I am using R leaftlet package to create a interactive choropleth of the U.S.
There are several tutorials online and I am able to create interactive state level map with popups and zooming. Also I was also able to create a separate zip code level map again with popups.
I would like both views in one map itself but make zip code visible as I zoom in a state or double click on a state. Like If I double click on New York, the New York Zip Code opens up. Is there a package/function in R that can help me do this?
Here are static screenshots of both to make things clear what I plan to integrate.
I agree with Yehoshapat Schellekens that in R one might not have the flexibility of a web programming language. But seldom R is not flexible enough to achieve fancy results! :) Here you go with a "vanilla" example of what you basically need. You can customize the windows popup with some JS.
library(shiny)
library(leaflet)
library(maps)
library(maptools)
library(sp)
library(rgeos)
mapStates = map("state", fill = TRUE, plot = FALSE)
mapCounty = map("county", fill = TRUE, plot = FALSE)
shinyApp(
ui = fluidPage(leafletOutput('myMap'),
br(),
leafletOutput('myMap2')),
server <- function(input, output, session) {
output$myMap <- renderLeaflet({
leaflet() %>%
addProviderTiles("Stamen.TonerLite",
options = providerTileOptions(noWrap = TRUE)) %>%
addPolygons(lng = mapStates$x,
lat = mapStates$y,
fillColor = topo.colors(10, alpha = NULL),
stroke = FALSE)
})
observeEvent(input$myMap_shape_click, {
click <- input$myMap_shape_click
if(is.null(click))
return()
lat <- click$lat
lon <- click$lng
coords <- as.data.frame(cbind(lon, lat))
point <- SpatialPoints(coords)
mapStates_sp <- map2SpatialPolygons(mapStates, IDs = mapStates$names)
i <- point [mapStates_sp, ]
selected <- mapStates_sp [i]
mapCounty_sp <- map2SpatialPolygons(mapCounty, IDs = mapCounty$names)
z <- over(mapCounty_sp, selected)
r <- mapCounty_sp[(!is.na(z))]
output$myMap2 <- renderLeaflet({
leaflet() %>%
addProviderTiles("Stamen.TonerLite",
options = providerTileOptions(noWrap = TRUE)) %>%
addPolygons(data=r,
fillColor = topo.colors(10, alpha = NULL),
stroke = FALSE)
})
})
})
NOTE: The datasets used in the example seem to have different accuracies (not perfect overlap for states and counties). Therefore the spatial matching is accounting for more counties than expected (those inside plus those intersecting the state borders). Use the name as ID instead to achive the perfect match.
I've created the same type of app working off of G. Cocca's code, and after a few months of fiddling with it over and over, I've come up with a more elegant solution to your problem. For simple reproducibility, I'm using Rwanda shapefiles as an example (because they're much smaller than GADM's USA shapefiles, but you can always just replace these with your own US shapefiles).
library(raster)
library(shiny)
library(leaflet)
library(RColorBrewer)
#load in shapefiles for state and county level
states <- getData("GADM", country = "rwa", level = 1)
counties <- getData("GADM", country = "rwa", level = 2)
#define color palettes for states
pal <- brewer.pal(8, "Dark2")
statePal <- colorFactor(pal, states#data$NAME_1)
shinyApp(
ui = fluidPage(
leafletOutput('myMap', width = "100%"),
br(),
leafletOutput("myMap2", width = "100%")
), #END UI
server <- function(input, output, session){
#default state level map output
output$myMap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data = states,
fillColor = ~statePal(states#data$NAME_1),
fillOpacity = 1,
color = "white",
stroke = T,
weight = 1,
layerId = states#data$NAME_1) #this sets the click id, very important!
}) #END RENDERLEAFLET OUTPUT
observeEvent(input$myMap_shape_click, {
#define click object
click <- input$myMap_shape_click
#subset counties shapefile so that only counties from the clicked state are mapped
selected <- counties[counties$NAME_1 == click$id,]
#define color palette for counties
countyPal <- colorFactor(pal, selected#data$NAME_2)
#if click id isn't null (i.e. if ANY polygon is clicked on), draw map of counties
if(!is.null(click$id)){
output$myMap2 <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data = selected,
fillColor = ~countyPal(selected#data$NAME_2),
fillOpacity = 1,
color = "white",
stroke = T,
weight = 1)
}) #END RENDERLEAFLET
} #END CONDITIONAL
}) #END OBSERVE EVENT
}) #END SHINYAPP
The first output is your state level map. With this code, when you click on a state of interest, a click object is created that has a click$id corresponding the name of that state (which is established in the layerId definition in the addPolygons call). With the click$id as the selected state name, you can then subset your county level polygon by that state and plot it as a map.
The options for designing this map are endless, really. Hope this helps!
You wont be able to create this through R, you need to run this through good old java Script, and specifically leaflet.
Keep in mind that R does not run the map, all it does is to create a java-script template of an HTML file, your Web browser runs the rest (Not R interpreter)
The professional word you are looking for is event binding, which on one click will trig both zooming in your original US map, and open a new map of a state with its zip code.
General instructions (this is all java script, no R!):
go to http://leafletjs.com/reference.html and find events, you need the dblclick event.
Then you'll need to create a function that opens up a new map.
keep in mind that if you want to do sophisticated stuff, R will give you very limited solutions, so my advice is when you need nice java script visualizations just go straight to the source :)
Your requirement needs lot of customization. If you are good in JavaScript just check geojson2svg that gives lot of flexibility. Basically it converts GeoJSON to SVG, that's all then rest you can achieve with plain HTML and JavaScript. Here are some examples.
Related
I have been searching the web for weeks trying to find an example or a code for what I am trying to accomplish with my shiny app (shinydashboard). I’m new to r and I’m starting to think that what I am trying to do is not possible. I basically have a leaflet map with a county polygon (shapefile) and I want to use the click event on the polygon to open a related dataTable (species table) on a box() below the map. The polygon data is a shapefile containing the county name and county number id. The related dataTable contain the county name, county #id and names of species for each county (one-to-many relationship). I was thinking that some how I could use the observe function and county # id from the “map_shape_click” to render the table with the names of the species by county on a output box(). However I don’t know if that is even possible. So far I was able to create the map and use the click event to capture the county name on a box() ( see attached image).
This forum is amazing and I have learn a lot from the postings. Thank everyone that contribute to the community. If you have any suggestions how I can accomplish this task please let me know,
Thanks
JB
Example image
let see if I got it right..
You can get the desired result by capturing the info related to hte clicked polygon and then using the id to subset your table
library(raster)
library(shiny)
library(leaflet)
library(RColorBrewer)
library(DT)
#species per region
mydata<-data.frame(myID=c("Iburengerazuba", "Iburasirazuba","Umujyi wa
Kigali","Umujyi wa Kigali", "Amajyaruguru", "Iburengerazuba",
"Amajyaruguru", "Amajyaruguru"),
myspec=c("virginiana", "setosa", "barbosa", "pelosa",
"pudica","pudica","pudica","pudica"))
#load in shapefiles for state
states <- getData("GADM", country = "rwa", level = 1)
#define color palettes for states
statePal <- colorFactor("Dark2", states#data$NAME_1)
shinyApp(
ui = fluidPage(
leafletOutput('myMap', width = "100%"),
br(),
DT::dataTableOutput("mytable", width = "100%")
),
server <- function(input, output, session){
output$myMap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data = states,
fillColor = ~statePal(states#data$NAME_1),
fillOpacity = 1,
color = "white",
stroke = T,
weight = 1,
layerId = states#data$NAME_1)
})
observeEvent(input$myMap_shape_click, {
#capture the info of the clicked polygon
click <- input$myMap_shape_click
#subset your table with the id of the clicked polygon
selected <- mydata[mydata$myID == click$id,]
#if click id isn't null render the table
if(!is.null(click$id)){
output$mytable = DT::renderDataTable({
selected
})
}
})
})
The code below is reproducible - it builds the map of the world using leaflet.
I am really not interested in Antarctica and I am more interested in Scandinavia :)
Any way to cut Antarctica or at least force it to be always at the bottom of the map - so that the center of the map is farther north?
Thanks a lot for any pointers!
library(leaflet)
library(rnaturalearth)
countries <- rnaturalearth::countries110
goodnames <- countries$name
goodnames[goodnames %in% goodnames[32]] <- "Ivory Coast"
countries$name[32] <- goodnames[32]
mymap <- leaflet(countries, options = leafletOptions(minZoom = 2))
myvalues <- 1:177
mycolors <- colorNumeric(palette = c("#fee6ce","#e6550d"),
domain = myvalues)(myvalues)
mymap %>%
addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1,
color = ~mycolors,
label = countries$name)
You can use setView to set the initial viewing point to any location of your choosing. If you want this map to focus on Scandinavia on opening, you can do...
mymap <- leaflet(countries, options = leafletOptions(minZoom = 2)) %>% setView(lng=18.6435,lat=60.1282,zoom=2)
The coordinates are simply from searching 'Sweden coordinates' on Google. You can use a site such as https://www.latlong.net/ to help you pick an appropriate center point.
Unfortunately 'rnaturalearth' is not (yet) available fpr R 3.4.2 and I have just updated one second ago so I can't prove my answer. But as you're asking for any pointer -
I use the 'rworldmap' package and take out Antarctica by excluding it after the map is defined by the package.
According to this my suggestion to your code would be:
mymap <- mymap[-which(row.names(mymap)=='Antarctica'),]
I'm working on creating a Shiny/Leaflet app similar to this one that's done in tableau. It shows world-level views of poverty for different years, allowing the user to filter the map by variable, region, and year.
The problem is that the global country-level shapefile (from NaturalEarthData) renders quite slowly. I'm working on different ways to simplify those polygons to decrease load time, but in the meantime, I'm working on other potential solutions.
Ideally, I would use Shiny controls to toggle the different map layers and use leafletProxy to update the map. But because each layer change draws the entire map again, this is also quite slow.
When I include the different layers inside Leaflet, the layers are rendered much, much faster. (I assume that this is because the addLayersControl option in Leaflet only changes the fillColor of the polygons rather than redrawing the entire global shapefile, as is done with leafletProxy). But is there any way to access these layers outside of Leaflet?
To illustrate, here's some dummy code:
#load required libraries
library(shiny)
library(leaflet)
library(raster)
#begin shiny app
shinyApp(
ui <- fluidPage(
leafletOutput("map", width = "100%", height = 600)
), #END UI
server <- function(input, output, session){
#load shapefile
rwa <- getData("GADM", country = "RWA", level = 0)
#render map
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data = rwa,
fillColor = "blue",
group = "blue") %>%
addPolygons(data = rwa,
fillColor = "red",
group = "red") %>%
addLayersControl(baseGroups = c("blue", "red"),
options = layersControlOptions(collapsed = F))
}) #END RENDER LEAFLET
} #END SERVER
) #END SHINY APP
Which has the following output:
You can easily toggle between the blue and red layers within the leaflet map object. But let's say that I want a Shiny table to update with the attributes from the red polygon layer when I toggle the map layers from blue to red. I want to be able to pull this object outside of leaflet and utilize it in a Shiny observeEvent. Is this possible/how can I do this?
You can define an observer for the {MAP_ID}_groups input in your Shiny server.
Example:
server <- function(input, output, session) {
# ...
output$my_map <- renderLeaflet({
# ...
})
observe({
selected_groups <- req(input$my_map_groups)
# do whatever ...
})
}
This input gets updated when the user selects a group in the layers control.
I'm having some problems changing polygon styles when selecting and deselecting polygons in a Leaflet Shiny app I'm working on. In my current app, when you click on a polygon, that polygon is highlighted with a different color. Ideally, I want the user to be able to select and highlight multiple polygons. I also want the user to be able to re-click a single highlighted polygon to deselect it.
The best that I've been able to manage is to select multiple polygons, give them the same group ID "selected", then deselect that entire group when a polygon is re-clicked. Here's some example/reproducible code:
library(raster)
library(shiny)
library(leaflet)
#load shapefile
rwa <- getData("GADM", country = "RWA", level = 1)
shinyApp(
ui = fluidPage(
leafletOutput("map")
),
server <- function(input, output, session){
#initial map output
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data = rwa,
fillColor = "white",
fillOpacity = 1,
color = "black",
stroke = T,
weight = 1,
layerId = rwa#data$OBJECTID,
group = "regions")
}) #END RENDER LEAFLET
observeEvent(input$map_shape_click, {
#create object for clicked polygon
click <- input$map_shape_click
#define leaflet proxy for second regional level map
proxy <- leafletProxy("map")
#subset regions shapefile by the clicked on polygons
selectedReg <-rwa[rwa#data$OBJECTID == click$id,]
#map clicked on polygons
proxy %>% addPolygons(data = selectedReg,
fillColor = "red",
fillOpacity = 1,
weight = 1,
color = "black",
stroke = T,
group = "selected",
# layerId = "selected")
layerId = selectedReg#data$OBJECTID)
#remove polygon group that are clicked twice
if(click$group == "selected"){
proxy %>%
clearGroup(group = "selected")
} #END CONDITIONAL
}) #END OBSERVE EVENT
}) #END SHINYAPP
In the above example, every clicked polygon turns red. If a previously-selected red polygon is clicked again, every red polygon is cleared from the map, leaving the initial white polygon renderings.
I can accomplish the desired selecting/deselecting effect when I'm working with only one polygon at a time by using the string layerId "selected" (commented out in the above code), but doing that removes my ability to select and highlight multiple polygons at the same time.
I'm open to any and all suggestions!
The answer lies in layerIds. I wasn't understanding how these were applied to my polygons and removing shapes--understanding this is key. This might not be the most elegant solution, but it gets the job done!
In the below code, the initial map rendering of Rwanda has a layerId of rwa#data$NAME_1, which are the region names. You can see this in action with the label also being set as rwa#data$NAME_1. So in the below image, the leftmost polygon is labeled as Iburengerazuba, its attribute in the NAME_1 column. This layerId sets the click$id for any click events you have on this initial map rendering. So, just as this polygon is labeled Iburengerazuba, its click$id will also be set as Iburengerazuba. As stated in the Leaflet Shiny documentation, if you've got more than one polygon, this needs to be a vectorized argument. If you only need to select and deselect ONE polygon (so only one region at a time, in this example), you could use a layerId string, as I mentioned in my question (such as layerId = "selected").
Next up is the observeEvent for your shape click. Thanks to the help of user #John Paul, I figured out how to save all click events (click ids specifically in this case) made on the map. I saved those in a reactive vector, then subset my shapefile by those click ids. The code is pretty thoroughly commented, so hopefully anyone else looking for this same solution can figure out exactly what's going on.
The final bit of code (housed in the if...else conditional statement) is probably the most confusing. Let's look at the else portion of the code first. (Note: Your initial map click is going to trigger this event because there's no way for the if conditions to have been met upon first click.) If any white polygon is clicked, the addPolygons() call is triggered, adding the clicked polygon onto the map with different styling (in this case, it's red). This is plotting an entirely different polygon on top of the leafletProxy object!
The key to removing the red clicked polygons is giving these polygons a different layerId than the initial map rendering. Note that in the above image, the white polygon that was labeled Iburengerazuba is now labeled as 3. This is because the layerId in the second addPolygons call is set as CC_1 INSTEAD OF NAME_1. So, bottom layer white map has a NAME_1 layerID and therefore NAME_1 click ids, whereas any red clicked polygon plotted on top of that has a CC_1 layerId and therefore CC_1 click ids.
The if statements states that if your click$id already exists in the clickedPolys polygon, that this shape is removed. This is kind of confusing, so again, it might help to go through each line of code and play around with it to truly understand.
Again using the above example, clicking the leftmost polygon adds the layerId Iburengerazuba to the clickedIds$ids vector. This click event triggers a second map drawing, plotting the clicked polygon on top of itself in a different style and with a layerId of 3 (from the CC_1 column). We want to say that if any red polygon is clicked twice (if(click$id %in% clickedPolys#data$CC_1)), it counts as a deselection, and that polygon should be removed from the map. So if you click on the red leftmost polygon with a layerId of 3, the clickedIds$ids vector will be comprised of Iburengerazuba and 3. Iburengerazuba in the NAME_1 column of the clickedPolys polygon corresponds to 3 in the CC_1 column, triggering the if statement. The call removeShape(layerId = click$id) means to remove the shape that corresponds to that click$id. So in this case, the clickedPolys polygon with a CC_1 layerId of 3.
Keep in mind that every click id, both NAME_1 and CC_1 are being recorded in your clickedIds$ids vector. This vector is subsetting your Rwanda shapefile to map all clicked polygons, so as you're clicking polygons, the clickedPolys polygon is dynamically updating (use print calls to check every bit of code if this isn't making sense to you!). Removing any double-clicked shape isn't enough to plot everything correctly--you need to remove deselected layerIds, both NAME_1 and CC_1, from the clickedIds$ids vector. I matched each deselected CC_1 layerId to its corresponding NAME_1 value and removed both of those attributes from the clickedIds$ids vector so that they are removed from the clickedPolys polygon.
Voila! Now you can select and deselect any polygons you want!
library(raster)
library(shiny)
library(leaflet)
#load shapefile
rwa <- getData("GADM", country = "RWA", level = 1)
shinyApp(
ui = fluidPage(
leafletOutput("map")
),
server <- function(input, output, session){
#create empty vector to hold all click ids
clickedIds <- reactiveValues(ids = vector())
#initial map output
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data = rwa,
fillColor = "white",
fillOpacity = 1,
color = "black",
stroke = T,
weight = 1,
layerId = rwa#data$NAME_1,
group = "regions",
label = rwa#data$NAME_1)
}) #END RENDER LEAFLET
observeEvent(input$map_shape_click, {
#create object for clicked polygon
click <- input$map_shape_click
#define leaflet proxy for second regional level map
proxy <- leafletProxy("map")
#append all click ids in empty vector
clickedIds$ids <- c(clickedIds$ids, click$id)
#shapefile with all clicked polygons - original shapefile subsetted by all admin names from the click list
clickedPolys <- rwa[rwa#data$NAME_1 %in% clickedIds$ids, ]
#if the current click ID [from CC_1] exists in the clicked polygon (if it has been clicked twice)
if(click$id %in% clickedPolys#data$CC_1){
#define vector that subsets NAME that matches CC_1 click ID
nameMatch <- clickedPolys#data$NAME_1[clickedPolys#data$CC_1 == click$id]
#remove the current click$id AND its name match from the clickedPolys shapefile
clickedIds$ids <- clickedIds$ids[!clickedIds$ids %in% click$id]
clickedIds$ids <- clickedIds$ids[!clickedIds$ids %in% nameMatch]
#remove that highlighted polygon from the map
proxy %>% removeShape(layerId = click$id)
} else {
#map highlighted polygons
proxy %>% addPolygons(data = clickedPolys,
fillColor = "red",
fillOpacity = 1,
weight = 1,
color = "black",
stroke = T,
label = clickedPolys#data$CC_1,
layerId = clickedPolys#data$CC_1)
} #END CONDITIONAL
}) #END OBSERVE EVENT
}) #END SHINYAPP
I hope you can help me. I have created a choropleth Map with Leaflet. I merged my (dataframe with countries and a random score) and a Shapefile with the Polygon data. So far it is working, however if I implement it in R-Shiny, the map is showing, but with no color. There is also no error showing. Anyone knows why?
My code:
ui <- fluidPage(
leafletOutput("map")
)
shinyServer(function(input, output) {
output$map <- renderLeaflet({
test_map
})
})
global.R
tmp <- tempdir()
url <- "http://www.naturalearthdata.com/http//www.naturalearthdata.com/download/50m/cultural/ne_50m_admin_0_countries.zip"
file <- basename(url)
download.file(url, file)
unzip(file, exdir = tmp)
world <- readOGR(dsn = tmp, layer = "ne_50m_admin_0_countries", encoding = "UTF-8")
data <- data.frame(Code = c("AR", "AU", "BE", "BR"),
Score = c(0.01, -0.05, 0.15, -0.22))
world <- merge(world, data,
by.x = "iso_a2",
by.y = "Code",
sort = FALSE)
pal <- colorNumeric(
palette = "RdYlGn",
domain = world$Score
)
test_map <- leaflet(data = world) %>%
addTiles() %>%
addPolygons(fillColor = ~pal(Score),
fillOpacity = 0.9,
color = "#BDBDC3",
weight = 1)
I know this is an old question and I'm not sure whether this will help or not, but I believe I had a similar problem to you which was just solved.
In my case, I had no trouble displaying polygon colours within Rstudio on my own PC, but certain web browsers and older versions of Rstudio refused to fill polygons with colours, even though all other aspects of the map worked fine.
The problem was that my colour palette consisted of a vector of hex codes with an alpha channel (the last couple of digits, specifying transparency). Removing the alpha channel from the hex codes solved my problem. It may be worth checking whether your colour vectors include alpha and if so, removing it with something like gsub(".{2}$","",your_colour_vector) as per the answer to my own problem (link above).
It doesn't look like your colours include alpha in your sample code but maybe it's a problem in your full code. That would explain why the sample code works but the full code doesn't. Might be something to look into anyway? Sorry I can't help more, I know this is a bit of a shot in the dark and not a full solution.