mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-30 05:08:57 +00:00
update entire app to begin using bslib instead of flexdashboard
This commit is contained in:
+721
@@ -0,0 +1,721 @@
|
||||
server <- function(input, output, session) {
|
||||
storm_coverage <- get_storm_data_coverage() %>%
|
||||
select(-storm_basin) %>%
|
||||
{
|
||||
col_names <- names(.)
|
||||
mutate(
|
||||
.,
|
||||
data = trimws(paste(
|
||||
ifelse(
|
||||
as.logical(.data[[col_names[3]]]),
|
||||
'<span class="badge badge-primary">Fatality</span>',
|
||||
""
|
||||
),
|
||||
ifelse(
|
||||
as.logical(.data[[col_names[4]]]),
|
||||
'<span class="badge badge-success">Cost</span>',
|
||||
""
|
||||
)
|
||||
))
|
||||
) %>%
|
||||
select(1, 2, data)
|
||||
}
|
||||
|
||||
output$storm_coverage_table <- renderDT({
|
||||
datatable(
|
||||
storm_coverage,
|
||||
rownames = F,
|
||||
escape = F,
|
||||
colnames = c("Year", "Name", "Data"),
|
||||
selection = "single",
|
||||
options = list(
|
||||
pageLength = 1000,
|
||||
order = list(0, 'desc'),
|
||||
searching = F,
|
||||
paging = F,
|
||||
info = F,
|
||||
lengthChange = F
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
dt_storm_selected <- reactive({
|
||||
req(input$storm_coverage_table_rows_selected)
|
||||
storm_coverage[input$storm_coverage_table_rows_selected, ]
|
||||
})
|
||||
|
||||
output$dt_storm_name_year <- renderText({
|
||||
paste0(
|
||||
dt_storm_selected()$storm_name,
|
||||
" (",
|
||||
dt_storm_selected()$storm_year,
|
||||
")"
|
||||
)
|
||||
})
|
||||
|
||||
output$selected_storm_name_year <- renderText({
|
||||
if (is.null(storm_selection$storm_name)) {
|
||||
"Select a storm"
|
||||
} else {
|
||||
paste0(
|
||||
storm_selection$storm_name,
|
||||
" (",
|
||||
storm_selection$storm_year,
|
||||
")"
|
||||
)
|
||||
}
|
||||
})
|
||||
|
||||
observe({
|
||||
req(
|
||||
storm_selection$storm_basin,
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name
|
||||
)
|
||||
|
||||
unique_lfs <- get_unique_lf_ids(storm_selection)
|
||||
|
||||
updateVirtualSelect(
|
||||
session = session,
|
||||
"storm_overview_cost_index_lf_select",
|
||||
choices = prepare_choices(unique_lfs, full_lf_id, full_lf_id, lf_type),
|
||||
selected = unique_lfs$full_lf_id[1]
|
||||
)
|
||||
|
||||
updateSelectInput(
|
||||
session,
|
||||
"growth_trend_lf_select",
|
||||
choices = unique_lfs$full_lf_id,
|
||||
selected = unique_lfs$full_lf_id[1]
|
||||
)
|
||||
})
|
||||
|
||||
observeEvent(input$load_storm, {
|
||||
storm_selection$storm_basin <- "AL"
|
||||
storm_selection$storm_year <- dt_storm_selected()$storm_year
|
||||
storm_selection$storm_name <- dt_storm_selected()$storm_name
|
||||
|
||||
hurdatid <- get_hurdat_id(storm_selection)
|
||||
storm_selection$hurdatid = hurdatid$hurdatid
|
||||
|
||||
selected_storm <-
|
||||
paste0(
|
||||
dt_storm_selected()$storm_name,
|
||||
" (",
|
||||
dt_storm_selected()$storm_year,
|
||||
")"
|
||||
)
|
||||
|
||||
nav_select("main_navbar", "Storm Explorer")
|
||||
})
|
||||
|
||||
output$all_storms_map <- renderLeaflet({
|
||||
leaflet() %>%
|
||||
addProviderTiles("Stadia.AlidadeSmooth") %>%
|
||||
addCircleMarkers(
|
||||
data = all_conus_landfalls,
|
||||
lng = ~lon,
|
||||
lat = ~lat,
|
||||
radius = 2,
|
||||
popup = ~ paste0(storm_name, " ", storm_year),
|
||||
weight = 0,
|
||||
color = "blue",
|
||||
fillColor = "blue",
|
||||
fillOpacity = 0.5
|
||||
) %>%
|
||||
addCircles(
|
||||
data = all_conus_landfalls,
|
||||
lng = ~lon,
|
||||
lat = ~lat,
|
||||
radius = ~rmw_meters,
|
||||
popup = ~ paste0(storm_name, " ", storm_year),
|
||||
weight = 1,
|
||||
color = "blue",
|
||||
fillColor = "blue",
|
||||
fillOpacity = 0.05
|
||||
)
|
||||
})
|
||||
|
||||
storm_track <- reactive({
|
||||
req(
|
||||
storm_selection$storm_basin,
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name
|
||||
)
|
||||
result <- get_hurdat_track(storm_selection)
|
||||
|
||||
# HURDAT storm status
|
||||
# TD – Tropical cyclone of tropical depression intensity (< 34 knots)
|
||||
# TS – Tropical cyclone of tropical storm intensity (34-63 knots)
|
||||
# HU – Tropical cyclone of hurricane intensity (> 64 knots)
|
||||
# EX – Extratropical cyclone (of any intensity)
|
||||
# SD – Subtropical cyclone of subtropical depression intensity (< 34 knots)
|
||||
# SS – Subtropical cyclone of subtropical storm intensity (> 34 knots)
|
||||
# LO – A low that is neither a tropical cyclone, a subtropical cyclone, nor an extratropical cyclone (of any intensity)
|
||||
# WV – Tropical Wave (of any intensity)
|
||||
# DB – Disturbance (of any intensity)
|
||||
|
||||
# Line Color Storm Type Status Pressure (mb) Wind (mph) Wind (knots)
|
||||
# Blue Subtropical Depression SD -- <=38 <=33
|
||||
# Light Blue Subtropical Storm SS -- 39-73 34-63
|
||||
# Green Tropical Depression (TD) TD -- <=38 <=33
|
||||
# Yellow Tropical Storm (TS) TS 980+ 39-73 34-63
|
||||
# Red Hurricane (Cat 1) HU <=980 74-95 64-82
|
||||
# Pink Hurricane (Cat 2) HU 965-980 96-110 83-95
|
||||
# Magenta Major Hurricane (Cat 3) HU 945-965 111-129 96-112
|
||||
# Purple Major Hurricane (Cat 4) HU 920-945 130-156 113-136
|
||||
# White Major Hurricane (Cat 5) HU <=920 157+ 137+
|
||||
# Green dashed (- -) Wave/Low/Disturbance WV/LO/DB -- -- --
|
||||
# Black hatched (++) Extratropical Cyclone EX -- -- --
|
||||
|
||||
# Category Sustained Windspeed (knots)
|
||||
# 1 64-82
|
||||
# 2 83-95
|
||||
# 3 96-112
|
||||
# 4 113-136
|
||||
# 5 137+
|
||||
|
||||
# Preprocess the track data with colors
|
||||
result <- result %>%
|
||||
mutate(
|
||||
hurricane_category = case_when(
|
||||
# Hurricane Cat 1
|
||||
storm_status == "HU" & windspeed >= 64 & windspeed <= 82 ~ 1,
|
||||
|
||||
# Hurricane Cat 2
|
||||
storm_status == "HU" & windspeed >= 83 & windspeed <= 95 ~ 2,
|
||||
|
||||
# Hurricane Cat 3
|
||||
storm_status == "HU" & windspeed >= 96 & windspeed <= 112 ~ 3,
|
||||
|
||||
# Hurricane Cat 4
|
||||
storm_status == "HU" & windspeed >= 113 & windspeed <= 136 ~ 4,
|
||||
|
||||
# Hurricane Cate 5
|
||||
storm_status == "HU" & windspeed >= 137 ~ 5,
|
||||
),
|
||||
line_color = case_when(
|
||||
# Tropical Depression - Green
|
||||
storm_status == "TD" ~ "#2AFF00",
|
||||
|
||||
# Tropical Storm - Yellow
|
||||
storm_status == "TS" ~ "#FFD020",
|
||||
|
||||
# Hurricane Cat 1 - Red
|
||||
hurricane_category == 1 ~ "#FF4343",
|
||||
|
||||
# Hurricane Cat 2 - Pink
|
||||
hurricane_category == 2 ~ "#FF6FFF",
|
||||
|
||||
# Hurricane Cat 3 - Magenta
|
||||
hurricane_category == 3 ~ "#FF23D3",
|
||||
|
||||
# Hurricane Cat 4 - Purple
|
||||
hurricane_category == 4 ~ "#C916FF",
|
||||
|
||||
# Hurricane Cate 5 - White
|
||||
hurricane_category == 5 ~ "#FFFFFF",
|
||||
|
||||
# Extratropical Cyclone
|
||||
storm_status == "EX" ~ "#202020",
|
||||
|
||||
# Subtropical Depression
|
||||
storm_status == "SD" ~ "#0055FF",
|
||||
|
||||
# Subtropical Storm
|
||||
storm_status == "SS" ~ "#6CE2FF",
|
||||
|
||||
# Low
|
||||
storm_status == "LO" ~ "#A1A1A1",
|
||||
|
||||
# Wave
|
||||
storm_status == "WV" ~ "#A1A1A1",
|
||||
|
||||
# Disturbance
|
||||
storm_status == "DB" ~ "#A1A1A1",
|
||||
|
||||
# Missing
|
||||
TRUE ~ "#FF5C00"
|
||||
),
|
||||
popup_category = case_when(
|
||||
storm_status == "TD" ~ "TD",
|
||||
storm_status == "TS" ~ "TS",
|
||||
hurricane_category == 1 ~ "H1",
|
||||
hurricane_category == 2 ~ "H2",
|
||||
hurricane_category == 3 ~ "H3",
|
||||
hurricane_category == 4 ~ "H4",
|
||||
hurricane_category == 5 ~ "H5",
|
||||
storm_status == "EX" ~ "EX",
|
||||
storm_status == "SD" ~ "SD",
|
||||
storm_status == "SS" ~ "SS",
|
||||
storm_status == "LO" ~ "LO",
|
||||
storm_status == "WV" ~ "WV",
|
||||
storm_status == "DB" ~ "DB",
|
||||
TRUE ~ "NA"
|
||||
)
|
||||
) %>%
|
||||
arrange(datetime)
|
||||
|
||||
return(result)
|
||||
}) %>%
|
||||
bindCache(
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name,
|
||||
storm_selection$storm_basin
|
||||
)
|
||||
|
||||
output$track_map <- renderLeaflet({
|
||||
track_data <- storm_track()
|
||||
|
||||
map <- leaflet() %>%
|
||||
addProviderTiles("Stadia.AlidadeSmooth") %>%
|
||||
fitBounds(
|
||||
lng1 = min(track_data$lon),
|
||||
lng2 = max(track_data$lon),
|
||||
lat1 = min(track_data$lat),
|
||||
lat2 = max(track_data$lat)
|
||||
)
|
||||
|
||||
map <- map %>%
|
||||
leaflet::addLegend(
|
||||
position = "bottomleft",
|
||||
colors = c(
|
||||
"#2AFF00", # TD
|
||||
"#FFD020", # TS
|
||||
"#FF4343", # Cat 1
|
||||
"#FF6FFF", # Cat 2
|
||||
"#FF23D3", # Cat 3
|
||||
"#C916FF", # Cat 4
|
||||
"#FFFFFF", # Cat 5
|
||||
"#202020", # EX
|
||||
"#0055FF", # SD
|
||||
"#6CE2FF", # SS
|
||||
"#A1A1A1", # LO/WV/DB
|
||||
"#FF5C00" # Missing
|
||||
),
|
||||
labels = c(
|
||||
"Tropical Depression (TD)",
|
||||
"Tropical Storm (TS)",
|
||||
"Hurricane Category 1",
|
||||
"Hurricane Category 2",
|
||||
"Hurricane Category 3",
|
||||
"Hurricane Category 4",
|
||||
"Hurricane Category 5",
|
||||
"Extratropical Cyclone (EX)",
|
||||
"Subtropical Depression (SD)",
|
||||
"Subtropical Storm (SS)",
|
||||
"Low/Wave/Disturbance (LO/WV/DB)",
|
||||
"Missing Data"
|
||||
),
|
||||
opacity = 1,
|
||||
title = "Track Legend"
|
||||
)
|
||||
|
||||
if (nrow(track_data) >= 2) {
|
||||
for (i in 1:(nrow(track_data) - 1)) {
|
||||
segment_data <- track_data[i:(i + 1), ]
|
||||
|
||||
map <- map %>%
|
||||
addPolylines(
|
||||
data = segment_data,
|
||||
lng = ~lon,
|
||||
lat = ~lat,
|
||||
weight = 2,
|
||||
color = track_data$line_color[i],
|
||||
opacity = 1
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
map <- map %>%
|
||||
addCircleMarkers(
|
||||
data = track_data,
|
||||
lng = ~lon,
|
||||
lat = ~lat,
|
||||
radius = 2,
|
||||
color = ~line_color,
|
||||
fillOpacity = 1,
|
||||
popup = ~ paste0(
|
||||
"<b>DATE</b>",
|
||||
"<br>",
|
||||
datetime,
|
||||
"<br>",
|
||||
"<b>CATEGORY</b>",
|
||||
"<br>",
|
||||
popup_category,
|
||||
"<br>",
|
||||
"<b>WINDSPEED</b>",
|
||||
"<br>",
|
||||
windspeed,
|
||||
"kt",
|
||||
"<br>",
|
||||
"<b>PRESSURE</b>",
|
||||
"<br>",
|
||||
pressure,
|
||||
"mb"
|
||||
)
|
||||
)
|
||||
|
||||
landfall_data <- track_data %>%
|
||||
filter(record_identifier == "L")
|
||||
|
||||
if (nrow(landfall_data) > 0) {
|
||||
map <- map %>%
|
||||
addCircleMarkers(
|
||||
data = landfall_data,
|
||||
lng = ~lon,
|
||||
lat = ~lat,
|
||||
radius = 5,
|
||||
weight = 0,
|
||||
color = ~line_color,
|
||||
fillColor = ~line_color,
|
||||
fillOpacity = 1,
|
||||
popup = ~ paste0(
|
||||
"<b>LANDFALL</b>",
|
||||
"<br>",
|
||||
"<b>DATE</b>",
|
||||
"<br>",
|
||||
datetime,
|
||||
"<br>",
|
||||
"<b>CATEGORY</b>",
|
||||
"<br>",
|
||||
popup_category,
|
||||
"<br>",
|
||||
"<b>WINDSPEED</b>",
|
||||
"<br>",
|
||||
windspeed,
|
||||
"kt",
|
||||
"<br>",
|
||||
"<b>PRESSURE</b>",
|
||||
"<br>",
|
||||
pressure,
|
||||
"mb",
|
||||
"<br>",
|
||||
"<b>RMW</b>",
|
||||
"<br>",
|
||||
rmw,
|
||||
"nm"
|
||||
)
|
||||
) %>%
|
||||
addCircles(
|
||||
data = landfall_data,
|
||||
lng = ~lon,
|
||||
lat = ~lat,
|
||||
radius = ~rmw_meters,
|
||||
weight = 2,
|
||||
color = ~line_color,
|
||||
fillColor = ~line_color,
|
||||
fillOpacity = 0.3,
|
||||
popup = ~ paste0(
|
||||
"<b>LANDFALL</b>",
|
||||
"<br>",
|
||||
"<b>DATE</b>",
|
||||
"<br>",
|
||||
datetime,
|
||||
"<br>",
|
||||
"<b>CATEGORY</b>",
|
||||
"<br>",
|
||||
popup_category,
|
||||
"<br>",
|
||||
"<b>WINDSPEED</b>",
|
||||
"<br>",
|
||||
windspeed,
|
||||
"kt",
|
||||
"<br>",
|
||||
"<b>PRESSURE</b>",
|
||||
"<br>",
|
||||
pressure,
|
||||
"mb",
|
||||
"<br>",
|
||||
"<b>RMW</b>",
|
||||
"<br>",
|
||||
rmw,
|
||||
"nm"
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
return(map)
|
||||
})
|
||||
|
||||
output$track_data <- renderDT({
|
||||
datatable(
|
||||
storm_track() %>%
|
||||
select(
|
||||
formatted_datetime,
|
||||
storm_status,
|
||||
lon,
|
||||
lat,
|
||||
rmw,
|
||||
pressure,
|
||||
windspeed
|
||||
),
|
||||
rownames = F,
|
||||
colnames = c(
|
||||
"Date",
|
||||
"Status",
|
||||
"Lon",
|
||||
"Lat",
|
||||
"RMW",
|
||||
"Pressure",
|
||||
"Windspeed"
|
||||
),
|
||||
selection = "none",
|
||||
options = list(
|
||||
pageLength = 1000,
|
||||
order = list(0, 'asc'),
|
||||
searching = F,
|
||||
paging = F,
|
||||
info = F,
|
||||
lengthChange = F,
|
||||
server = T
|
||||
)
|
||||
)
|
||||
})
|
||||
|
||||
storm_yearly_normalization <- reactive({
|
||||
req(
|
||||
storm_selection$storm_basin,
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name
|
||||
)
|
||||
|
||||
result <- get_all_normalized_cost_index(storm_selection)
|
||||
|
||||
return(result)
|
||||
}) %>%
|
||||
bindCache(
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name,
|
||||
storm_selection$storm_basin
|
||||
)
|
||||
|
||||
output$cost_index_chart <- renderDygraph({
|
||||
req(
|
||||
storm_yearly_normalization(),
|
||||
input$storm_overview_cost_index_lf_select,
|
||||
input$storm_overview_cost_index_mmh_mmp,
|
||||
input$storm_overview_cost_index_scale,
|
||||
input$storm_overview_cost_index_y_scale
|
||||
)
|
||||
|
||||
if (input$storm_overview_cost_index_y_scale == "Log") {
|
||||
is_y_log <- T
|
||||
} else {
|
||||
is_y_log <- F
|
||||
}
|
||||
|
||||
normalized_data <- storm_yearly_normalization() %>%
|
||||
rename(
|
||||
"MMH Index" = mmh_index,
|
||||
"MMH Loss" = mmh_loss,
|
||||
"MMP Index" = mmp_index,
|
||||
"MMP Loss" = mmp_loss
|
||||
)
|
||||
|
||||
selected_lf <- input$storm_overview_cost_index_lf_select
|
||||
selected_normalization <- input$storm_overview_cost_index_mmh_mmp
|
||||
selected_scale <- input$storm_overview_cost_index_scale
|
||||
|
||||
method_map <- c("MMH", "MMP")
|
||||
selected_methods <- method_map[method_map %in% selected_normalization]
|
||||
|
||||
if (selected_scale == "Index") {
|
||||
value_columns <- paste0(selected_methods, " Index")
|
||||
|
||||
y_label <- "Cost Index"
|
||||
} else if (selected_scale == "Loss") {
|
||||
value_columns <- paste0(selected_methods, " Loss")
|
||||
|
||||
y_label <- "Normalized Loss"
|
||||
}
|
||||
|
||||
normalization_index <- normalized_data %>%
|
||||
filter(
|
||||
full_lf_id %in% selected_lf
|
||||
) %>%
|
||||
mutate(
|
||||
normalization_year = as.Date(paste0(normalization_year, "-01-01"))
|
||||
) %>%
|
||||
select(
|
||||
normalization_year,
|
||||
full_lf_id,
|
||||
all_of(value_columns)
|
||||
) %>%
|
||||
pivot_wider(
|
||||
names_from = full_lf_id,
|
||||
values_from = all_of(value_columns),
|
||||
names_glue = "{full_lf_id} {.value}"
|
||||
)
|
||||
|
||||
normalization_index_ts <- normalization_index %>%
|
||||
select(-normalization_year) %>%
|
||||
xts(order.by = normalization_index$normalization_year)
|
||||
|
||||
dygraph(normalization_index_ts, ylab = y_label) %>%
|
||||
dyOptions(
|
||||
colors = paletteer_d(
|
||||
"ggthemes::Classic_Purple_Gray_12",
|
||||
ncol(normalization_index - 1)
|
||||
),
|
||||
fillGraph = T,
|
||||
fillAlpha = .2,
|
||||
labelsKMB = T,
|
||||
logscale = is_y_log
|
||||
) %>%
|
||||
dyAxis("x", drawGrid = F) %>%
|
||||
dyLegend(show = "always", width = 400, hideOnMouseOut = FALSE) %>%
|
||||
dyRangeSelector()
|
||||
}) %>%
|
||||
bindCache(
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name,
|
||||
storm_selection$storm_basin,
|
||||
input$storm_overview_cost_index_lf_select,
|
||||
input$storm_overview_cost_index_mmh_mmp,
|
||||
input$storm_overview_cost_index_scale,
|
||||
input$storm_overview_cost_index_y_scale
|
||||
)
|
||||
|
||||
observe({
|
||||
req(
|
||||
storm_selection$storm_basin,
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name
|
||||
)
|
||||
|
||||
updateSliderInput(
|
||||
session,
|
||||
"growth_trend_map_slider",
|
||||
min = storm_selection$storm_year,
|
||||
value = storm_selection$storm_year
|
||||
)
|
||||
})
|
||||
|
||||
growth_counties <- reactive({
|
||||
req(
|
||||
storm_selection$storm_basin,
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name,
|
||||
input$growth_trend_lf_select
|
||||
)
|
||||
|
||||
selected_lf <- input$growth_trend_lf_select
|
||||
|
||||
counties <- get_normalized_metric_growth(storm_selection, selected_lf)
|
||||
|
||||
result <- counties %>%
|
||||
#filter(year == 2024) %>%
|
||||
mutate(
|
||||
population_opacity = rescale(
|
||||
normalized_population,
|
||||
to = c(0.2, 0.8),
|
||||
from = range(normalized_population, na.rm = T)
|
||||
),
|
||||
housing_opacity = rescale(
|
||||
normalized_housing,
|
||||
to = c(0.2, 0.8),
|
||||
from = range(normalized_housing, na.rm = T)
|
||||
)
|
||||
) %>%
|
||||
st_as_sf(wkt = "geom_wkt")
|
||||
|
||||
return(result)
|
||||
}) %>%
|
||||
bindCache(
|
||||
storm_selection$storm_year,
|
||||
storm_selection$storm_name,
|
||||
storm_selection$storm_basin,
|
||||
input$growth_trend_lf_select
|
||||
)
|
||||
|
||||
output$growth_map <- renderLeaflet({
|
||||
req(
|
||||
growth_counties(),
|
||||
input$growth_trend_map_slider,
|
||||
input$growth_map_metric
|
||||
)
|
||||
|
||||
counties_data <- growth_counties()
|
||||
combined_geom <- st_union(counties_data)
|
||||
growth_bbox <- st_bbox(combined_geom)
|
||||
|
||||
growth_year <- input$growth_trend_map_slider
|
||||
growth_county_year <- counties_data %>%
|
||||
filter(year == growth_year)
|
||||
|
||||
map <- leaflet() %>%
|
||||
addProviderTiles("Stadia.AlidadeSmooth") %>%
|
||||
fitBounds(
|
||||
lng1 = growth_bbox[["xmin"]],
|
||||
lng2 = growth_bbox[["xmax"]],
|
||||
lat1 = growth_bbox[["ymin"]],
|
||||
lat2 = growth_bbox[["ymax"]]
|
||||
)
|
||||
|
||||
if (input$growth_map_metric == "Population") {
|
||||
map <- map %>%
|
||||
addPolygons(
|
||||
data = growth_county_year,
|
||||
group = "counties",
|
||||
fillColor = "red",
|
||||
color = "red",
|
||||
fillOpacity = ~population_opacity,
|
||||
weight = 1,
|
||||
popup = ~name
|
||||
)
|
||||
} else {
|
||||
map <- map %>%
|
||||
addPolygons(
|
||||
data = growth_county_year,
|
||||
group = "counties",
|
||||
fillColor = "blue",
|
||||
color = "blue",
|
||||
fillOpacity = ~housing_opacity,
|
||||
weight = 1,
|
||||
popup = ~name
|
||||
)
|
||||
}
|
||||
|
||||
return(map)
|
||||
})
|
||||
|
||||
observe({
|
||||
req(
|
||||
growth_counties(),
|
||||
input$growth_trend_map_slider,
|
||||
input$growth_map_metric
|
||||
)
|
||||
|
||||
growth_year <- input$growth_trend_map_slider
|
||||
|
||||
growth_county_year <- growth_counties() %>%
|
||||
filter(
|
||||
year == growth_year
|
||||
)
|
||||
|
||||
if (input$growth_map_metric == "Population") {
|
||||
leafletProxy("growth_map", data = growth_county_year) %>%
|
||||
clearGroup("counties") %>%
|
||||
addPolygons(
|
||||
group = "counties",
|
||||
fillColor = "red",
|
||||
color = "red",
|
||||
fillOpacity = ~population_opacity,
|
||||
weight = 1,
|
||||
popup = ~name
|
||||
)
|
||||
} else {
|
||||
leafletProxy("growth_map", data = growth_county_year) %>%
|
||||
clearGroup("counties") %>%
|
||||
addPolygons(
|
||||
group = "counties",
|
||||
fillColor = "blue",
|
||||
color = "blue",
|
||||
fillOpacity = ~housing_opacity,
|
||||
weight = 1,
|
||||
popup = ~name
|
||||
)
|
||||
}
|
||||
})
|
||||
}
|
||||
Reference in New Issue
Block a user