Get a linear date Shiny slider input to "stick" on only specified irregular dates

Question

I am using a Shiny date slider but there are only certain dates with observations. When the user moves the slider I would like it to jump to the nearest observation date when released. I could use an index value to step through each observation but I want to preserve the spatial appearance of a linear timeline.

My hunch is to render the slider on the fly, updating the value parameter with the nearest available observation date whenever the inputId of the slider changes, but this creates a circular argument with inputId and value parameters.

The example below shows my attempt to avoid this circularity. Note that if you comment out value = ifelse(length(nearest_date()) > 0,nearest_date(),min(date_vec)), and replace it with value = min(date_vec), the code runs fine (just not what I want).

library(shiny)
#> Warning: package 'shiny' was built under R version 4.1.3

date_vec <- as.Date("2022-01-01") +
  cumsum(round(runif(10, 1, 20)))

ui <- fluidPage(uiOutput("jumpySlider"),
                mainPanel(textOutput("this_date"),
                          textOutput("desired_date")))

server <- function(input, output) {
  nearest_date <- reactive({
      date_vec[which.min(abs(as.numeric(input$date) - as.numeric(date_vec)))]
  })

  output$jumpySlider <- renderUI({
    sliderInput(
      "date",
      "Date",
      min = min(date_vec),
      max = max(date_vec),
      # value = min(date_vec),
      # PROBLEM LINE
      value = ifelse(length(nearest_date()) > 0,nearest_date(),min(date_vec)),
      animate = animationOptions(interval = 100)
    )
  })

  output$this_date <- renderText({
    paste("Slider Date:", format.Date(input$date))
  })
  output$desired_date <- renderText({
    paste("Desired Date:", format.Date(nearest_date()))
  })
}
shinyApp(ui = ui, server = server)

Shiny applications not supported in static R Markdown documents

^{Created on 2022-07-23 by the reprex package (v2.0.1)}

Answer 1

I am using observe to update the sliderInput to the closest date. The sliderInput "jumps" to the closest date after the input from the user.

library(shiny)

set.seed(2022)
date_vec <- as.Date("2022-01-01") + cumsum(round(runif(10, 1, 20)))

ui <- fluidPage(
        sliderInput(
        "date",
        "Date",
        min = min(date_vec),
        max = max(date_vec),
        value = min(date_vec)
        ),
        mainPanel(
          textOutput("this_date")
          )
)

server <- function(input, output, session) {
  
  observe({
    req(input$date)
     updateSliderInput(session, "date", 
       value = date_vec[which.min(abs(date_vec - input$date))])
  })
  
  output$this_date <- renderText({
    paste("Slider Date:", format.Date(input$date))
  })
}

shinyApp(ui = ui, server = server)