Rshiny : les 2 observer ne s'affichent pas en même temps

Postez ici vos questions, réponses, commentaires ou suggestions - Les sujets seront ultérieurement répartis dans les archives par les modérateurs

Modérateur : Groupe des modérateurs

Carine Lambert
Messages : 37
Enregistré le : 18 Fév 2021, 15:16

Rshiny : les 2 observer ne s'affichent pas en même temps

Messagepar Carine Lambert » 12 Mai 2021, 08:27

Bonjour,

je souhaite afficher des points sur une carte et offrir la possibilité de marquer un point en plus, les 2 doivent donc s'afficher en même temps (avec la possibilité pour le marqueur de s'effacer pour laisser place à une nouvelle sélection...) mais les 2 ne s'affichent pas en même temps !

Auriez-vous une idée ?

Merci beaucoup à ceux qui auront un moment

Code : Tout sélectionner

library(shiny)
library(shinyTime)
library(ggplot2)
library(plotly) #pour graph
library(leaflet) #carte
library(plyr)
library(dplyr)
library(stringr)
library(tidyverse)
library(lubridate) #pour gérer variable temps
library(hms)
library(shinyWidgets)


#pour code reproductible

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) {
 
  #reactive avec slider heure pour cartes
  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)
 
 
  #reactive avec 1 heure pour focus
  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)
  }) #,ignoreNULL = FALSE
 
 
  #graph carte allure----
 
  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)}
   
    # df2 <- heure_filtre()
    #   leafletProxy("carte", data = df2) %>%
    #     clearMarkers() %>%
    #     addLegend(pal = allure_couleur, values = ~df2$allure, title = "Allures", opacity = 1)%>%
    #     addCircleMarkers(lng = ~df2$longitude2, lat = ~df2$latitude2, radius = 2, color = ~allure_couleur(df2$allure),stroke= FALSE, fillOpacity = 1, label=~label, popup = ~popup)
  })
 
}

shinyApp(ui, server)

Retourner vers « Questions en cours »

Qui est en ligne

Utilisateurs parcourant ce forum : Aucun utilisateur enregistré et 1 invité