mirror of
https://github.com/dylanbenzi/hurricane_normalization_app.git
synced 2026-07-30 05:08:57 +00:00
update landfalls datatable
This commit is contained in:
+67
-24
@@ -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() %>%
|
||||||
@@ -582,6 +583,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")
|
||||||
|
|
||||||
```
|
```
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user