我正在基于选举结果构建一个应用程序，我想用每个选民的当选政党颜色为传单地图上的多边形着色。用户可以选择要查看结果的年份：Sitting Party（当前），2013等。
我在这里已经阅读了很多有关基于用户输入的动态调色板和反应式调色板的信息，但是它们都无法与我的预定义调色板一起使用，后者根据聚会的颜色为每个聚会的缩写设置特定的颜色。
我不确定我错过了什么或做错了什么，但是将非常感谢您的帮助。
您可以在此处下载shp文件，我使用的是昆士兰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)
答案 0 :(得分：1)
因此，我想出了一个解决方法，即需要一个预定义的配色方案（政党颜色）才能根据下拉菜单中的用户输入在传单地图上填充多边形。
我的解决方案并不完全符合我的要求，但是绝对可以，我对此感到满意。
#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")
)