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_id = NULL,
full_lf_id = NULL,
use_normalized_costs = FALSE
)
```
@@ -562,7 +563,7 @@ storm_normalized_landfall <- reactive({
return(result)
})
storm_cost_index_ts <- reactive({
storm_cost_index_base_index_ts <- reactive({
req(storm_normalized_landfall())
cost_index <- storm_normalized_landfall() %>%
@@ -582,6 +583,26 @@ storm_cost_index_ts <- reactive({
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({
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({
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(
@@ -617,7 +650,8 @@ fillCol(
selectInput("storm_overview_cost_index_lf", "Landfall Select", choices = NULL)
),
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,
#checkboxInput("mmpSelect", "Display MMP", value = T)
@@ -632,6 +666,8 @@ Col {data-width=500}
### Fatalities {data-height=200}
```{r}
# TODO: fatalities dashboard
fluidRow(
column(6,
HTML('
@@ -647,31 +683,38 @@ fluidRow(
### Landfalls {data-height=300 .no-padding}
```{r}
#selectLandfalls <- hurdat.best_track %>%
# filter(
# storm_name == storm_selection$storm_name &
# storm_year == storm_selection$storm_year &
# record_identifier == "L"
# )
landfallsdata <- reactive({
storm_landfalls <- reactive({
req(storm_selection$is_selected)
df <- selected.best_track() %>%
filter(record_identifier == "L") %>%
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,
Latitude = lat,
Longitude = lon,
Latitude = lat,
RMW = rmw,
Pressure = pressure,
Windspeed = windspeed,
RMW = rmw
)
Windspeed = windspeed
) %>%
collect()
cat(str(result))
return(result)
})
output$landfalls <- renderDT({
output$landfalls_table <- renderDT({
datatable(
landfallsdata(),
storm_landfalls(),
rownames = F,
options = list(
order = list(0, 'asc'),
@@ -685,7 +728,7 @@ output$landfalls <- renderDT({
formatDate(columns = "Date", method = "toUTCString")
})
DTOutput("landfalls")
DTOutput("landfalls_table")
```