[英]Using reactiveValues across multiple modules in R Shiny
我正在嘗試在 R 閃亮應用程序中的多個模塊中使用reactiveValues。
我已經建立了一個例子來說明我的問題。 它由一個包含reactiveValue的主應用程序組成,該應用程序是一個包含3列和3個模塊的數據框,旨在“讀取”、“寫入”和“讀取和寫入”reactiveValue。
我收到錯誤:
警告:<- 中的錯誤:“閉包”類型的對象不是可子集的
請注意,如果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)
關鍵是在處理reactives
和reactiveValues
值時添加toReturn$x <- toReturn$x()
,但這只能運行一次,因此如下:
observeEvent(toReturn, {
toReturn$x <- toReturn$x()
}, once = TRUE)
我發現的一個獨立問題是,即使對於write
模塊,您的代碼也只能工作一次。 於是,我改變了trigger = NULL
來trigger = 0
(因為你不能添加到NULL
值),但隨后不得不在添加ignoreInit = TRUE
為observeEvents
在server
忽略它們的啟動。
隨意測試這些,一一拿出我的補充來了解這個過程。 如果有什么需要澄清的,請在下面評論。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.