I would like to add OpenStreetMap, OpenTopoMap and Stamen.TonerLines in a list to a leaflet map.
I get those names with
library("leaflet"); library("leafem")
names(providers)[c(1,10,40)]
[1] "OpenStreetMap" "OpenTopoMap" "Stamen.TonerLines"
My map is this
n = leaflet() %>%
addTiles(group = "Base") %>%
setView( lng = 1, lat = 40, zoom = 5 )
n
My lapply code is this
lapply(
c(1,10,40),
function(i) addProviderTiles(map=n, names(providers)[i], layerId = i, group =names(providers)[i])
)
lapply(
c(1,10,40),
function(i) addLayersControl(map=n, baseGroups = names(providers)[i])
)
Now I have only last tile!
How could I add those tiles using lapply?
You could do something like this
n = leaflet() %>%
addTiles(group = "Base") %>%
setView( lng = 1, lat = 40, zoom = 5 )
n %>% addProviderTiles(providers$OpenStreetMap, group = 'OpenStreetMap') %>%
addProviderTiles(providers$OpenTopoMap, group='OpenTopoMap') %>%
addLayersControl(baseGroups = c('OpenStreetMap', 'OpenTopoMap'))
To wrap into a function calling index
layered_map <- function(..., provider=NULL, base_map_name="Base") {
select_providers <- provider[c(...)]
iter <- function(providers, layerid) {
if (length(providers)==0) {
leaflet() %>% addTiles(group = base_map_name) %>% setView(lng = 1, lat = 40, zoom = 5 )
} else {
iter(providers[-length(providers)], layerid-1) %>%
addProviderTiles(providers[[length(providers)]],
layerId = layerid,
group = providers[[length(providers)]])
}
}
controlnames <- if (length(select_providers)==0) base_map_name else names(select_providers)
iter(select_providers, length(select_providers)) %>% addLayersControl(baseGroups = controlnames)
}
To call the function:
library("leaflet")
library("leafem")
layered_map(1, 10, 40, provider=providers)
It is quite generic. So, if you want to generate a base map without additional layers. You could simply do
layered_map()
or
layered_map(base_map_name="My base map")
which will give you
Related
I have a code below, and I would like to forloop the overlayGroup by each cluster. Many thanks in advance.
library(dplyr); library(leaflet); library(raster);library(htmltools)
cluster <- c("1st.C", "2nd.C", "3rd.C")
lat <- c(40.8518, 42.6611, 37.3089)
long <- c(14.2681, 13.6987, 13.5858)
data <- data.frame(cluster, lat, long); data
adm <- raster::getData('GADM', country= "italy" , level=1)
map_layers <- function() {
#number of groups
k <- n_distinct(data$cluster)
#base map
map <- leaflet() %>%
addProviderTiles(providers$CartoDB.Positron)
#loop through all groups and add a layer one at a time
for (i in 1:k) {
map <- map %>%
addCircleMarkers(
data = data %>% filter(cluster == i), group = as.character(i),
radius = 3, lng = ~long, lat = ~lat
)
}
#create layer control
map %>%
addLayersControl(
overlayGroups = c(1:k),
options = layersControlOptions(collapsed = FALSE)) %>%
hideGroup(as.character(c(2:k))) #hide all groups except the 1st one
}
#plot the map
map_layers()
i think this is what you are trying to achieve:
leaflet() %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addCircleMarkers(data = data,
radius = 3, lng = ~long, lat = ~lat, group = cluster) %>%
addLayersControl(overlayGroups = cluster,
options = layersControlOptions(collapsed = FALSE)) %>%
hideGroup(group = data$cluster[2:3])
I am working on Shiny and I would like to capture with a ObserveEvent the group/BaseGroup that the user is clicking in the legend of the following map:
output$map <- renderLeaflet({
p <- leaflet(paises_total_casos()) %>%
addTiles() %>%
setView( lat=10, lng=0 , zoom=2) %>%
addCircles(lng = ~cent$x, lat = ~cent$y, weight = 1, radius = ~sqrt(total_casos) * 40, color = "blue", group = "New_cases",
label = ~htmlEscape(paste(location, ":", format(as.numeric(total_casos), big.mark=","), sep = " "))) %>%
addCircles(lng = ~cent$x, lat = ~cent$y, weight = 1, radius = ~sqrt(total_fallecidos) * 40, color = "red", group = "New_deaths",
label = ~htmlEscape(paste(location, ":", format(as.numeric(total_fallecidos), big.mark=","), sep = " "))) %>%
addCircles(lng = ~cent$x, lat = ~cent$y, weight = 1, radius = ~sqrt(tests) * 40, color = "green", group = "New_tests",
label = ~htmlEscape(paste(location, ":", format(as.numeric(tests), big.mark=","), sep = " "))) %>%
#Afegim el Layers Control
addLayersControl(baseGroups = c("New_cases", "New_deaths", "New_tests"),
options = layersControlOptions(collapsed = FALSE))
})
Let's say I would like to capture if the map is showing the group New_cases, New_deaths or New_tests.
Is there a possibility to do that with ObserveEvent?
Thank you
You can include an observer for your map. You can use input$map_groups (adding "_groups" to the outputId used) and place inside observe. See complete example below which will print the map layer shown.
library(shiny)
library(leaflet)
ui <- fluidPage(leafletOutput("map"))
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles(group = "OpenStreetMap") %>%
addProviderTiles("Stamen.Toner", group = "Toner by Stamen") %>%
addMarkers(runif(20, -75, -74), runif(20, 41, 42), group = "Markers") %>%
addLayersControl(
baseGroups = c("OpenStreetMap", "Toner by Stamen"),
overlayGroups = c("Markers")
)
})
observe({
print(input$map_groups)
})
}
shinyApp(ui, server)
here is my R code
library(leaflet)
m <- leaflet() %>%
addTiles() %>%
setView(lng = 126.97806, lat=37.56667, zoom=16)
m
acci <- read.csv("C:/accidents.csv")
acci
leaflet(acci) %>%
setView(lng = 126.97806, lat=37.56667, zoom=13) %>%
addTiles() %>%
addCircles(lng=~longitude, lat=~latitude, color=~acci_colour(accidenttype), popup=~accidentplace) %>%
addLegend(position = "bottomleft",
title = "accidenttype",
pal = acci_colour, values = ~accidenttype, opacity = 1)
acci_colour <- colorFactor("viridis", acci$accidenttype)
SO, I want to know how to get multiple informations of data acci when i click the circle mark on the leaflet map.
I tried :
addCircles(lng=~longitude, lat=~latitude, color=~acci_colour(accidenttype), popup=~accidentplace, ~...., ~.....)
addCircles(lng=~longitude, lat=~latitude, color=~acci_colour(accidenttype),popup=paste(acci$accidentplace, acci$..., acci$...)
addCircles(lng=~longitude, lat=~latitude, color=~acci_colour(accidenttype), popup=colnames(acci)[5:9])
... Thank you
You only need to use ~ once and paste the column data together using html for formatting.
For example:
Data for reprex
library(leaflet)
df <- data.frame(
lat = runif(10, 35, 40),
lon = runif(10, 80, 120),
n = 1:10,
txt1 = sample(LETTERS, 10),
txt2 = sample(letters, 10)
)
Example 1
leaflet(df) %>%
addTiles() %>%
addCircles(
lng = ~lon,
lat = ~lat,
popup = ~paste(n, txt1, txt2, sep = "<br>")
)
Example 2 (more control)
library(htmltools)
leaflet(df) %>%
addTiles() %>%
addCircles(
lng = ~lon,
lat = ~lat,
popup = ~paste0(
"<b>n: ", n, "</b><br>",
"id1: ", txt1, "<br>",
"id2: ", txt2, "<br>"
)
)
Using htmltools::htmlEscape() ensures the column text isn't interpreted as html. It's not strictly necessary for this example.
I added points on a map using shiny and leaflet.
Each point is a different type of transit option.
I want to distinguish the different types by color and couldn't figure this out.
Tried using "if" which doesn't work.
Thanks!
This is the basic code I have
library(leaflet)
ui <- fluidPage(
leafletOutput("map"),
headerPanel("Example"),
sidebarPanel(checkboxGroupInput(inputId = "Type", label = "Data
Layer",choices = c("Bike", "Muni", "Bus", "BART"), selected = "Bike")))
server <- function(input, output) {
output$map <- renderLeaflet({
rownumber = which(Stops_and_stations$Type == input$Type)
x <- Stops_and_stations[rownumber,]
leaflet(width = 1000, height = 500) %>%
addTiles() %>%
addCircleMarkers(lng = x$stop_lon,
lat = x$stop_lat,
radius= 3, color = '#ff6633') %>%
setView(lng = -122.4000,
lat = 37.79500,
zoom = 13)
})
}
shinyApp(ui, server)
And this is what I tried to add
.....
if(input$Type == "Bike"){
leaflet(width = 1000, height = 500) %>%
addTiles() %>%
addCircleMarkers(lng = x$stop_lon,
lat = x$stop_lat,
radius= 3, color = '#ff6633') %>%
setView(lng = -122.4000,
lat = 37.79500,
zoom = 13)
}
if(input$Type == "Muni"){
leaflet(width = 1000, height = 500) %>%
addTiles() %>%
addCircleMarkers(lng = x$stop_lon,
lat = x$stop_lat,
radius= 3, color = '#0033ff') %>%
setView(lng = -122.4000,
lat = 37.79500,
zoom = 13)
}
.....
It would be much easier to answer to your question if you provided Stops_and_stations and thus made it a reproducible example..
One approach to use distinct colors for different groups is to add a color column to your data.frame:
Since we don't know your data, I created some random dataset.
Stops_and_stations <- data.frame(
Type = rep(c("Bike", "Muni", "Bus", "BART"), each = 10),
stop_lon = -runif(40, 122.4200, 122.4500),
stop_lat = runif(40, 37.76800, 37.78900),
color = rep(c("Red", "Blue", "Green", "Yellow"), each = 10)
)
Then instead of specifying a concrete color such as #ff6633, you can use the color column.
addCircleMarkers(lng = x$stop_lon,
lat = x$stop_lat,
radius= 3, color = x$color)
I would also like to point out that your subsetting is not right: you are using checkboxGroupInput which can have more values, so you need to use the %in% operator to filter.
x <- Stops_and_stations[Stops_and_stations$Type %in% input$Type,]
I want to use different icons in a leaflet plot in R based on a factor variable in a dataframe. The factor variable might have 100 different levels, but I only have icons for a few levels, maybe 10 or so. If there is an icon I want to use it, else draw CircleMarkers.
I can do this with a for loop:
library(leaflet)
# Some icons
fruits_icons <- iconList(
apple = makeIcon("apple.png", iconWidth = 20, iconHeight = 20),
banana = makeIcon("banana.png", iconWidth = 20, iconHeight = 20)
)
# Some data
latitude <- 48 + runif(20)
longitude <- 10 + runif(20)
fruit <- sample(c("banana", "apple", "pear"), 20, replace = TRUE)
df <- data.frame(latitude, longitude, fruit)
map <- leaflet(df) %>% addTiles()
# check if fruit is in names(icons), then use icons, else circles
for(i in seq_len(nrow(df))){
if(df$fruit[i] %in% names(fruits_icons)){
map <- map %>% addMarkers(lng = df$longitude[i],
lat = df$latitude[i],
icon = ~fruits_icons[df$fruit[i]])
} else {
map <- map %>% addCircleMarkers(lng = df$longitude[i],
lat = df$latitude[i])
}
}
map
Is there a better way to do this without the for loop?
You can just subset the data that you want to use in each of the add*() methods
leaflet() %>% addTiles() %>%
addMarkers(data = df[df$fruit %in% names(fruits_icons),],
lng = ~longitude,
lat = ~latitude,
icon = ~fruits_icons[fruit]) %>%
addCircleMarkers(data = df[!df$fruit %in% names(fruits_icons), ],
lng = ~longitude,
lat = ~latitude)