I would like to build an animated map with a time cursor in R.
I have time series (xts) that I would like to represent on map.
library(xts)
library(leaflet)
date<-seq(as.POSIXct("2015-01-01"), as.POSIXct("2015-01-10"), by=86400)
a<-xts(1:10,order.by=date)
b<-xts(5:14,order.by=date)
df = data.frame(Lat = 1:10, Long = rnorm(10),Id=letters[1:10])
leaflet() %>% addCircles(data = df,popup =df$Id)
#popup =paste(df$Id, xts value) time cursor on the map
Is there a way to do this with the leaflet package?
I didn't try rmaps package yet.
Thanks
EDIT:https://github.com/skeate/Leaflet.timeline
There is a simple example
Library:
library(shiny)
library(xts)
library(leaflet)
library(dplyr)
Data:
date<-seq(as.Date("2015-01-01"), as.Date("2015-01-10"), by="day")
a<-xts(1:10,order.by=date)
df = data.frame(Lat = rnorm(1)+10, Long = rnorm(1),Id=a)
data_a<-data.frame(a)
data_a1<-data_a %>%
mutate("Lat" =as.numeric(df[1,1]),"Long"=as.numeric(df[2,1]),"Date"=rownames(data_a))
shinyapp:
ui <- fluidPage(
sliderInput("time", "date",min(date),
max(date),
value = max(date),
step=1,
animate=T),
leafletOutput("mymap")
)
server <- function(input, output, session) {
points <- reactive({
data_a1 %>%
filter(Date==input$time)
})
output$mymap <- renderLeaflet({
leaflet() %>%
addMarkers(data = points(),popup=as.character(points()$a))
})
}
shinyApp(ui, server)
If you add the following in the formula above, you can see the tiles
#in data
tilesURL <- "http://server.arcgisonline.com/ArcGIS/rest/services/Canvas/World_Light_Gray_Base/MapServer/tile/{z}/{y}/{x}"
#in server replace
output$mymap <- renderLeaflet({
leaflet() %>%
addTiles(tilesURL)%>%
addMarkers(data = points(),popup=as.character(points()$a))
})
Related
I would like to make an interactive map in shiny, and filter as follows: first, select the name_region column, and then only the selected region will appear on the map. I would also like to have a way to optionally mark the state or municipality polygon. If nothing is checked, I would like all polygons to appear on the map.
Could someone help me with these first steps please?
library(shiny)
library(leaflet)
library(shinyWidgets)
library(sf)
library(geobr)
#Read states
SP <- read_state("SP",2019)
RJ <- read_state("RJ",2019)
PI <- read_state("PI",2019)
BA <- read_state("BA",2019)
#Read municipalities
SP_M <- read_municipality("SP",2019)
RJ_M <- read_municipality("RJ",2019)
PI_M <- read_municipality("PI",2019)
BA_M <- read_municipality("BA",2019)
#Rbind
States_all <- rbind(SP,RJ,PI,BA)
Mun_all <- rbind(SP_M,RJ_M,PI_M,BA_M)
#Transform coordinates
States_all <- st_transform(States_all, crs = 4326)
Mun_all <- st_transform(Mun_all, crs = 4326)
#UI
ui <- fluidPage(
leafletOutput("mymap"),
fluidPage(
selectInput("name_region", "Region", choices = unique(States_all$name_region))
))
#SERVER
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
leaflet() %>%
addScaleBar() %>%
addTiles() %>%
addPolygons(data=Mun_all,color = "blue", fillColor = "transparent",weight = 1,
smoothFactor = 0.5,opacity = 1.0,popup = ~as.character(name_muni)) %>%
addPolygons(data=States_all,color = "black",
fillColor = "transparent",weight = 1,smoothFactor = 0.5, opacity = 1.0,
popup = ~as.character(name_state))
})
observe({
leafletProxy("mymap") %>%
clearShapes()
})
}
#SHINYAPP
shinyApp(ui, server)
I am building a map using Shiny and want to capture the latitude and longitude of the centre of the map in the variables 'lt' and 'ln'. I am using the below code, however, when it is run, I get NULL values for both 'lt' and 'ln'.
library(shiny)
library(leaflet)
library(leaflet.extras)
server <- function(input, output, session){
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$OpenStreetMap) %>%
setView(lng = 147.842393, lat = -24.000942, zoom = 6) %>%
addSearchOSM(options = searchOptions(collapsed = TRUE))
})
observeEvent(input$MAPID_center, {
lt <- input$MAPID_center$lat
ln <- input$MAPID_center$lng
})
})
Your MAPID is wrong.
You've defined your map output as output$map. So map is your ID in this case
When you want to "observe" this map, you need to observe input$map_... objects
Here's a working example
library(shiny)
library(leaflet)
library(leaflet.extras)
ui <- fluidPage(
leaflet::leafletOutput(
outputId = "map"
)
)
server <- function(input, output, session){
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$OpenStreetMap) %>%
setView(lng = 147.842393, lat = -24.000942, zoom = 6) %>%
addSearchOSM(options = searchOptions(collapsed = TRUE))
})
observeEvent(input$map_center, {
lt <- input$map_center$lat
ln <- input$map_center$lng
print(lt); print(ln)
})
}
shinyApp(ui, server)
If you want those variables in the global environment you may use <<- operator.
library(shiny)
library(leaflet)
library(leaflet.extras)
server <- function(input, output, session){
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$OpenStreetMap) %>%
setView(lng = 147.842393, lat = -24.000942, zoom = 6) %>%
addSearchOSM(options = searchOptions(collapsed = TRUE))
})
observeEvent(input$MAPID_center, {
lt <<- input$MAPID_center$lat
ln <<- input$MAPID_center$lng
})
}
I would like to automatically detect which polygon is at the center of the map. And it should update dynamically when the user is moving through the map.
For the moment I could not find a way to reverse find on which polygon are some coordinates.
I think I could simulate a input$map_shape_click with shinyjs or javascript and so get input$map_shape_click$id, but before I go to this solution, I would like to make sure there is no other way.
Here is a minimal example
library(leaflet)
library(shiny)
# data source : https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_FRA_2_sp.rds
cities <- readRDS(file = "../gadm36_FRA_2_sf.rds")
ui <- fluidPage(leafletOutput("map"))
server <- function(input, output, session) {
rv <- reactiveValues()
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = providers$CartoDB.Positron) %>%
setView(lng = 1, lat = 45, zoom = 8) %>%
addPolygons(data = cities,layerId = ~NAME_2,label = ~NAME_2)
})
observeEvent(input$map_bounds,{
rv$center <- c(mean(input$map_bounds$north, input$map_bounds$south), mean(input$map_bounds$east, input$map_bounds$west))
# how can I detect on which polygon the center is ?
})
}
shinyApp(ui = ui, server = server)
library(leaflet)
library(shiny)
library(sf)
cities <- readRDS(file = "gadm36_FRA_2_sp.rds") %>%
st_as_sf()
ui <- fluidPage(leafletOutput("map"))
server <- function(input, output, session) {
rv <- reactiveValues()
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = providers$CartoDB.Positron) %>%
setView(lng = 1, lat = 45, zoom = 8) %>%
addPolygons(data = cities, layerId = ~NAME_2, label = ~NAME_2)
})
observeEvent(input$map_bounds, {
rv$center <- c(mean(input$map_bounds$north, input$map_bounds$south), mean(input$map_bounds$east,
input$map_bounds$west))
pnt <- st_point(c(rv$center[2], rv$center[1]))
rslt <- cities[which(st_intersects(pnt, cities, sparse = FALSE)),]$NAME_1
print(rslt)
})
}
shinyApp(ui = ui, server = server)
So I found a way to do it with the function sf::st_intersects
observeEvent(input$map_bounds,{
rv$center <- data.frame(x = mean(c(input$map_bounds$north, input$map_bounds$south)),
y = mean(c(input$map_bounds$east, input$map_bounds$west)))
res <- sf::st_as_sf(rv$center, coords=c("y","x"), crs=st_crs(cities$geometry))
intersection <- as.integer(st_intersects(res, cities$geometry))
print(if_else(is.na(intersection), '', cities$NAME_2[intersection]))
})
I am trying to visualise a random walk. Not its path, but actually see the marker moving as it wanders around. Something like this.
I have come with this workaround in which I clear all markers and add them again with the new positions at every step.
library(shiny)
library(leaflet)
df <- data.frame(latitude = 10, longitude = 0)
ui <- fluidPage(
sliderInput("time", "date", 0,
1e2,
value = 1,
step = 1,
animate = TRUE
),
leafletOutput("mymap")
)
server <- function(input, output, session) {
points <- eventReactive(input$time, {
df$latitude <- df$latitude + rnorm(1)
df$longitude <- df$longitude + rnorm(1)
df
})
output$mymap <- renderLeaflet({
leaflet() %>%
addTiles()
})
observe({
leafletProxy("mymap") %>%
clearMarkers() %>%
addMarkers(data = points())
})
}
shinyApp(ui, server)
But I found a much more neat solution in this method movingMarker. I was wondering if there's a way to implement it using that javascript code.
I am still working on this R Leaflet self project to learn and I'm trying to color in some Polygons in the Wake County area of Raleigh, NC. Below is the image of what I am trying to color.
https://imgur.com/a/xdvNLvM
Basically I am trying to get each of those polygons colored differently. I've tried addPolygons but I guess I didn't have correct Polygon data. I've looked at color binning but I seem to be out of ideas. Below is my code. I even tried to unnest the GeoJSON data and create a factor palette but that hasn't seemed to work.
library(shiny)
library(leaflet.extras)
library(geojsonio)
library(rgdal)
dataurl <- 'https://opendata.arcgis.com/datasets/f5c3b84a6fcc499d8f9ece78602258eb_0.geojson'
data <- geojson_read(dataurl, method = 'web', parse = FALSE, what = 'list')
wake <- readOGR(dataurl)
wake$zips <- factor(sample.int(39L, nrow(wake), TRUE))
#bikedata <- 'D:/bicycle-crash-data-chapel-hill-region.geojson'
#bike <- geojson_read(bikedata)
vtdata <- 'http://geodata.vermont.gov/datasets/4c206846699947429df59c8cb552ab5c_11.geojson'
vt <- geojson_read(vtdata)
factpal <- colorFactor(topo.colors(39), wake$zips)
ui <- shinyUI(
fluidPage(
leafletOutput("map", width = "100%", height = "900px")
)
)
server <- function(input, output) {
wakegeojson <- reactive({
data
})
#bikegeojson <- reactive({
# bike
#})
vtgeojson <- reactive({
vt
})
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-93.65, 42.0285, zoom = 4)
})
observe({
leafletProxy("map") %>%
addWMSTiles("http://mesonet.agron.iastate.edu/cgi-bin/wms/nexrad/n0r.cgi",
layers = "nexrad-n0r-900913",
options = WMSTileOptions(format = "image/png", transparent = TRUE),
attribution = "") %>%
addGeoJSON(wakegeojson(), weight = 3, fill = factpal) %>%
#addGeoJSON(bikegeojson()) %>%
addGeoJSON(vtgeojson(), fill = FALSE, color = "black")
})
}
app <- shinyApp(ui = ui, server = server)
runApp(app, launch.browser = TRUE)
I think I need to explore the addPolygons feature more but I'm not exactly sure how to do that or how to parse/unnest my GeoJSON data in order to accomplish filling in the Wake County Zipcodes with different colors. Any help is always appreciated. Thank you.
I would switch to sf. You can directly load the geojson and produce a Multipolygon and a Multilinestring object which will also read much faster than readOGR.
Then you can just put those objects in addPolygons and addPolylines.
The following example should work:
library(shiny)
library(leaflet.extras)
library(geojsonio)
library(rgdal)
library(sf)
dataurl <- 'https://opendata.arcgis.com/datasets/f5c3b84a6fcc499d8f9ece78602258eb_0.geojson'
wake <- st_read(dataurl)
wake$zips <- factor(sample.int(39L, nrow(wake), TRUE))
vtdata <- 'http://geodata.vermont.gov/datasets/4c206846699947429df59c8cb552ab5c_11.geojson'
vt <- st_read(vtdata)
factpal <- colorFactor(topo.colors(39), wake$zips)
ui <- shinyUI(
fluidPage(
leafletOutput("map", width = "100%", height = "900px")
)
)
server <- function(input, output) {
wakegeojson <- reactive({
wake
})
vtgeojson <- reactive({
vt
})
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data=wakegeojson(), color=factpal(wake$zips)) %>%
addPolylines(data=vtgeojson(), color="red")
})
}
app <- shinyApp(ui = ui, server = server)
runApp(app, launch.browser = TRUE)