dreamRs / shinyWidgets

shinyWidgets : Extend widgets available in shiny
https://dreamrs.github.io/shinyWidgets/
GNU General Public License v3.0
833 stars 153 forks source link

Feature request: allow two values for `knobInput()` (like `sliderInput()`) to visualize ranges wrapping variable limits #468

Open mlaparie opened 2 years ago

mlaparie commented 2 years ago

sliderInput allows setting ranges of values when two default values are set. This is great, but since both handles can never cross each other, the selected range can only be continuous. Say I have a vector 1:366 (like year days) or 1:24 (like day hours), then I can only select values within both ends of the interval. If you are interested in showing only winter temperatures, or night temperatures, then you are stuck. This would be the case with any types of cycles really. I see two workarounds with current tools:

Solution 1

Reverse the selection to forcibly include slider boundaries, and invert the coloration as well to show what part is selected. Say I need to study winter data regardless of the year, I'll need a range [330-366, 1-60] for instance. With some CSS to invert the slider coloration, this can be done with something like this:

    div(id = "reverseSlider",
    sliderInput("time1", "Sampling period (in year days):",
                min = 1,
                max = 366,
                value = c(max(subset(tmpdata()$Yday, tmpdata()$Yday <= 250)),
                          max(subset(tmpdata()$Yday, tmpdata()$Yday >= 251))
                          ),
                step = 1
    )
  )

ss-2022-01-16_235812

However, since slider handles cannot cross each other, there is no way to exclude 366 and 1 from the final range. If your users only wanted to visualize summer data, well then they can't and will have to study at least another season.

Solution 2

Use two "start" and "end" sliders with single value each and combine them. This way we can select 5 and 20 as hour of day for a range [5-20] for instance, and therefore analyse daytime data, or 20 and 5 and for a range [20-24, 1-5] and therefore nighttime.

6vp-B1frx-V1-Tdw1-Udr66b (Thanks rickyrick from #R on IRC for the example.)

The problem is it complicates the UI, which is not good from a user's perspective. Moreover, I don't know of any easy way to dynamically invert the coloration of a sliderInput() depending on the position of another sliderInput(), so it won't be straightforward to achieve the same red line as in the example above to help users check whether their input does what they want.

Solution 3 with the feature request

One way to solve all that is to allow handles to cross each other and dynamically reverse the coloration of the sliderInput(). I think this would mean a lot of coding and CSS hacks. Another way is to make circular slider whose range can be shifted regardless of the first and last value in the variable. I cannot say I am a big fan of circular slider in general, but this is mostly because they are used where it they don't bring extra value or don't have sane defaults.

The knobInput() could cover all above cases if it could take two values like sliderInput(). With sane defaults in the Shiny app, users may not always need to fiddle with it, and a dragRange = TRUE option as in sliderInput() would also allow moving the range without moving individual ends. One could for instance decide to show 90 days, and just spin the range it over the whole circle to study seasonal differences regardless of year limits.

mlaparie commented 2 years ago

Just to bring grist to the mill, for my immediate use I came up with something like this:

ss-2022-01-18_044207

   output$from <- renderUI({
      tags$style(type='text/css', CSS)
      div(id = "hollowSlider",
      setSliderColor(rep("#333333", 1000), 1:1000),
        sliderInput("from", "Sampling from (year day):",
                    min = 1,
                    max = 366,
                    value = ifelse(max(tmpdata()$Yday) >= 200,
                                   min(subset(tmpdata()$Yday, tmpdata()$Yday >= 200)),
                                   min(tmpdata()$Yday)),
                    ticks = FALSE,
                    step = 1
        )
      )
  })

  output$to <- renderUI({
    tags$style(type='text/css', CSS)
    div(id = "hollowSlider",
    setSliderColor(rep("#333333", 1000), 1:1000),
        sliderInput("to", "To (year day):",
                    min = 1,
                    max = 366,
                    value = ifelse(max(tmpdata()$Yday) >= 200,
                                   max(subset(tmpdata()$Yday, tmpdata()$Yday <= 199)),
                                   max(tmpdata()$Yday)),   
                    ticks = FALSE,
                    step = 1
        )
    )
  })

  observeEvent(input$resetfrom, {
    updateSliderInput(session,
                      "from",
                      value = ifelse(max(tmpdata()$Yday) >= 200,
                                     min(subset(tmpdata()$Yday, tmpdata()$Yday >= 200)),
                                     min(tmpdata()$Yday)))
  })

  observeEvent(input$resetto, {
    updateSliderInput(session,
                      "to",
                      value = ifelse(max(tmpdata()$Yday) >= 200,
                                     max(subset(tmpdata()$Yday, tmpdata()$Yday <= 199)),
                                     max(tmpdata()$Yday)))
  })

  tmpdata <- reactive({
    req(input$elevation)
    req(elevation())
    rawdata %>%
      filter(Generation %in% input$generation,
             Instar %in% input$instar,
             Tree %in% input$tree,
             Elevation %in% input$elevation[1]:input$elevation[2])
  })

  tmpdata2 <- reactive({
    req(input$from)
    req(input$to)
    req(input$elevation)
    req(elevation())
    if (input$from > input$to) {
    rawdata %>%
      filter(Generation %in% input$generation,
             Instar %in% input$instar,
             Tree %in% input$tree,
             Elevation %in% input$elevation[1]:input$elevation[2],
             Yday %in% c(1:input$to, input$from:366)
      )
    } else {
    rawdata %>%
      filter(Generation %in% input$generation,
             Instar %in% input$instar,
             Tree %in% input$tree,
             Elevation %in% input$elevation[1]:input$elevation[2],
             Yday %in% c(input$to:input$from)
      )
    }
  })

  elevation <- reactive(function() {
    if (is.null(input$elevation))
      "0"
    else
      input$elevation
  })

However this implies some weirdly complicated logic and hair pulling (I'm sure it can be improved and simplified but I have not found how yet), and the UI may not be completely straightforward to users. Plus I set a split at the 200th year day because I know I will never have data at this time of the year for this data set, but for other cyclic data, hardcoding a split would be impossible.