0

我正在尝试构建一个依赖于通过 lapply 创建的按钮列表的应用程序。当我不使用模块化代码时，我可以使用 observeEvent 成功引用按钮。但是，当我尝试使用模块时，observeEvent 不起作用。我怀疑这与 Shiny 处理命名空间 id 的方式有关，但是尽管进行了几天的实验，我还是无法解决这个问题。

下面我将首先发布可以工作的非模块化虚拟应用程序（从另一个堆栈溢出问题中窃取：R Shiny: How to write loop for observeEvent）。然后我将分享我现有的不起作用的模块化代码。

工作非模块化代码：

library("shiny")
ui <- fluidPage(
  fluidRow(
    column(
      width = 6,
      lapply(
        X = 1:6,
        FUN = function(i) {
          sliderInput(inputId = paste0("d", i), label = i, min = 0, max = 10, value = i)
        }
      )
    ),
    column(
      width = 6,
      verbatimTextOutput(outputId = "test")
    )
  )
)
server <- function(input, output){

  vals <- reactiveValues()

  lapply(
    X = 1:6,
    FUN = function(i){
      observeEvent(input[[paste0("d", i)]], {
        vals[[paste0("slider", i)]] <- input[[paste0("d", i)]]
      })
    }
  )

  output$test <- renderPrint({
    reactiveValuesToList(vals)
  })
}
shinyApp(ui = ui, server = server)

失败的模块化代码：

library(shiny)

slidersUI <- function(id){
  ns <- NS(id)
  tagList(

  fluidRow(
    column(
      width = 6,
      lapply(
        X = 1:6,
        FUN = function(i) {
          sliderInput(inputId = paste0("d", i), label = i, min = 0, max = 10, value = i)
        }    ),
    column(
      width = 6,
      verbatimTextOutput(outputId = "test")
    )

    
  )))
}

slidersServer <- function(input, output, session){
  vals <- reactiveValues()

    lapply(
    X = 1:6,
    FUN = function(i){
      output$test2 <- renderText(paste0("this is i:", i))
      observeEvent(input[[paste0("d", i)]], {
        vals[[paste0("slider", i)]] <- input[[paste0("d", i)]]
      })
    }
  )
  
  output$test <- renderPrint({
    reactiveValuesToList(vals)
  })
  
}


library("shiny")
ui <- fluidPage(
  slidersUI("TheID")
  
)
server <- function(input, output){
  callModule(slidersServer, "TheID")
}
shinyApp(ui = ui, server = server)

谢谢！

4

1 回答 1

0

您需要包装您的 IDns以获得正确的命名空间。这是更正后的模块ui：

slidersUI <- function(id){
  ns <- NS(id)
  tagList(
    
    fluidRow(
      column(
        width = 6,
        lapply(
          X = 1:6,
          FUN = function(i) {
            sliderInput(inputId = ns(paste0("d", i)), label = i, min = 0, max = 10, value = i)
          }    ),
        column(
          width = 6,
          verbatimTextOutput(outputId = ns("test"))
        )
        
        
      )))
}
于 2021-01-14T17:13:15.030 回答