R Displaying Points Twice? - r

I have this code for an interactive map in R:
library(leaflet)
library(inlmisc)
Long = rnorm(1000, -71, 0.5)
Lat = rnorm(1000, 42.3, 0.5)
loc = rep("loc", 1000)
Name = rep("Location", 1000)
num = 1:1000
Label = paste0(loc, "_", num)
Location = paste0(Name, "_", num)
df = data.frame(Name, Lat, Long, Label)
map <- leaflet(df) %>% addProviderTiles(providers$OpenStreetMap) %>%
addMarkers( clusterOptions = markerClusterOptions(), popup = ~paste("title: ", Name)) %>%
addTiles() %>%
setView(lng=-71.0589,lat=42.3301, zoom=12) %>%
addMarkers(~Long, ~Lat, popup = ~Name, group="marker", label = ~Label) %>%
inlmisc::AddSearchButton(group = "marker", zoom = 15,
textPlaceholder = "Search here")
The map seems to work fine - but the "icons" are being displayed twice (i.e. blue pins and colored circles, e.g. yellow, green):
Is there a way to have it such that when you zoom out, the blue pins collapse into the colorful circles - and when you zoom in, the colorful circles collapse into the blue pins?
Thank you!

It looks like you are adding the markers twice.
The first addMarkers line, does the clustering with zoom that it sound like you are interested in.
You can add the group and label options to the first addMarkers call, to be able to search and have mouse-over labels as well as the clustering.
map <- leaflet(df) %>% addProviderTiles(providers$OpenStreetMap) %>%
addMarkers( clusterOptions = markerClusterOptions(),
popup = ~paste("title: ", Name),
group="marker", label = ~Label) %>%
addTiles() %>%
setView(lng=-71.0589,lat=42.3301, zoom=12) %>%
inlmisc::AddSearchButton(group = "marker", zoom = 15,
textPlaceholder = "Search here")

Using the answer of #Senithil913 - I added a reset option:
map <- leaflet(df) %>% addProviderTiles(providers$OpenStreetMap) %>%
addMarkers( clusterOptions = markerClusterOptions(),
popup = ~paste("title: ", Name),
group="marker", label = ~Label) %>%
addTiles() %>%
setView(lng=-71.0589,lat=42.3301, zoom=12) %>%
inlmisc::AddSearchButton(group = "marker", zoom = 15,
textPlaceholder = "Search here") %>% addResetMapButton()

Related

R Leaflet not mapping polylines to datarame

I use Leaflet with R quite frequently, but I've not used addPolylines before.
I have a series of lines with origin and destination locations that I'm attempting to plot on a map, and I'm noticing some weird behaviour:
Polylines and markers mapped to the same dataframe are not appearing in the same location.
Labels are not mapping at all to the dataframe, instead only returning the values in the last row for all lines.
Line weight mapping is not working.
I'm not entirely sure what I'm doing wrong here - any help would be appreciated. I've included a reproducible example below.
dummy <- data.frame(
Line_name = c("line1", "line2", "line3"),
origin_lng = c(145.1234, 147.223, 153.225),
origin_lat = c(-17, -19.4, -27.6),
Destination_lng = c(147.223, 153.225, 156.1123),
Destination_lat = c(-19.4, -27.6, -30.5),
Line_weight = c(1, 2, 5)
)
leaflet() %>%
addProviderTiles(provider = providers$Esri.WorldImagery) %>%
setView(lng = 146.612020, lat = -21.628836, zoom = 5) %>%
addMarkers(lng = dummy$origin_lng, lat = dummy$origin_lat, label = "origins") %>%
addPolylines(
lng = c(dummy$origin_lng, dummy$Destination_lng),
lat = c(dummy$Origin_lat, dummy$Destination_lat),
weight = dummy$Line_weight,
label = paste0(
"Line name: ", dummy$Line_name, "<br>",
"Origin coords: ", dummy$origin_lng, " ", dummy$origin_lat, "<br>",
"Destination coords: ", dummy$Destination_lng, " ", dummy$Destination_lat
) %>% lapply(htmltools::HTML)
)
You have to group the lines. You used the columns of dummy as independent vectors but sent no groups. Leaflet doesn't 'know' which labels go with which line segments. Additionally, you did get a popup, but you have to hover. (You only had one, as well.)
So, in short—grouping the data... There is probably an easier way of doing this, but this works. I pivoted longer to going the lat/long. Then I pivoted wider. Essentially, I needed the longs in a column and the lats in a column.
library(leaflet)
library(tidyverse)
dum2 <- dummy %>% pivot_longer(cols = names(.)[2:5], names_to = c("ft", "val"),
names_sep = "_", values_to = "lng_lat") %>%
pivot_wider(id_cols = c("Line_name", "ft", "Line_weight"),
names_from = "val", values_from = "lng_lat")
Then I separated the call for addPolyLines. You need one call for each group.
mp <- leaflet() %>%
addProviderTiles(provider = providers$Esri.WorldImagery) %>%
setView(lng = 146.612020, lat = -21.628836, zoom = 5) %>%
addMarkers(lng = dummy$origin_lng, lat = dummy$origin_lat, label = "origins")
map(dummy$Line_name,
function(group){
mp <<- addPolylines(
mp,
data = dum2[dum2$Line_name == group, ],
lng = ~lng,
lat = ~lat,
weight = ~Line_weight,
labelOptions = list(noHide = T, sticky = T, permanent = T),
label = paste0(
"Line name: ", group, "<br>",
"Origin coords: ", dummy[dummy$Line_name == group, ]$origin_lng,
" ", dummy[dummy$Line_name == group, ]$origin_lat, "<br>",
"Destination coords: ", dummy[dummy$Line_name == group, ]$Destination_lng,
" ", dummy[dummy$Line_name == group, ]$Destination_lat) %>%
lapply(htmltools::HTML))
}
)

ObserveEvent of group legend in Shiny

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)

Leaflet plot with GPS coordinates in R

I want to display a CSV file via its coordinates using leaflet in R. I think leaflet is not being able to pick up the coordinates correctly, how can I fix this?
Sample Data
Point Name X Y
1 A 1393959 406726.6
2 B 1392820 407719.7
3 C 1394466 405740.5
4 D 1393543 407094.7
5 E 1395119 405969.7
6 F 1393557 406747.5
Code
library(tidyverse)
library(leaflet)
map_data = df
map_data$popup = paste("<b>Location #: </b>", map_data$Point,
"<br>", "<b>Longitude: </b>", map_data$X,
"<br>", "<b>Latitude: </b>", map_data$Y,
"<br>", "<b>Desciption </b>", map_data$Name)
leaflet(map_data, width = "100%") %>% addTiles() %>%
addTiles(group = "OSM (default)") %>%
addProviderTiles(provider = "Esri.WorldStreetMap",group = "World StreetMap") %>%
addProviderTiles(provider = "Esri.WorldImagery",group = "World Imagery") %>%
addMarkers(lng = ~X, lat = ~Y, popup = map_data$popup, clusterOptions = markerClusterOptions())
Current Plot
First convert the df into an sf object. Define the CRS which in my case is 2271. Reproject to 4326 to make it work with leaflet and run the rest of the code.
library(tidyverse)
library(sf)
library(sfheaders)
library(leaflet)
# Convert df to sf
df_sf = st_as_sf(x = df,
coords = c("X", "Y"),
crs = 2271)
# Reproject to WGS84
df_sf = st_transform(df_sf , 4326)
df_sf = sf_to_df(rocks_wgs_sf, fill = T)
# Create the map
map_data = df
map_data$popup = paste("<b>Location #: </b>", map_data$Point,
"<br>", "<b>Longitude: </b>", map_data$X,
"<br>", "<b>Latitude: </b>", map_data$Y,
"<br>", "<b>Desciption </b>", map_data$Name)
leaflet(map_data, width = "100%") %>% addTiles() %>%
addTiles(group = "OSM (default)") %>%
addProviderTiles(provider = "Esri.WorldStreetMap",group = "World StreetMap") %>%
addProviderTiles(provider = "Esri.WorldImagery",group = "World Imagery") %>%
addMarkers(lng = ~X, lat = ~Y, popup = map_data$popup, clusterOptions = markerClusterOptions())

I want to know how to print multiple columns of addcircles(popup=...) in R using leaflet package

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.

Change color of leaflet marker

Is there anyway to change the color of leaflet marker base on the value of some variable. In the following map, for example, I wish to assign marker color based on mag variable:
library(leaflet)
data(quakes)
# Show first 20 rows from the `quakes` dataset
leaflet(data = quakes[1:20,]) %>% addTiles() %>%
addMarkers(~long, ~lat, popup = ~as.character(mag))
I often use the circle markers because you can change both the size and color based on other variables. For example, I have created a binned variable from a continuous using the following code:
# first cut the continuous variable into bins
# these bins are now factors
last$BeatHomeLvl <- cut(last$BeatHome,
c(0,.5,1,2,3,5,100), include.lowest = T,
labels = c('<.5x', '.5-1x', '1-2x', '2-3x', '3-5x','5x+'))
# then assign a palette to this using colorFactor
# in this case it goes from red for the smaller values to yellow and green
# standard stoplight for bad, good, and best
beatCol <- colorFactor(palette = 'RdYlGn', last$BeatHomeLvl)
When you plot it, I use the code for circle markers. The radius/area of the circle is based on the actual value of the factor and then color is assigned according to the bins.
m1 <- leaflet() %>%
addTiles() %>%
addProviderTiles(providers$OpenStreetMap, group = 'Open SM') %>%
addProviderTiles(providers$Stamen.Toner, group = 'Toner') %>%
addProviderTiles(providers$Esri.NatGeoWorldMap, group = 'NG World') %>%
setView(lng = -72, lat = 41, zoom = 8) %>%
addCircleMarkers(data = Jun, lat = ~Lat, lng = ~Lon,
color = ~beatCol(BeatHomeLvl), popup = Jun$Popup,
radius = ~sqrt(BeatHome*50), group = 'Home - Jun') %>%
At the end of your code add a legend. I added some formatting.
addLegend('bottomright', pal = beatCol, values = last$BeatHomeLvl,
title = 'Compare Home<br>Quote Count to<br>3Mos State Avg',
opacity = 1)
This gives you color-coded and sized circles based on a variable and a nice legend.
As far as I know, you need to assign an image file to one level of icon. For instance, if you have three levels in magnitude in the earthquake data, you need to create an icon list with three image paths. Then, you can have three different colors in markers. At least, the following example is getting closer to what you want. I edited a png file and created three png files. You need to specify the paths of the file when you make an icon list.
library(dplyr)
library(leaflet)
mutate(quakes, group = cut(mag, breaks = c(0, 5, 6, Inf), labels = c("blue", "green", "orange"))) -> mydf
### I edit this png file and created my own marker.
### https://raw.githubusercontent.com/lvoogdt/Leaflet.awesome-markers/master/dist/images/markers-soft.png
quakeIcons <- iconList(blue = makeIcon("/Users/jazzurro/Documents/Stack Overflow/blue.png", iconWidth = 24, iconHeight =32),
green = makeIcon("/Users/jazzurro/Documents/Stack Overflow/green.png", iconWidth = 24, iconHeight =32),
orange = makeIcon("/Users/jazzurro/Documents/Stack Overflow/orange.png", iconWidth = 24, iconHeight =32))
leaflet(data = mydf[1:100,]) %>%
addTiles() %>%
addMarkers(icon = ~quakeIcons[group])
This one worked for me:
Source: https://github.com/bhaskarvk/leaflet/blob/master/inst/examples/awesomeMarkers.R
library(leaflet)
icon.glyphicon <- makeAwesomeIcon(icon= 'flag', markerColor = 'blue', iconColor = 'black')
icon.fa <- makeAwesomeIcon(icon = 'flag', markerColor = 'red', library='fa', iconColor = 'black')
icon.ion <- makeAwesomeIcon(icon = 'home', markerColor = 'green', library='ion')
# Marker + Label
leaflet() %>% addTiles() %>%
addAwesomeMarkers(
lng=-118.456554, lat=34.078039,
label='This is a label',
icon = icon.glyphicon)
leaflet() %>% addTiles() %>%
addAwesomeMarkers(
lng=-118.456554, lat=34.078039,
label='This is a label',
icon = icon.fa)
leaflet() %>% addTiles() %>%
addAwesomeMarkers(
lng=-118.456554, lat=34.078039,
label='This is a label',
icon = icon.ion)
# Marker + Static Label using custom label options
leaflet() %>% addTiles() %>%
addAwesomeMarkers(
lng=-118.456554, lat=34.078039,
label='This is a static label',
labelOptions = labelOptions(noHide = T),
icon = icon.fa)
Why not use vector markers based on svg (here is one example implementation - https://github.com/hiasinho/Leaflet.vector-markers) that you can apply any fill color you want to? Instead of having to create a large amount of static image files. Some code involved, yes, but a lot more flexible.
L.Marker uses images (one for the marker, one for the shadow) so that's not possible. You can however use your own images, there's a good write up on the topic among the tutorials on the Leaflet site:
http://leafletjs.com/examples/custom-icons.html

Resources