Shiny交互式地图选择特定城市时透明度不一致问题求助

核心问题分析 #

1. 原代码中fillOpacity绑定数据列但未根据城市选择动态切换，且颜色映射使用原始全量数据而非筛选后的数据，导致单个城市选择时颜色范围和透明度不符合预期。
2. 颜色调色板的alpha参数固定为0.3，无法区分全部/单个城市的显示效果。
3. portlandsvi()使用原始数据，筛选单个城市时会出现数据长度不匹配的问题。

修改后的完整代码 #

UI代码

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

Server代码

# 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(input$city == "All"){
    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({
  filtered_data() %>% 
    st_drop_geometry() %>% 
    select(input$variable) %>% 
    pull() %>% 
    as.numeric()
}) 

# Set colors (alpha设为1，由fillOpacity控制透明度)
pal <- reactive({
  colorNumeric("viridis", domain = portlandsvi(), alpha = 1, reverse = TRUE)
})


output$map <- renderLeaflet({
  leaflet() %>% 
    addProviderTiles(provider = basemap_providers[[input$basemap]]) %>% 
    addPolygons(
      data = filtered_data(),
      fillColor = ~ pal()(get(input$variable)), # 直接从筛选数据中取变量
      weight = 0.5,
      opacity = 0.5,
      fillOpacity = if(input$city == "All") 0.3 else 0.9, # 动态切换透明度
      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(get(input$variable), 2))
      } else {
        paste0(variable_labels[[input$variable]], ": ", round(get(input$variable), 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 = if(input$city == "All") 0.3 else 0.9, # 图例透明度同步
      labFormat = labelFormat(suffix = "", digits = 2)
    ) %>% 
    setView(lng = -70.2110, lat = 43.6770, zoom = 12) 
})

关键修改点说明 #

1. 动态透明度控制：将fillOpacity从绑定数据列改为根据input$city判断，选择"All"时设为0.3，单个城市时设为0.9（可根据需求调整数值），同时图例透明度同步调整。
2. 颜色映射修正：portlandsvi()改为使用筛选后的数据，确保颜色范围匹配当前显示的地理区域；调色板alpha设为1，避免颜色本身的透明度干扰。
3. 填充颜色修正：fillColor直接从filtered_data()中通过get(input$variable)获取当前变量，避免原始数据与筛选数据的长度不匹配问题。
4. Basemap选项修正：移除UI中无效的"All"选项，避免basemap_providers找不到对应值的报错。

内容的提问来源于stack exchange，提问作者Ko Htut