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

resolve merge conflict storm_details master

Browse Source
This commit is contained in:
dylan
2025-07-19 16:25:53 -04:00
parent 54a0edf0ba f9e6ce7a33
commit ab5acd9d67
2 changed files with 121 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files
dashboard.Rmd
+95 -31
View File
@@ -41,6 +41,7 @@ library(caret)
library(scales)
library(billboarder)
library(shinyWidgets)
library(paletteer)
# local testing env setup
os <- Sys.info()["sysname"]
@@ -218,10 +219,17 @@ observe({
unique_lfs <- get_unique_lf_ids(storm_selection)
updateSelectInput(
session,
"storm_overview_cost_index_lf",
choices = unique_lfs$full_lf_id,
#updateSelectInput(
# session,
# "storm_overview_cost_index_lf",
# choices = unique_lfs$full_lf_id,
# selected = unique_lfs$full_lf_id[1]
#)
updateVirtualSelect(
session = session,
"storm_overview_cost_index_lf_select",
choices = prepare_choices(unique_lfs, full_lf_id, full_lf_id, lf_type),
selected = unique_lfs$full_lf_id[1]
)
@@ -322,45 +330,101 @@ DTOutput("track_data")
Col {data-width=500}
------------------------------------
### Normalization Cost Index {data-height=500}
### Normalization Cost Index {data-height=700}
```{r}
# Overview - Normalization Chart
# TODO: chart controls and filter
output$cost_index_chart <- renderDygraph({
req(storm_selection$is_selected, input$storm_overview_cost_index_lf)
storm_yearly_normalization <- reactive({
req(storm_selection$is_selected)
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)
result <- get_all_normalized_cost_index(storm_selection)
dygraph(cost_index_ts, main = "Cost Index") %>%
dySeries("mmh", label = "MMH24") %>%
dySeries("mmp", label = "MMP24") %>%
dyRangeSelector(height = 30)
return(result)
})
fillCol(
flex = c(.2, .8),
fluidRow(
column(4,
selectInput("storm_overview_cost_index_lf", "Landfall Select", choices = NULL)
output$cost_index_chart <- renderDygraph({
req(storm_yearly_normalization,
input$storm_overview_cost_index_lf_select,
input$storm_overview_cost_index_mmh_mmp,
input$storm_overview_cost_index_scale)
normalized_data <- storm_yearly_normalization() %>%
rename(
"MMH Index" = mmh_index,
"MMH Loss" = mmh_loss,
"MMP Index" = mmp_index,
"MMP Loss" = mmp_loss
)
selected_lf <- input$storm_overview_cost_index_lf_select
selected_normalization <- input$storm_overview_cost_index_mmh_mmp
selected_scale <- input$storm_overview_cost_index_scale
method_map <- c("MMH", "MMP")
selected_methods <- method_map[method_map %in% selected_normalization]
if (selected_scale == "Index") {
value_columns <- paste0(selected_methods, " Index")
} else if (selected_scale == "Loss") {
value_columns <- paste0(selected_methods, " Loss")
}
normalization_index <- normalized_data %>%
filter(
full_lf_id %in% selected_lf
) %>%
mutate(
normalization_year = as.Date(paste0(normalization_year, "-01-01"))
) %>%
select(
normalization_year,
full_lf_id,
all_of(value_columns)
) %>%
pivot_wider(
names_from = full_lf_id,
values_from = all_of(value_columns),
names_glue = "{full_lf_id} {.value}"
)
normalization_index_ts <- normalization_index %>%
select(-normalization_year) %>%
xts(order.by = normalization_index$normalization_year)
dygraph(normalization_index_ts) %>%
dyOptions(
colors = paletteer_d("ggthemes::Classic_Purple_Gray_12", ncol(normalization_index - 1)),
fillGraph = T,
fillAlpha = .2,
) %>%
dyAxis("x", drawGrid = F) %>%
dyRangeSelector()
})
fluidRow(
style = "height: 100%",
column(3,
virtualSelectInput("storm_overview_cost_index_lf_select", "Landfalls",
#choices = list(
# "LF" = c("LF1", "LF2", "LF3"),
# "DIL" = c("DIL1", "DIL2", "DIL3", "DIL4"),
# "ID" = c("ID1", "ID2", "ID3", "ID4")
#),
choices = NULL,
showValueAsTags = T,
multiple = T,
autoSelectFirstOption = T),
radioGroupButtons("storm_overview_cost_index_scale", label = "Value", choices = c("Index", "Loss"), status = "outline-primary rounded-0", justified = T),
checkboxGroupButtons("storm_overview_cost_index_mmh_mmp", label = "MMH/MMP", choices = c("MMH", "MMP"), selected = c("MMH", "MMP"), status = "outline-primary rounded-0", justified = T)
),
column(4,
),
column(4,
column(9,
dygraphOutput("cost_index_chart")
)
),
dygraphOutput("cost_index_chart")
)
```
### Landfalls {data-height=500 .no-padding}
### Landfalls {data-height=300 .no-padding}
```{r}
# Overview - Landfalls Table
queries.R
+26 -1
View File
@@ -75,6 +75,12 @@ view.all_conus_landfalls <- tbl(con, "all_conus_landfalls")
# lf_id = 1
#)
agnes <- list(
storm_basin = "AL",
storm_year = 1972,
storm_name = "AGNES"
)
# helper functions
# disconnect db connection
@@ -197,6 +203,25 @@ ORDER BY year;")
xts(order.by = result$year)
return(result_ts)
# returns normalized mmh/mmp indexes and costs over time by storm
get_all_normalized_cost_index <- function(storm) {
query <- view.yearly_normalized_losses %>%
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)
) %>%
select(
normalization_year, mmh_index, mmp_index, mmh_loss = mmh, mmp_loss = mmp, full_lf_id
)
result <- query %>% collect()
return(result)
}
# returns landfalls and data at landfall from HURDAT
@@ -359,4 +384,4 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
result <- query %>% collect()
return(result)
}
}