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
|
Home
|
||||||
=============================================
|
=============================================
|
||||||
|
|
||||||
@@ -473,6 +441,13 @@ storm_overview_reactive <- reactiveValues(
|
|||||||
use_normalized_costs = FALSE
|
use_normalized_costs = FALSE
|
||||||
)
|
)
|
||||||
|
|
||||||
|
growth_trends <- reactiveValues(
|
||||||
|
lf_type = NULL,
|
||||||
|
lf_id = NULL,
|
||||||
|
full_lf_id = NULL
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
```
|
```
|
||||||
|
|
||||||
Col {data-width=500}
|
Col {data-width=500}
|
||||||
@@ -601,6 +576,10 @@ observe({
|
|||||||
storm_overview_reactive$lf_type = storm_unique_landfalls()$lf_type[1]
|
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$lf_id = storm_unique_landfalls()$lf_id[1]
|
||||||
storm_overview_reactive$full_lf_id = storm_unique_landfalls()$full_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({
|
observe({
|
||||||
@@ -798,12 +777,6 @@ Column {data-width=550}
|
|||||||
### {data-height=1000 .no-padding}
|
### {data-height=1000 .no-padding}
|
||||||
|
|
||||||
```{r}
|
```{r}
|
||||||
growth_trends <- reactiveValues(
|
|
||||||
lf_id = NULL
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
dbStormCounties <- reactive({
|
dbStormCounties <- reactive({
|
||||||
req(storm_selection$is_selected)
|
req(storm_selection$is_selected)
|
||||||
|
|
||||||
@@ -875,75 +848,111 @@ fillCol(
|
|||||||
Column {data-width=450}
|
Column {data-width=450}
|
||||||
----------------------------------
|
----------------------------------
|
||||||
|
|
||||||
### Landfall Selection {data-height=150}
|
### Landfall Selection {data-height=550}
|
||||||
```{r}
|
```{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(
|
growth_metrics_lf <- metrics.pop_and_housing %>%
|
||||||
column(4,
|
mutate(
|
||||||
selectInput("growthTrendLfSelect", "Landfall", choices = NULL)
|
full_lf_id = paste0(state_fips, county_fips)
|
||||||
),
|
) %>%
|
||||||
column(4,
|
filter(
|
||||||
|
full_lf_id %in% growth_metrics_lf_fips$full_lf_id,
|
||||||
),
|
year >= storm_selection$storm_year
|
||||||
column(4,
|
) %>%
|
||||||
|
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({
|
output$popHu <- renderDygraph({
|
||||||
dygraph(normalizedKatrinaLfTwoTs, main = "Normalized LF2 Aggregate Growth") %>%
|
dygraph(normalized_growth_metrics_lf_ts(), main = "Normalized Aggregate Growth") %>%
|
||||||
dySeries("affectedPop", label = "Population") %>%
|
dySeries("normalized_population", label = "Population") %>%
|
||||||
dySeries("affectedHousing", label = "Housing Units") %>%
|
dySeries("normalized_housing_units", label = "Housing Units") %>%
|
||||||
dyRangeSelector()
|
dyRangeSelector()
|
||||||
})
|
})
|
||||||
|
|
||||||
|
|
||||||
#dygraphOutput("popHu")
|
|
||||||
```
|
```
|
||||||
|
|
||||||
### County Data {data-height=450 .no-padding}
|
### County Data {data-height=450 .no-padding}
|
||||||
|
|||||||
Reference in New Issue
Block a user