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")
)