Question

我有一组嵌套的闪亮模块，其中主UI采用textInput（）并调用添加/删除按钮模块，该模块又调用名为“first”的模块，该模块采用textInput（）值并预先设置selectInput（）框中的选项由“a”，“b”，“c”，“d”组成，作为这些选项。例如，如果用户键入“1”（默认值），则添加/删除按钮模块调用的selectInput（）框将显示选项“1a”，“1b”，“qc”和“1d”。我想将“first”模块中selectInput（）框的结果传递给主服务器逻辑。所以我传递selectInput（）的结果作为“第一”模块的返回，然后在addRmBtn（）模块中将其作为反应值分配，我想传递该值和param $ btn值，这是（净）单击添加按钮的次数。我在addRmBtnServer（）模块中收到错误，因为我没有正确地将“first”模块的返回值分配给addRmBtnServer（）中的reactive元素。代码如下。谢谢！

library(shiny)

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

firstServer <- function(input, output, session, a) {
    ns = session$ns

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

    return(reactive({ paste0(input$select) }))
}

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

       returnA <-  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
    })

    return(reactive({ c(returnA(), params$btn) }))
}

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

server <- function(input, output, session) {


    a <- reactive({ input$a })
    comp <- callModule(
    addRmBtnServer, id = "addRm",
    moduleToReplicate = list(
      ui = firstUI,
      server = firstServer,
      remover = removeFirstUI
    ),
    a = a
  )
    output$output <- renderText({ paste("a = ", a(), "comp = ", comp()) })

}

shinyApp(ui = ui, server = server)

Answer 1

如果可能的话，请尝试在将来提供更简约的示例代码。在SO上发布的问题也是为了帮助未来的访问者。如果他们必须通过80行代码，那对他们来说并不是很有帮助。这也使你的问题更难回答。

无论如何，我实现了你所追求的功能。 addRmButtonServer现在返回选项列表以及按钮值。所有值都存储在param范围内的addRmButtonServer变量中。可以在server范围内以returnValue$a[[firstUI_index]]()的形式访问这些值。请参阅output$text。

library(shiny)

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

firstServer <- function(input, output, session, a) {
  ns = session$ns

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

  return(reactive({ paste0(input$select) }))
}

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, a = list())

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

    params$a[[params$btn]] <- 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
  })

  return(params)
}

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

server <- function(input, output, session) {


  a <- reactive({ input$a })
  comp <- callModule(
    addRmBtnServer, id = "addRm",
    moduleToReplicate = list(
      ui = firstUI,
      server = firstServer,
      remover = removeFirstUI
    ),
    a = a
  )
  output$text <- renderText({ 
    if(comp$btn>0)
      paste(
        "a = ", comp$a[[comp$btn]](), 
        "comp = ", comp$btn
      ) 
  })

}

shinyApp(ui = ui, server = server)

R Shiny：访问嵌套闪亮模块中的反应元素

1 个答案: