如何显示和隐藏由另一个模块的反应触发的用户输入？

Question

我一直在使用 Shiny

conditionalPanel()

和shinyjs

show

、

hide

和

toggle

函数显示/隐藏 UI 项目。然而，在这个多模块示例中我陷入了困境。我试图在第二个模块 (

selectInput()

) 中显示/隐藏

mod2

，由第一个模块 (

mod1

) 中的操作按钮“计算”触发。在单击“计算”操作按钮之前，我希望隐藏“选择系列”

selectInput()

。如下图所示。

下面是我的 2 模块代码的骨架版本。我遇到的困难是，当来自

selectInput()

的反应性

mod2_ui

触发取消隐藏时，如何将

common$calc_click

隐藏在

mod1_server

中。本质上，我试图让

mod1_ui

中的操作也控制其他模块中的操作。有什么建议么？我试图避免

renderUI()

因为它带来的问题（速度、调用闪烁等），但也许这是不可避免的。也许其他人有更好的想法？

代码：

library(shiny)

seriesTrm <- data.frame('Series_1' = c(1,2,3),row.names = c("A","B","C"))

mod1_ui <- function(id) {
  ns <- NS(id)
  list(
    calcBttn = actionButton(ns("calculate"), "Calculate"), 
    allocTable = textOutput(ns("alloc_tbl")),
    info_text = uiOutput(ns("click_warn_1"))
  )
}

mod1_server <- function(id, common, input) {
  moduleServer(id, function(input, output, session) {
    calc_click <- reactiveVal(FALSE)  
    allocData <- reactiveVal()
    
    observeEvent(input$calculate, {
      calc_click(TRUE)
      common$mod1_data <- allocData  
    }) 
    
    output$click_warn_1 <- renderText(if(!calc_click()){"Click Calculate to render mod1 table"}) 
    observe({common$calc_click <- calc_click()})
    output$alloc_tbl <- renderText({if(calc_click()){"Mod1 table appears here"}})
  }) 
}

mod2_ui <- function(id) {
  ns <- NS(id)
  list(
    seriesSelect = selectInput(ns("seriesSelect"), "Select Series", choices = NULL),
    mod2Output = textOutput(ns("series_tbl")),
    info_text = uiOutput(ns("click_warn_2"))
  )
}

mod2_server <- function(id, common, input) {
  moduleServer(id, function(input, output, session) {
    reactive_choices <- reactive({colnames(common$seriesTbl_1())})
    observe({updateSelectInput(session, "seriesSelect", choices = reactive_choices())})
    calc_click <- reactive(common$calc_click)
    output$click_warn_2 <- renderText(if(!calc_click()){"Click Calculate to render mod2 table"})
    output$series_tbl <- renderText({if(calc_click()){"Mod2 table appears here"}})
  })
}

ui <- fluidPage(
 tableOutput('hottable_1'),br(),
 mod1_ui("mod1")$calcBttn,br(),br(),
 mod1_ui("mod1")$info_text,
 mod1_ui("mod1")$allocTable, br(),
 mod2_ui("mod2")$info_text,br(),
 mod2_ui("mod2")$seriesSelect, br(),
 mod2_ui("mod2")$mod2Output 
) 

server <- function(input,output,session)({
  seriesTbl_1 <- reactiveVal(seriesTrm) 
  observeEvent(input$hottable_1, {seriesTbl_1(hot_to_r(input$hottable_1))})
  
  output$hottable_1 <- renderTable({seriesTbl_1()})
  
  common <- reactiveValues(seriesTbl_1 = reactive(seriesTbl_1()))
  mod1_data <- mod1_server("mod1", common, input)
  mod2_server("mod2", common, input)
}) 

shinyApp(ui, server)

Answer 1

以下构建一个对用户输入做出反应的动态 UI 一种选择是使用助手

output

来存储

calc_click

的值，然后可以在

condition

的

conditionalPanel

中使用该值，如下所示：

mod2_ui <- function(id) {
  ns <- NS(id)
  list(
    seriesSelect =
      conditionalPanel(
        condition = "output.show_series",
        selectInput(
          ns("seriesSelect"), "Select Series",
          choices = NULL
        ),
        ns = ns
      ),
    mod2Output = textOutput(ns("series_tbl")),
    info_text = uiOutput(ns("click_warn_2"))
  )
}

mod2_server <- function(id, common, input) {
  moduleServer(id, function(input, output, session) {
    reactive_choices <- reactive({
      colnames(common$seriesTbl_1())
    })
    observe({
      updateSelectInput(session, "seriesSelect",
        choices = reactive_choices()
      )
    })
    calc_click <- reactive(common$calc_click)
    output$click_warn_2 <- renderText(if (!calc_click()) {
      "Click Calculate to render mod2 table"
    })
    output$series_tbl <- renderText({
      if (calc_click()) {
        "Mod2 table appears here"
      }
    })
    output$show_series <- reactive({ calc_click() })
    outputOptions(output, "show_series", suspendWhenHidden = FALSE)
  })
}