dylan/hurricane_normalization_app
1
0
Fork 0
mirror of https://github.com/dylanbenzi/hurricane_normalization_app.git synced 2026-07-30 05:08:57 +00:00
Code Issues Packages Projects Releases Wiki Activity

update storm coverage table functionality

Browse Source
This commit is contained in:
dylan
2026-04-09 00:56:41 -04:00
parent b1ae0db23f
commit 087a765a2b
2 changed files with 39 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app/server.R
+38 -19
View File
@@ -20,6 +20,7 @@ server <- function(input, output, session) {
)
))
) %>%
mutate(total_direct_deaths = as.integer(total_direct_deaths)) %>%
select(
hurdatid,
storm_name,
@@ -65,7 +66,7 @@ server <- function(input, output, session) {
selection = "single",
options = list(
pageLength = 1000,
order = list(0, 'desc'),
order = list(4, 'desc'),
searching = F,
paging = F,
info = F,
@@ -842,13 +843,13 @@ server <- function(input, output, session) {
fatalities <- get_fatality_map(storm_selection)
category_colors <- c(
"Wind" = "#cd2626",
"Surf" = "#4f94cd",
"Offshore" = "#5cacee",
"Storm Surge" = "#4682b4",
"Wind" = "#cd2626",
"Surf" = "#4f94cd",
"Offshore" = "#5cacee",
"Storm Surge" = "#4682b4",
"Freshwater Flood" = "#36648b",
"Tornado" = "#8b1a1a",
"Unknown" = "#ffa500"
"Tornado" = "#8b1a1a",
"Unknown" = "#ffa500"
)
state_geoms <- fatalities %>% distinct(state_fips, name, geom_wkt)
@@ -872,30 +873,40 @@ server <- function(input, output, session) {
left_join(state_geoms, by = "state_fips") %>%
st_as_sf(wkt = "geom_wkt", crs = 4326)
active_categories <- intersect(names(category_colors), unique(fatalities_mapped$category))
active_categories <- intersect(
names(category_colors),
unique(fatalities_mapped$category)
)
map <- leaflet() %>%
addProviderTiles("Stadia.AlidadeSmooth")
tint <- function(hex, factor = 0.8) {
v <- col2rgb(hex) / 255
rgb(v[1] + (1 - v[1]) * factor, v[2] + (1 - v[2]) * factor, v[3] + (1 - v[3]) * factor)
rgb(
v[1] + (1 - v[1]) * factor,
v[2] + (1 - v[2]) * factor,
v[3] + (1 - v[3]) * factor
)
}
for (cat in active_categories) {
cat_data <- fatalities_mapped %>% filter(category == cat)
cat_color <- category_colors[[cat]]
pal <- colorNumeric(c(tint(cat_color), cat_color), domain = cat_data$fatality_count)
pal <- colorNumeric(
c(tint(cat_color), cat_color),
domain = cat_data$fatality_count
)
map <- map %>%
addPolygons(
data = cat_data,
group = cat,
fillColor = ~pal(fatality_count),
fillColor = ~ pal(fatality_count),
fillOpacity = 0.7,
color = cat_color,
weight = 1,
popup = ~paste0(name, ": ", fatality_count)
popup = ~ paste0(name, ": ", fatality_count)
)
}
@@ -952,7 +963,15 @@ server <- function(input, output, session) {
mutate(
category = factor(
category,
levels = c("Freshwater Flood", "Offshore", "Storm Surge", "Surf", "Tornado", "Wind", "Unknown")
levels = c(
"Freshwater Flood",
"Offshore",
"Storm Surge",
"Surf",
"Tornado",
"Wind",
"Unknown"
)
),
state_label = factor(
state_label,
@@ -1002,13 +1021,13 @@ server <- function(input, output, session) {
filter(n > 0)
category_colors <- c(
"Wind" = "#cd2626",
"Surf" = "#4f94cd",
"Offshore" = "#5cacee",
"Storm Surge" = "#4682b4",
"Wind" = "#cd2626",
"Surf" = "#4f94cd",
"Offshore" = "#5cacee",
"Storm Surge" = "#4682b4",
"Freshwater Flood" = "#36648b",
"Tornado" = "#8b1a1a",
"Unknown" = "#ffa500"
"Tornado" = "#8b1a1a",
"Unknown" = "#ffa500"
)
plot_ly(