r - 多个 ui 元素的观察事件

Question

问题

在我的用户界面上，我想要一个复选框，它控制是否启用某个 slider 。我使用 library(shinyjs) 中的 toggleState 来执行此操作。我添加了一个observeEvent，如果单击该复选框，则会切换状态 - 请参阅随附的示例。到目前为止，一切都很好。我现在可以复制粘贴所有复选框/ slider 对的observeEvent，但我想知道是否可以做一些更聪明的事情。是否可以编写一个“参数化”observeEvent 函数，该函数在单击任何复选框时触发，并使用单击的复选框的 ID 来确定要激活哪个 slider ？

代码

library(shiny)
library(shinyjs)
ui <- shinyUI(fluidPage(
   useShinyjs(),
   fluidRow(
      column(width = 6, checkboxInput("id1.ckb", "Click to activate Slider 1")),
      column(width = 6, sliderInput("id1.sld", "Choose:", min = 1, max = 30, value = 2,
                                    step = 1))       
   ),
   fluidRow(
      column(width = 6, checkboxInput("id2.ckb", "Click to activate Slider 2")),
      column(width = 6, sliderInput("id2.sld", "Choose:", min = 1, max = 30, value = 2,
                                step = 1))       
   ),
   fluidRow(
      column(width = 6, checkboxInput("id3.ckb", "Click to activate Slider 3")),
      column(width = 6, sliderInput("id3.sld", "Choose:", min = 1, max = 30, value = 2,
                                step = 1))       
   ),
   fluidRow(
      column(width = 6, checkboxInput("id4.ckb", "Click to activate Slider 4")),
      column(width = 6, sliderInput("id4.sld", "Choose:", min = 1, max = 30, value = 2,
                                step = 1))       
   )
)
)

server <- shinyServer(function(input, output) {
   observeEvent(input$id1.ckb, {
      toggleState("id1.sld")
   })
})

shinyApp(ui=ui,server=server)

Answer 1

模块和循环的完美用例:

library(shiny)
library(shinyjs)

boxSliderUI <- function(id, label="Click to activate Slider") {
  ns <- NS(id)
  tagList(
    fluidRow(
      column(width = 6, checkboxInput(ns("ckb"),label)),
      column(width = 6, sliderInput(ns("sld"), "Choose:", min = 1, max = 30, value = 2,
                                    step = 1))       
    ))
}

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

  observeEvent(input$ckb, {
    toggleState("sld")
  })

  value <- reactive(input$sld)

  return(value)
}


ui <- shinyUI(fluidPage(
  useShinyjs(),
  lapply(1:4,function(i) boxSliderUI(paste0("id",i),paste0("Click to activate Slider ",i))),
  verbatimTextOutput("return")
)
)

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

  vals <- lapply(1:4,function(i) callModule(boxSlider,paste0("id",i)))

  output$return <- renderPrint(lapply(1:4,function(i) vals[[i]]()))

})

shinyApp(ui=ui,server=server)

编辑:向 UI 添加标签参数，以便我可以动态命名标签

---

edit2:在模块中添加了返回语句，并展示了如何从 slider 中提取值，因为模块并不完全简单。