Я создаю приложение на основе результатов выборов, и я хотел бы раскрасить полигоны на листовой карте цветами избранных партий в расчете на электорат.Пользователь может выбрать год, за который вы хотите увидеть результаты: Заседание (текущее), 2013 и т. Д.
Я много читал здесь о динамических цветовых палитрах и реактивных цветовых палитрах, основанных на пользовательском вводе, ноНи один из них не работает с моей предопределенной цветовой палитрой, которая устанавливает определенный цвет для каждой аббревиатуры партии на основе цветов вечеринки.
Я не уверен, что я пропускаю или делаю неправильно, но помощь будет очень полезна.
Вы можете скачать файлы shp здесь, я использовал дистрибутивы Queensland 2018: https://www.aec.gov.au/electorates/gis/
А вот данные избранной партии, которые я объединил с файлом формы на поле 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)