Update date in sliderInput by dateInput r shiny

[Paul_Bertens]

I have a shiny dashboard with two pages. Default is page 1 with a dateInput and a table. Page 2 is a page with a sliderInput and a plot. With a input$map_marker_click on a leaflet map, page 2 is shown. I my example below, I changed the input$map_marker_click for a materialSwitch.

This is what I want:

1. Select a date with the dateInput (input$date) to show a table with the results of a research on the selected date.
2. When I click on the materialSwitch the input$slide[2] is updated to the value of input$date
3. The default range on sliderInput is 5 months. This range can only be changed by sliding input$slide[1] to another date. Sliding input$slide[2], the calculated range doesn't change
4. When I click on the materialSwitch again, input$date is updated to the value of input$slide[2]

Step 2 works in my code. Step 3 and 4 doesn't work.

Here is my code. It only shows the dateInput and slider functionality:

library(shiny)
library(shinyWidgets)
library(lubridate)

# Function detail_menu_HTML
detail_menu_HTML <- function(back_link = "", title = "", subtitle = "", top_row = "", middle_row = "", bottom_row = "") {
  div(
    fluidRow(back_link, title),
    fluidRow(subtitle),
    fluidRow(top_row),
    fluidRow(middle_row),
    br(),
    fluidRow(bottom_row)
  )
}

ui <- fluidPage(
  column(
    width = 12,
    uiOutput("right_screen", width = "100%"),
    materialSwitch(inputId = "switch1", label = "DateSlider"), # To switch between table an plot
    textOutput(outputId = "text1"),
    textOutput(outputId = "text2"),
    textOutput(outputId = "text3"),
    textOutput(outputId = "text4")
  )
)


server <- function(input, output, session) {
  ##### reactiveValues
  difference <- reactiveValues(months = 5)
  
  ##### uiOutput
  output$right_screen <- renderUI({
    sliderIn <- sliderInput(inputId =  "slide",
                label = "Select a date range",
                min = as.Date("2015-01-01"),
                max = Sys.Date(),
                value = c(Sys.Date() %m-% months(5, FALSE), Sys.Date()),
                width = "95%")
    
    dateIn <- dateInput(inputId =  "date",
              label = "Input Date",
              value = Sys.Date(),
              language = "nl"
              )
    
    if(input$switch1){
      # In this page you can select a date range for the axis of a plot
      return(detail_menu_HTML(h2("Page where I use the SliderInput for selecting date range"),
                              top_row = sliderIn,
                              bottom_row = h3("here comes the plot")
      ))
    } else {
      # In this page  a table is shown with results from that date
      return(detail_menu_HTML(h2("Page where I use the dateInput for selecting date"),
                              top_row = dateIn,
                              middle_row = h3("here comes the table")
      ))
    }
  })
  
  ##### TextOutput
  # Just to return the values of slider and dateInput to see what happens
  output$text1 <- renderText({
    paste("value input$date:", input$date)
  })
  output$text2 <- renderText({
    paste("value input$slide[1]:", input$slide[1])
  })
  output$text3 <- renderText({
    paste("value input$slide[2]:", input$slide[2])
  })
  output$text4 <- renderText({
    paste("reactiveValues difference$months:", difference$months)
  })
  
  ##### Observers
  observeEvent(input$slide[1], {
    # Only when input$slide[1] is changed
    req(input$date)
    month_end <- input$date
    month_start <- input$slide[1]
    difference$months <- round(as.numeric(month_end - month_start)/30)
  })

  observe({
    # sync enddate sliderInput (input$slide[2]) with input$date
    req(input$date)
    
    date_start <- input$date %m-% months(difference$months, FALSE)

    updateSliderInput(session,
                      inputId = "slide",
                      value = c(date_start, input$date)
                      )

  })

  observe({
    # sync input$date with enddate sliderInput (input$slide[2])
    updateDateInput(session,
                    inputId = "date",
                    value = input$slide[2]
                    )
  })
}

shinyApp(ui, server)

Appreciate any help and suggestions!

[woodward]

I had a quick try. The only thing I can think of immediately is that input$slide[1] and input$slide[2] are not treated as separate variables and are triggering the wrong things. I could be wrong. What if you put

sliderstart <- reactive({input$slide[1]})
sliderend <- reactive({input$slide[2]})

and use these ?

[Paul_Bertens]

Thanks for your quick reaction. I tried your solution.
I got a warning error:

Warning: Error in as.Date.default: do not know how to convert 'x' to class “Date”.

I have the feeling that the if/else statement doesn't trigger the updateSliderInput and updateDateInput.

When I add "middle_row = dateIn," to the detail_menu_HTML in the if-statement the updateSliderInput and updateDateInput works for that page, but it doesn't trigger the dateInput on the other page.

if(input$switch1){
      # In this page you can select a date range for the axis of a plot
      # req(sliderstart)
      # req(sliderend)
      return(detail_menu_HTML(h2("Page where I use the SliderInput for selecting date range"),
                              top_row = sliderIn,
                              middle_row = dateIn,
                              bottom_row = h3("here comes the plot")
      ))
    } else {
      # In this page  a table is shown with results from that date
      return(detail_menu_HTML(h2("Page where I use the dateInput for selecting date"),
                              top_row = dateIn,
                              middle_row = h3("here comes the table")
      ))
    }

[woodward]

You need as.Date("2015-01-01", "%Y-%m-%d")

[Paul_Bertens]

Unfortunately, the values aren't updating. When I switch between the two pages with the switch the dateInput or sliderInput starts with the default values.

[woodward]

Everytime input$switch1 changes it will refresh output$right_screen. You don't want that. Initialise the controls (date and slide) once. Then use updateXXX to update them when you need to .

You have to think about shiny backwards. The observers (e.g. plots, tables) are watching to see if their inputs change.

At the same time, the user can cause ui inputs$xxx to change.

In the middle are your own reactive objects.

observers -> reactive_objects -> inputs$xxx