mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-30 05:08:57 +00:00
update db calls
This commit is contained in:
+130
-647
@@ -37,6 +37,8 @@ library(sf)
|
||||
library(shinyBS)
|
||||
library(xts)
|
||||
library(tigris)
|
||||
library(caret)
|
||||
library(scales)
|
||||
|
||||
linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/"
|
||||
macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/"
|
||||
@@ -57,120 +59,7 @@ con <- dbConnect(
|
||||
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
|
||||
|
||||
# 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"))
|
||||
@@ -187,79 +76,14 @@ 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"))
|
||||
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()
|
||||
|
||||
# pull static data
|
||||
loss_storms <- get_all_loss_storms()
|
||||
|
||||
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()
|
||||
latest_normalized_losses <- get_latest_aggregate_losses()
|
||||
|
||||
storm_selection <- reactiveValues(
|
||||
storm_year = NULL,
|
||||
@@ -269,6 +93,10 @@ storm_selection <- reactiveValues(
|
||||
is_selected = FALSE,
|
||||
is_table_selection = FALSE,
|
||||
)
|
||||
|
||||
onStop(function() {
|
||||
dbDisconnect(con)
|
||||
})
|
||||
```
|
||||
|
||||
Home
|
||||
@@ -370,20 +198,24 @@ Col {data-width=500}
|
||||
|
||||
### Storm Selector {data-height=500}
|
||||
```{r}
|
||||
#h5("Select a storm: ")
|
||||
#h6("Use either the select inputs or the data table below")
|
||||
|
||||
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(4,
|
||||
selectInput("stormBasin", "Select Basin", choices = "AL")
|
||||
),
|
||||
column(6,
|
||||
#TODO: ADD TABLE
|
||||
|
||||
#DTOutput("storm_selector_table")
|
||||
column(4,
|
||||
selectInput("stormYear", "Select Year", choices = loss_storms$storm_year)
|
||||
),
|
||||
column(4,
|
||||
selectInput("stormName", "Select Storm", choices = NULL)
|
||||
)
|
||||
)
|
||||
|
||||
actionButton("selectStorm", "Submit", class = "btn-primary")
|
||||
|
||||
|
||||
observeEvent(input$stormYear, {
|
||||
stormsByChosenYear <- loss_storms[loss_storms$storm_year == input$stormYear, ]
|
||||
|
||||
@@ -411,8 +243,9 @@ observeEvent(input$selectStorm, {
|
||||
```{r}
|
||||
output$normalized_storms_table <- renderDT({
|
||||
datatable(
|
||||
normalized_losses_2024 %>% select(Storm = storm_name, Year = storm_year, MMH24 = mmh, MMP24 = mmp),
|
||||
latest_normalized_losses,
|
||||
rownames = F,
|
||||
colnames = c("Storm", "Year", "MMH24", "MMP24"),
|
||||
selection = "single",
|
||||
options = list(
|
||||
pageLength = 1000,
|
||||
@@ -424,7 +257,7 @@ output$normalized_storms_table <- renderDT({
|
||||
server = T
|
||||
)
|
||||
) %>%
|
||||
formatCurrency(c("MMH24", "MMP24"), "$", digits = 0)
|
||||
formatCurrency(c("mmh", "mmp"), "$", digits = 0)
|
||||
})
|
||||
|
||||
DTOutput("normalized_storms_table")
|
||||
@@ -451,7 +284,25 @@ growth_trends <- reactiveValues(
|
||||
full_lf_id = NULL
|
||||
)
|
||||
|
||||
|
||||
observe({
|
||||
req(storm_selection$is_selected)
|
||||
|
||||
unique_lfs <- get_unique_lf_ids(storm_selection)
|
||||
|
||||
updateSelectInput(
|
||||
session,
|
||||
"storm_overview_cost_index_lf",
|
||||
choices = unique_lfs$full_lf_id,
|
||||
selected = unique_lfs$full_lf_id[1]
|
||||
)
|
||||
|
||||
updateSelectInput(
|
||||
session,
|
||||
"growth_trend_lf_select",
|
||||
choices = unique_lfs$full_lf_id,
|
||||
selected = unique_lfs$full_lf_id[1]
|
||||
)
|
||||
})
|
||||
```
|
||||
|
||||
Col {data-width=500}
|
||||
@@ -467,156 +318,27 @@ 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())
|
||||
output$cost_index_chart <- renderDygraph({
|
||||
req(storm_selection$is_selected, input$storm_overview_cost_index_lf)
|
||||
|
||||
cost_index <- storm_normalized_landfall() %>%
|
||||
select(
|
||||
normalization_year, mmh_index, mmp_index
|
||||
) %>%
|
||||
cost_index <- get_normalized_cost_index(storm_selection, input$storm_overview_cost_index_lf) %>%
|
||||
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)
|
||||
dygraph(cost_index_ts, main = "Cost Index") %>%
|
||||
dySeries("mmh", label = "MMH24") %>%
|
||||
dySeries("mmp", label = "MMP24") %>%
|
||||
dyRangeSelector(height = 30)
|
||||
})
|
||||
|
||||
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, {
|
||||
#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),
|
||||
@@ -632,7 +354,7 @@ fillCol(
|
||||
#checkboxInput("mmpSelect", "Display MMP", value = T)
|
||||
)
|
||||
),
|
||||
dygraphOutput("costIndex")
|
||||
dygraphOutput("cost_index_chart")
|
||||
)
|
||||
```
|
||||
|
||||
@@ -656,39 +378,15 @@ fluidRow(
|
||||
|
||||
### Landfalls {data-height=300 .no-padding}
|
||||
```{r}
|
||||
storm_landfalls <- reactive({
|
||||
output$landfalls_table <- renderDT({
|
||||
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()
|
||||
hurdat_landfalls <- get_hurdat_landfalls(storm_selection)
|
||||
|
||||
cat(str(result))
|
||||
|
||||
return(result)
|
||||
})
|
||||
|
||||
output$landfalls_table <- renderDT({
|
||||
datatable(
|
||||
storm_landfalls(),
|
||||
hurdat_landfalls,
|
||||
rownames = F,
|
||||
colnames = c("Date", "Longitude", "Latitude", "RMW", "Pressure", "Windspeed"),
|
||||
options = list(
|
||||
order = list(0, 'asc'),
|
||||
paging = F,
|
||||
@@ -698,57 +396,29 @@ output$landfalls_table <- renderDT({
|
||||
server = T
|
||||
)
|
||||
) %>%
|
||||
formatDate(columns = "Date", method = "toUTCString")
|
||||
formatDate(columns = "datetime", method = "toUTCString")
|
||||
})
|
||||
|
||||
DTOutput("landfalls_table")
|
||||
|
||||
```
|
||||
|
||||
### Storm Track {data-height=500 .no-padding}
|
||||
```{r}
|
||||
storm_track <- reactive({
|
||||
req(storm_selection$is_selected)
|
||||
output$track_map <- renderLeaflet({
|
||||
storm_track <- get_hurdat_track(storm_selection)
|
||||
|
||||
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(),
|
||||
data = storm_track,
|
||||
lng = ~lon,
|
||||
lat = ~lat,
|
||||
weight = 4,
|
||||
color = "blue"
|
||||
) %>%
|
||||
addCircleMarkers(
|
||||
data = storm_track() %>% filter(record_identifier == "L"),
|
||||
data = storm_track %>% filter(record_identifier == "L"),
|
||||
lng = ~lon,
|
||||
lat = ~lat,
|
||||
radius = 5,
|
||||
@@ -758,7 +428,7 @@ output$trackMap <- renderLeaflet({
|
||||
fillOpacity = 0.8
|
||||
) %>%
|
||||
addCircles(
|
||||
data = storm_track() %>% filter(record_identifier == "L"),
|
||||
data = storm_track %>% filter(record_identifier == "L"),
|
||||
lng = ~lon,
|
||||
lat = ~lat,
|
||||
radius = ~rmw_meters,
|
||||
@@ -769,7 +439,7 @@ output$trackMap <- renderLeaflet({
|
||||
)
|
||||
})
|
||||
|
||||
leafletOutput("trackMap", height="100%")
|
||||
leafletOutput("track_map", height="100%")
|
||||
```
|
||||
|
||||
Growth Trends {data-navmenu="Storm Details"}
|
||||
@@ -780,230 +450,76 @@ Column {data-width=550}
|
||||
|
||||
### Map Year {data-height=100}
|
||||
```{r}
|
||||
sliderInput("growth_trend_map_slider", label = NULL, min = 1900, max = 2024, step = 1, animate = T, value = 2005, sep = "", width = "100%", ticks = F)
|
||||
observe({
|
||||
req(storm_selection$is_selected)
|
||||
|
||||
updateSliderInput(session,
|
||||
"growth_trend_map_slider",
|
||||
min = 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)
|
||||
```
|
||||
|
||||
### {data-height=900 .no-padding}
|
||||
|
||||
```{r}
|
||||
growth_metrics_lf_fips <- reactive({
|
||||
req(growth_trends$full_lf_id)
|
||||
|
||||
result <- 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(
|
||||
fips = paste0(state_fips, county_fips)
|
||||
) %>%
|
||||
select(
|
||||
fips
|
||||
) %>%
|
||||
collect()
|
||||
|
||||
return(result)
|
||||
})
|
||||
#storm_metrics_growth_geom <- reactive({
|
||||
# req(storm_selection$is_selected)
|
||||
#
|
||||
# counties <- get_normalized_metric_growth(storm_selection, input$growth_trend_lf_select)
|
||||
#
|
||||
# result <- counties %>%
|
||||
# st_as_sf(wkt = "geom_wkt")
|
||||
# #%>%
|
||||
# # mutate(
|
||||
# # clamped_population = rescale(normalized_population, to = c(0.1, 0.9), from = range(normalized_population, na.rm = T)),
|
||||
# # clamped_housing = rescale(normalized_housing, to = c(0.1, 0.9), from = range(normalized_housing, na.rm = T))
|
||||
# # ) %>%
|
||||
#
|
||||
#
|
||||
# cat(str(result))
|
||||
#
|
||||
# return(result)
|
||||
#})
|
||||
|
||||
normalized_growth_metrics_lf <- reactive({
|
||||
req(growth_metrics_lf_fips())
|
||||
|
||||
affected_fips <- growth_metrics_lf_fips()$fips
|
||||
|
||||
affected_counties <- metrics.pop_and_housing %>%
|
||||
mutate(
|
||||
fips = paste0(state_fips, county_fips)
|
||||
) %>%
|
||||
filter(
|
||||
fips %in% affected_fips,
|
||||
year >= storm_selection$storm_year
|
||||
) %>%
|
||||
group_by(
|
||||
fips
|
||||
) %>%
|
||||
arrange(
|
||||
year
|
||||
) %>%
|
||||
mutate(
|
||||
base_population = first(population),
|
||||
base_housing_units = first(housing_units),
|
||||
) %>%
|
||||
ungroup() %>%
|
||||
collect()
|
||||
#observe({
|
||||
# req(storm_selection$is_selected, input$growth_trend_map_slider)
|
||||
#
|
||||
# county_data <- storm_metrics_growth_geom() %>%
|
||||
# filter(year == input$growth_trend_map_slider)
|
||||
#
|
||||
# cat(str(county_data))
|
||||
#
|
||||
# leafletProxy("pop_growth_map", session) %>%
|
||||
# clearShapes() %>%
|
||||
# addPolygons(
|
||||
# data = county_data,
|
||||
# fillColor = "red",
|
||||
# fillOpacity = 1
|
||||
# )
|
||||
#})
|
||||
|
||||
affected_counties_geom <- public.counties %>%
|
||||
mutate(
|
||||
fips = paste0(statefp, countyfp),
|
||||
geom_wkt = sql("ST_AsText(ST_Transform(geom, 4326))")
|
||||
) %>%
|
||||
filter(
|
||||
fips %in% affected_fips,
|
||||
) %>%
|
||||
collect()
|
||||
|
||||
result <- affected_counties %>%
|
||||
left_join(
|
||||
affected_counties_geom,
|
||||
by = "fips"
|
||||
) %>%
|
||||
st_as_sf(wkt = "geom_wkt")
|
||||
|
||||
return(result)
|
||||
})
|
||||
|
||||
growth_trend_map_year <- reactive({
|
||||
req(input$growth_trend_map_slider)
|
||||
|
||||
result <- normalized_growth_metrics_lf() %>%
|
||||
filter(
|
||||
year == input$growth_trend_map_slider
|
||||
)
|
||||
|
||||
return(result)
|
||||
})
|
||||
|
||||
aggregate_growth_metrics_lf <- reactive({
|
||||
req(growth_metrics_lf_fips())
|
||||
|
||||
result <- metrics.pop_and_housing %>%
|
||||
mutate(
|
||||
fips = paste0(state_fips, county_fips)
|
||||
) %>%
|
||||
filter(
|
||||
fips %in% growth_metrics_lf_fips()$fips,
|
||||
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()
|
||||
|
||||
return(result)
|
||||
})
|
||||
|
||||
aggregate_normalized_growth_metrics_lf <- reactive ({
|
||||
req(aggregate_growth_metrics_lf())
|
||||
|
||||
result <- aggregate_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
|
||||
)
|
||||
|
||||
return(result)
|
||||
})
|
||||
|
||||
aggregate_normalized_growth_metrics_lf_ts <- reactive({
|
||||
req(aggregate_normalized_growth_metrics_lf())
|
||||
|
||||
result <- aggregate_normalized_growth_metrics_lf() %>%
|
||||
select(-year) %>%
|
||||
xts(order.by = aggregate_normalized_growth_metrics_lf()$year)
|
||||
|
||||
return(result)
|
||||
})
|
||||
|
||||
normalized_growth_metrics_lf_ts <- reactive({
|
||||
req(normalized_growth_metrics_lf())
|
||||
|
||||
result <- normalized_growth_metrics_lf() %>%
|
||||
select(-year) %>%
|
||||
xts(order.by = normalized_growth_metrics_lf()$year)
|
||||
|
||||
return(result)
|
||||
})
|
||||
|
||||
normalized_counties_sf <- reactive({
|
||||
req(storm_selection$is_selected)
|
||||
|
||||
affected_counties <- gis.affected_area_landfalls
|
||||
})
|
||||
|
||||
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({
|
||||
output$pop_growth_map <- renderLeaflet({
|
||||
leaflet() %>%
|
||||
addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>%
|
||||
setView(lng = -89.8, lat = 29.6, zoom = 8) %>%
|
||||
addPolygons(
|
||||
data = growth_trend_map_year(),
|
||||
fillColor = "red",
|
||||
fillOpacity = 0.3,
|
||||
color = "black",
|
||||
weight = 2
|
||||
)
|
||||
addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18))
|
||||
# %>% setView(lng = -89.8, lat = 29.6, zoom = 8)
|
||||
})
|
||||
|
||||
output$housingMapPoly <- 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) #%>%
|
||||
#addPolygons(
|
||||
# data = dbStormCounties(),
|
||||
# fillColor = "blue",
|
||||
# fillOpacity = 0.3,
|
||||
# color = "black",
|
||||
# weight = 2
|
||||
#)
|
||||
addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18))
|
||||
# %>% setView(lng = -89.8, lat = 29.6, zoom = 8)
|
||||
})
|
||||
|
||||
fillCol(
|
||||
flex = c(1, 1),
|
||||
leafletOutput("popMapPoly"),
|
||||
leafletOutput("housingMapPoly")
|
||||
leafletOutput("pop_growth_map"),
|
||||
leafletOutput("housing_growth_map")
|
||||
)
|
||||
|
||||
```
|
||||
|
||||
Column {data-width=450}
|
||||
@@ -1011,23 +527,6 @@ Column {data-width=450}
|
||||
|
||||
### Landfall Selection {data-height=550}
|
||||
```{r}
|
||||
|
||||
|
||||
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(
|
||||
@@ -1039,15 +538,15 @@ fillCol(
|
||||
#checkboxInput("storm_overview_select_base", "Include Normalized Losses", value = F)
|
||||
)
|
||||
),
|
||||
dygraphOutput("popHu")
|
||||
#dygraphOutput("popHu")
|
||||
)
|
||||
|
||||
output$popHu <- renderDygraph({
|
||||
dygraph(aggregate_normalized_growth_metrics_lf_ts(), main = "Normalized Aggregate Growth") %>%
|
||||
dySeries("normalized_population", label = "Population") %>%
|
||||
dySeries("normalized_housing_units", label = "Housing Units") %>%
|
||||
dyRangeSelector()
|
||||
})
|
||||
#output$popHu <- renderDygraph({
|
||||
# dygraph(aggregate_normalized_growth_metrics_lf_ts(), main = "Normalized Aggregate Growth") %>%
|
||||
# dySeries("normalized_population", label = "Population") %>%
|
||||
# dySeries("normalized_housing_units", label = "Housing Units") %>%
|
||||
# dyRangeSelector()
|
||||
#3})
|
||||
|
||||
```
|
||||
|
||||
@@ -1055,27 +554,11 @@ output$popHu <- renderDygraph({
|
||||
```{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")
|
||||
|
||||
```
|
||||
|
||||
Storm Fatalities {data-navmenu="Storm Details"}
|
||||
===
|
||||
|
||||
|
||||
|
||||
Fatalities {data-navmenu="Fatalities"}
|
||||
|
||||
@@ -1,28 +0,0 @@
|
||||
#
|
||||
# This is the server logic of a Shiny web application. You can run the
|
||||
# application by clicking 'Run App' above.
|
||||
#
|
||||
# Find out more about building applications with Shiny here:
|
||||
#
|
||||
# https://shiny.posit.co/
|
||||
#
|
||||
|
||||
library(shiny)
|
||||
|
||||
# Define server logic required to draw a histogram
|
||||
function(input, output, session) {
|
||||
|
||||
output$distPlot <- renderPlot({
|
||||
|
||||
# generate bins based on input$bins from ui.R
|
||||
x <- faithful[, 2]
|
||||
bins <- seq(min(x), max(x), length.out = input$bins + 1)
|
||||
|
||||
# draw the histogram with the specified number of bins
|
||||
hist(x, breaks = bins, col = 'darkgray', border = 'white',
|
||||
xlab = 'Waiting time to next eruption (in mins)',
|
||||
main = 'Histogram of waiting times')
|
||||
|
||||
})
|
||||
|
||||
}
|
||||
@@ -1,33 +0,0 @@
|
||||
#
|
||||
# This is the user-interface definition of a Shiny web application. You can
|
||||
# run the application by clicking 'Run App' above.
|
||||
#
|
||||
# Find out more about building applications with Shiny here:
|
||||
#
|
||||
# https://shiny.posit.co/
|
||||
#
|
||||
|
||||
library(shiny)
|
||||
|
||||
# Define UI for application that draws a histogram
|
||||
fluidPage(
|
||||
|
||||
# Application title
|
||||
titlePanel("Old Faithful Geyser Data"),
|
||||
|
||||
# Sidebar with a slider input for number of bins
|
||||
sidebarLayout(
|
||||
sidebarPanel(
|
||||
sliderInput("bins",
|
||||
"Number of bins:",
|
||||
min = 1,
|
||||
max = 50,
|
||||
value = 30)
|
||||
),
|
||||
|
||||
# Show a plot of the generated distribution
|
||||
mainPanel(
|
||||
plotOutput("distPlot")
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -3,6 +3,7 @@
|
||||
library(tidyverse)
|
||||
library(dplyr)
|
||||
library(DBI)
|
||||
#library(sf)
|
||||
|
||||
linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/"
|
||||
macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/"
|
||||
@@ -43,6 +44,18 @@ metrics.pop_and_housing <- tbl(con, I("metrics.pop_and_housing"))
|
||||
|
||||
public.counties <- tbl(con, I("public.counties"))
|
||||
|
||||
# helper functions
|
||||
|
||||
# splits full_lf_id into lf_type and lf_id
|
||||
split_full_lf_id <- function(full_lf_id) {
|
||||
lf_type = gsub('[0-9]+', '', full_lf_id)
|
||||
lf_id = gsub('[^0-9]', '', full_lf_id)
|
||||
|
||||
return(list(lf_type = lf_type, lf_id = lf_id))
|
||||
}
|
||||
|
||||
# DB getters
|
||||
|
||||
# returns a list of loss storms we have data on
|
||||
get_all_loss_storms <- function() {
|
||||
query <- econ.storm_base_loss %>%
|
||||
@@ -65,14 +78,265 @@ get_all_loss_storms <- function() {
|
||||
return(result)
|
||||
}
|
||||
|
||||
# returns a list of latest normalized losses
|
||||
get_latest_aggregate_losses <- function() {
|
||||
latest_loss_year <- econ.normalized_landfalls %>%
|
||||
select(normalization_year) %>%
|
||||
arrange(desc(normalization_year)) %>%
|
||||
head(1) %>%
|
||||
collect() %>%
|
||||
pull(normalization_year)
|
||||
|
||||
query <- econ.normalized_landfalls %>%
|
||||
filter(normalization_year == latest_loss_year) %>%
|
||||
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)) %>%
|
||||
select(
|
||||
storm_name,
|
||||
storm_year,
|
||||
mmh,
|
||||
mmp
|
||||
)
|
||||
|
||||
result <- query %>% collect()
|
||||
|
||||
return(result)
|
||||
}
|
||||
|
||||
# returns unique lf ids for a storm
|
||||
get_unique_lf_ids <- function(storm) {
|
||||
query <- econ.storm_base_loss %>%
|
||||
filter(
|
||||
storm_basin == storm$storm_basin,
|
||||
storm_year == storm$storm_year,
|
||||
storm_name == storm$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
|
||||
)
|
||||
|
||||
result <- query %>% collect()
|
||||
|
||||
return(result)
|
||||
}
|
||||
|
||||
# returns normalized mmh/mmp indexes and costs over time by landfall
|
||||
get_normalized_cost_index <- function(storm, full_lf_id) {
|
||||
lf_id_parts <- split_full_lf_id(full_lf_id)
|
||||
|
||||
query <- econ.normalized_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
|
||||
) %>%
|
||||
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, "%mwr%") ~ 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(
|
||||
normalization_year, mmh, mmp
|
||||
)
|
||||
|
||||
result <- query %>% collect()
|
||||
|
||||
return(result)
|
||||
}
|
||||
|
||||
# returns landfalls and data at landfall from HURDAT
|
||||
get_hurdat_landfalls <- function(storm) {
|
||||
query <- hurdat.best_track %>%
|
||||
filter(
|
||||
storm_basin == storm$storm_basin,
|
||||
storm_year == storm$storm_year,
|
||||
storm_name == storm$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(
|
||||
datetime,
|
||||
lon,
|
||||
lat,
|
||||
rmw,
|
||||
pressure,
|
||||
windspeed
|
||||
)
|
||||
|
||||
result <- query %>% collect()
|
||||
|
||||
return(result)
|
||||
}
|
||||
|
||||
# returns storm track from HURDAT
|
||||
get_hurdat_track <- function(storm) {
|
||||
query <- hurdat.best_track %>%
|
||||
filter(
|
||||
storm_basin == storm$storm_basin,
|
||||
storm_year == storm$storm_year,
|
||||
storm_name == storm$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) # convert nautical miles to meters
|
||||
) %>%
|
||||
select(
|
||||
datetime,
|
||||
lon,
|
||||
lat,
|
||||
rmw,
|
||||
record_identifier,
|
||||
rmw_meters
|
||||
)
|
||||
|
||||
result <- query %>% collect()
|
||||
|
||||
return(result)
|
||||
}
|
||||
|
||||
# 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)
|
||||
#}
|
||||
|
||||
# test functions
|
||||
|
||||
#storm <- list(storm_basin = "AL", storm_name = "KATRINA", storm_year = 2005)
|
||||
#full_lf_id <- "LF1"
|
||||
|
||||
#a <- get_all_loss_storms()
|
||||
|
||||
#b <- get_latest_aggregate_losses()
|
||||
|
||||
#c <- get_unique_lf_ids(storm)
|
||||
|
||||
#d <- get_normalized_cost_index(storm, full_lf_id)
|
||||
|
||||
#e <- get_hurdat_landfalls(storm)
|
||||
|
||||
#f <- get_hurdat_track(storm)
|
||||
|
||||
#g <- get_normalized_metric_growth(storm, full_lf_id)
|
||||
#g_2 <- g %>%
|
||||
# st_as_sf(wkt = "geom_wkt")
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user