2 observer doesn't display at the same time

Hi everyone,
I don't succeed to have a link between a sliderInput with hours and a reactive in order to change the hour range in my plot... can somebody help me ? thanks a lot :slightly_smiling_face:

library(leaflet) #carte
library(plyr)
library(dplyr)
library(stringr)
library(tidyverse)
library(hms)
library(shinyWidgets)

heure <- c("15:16:00","17:56:00","18:17:00","20:00:00","21:00:00","22:22:00")

df <- data_frame(
  heure = as_hms(heure),
  latitude =c(46.50253,46.24055,46.22687,46.22042,46.20115,46.16915),
  longitude = c(-1.788917,-1.360150,-1.337583,-1.317250,-1.279983,-1.245900),
  vitesse =c(5.54,7.23,2.28,3.92,7.23,5.20),
  angle = c(231,290,332,223,283,220)
)

ui <- fluidPage(
 
            leafletOutput("carte"),
   
            sliderInput(
             inputId = "periode",
             label = "Période  de temps",
             min = as.POSIXct("00:00:00",format = "%H:%M:%S"),
             max = as.POSIXct("24:00:00",format = "%H:%M:%S"),
             value = c(as.POSIXct("10:00:00",format = "%H:%M:%S"), as.POSIXct("23:59:59",format = "%H:%M:%S")),
             timeFormat = "%H:%M:%S",
             step=60),
           
           actionBttn(inputId = "viz",
                      label = "Visualiser",
                      style = "pill",
                      color = "danger"),
                      
           sliderInput(
             inputId = "point",
             label = "Marquage sur un instant",
             min = as.POSIXct("00:00:00",format = "%H:%M:%S"),
             max = as.POSIXct("24:00:00",format = "%H:%M:%S"),
             value = as.POSIXct("10:00:00",format = "%H:%M:%S"),
             timeFormat = "%H:%M:%S",
             step=60),
                      
           actionBttn(inputId = "mark",
                      label = "Marquer",
                      style = "pill",
                      color = "danger")
           
    )

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

  heure_filtre <- eventReactive(input$viz,{
   
    mini <- as.difftime(strftime(input$periode[1],format = "%H:%M:%S"),format = "%H:%M:%S")
    maxi <- as.difftime(strftime(input$periode[2],format = "%H:%M:%S"),format = "%H:%M:%S")
   
    data <- df[(df$heure > mini & df$heure < maxi),]
    return(data)
  },ignoreNULL = FALSE)
 
  focus_heure <- eventReactive(input$mark,{
   
    focus <- as.difftime(strftime(input$point,format = "%H:%M:%S"),format = "%H:%M:%S")
   
    data <- df[(df$heure == focus),]
    return(data)
  }) 
 
  output$carte <- renderLeaflet({
    leaflet(heure_filtre()) %>%
      addProviderTiles("OpenStreetMap.France") %>%
      fitBounds(~min(longitude), ~min(latitude), ~max(longitude), ~max(latitude))
  })
 
  observe({
    df <- heure_filtre()
    leafletProxy("carte", data = df) %>%
      clearMarkers() %>%
      addCircleMarkers(lng = ~longitude, lat = ~latitude, radius = 6,stroke= FALSE, fillOpacity = 1)
  })
  observe({
    df <- focus_heure()
    proxy <- leafletProxy("carte", data = df)
    proxy %>%
      clearMarkers()
    if (input$point){
      proxy %>% addMarkers(lng = ~df$longitude, lat = ~df$latitude)}
  })
 
}
shinyApp(ui, server)

I advise you to be more clear about the effect you wish to achieve.
My guess is that you want to head towards something like this

library(leaflet) 
library(tidyverse)
library(hms)
library(shinyWidgets)
library(shiny)

heure <- c("15:16:00", "17:56:00", "18:17:00", "20:00:00", "21:00:00", "22:22:00")

df <- data_frame(
  heure = as.hms(heure),
  latitude = c(46.50253, 46.24055, 46.22687, 46.22042, 46.20115, 46.16915),
  longitude = c(-1.788917, -1.360150, -1.337583, -1.317250, -1.279983, -1.245900),
  vitesse = c(5.54, 7.23, 2.28, 3.92, 7.23, 5.20),
  angle = c(231, 290, 332, 223, 283, 220)
)

ui <- fluidPage(
  leafletOutput("carte"),
  sliderInput(
    inputId = "periode",
    label = "Période  de temps",
    min = as.POSIXct("00:00:00", format = "%H:%M:%S"),
    max = as.POSIXct("24:00:00", format = "%H:%M:%S"),
    value = c(as.POSIXct("10:00:00", format = "%H:%M:%S"), as.POSIXct("23:59:59", format = "%H:%M:%S")),
    timeFormat = "%H:%M:%S",
    step = 60
  ),
  actionBttn(
    inputId = "viz",
    label = "Visualiser",
    style = "pill",
    color = "danger"
  ),
  pickerInput(inputId = "point",
    label = "Marquage sur un instant",
    choices=unique(heure),
    selected = unique(heure)[[1]]
  ),
  actionBttn(
    inputId = "mark",
    label = "Marquer",
    style = "pill",
    color = "danger"
  )
)

server <- function(input, output, session) {
  
  heure_filtre <- eventReactive(input$viz,
    {
      mini <- as.difftime(strftime(input$periode[1], format = "%H:%M:%S"), format = "%H:%M:%S")
      maxi <- as.difftime(strftime(input$periode[2], format = "%H:%M:%S"), format = "%H:%M:%S")

      data <- df[(df$heure > mini & df$heure < maxi), ]
      return(data)
    },
    ignoreNULL = FALSE
  )

  focus_heure <- eventReactive(input$mark, {
    
    focus <- as.difftime(as.hms(input$point, format = "%H:%M:%S"))

    data <- df[(df$heure == focus), ]
    return(data)
  })

  output$carte <- renderLeaflet({
    shiny::isolate({
    leaflet(df) %>%
      addProviderTiles("OpenStreetMap.France") %>%
      fitBounds(~ min(longitude), 
                ~ min(latitude), 
                ~ max(longitude), 
                ~ max(latitude))
    })
  })

  observe({
   hf <- req(heure_filtre())
      updatePickerInput(session=session,
                      inputId = "point",
                      choices=as.character(hf$heure) %>% unique,
                      selected=input$point)
    
    leafletProxy("carte",data = hf) %>%
      clearGroup("mycircles") %>%
      addCircleMarkers(
        lng = ~longitude, 
        lat = ~latitude, 
        radius = 6, stroke = FALSE, fillOpacity = 1,
        group = "mycircles"
      )
  })
  
  observe({
    
    fh <- req(focus_heure())
leafletProxy("carte",data=fh) %>%
        clearGroup("myfocus") %>% 
        addMarkers(
        lng = ~longitude, lat = ~latitude,
        group = "myfocus"
      )
  })
}
shinyApp(ui, server)

Thanks [nirgrahamuk] ! This is exactly what I wanted to do ! It works perfectly in this reprex, but in my real app I have this error , do you know what does it mean ?

Warning: Error in : erreur d'évaluation de l'argument 'tim' lors de la sélection d'une méthode pour la fonction 'as.difftime' : 1 components of ... were not used.

We detected these problematic arguments:

  • format

Did you misspecify an argument?

review your use of as.difftime, is the input in expected format, are you passing format queues as additional parameters correctly ?

I recommend you use some combination of print/str type statements in your code, to print things to console , and browser() drops to halt flow during your app from where you can investigate your objects and code

Thanks again !
I didn't really understand your explanations... do you mind to specify ?

Here is a document you could read particularly the part on debugging.(Shiny debugging and reprex guide)

Thank you very much ! I will read it !

Very last question : how would the code have been with a slider input instead of a pickerinput for the inputId : "point" ?

This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.