thothal thothal - 3 months ago 10
R Question

observeEvent for several ui elements

Problem

On my UI I want to have a checkbox, which controls whether a certain slider is enabled. I use

toggleState
from
library(shinyjs)
to do so. I add an
observeEvent
and if the checkbox is clicked, the state is toggled - see attached example. So far so good. I could now copy paste the
observeEvent
for all checkbox / slider pairs, but I was wondering whether I can do something smarter. Is there a possibility to write a "parameterized"
observeEvent
function, which fires if any of the check boxes is clicked and uses the id of the checkbox clicked to determine which slider to activate?

Code

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

Perfect use case for modules and loops:

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)

edit: added label parameter to UI so I could dynamically name the label


edit2: Added a return statemend in the module and showed how you can extract the values from the sliders, since with modules that isn't totally straightforward.