Jon Thnarfsson Jon Thnarfsson - 4 months ago 92
R Question

Create dynamic UI using R/Shiny where user input toggles parameter from a constant to a range

I'm new to Shiny and making an app where the output will ultimately be a plot of points produced using a function evaluated over a user-imposed range of variation in the x-axis parameter. There are 20 possible parameters from which the user can choose 1 to impose as x, but the rest of these parameters are also used by the function as single values. I want to make the app such that:


  1. All of the 20 variables are visible in the app as single-value sliders

  2. The user can change 1 of these single-value sliders at a time to a range slider by selecting the name of the parameter pertinent to the slider from a drop-down list

  3. Only 1 slider at a time can be a range slider, meaning that a slider previously selected to produce a range of values should revert to some single default value when a different slider is selected to produce a range



So far I have succeeded in only producing one slider that can be manipulated using the drop-down list. In ui.R, I simple have
uiOutput("ui")
, while in server.R:

server <- shinyServer(function(input, output) {
var <- reactive(switch(input$var_param,
"K_As1" = (value <- c(10,20)),
"K_Ap1" = (value <- c(10,15))
))

output$ui <- renderUI({
# Depending on input$var_param, we'll generate a different
# slider component and reload it with a range.
sliderInput("ui", label = input$var_param, 0, 50, var())
})
})


So I'm fairly stuck with this. In order to have the single-value default sliders, it seems like it would be necessary to write this into ui.R; however, that means they cannot be dynamic as ui.R is run only once when the app is launched. It may be necessary to use
if
statements, perhaps? Any pointers on where to go from here?

Answer

There are different ways to create a dynamic UI with shiny. Here is one possible solution for your problem. The main idea is to use a reactive variable to store the the name of the selected variable. Only the selected variable in the selectInput will have a range slider and the remaining variables will have a single value sliders with a default value. An associated observer with the selectInput will change the name of the selected variable and the rangeUI will be rendered again.

I hope it could help you to build you dynamic UI.

library(shiny)

ui <- fluidPage(
  fluidRow(
    column(6, uiOutput('controls')),
    column(6, plotOutput('plot1', height = 500))
  )
)

server <- shinyServer(function(input, output, session) {
  # define the data frame to use
  dat <- mtcars
  # name of available data frame
  varNames <-  names(dat)
  # define defaul values as the first value in each column
  defaultValues <- as.numeric(dat[1,])
  # store the selected variable in a reactive variable 
  rv <- reactiveValues(selected = varNames[1])

  # dynamically creates a set of buttons and sliders
  output$controls <- renderUI({
    div(
      fluidRow(
        column(3, 
          selectInput("select", "Variables", varNames, selected=varNames[1])
        ),
        column(9, uiOutput("rangeUI"))
      )
    )
  })

  output$rangeUI <- renderUI({
    lapply(1:length(varNames), function(k) {
      # get min and max value
      minmax <- c(round(min(dat[[varNames[k]]])), round(max(dat[[varNames[k]]])) )
      fluidRow(
        column(12,
          if (rv$selected == varNames[k]) {
            # a slider range will created only is the variable is selected
            sliderInput(paste0("slider_", varNames[k]), label = varNames[k], 
              min = minmax[1], max = minmax[2], value = minmax)
          } else {
            # otherwise uses single value with a default value
            sliderInput(paste0("slider_", varNames[k]), label = varNames[k], 
              min = minmax[1], max = minmax[2], value = defaultValues[k])
          }
        )
      )
    })
  })

  observeEvent(input$select, {
    # changes in this variable will make the UI "controls" to be rendered again
    rv$selected <- input$select
  })

  # plot dat
  output$plot1 = renderPlot({
    # get the correct id name for the current slider
    id <- paste0("slider_", rv$selected)
    cat("id", id, "\n")
    # get the value from the input
    val = input[[id]]
    # plot all points of the selected variable
    plot(dat[,rv$selected])
    # fill out the points that are greater or equal to the value
    points(dat[ dat[,rv$selected] >= val, rv$selected, drop = FALSE], pch = 19, cex = 2)
  })

})

shinyApp(ui, server)