How to fetch the dynamic slider values in r shiny app?

Viewed 28

I stuck in printing dynamic slider values. In the following code I tried to print the dynamic slider values but it's not possible.

library(shinydashboard)
library(DT)

ui <- dashboardPage(
  dashboardHeader(title = "Dynamic slider"),
  dashboardSidebar(
    tags$head(
      tags$style(HTML('.skin-blue .main-sidebar {
                      background-color: #666666;
                      }'))
    ),
    sidebarMenu(
      menuItem("Input data", tabName = 'input_data')
      
    ),
    fileInput(
      "file",
      "Choose CSV File",
      accept = c("text/csv",
                 "text/comma-separated-values,text/plain",
                 ".csv")
    ),
    checkboxInput("header",
                  "Header",
                  value = TRUE),
    radioButtons(
      "disp",
      "Display",
      choices = c(Head = "head",
                  All = "all"),
      selected = "head"
    ),
    sliderInput(
      inputId = 'slr',
      label = 'Slider range',
      min = 0,
      max = 3,
      value = c(0.5,3),
      step = 0.5
    ),
    selectInput(
      inputId = 'var',
      label = 'Variables',
      'Names',
      multiple = TRUE
    ),
    uiOutput('sliders')
  ),
  
  dashboardBody(tabItems(
    tabItem(tabName = 'input_data',
            fluidRow(
              box(width = 12,
                  dataTableOutput('table'),
                  title = 'Raw data'),
              box(width = 6,
                  verbatimTextOutput('slider1'),
                  title = 'slider range'),
              box(width = 6,
                  verbatimTextOutput('slider2'),
                  title = 'dynamic slider value')
            )
    )
    ))
)

server <- function(input, output) {
  dataset <- reactive({
    req(input$file)
    read.csv(input$file$datapath,header = input$header)
  })
  
  observe(
    output$table <- DT::renderDataTable({
      if (input$disp == 'head') {
        head(dataset())
      }
      else{
        dataset()
      }
    })
  )
  
  observe({
    updateSelectInput(inputId = 'var',choices = c(' ',names(dataset())))
    
  })
  
  variables <- reactive({
    input$var
  })

  sli <- reactive({
    lapply(1:length(variables()), function(i){
      inputName <- variables()[i]
      sliderInput(inputName, inputName,
                  min = 0, max = 1, value = c(0.3,0.7))
    })
  })
  
  output$sliders <- renderUI({
    do.call(tagList,sli())
    
  })
  output$slider1 <- renderPrint({
    input$slr
  })
  
  output$slider2 <- renderPrint({
   sli()
  })

}

shinyApp(ui = ui, server = server)

Any suggestions will be appreciated, Is there any other method to get dynamic sliders based on selected variables or How can we get the values of the dynamic slider here??

1 Answers

There may be better ways to structure your app, but here is a solution that follows your general approach. There are 4 modifications to what you already have:

  1. There is no need to define the reactive variables when you can just use input$var directly. The proposed solution eliminates this reactive.

  2. Using req(input$var) will prevent components dependent on that selectInput from trying to render when a selection has not been made.

  3. Since input$var defines the id of the dynamic slider, you can use this to retrieve the slider's values (i.e., input[[input$var]]).

  4. Since you have specified "multiple = TRUE", a few nested paste statements are used to create a single string representing the values of all (potentially multiple) dynamic sliders.

The below app includes these modifications, and I believe, achieves what you are trying to accomplish.

library(shinydashboard)
library(DT)

ui <- dashboardPage(
  dashboardHeader(title = "Dynamic slider"),
  dashboardSidebar(
    tags$head(
      tags$style(HTML('.skin-blue .main-sidebar {
                      background-color: #666666;
                      }'))
    ),
    sidebarMenu(
      menuItem("Input data", tabName = 'input_data')
      
    ),
    fileInput(
      "file",
      "Choose CSV File",
      accept = c("text/csv",
                 "text/comma-separated-values,text/plain",
                 ".csv")
    ),
    checkboxInput("header",
                  "Header",
                  value = TRUE),
    radioButtons(
      "disp",
      "Display",
      choices = c(Head = "head",
                  All = "all"),
      selected = "head"
    ),
    sliderInput(
      inputId = 'slr',
      label = 'Slider range',
      min = 0,
      max = 3,
      value = c(0.5,3),
      step = 0.5
    ),
    selectInput(
      inputId = 'var',
      label = 'Variables',
      'Names',
      multiple = TRUE
    ),
    uiOutput('sliders')
  ),
  
  dashboardBody(tabItems(
    tabItem(tabName = 'input_data',
            fluidRow(
              box(width = 12,
                  dataTableOutput('table'),
                  title = 'Raw data'),
              box(width = 6,
                  verbatimTextOutput('slider1'),
                  title = 'slider range'),
              box(width = 6,
                  verbatimTextOutput('slider2'),
                  title = 'dynamic slider value')
            )
    )
  ))
)

server <- function(input, output) {
  dataset <- reactive({
    req(input$file)
    read.csv(input$file$datapath,header = input$header)
  })
  
  observe(
    output$table <- DT::renderDataTable({
      if (input$disp == 'head') {
        head(dataset())
      }
      else{
        dataset()
      }
    })
  )
  
  observe({
    updateSelectInput(inputId = 'var',choices = c(' ',names(dataset())))
  })
  
  sli <- reactive({
    lapply(1:length(input$var), function(i){
      inputName <- input$var[i]
      sliderInput(inputName, inputName,
                  min = 0, max = 1, value = c(0.3,0.7))
    })
  })
  
  output$sliders <- renderUI({
    req(input$var)
    do.call(tagList,sli())
    
  })
  output$slider1 <- renderPrint({
    input$slr
  })
  
  output$slider2 <- renderPrint({
    req(input$var)
    paste(
      sapply(
        input$var, 
        function(x) {
          paste(x, paste(input[[x]], collapse = ', '), sep = ': ')
        }
      ), 
      collapse = '; '
    )
  })
}

shinyApp(ui = ui, server = server)
Related