I have created a module sliderCheckbox
which bundles together a sliderInput
and a checkBoxInput
to disable the sliderInput - basically a possibility to state "I don't know", which is necessary for survey-like inputs. When the slider is disabled, I want it to return a default value - most often the initial value, but not necessarily.
Now my question is: Is there any possibility to pass this default value when initialising the UI, that is with sliderCheckboxInput()
? As the default value is a property like minimum and maximum, that is where it logically belongs to, and it also fits better to the rest of my setup.
Example:
library(shiny)
library(shinyjs)
sliderCheckboxInput <- function(id,description="",
min = 0,
max = 100,
value = 30,
default= NULL ##HERE I would want the default value to be set
cb_title = "I don't know"){
ns <- NS(id)
fluidRow(
column(width=9,
sliderInput(ns("sl"),
paste0(description, collapse=""),
min = min,
max = max,
value = value)
),
column(width=2,
checkboxInput(ns("active"),
cb_title, value=FALSE )
)
)
}
sliderCheckbox<- function(input, output, session,
default=NA) { #Problem: set default when initialising module
oldvalue<- reactiveVal()
observeEvent(input$active, {
if (input$active){
oldvalue(input$sl)
disable("sl")
updateSliderInput(session, "sl", value=default)
}else {
updateSliderInput(session, "sl", value=oldvalue())
enable("sl")
}
toggleState("sl", !input$active)
})
onclick("sl",
if(input$active) updateCheckboxInput(session, "active", value=FALSE)
)
return ( reactive({
if (input$active){
default
}else {
input$sl
}
}))
}
ui <- fluidPage(
useShinyjs(),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderCheckboxInput("bins", "Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output, session) {
bins_nr <- callModule(sliderCheckbox, "bins", default=44)
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = bins_nr() + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
shinyApp(ui, server)