0

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)
Julian
  • 741
  • 8
  • 19
  • Whenever I need to do something more complex, like passing values back and forth, I usually end up moving the whole thing to the server side and then passing the rendered input to the ui. When you are in the server you can do all kinds of things, like what you did with the plot. You will probably need to make renderSliderCheckbox(). – Elin Nov 23 '18 at 15:35

2 Answers2

2

You can send the value from the ui to the server using a hidden textInput

library(shiny)
library(shinyjs)

sendValueToServer <- function(id, value) {
  hidden(textInput(
    id, "If you can see this, you forgot useShinyjs()", value
  ))
}

myModuleUI <- function(id, param) {
  ns <- NS(id)
  tagList(
    sendValueToServer(ns("param_id"), param),
    textOutput(ns("text_out"))
  )
}

myModule <- function(input, output, session) {
  param <- isolate(input$param_id)

  output$text_out <- renderText({
    param
  })
}

shinyApp(
  ui = fluidPage(
    useShinyjs(),
    myModuleUI("id", "test")
  ),
  server = function(input, output, session) {
    callModule(myModule, "id")
  }
)

There are probably more direct ways to do this using the JavaScript API of shiny but this is a "pure R" solution which should be enough for most usecases. Note that you can use the input value at initialization time with

isolate(input$text_in)

because the ui is always built before the server. Things get more complicated if everything is wrapped into renderUI but this does not seem to be the case for you.

Gregor de Cillia
  • 7,397
  • 1
  • 26
  • 43
  • Thankyou for the answer. In my real application the next step is to wrap everything into renderUI. So I would be glad if if you can explain a little bit more your last sentence? – Julian Nov 24 '18 at 19:29
  • 1
    If `myModuleUI` is part of an `uiOutput`, `input$text_in` won't be available when the app starts up. Your server logic will have to wait until the `renderUI` components are rendered (displayed) before fetching `input$text_in`. This can be quite tricky in practice and therefore I personally try to avoid `rednerUI` at the "top level" of my applications. – Gregor de Cillia Nov 24 '18 at 20:11
0

Somewhat late to the party, but I think a neater way to do this is to use session$userData. This is available to both the main server function and the module's sewrver function.

So, in the main server, before callModule creates the module server:

session$userData[["module_id"]]$defaultValue <- myDefaultValue

and then at the end of module server function:

return ( reactive({
  if (input$active){
      session$userData[["module_id"]]$defaultValue
    } else {
      input$sl
    }
  })
)

That strikes me as neater, more robust and more generic than using a hidden input.

Limey
  • 10,234
  • 2
  • 12
  • 32