From 49ef7919bca8594ba615d7520ebcc3189feb388f Mon Sep 17 00:00:00 2001 From: dylanbenzi Date: Tue, 10 Jun 2025 15:32:04 -0400 Subject: [PATCH] add proxy map updates --- dashboard.Rmd | 132 ++++++++++++++++++++++++++++++++++++++++++++--- queries.R | 138 +++++++++++++++++++++++++------------------------- 2 files changed, 193 insertions(+), 77 deletions(-) diff --git a/dashboard.Rmd b/dashboard.Rmd index 29b55cf..c027b0b 100644 --- a/dashboard.Rmd +++ b/dashboard.Rmd @@ -39,6 +39,7 @@ library(xts) library(tigris) library(caret) library(scales) +library(billboarder) linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/" macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/" @@ -370,7 +371,7 @@ fluidRow( ') ), column(6, - actionLink("fatalitiesLink", tagList(icon("arrow-right"), "Fatalities dashboard"), class = "btn btn-outline") + #actionLink("fatalitiesLink", tagList(icon("arrow-right"), "Fatalities dashboard"), class = "btn btn-outline") ) ) ``` @@ -403,12 +404,14 @@ DTOutput("landfalls_table") ### Storm Track {data-height=500 .no-padding} ```{r} -output$track_map <- renderLeaflet({ +observe({ + req(storm_selection$is_selected) + storm_track <- get_hurdat_track(storm_selection) - leaflet() %>% - addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% - setView(lng = -80, lat = 32, zoom = 4) %>% + leafletProxy("track_map", data = storm_track) %>% + clearShapes() %>% + clearMarkers() %>% addPolylines( data = storm_track, lng = ~lon, @@ -438,6 +441,12 @@ output$track_map <- renderLeaflet({ ) }) +output$track_map <- renderLeaflet({ + leaflet() %>% + addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% + setView(lng = -80, lat = 32, zoom = 4) +}) + leafletOutput("track_map", height="100%") ``` @@ -458,12 +467,14 @@ observe({ value = storm_selection$storm_year) }) -sliderInput("growth_trend_map_slider", label = NULL, min = 1700, max = 2024, step = 1, animate = T, value = 1700, sep = "", width = "100%", ticks = F) +sliderInput("growth_trend_map_slider", label = NULL, min = 1900, max = 2024, step = 1, animate = T, value = 1700, sep = "", width = "100%", ticks = F) ``` ### {data-height=900 .no-padding} ```{r} + + #storm_metrics_growth_geom <- reactive({ # req(storm_selection$is_selected) # @@ -500,6 +511,24 @@ sliderInput("growth_trend_map_slider", label = NULL, min = 1700, max = 2024, ste # ) #}) +test_storm <- reactiveValues( + storm_basin = "AL", + storm_year = 2005, + storm_name = "KATRINA", +) + +katrina_counties <- reactive({ + req(storm_selection$is_selected) + + counties <- get_normalized_metric_growth(test_storm, "LF1") + + result <- counties %>% + filter(year == 2006) %>% + st_as_sf(wkt = "geom_wkt") + + return(result) +}) + output$pop_growth_map <- renderLeaflet({ leaflet() %>% addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) @@ -507,13 +536,23 @@ output$pop_growth_map <- renderLeaflet({ }) output$housing_growth_map <- renderLeaflet({ - - leaflet() %>% addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) # %>% setView(lng = -89.8, lat = 29.6, zoom = 8) }) +observe({ + req(katrina_counties) + + leafletProxy("pop_growth_map", data = katrina_counties()) %>% + clearShapes() %>% + addPolygons( + fillColor = "red", + fillOpacity = 0.5, + weight = 2 + ) +}) + fillCol( flex = c(1, 1), leafletOutput("pop_growth_map"), @@ -567,14 +606,91 @@ Column {data-width=500} --- ### {data-height=500} +```{r} +fatality_years <- seq(1900, 2010, by = 10) +direct_deaths <- c(6000, 275, 0, 408, 26, 654, 466, 213, 104, 228, 1136, 321) +indirect_deaths <- c(0, 0, 0, 0, 0, 1, 8, 15, 40, 54, 1171, 368) + +yearly_fatalities <- data.frame(fatality_years, direct_deaths, indirect_deaths) %>% + mutate( + fatality_years = as.Date(paste0(fatality_years, "-01-01")) + ) + +yearly_fatalities_ts <- yearly_fatalities %>% + select(-fatality_years) %>% + xts(order.by = yearly_fatalities$fatality_years) + +output$decade_fatalities <- renderDygraph( + dygraph(yearly_fatalities_ts, main = "Fatalities By Decade") %>% + dySeries("direct_deaths", label = "Direct Deaths") %>% + dySeries("indirect_deaths", label = "Indirect Deaths") %>% + dyRangeSelector() +) + +dygraphOutput("decade_fatalities") +``` ### {data-height=500} +```{r} +surge_yearly <- c(0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 410, 107) +surf_yearly <- c(0, 0, 0, 0, 0, 0, 0, 14, 2, 12, 12, 17) +rough_seas_yearly <- c(0, 0, 0, 0, 16, 0, 2, 0, 24, 17, 0, 14) +rip_current_yearly <- c(0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 14, 3) +freshwater_floods_yearly <- c(0, 0, 0, 0, 0, 200, 12, 151, 0, 117, 50, 284) +wind_yearly <- c(0, 0, 0, 0, 0, 0, 0, 8, 14, 23, 11, 82) +tree_fall_yearly <- c(0, 0, 0, 0, 1, 0, 0, 1, 0, 9, 24, 56) +tornado_yearly <- c(0, 0, 0, 0, 1, 12, 43, 7, 0, 7, 11, 7) +traffic_yearly <- c(0, 0, 0, 0, 0, 0, 0, 4, 0, 3, 2, 1) +traffic_accident_yearly <- c(0, 0, 0, 0, 0, 0, 5, 0, 0, 8, 26, 11) +electrocution_yearly <- c(0, 0, 0, 0, 0, 0, 2, 0, 0, 5, 2, 7) +other_yearly <- c(0, 0, 0, 0, 5, 0, 5, 11, 15, 13, 37, 7) + +yearly_fatalities_type <- data.frame(fatality_years, surge_yearly, surf_yearly, rough_seas_yearly, rip_current_yearly, freshwater_floods_yearly, wind_yearly, tree_fall_yearly, tornado_yearly, traffic_yearly, traffic_accident_yearly, electrocution_yearly, other_yearly) %>% + mutate( + fatality_years = as.Date(paste0(fatality_years, "-01-01")) + ) + +yearly_fatalities_type_ts <- yearly_fatalities_type %>% + select(-fatality_years) %>% + xts(order.by = yearly_fatalities_type$fatality_years) + +output$decade_fatalities_type <- renderDygraph( + dygraph(yearly_fatalities_type_ts, main = "Fatality Types By Decade") %>% + dySeries("surge_yearly", label = "Surge") %>% + dySeries("surf_yearly", label = "Surf") %>% + dySeries("rough_seas_yearly", label = "Rough Seas") %>% + dySeries("rip_current_yearly", label = "Rip Current") %>% + dySeries("freshwater_floods_yearly", label = "Freshwater Floods") %>% + dySeries("wind_yearly", label = "Wind") %>% + dySeries("tree_fall_yearly", label = "Tree Fall") %>% + dySeries("tornado_yearly", label = "Tornado") %>% + dySeries("traffic_yearly", label = "Traffic") %>% + dySeries("traffic_accident_yearly", label = "Traffic Accident") %>% + dySeries("electrocution_yearly", label = "Electrocution") %>% + dySeries("other_yearly", label = "Other") %>% + dyRangeSelector() +) + +dygraphOutput("decade_fatalities_type") +``` Column {data-width=500} --- ### {data-height=500} ```{r} +fatality_type <- c("Surge", "Surf", "Rough Seas", "Rip Current", "Floods", "Wind", "Tree Fall", "Tornado", "Traffic", "Traffic Accident", "Electrocution", "Other") +fatality_totals <- c(520, 56, 77, 23, 826, 131, 91, 88, 10, 45, 16, 56) + +aggregate_fatality_types <- data.frame(fatality_type, fatality_totals) + +output$aggregate_fatalities <- renderBillboarder( + billboarder() %>% + bb_piechart(aggregate_fatality_types) %>% + bb_legend(position = "right") +) + +billboarderOutput("aggregate_fatalities") ``` ### {data-height=500} diff --git a/queries.R b/queries.R index 3b03bc1..78d1a23 100644 --- a/queries.R +++ b/queries.R @@ -248,75 +248,75 @@ get_hurdat_track <- function(storm) { } # returns normalized population and housing growth by county with geometry -#get_normalized_metric_growth <- function(storm, full_lf_id) { -# lf_id_parts <- split_full_lf_id(full_lf_id) -# -# affected_counties <- gis.affected_area_landfalls %>% -# filter( -# storm_basin == storm$storm_basin, -# storm_year == storm$storm_year, -# storm_name == storm$storm_name, -# lf_type == lf_id_parts$lf_type, -# lf_id == lf_id_parts$lf_id -# ) %>% -# select(state_fips, county_fips) -# -# baseline_metrics <- metrics.pop_and_housing %>% -# filter( -# year == storm$storm_year -# ) %>% -# inner_join(affected_counties, by = c("state_fips", "county_fips")) %>% -# select( -# state_fips, -# county_fips, -# baseline_population = population, -# baseline_housing = housing_units -# ) -# -# normalized_metrics <- metrics.pop_and_housing %>% -# filter( -# year >= storm$storm_year -# ) %>% -# inner_join(affected_counties, by = c("state_fips", "county_fips")) %>% -# inner_join(baseline_metrics, by = c("state_fips", "county_fips")) %>% -# mutate( -# normalized_population = as.numeric(population) / as.numeric(baseline_population), -# normalized_housing = as.numeric(housing_units) / as.numeric(baseline_housing) -# ) %>% -# select( -# state_fips, -# county_fips, -# year, -# population, -# housing_units, -# normalized_population, -# normalized_housing -# ) -# -# query <- normalized_metrics %>% -# inner_join( -# public.counties, -# by = c("state_fips" = "statefp", "county_fips" = "countyfp") -# ) %>% -# mutate( -# geom_wkt = sql("ST_AsText(ST_Transform(geom, 4326))") -# ) %>% -# select( -# state_fips, -# county_fips, -# year, -# population, -# housing_units, -# normalized_population, -# normalized_housing, -# geom_wkt -# ) %>% -# arrange(state_fips, county_fips, year) -# -# result <- query %>% collect() -# -# return(result) -#} +get_normalized_metric_growth <- function(storm, full_lf_id) { + lf_id_parts <- split_full_lf_id(full_lf_id) + + affected_counties <- gis.affected_area_landfalls %>% + filter( + storm_basin == storm$storm_basin, + storm_year == storm$storm_year, + storm_name == storm$storm_name, + lf_type == lf_id_parts$lf_type, + lf_id == lf_id_parts$lf_id + ) %>% + select(state_fips, county_fips) + + baseline_metrics <- metrics.pop_and_housing %>% + filter( + year == storm$storm_year + ) %>% + inner_join(affected_counties, by = c("state_fips", "county_fips")) %>% + select( + state_fips, + county_fips, + baseline_population = population, + baseline_housing = housing_units + ) + + normalized_metrics <- metrics.pop_and_housing %>% + filter( + year >= storm$storm_year + ) %>% + inner_join(affected_counties, by = c("state_fips", "county_fips")) %>% + inner_join(baseline_metrics, by = c("state_fips", "county_fips")) %>% + mutate( + normalized_population = as.numeric(population) / as.numeric(baseline_population), + normalized_housing = as.numeric(housing_units) / as.numeric(baseline_housing) + ) %>% + select( + state_fips, + county_fips, + year, + population, + housing_units, + normalized_population, + normalized_housing + ) + + query <- normalized_metrics %>% + inner_join( + public.counties, + by = c("state_fips" = "statefp", "county_fips" = "countyfp") + ) %>% + mutate( + geom_wkt = sql("ST_AsText(ST_Transform(geom, 4326))") + ) %>% + select( + state_fips, + county_fips, + year, + population, + housing_units, + normalized_population, + normalized_housing, + geom_wkt + ) %>% + arrange(state_fips, county_fips, year) + + result <- query %>% collect() + + return(result) +} # test functions