数据链接在这里。 你好，我正在开发一个闪亮的应用程序。我有包含所有选项的下拉菜单，并且颜色在地图上一致且透明。但我选择了一个特定的城市，它变成了更纯的颜色，几乎或没有透明。我该如何修改代码。这是我的用户界面和服务器代码
tabPanel("Interactive Map", icon = icon("map"),
# Sidebar with a select input
sidebarLayout(
sidebarPanel(
p("This app allows you to visualize the social vulnerability index in the city of Portland.
Please choose the variables under the drop down menu."),
# For Variable
selectInput(inputId = "variable",
label = "Variable:",
choices = c("Overall SVI Ranking" = "RPL_THEMES",
"Socioeconomic Status Theme Ranking" = "RPL_THEME1",
"Household Characteristics Theme Ranking" = "RPL_THEME2",
"Racial & Ethnic Minority Status Theme Ranking" = "RPL_THEME3",
"Housing Type & Transportation Theme Ranking" = "RPL_THEME4",
"Population Estimate" = "E_TOTPOP",
"Housing Units Estimate" = "E_HU",
"Households Estimate" = "E_HH",
"Age 17 & Younger" = "EP_AGE17",
"Age 65 & Older" = "EP_AGE65",
"More People than Rooms" = "EP_CROWD",
"Population with a Disability" = "EP_DISABL",
"Persons in Group Quarters" = "EP_GROUPQ",
"Housing Cost Burden" = "EP_HBURD",
"Limited English Speaking" = "EP_LIMENG",
"Minority" = "EP_MINRTY",
"Mobile Homes" = "EP_MOBILE",
"Housing with Multiple Units" = "EP_MUNIT",
"No High School Diploma" = "EP_NOHSDP",
"Households with No Vehicles" = "EP_NOVEH",
"Below 150% Poverty" = "EP_POV150",
"Single Parent Households" = "EP_SNGPNT",
"Unemployment Rate" = "EP_UNEMP",
"No Health Insurance" = "EP_UNINSUR"),
selected = "Overall SVI Ranking"),
# For Base Map
selectInput("basemap",
label = "Basemap",
choices = c(
"All" = "All",
"Open Street Map" = "OpenStreetMap",
"CARTO Positron" = "CartoDB.Positron",
"CARTO Voyager" = "CartoDB.Voyager",
"Stadia Toner" = "Stadia.StamenToner"),
selected = "OpenStreetMap"),
# For City
selectInput("city",
label = "City:",
choices = c(
"All" = "All",
"Portland City" = "Portland",
"South Portland City" = "South Portland",
"Westbrook City" = "Westbrook"),
selected = "All"
),
mainPanel(
leafletOutput("map", width = "100%", height = "700px"),
# Data source caption below the map
tags$div(style = "text-align: right; font-size: 10px; margin-top: 10px;",
tags$b("Data source:"),
"2018-2022 ACS, US Census Bureau"),
width = 9
)))
这是我的服务器代码。
# Erase Water
plsvi <- erase_water(svi, year = 2020) %>% st_make_valid()
# Transform spatial data to WGS84
sviwgs84 <- reactive({
plsvi %>% st_transform(crs = 4326)
})
# Filter data based on city selection
filtered_data <- reactive({
if("All" %in% input$city){
sviwgs84()
} else {
sviwgs84() %>% filter(CITY == input$city)
}
})
# Map basemap names to their corresponding provider objects
basemap_providers <- list(
"OpenStreetMap" = providers$OpenStreetMap,
"CartoDB.Positron" = providers$CartoDB.Positron,
"CartoDB.Voyager" = providers$CartoDB.Voyager,
"Stadia.StamenToner" = providers$Stadia.StamenToner
)
# Define the variable-label mapping using the choices vector
variable_labels <- list(
"RPL_THEMES" = "Overall SVI Ranking",
"RPL_THEME1" = "Socioeconomic Status Theme Ranking",
"RPL_THEME2" = "Household Characteristics Theme Ranking",
"RPL_THEME3" = "Racial & Ethnic Minority Status Theme Ranking",
"RPL_THEME4" = "Housing Type & Transportation Theme Ranking",
"E_TOTPOP" = "Population Estimate",
"E_HU" = "Housing Units Estimate",
"E_HH" = "Households Estimate",
"EP_AGE17" = "Age 17 & Younger",
"EP_AGE65" = "Age 65 & Older",
"EP_CROWD" = "More People than Rooms",
"EP_DISABL" = "Population with a Disability",
"EP_GROUPQ" = "Persons in Group Quarters",
"EP_HBURD" = "Housing Cost Burden",
"EP_LIMENG" = "Limited English Speaking",
"EP_MINRTY" = "Minority",
"EP_MOBILE" = "Mobile Homes",
"EP_MUNIT" = "Housing with Multiple Units",
"EP_NOHSDP" = "No High School Diploma",
"EP_NOVEH" = "Households with No Vehicles",
"EP_POV150" = "Below 150% Poverty",
"EP_SNGPNT" = "Single Parent Households",
"EP_UNEMP" = "Unemployment Rate",
"EP_UNINSUR" = "No Health Insurance"
)
# Compute totals for info boxes
total_tracts <- nrow(svi)
total_population <- sum(st_drop_geometry(svi)$E_TOTPOP, na.rm=TRUE)
total_housing <- sum(st_drop_geometry(svi)$E_HU, na.rm=TRUE)
total_households <- sum(st_drop_geometry(svi)$E_HH, na.rm=TRUE)
# Create a reactive dataframe
portlandsvi <- reactive({svi %>% st_drop_geometry() %>% select(input$variable) %>% pull() %>% as.numeric() })
# Set colors
pal <- reactive({
colorNumeric("viridis", domain = portlandsvi(), alpha = 0.3, reverse = TRUE)
})
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = basemap_providers[[input$basemap]]) %>%
addPolygons(
data = filtered_data(),
fillColor = ~ pal()(portlandsvi()),
weight = 0.5,
opacity = 0.5,
fillOpacity = ~ fillOpacity,
smoothFactor = 0.2,
color = "black",
label = ~ if (input$variable %in% c("RPL_THEMES","RPL_THEME1","RPL_THEME2","RPL_THEME3",
"RPL_THEME4","E_TOTPOP","E_HU","E_HH")) {
paste0(variable_labels[[input$variable]], ": ", round(portlandsvi(), 2))
} else {
paste0(variable_labels[[input$variable]], ": ", round(portlandsvi(), 2),"%")
},
labelOptions = labelOptions(
style = NULL,
textsize = "10px",
direction = "auto",
opacity = 1,
textOnly = FALSE
),
# Tooltip for Census Tract
highlight = highlightOptions(
color = "white",
weight = 2.5,
bringToFront = TRUE
),
# Tooltip for census tract
popup = ~ paste(
"<div style='font-size: 10px;'>",
"<strong>Census Tract: </strong>", str_remove(NAMELSAD, "Census Tract"), "<br/>",
"<strong>Population: </strong>", formatC(E_TOTPOP, format = "d", big.mark = ","), "<br/>",
"<strong>Housing Units: </strong>", formatC(E_HU, format = "d", big.mark = ","), "<br/>",
"<strong>Households: </strong>", formatC(E_HH, format = "d", big.mark = ","), "<br/>",
"<strong>City: </strong>", CITY
),
popupOptions = popupOptions(
autoPan = TRUE,
closeButton = TRUE
)
) %>%
addLegend(
position = "topright",
pal = pal(),
values = filtered_data()[[input$variable]],
title = variable_labels[[input$variable]],
opacity = 0.8,
labFormat = labelFormat(suffix = "", digits = 2)
) %>%
setView(lng = -70.2110, lat = 43.6770, zoom = 12)
})
我创建了 fillOpacity 列并将其添加到数据集作为解决此问题的替代方法，但它不起作用。 抱歉代码很长，非常感谢您的帮助和专业知识。
因此，问题似乎是由反应式数据帧对象
portlandsvisvifiltered_data()portlandsvi <- reactive({
filtered_data() %>% st_drop_geometry() %>% select(input$variable) %>%
pull() %>% as.numeric()
})
然后使调色板的
domaindataaddPolygons()app.RfillOpacityfillOpacity = ~ fillOpacityfillOpacity = 0.5leafletserver <- function(input, output, session) {
# Erase Water
plsvi <- erase_water(svi, year = 2020) %>% st_make_valid()
# Transform spatial data to WGS84
sviwgs84 <- reactive({
plsvi %>%
st_transform(crs = 4326)
})
# Filter data based on city selection
filtered_data <- reactive({
if("All" %in% input$city){
sviwgs84()
} else {
sviwgs84() %>% dplyr::filter(CITY == input$city)
}
})
# Map basemap names to their corresponding provider objects
basemap_providers <- list(
"OpenStreetMap" = providers$OpenStreetMap,
"CartoDB.Positron" = providers$CartoDB.Positron,
"CartoDB.Voyager" = providers$CartoDB.Voyager,
"Stadia.StamenToner" = providers$Stadia.StamenToner
)
# Define the variable-label mapping using the choices vector
variable_labels <- list(
"RPL_THEMES" = "Overall SVI Ranking",
"RPL_THEME1" = "Socioeconomic Status Theme Ranking",
"RPL_THEME2" = "Household Characteristics Theme Ranking",
"RPL_THEME3" = "Racial & Ethnic Minority Status Theme Ranking",
"RPL_THEME4" = "Housing Type & Transportation Theme Ranking",
"E_TOTPOP" = "Population Estimate",
"E_HU" = "Housing Units Estimate",
"E_HH" = "Households Estimate",
"EP_AGE17" = "Age 17 & Younger",
"EP_AGE65" = "Age 65 & Older",
"EP_CROWD" = "More People than Rooms",
"EP_DISABL" = "Population with a Disability",
"EP_GROUPQ" = "Persons in Group Quarters",
"EP_HBURD" = "Housing Cost Burden",
"EP_LIMENG" = "Limited English Speaking",
"EP_MINRTY" = "Minority",
"EP_MOBILE" = "Mobile Homes",
"EP_MUNIT" = "Housing with Multiple Units",
"EP_NOHSDP" = "No High School Diploma",
"EP_NOVEH" = "Households with No Vehicles",
"EP_POV150" = "Below 150% Poverty",
"EP_SNGPNT" = "Single Parent Households",
"EP_UNEMP" = "Unemployment Rate",
"EP_UNINSUR" = "No Health Insurance"
)
# Create a reactive dataframe
portlandsvi <- reactive({
filtered_data() %>% st_drop_geometry() %>% select(input$variable) %>%
pull() %>% as.numeric()
}) # Need to drop geometry first otherwise give error
# Set colors
pal <- reactive({
colorNumeric(
"viridis",
domain = portlandsvi(),
alpha = 0.3,
reverse = TRUE
)
})
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = basemap_providers[[input$basemap]]) %>%
addPolygons(
data = filtered_data(),
fillColor = ~ pal()(portlandsvi()),
weight = 0.5,
fillOpacity = 0.5,
smoothFactor = 0.2,
color = "black",
label = ~ if (input$variable %in% c(
"RPL_THEMES",
"RPL_THEME1",
"RPL_THEME2",
"RPL_THEME3",
"RPL_THEME4",
"E_TOTPOP",
"E_HU",
"E_HH"
)) {
paste0(variable_labels[[input$variable]], ": ", round(portlandsvi(), 2))
} else {
paste0(variable_labels[[input$variable]], ": ", round(portlandsvi(), 2), "%")
},
labelOptions = labelOptions(
style = NULL,
textsize = "10px",
direction = "auto",
opacity = 1,
textOnly = FALSE
),
# Tooltip for Census Tract
highlight = highlightOptions(
color = "white",
weight = 2.5,
bringToFront = TRUE
),
# Tooltip for census tract
popup = ~ paste(
"<div style='font-size: 10px;'>",
"<strong>Census Tract: </strong>",
str_remove(NAMELSAD, "Census Tract"),
"<br/>",
"<strong>Population: </strong>",
formatC(E_TOTPOP, format = "d", big.mark = ","),
"<br/>",
"<strong>Housing Units: </strong>",
formatC(E_HU, format = "d", big.mark = ","),
"<br/>",
"<strong>Households: </strong>",
formatC(E_HH, format = "d", big.mark = ",")
),
popupOptions = popupOptions(autoPan = TRUE, closeButton = TRUE)
) %>%
addLegend(
position = "topright",
pal = pal(),
values = portlandsvi(),
title = variable_labels[[input$variable]],
opacity = 0.8,
labFormat = labelFormat(suffix = "", digits = 2)
) %>%
setView(lng = -70.2010,
lat = 43.6190,
zoom = 11.2)
})
}