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

add proxy map updates

Browse Source
This commit is contained in:
dylan
2025-06-10 15:32:04 -04:00
parent d653271142
commit 49ef7919bc
2 changed files with 193 additions and 77 deletions
Download Patch File Download Diff File Expand all files Collapse all files
dashboard.Rmd
+124 -8
View File
@@ -39,6 +39,7 @@ library(xts)
library(tigris) library(tigris)
library(caret) library(caret)
library(scales) library(scales)
library(billboarder)
linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/" linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/"
macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/" macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/"
@@ -370,7 +371,7 @@ fluidRow(
') ')
), ),
column(6, 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} ### Storm Track {data-height=500 .no-padding}
```{r} ```{r}
output$track_map <- renderLeaflet({ observe({
req(storm_selection$is_selected)
storm_track <- get_hurdat_track(storm_selection) storm_track <- get_hurdat_track(storm_selection)
leaflet() %>% leafletProxy("track_map", data = storm_track) %>%
addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% clearShapes() %>%
setView(lng = -80, lat = 32, zoom = 4) %>% clearMarkers() %>%
addPolylines( addPolylines(
data = storm_track, data = storm_track,
lng = ~lon, 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%") leafletOutput("track_map", height="100%")
``` ```
@@ -458,12 +467,14 @@ observe({
value = storm_selection$storm_year) 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} ### {data-height=900 .no-padding}
```{r} ```{r}
#storm_metrics_growth_geom <- reactive({ #storm_metrics_growth_geom <- reactive({
# req(storm_selection$is_selected) # 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({ output$pop_growth_map <- renderLeaflet({
leaflet() %>% leaflet() %>%
addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18))
@@ -507,13 +536,23 @@ output$pop_growth_map <- renderLeaflet({
}) })
output$housing_growth_map <- renderLeaflet({ output$housing_growth_map <- renderLeaflet({
leaflet() %>% leaflet() %>%
addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18))
# %>% setView(lng = -89.8, lat = 29.6, zoom = 8) # %>% 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( fillCol(
flex = c(1, 1), flex = c(1, 1),
leafletOutput("pop_growth_map"), leafletOutput("pop_growth_map"),
@@ -567,14 +606,91 @@ Column {data-width=500}
--- ---
### {data-height=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} ### {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} Column {data-width=500}
--- ---
### {data-height=500} ### {data-height=500}
```{r} ```{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} ### {data-height=500}
queries.R
+69 -69
View File
@@ -248,75 +248,75 @@ get_hurdat_track <- function(storm) {
} }
# returns normalized population and housing growth by county with geometry # returns normalized population and housing growth by county with geometry
#get_normalized_metric_growth <- function(storm, full_lf_id) { get_normalized_metric_growth <- function(storm, full_lf_id) {
# lf_id_parts <- split_full_lf_id(full_lf_id) lf_id_parts <- split_full_lf_id(full_lf_id)
#
# affected_counties <- gis.affected_area_landfalls %>% affected_counties <- gis.affected_area_landfalls %>%
# filter( filter(
# storm_basin == storm$storm_basin, storm_basin == storm$storm_basin,
# storm_year == storm$storm_year, storm_year == storm$storm_year,
# storm_name == storm$storm_name, storm_name == storm$storm_name,
# lf_type == lf_id_parts$lf_type, lf_type == lf_id_parts$lf_type,
# lf_id == lf_id_parts$lf_id lf_id == lf_id_parts$lf_id
# ) %>% ) %>%
# select(state_fips, county_fips) select(state_fips, county_fips)
#
# baseline_metrics <- metrics.pop_and_housing %>% baseline_metrics <- metrics.pop_and_housing %>%
# filter( filter(
# year == storm$storm_year year == storm$storm_year
# ) %>% ) %>%
# inner_join(affected_counties, by = c("state_fips", "county_fips")) %>% inner_join(affected_counties, by = c("state_fips", "county_fips")) %>%
# select( select(
# state_fips, state_fips,
# county_fips, county_fips,
# baseline_population = population, baseline_population = population,
# baseline_housing = housing_units baseline_housing = housing_units
# ) )
#
# normalized_metrics <- metrics.pop_and_housing %>% normalized_metrics <- metrics.pop_and_housing %>%
# filter( filter(
# year >= storm$storm_year year >= storm$storm_year
# ) %>% ) %>%
# inner_join(affected_counties, by = c("state_fips", "county_fips")) %>% inner_join(affected_counties, by = c("state_fips", "county_fips")) %>%
# inner_join(baseline_metrics, by = c("state_fips", "county_fips")) %>% inner_join(baseline_metrics, by = c("state_fips", "county_fips")) %>%
# mutate( mutate(
# normalized_population = as.numeric(population) / as.numeric(baseline_population), normalized_population = as.numeric(population) / as.numeric(baseline_population),
# normalized_housing = as.numeric(housing_units) / as.numeric(baseline_housing) normalized_housing = as.numeric(housing_units) / as.numeric(baseline_housing)
# ) %>% ) %>%
# select( select(
# state_fips, state_fips,
# county_fips, county_fips,
# year, year,
# population, population,
# housing_units, housing_units,
# normalized_population, normalized_population,
# normalized_housing normalized_housing
# ) )
#
# query <- normalized_metrics %>% query <- normalized_metrics %>%
# inner_join( inner_join(
# public.counties, public.counties,
# by = c("state_fips" = "statefp", "county_fips" = "countyfp") by = c("state_fips" = "statefp", "county_fips" = "countyfp")
# ) %>% ) %>%
# mutate( mutate(
# geom_wkt = sql("ST_AsText(ST_Transform(geom, 4326))") geom_wkt = sql("ST_AsText(ST_Transform(geom, 4326))")
# ) %>% ) %>%
# select( select(
# state_fips, state_fips,
# county_fips, county_fips,
# year, year,
# population, population,
# housing_units, housing_units,
# normalized_population, normalized_population,
# normalized_housing, normalized_housing,
# geom_wkt geom_wkt
# ) %>% ) %>%
# arrange(state_fips, county_fips, year) arrange(state_fips, county_fips, year)
#
# result <- query %>% collect() result <- query %>% collect()
#
# return(result) return(result)
#} }
# test functions # test functions