roarkz roarkz - 2 years ago 56
R Question

Dynamically update position of sliderInput in Shiny

I have the following code to dynamically make either Check Boxes or Sliders.

server <- shinyServer(function(input, output, session) {
# define the data frame to use
dat <- mtcars
dat <- rownames_to_column(dat, "car")
# name of availale 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


# dynamically creates a set of sliders
output$controls <- renderUI({
div(
fluidRow(
column(9, uiOutput("rangeUI"))
)
)
})

output$rangeUI <- renderUI({
lapply(1:length(varNames), function(k) {
fluidRow(
column(12,
if (is_character(dat[1, k])) {
# a slider range will created only is the variable is selected


checkboxGroupInput(paste0("slider_", varNames[k]), label = varNames[k], choices = unique(dat[[k]]), selected = NULL,
inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL)
} else {
# otherwise uses single value with a default value
sliderInput(paste0("slider_", varNames[k]), label = varNames[k],
min = 0, max = 100, value = defaultValues[k])
}
)
)
})
})


The issue I am running into is that I would like to display the sliders and check boxes side by side until they hit the screen width and then start a new row. Currently, they are all in one column.

Is there a good way to dynamically adjust
offset
to accomplish this, maybe something like this?

column(12, offset = match(k, colnames(dat)), # then lead into the if else statement


Any other suggestions on building the UI are welcome.

Answer Source

Try to put the fluidRow outside the lapply and change the size of the column from 12 to maybe 3, otherwise you are creating multiple rows with only one column, instead on one row with multiple columns.

Below is your code modified, maybe it could help you.

library(shiny)
library(tibble)
ui <- fluidPage(
  uiOutput("controls")
)

server <- shinyServer(function(input, output, session) {
  # define the data frame to use
  dat <- mtcars
  dat <- rownames_to_column(dat, "car")
  # name of availale 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 

  # dynamically creates a set of sliders
  output$controls <- renderUI({
    fluidRow(
      column(offset = 3, 9, uiOutput("rangeUI"))
    )
  })
  # to test that a dynamically created input works with an observer
  observeEvent(input$slider_mpg, {
    cat("slider_mpg:", input$slider_mpg, "\n")
  })
  output$rangeUI <- renderUI({
    fluidRow(
      lapply(1:length(varNames), function(k) {
        column(3,
          if (is.character(dat[1, k])) {
            # a slider range will created only is the variable is selected
            checkboxGroupInput(paste0("slider_", varNames[k]), label = varNames[k], choices = unique(dat[[k]]), selected = NULL,
                              inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL)
          } else {
            # otherwise uses single value with a default value
            sliderInput(paste0("slider_", varNames[k]), label = varNames[k], 
                       min = 0, max = 100, value = defaultValues[k])
          }
        )
      })
    )
  })
})

shinyApp(ui = ui, server = server)

Update:

You can get the values of dynamically created inputs by using an action button as is explained here or get them automatically by using the solution explained here.

Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download