r - 使用 selectizeGroup 的 Reactive Module 没有输出

Question

我想要一个 pickerinput 来限制 ShinyWisgets 的 Selectize Group 模块中的选项。我可以使用响应式(Reactive)表达式让它工作。但是，表中没有生成任何内容供我查看结果。我错过了什么？

我怀疑我在 mpg_filter 表达式中犯了一个错误。

# https://dreamrs.github.io/shinyWidgets/reference/selectizeGroup-module.html

library(shiny)
library(shinyWidgets)

data("mpg", package = "ggplot2")

ui <- fluidPage(
  fluidRow(
    column(
      width = 10, offset = 1,
      tags$h3("Filter data with selectize group"),
      panel(
        pickerInput(
          inputId = "car_select",
          choices = unique(mpg$manufacturer),
          options = list(
            `live-search` = TRUE,
            title = "None selected"
          ),
        ),


        selectizeGroupUI(
          id = "my-filters",
          params = list(
            manufacturer = list(inputId = "manufacturer", title = "Manufacturer:"),
            model = list(inputId = "model", title = "Model:"),
            trans = list(inputId = "trans", title = "Trans:"),
            class = list(inputId = "class", title = "Class:")
          )
        ),
        status = "primary"
      ),
      dataTableOutput(outputId = "table")
    )
  )
)

server <- function(input, output, session) {
  mpg_filter <- reactive({
    mpg %>%
      filter(mpg$manufacturer %in% input$car_select)
  })


  res_mod <- reactive({
    callModule(
      module = selectizeGroupServer,
      id = "my-filters",
      data = mpg_filter(),
      vars = c("manufacturer", "model", "trans", "class")
    )
  })

  output$table <- renderDataTable(res_mod())
}

shinyApp(ui, server)

Answer 1

自 v0.5.0 (November 2019) ,

selectizeGroupServer() (module selectizeGroup) now accept reactive data and reactive vars arguments, see examples for details ?selectizeGroupServer.

?selectizeGroupServer 中的最后一个示例实际上是对这个问题的直接回答:

# Subset data -------------------------------------------------------------

library(shiny)
library(shinyWidgets)

data("mpg", package = "ggplot2")

ui <- fluidPage(
  fluidRow(
    column(
      width = 10, offset = 1,
      tags$h3("Filter data with selectize group"),
      panel(
        pickerInput(
          inputId = "car_select",
          choices = unique(mpg$manufacturer),
          options = list(
            `live-search` = TRUE,
            title = "None selected"
          )
        ),
        selectizeGroupUI(
          id = "my-filters",
          params = list(
            manufacturer = list(inputId = "manufacturer", title = "Manufacturer:"),
            model = list(inputId = "model", title = "Model:"),
            trans = list(inputId = "trans", title = "Trans:"),
            class = list(inputId = "class", title = "Class:")
          )
        ),
        status = "primary"
      ),
      DT::dataTableOutput(outputId = "table")
    )
  )
)

server <- function(input, output, session) {
  
  mpg_filter <- reactive({
    subset(mpg, manufacturer %in% input$car_select)
  })
  
  res_mod <- callModule(
    module = selectizeGroupServer,
    id = "my-filters",
    data = mpg_filter,
    vars = c("manufacturer", "model", "trans", "class")
  )
  
  output$table <- DT::renderDataTable({
    req(res_mod())
    res_mod()
  })
}

shinyApp(ui, server)

注意 data = mpg_filter ( react 本身，而不是对它的调用)在 callModule(module = selectizeGroupServer)

---

过时的答案

困难源于selectizeGroupServer不接受 reactive作为 data争论。如果是这样，那就更简单了。这是一个解决方法:

server <- function(input, output, session) {
  mpg_filter <- reactive({
    mpg %>%
      filter(mpg$manufacturer %in% input$car_select)
  })
  
  res_mod <- reactive({})
  
  observe({
    res_mod <<- callModule(
      module = selectizeGroupServer,
      id = "my-filters",
      data = mpg_filter(),
      vars = c("manufacturer", "model", "trans", "class")
    )
  })
  
  output$table <- renderDataTable(res_mod())
}

还有一个:

server <- function(input, output, session) {
  mpg_filter <- reactive({
    mpg %>%
      filter(mpg$manufacturer %in% input$car_select)
  })
  
  
  res_mod <- reactive({
    callModule(
      module = selectizeGroupServer,
      id = "my-filters",
      data = mpg_filter(),
      vars = c("manufacturer", "model", "trans", "class")
    )
  })
  
  output$table <- renderDataTable(res_mod()())
}

注意唯一的变化:res_mod()() .这是因为 res_mod()本身是 react 性的，因为callModule包裹在 reactive 中(不只是 res_mod 本身，还有结果调用)，所以我们必须像 res_mod()() 一样调用它两次.
这在第一个建议中没有发生，但我不得不对 res_mod 的初始化进行一些修改。 , 然后 <<- ，以避免在 res_mod 时出现错误在仍未定义时被调用。
我仍然会选择第一个，因为 res_mod()()与惯用的 Shiny 代码相去甚远。