mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-30 05:08:57 +00:00
add growth trend chart
This commit is contained in:
+106
-97
@@ -267,38 +267,6 @@ storm_selection <- reactiveValues(
|
||||
)
|
||||
```
|
||||
|
||||
```{r}
|
||||
###### REACTIVE SETUP
|
||||
|
||||
#REACTIVES USE LAZY LOADING
|
||||
|
||||
#hurdat.best_track <- dbGetQuery(con, "SELECT *, ST_X(ST_Transform(location::geometry, 4326)) as lon, ST_Y(ST_Transform(location::geometry, 4326)) as lat FROM hurdat.best_track")
|
||||
|
||||
|
||||
selected.best_track <- reactive({
|
||||
req(storm_selection$is_selected)
|
||||
|
||||
query <- paste0("
|
||||
SELECT *,
|
||||
ST_X(ST_Transform(location::geometry, 4326)) as lon,
|
||||
ST_Y(ST_Transform(location::geometry, 4326)) as lat
|
||||
FROM hurdat.best_track
|
||||
WHERE storm_basin = '", storm_selection$storm_basin,
|
||||
"' AND storm_year = ", storm_selection$storm_year,
|
||||
" AND storm_name = '", storm_selection$storm_name,
|
||||
"'")
|
||||
|
||||
result <- dbGetQuery(con, query)
|
||||
|
||||
cat(paste0("DEBUG: selected.best_track returned ", nrow(result)))
|
||||
|
||||
return(result)
|
||||
})
|
||||
|
||||
|
||||
```
|
||||
|
||||
|
||||
Home
|
||||
=============================================
|
||||
|
||||
@@ -473,6 +441,13 @@ storm_overview_reactive <- reactiveValues(
|
||||
use_normalized_costs = FALSE
|
||||
)
|
||||
|
||||
growth_trends <- reactiveValues(
|
||||
lf_type = NULL,
|
||||
lf_id = NULL,
|
||||
full_lf_id = NULL
|
||||
)
|
||||
|
||||
|
||||
```
|
||||
|
||||
Col {data-width=500}
|
||||
@@ -601,6 +576,10 @@ observe({
|
||||
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({
|
||||
@@ -798,12 +777,6 @@ Column {data-width=550}
|
||||
### {data-height=1000 .no-padding}
|
||||
|
||||
```{r}
|
||||
growth_trends <- reactiveValues(
|
||||
lf_id = NULL
|
||||
)
|
||||
|
||||
|
||||
|
||||
dbStormCounties <- reactive({
|
||||
req(storm_selection$is_selected)
|
||||
|
||||
@@ -875,75 +848,111 @@ fillCol(
|
||||
Column {data-width=450}
|
||||
----------------------------------
|
||||
|
||||
### Landfall Selection {data-height=150}
|
||||
### Landfall Selection {data-height=550}
|
||||
```{r}
|
||||
#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
|
||||
# )
|
||||
#})
|
||||
|
||||
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()
|
||||
|
||||
fluidRow(
|
||||
column(4,
|
||||
selectInput("growthTrendLfSelect", "Landfall", choices = NULL)
|
||||
),
|
||||
column(4,
|
||||
|
||||
),
|
||||
column(4,
|
||||
|
||||
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")
|
||||
)
|
||||
|
||||
observeEvent(input$growthTrendLfSelect, {
|
||||
growth_trends$lf_id = input$growthTrendLfSelect
|
||||
|
||||
showNotification("Landfall updated", type = "message")
|
||||
})
|
||||
```
|
||||
|
||||
### Time Series {data-height=400 .no-padding}
|
||||
```{r}
|
||||
|
||||
|
||||
katrinaLfTwoLong <- katrinaLfTwoCountyMetrics %>%
|
||||
pivot_longer(
|
||||
cols = -c(fips, metric),
|
||||
names_to = "year",
|
||||
values_to = "value"
|
||||
) %>%
|
||||
group_by(
|
||||
metric, year
|
||||
) %>%
|
||||
summarize(
|
||||
aggregateValue = sum(value, na.rm = T),
|
||||
.groups = "drop"
|
||||
) %>%
|
||||
pivot_wider(
|
||||
names_from = metric,
|
||||
values_from = aggregateValue
|
||||
)
|
||||
|
||||
normalizedKatrinaLfTwo <- xlallLandfallsNormalized %>%
|
||||
filter(hurdatId == "AL122005" & lfId == "LF2") %>%
|
||||
select(normalizationYear, affectedPop, affectedHousing)
|
||||
|
||||
normalizedKatrinaLfTwoTs <- normalizedKatrinaLfTwo %>%
|
||||
select(-normalizationYear) %>%
|
||||
as.matrix() %>%
|
||||
xts(order.by = as.Date(paste0(normalizedKatrinaLfTwo$normalizationYear, "-01-01")))
|
||||
|
||||
katrinaLfTwoLongTs <- katrinaLfTwoLong %>%
|
||||
select(-year) %>%
|
||||
as.matrix() %>%
|
||||
xts(order.by = as.Date(paste0(katrinaLfTwoLong$year, "-01-01")))
|
||||
|
||||
|
||||
output$popHu <- renderDygraph({
|
||||
dygraph(normalizedKatrinaLfTwoTs, main = "Normalized LF2 Aggregate Growth") %>%
|
||||
dySeries("affectedPop", label = "Population") %>%
|
||||
dySeries("affectedHousing", label = "Housing Units") %>%
|
||||
dygraph(normalized_growth_metrics_lf_ts(), main = "Normalized Aggregate Growth") %>%
|
||||
dySeries("normalized_population", label = "Population") %>%
|
||||
dySeries("normalized_housing_units", label = "Housing Units") %>%
|
||||
dyRangeSelector()
|
||||
})
|
||||
|
||||
|
||||
#dygraphOutput("popHu")
|
||||
```
|
||||
|
||||
### County Data {data-height=450 .no-padding}
|
||||
|
||||
Reference in New Issue
Block a user