How to fix geospatial mislabeling on leaflet map within R Shiny app? - r

I made the following map from a data frame that contains the number of parole of each state from the years 1995-2015 per 100,000 as well as the spatial information for each state. I want to incorporate it into r shiny app to have a slider to be able to choose the specific year and view it. I got the slider to work and change the data and when you first run it works and gives you the appropriate state and number. However, when you move around the slider the geospatial labels start moving around using the reactive and different states start getting different states labels. Like the following:
The slider starts at the year 2000 and as you can see the if I move it around it, in this case 2014, now we have florida being labeled as Montana.
All these was done within the R shiny app. This is the code I have below. I have my leaflet map fully created outside the server.
server <- function(input, output) {
#Set YEAR with Slider
state_parole_year <- reactive({
state_parole %>%
filter(year == year(input$year))
})
labels_year <- reactive({paste("Parole/100000 US Adults",
state_parole_year()$state, state_parole_year()$number_on_parole_per_100000_us_adult_residents)})
output$mymap <- renderLeaflet({
state_map %>%
addTiles()%>%
addPolygons(fillColor = ~ pal(state_parole_year()$number_on_parole_per_100000_us_adult_residents),
fillOpacity = 1,
color = "blue",
opacity = 0.1,
weight = 1,
highlight = highlightOptions(
weight = 3,
color = "blue",
fillOpacity = .2,
bringToFront = TRUE),
label = labels_year())
})
}
When I run the leaflet map outside of r shiny app and change the year manually by subsetting the csv it works perfectly. The problem occurs when I try to make the labels reactive to the slider. Does someone know how I can fix the problem? Thanks!

The problem is that you build the map on unfiltered data, then display it with filtered data. There is then a switch in factors.
A quick fix is to build your map on filtered data, directly in the server() function :
output$mymap <- renderLeaflet({
leaflet(data = state_parole_year()) %>%
addTiles() %>%
setView(lng = -80,
lat = 34.5,
zoom = 4) %>%
addPolygons(fillColor = ~ pal(state_parole$number_on_parole_per_100000_us_adult_residents),
fillOpacity = 1,
color = "blue",
opacity = 0.1,
weight = 1,
highlight = highlightOptions(
weight = 3,
color = "blue",
fillOpacity = .2,
bringToFront = TRUE),
label = labels) %>%
addLegend(
position = "topright",
pal = pal,
values = ~number_on_parole_per_100000_us_adult_residents,
title = "# of U.S. Adults on Parole/100000.",
opacity = 1) %>%
addTiles()%>%
addPolygons(fillColor = ~ pal(state_parole_year()$number_on_parole_per_100000_us_adult_residents),
fillOpacity = 1,
color = "blue",
opacity = 0.1,
weight = 1,
highlight = highlightOptions(
weight = 3,
color = "blue",
fillOpacity = .2,
bringToFront = TRUE),
label = ~labels_year())
})

Related

Converting Values using numberFormat in leaflegend on Shiny

I am building a Shiny app and am trying to get a resized leaflet legend using leaflegend. My dataset has several different measures in it, some that are raw counts and some percentages. I am trying to code the legend numberFormat so that it displays the appropriate format for each. I currently have the values in dat2$value and the properly formatted label in dat2$lbl. I have tried defining a function to execute this translation for numberFormat but am getting strange results.
#define getLabel
getLabel = function(x){
dat2$lbl[dat2$value == x]
}
#draw map on screen
leafletProxy("map") %>%
clearShapes() %>%
clearControls() %>%
addMapPane("polygons", zIndex = 410) %>%
addMapPane("borders", zIndex = 420) %>%
addPolygons(
data = dat2,
stroke = T,
color = "#343434",
weight = 0.5,
opacity = 1,
fillColor = ~ pal(dat2$value),
fillOpacity = 0.8,
smoothFactor = 0.2,
popup = content,
options = pathOptions(pane = "polygons")
) %>%
addLegendBin(
pal = pal,
values = dat2$value,
numberFormat = function(x) lapply(x, getLabel),
title = input$group,
position = "topleft",
orientation = "vertical"
)
Resulting output:
Any thoughts on what is going wrong here? I feel so close, but can't quite get it to where I need it to be.

leafletProxy to change map with fixed fillOpacity in addPolygons, Shiny

I made a Shiny app with Year slider so that the map could update the value by Year with leafletProxy.
However, if I set fillOpacity less than 1 in addPolygons. The opacity from the next Year would overlay on the previous display. So one after one, it would fully be opaque. I could add clearShapes() after proxy %>% to overcome this, but the shape would be re-drawn and I could see the refresh.
With fillOpacity = 1, this would not be a problem, but the color is just too bright.
The first graph below is the initial view, and the second one is after sliding by one year.
Is there anyways to fix fillOpacity for each update without clearShapes()?
The parts of my codes for this are:
observe({
df <- mapSelected()
value <- as.numeric(displayValue())
proxy <- leafletProxy("mapPlot", session, data = df)
proxy %>%
addPolygons(fillColor = ~regionPal()(value), fill = TRUE,
fillOpacity = 0.6,
color = 'white', weight = 1, opacity = 0.8,
popup = paste(mapLevel(), ": ", df[[SAName()]], "<br>",
"ED counts: ", value),
highlightOptions = highlightOptions(color = 'white',
weight = 3,
opacity = 1,
bringToFront = FALSE))
})
output$mapPlot <- renderLeaflet({
leaflet() %>%
addTiles() %>%
fitBounds(lng1 = 140.99926, lng2 = 153.63873,
lat1 = -37.50508, lat2 = -28.15702)
})

Colour leaflet polygons based on user input (using predefined categorical based palette) in shiny app

I am building an app based on election results and I would like to colour the polygons on the leaflet map with the elected parties' colours per electorate. The user can select the year for which the choose to see the results: Sitting Party (current), 2013 etc.
I have read a lot on here about dynamic colour palettes and reactive colour palettes based on user input but none of them work with my pre-defined colour palette which sets a specific colour to each party abbreviation based on the party colours.
I am not sure what I am missing or doing wrong, but help will be greatly appreciated.
You can download the shp files here here, I used the Queensland 2018 distributions: https://www.aec.gov.au/electorates/gis/
And here is the elected party data which I merged with the shape file on the field Elect_div:
PartyAb<-c(ALP,"LNP","LNP", "LNP","LNP","LNP","LNP","LNP","LNP","LNP","LNP", "LNP","ALP","LNP","ALP","LNP","KAP","LNP","ALP","ALP","LNP","LNP","LNP","ALP", "ALP","LNP","ALP","LNP","LNP","LNP")
Elected_Party_2013<-c("ALP","LNP","LNP","LNP","LNP","LNP","LNP","LNP","PUP", "LNP","LNP","LNP","ALP","LNP","LNP","LNP","KAP","LNP","ALP","LNP","LNP","LNP", "LNP", "ALP", "ALP", "LNP", "ALP", "LNP","LNP","LNP")
Elect_div<-c("Blair","Bonner","Bowman","Brisbane",
"Capricornia","Dawson","Dickson","Fadden",
"Fairfax","Fisher","Flynn","Forde",
"Griffith","Groom","Herbert","Hinkler",
"Kennedy","Leichhardt","Lilley",
"Longman","Maranoa","McPherson",
"Moncrieff","Moreton","Oxley",
"Petrie","Rankin","Ryan",
"Wide Bay","Wright")
df.party <- data.frame c(PartyAb, Elected_Party_2013, Elect_div)
#read in the shape files and filter to only have qld elects
qld<-readOGR(dsn=path.expand("./data/shape_files"), layer="E_AUGEC_region")
qld<-qld[qld$Elect_div %in% c("Blair","Bonner","Bowman","Brisbane",
"Capricornia","Dawson","Dickson","Fadden",
"Fairfax","Fisher","Flynn","Forde",
"Griffith","Groom","Herbert","Hinkler",
"Kennedy","Leichhardt","Lilley",
"Longman","Maranoa","McPherson",
"Moncrieff","Moreton","Oxley",
"Petrie","Rankin","Ryan",
"Wide Bay","Wright"),]
#merge the csv to the shape file based on elect_div
qld.stats <- merge(qld, df, by = "Elect_div")
ui<- fluidPage(selectInput("stats", "",label="Select a statistic to display spatially on the map.",
choices= list("Sitting Party"="PartyAb",
"2013 results"="Elected_Party_2013" ))
)
#colour palette based on party colours
party_cols<-c("LNP"="#021893","ALP" = "#C12525","IND" = "grey", "KAP" = "#33165F",
"PUA"="orange", "ON"="orange", "GRN"="#339966", "LNQ"="#0066FF",
"LP"="#0033CC", "NP"="#009999", "Electorate not established in 2007"="black", "Electorate not established in 2004"="black")
#attempt to create a reactive colour palette using the party_cols colour palette based on user input but it doesnt work
observe({
if (input$stats == "PartyAb") {
pal <- colorFactor(c("LNP"="#021893","ALP" = "#C12525","IND" = "grey", "KAP" = "#33165F",
"PUA"="orange", "ON"="orange", "GRN"="#339966", "LNQ"="#0066FF",
"LP"="#0033CC", "NP"="#009999", "Electorate not established in 2007"="black", "Electorate not established in 2004"="black"), domain= qld.stats[[input$stats]])
} else {
pal <- colorNumeric(c("red", "green"), domain = qld.stats[[input$stats]], reverse = FALSE)
}
# the second part of the colour palette above is related to the fact that I have other options from the dropdown menu that display numeric stats like unemployment and participation rate
#this colour palette works but it is a total fluke and won't work for
this years data as there are green and yellow colours required so I need something like this but that uses the party_cols colour palette
colorpal <- reactive({
colorFactor(colorRamp(c("red", "blue")), domain = qld.stats[[input$stats]], reverse = FALSE)
})
#create the base map that will be displayed regardless of selected input
output$map<-renderLeaflet({
leaflet(qld.stats) %>%
addProviderTiles(providers$OpenStreetMap.BlackAndWhite) %>% #(providers$OpenStreetMap.BlackAndWhite)%>%
# Centre the map in the middle of our co-ordinates
fitBounds(min(137.99),max(-29.18),min(153.55),max(-9.12))
})
leafletProxy("map", data = qld.stats) %>%
clearShapes() %>%
addPolygons(
layerId = qld.stats$Elect_div,
fillColor = ~pal(qld.stats[[input$stats]]),
fillOpacity = 0.4,
weight = 0.6,
opacity = 1,
color = "#444444",
dashArray = "5",
label = labels,
highlight = highlightOptions(
weight = 4,
color = "#FFFFFF",
dashArray = "",
fillOpacity = 0.9,
bringToFront = TRUE),
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 5px"),
textsize = "13px",
direction = "auto")
)
#we are adding a legend to display the raw data that aligns with the spatially depicted stat from the stats drop-down
#this information is also displayed in the pop-ups for each clickable electorate
varname<-switch(input$stats,
"PartyAb"="Sitting Party", "Electorate Population"="CED_pop_total",
'CED_participation_rate_2018'="Work-force participation rate %",
'Unemployment_rate_2018'="Unemployment rate %")
leafletProxy("map", data = qld.stats) %>% clearControls() %>%
addLegend(pal = pal, opacity = 0.9, title = varname,
values = ~qld.stats[[input$stats]],labels = c(min(input$stats), max(input$stats)),
position = "topleft")
})
#we want to create a reactivity so users can either select the division
#from the drop down menu or by clicking on the map
observe({
event <- input$map_shape_click
if (is.null(event))
return()
updateSelectInput(session, "division", selected = event$id)
})
#we want to create reactivity so that the map to zooms in on and focus on the selected electorate
observe({
selectedPolygon <- subset(qld.stats, qld.stats$Elect_div == input$division)
leafletProxy("map", data = qld.stats) %>%
removeShape("highlightedPolygon") %>%
fitBounds(selectedPolygon#bbox[1,1],
selectedPolygon#bbox[2,1],
selectedPolygon#bbox[1,2],
selectedPolygon#bbox[2,2]) %>%
addPolylines(weight = 4, color = "white",
data = selectedPolygon, layerId = "highlightedPolygon")
})
}
shinyApp(ui, server)
So I figured out a work around to the issue I was having which was needing a predefined colour scheme (political party colours) to fill polygons on a leaflet map based on user input from a drop down menu.
My solution isn't exactly what I was after, but it definitely works and I am happy with it.
#we need to set up 3 separate colour schemes for the different options from the spatial stats drop down menu
#one for current party using factor levels to match the party colours
#one for the previous election results using same rationale
#one for the numeric based stats for unemployment rate and participation rate
observe({
if (input$stats == "PartyNm") {
pal <- colorFactor(c("#C12525","#6600CC","#021893"), domain= qld.stats[[input$stats]])
} else if (input$stats == "Elected_Party_2013") {
pal <- colorFactor(c("#C12525","##6600CC","#021893", "yellow"), domain= qld.stats[[input$stats]])
} else {
pal <- colorNumeric(c("#C12525", "#33ffff"), domain = qld.stats[[input$stats]], reverse = FALSE)
}
#creating a proxy map that displays the various stats from the stats drp down
leafletProxy("map", data = qld.stats) %>%
clearShapes() %>%
addPolygons(
layerId = qld.stats$Elect_div,
fillColor = ~pal(qld.stats[[input$stats]]),
fillOpacity = 0.6,
weight = 0.6,
opacity = 1,
color = "#444444",
dashArray = "5",
label = labels,
highlight = highlightOptions(
weight = 4,
color = "#FFFFFF",
dashArray = "",
fillOpacity = 0.9,
bringToFront = TRUE),
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 5px"),
textsize = "13px",
direction = "auto")
)

color mapping polygons based on user input

I want to color map my polygons based on the user input. The column i am using has categorial variables so I am using the colorFactor function which I have tested it is functioning normally. The issue is with the observe function when I load my shiny app it terminates immediately and outputs "Error in addPolygons: unused argument (fillcolor = ~pal(AreaTyp)) in leaflet".My question is how to include reactivity correctly using the observe function. Here is my code:
#INTERACTIVE MAPPING
#colorfunction
pal<-colorFactor(rainbow(7),mp$AreaTyp)
#set data based on user input
fdata<-reactive({
data<-mp
if(input$area!="All"){
data<-data[data$AreaType==input$area,]
}
data
})
output$leaf<-renderLeaflet({
leaflet(fdata()) %>%
#Initializing the map
setView(lng=36.092245, lat=-00.292115,zoom=15)%>%
#Base map
#Add default OpenStreetMap map tiles
addTiles(group = "default")%>%
#addProviderTiles("Esri.NatGeoWorldMap",group = "default")%>%
#addProviderTiles("CartoDB.Positron",group = "custom")%>%
#Overlay map
addPolygons(
data = fdata(),
fillColor = "blue",
weight = 1, smoothFactor = 0.5,
opacity = 1.0, fillOpacity = 1.0,
group = "basepoly",
highlightOptions = highlightOptions(
weight = 2,
color = "red",
fillOpacity = 0.7,
bringToFront = TRUE
),label =~LIA
)
})
observe({
leafletProxy("leaf",data = fdata()) %>%
clearShapes() %>%
addPolygons(
weight = 1, smoothFactor = 0.5,
opacity = 1.0, fillOpacity = 1.0,
data=fdata(),
fillcolor = ~pal(AreaTyp),
label =~LIA
)
})
Change fillcolor = ~pal(AreaTyp) to fillColor = ~pal(AreaTyp)
Let's break down your error.
"Error in addPolygons: unused argument (fillcolor = ~pal(AreaTyp)) in leaflet"
first:
"Error in addPolygons:
this means that addPolygons failed to run. not that the observer failed
second
"unused argument "
This means that you added an argument that addpolygons can not use.
Third
(fillcolor = ~pal(AreaTyp)) in leaflet
This is telling you exactly which argument is wrong.

Grouped layer control in Leaflet R

There is a plug-in for Leaflet JS that allows to group the layers in the layer control. https://github.com/ismyrnow/Leaflet.groupedlayercontrol
This plug-in does not seem to exist for Leaflet R but I found this post saying that there is a way to use arbitraty Leaflet JS plug-in in Leaflet R.
https://gist.github.com/jcheng5/c084a59717f18e947a17955007dc5f92
I tried to apply this method to the Leaflet.groupedlayercontrol plug-in but did not succeed. Do you have any idea how I can possibly use this plug-in or any other way to group my layers in the layercontrol generated by Leaflet R? Thank you.
You definitely can do layer control in leafletR. If you version does not have it, then you need to update, probably from the most recent GITHUB version.
I am working on a map right now that has layer controls, see the photograph. Here is the code that makes it happen. As you can see each of the addPolygons has a group = " A Name" This is where you identify the layers in the check boxes on my image.
map<-leaflet()%>%
addTiles()%>%
addPolygons(data = plotMerge,
fillColor = ~pal(plotMerge$incomePerCapita),
color = "#000000", #this is an outline color
fillOpacity = 0.8,
group="Tract",
weight = 0.2,
popup=popup)%>%
addPolygons(data = countyPoly,
fillColor = "transparent",
color = "#000000", #this is an outline color
fillOpacity = 0.8,
group="County",
popup=countyPoly#data$NAME,
weight = 2)%>%
addPolygons(data = townPoly,
fillColor = "transparent",
color = "#000000", #this is an outline color
fillOpacity = 0.8,
group="Town",
weight = .8,
popup=townPoly#data$TOWN)%>%
addPolygons(data = rphnPoly,
fillColor = "transparent",
color = "#000000", #this is an outline color
fillOpacity = 0.8,
group="Public Health Region",
weight = .8,
popup=rphnPoly#data$PHN)%>%
addLegend(pal = pal,
values = plotMerge$incomePerCapita,
position = "bottomright",
title = "State-wide Income Percentiles",
labFormat = labelFormat(digits=1))%>%
addLayersControl(
overlayGroups =c("County", "Town", "Public Health Region", "Tract"),
options = layersControlOptions(collapsed=FALSE)
)
saveWidget(map, file="map1.html", selfcontained=FALSE)
Here is what it looks like:
You can also add other controls check it out here:
Leaflet R Hidden Layers
I know this is an old question but I didn't find a good answer elsewhere - this may help others in the future.
Here is a reprex with comments that explains the code:
#load library
library(tidyverse)
library(leaflet)
#load data
data("quakes")
#map all points
# quakes %>%
# leaflet() %>%
# addProviderTiles(providers$CartoDB.Positron) %>%
# addCircleMarkers(lng = ~long, lat = ~lat, radius = 1)
#create a grouping variable -- this can be whatever you want to filter by
quakes <- quakes %>%
mutate(groups = case_when(
stations < 30 ~ 1,
stations < 50 ~ 2,
TRUE ~ 3
))
#function to plot a map with layer selection
map_layers <- function() {
#number of groups
k <- n_distinct(quakes$groups)
#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 = quakes %>% filter(groups == i), group = as.character(i),
lng = ~long, lat = ~lat, radius = 1
)
}
#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()

Resources