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( select(
hurdatid, hurdatid,
storm_name, storm_name,
@@ -65,7 +66,7 @@ server <- function(input, output, session) {
selection = "single", selection = "single",
options = list( options = list(
pageLength = 1000, pageLength = 1000,
order = list(0, 'desc'), order = list(4, 'desc'),
searching = F, searching = F,
paging = F, paging = F,
info = F, info = F,
@@ -842,13 +843,13 @@ server <- function(input, output, session) {
fatalities <- get_fatality_map(storm_selection) fatalities <- get_fatality_map(storm_selection)
category_colors <- c( category_colors <- c(
"Wind" = "#cd2626", "Wind" = "#cd2626",
"Surf" = "#4f94cd", "Surf" = "#4f94cd",
"Offshore" = "#5cacee", "Offshore" = "#5cacee",
"Storm Surge" = "#4682b4", "Storm Surge" = "#4682b4",
"Freshwater Flood" = "#36648b", "Freshwater Flood" = "#36648b",
"Tornado" = "#8b1a1a", "Tornado" = "#8b1a1a",
"Unknown" = "#ffa500" "Unknown" = "#ffa500"
) )
state_geoms <- fatalities %>% distinct(state_fips, name, geom_wkt) 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") %>% left_join(state_geoms, by = "state_fips") %>%
st_as_sf(wkt = "geom_wkt", crs = 4326) 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() %>% map <- leaflet() %>%
addProviderTiles("Stadia.AlidadeSmooth") addProviderTiles("Stadia.AlidadeSmooth")
tint <- function(hex, factor = 0.8) { tint <- function(hex, factor = 0.8) {
v <- col2rgb(hex) / 255 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) { for (cat in active_categories) {
cat_data <- fatalities_mapped %>% filter(category == cat) cat_data <- fatalities_mapped %>% filter(category == cat)
cat_color <- category_colors[[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 %>% map <- map %>%
addPolygons( addPolygons(
data = cat_data, data = cat_data,
group = cat, group = cat,
fillColor = ~pal(fatality_count), fillColor = ~ pal(fatality_count),
fillOpacity = 0.7, fillOpacity = 0.7,
color = cat_color, color = cat_color,
weight = 1, weight = 1,
popup = ~paste0(name, ": ", fatality_count) popup = ~ paste0(name, ": ", fatality_count)
) )
} }
@@ -952,7 +963,15 @@ server <- function(input, output, session) {
mutate( mutate(
category = factor( category = factor(
category, 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 = factor(
state_label, state_label,
@@ -1002,13 +1021,13 @@ server <- function(input, output, session) {
filter(n > 0) filter(n > 0)
category_colors <- c( category_colors <- c(
"Wind" = "#cd2626", "Wind" = "#cd2626",
"Surf" = "#4f94cd", "Surf" = "#4f94cd",
"Offshore" = "#5cacee", "Offshore" = "#5cacee",
"Storm Surge" = "#4682b4", "Storm Surge" = "#4682b4",
"Freshwater Flood" = "#36648b", "Freshwater Flood" = "#36648b",
"Tornado" = "#8b1a1a", "Tornado" = "#8b1a1a",
"Unknown" = "#ffa500" "Unknown" = "#ffa500"
) )
plot_ly( plot_ly(
app/ui.R
+1 -2
View File
@@ -10,7 +10,6 @@ ui <- page_navbar(
nav_panel( nav_panel(
"Home", "Home",
card( card(
"Welcome to the Tropical Cyclone Database",
HTML( HTML(
' '
<h4>Welcome to the Hurricane Cost Normalization Web App</h4> <h4>Welcome to the Hurricane Cost Normalization Web App</h4>
@@ -104,7 +103,7 @@ ui <- page_navbar(
) )
) )
), ),
actionButton("load_storm", "Load Storm") actionButton(class = "btn-primary", "load_storm", "Load Storm")
), ),
card( card(
height = 700, height = 700,