Shiny Slider Customized Values

Shiny Slider Customized Values

The shinyWidgets package now solves this for you with a slider that allows custom values. Updated code for your third slider would look like this:

shinyWidgets::sliderTextInput(inputId = "decade", 
  label = "Time (decade):", 
  choices = c(1,5,10,15,20,25,30))

custom values in slider input shiny

You could use something like a log scaling to determine where you sample points from, e.g.:

x <- log(seq(1,100,length.out=24))
scx <- scale(x,center=min(x),scale=diff(range(x)))
out <- round(scx * length(sequence))
out[1] <- 1

sequence[out]
# [1] 1600 1749 1802 1836 1860 1879 1895 1908 1920 1930 1939 1948 1955
#[14] 1962 1969 1975 1981 1986 1991 1996 2001 2005 2009 2013

It's not exactly what you are asked for, but it approximates it. If you change the function to use something other than log you may be able to get closer to your exact request.

Set sliderInput values as characters in shiny

Thanks @daattli for pointing me the right direction and letting me know how to use js to change the shiny element.

I have implemented a solution to change labels of sliderInput and a selectInput to switch different values (and length). I think this feature should be implemented into shiny which uses ionRangeSlider.

Please improve my codes if you think there is a better way to implement it, as it is my first js script.

library(shiny)
values <- list(A = c('A1', 'A2', 'A3'),
               B = c('B1', 'B2', 'B3', 'B4'))

ui <- shinyUI(bootstrapPage(
    selectInput('selection', 'selection', c('A',  'B'), 'A'),
    uiOutput('selectUI'),
    sliderInput(inputId = "target", label = "Target",
                min = 0, max = length(values$A) - 1,
                step = 1,
                value = length(values$A) - 1),
    verbatimTextOutput('summary')
))

server <- shinyServer(function(input, output, session) {
    output$summary <- renderPrint({
        print(input$target)
        print(values[[input$selection]][input$target + 1])
    })
    output$selectUI <- renderUI({

        sel_values <- paste(paste0('"', values[[input$selection]], '"'), collapse = ',')
        print(sel_values)
        list(
            (HTML(
                sprintf('
                        <script type="text/javascript">
                        $(document).ready(function() {
                        var vals = [%s];
                        $(\'#target\').data(\'ionRangeSlider\').update(
                        {values:vals,
                        min: 0,
                        max: %s,
                        from:%s})
                        })
                        </script>
                        ', sel_values, 
                        length(values[[input$selection]]) - 1,
                        length(values[[input$selection]]) - 1)))
        )}
    )}
)

shinyApp(ui = ui, server = server)

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

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)

r shiny sliderInput with exact values instead of evenly divided range

I think the sliderTextInput from shinyWidgets does what you want. Though on the slider, all values are equally separated and not proportionnally.

library(shiny)
library(shinyWidgets)

ui <- fluidPage(
  
  sliderTextInput(
    inputId = "myslider",
    label = "Choose a value:", 
    choices = c(2,3,5,7,11,13,17,19,23,29,31),
    grid = TRUE
  )
)

server <- function(input, output, session) {
  observe(print(input$myslider))
}

shinyApp(ui, server)

Unique values for slider range R Shiny

You can use sliderTextInput for that as well. It has choices argument which can take all the unique values that you want to show and selected argument which will show the first range selected by default.

library(shiny)
library(shinyWidgets)

df<- data.frame("ID" = c("001","001","001"), "date" = as.POSIXct(c("2020-07-01 01:00:00","2020-07-01 03:00:00","2020-07-01 06:00:00")))
df

server <- function(input, output, session) {
}

ui <- navbarPage(
  tabPanel("Analysis",
           sidebarLayout(
             sidebarPanel(width = 5,
                          selectInput("selectVariable", "Select an ID:",
                                      choices =  unique(df$ID)),
                          sliderTextInput("month",
                                          "Date Range Correct:",
                                          choices =  sort(unique(df$date))), 
                          sliderTextInput('falltime',"Slider Incorrect Date Range:", 
                                      choices =  unique(df$date), selected = range(df$date)
                          
                          )), 
             mainPanel(h2("Uploaded Data")))
  )
  
) 
shinyApp(ui, server)

Customize `sliderInput()` appearance

do you want something like this? Make sure to adjust your width accordingly

library(shiny)
ui <- fluidPage(
  sliderInput('slider', 
              label = div(style='width:500px;', 
                          div(style='float:left;', 'I totally disagree'), 
                          div(style='float:right;', 'I totaly aggree')), min = 0, max = 10, value = 7, width = '500px')

)

server <- function(input, output) {}
shinyApp(ui, server)

---

Related Topics