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

Sea*_*kin 2 r shiny

我创建了一个玩具示例,其中弹出一个textInput()框供用户输入任何字符串,然后通过单击添加按钮,弹出一个selectInput()框,并在字符串前加上字母a:d。换句话说,如果用户输入“ 1”,则通过单击“添加”按钮,将弹出一个selectInput()框,其中包含1a,1b,1c和1d作为选择。我正在使用一个用于添加/删除按钮功能的模块,该模块调用另一个模块来生成selectInput()框。主服务器函数调用添加/删除模块,该模块调用“第一个”模块,该模块生成selectInput()框。我将a()作为反应元素传递给添加/删除模块,该模块又将其传递给“第一个”模块。我只是在添加/删除模块和“ first”的功能签名中使用了“ ...”

这似乎可行,尽管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)
Run Code Online (Sandbox Code Playgroud)

Gre*_*lia 5

如果你有

a <- reactive({input$a})
Run Code Online (Sandbox Code Playgroud)

您需要传递a给内部(第一个)模块,而不是a()。那是因为a()代表了可观察对象的当前a。这意味着a()无法观测。在您的代码中,a()在启动期间在服务器范围内进行评估。当时,a具有值1(在中定义的默认值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(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)
Run Code Online (Sandbox Code Playgroud)