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.
Related
I'm trying to make a map with the leaflet package in R. My goal is to color the markers on the map based on a factor variable in my data frame. The dataframe I'm working on is something like this:
My code is as follows:
subset_dados$Circuito=as.factor(subset_dados$Circuito)
pal <- colorFactor("blues", subset_dados$Circuito)
leaflet(subset_dados) %>% addTiles() %>%
addCircleMarkers(~Longitude, ~Latitude, color=~pal(Circuito),fillOpacity = 0.5)
But the map i get is the following
I don't understand what i'm doing wrong, since I would like to have a different color for each factor, but it seems that the only thing changing is the transparency of the black.
Thank you!
Update! I'm adding part of the data frame to make the question reproducible.
Circuito Latitude Longitude
L2RC 41.36394 -8.550200
L21M 41.22638 -8.693360
LBXP 41.15796 -8.610030
L2RC 41.36394 -8.550200
LERM 41.23865 -8.531550
LCAN 41.14016 -8.634990
LARE 41.19195 -8.556460
LCAR 41.05805 -8.563920
LBXP 41.15786 -8.600700
LBAG 41.18931 -8.526040
You should have set Blues in your colorFactor to color the markers based on different factors. You can use the following code:
library(leaflet)
library(dplyr)
subset_dados$Circuito=as.factor(subset_dados$Circuito)
pal <- colorFactor("Blues", subset_dados$Circuito)
leaflet(subset_dados) %>% addTiles() %>%
addCircleMarkers(~Longitude,
~Latitude,
color=~pal(Circuito),
fillOpacity = 0.5)
Output:
As you can see in the picture, the markers show different colors based on the factors.
My objective is to portray the locations with varying numbers of traffic conflicts in a road intersection. My data consists of all the conflicts that we observed in a given time period at an intersection coded into a .CSV file with the following fields "time of conflict", "TTC" (means Time to Collision), "Lat", "Lon" and "Conflict Type". I figured the best way to do so would be using the 'ggmap+stat_density2d' function in R. I am using the following code:
df = read.csv(filename, header = TRUE)
int.map = get_map(location = c(mean.long, mean.lat), zoom = 20, maptype = "satellite")
int.map = ggmap(int.map, extent ="device", legend = "right")'''
int.map +stat_density2d(data = new_xdf, aes(x, y, fill = ..levels.., alpha = ..levels..),
geom = "polygon")
int.map + scale_fill_gradientn(guide = "colourbar", colours = rev(brewer.pal(7,"Spectral")),
name = "Conflict Density")
The output is a very nice map Safety Heat Map that correctly portrays the conflict hotspots. My problem is that in the legends it gives the values of "levels" automatically calculated by the 'stat_density2d()' function. I tried searching for a way to display, say, the counts of all conflict points inside each level on the legend bar but to no avail.
I did find the below link that handles a similar question, but the problem with that is that it creates a new data frame (new_xdf) with much more points than in the original data. Thus, the counts determined in that program seems to be of no use to me as I want the exact number of conflict points in my original data to be displayed in the legends bar.
How to find points within contours in R?
Thanks in advance.
Edit: Link to a sample data file
https://docs.google.com/spreadsheets/d/11vc3lOhzQ-tgEiAXe-MNw2v3fsAqnadweVrvBdNyNuo/edit?usp=sharing
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))
I'm working on a custom route planner in R at the moment. I'm using the output of the Google Maps Directions API. I want to show the route on a map between two places. Everything is going great so far. The only problem is that I don't know how to give the route multiple colors based on Speed at the moment. I searched the internet for a few days and I couldn't find something that fits my goal. That's why I made this post.
Then I visualized it in Leafet with te following code:
#install.packages("leaflet")
library(leaflet)
pal <- colorNumeric(
palette = unique(polyline$Col),
domain = polyline$Speed,
na.color = "#FFFFFF"
)
rm(map)
map <- leaflet()
map <- addTiles(map)
a <- 1
for(a in length(unique(polyline$Step_ID))){
map <- addPolylines(map,lng = polyline$Lon,
lat = polyline$Lat,
data = polyline[polyline$Step_ID==a,],
color = polyline$col)
a <- a + 1
}
map <- addLegend(map,"bottomright", pal = pal, values = polyline$Speed,
title = "Speed",
opacity = 1)
map
So far I think you have to create multiple PolyLines(correct me if I'm wrong) to plot multiple colors in the route. That's why I made a for loop, to add ever PolyLine into the map.
Everthing is just how want it. The only problem is the coloring of the line. I want the coloring of the lines just like Google does with traffic.
Can someone help me out with this please?
To fully replicate your question you need to provide us with the actual data for polyline (i.e, not a screenshot). Until then, I'm going to create my own data set and show you how to create the coloured lines.
And, as you're using Google's API to get the directions, I'm assuming you'll have an API key, so I'm going to show you how to do it using my googleway package
library(googleway)
api_key <- "your_api_key"
directions <- google_directions(origin = "St Kilda, Melbourne, Australia",
destination = "Geelong, Victoria, Australia",
key = api_key)
## the results of the API give you distance in metres, and time in seconds
## so we need to calculate teh speed
spd <- (directions$routes$legs[[1]]$steps[[1]]$distance$value / 1000) / (directions$routes$legs[[1]]$steps[[1]]$duration$value/ 60 / 60)
## then we can start to build the object to use in the plot
## and as we are staying within Google's API, we can use the encoded polyline to plot the routes
## rather than extracting the coordinates
df <- data.frame(speed = spd,
polyline = directions$routes$legs[[1]]$steps[[1]]$polyline)
df$floorSpeed <- floor(df$speed)
colours <- seq(1, floor(max(df$speed)))
colours <- colorRampPalette(c("red", "yellow","green"))(length(colours))
df <- merge(df,
data.frame(speed = 1:length(colours),
colour = colours),
by.x = "floorSpeed",
by.y = "speed")
map_key <- "your_map_api_key"
google_map(key = map_key) %>%
add_polylines(data = df, polyline = "points", stroke_colour = "colour",
stroke_weight = 5, stroke_opacity = 0.9)
See this answer for a way of making the route planner in Shiny.
I am attempting to plot profitability on top of counties in Minnesota, Iowa, and Nebraska. Using leaflet and tigris, I have been able to plot ALL counties, whether or not I have data for it. This leaves me with a few counties with colors and the rest labeled as NA. Is there a way for me to remove all NA's from my geo_join data so that it just isn't used ala unused Wisconsin areas? I have tried using fortify, but I can't figure out how to determine what county boundaries I'm looking at when I merge the TIGER boundary lines with my County FIPS file in order to remove them.
Here is what my leaflet currently looks like:
My code to get the map is this:
library(tigris)
library(leaflet)
pal <- colorNumeric(c("yellow","dark red"),county$Construction.Cost,na.color="white")
IA_counties <- counties(state="IA", cb=TRUE, resolution ="20m")
MN_counties <- counties(state="MN",cb=TRUE,resolution="20m")
NE_counties <- counties(state="NE",cb=TRUE,resolution="20m")
IA_merged <- geo_join(IA_counties,county,"GEOID", "GEOID")
MN_merged <- geo_join(MN_counties,county,"GEOID","GEOID")
NE_merged <- geo_join(NE_counties,county,"GEOID","GEOID")
popupIA <- paste0("County Projects: ", as.character(paste('$',formatC(format(round(IA_merged$Construction.Cost, 0), big.mark=',', format = 'f')))))
popupMN <- paste0("County Projects: ", as.character(paste('$',formatC(format(round(MN_merged$Construction.Cost, 0), big.mark=',', format = 'f')))))
popupNE <- paste0("County Projects: ", as.character(paste('$',formatC(format(round(NE_merged$Construction.Cost, 0), big.mark=',', format = 'f')))))
leaflet() %>%
addProviderTiles("MapQuestOpen.OSM") %>%
addLegend(pal = pal,
values = IA_merged$Construction.Cost,
position = "bottomright",
title = "County Projects",
labFormat=labelFormat(prefix="$")) %>%
addCircles(lng=yup2$lon, lat=yup2$lat,weight=.75,fillOpacity=0.01,color="red",
radius = 96560) %>%
addCircles(lng=yup2$lon, lat=yup2$lat,weight=.75,fillOpacity=0.01,color="blue",
radius = 193121) %>%
addPolygons(data = IA_counties,
fillColor = ~pal(IA_merged$Construction.Cost),
layerId=1,
fillOpacity = .25,
weight = 0.05,
popup = popupIA)%>%
addPolygons(data=MN_counties,
fillColor=~pal(MN_merged$Construction.Cost),
fillOpacity=0.25,
weight=0.05,
popup = popupMN) %>%
addPolygons(data=NE_counties,
fillColor=~pal(NE_merged$Construction.Cost),
fillOpacity=0.25,
weight=0.05,
popup = popupNE)
I apologize for not including reproducible data, but if needed, please ask. I'm hoping that this is more of a simple na.color= formula solution. The map looks "okay" as of now, but I'd like it if it's possible to not have to make the fillOpacity so light so the NA counties don't stand out.
Thanks for any and all help and please, let me know if you have any questions!
I'm the creator of the tigris package. Thanks so much for using it! In the development version of tigris on GitHub (https://github.com/walkerke/tigris), I've added an option to geo_join to accommodate inner joins, which would remove the unmatched data entirely from the resultant spatial data frame (if this is what you are looking for). You can also supply a common merge column name as a named argument to the new by parameter if you want. For example:
IA_merged <- geo_join(IA_counties, county, by = "GEOID", how = "inner")
should work. I'm still testing but I'll probably submit this update to CRAN in January.
So, embarrassingly, the answer to this question was as simple as I had hoped. I tweaked the following na.color code and it worked exactly as I wanted.
pal <- colorNumeric(c("yellow","dark red"),county$Construction.Cost,na.color="transparent")