Optimising Shiny + Leaflet performance for detailed maps with many 'layers' - r

I want to make a Shiny app where the colouring of a choropleth is based on a numeric value of one of many possible quantitative variables that a user can select from. In simple cases, this is straightforward, but I'm unsure of the best practices when we have 20+ variables, with quite detailed shape files (~2300 polygons).
It might or might not be relevant that the variables might be completely independent to each other such as 'Total Population' or 'Average Temperature' but some of them will have a temporal relationship such as 'Total Population' at 3 or more points in time.
One of the main shapefiles I am using is the ABS Statistical Area 2. Below I give the population density (total population/area) for Australia and a zoomed in view of Sydney to better convey the level of detail I'm interested in.
Australia
Sydney
I have read the shapefile in to R and greatly reduced the complexity/number of points using the ms_simplify() function in the rmapshaper package.
Now as far as Shiny and leaflet go, this is what I have been doing:
Before the server object is defined in server.R, I build a primary map object with all the desired 'layers'. That is, a leaflet with numerous addPolygon() calls to define the colouring of each 'layer' (group).
# Create main map
primary_map <- leaflet() %>%
addProviderTiles(
providers$OpenStreetMap.BlackAndWhite,
options = providerTileOptions(opacity = 0.60)
) %>%
# Layer 0 (blank)
addPolygons(
data = aus_sa2_areas,
group = "blank"
) %>%
# Layer 1
addPolygons(
data = aus_sa2_areas,
fillColor = ~palette_layer_1(aus_sa2_areas$var_1),
smoothFactor = 0.5,
group = "layer_1"
) %>%
...
# Layer N
addPolygons(
data = aus_sa2_areas,
fillColor = ~palette_layer_n(aus_sa2_areas$var_n),
smoothFactor = 0.5,
group = "layer_n"
) %>% ...
All bar the first layer is then hidden using hideGroup() so that the initial rendering of the map doesn't look silly.
hideGroup("layer_1") %>%
hideGroup("layer_2") %>%
...
hideGroup("layer_n")
In the Shiny app, using radio buttons (layer_selection), the user can select the 'layer' they'd like to see. I use observeEvent(input$layer_selection, {}) to watch the status of the radio button options.
To update the plot, I use leafletProxy() and hideGroup() to hide all the groups and then showGroup() to unhide the selected layer.
I apologize for the lack of reproducible example.
Questions
How can I optimise my code? I am eager to make it more performant and/or easy to work with. I've found using hideGroup()'s/showGroup() for each layer selection is far faster than using addPolygon() to a blank map, but this causes the app to take a very significant amount of time to load.
Can I change the variable I am colouring the polygons by, without redrawing or adding those polygons again? To clarify, if I have 2 different variables to plot, both using the same shape data, do I have to do 2 distinct addPolygon() calls?
Is there a more automatic way to sensibly colour the polygons for each layer according to a desired palette (from the viridis package?). Right now I'm finding defining a new palette for each variable, rather cumbersome, eg:
palette_layer_n <- colorNumeric(
palette = "viridis",
domain = aus_sa2_areas$aus_sa2_areas$var_n
)
Side Question
How does this map on the ABS website work? It can be incredibly detailed and yet extremely responsive. Compare the Mesh Block detail to the SA2 (2310 polygons), example below:

Since you haven't gotten any answers yet, I'll post a few things that can maybe help you, based on a simple example.
It would of course be easier if yours was reproducible; and I suppose from looking around you have already seen that there are several related issues / requests (about re-coloring polygons), whereas it doesn't seem that a real solution has made it into any release (of leaflet) yet.
With the below work-around you should be able to avoid multiple addPolygons and can cover an arbitrary number of variables (for now I have just hard-coded a single variable into the modFillCol call though).
library(leaflet)
library(maps)
library(viridis)
mapStates = map("state", fill = TRUE, plot = FALSE)
# regarding Question 3 - the way you set the domain it looks equivalent
# to just not setting it up front, i.e. domain = NULL
myPalette <- colorNumeric(
palette = "viridis",
domain = NULL
)
mp <- leaflet(data = mapStates) %>%
addTiles() %>%
addPolygons(fillColor = topo.colors(10, alpha = NULL), stroke = FALSE)
# utility function to change fill color
modFillCol <- function(x, var_x) {
cls <- lapply(x$x$calls, function(cl) {
if (cl$method == "addPolygons") {
cl$args[[4]]$fillColor <- myPalette(var_x)
}
cl
})
x$x$calls <- cls
x
}
# modify fill color depending on the variable, in this simple example
# I just use the number of characters of the state-names
mp %>%
modFillCol(nchar(mapStates$names))

Related

r leaflet limit max zoom with markerClusterOptions turned on

I have a leaflet map, which has points that overlap when zoomed out. I have therefore used markerClusterOtions() so that as the user zooms in, the overlapping points that were grouped into clusters will separate.
This is all working fine, but my problem is that I would like to apply a zoom limit. I don't want the users to be able to zoom right in to street level, because then they could see the exact address of my markers (which in this case would be a data protection issue). I want the markers to freeze when the user reaches the max zoom limit, but until then, they should keep separating out as the user zooms in.
I thought this could be achieved by setting the maxZoom in tileOptions, and freezeAtZoom in markerClusterOptions, but it doesn't work and I keep getting a strange error.
Here is my code:
# Create the interactive map:
myleaflet <- leaflet() %>%
# Add open street map (default base layer)
addTiles(tileOptions(minZoom = 1, maxZoom = 12)) %>%
# Add transformed shapefile of regions
addPolygons(data = regions, weight = 5, col = "black") %>%
# Add markers for case residence with descriptive labels:
addMarkers(lng = mydata$home_long,
lat = mydata$home_lat,
popup = paste("ID: ", mydata$id, "<br/>",
"Link: ", mydata$links, "<br/>",
"Clade: ", mydata$wgs_cluster),
clusterOptions = markerClusterOptions(freezeAtZoom = "max"))
# View the map:
myleaflet
And here is the error I get (it appears when I try to view the map, not when running the code to create it):
Error in dirname(to) : path too long
If I remove the zoom options, I can view the map, but then the zoom is not limited.
I have looked at posts regarding this error, and I can see that it is associated with Windows OS and paths that are too long. I am using windows, and this is part of an R markdown chunk, but the chunk name is 24 characters (so within the limit) and the R markdown file name is short - also, the error only occurs when I run the above code, which is just part of the code in that chunk. I can't see how adding the zoom options makes something too long, since they are supposed to be valid arguments?
Any insights as to what I'm doing wrong would be much appreciated.
Update:
It seems my mistake was not specifying the argument name for tileOptions - also freezeAtZoom is not necessary to specify when the maximum zoom limit is already specified for the map tiles (in fact if both are specified, the unclustered markers also show up on the map).
The code below works:
# Create the interactive map:
myleaflet <- leaflet() %>%
# Add open street map (default base layer)
addTiles(options = tileOptions(maxZoom = 12)) %>%
# Add transformed shapefile of regions
addPolygons(data = regions, weight = 5, col = "black") %>%
# Add markers for case residence with descriptive labels:
addMarkers(lng = mydata$home_long,
lat = mydata$home_lat,
popup = paste("ID: ", mydata$id, "<br/>",
"Link: ", mydata$links, "<br/>",
"Clade: ", mydata$wgs_cluster),
clusterOptions = markerClusterOptions())
# View the map:
myleaflet
Since the first option in addTiles() is map I suppose that it was previously interpreting the tileOptions argument as a file path to a map, but I would be interested to know if there are other interpretations, since the traceback showed the problem with the file path length was in saving to html, not importing / reading a file.

R: Understanding the "max" and "blur" options

I am working with the R programming language. Using the following code, I made an interactive map with the "leaflet" library :
Lat = round(runif(5000,43,44), 4)
Long = round(runif(5000,79,80), 4)
a <- rnorm(5000,100,10)
map_data <- data.frame(Lat, Long, a)
map_data$Long = -1 * map_data$Long
#load libraries
library(leaflet)
library(leaflet.extras)
#make heatmap for variable "a"
leaflet(map_data) %>%
addTiles(group="OSM") %>%
addHeatmap(group="a", lng=~Long, lat=~Lat, max=.6, blur = 60)
Does anyone know if it is possible to understand the exact (math) formulas behind the coloring/shading in this map? I tried consulting the official documentation for the functions used to create this map (https://cran.r-project.org/web/packages/leaflet.extras/leaflet.extras.pdf) , but no where does it explain how the colors are finalized. I suspect that this somehow might be related to "kernel density estimation". Furthermore, I have a feeling that the "max" and the "blur" options are actually parameters used in the final coloring of this map.
Does anyone know if it is possible to understand the exact formula used behind the coloring?
Thanks

Mapview Popup Graph Appear on Hover?

Is there a way to make popup graphs appear on hover (rather than click) in Mapview? Alternatively, is it possible for the graphs to appear open by default? Rather than produce my own reproducible example, I would defer to the example given with the R Mapview documentation.
I am fairly new to R and Mapview so any guidance is greatly appreciated!
I've just pushed an update to package leafpop which provides the popup functionality used in mapview. This should provide what you want (at least partly - as mapview() will still need to be updated). This allows you to now specify tooltip = TRUE in addPopupImages (in addPopupGraphs via ...). Note that it is encouraged to use addPopup* functions over the classic popup* functions because they also work in non-interactive setting, e.g. when saving a map locally.
library(sf)
library(leaflet)
library(lattice)
library(leafpop)
pt = data.frame(x = 174.764474, y = -36.877245)
pt = st_as_sf(pt, coords = c("x", "y"), crs = 4326)
p2 = levelplot(t(volcano), col.regions = terrain.colors(100))
leaflet() %>%
addTiles() %>%
addCircleMarkers(data = pt, group = "pt") %>%
addPopupGraphs(
list(p2)
, group = "pt"
, width = 300
, height = 400
, tooltip = TRUE
)
Not sure when and how to integrate this into mapview() as this is a bit more complicated than the classic popup* functions (because we need to know something about the map object we create with mapview before we create it...). In any case, I hope this is at least partly useful and helps resolve your issue.

Is there a way to have a highlighted chart as well as have interactivity of selecting elements in R?

I have come across a beautiful chart on this webpage: https://ourworldindata.org/coronavirus and interested to know if we can build the same chart in R with functionality of having highlighted series as well as selecting any line on hovering ?
I have build static highlighted charts using gghighlight but those are not interactive.
Plotly can help in interaction but I think they don't work with gghighlight.
So how can we have the combination of both highlight and interactivity in charts as in the link shared on top ?
Is it possible to achieve same results in R ? It would be really helpful if someone could share an example or link that can help.
(UPDATE: May be I can manually highlight lines by creating a factor column instead of using gghighlight and then pass it to ggplotly but then can ggplotly or some other library provide similar results on hover ?)
(NOTE: Not looking for animation. Just need highlighted, hover over interactive chart)
Below is the snapshot of same chart hovered over US (This chart is also similar to the one shared in World Economic Forum many times.)
Using plotly you can use highlight() to achive this.
This is a slightly modified example from here:
library(plotly)
# load the `txhousing` dataset
data(txhousing, package = "ggplot2")
# declare `city` as the SQL 'query by' column
tx <- highlight_key(txhousing, ~city)
# initiate a plotly object
base <- plot_ly(tx, color = I("black")) %>%
group_by(city)
# create a time series of median house price
time_series <- base %>%
group_by(city) %>%
add_lines(x = ~date, y = ~median)
highlight(
time_series,
on = "plotly_hover",
selectize = FALSE,
dynamic = FALSE,
color = "red",
persistent = FALSE
)

Add "rgb" legend to R leaflet heatmap

I made some interactive heatmaps using leaflet (particularly the addHeatmap() command from the leaflet.extras package) and shiny. Having created a desired map, I would like to add a legend to it.
What I am interested in is a "rgb" legend, based on density values deduced by addHeatmap() from pure long/lat coords.
What I need is something like this map - https://www.patrick-wied.at/static/heatmapjs/example-legend-tooltip.html - unfortunately I have no knowledge of JS and can't rewrite this code in terms of R/include the right fragment of JS code for my problem.
What I tried so far is the addLegend() command, which does not give the desired result, as in this case I would need to specify a variable for which the legend would be prepared. I also tried to extract the color range and assigned values from created leaflet object, however with no success.
Here's link to full data to run the reproducible example on:
https://drive.google.com/file/d/1h3jL_PU6DGTtdIWBK02Tt37R7IB2ArH9/view
And here's top 20 records:
structure(list(latitude = c(30.309522, 30.24429616, 30.30038194,
30.27752338, 30.23294081, 30.23038507,
30.34285933, 30.24962237, 30.26594744,
30.20515821, 30.22363485, 30.2759184,
30.28283226, 30.33816909, 30.26611565,
30.18835401, 30.26704789, 30.27456699,
30.19237135, 30.1925213),
longitude = c(-97.73171047, -97.77446858, -97.77885789,
-97.71919076, -97.58937812, -97.76581095,
-97.73598704, -97.72215443, -97.74144275,
-97.8782895, -97.78329845, -97.71321066,
-97.70820152, -97.82413058, -97.7327258,
-97.81606795, -97.68989589, -97.7580592,
-97.7816127, -97.73138523)),
.Names = c("latitude", "longitude"), row.names =
c(NA, 20L), class = "data.frame")
Here's an example code, which I'd like to extend by the mentioned functionality:
library(magrittr)
library(leaflet)
library(leaflet.extras)
data <- read.csv('DATA.csv')
leaflet(data) %>%
addTiles(group="OSM") %>%
addHeatmap(group="heat", lng = ~longitude, lat = ~latitude, max=.5, blur = 60)
And here is the result of that code (on whole dataset):
https://i.stack.imgur.com/6VFNC.jpg
So to sum up what I would like to do: based on such picture I would like to extract the range of the drawn colors along with values assigned to them, and draw legend using that information.
Is there something I am missing? It looks like a pretty simple issue, but I've been struggling to find a solution for past few hours.
Thanks in advance for any help!
EDIT: extended the reproducible example.
Your sample data does not have any values to it to actually map a density overlay.
You can specify the number of bins with colorBin() and then specify those bins with your pal function. You can set the bins differently depending on your needs at the data_values distributions. The help section of colorBin() is helpful in identifying the correct parameters for your needs.
bins <- c(0,1,2,3,4)
pal <- colorBin("Spectral", domain = data_value, bins = bins, na.color = "transparent")
m <-leaflet() %>%
addTiles() %>%
addHeatmap(lng= long_cords, lat = lat_cords, intensity = data_value,
blur = 20, max = 400, radius = 15, cellSize = 3) %>%
addLegend(pal = pal, values = data_value,
title="Heat map legend")
You'll have to play around with the addHeatmap arguments to get an the right transparency and density settings.

Resources