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??

CodePudding user response：

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)