Link to the data is here.
Hi I am developing a Shiny App. I have drop down menu with All options and the colors are consistent and transparent across the map. But I choose a particular city, it turns out into a more solid color with almost or no transparent. How can I modify the code. Here is my UI and Server code
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
)))
And this is my server code.
# 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)
})
I created fillOpacity column and added to the dataset as an alternative way to solve this problem but it did not work.
Sorry for the very long code and thank you so much for your kind help and expertise.
2