update landfalls datatable

This commit is contained in:
2025-06-04 17:07:20 -04:00
parent f86221b0f6
commit 858868c828
+67 -24
View File
@@ -478,6 +478,7 @@ storm_overview_reactive <- reactiveValues(
lf_type = NULL, lf_type = NULL,
lf_id = NULL, lf_id = NULL,
full_lf_id = NULL, full_lf_id = NULL,
use_normalized_costs = FALSE
) )
``` ```
@@ -562,7 +563,7 @@ storm_normalized_landfall <- reactive({
return(result) return(result)
}) })
storm_cost_index_ts <- reactive({ storm_cost_index_base_index_ts <- reactive({
req(storm_normalized_landfall()) req(storm_normalized_landfall())
cost_index <- storm_normalized_landfall() %>% cost_index <- storm_normalized_landfall() %>%
@@ -581,6 +582,26 @@ storm_cost_index_ts <- reactive({
return(result) 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({ observe({
req(storm_unique_landfalls()) req(storm_unique_landfalls())
@@ -601,13 +622,25 @@ observe({
) )
}) })
observeEvent(input$storm_overview_select_base, {
# TODO: add button to select normalized costs
})
output$costIndex <- renderDygraph({ output$costIndex <- renderDygraph({
req(storm_cost_index_ts()) 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)
}
dygraph(storm_cost_index_ts(), main = paste(storm_selection$storm_name, storm_selection$storm_year, "Cost Index")) %>%
dySeries("mmh_index", label = "MMH") %>%
dySeries("mmp_index", label = "MMP") %>%
dyRangeSelector(height = 30)
}) })
fillCol( fillCol(
@@ -617,7 +650,8 @@ fillCol(
selectInput("storm_overview_cost_index_lf", "Landfall Select", choices = NULL) selectInput("storm_overview_cost_index_lf", "Landfall Select", choices = NULL)
), ),
column(4, column(4,
#checkboxInput("mmhSelect", "Display MMH", value = T) # TODO: add button to select normalized costs
#checkboxInput("storm_overview_select_base", "Include Normalized Losses", value = F)
), ),
column(4, column(4,
#checkboxInput("mmpSelect", "Display MMP", value = T) #checkboxInput("mmpSelect", "Display MMP", value = T)
@@ -632,6 +666,8 @@ Col {data-width=500}
### Fatalities {data-height=200} ### Fatalities {data-height=200}
```{r} ```{r}
# TODO: fatalities dashboard
fluidRow( fluidRow(
column(6, column(6,
HTML(' HTML('
@@ -647,31 +683,38 @@ fluidRow(
### Landfalls {data-height=300 .no-padding} ### Landfalls {data-height=300 .no-padding}
```{r} ```{r}
#selectLandfalls <- hurdat.best_track %>% storm_landfalls <- reactive({
# filter(
# storm_name == storm_selection$storm_name &
# storm_year == storm_selection$storm_year &
# record_identifier == "L"
# )
landfallsdata <- reactive({
req(storm_selection$is_selected) req(storm_selection$is_selected)
df <- selected.best_track() %>% result <- hurdat.best_track %>%
filter(record_identifier == "L") %>% 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( select(
Date = datetime, Date = datetime,
Latitude = lat,
Longitude = lon, Longitude = lon,
Latitude = lat,
RMW = rmw,
Pressure = pressure, Pressure = pressure,
Windspeed = windspeed, Windspeed = windspeed
RMW = rmw ) %>%
) collect()
cat(str(result))
return(result)
}) })
output$landfalls <- renderDT({ output$landfalls_table <- renderDT({
datatable( datatable(
landfallsdata(), storm_landfalls(),
rownames = F, rownames = F,
options = list( options = list(
order = list(0, 'asc'), order = list(0, 'asc'),
@@ -685,7 +728,7 @@ output$landfalls <- renderDT({
formatDate(columns = "Date", method = "toUTCString") formatDate(columns = "Date", method = "toUTCString")
}) })
DTOutput("landfalls") DTOutput("landfalls_table")
``` ```