Предупреждение о запуске с реактивным входом в блестящем модуле

Question

В настоящее время я разбиваю приложение Shiny на разные модули в соответствии со структурой {golem}. Для простоты предположим, что у меня есть 3 основных блестящих модуля:

• mod_faith_plot: генерирует диаграмму рассеяния для данного набора данных (я буду использовать faitfhul).
• mod_points_select: отделяет раскрывающееся меню, чтобы выбрать, сколько точек будет нанесено на график. У входов пользовательского интерфейса есть этот специальный модуль, поскольку я хотел разместить селектор в sidebarPanel вместо mainPanel (рядом с графиком).
• mod_data: предоставляет реактивный фрейм данных в зависимости от аргумента n_points .

Эти модули взаимодействуют друг с другом в функции server. Теперь, когда я запускаю свое приложение с простым head(., n_points()) в mod_data, я получаю следующее предупреждение:

Warning: Error in checkHT: invalid 'n' -  must contain at least one non-missing element, got none.

Вход в mod_points_select явно NULL до того, как аргумент selected_points получит назначен, есть ли менее хитрый и более элегантный способ избежать предупреждения при запуске, чем мое условие if ?

library(shiny)
library(dplyr)
library(ggplot2)

# [Module] Plot faithful data -------------------------------------------------------

mod_faith_plot_ui <- function(id){
  ns <- NS(id)
  tagList(
    plotOutput(ns("faith_plot"))
  )
}

mod_faith_plot_server <- function(input, output, session, data){
  ns <- session$ns

  output$faith_plot <- renderPlot({
    data() %>% 
      ggplot(aes(eruptions, waiting)) +
      geom_point()
  })

}


# [Module] Module for n_points dropdown ---------------------------------------------

mod_points_select_ui <- function(id){
  ns <- NS(id)

  uiOutput(ns("select_points"))

}

mod_points_select_server <- function(input, output, session){
  ns <- session$ns

  output$select_points <- renderUI({
    selectInput(
      ns("n_points"),
      label = "Select how many points",
      choices = seq(0, 200, by = 10),
      selected = 50
    )
  })
  reactive({input$n_points})
}


# [Module] Get filtered data -----------------------------------------------------------------

mod_data_server <- function(input, output, session, n_points){
  ns <- session$ns

  data <- reactive({
    faithful %>%
      # If condition used to avoid warnings at startup - switch lines to get warning
      # head(., n_points())
      head(., if(is.null(n_points())) { TRUE } else {n_points()})
  })

}


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      mod_points_select_ui(id = "selected_points")
    ),
    mainPanel(
      tabsetPanel(type = "tabs",
                  tabPanel("plot", mod_faith_plot_ui(id = "faith_plot"))
      )
    )
  )
)

server <- function(input, output, session) {

  data <- callModule(mod_data_server, id = "data", n_points = selected_points)
  selected_points <- callModule(mod_points_select_server, id = "selected_points")

  callModule(mod_faith_plot_server, id = "faith_plot", data = data)
}

shinyApp(ui, server)

Answer 1

Вы можете использовать req(), чтобы убедиться, что значения доступны:

data <- reactive({
    req(n_points())
    faithful %>%
        head(., n_points())
})

Когда значения недоступны, вызов автоматически отменяется