闪亮的反应性在subModules中不起作用

时间:2018-02-02 22:58:07

标签: r shiny shiny-reactivity

因为我的shiny应用程序变得非常庞大,我最近将一些代码放入模块中(也是为了在不同的地方多次重用代码)。不知何故,部分代码不再按预期工作。

在这个例子中,我有一个模块,它根据输入元素过滤数据并返回一个被动data.frame。在mainPanel中,我有一个模块,可以从过滤后的数据中创建dataTable。但是反应不起作用,当我更改selectInput时,dataTable不会更新。

library(shiny)
library(DT)

filtersUI <- function(id) {
  ns <- NS(id)
  selectizeInput(
    ns("Species"), label = "Species",
    choices = levels(iris$Species),
    selected = "virginica"
  )
}

filters <- function(input, output, session, .data) {
  inputs <- reactive({
    list("Species" = input[["Species"]])
  })
  reactive({
    .data[.data$Species %in% inputs()[["Species"]], ]
  })
}

dataTableUI <- function(id) {
  ns <- NS(id)
  DT::dataTableOutput(ns("data.table"))
}

dataTable <- function(input, output, session, .data) {
  output$data.table <- DT::renderDataTable({
    DT::datatable(.data)
  })
}

appUI <- function(id) {
  ns <- NS(id)
  sidebarLayout(
    sidebarPanel(
      filtersUI(ns("filter"))
    ),
    mainPanel(
      dataTableUI(ns("data.table"))
    )
  )
}

app <- function(input, output, session, .data) {
  data.subset <- callModule(filters, "filter", .data = .data)
  callModule(dataTable, "data.table", .data = data.subset())
}

ui <-   fluidPage(
  appUI("app")
)

server <- function(input, output, session) {
  callModule(app, "app", .data = iris)
}

shinyApp(ui, server)

但是当将代码从子模块复制到app模块时,代码工作正常:

library(shiny)
library(DT)
appUI <- function(id) {
  ns <- NS(id)
  sidebarLayout(
    sidebarPanel(
      selectizeInput(
        ns("Species"), label = "Species",
        choices = levels(iris$Species),
        selected = "virginica"
      )
    ),
    mainPanel(
      DT::dataTableOutput(ns("data.table"))
    )
  )
}

app <- function(input, output, session, .data) {
  inputs <- reactive({
    list("Species" = input[["Species"]])
  })
  data.subset <- reactive({
    .data[.data$Species %in% inputs()[["Species"]], ]
  })
  output$data.table <- DT::renderDataTable({
    DT::datatable(data.subset())
  })
}

ui <-   fluidPage(
  appUI("app")
)

server <- function(input, output, session) {
  callModule(app, "app", .data = iris)
}

shinyApp(ui, server)

我知道模块化结构在这个简单的例子中看起来有些过分,但在我的真实应用程序中,我在模块中有很多代码,我删除了这些代码使这个例子最小化。因此,使用与第一个代码片段中相同的模块化结构来获得解决方案会更好。任何想法失败的想法?

1 个答案:

答案 0 :(得分:1)

您创建了一个包含子模块的可重复示例,做得非常好。但是,问题确实与子模块没有任何关系。您只需要以不同方式传递反应对象data.subset。而不是

callModule(dataTable, "data.table", .data = data.subset())

你应该使用

callModule(dataTable, "data.table", .data = data.subset)

传递反应本身而不是其当前值。然后可以在DT::renderDataTable中“解析”该值

output$data.table <- DT::renderDataTable({
    DT::datatable({.data()})                                   
})

您编码的方式,“构建时间”的数据,即未过滤的数据集将被发送到模块,并且在此过程中无法观察到。

要明确:评论的行(## remove parantheses here## add parantheses here)是我从原始代码中更改的唯一行。

library(shiny)
library(DT)

filtersUI <- function(id) {
  ns <- NS(id)
  selectizeInput(
    ns("Species"), label = "Species",
    choices = levels(iris$Species),
    selected = "virginica"
  )
}

filters <- function(input, output, session, .data) {
  inputs <- reactive({
    list("Species" = input[["Species"]])
  })
  reactive({
    .data[.data$Species %in% inputs()[["Species"]], ]
  })
}

dataTableUI <- function(id) {
  ns <- NS(id)
  DT::dataTableOutput(ns("data.table"))
}

dataTable <- function(input, output, session, .data) {
  output$data.table <- DT::renderDataTable({
    DT::datatable({.data()})                                  ## add parantheses here
  })
}

appUI <- function(id) {
  ns <- NS(id)
  sidebarLayout(
    sidebarPanel(
      filtersUI(ns("filter"))
    ),
    mainPanel(
      dataTableUI(ns("data.table"))
    )
  )
}

app <- function(input, output, session, .data) {
  data.subset <- callModule(filters, "filter", .data = .data)
  callModule(dataTable, "data.table", .data = data.subset)    ## remove parantheses here
}

ui <-   fluidPage(
  appUI("app")
)

server <- function(input, output, session) {
  callModule(app, "app", .data = iris)
}

shinyApp(ui, server)

总结一下,以下是Joe Cheng对similar issue

的引用
  

嗨Mark,LinkedScatter本身的代码是正确的;但是当调用callModule时,你想通过名称(car_data)传递反应本身而不读它(car_data())。

     

callModule(linkedScatter,“scatters”,car_data)

     

这类似于如何通过名称将函数传递给lapply:

     

lapply(字母,toupper)#works

     

lapply(letters,toupper())#不起作用