Question

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

这似乎有效，虽然a（）似乎在它到达“first”模块时没有反应，这意味着如果我在“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)

Answer 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)

Answer 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)

这导致app类似：

如上所述，selectInput是基于a添加的。{/ p>

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

2 个答案: