R Shiny：如何在嵌套模块之间传递反应变量

Posted 2023-03-24

【中文标题】R Shiny：如何在嵌套模块之间传递反应变量

【英文标题】：R Shiny: How to pass reactive variables between nested modules

【发布时间】：2018-03-16 15:56:33

【问题描述】：

我创建了一个玩具示例，其中弹出一个 textInput() 框供用户输入任何字符串，然后通过单击添加按钮，弹出一个 selectInput() 框，其中字母 a:d 前面带有字符串.换句话说，如果用户输入“1”，那么通过单击“添加”按钮，会弹出一个 selectInput() 框，其中有 1a、1b、1c 和 1d 作为选项。我正在使用一个模块来实现添加/删除按钮功能，并且该模块调用另一个模块来生成 selectInput() 框。主服务器函数调用添加/删除模块，该模块调用“第一个”模块，该模块生成 selectInput() 框。我将 a() 作为反应元素传递给添加/删除模块，然后将其传递给“第一个”模块。我只是在添加/删除模块和“第一个”模块的函数签名中使用“...”来获取嵌套模块的 a()。

这似乎可行，尽管 a() 在到达“第一个”模块时似乎没有反应，这意味着如果我在“a”框中键入不同的字符串，我希望在selectInput() 框动态更改，或者至少当我更改 textInput() 字符串并单击“添加”时，新的 selectInput() 应该反映更新后的 textInput() 字符串，但这不会发生。什么会使 selectInput() 选项随着 textInput() 的变化而动态变化？代码如下，谢谢！

library(shiny)

firstUI <- function(id)  uiOutput(NS(id, "first")) 

firstServer <- function(input, output, session, a) 

    output$first <- renderUI(
        selectInput(session$ns("select"), h4("Select"), paste0(a,letters[1:4]))
    )


removeFirstUI <- function(id) 
    removeUI(selector = paste0('#', NS(id, "first")))


addRmBtnUI <- function(id) 
    ns <- NS(id)

    tags$div(
    actionButton(inputId = ns('insertParamBtn'), label = "Add"),
    actionButton(ns('removeParamBtn'), label = "Remove"),
    hr(),
    tags$div(id = ns('placeholder'))
  )


addRmBtnServer <- function(input, output, session, moduleToReplicate,...) 
    ns = session$ns

    params <- reactiveValues(btn = 0)

    observeEvent(input$insertParamBtn, 
        params$btn <- params$btn + 1

        callModule(moduleToReplicate$server, id = params$btn, ...)
        insertUI(
      selector = paste0('#', ns('placeholder')),
      ui = moduleToReplicate$ui(ns(params$btn))
    )
    )

    observeEvent(input$removeParamBtn, 
        moduleToReplicate$remover(ns(params$btn))
        params$btn <- params$btn - 1
    )


ui <- fluidPage(
          addRmBtnUI("addRm"),
          textInput("a", label = "a", value = 1, width = '150px') )

server <- function(input, output, session) 


    a <- reactive( input$a )
    callModule(
    addRmBtnServer, id = "addRm",
    moduleToReplicate = list(
      ui = firstUI,
      server = firstServer,
      remover = removeFirstUI
    ), a = a()
  )


shinyApp(ui = ui, server = server)

【问题讨论】：

假设我在这里推断正确，@Sean 我的方法能解决你的目的吗？

【参考方案1】：

如果你有

a <- reactive(input$a)

您需要将a 向下传递给内部（第一个）模块，而不是a()。这是因为a() 代表了可观察对象a 的当前 值。这意味着a() 是不可观察的。在您的代码中，a() 在启动期间在服务器范围内进行评估。那时，a 的值为1（对应的textInput 中定义的默认值），您将其作为静态 对象传递。

您可以了解更多关于反应式值的信息here。

library(shiny)

firstUI <- function(id)  uiOutput(NS(id, "first")) 

firstServer <- function(input, output, session, a) 

  output$first <- renderUI(
    selectInput(session$ns("select"), h4("Select"), paste0(isolate(a()),letters[1:4]))
  )


removeFirstUI <- function(id) 
  removeUI(selector = paste0('#', NS(id, "first")))


addRmBtnUI <- function(id) 
  ns <- NS(id)

  tags$div(
    actionButton(inputId = ns('insertParamBtn'), label = "Add"),
    actionButton(ns('removeParamBtn'), label = "Remove"),
    hr(),
    tags$div(id = ns('placeholder'))
  )


addRmBtnServer <- function(input, output, session, moduleToReplicate,...) 
  ns = session$ns

  params <- reactiveValues(btn = 0)

  observeEvent(input$insertParamBtn, 
    params$btn <- params$btn + 1

    callModule(moduleToReplicate$server, id = params$btn, ...)
    insertUI(
      selector = paste0('#', ns('placeholder')),
      ui = moduleToReplicate$ui(ns(params$btn))
    )
  )

  observeEvent(input$removeParamBtn, 
    moduleToReplicate$remover(ns(params$btn))
    params$btn <- params$btn - 1
  )


ui <- fluidPage(
  addRmBtnUI("addRm"),
  textInput("a", label = "a", value = 1, width = '150px') )

server <- function(input, output, session) 


  a <- reactive( input$a )
  callModule(
    addRmBtnServer, id = "addRm",
    moduleToReplicate = list(
      ui = firstUI,
      server = firstServer,
      remover = removeFirstUI
    ), 
    a = a
  )


shinyApp(ui = ui, server = server)

【讨论】：

这太好了，再次感谢！现在，如果我想将 firstUI() 元素包装在 tags$div 中（例如，如果我想在一个“块”中添加和删除多个元素，我该如何调整 removeFirstUI()？即，如果 firstUI() 为如下：

firstUI

在这种情况下，我不想只删除 UI 元素“first”，而是删除 tags$div() 中的所有内容，它可以构建到任意数量的 UI 元素。注意标签$div的id是id = paste0('firstui', id)。是模块中 tags$div() id 的命名空间让我感到困惑。谢谢！

使用id = ns('firstui') 并删除div 和removeUI(selector = paste0('#', NS(id, "firstui")))。我没有测试它，但这样的东西应该可以完成这项工作。

注意NS(id,'fitstui')等价于ns <- NS(id); ns('firstui')

【参考方案2】：

基于example here，我对所需的输出进行了一些调整。

app.R

library(shiny)

ui <- fluidPage( 
  actionButton('insertBtn', 'Insert'), 
  actionButton('removeBtn', 'Remove'), 
  tags$div(id = 'placeholder'),
  textInput(inputId = "a", label = "a", value = 1, width = '150px')
)

server <- function(input, output) 

  ## keep track of elements inserted and not yet removed
  inserted <- c()

  observeEvent(input$insertBtn, 
    btn <- input$a
    id <- paste0('txt', btn)
    insertUI(
      selector = '#placeholder',
      ## wrap element in a div with id for ease of removal
      ui = tags$div(
        selectInput(inputId = btn,label = btn,choices = paste(btn,letters[1:4])), 
        id = id
      )
    )
    inserted <<- c(id, inserted)
  )

  observeEvent(input$removeBtn, 
    removeUI(
      ## pass in appropriate div id
      selector = paste0('#', inserted[length(inserted)])
    )
    inserted <<- inserted[-length(inserted)]
  )



shinyApp(ui = ui, server = server)

这会导致应用程序如下：

据观察，selectInputs 是基于 a 添加的。

【讨论】：

谢谢，但我需要将它保留在我发布它的模块化形式中。我的实际应用程序要复杂得多，我为这篇文章简化了它。关键是我能够获取一个反应元素并将其作为参数传递给创建添加/删除按钮的模块，然后调用嵌套模块来处理该信息，在这种情况下使用 selectInput() 框.我想将添加/删除按钮模块化，这样我就可以轻松地为不同的嵌套模块多次调用它们，而无需一个单一且不可维护的毛球。