r - 如何从 Shiny 的callModule函数返回输入值

Question

我目前正在尝试基于 this tutorial 模块化我的 Shiny 应用程序。在我的实际应用程序中，我有两个 selectInput ，允许用户选择第一个和最后一个季度结束日期，并根据该日期计算某些数据集的一些统计数据。由于可用的季末日期取决于实际数据集，并且使用了不同的数据集，因此我在服务器函数中动态提供 selectInput 的 choices 参数。流程如下:

1. 根据数据集的可用季度结束日期动态创建 selectInput 对象。
2. 使用选定的季度结束日期来相应地限制特定数据集。

我在我的应用程序中针对不同的数据集一遍又一遍地执行此操作，这就是我现在想要创建一个模块的原因。然而，我很难获取选定的季度末日期，然后我可以用它来限制我的数据集。

下面，请找到一个小应用程序来说明我的问题。

app.R 部分

source("module.R")

ui <- fixedPage(
  selectQuartersUI("test"),
  textOutput("summary")
)

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

  ### Here I want to save the selected input
  #(Use 1:10 for illustration purposes, this would actually be 
  #quarter end-dates that are dynamic based on the specific data set)
  testValues <- callModule(selectQuarters, "test", 1:10) 

  ### Use the selected input (here to simply output them, in actual app to limit data set)
  #Using testValues returns long function call, calling testValues() returns "Error: could not find function "testValues""
  output$summary <- renderText({
    sprintf(paste0("Start: ", testValues(), collapse = "_"))
  })
}

shinyApp(ui, server)

module.R部分

selectQuartersUI <- function(id) {

  ns <- NS(id)

  fluidRow(
    column(3, htmlOutput(ns("startQuarter"))),
    column(3, htmlOutput(ns("endQuarter")))
  )

}

selectQuarters <- function(input, output, session, vec_dates) {

  vec_dates <- sort(unique(vec_dates))

  output$startQuarter <-  renderUI({
    ns <- session$ns
    selectInput(ns("startQuarter"), "Start:", vec_dates[1:(length(vec_dates)-1)],
                multiple = FALSE,
                selected =  max(vec_dates[1:(length(vec_dates)-1)])) 
  })

  output$endQuarter  <- renderUI({
    ns <- session$ns #See "Using renderUI within modules" part in tutorial
    selectInput(ns("endQuarter"), "End:", vec_dates,
                multiple = FALSE,
                selected =  max(vec_dates)) #3nd latest quarter
  })

  #See tutorial: "If a module wants to return reactive expressions to the calling app, 
  #               then return a list of reactive expressions from the function
  # Using c() instead causes the same issues
  return(list(reactive({input$startQuarter}), 
              reactive({input$endQuarter})))

}

失败的部分是返回 testValues 中选定的季末日期，但我很难找出原因。

Answer 1

您的代码非常接近正确。

您需要意识到的唯一一件事是您从模块返回的是一个列表，而不是一个响应值。因此，您无法像无功值一样访问它。但您可以访问其各个元素，例如 react 值。

因此，虽然 testValues() 会导致错误，但 testValues[[1]]() 和 testValues[[2]]() 将为您提供您想要的两个值。

Shiny 的应用程序代码表明它确实如此简单:

ui <- fixedPage(
  selectQuartersUI("test"),
  textOutput("summary")
)

server <- function(input, output, session) {
  testValues <- callModule(selectQuarters, "test", 1:10) 
  output$summary <- renderText({
    sprintf(paste0("Start: ", testValues[[1]](), " end: ", testValues[[2]]()))
  })
}

shinyApp(ui, server)

更好的是，您可以返回一个命名列表(并作为 react 值访问各个元素)。在模块内部，将return语句修改为

return(list(start = reactive({input$startQuarter}), 
            end   = reactive({input$endQuarter})))

然后应用程序代码变为

ui <- fixedPage(
  selectQuartersUI("test"),
  textOutput("summary")
)

server <- function(input, output, session) {
  testValues <- callModule(selectQuarters, "test", 1:10) 
  output$summary <- renderText({
    sprintf(paste0("Start: ", testValues$start(), " end: ", testValues$end()))
  })
}

shinyApp(ui, server)