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
Files
8442e6d6bd77b903c771124097b7f9ff51948273
hurricane_normalization_app/dashboard.Rmd
T

1022 lines
26 KiB
Plaintext
Raw Blame History

---
title: "Hurricane Normalization App"
runtime: shiny
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
theme:
version: 4
bootswatch: litera
---
```{r setup, include=FALSE}
# TODO:
# - update normalization to new 2024 data
# -
library(flexdashboard)
library(shiny)
library(leaflet)
library(DT)
library(dplyr)
library(DBI)
library(tidyr)
library(ggplot2)
library(plotly)
library(viridis)
library(lubridate)
library(scales)
library(readr)
library(stringr)
library(kableExtra)
library(bslib)
library(dygraphs)
library(tidyverse)
library(sf)
library(shinyBS)
library(xts)
library(tigris)
linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/"
macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/"
#baseDir <- macdir
baseDir <- linuxdir
config <- config::get(file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml"))
# SUPABASE CON
con <- dbConnect(
RPostgres::Postgres(),
host = config$db_host,
port = config$db_port,
dbname = config$db_dbname,
user = config$db_user,
password = config$db_password
)
selected_storm_name <- "KATRINA"
selected_storm_year <- 2005
selected_storm_basin <- "AL"
selected_lf_type = "LF"
selected_lf_id = "2"
xlallLandfallsNormalized <- read.csv(paste0(baseDir, "R/dataScripts/restructured/normalization/all-landfalls-normalized.csv"), header = T) %>%
select(-X)
normalized2024 <- read.csv(paste0(baseDir, "R/dataScripts/restructured/normalization/2024-normalized.csv"), header = T) %>%
select(-X, -hurdatId, -MMH23, -MMP23) %>%
filter(MMH24 > 0) %>%
mutate(
lf_date = trimws(lf_date)
)
normalized2024 <- normalized2024 %>%
mutate(
lf_date = mdy(lf_date)
) %>%
rename(
Storm = storm_name,
Landfall = lf_date
)
pop <- read.csv(paste0(baseDir, "Data/population_with_projections.csv"), stringsAsFactors = F) %>%
pivot_longer(
cols = starts_with("X"),
names_to = "year",
values_to = "pop",
) %>%
rename(population = pop) %>%
mutate(
year = parse_number(year),
FIPS = ifelse(nchar(FIPS) == 4, paste0("0", FIPS), FIPS),
state_fips = substr(FIPS, 1, 2),
county_fips = substr(FIPS, 3, 5)
) %>%
select(!full_county_and_state:County & !county_state & !FIPS)
housing <- read.csv(paste0(baseDir, "Data/housing_units.csv"), stringsAsFactors = F) %>%
pivot_longer(
cols = starts_with("X"),
names_to = "year",
values_to = "housing"
) %>%
mutate(
year = parse_number(year),
FIPS = ifelse(nchar(FIPS) == 4, paste0("0", FIPS), FIPS),
state_fips = substr(FIPS, 1, 2),
county_fips = substr(FIPS, 3, 5)
) %>%
rename(housing_units = housing) %>%
select(!County.Full:County & !County.State & !FIPS)
metrics.pop_and_housing <- pop %>%
left_join(housing, by = c("state_fips", "county_fips", "year"))
weightedCounties <- read.csv(paste0(baseDir, "R/dataScripts/weighted-counties.csv"), header = T) %>%
mutate(
weight = (PERCENTAGE/100),
FIPS = ifelse(nchar(FIPS) == 4, paste0("0", FIPS), FIPS),
state_fips = substr(FIPS, 1, 2),
county_fips = substr(FIPS, 3, 5)
) %>%
select(
state_fips,
county_fips,
hurdatId = HURDAT_Cod,
storm_name = Name_1,
lfId = LF_ID_Mull,
lf_date = LF_Date,
year = Year,
rmw = RMW,
lat = Lat,
lon = Long,
rmw_2x = RMW_x2,
area = AREA,
weight
)
katrinaAffectedCounties <- weightedCounties %>%
filter(hurdatId == "AL122005" & lfId == "LF2") %>%
mutate(
fips = paste0(state_fips, county_fips)
)
katrinaLfTwoCountyMetrics <- metrics.pop_and_housing %>%
filter(year >= 2005) %>%
pivot_longer(
cols = c("population", "housing_units"),
names_to = "metric",
values_to = "value"
) %>%
pivot_wider(
names_from = year,
values_from = value,
) %>%
mutate(
fips = paste0(state_fips, county_fips)
) %>%
filter(fips %in% katrinaAffectedCounties$fips) %>%
select(fips, !state_fips & !county_fips)
###### REACTIVE VALUES
######
# LAZY LOAD DB TABLES
econ.normalized_landfalls <- tbl(con, I("econ.normalized_landfalls"))
econ.storm_base_loss <- tbl(con, I("econ.storm_base_loss"))
econ.usa_yearly <- tbl(con, I("econ.usa_yearly"))
fatal.storm_fatalities_type <- tbl(con, I("fatal.storm_fatalities_type"))
fatal.storm_total_fatalities <- tbl(con, I("fatal.storm_total_fatalities"))
fips.counties <- tbl(con, I("fips.counties"))
fips.states <- tbl(con, I("fips.states"))
gis.affected_area_landfalls <- tbl(con, I("gis.affected_area_landfalls"))
hurdat.best_track <- tbl(con, I("hurdat.best_track"))
hurdat.hurdat_storms <- tbl(con, I("hurdat.hurdat_storms"))
metrics.geo_attributes <- tbl(con, I("metrics.geo_attributes"))
#metrics.pop_and_housing <- tbl(con, I("metrics.pop_and_housing"))
public.counties <- tbl(con, I("public.counties"))
### COMMONLY USED DATA
loss_storms <- econ.storm_base_loss %>%
select(
storm_basin, storm_year, storm_name
) %>%
distinct(
storm_basin, storm_year, storm_name
) %>%
left_join(
hurdat.hurdat_storms %>%
mutate(hurdatId = paste0(storm_basin, storm_number, storm_year)),
by = c("storm_basin", "storm_year", "storm_name")) %>%
select(
hurdatId, storm_basin, storm_name, storm_year
) %>%
collect()
base_losses_by_lf <- econ.storm_base_loss %>%
filter(!is.na(base_loss)) %>%
mutate(
ncei_priority = case_when(
str_like(base_loss_source, "%ncei%") ~ 1,
str_like(base_loss_source, "%ncei%") ~ 2,
TRUE ~ 3
)
) %>%
group_by(storm_basin, storm_year, storm_name, lf_type, lf_id) %>%
slice_min(ncei_priority, n = 1, with_ties = F) %>%
ungroup() %>%
collect()
total_base_losses <- base_losses_by_lf %>%
group_by(storm_basin, storm_year, storm_name) %>%
summarize(
total_base_loss = sum(base_loss),
.groups = "drop"
) %>%
collect()
normalized_losses_2024 <- econ.normalized_landfalls %>%
filter(normalization_year == 2024) %>%
left_join(econ.storm_base_loss %>%
filter(!is.na(base_loss)) %>%
mutate(
ncei_priority = case_when(
str_like(base_loss_source, "%ncei%") ~ 1,
str_like(base_loss_source, "%ncei%") ~ 2,
TRUE ~ 3
)
) %>%
group_by(storm_basin, storm_year, storm_name, lf_type, lf_id) %>%
slice_min(ncei_priority, n = 1, with_ties = F) %>%
ungroup(),
by = c("storm_basin", "storm_year", "storm_name", "lf_type", "lf_id")) %>%
mutate(
mmh_lf = (base_loss * gdp_deflator * rwhu * affected_housing),
mmp_lf = (base_loss * gdp_deflator * rwpc * affected_population)
) %>%
group_by(storm_basin, storm_year, storm_name) %>%
summarize(
mmh = sum(mmh_lf, na.rm = T),
mmp = sum(mmp_lf, na.rm = T),
.groups = "drop"
) %>%
filter(!is.na(mmh) & !is.na(mmp)) %>%
collect()
storm_selection <- reactiveValues(
storm_year = NULL,
storm_name = NULL,
storm_basin = NULL,
lf_id = NULL,
is_selected = FALSE,
is_table_selection = FALSE,
)
```
Home
=============================================
Col {data-width=500}
----------------------------------------------
### {}
```{r eval=FALSE, include=FALSE}
HTML(
'
<h4>Welcome to the Hurricane Cost Normalization Web App!</h4>
<p>Our platform provides access to normalized hurricane dama data spanning from 1900 to 2024, allowing researchers, policymakers, insurance professional, and the public to better understand how hurricane costs have changed over time.</p>
<h6>Our Data</h6>
<p>The core datasets used in this app are based on research by Muller et al. (2025) and the expanded analysis by Mooney et al. (2025), published in the <i>Bulletin of the American Meteorlogical Society</i> and <i>****JOURNAL****</i> respectively. These studies update and refine hurricane damage normalization methodologies to provide a more accurate picture of how historical hurricanes would impact today\'s society.</p>
<ul>
<li><b>PL22:</b> The Pielke-Landsea (2022) normalization that adjusts for inflation, wealth per capita, and population changes. This data has been updated to 2022.</li>
<li><b>CL22:</b> The Collins-Lowe (2022) normalization that adjusts for inflation, wealth per housing unit, and housing unit changes. This data has been updated to 2022.</li>
<li><b>MMP24:</b> The Muller-Mooney Population (2024) normalization with RMW weighting on affected population.</li>
<li><b>MMH24:</b> The Muller-Mooney Housing (2024) normalization with RMW weighting on affected housing units.</li>
</ul>
<h6>Methodology Innovations</h6>
<p>Our platform incoroprates several methodological innovations over previously used cost normalization formulas:
<ul>
<li><b>Radius of Maximum Wind (RMW) Data:</b> Using landfalling RMWs to identify impacted coastal counties.</li>
<li><b>RMW Affected Area Weighting:</b> Determining affected population and housing unit figures based on RMW.</li>
<li><b>Expanded Storm Coverage:</b> Inlcuding over 200 storms analyzed with interactive data.</li>
<li><b>Up-to-date Data:</b> Using the latest population, housing unit, and economic data through 2024.</li>
</ul>
<h6>Questions?</h6>
<p>CONTACT INFO?</p>
'
)
```
```{r}
HTML(
'
<h4>Welcome to the Hurricane Cost Normalization Web App!</h4>
<p>Our platform provides access to normalized hurricane dama data spanning from 1900 to 2024, allowing researchers, policymakers, insurance professional, and the public to better understand how hurricane costs have changed over time.</p>
<h6>Our Data</h6>
<p>The core datasets used in this app are based on research by Muller et al. (2025) published in the <i>Bulletin of the American Meteorlogical Society</i>. This study updates and refines hurricane damage normalization methodologies to provide a more accurate picture of how historical hurricanes would impact today\'s society.</p>
<ul>
<li><b>PL22:</b> The Pielke-Landsea (2022) normalization that adjusts for inflation, wealth per capita, and population changes. This data has been updated to 2022.</li>
<li><b>CL22:</b> The Collins-Lowe (2022) normalization that adjusts for inflation, wealth per housing unit, and housing unit changes. This data has been updated to 2022.</li>
<li><b>MMP24:</b> The Muller-Mooney Population (2024) normalization with RMW weighting on affected population.</li>
<li><b>MMH24:</b> The Muller-Mooney Housing (2024) normalization with RMW weighting on affected housing units.</li>
</ul>
<h6>Methodology Innovations</h6>
<p>Our platform incoroprates several methodological innovations over previously used cost normalization formulas:
<ul>
<li><b>Radius of Maximum Wind (RMW) Data:</b> Using landfalling RMWs to identify impacted coastal counties.</li>
<li><b>RMW Affected Area Weighting:</b> Determining affected population and housing unit figures based on RMW.</li>
<li><b>Expanded Storm Coverage:</b> Inlcuding over 200 storms analyzed with interactive data.</li>
<li><b>Up-to-date Data:</b> Using the latest population, housing unit, and economic data through 2024.</li>
</ul>
<h6>Questions?</h6>
<p>CONTACT INFO?</p>
'
)
```
Col {data-width=500}
----------------------------------------------
### Storm Selector {data-height=500}
```{r}
fluidRow(
column(6,
selectInput("stormBasin", "Select Basin", choices = "AL"),
selectInput("stormYear", "Select Year", choices = loss_storms$storm_year),
selectInput("stormName", "Select Storm", choices = NULL),
actionButton("selectStorm", "Submit", class = "btn-primary")
),
column(6,
#TODO: ADD TABLE
#DTOutput("storm_selector_table")
)
)
observeEvent(input$stormYear, {
stormsByChosenYear <- loss_storms[loss_storms$storm_year == input$stormYear, ]
stormsByYear <- loss_storms %>% filter(storm_year == input$stormYear)
updateSelectInput(session, "stormName",
choices = stormsByYear$storm_name,
selected = NULL
)
})
observeEvent(input$selectStorm, {
storm_selection$storm_basin <- input$stormBasin
storm_selection$storm_year <- input$stormYear
storm_selection$storm_name <- input$stormName
storm_selection$is_selected <- TRUE
showNotification("Storm selection updated!", type = "message")
})
```
### All Storms {data-height=500 .no-padding}
```{r}
output$normalized_storms_table <- renderDT({
datatable(
normalized_losses_2024 %>% select(Storm = storm_name, Year = storm_year, MMH24 = mmh, MMP24 = mmp),
rownames = F,
selection = "single",
options = list(
pageLength = 1000,
order = list(2, 'desc'),
searching = F,
paging = F,
info = F,
lengthChange = F,
server = T
)
) %>%
formatCurrency(c("MMH24", "MMP24"), "$", digits = 0)
})
DTOutput("normalized_storms_table")
```
Storm Overview {data-navmenu="Storm Details"}
====================================
```{r}
### REACTIVE VALUES FOR STORM OVERVIEW
storm_overview_reactive <- reactiveValues(
lf_type = NULL,
lf_id = NULL,
full_lf_id = NULL,
use_normalized_costs = FALSE
)
growth_trends <- reactiveValues(
lf_type = NULL,
lf_id = NULL,
full_lf_id = NULL
)
```
Col {data-width=500}
------------------------------------
### Storm Details {data-height=200}
```{r}
# TODO: add storm details section: name, base loss, base loss source, etc.
HTML('
')
```
### Normalization Cost Index {data-height=800}
```{r}
storm_unique_landfalls <- reactive({
req(storm_selection$is_selected)
result <- econ.storm_base_loss %>%
filter(
storm_basin == storm_selection$storm_basin,
storm_year == storm_selection$storm_year,
storm_name == storm_selection$storm_name
) %>%
mutate(
full_lf_id = paste0(lf_type, lf_id)
) %>%
distinct(
full_lf_id,
.keep_all = T
) %>%
arrange(
full_lf_id
) %>%
select(
storm_basin, storm_year, storm_name, lf_type, lf_id, full_lf_id
) %>%
collect()
return(result)
})
storm_normalized_landfall <- reactive({
req(storm_overview_reactive$full_lf_id)
result <- econ.normalized_landfalls %>%
filter(
storm_basin == storm_selection$storm_basin,
storm_year == storm_selection$storm_year,
storm_name == storm_selection$storm_name,
lf_type == storm_overview_reactive$lf_type,
lf_id == storm_overview_reactive$lf_id
) %>%
left_join(econ.storm_base_loss %>%
filter(!is.na(base_loss)) %>%
mutate(
ncei_priority = case_when(
str_like(base_loss_source, "%ncei%") ~ 1,
str_like(base_loss_source, "%ncei%") ~ 2,
TRUE ~ 3
)
) %>%
group_by(storm_basin, storm_year, storm_name, lf_type, lf_id) %>%
slice_min(ncei_priority, n = 1, with_ties = F) %>%
ungroup(),
by = c("storm_basin", "storm_year", "storm_name", "lf_type", "lf_id")) %>%
mutate(
mmh_index = (gdp_deflator * rwhu * affected_housing),
mmp_index = (gdp_deflator * rwpc * affected_population),
mmh = (base_loss * mmh_index),
mmp = (base_loss * mmp_index)
) %>%
select(
-base_loss_source, -base_loss, -base_loss_citation, -doi, -notes, -ncei_priority
) %>%
collect()
cat(str(result))
return(result)
})
storm_cost_index_base_index_ts <- reactive({
req(storm_normalized_landfall())
cost_index <- storm_normalized_landfall() %>%
select(
normalization_year, mmh_index, mmp_index
) %>%
mutate(normalization_year = as.Date(paste0(normalization_year, "-01-01")))
cost_index_ts <- cost_index %>%
select(-normalization_year) %>%
xts(order.by = cost_index$normalization_year)
cat(str(cost_index_ts))
result <- cost_index_ts
return(result)
})
storm_cost_index_normalized_costs_ts <- reactive({
req(storm_normalized_landfall())
cost_index <- storm_normalized_landfall() %>%
select(
normalization_year, mmh, mmp
) %>%
mutate(normalization_year = as.Date(paste0(normalization_year, "-01-01")))
cost_index_ts <- cost_index %>%
select(-normalization_year) %>%
xts(order.by = cost_index$normalization_year)
cat(str(cost_index_ts))
result <- cost_index_ts
return(result)
})
observe({
req(storm_unique_landfalls())
storm_overview_reactive$lf_type = storm_unique_landfalls()$lf_type[1]
storm_overview_reactive$lf_id = storm_unique_landfalls()$lf_id[1]
storm_overview_reactive$full_lf_id = storm_unique_landfalls()$full_lf_id[1]
growth_trends$lf_type = storm_unique_landfalls()$lf_type[1]
growth_trends$lf_id = storm_unique_landfalls()$lf_id[1]
growth_trends$full_lf_id = storm_unique_landfalls()$full_lf_id[1]
})
observe({
req(storm_overview_reactive$full_lf_id)
updateSelectInput(
session,
"storm_overview_cost_index_lf",
choices = storm_unique_landfalls()$full_lf_id,
selected = storm_overview_reactive$full_lf_id
)
})
observeEvent(input$storm_overview_select_base, {
# TODO: add button to select normalized costs
})
output$costIndex <- renderDygraph({
req(storm_normalized_landfall())
if(storm_overview_reactive$use_normalized_costs == F) {
dygraph(storm_cost_index_base_index_ts(), main = paste(storm_selection$storm_name, storm_selection$storm_year, "Cost Index")) %>%
dySeries("mmh_index", label = "MMH Index") %>%
dySeries("mmp_index", label = "MMP Index") %>%
dyRangeSelector(height = 30)
}else{
dygraph(storm_cost_index_normalized_costs_ts(), main = paste(storm_selection$storm_name, storm_selection$storm_year, "Cost Index")) %>%
dySeries("mmh", label = "MMH") %>%
dySeries("mmp", label = "MMP") %>%
dyRangeSelector(height = 30)
}
})
fillCol(
flex = c(.2, .8),
fluidRow(
column(4,
selectInput("storm_overview_cost_index_lf", "Landfall Select", choices = NULL)
),
column(4,
# TODO: add button to select normalized costs
#checkboxInput("storm_overview_select_base", "Include Normalized Losses", value = F)
),
column(4,
#checkboxInput("mmpSelect", "Display MMP", value = T)
)
),
dygraphOutput("costIndex")
)
```
Col {data-width=500}
------------------------------------
### Fatalities {data-height=200}
```{r}
fluidRow(
column(6,
HTML('
<h6>Katrina recorded 1,392 fatalities</h6>
<p>Surge: 387</p>
')
),
column(6,
actionLink("fatalitiesLink", tagList(icon("arrow-right"), "Fatalities dashboard"), class = "btn btn-outline")
)
)
```
### Landfalls {data-height=300 .no-padding}
```{r}
storm_landfalls <- reactive({
req(storm_selection$is_selected)
result <- hurdat.best_track %>%
filter(
storm_basin == storm_selection$storm_basin,
storm_year == storm_selection$storm_year,
storm_name == storm_selection$storm_name,
record_identifier == "L"
) %>%
mutate(
lon = sql("ST_X(ST_Transform(location::geometry, 4326))"),
lat = sql("ST_Y(ST_Transform(location::geometry, 4326))")
) %>%
select(
Date = datetime,
Longitude = lon,
Latitude = lat,
RMW = rmw,
Pressure = pressure,
Windspeed = windspeed
) %>%
collect()
cat(str(result))
return(result)
})
output$landfalls_table <- renderDT({
datatable(
storm_landfalls(),
rownames = F,
options = list(
order = list(0, 'asc'),
paging = F,
searching = F,
info = F,
lengthChange = F,
server = T
)
) %>%
formatDate(columns = "Date", method = "toUTCString")
})
DTOutput("landfalls_table")
```
### Storm Track {data-height=500 .no-padding}
```{r}
storm_track <- reactive({
req(storm_selection$is_selected)
result <- hurdat.best_track %>%
filter(
storm_basin == storm_selection$storm_basin,
storm_year == storm_selection$storm_year,
storm_name == storm_selection$storm_name
) %>%
mutate(
lon = sql("ST_X(ST_Transform(location::geometry, 4326))"),
lat = sql("ST_Y(ST_Transform(location::geometry, 4326))"),
rmw_meters = (rmw * 1852)
) %>%
select(
datetime,
lon,
lat,
rmw,
record_identifier,
rmw_meters
) %>%
collect()
cat(str(result))
return(result)
})
output$trackMap <- renderLeaflet({
leaflet() %>%
addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>%
setView(lng = -80, lat = 32, zoom = 4) %>%
addPolylines(
data = storm_track(),
lng = ~lon,
lat = ~lat,
weight = 4,
color = "blue"
) %>%
addCircleMarkers(
data = storm_track() %>% filter(record_identifier == "L"),
lng = ~lon,
lat = ~lat,
radius = 5,
weight = 0,
color = "red",
fillColor = "red",
fillOpacity = 0.8
) %>%
addCircles(
data = storm_track() %>% filter(record_identifier == "L"),
lng = ~lon,
lat = ~lat,
radius = ~rmw_meters,
weight = 2,
color = "red",
fillColor = "red",
fillOpacity = 0.3
)
})
leafletOutput("trackMap", height="100%")
```
Growth Trends {data-navmenu="Storm Details"}
================================
Column {data-width=550}
-------------------------------
### Map Year {data-height=100}
```{r}
sliderInput("growth_trend_map_year", label = NULL, min = 2005, max = 2024, step = 1, animate = T, value = 2005, sep = "", width = "100%", ticks = F)
```
### {data-height=900 .no-padding}
```{r}
dbStormCounties <- reactive({
req(storm_selection$is_selected)
sel_storm_basin <- storm_selection$storm_basin
sel_storm_year <- storm_selection$storm_year
sel_storm_name <- storm_selection$storm_name
sel_lfid <- growth_trends$lf_id
affectedCounties <- gis.affected_area_landfalls %>%
mutate(
fips = paste0(state_fips, county_fips),
lfid = paste0(lf_type, lf_id)
) %>%
filter(
storm_basin == sel_storm_basin,
storm_year == sel_storm_year,
storm_name == sel_storm_name,
lfid == sel_lfid
) %>%
left_join(
public.counties %>%
mutate(geom_wkt = sql("ST_AsText(ST_Transform(geom, 4326))")) %>%
rename(state_fips = statefp, county_fips = countyfp),
by = c("state_fips", "county_fips")
) %>%
collect()
affectedCounties_sf <- affectedCounties %>%
st_as_sf(wkt = "geom_wkt")
cat(str(affectedCounties_sf))
return(affectedCounties_sf)
})
output$popMapPoly <- renderLeaflet({
leaflet() %>%
addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>%
setView(lng = -89.8, lat = 29.6, zoom = 8) #%>%
#addPolygons(
# fillColor = "red",
# fillOpacity = 0.3,
# color = "black",
# weight = 2
#)
})
output$housingMapPoly <- renderLeaflet({
leaflet() %>%
addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>%
setView(lng = -89.8, lat = 29.6, zoom = 8) #%>%
#addPolygons(
# data = dbStormCounties(),
# fillColor = "blue",
# fillOpacity = 0.3,
# color = "black",
# weight = 2
#)
})
fillCol(
flex = c(1, 1),
leafletOutput("popMapPoly"),
leafletOutput("housingMapPoly")
)
```
Column {data-width=450}
----------------------------------
### Landfall Selection {data-height=550}
```{r}
normalized_growth_metrics_lf_ts <- reactive ({
req(growth_trends$full_lf_id)
growth_metrics_lf_fips <- gis.affected_area_landfalls %>%
filter(
storm_basin == storm_selection$storm_basin,
storm_year == storm_selection$storm_year,
storm_name == storm_selection$storm_name,
lf_type == growth_trends$lf_type,
lf_id == growth_trends$lf_id
) %>%
mutate(
full_lf_id = paste0(state_fips, county_fips)
) %>%
collect()
growth_metrics_lf <- metrics.pop_and_housing %>%
mutate(
full_lf_id = paste0(state_fips, county_fips)
) %>%
filter(
full_lf_id %in% growth_metrics_lf_fips$full_lf_id,
year >= storm_selection$storm_year
) %>%
group_by(
year
) %>%
summarize(
aggregate_population = sum(population, na.rm = T),
aggregate_housing_units = sum(housing_units, na.rm = T),
.groups = "drop"
) %>%
collect()
normalized_growth_metrics_lf <- growth_metrics_lf %>%
arrange(
year
) %>%
mutate(
base_population = first(aggregate_population),
base_housing_units = first(aggregate_housing_units),
normalized_population = (aggregate_population / base_population),
normalized_housing_units = (aggregate_housing_units / base_housing_units),
year = as.Date(paste0(year, "-01-01"))
) %>%
select(
year, normalized_population, normalized_housing_units
)
result <- normalized_growth_metrics_lf %>%
select(-year) %>%
xts(order.by = normalized_growth_metrics_lf$year)
return(result)
})
observe({
req(growth_trends$full_lf_id)
updateSelectInput(
session,
"growth_trend_lf_select",
choices = storm_unique_landfalls()$full_lf_id,
selected = growth_trends$full_lf_id
)
})
observeEvent(input$growth_trend_lf_select, {
growth_trends$full_lf_id = input$growth_trend_lf_select
})
fillCol(
flex = c(.2, .8),
fluidRow(
column(6,
selectInput("growth_trend_lf_select", "Landfall Select", choices = NULL)
),
column(6,
# TODO: add button to select normalized costs
#checkboxInput("storm_overview_select_base", "Include Normalized Losses", value = F)
)
),
dygraphOutput("popHu")
)
output$popHu <- renderDygraph({
dygraph(normalized_growth_metrics_lf_ts(), main = "Normalized Aggregate Growth") %>%
dySeries("normalized_population", label = "Population") %>%
dySeries("normalized_housing_units", label = "Housing Units") %>%
dyRangeSelector()
})
```
### County Data {data-height=450 .no-padding}
```{r}
output$katrinaCounties <- renderDT({
datatable(
katrinaLfTwoCountyMetrics,
rownames = F,
#extensions = "RowGroup",
options = list(
pageLength = 1000,
#rowGroup = list(dataSrc = 1),
paging = F,
searching = F,
info = F,
lengthChange = F,
server = T
)
)
})
#DTOutput("katrinaCounties")
```
Fatalities {data-navmenu="Fatalities"}
===
Column {data-width=500}
---
### {data-height=500}
### {data-height=500}
Column {data-width=500}
---
### {data-height=500}
```{r}
```
### {data-height=500}
```{r}
```
Storm Comparison {data-navmenu="Compute"}
===
Sandbox {data-navmenu="Compute"}
===
Data {data-navmenu="Compute"}
===
Top 50 Storms
===
```{r}
#DT with storm, hurdatid, base damage, mmh, mmp, maybe multipliers?, sparkline?
```
About
===
Reference in New Issue View Git Blame Copy Permalink