Question

问题

在我的UI上，我想要一个复选框，它控制是否启用某个滑块。我使用toggleState中的library(shinyjs)来执行此操作。我添加observeEvent，如果单击该复选框，则切换状态 - 请参阅附加示例。到现在为止还挺好。我现在可以复制粘贴observeEvent所有复选框/滑块对，但我想知道我是否可以做更聪明的事情。是否有可能写一个＆＃34;参数化＆＃34; observeEvent函数，如果单击任何复选框，则会触发该函数并使用单击复选框的ID来确定要激活的滑块？

代码

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：在模块中添加了一个返回状态修正，并展示了如何从滑块中提取值，因为模块并不是非常简单。

observeEvent用于几个ui元素

1 个答案: