我正在尝试在 R Shiny 应用程序中的多个模块中使用reactiveValues。
我举了一个例子来说明我的问题。它由一个主应用程序组成，其中包含一个reactiveValue，它是一个包含3列的数据帧和3个旨在“读取”、“写入”和“读写”reactiveValue的模块。
- 阅读:应用程序 -> 模块
- 写入:模块 -> 应用程序
- 读写:应用程序<->模块
我收到错误:
Warning: Error in <-: object of type 'closure' is not subsettable
请注意，如果reactiveValue只是一个简单的变量，例如，代码就可以工作。整数，但不适用于需要更新组件而不是整个数据框的数据框。
我发现以下链接非常有用。不确定它是否涵盖我的情况。 https://www.ardata.fr/en/post/2019/04/26/share-reactive-among-shiny-modules/
关于如何解决这个问题有什么想法吗？
这是我的代码:
library(shiny)
library(shinydashboard)
readUI <- function(id, label = "Read") {
ns <- NS(id)
tagList(
valueBoxOutput(ns("showX"))
)
}
read <- function(input, output, session, x) {
ns <- session$ns
output$showX <- renderValueBox({
valueBox(x(), "x")
})
}
writeUI <- function(id, label = "Write") {
ns <- NS(id)
tagList(
selectizeInput(ns("selectX"), "Select a value for x", choices = 1:10),
actionButton(ns("submit"), "Submit")
)
}
write <- function(input, output, session) {
ns <- session$ns
toReturn <- reactiveValues(x = data.frame(a=c(1), b=c(2), c=c(3)), trigger = NULL)
observeEvent(input$submit, {
toReturn$x$a <- as.numeric(input$selectX)
toReturn$trigger <- toReturn$trigger + 1
})
return(toReturn)
}
readAndWriteUI <- function(id, label = "ReadAndWrite") {
ns <- NS(id)
tagList(
valueBoxOutput(ns("showX")),
selectizeInput(ns("selectX"), "Select a value for x", choices = 1:10),
actionButton(ns("submit"), "Submit")
)
}
readAndWrite <- function(input, output, session, x) {
ns <- session$ns
toReturn <- reactiveValues(x = x, trigger = NULL)
output$showX <- renderValueBox({
valueBox(x(), "x")
})
observeEvent(input$submit, {
toReturn$x$a <- as.numeric(input$selectX)
toReturn$trigger <- toReturn$trigger + 1
})
return(toReturn)
}
ui <- dashboardPage(
dashboardHeader(title = "Example"),
dashboardSidebar(),
dashboardBody(
tabsetPanel(id = "mainTabSetPanel",
tabPanel("Read", readUI("Read")),
tabPanel("Write", writeUI("Write")),
tabPanel("ReadAndWrite", readAndWriteUI("ReadAndWrite"))
)
)
)
server <- function(input, output, session) {
rv <- reactiveValues(x = data.frame(a=c(1), b=c(2), c=c(3)))
callModule(read, "Read", reactive(rv$x))
output_Write <- callModule(write, "Write")
output_ReadAndWrite <- callModule(readAndWrite, "ReadAndWrite", reactive(rv$x))
observeEvent(output_Write$trigger, {
print("Updating x from Write")
rv$x <- output_Write$x
#updateTabsetPanel(session, "mainTabSetPanel", selected = "Read")
})
observeEvent(output_ReadAndWrite$trigger, {
print("Updating x from ReadAndWrite")
rv$x <- output_ReadAndWrite$x
#updateTabsetPanel(session, "mainTabSetPanel", selected = "Read")
})
}
shinyApp(ui, server)
最佳答案
请尝试以下操作:
library(shiny)
library(shinydashboard)
readUI <- function(id, label = "Read") {
ns <- NS(id)
tagList(
valueBoxOutput(ns("showX"))
)
}
read <- function(input, output, session, x) {
ns <- session$ns
output$showX <- renderValueBox({
valueBox(x(), "x")
})
}
writeUI <- function(id, label = "Write") {
ns <- NS(id)
tagList(
selectizeInput(ns("selectX"), "Select a value for x", choices = 1:10),
actionButton(ns("submit"), "Submit")
)
}
write <- function(input, output, session) {
ns <- session$ns
toReturn <- reactiveValues(x = data.frame(a=c(1), b=c(2), c=c(3)), trigger = 0)
observeEvent(input$submit, {
toReturn$x$a <- as.numeric(input$selectX)
toReturn$trigger <- toReturn$trigger + 1
})
return(toReturn)
}
readAndWriteUI <- function(id, label = "ReadAndWrite") {
ns <- NS(id)
tagList(
valueBoxOutput(ns("showX")),
selectizeInput(ns("selectX"), "Select a value for x", choices = 1:10),
actionButton(ns("submit"), "Submit")
)
}
readAndWrite <- function(input, output, session, x) {
ns <- session$ns
toReturn <- reactiveValues(x = x, trigger = 0)
observeEvent(toReturn, {
toReturn$x <- toReturn$x()
}, once = TRUE)
output$showX <- renderValueBox({
valueBox(x(), "x")
})
observeEvent(input$submit, {
toReturn$x$a <- as.numeric(input$selectX)
toReturn$trigger <- toReturn$trigger + 1
})
return(toReturn)
}
ui <- dashboardPage(
dashboardHeader(title = "Example"),
dashboardSidebar(),
dashboardBody(
tabsetPanel(id = "mainTabSetPanel",
tabPanel("Read", readUI("Read")),
tabPanel("Write", writeUI("Write")),
tabPanel("ReadAndWrite", readAndWriteUI("ReadAndWrite"))
)
)
)
server <- function(input, output, session) {
rv <- reactiveValues(x = data.frame(a=c(1), b=c(2), c=c(3)))
callModule(read, "Read", reactive(rv$x))
output_Write <- callModule(write, "Write")
output_ReadAndWrite <- callModule(readAndWrite, "ReadAndWrite", reactive(rv$x))
observeEvent(output_Write$trigger, {
print("Updating x from Write")
rv$x <- output_Write$x
#updateTabsetPanel(session, "mainTabSetPanel", selected = "Read")
}, ignoreInit = TRUE)
observeEvent(output_ReadAndWrite$trigger, {
print("Updating x from ReadAndWrite")
rv$x <- output_ReadAndWrite$x
#updateTabsetPanel(session, "mainTabSetPanel", selected = "Read")
}, ignoreInit = TRUE)
}
shinyApp(ui, server)
关键是在行中添加 toReturn$x <- toReturn$x()当你处理reactives时和reactiveValues但这只能运行一次，因此如下:
observeEvent(toReturn, {
toReturn$x <- toReturn$x()
}, once = TRUE)
我发现的一个独立问题是，即使对于 write，您的代码也只能工作一次。模块。所以，我改变了trigger = NULL至trigger = 0 (因为您无法添加 NULL 值)，但随后必须添加 ignoreInit = TRUE对于observeEvents在 server在启动时忽略它们。
请随意测试这些，通过一一取出我的添加内容来了解该过程。如果有任何需要澄清的地方请在下面评论。
关于r - 在 R Shiny 中跨多个模块使用reactiveValues，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/59874470/