I'm having trouble with R:Shiny and the observeEvent function

Question

I'm building a shiny app and having trouble with my observeEvent function. Unfortunately, it is supposed to work by slider input for dates. The app runs but when I change the date on the slider the same data keeps popping up over and over again. I believe its only the first couple of rows that are showing over and over again.

this is my full code:

ui <-  bootstrapPage(
  tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}","html, body {width:100%;height:100%}"),
  leafletOutput("map"),
  absolutePanel(top = 10, right = 10,
                sliderInput("dateRange",
                             "Dates:",
                             min = as.Date("2020-01-01","%Y-%m-%d"),
                             max = as.Date("2020-12-01","%Y-%m-%d"),
                             value=as.Date("2020-12-01"),
                             timeFormat="%Y-%m-%d")
                            
        
  )
)


server <- function(input, output) {
  
  result_data$Change1<- cut(result_data$Change, 
                          c(-1,0,1,2,3,4), include.lowest = T,
                          labels = c('increasing', 'decreasing', 'undetectable','no data','test'))
  
  
  beatCol <- colorFactor(palette = 'RdYlGn', result_data$Change1)
  
  


  map=leaflet() %>%
      addProviderTiles(providers$Esri.WorldStreetMap) %>%
      setView(lat = 47.2529, lng = -122.4443, zoom = 10) %>%
      
  #overlay groups
      addLayersControl(
          overlayGroups = c("Basins","Testing sites", "WWTP"),
          position = c("bottomright"),
          options = layersControlOptions(collapsed = FALSE))
  
 
  observeEvent(input$dateRange,
               {
                 leafletProxy("map") %>% 
                   clearMarkers()%>%
                   addCircleMarkers(data = result_data, unique(result_data$Change), 
                                    lat = as.numeric(result_data$Latitude), 
                                    lng = as.numeric(result_data$Longitude), 
                                    weight = 1, 
                                    radius = 10,
                                    fillOpacity = 0.1, 
                                    color = ~beatCol(Change1),
                                    label = ~ as.character(Site),
                                    popup = ~ as.character(Site),
                                    
                                    )
  
               }
               
  )
  
  output$map <- renderLeaflet({

    map
    
  })
  
}

shinyApp(ui, server)

I've tried to fix it by doing this instead with the observeEvent function.

 rv <- reactiveValues(
     filteredData =result_data,
     ids = unique(result_data$Change)
   )

   observeEvent(input$dateRange,
                {
                  leafletProxy("map") %>%
                    clearMarkers()%>%
                    addCircleMarkers(data = subset(rv$filteredData, Change == rv$ids),
                                     lat = as.numeric(rv$filteredData$Latitude),
                                     lng = as.numeric(rv$filteredData$Longitude),
                                     weight = 1,
                                     radius = 10,
                                     fillOpacity = 0.1,
                                     color = ~beatCol(Change1),
                                     label = ~ as.character(Site),
                                     popup = ~ as.character(Site),

                                  )
               }
  )

I still get the same issue.

A snippet of the dataset that observeEvent is pulling from:

Site    Change          Date        Latitude    Longitude
Basin C04 (MH-6761957)  1   2020-05-22  47.23513    -122.40374
Basin C04 (MH-6761957)  2   2020-05-29  47.23513    -122.40374
Basin C04 (MH-6761957)  2   2020-06-05  47.23513    -122.40374
Basin C04 (MH-6761957)  1   2020-06-12  47.23513    -122.40374
Basin C04 (MH-6761957)  2   2020-06-19  47.23513    -122.40374
Basin C04 (MH-6761957)  2   2020-06-25  47.23513    -122.40374
Basin C04 (MH-6761957)  1   2020-07-02  47.23513    -122.40374
Basin C04 (MH-6761957)  2   2020-07-09  47.23513    -122.40374
Basin C04 (MH-6761957)  2   2020-07-16  47.23513    -122.40374
Basin C04 (MH-6761957)  1   2020-07-23  47.23513    -122.40374
Basin C04 (MH-6761957)  1   2020-07-30  47.23513    -122.40374
Basin C09 (MH-6754884) alt site 0   2020-05-15  47.22362    -122.442
Basin C09 (MH-6754884) alt site 0   2020-05-22  47.22362    -122.442
Basin C09 (MH-6754884) alt site 0   2020-05-29  47.22362    -122.442
Basin C09 (MH-6754884) alt site 0   2020-06-05  47.22362    -122.442
Basin C09 (MH-6754884) alt site 1   2020-06-12  47.22362    -122.442
Basin C09 (MH-6754884) alt site 2   2020-06-19  47.22362    -122.442
Basin C09 (MH-6754884) alt site 0   2020-06-25  47.22362    -122.442
Basin C09 (MH-6754884) alt site 0   2020-07-02  47.22362    -122.442
Basin C09 (MH-6754884) alt site 0   2020-07-09  47.22362    -122.442
Basin C09 (MH-6754884) alt site 0   2020-07-16  47.22362    -122.442
Basin C09 (MH-6754884) alt site 0   2020-07-23  47.22362    -122.442

I am just getting the first date for each site and then it never changes.

Answer 1

If you are looking for date range, then you need to specify two dates in value in the sliderInput . Then use the dates to filter your data in a reactive prior to mapping. Try this

ui <-  bootstrapPage(
  tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}","html, body {width:100%;height:100%}"),
  leafletOutput("map"),
  #DTOutput("tb1"),
  absolutePanel(top = 10, right = 10,
                sliderInput("dateRange",
                            "Dates:",
                            min = as.Date("2020-01-01","%Y-%m-%d"),
                            max = as.Date("2020-12-01","%Y-%m-%d"),
                            value = c(as.Date("2020-07-02"), as.Date("2020-07-16")),
                            timeFormat="%Y-%m-%d")
  )
)


server <- function(input, output) {
  
  result_data$Change1<- cut(result_data$Change, 
                            c(-1,0,1,2,3,4), include.lowest = T,
                            labels = c('increasing', 'decreasing', 'undetectable','no data','test'))
  
  beatCol <- colorFactor(palette = 'RdYlGn', result_data$Change1)
  
  rv <- reactive(
    filteredData  <- filter(result_data, Date >= input$dateRange[1] & Date <= input$dateRange[2])
  )
  
  output$tb1 <- renderDT(rv())
  
  map=leaflet() %>%
    addProviderTiles(providers$Esri.WorldStreetMap) %>%
    setView(lat = 47.2529, lng = -122.4443, zoom = 10) %>%
    
    #overlay groups
    addLayersControl(
      overlayGroups = c("Basins","Testing sites", "WWTP"),
      position = c("bottomright"),
      options = layersControlOptions(collapsed = FALSE))
  
  
  observeEvent(input$dateRange, {
                 result_dataa <- rv()
                 leafletProxy("map") %>%
                   clearMarkers()%>%
                   addCircleMarkers(data = result_dataa, unique(result_dataa$Change),
                                    lat = as.numeric(result_dataa$Latitude),
                                    lng = as.numeric(result_dataa$Longitude),
                                    weight = 1,
                                    radius = 10,
                                    fillOpacity = 0.1,
                                    color = ~beatCol(Change1),
                                    label = ~ as.character(Site),
                                    popup = ~ as.character(Site),

                   )
               })

  output$map <- renderLeaflet({
    map
  })
  
}

shinyApp(ui, server)