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)