diff --git a/app/dashboard.Rmd b/app/dashboard.Rmd index 9fa1f0b..c5a47fe 100644 --- a/app/dashboard.Rmd +++ b/app/dashboard.Rmd @@ -1,5 +1,5 @@ --- -title: "Hurricane Normalization App" +title: "Tropical Cyclone Database" runtime: shiny output: flexdashboard::flex_dashboard: @@ -214,11 +214,6 @@ output$normalized_storms_table <- renderDT({ DTOutput("normalized_storms_table") ``` - - -Storm Overview {data-navmenu="Storm Details"} -==================================== - ```{r} # Storm Overview - Setup @@ -243,9 +238,115 @@ observe({ }) ``` -Col {data-width=500} ------------------------------------- +Storm Selector +==================================== +Col {data-width=600} +---------------------------------------------- + +### {.no-padding} +```{r} +# Tracking - Storms Table +observeEvent(input$normalized_storms_full_table_rows_selected, { + showNotification(latest_normalized_losses[input$normalized_storms_full_table_rows_selected, ]$storm_name, type = "message") +}) + +output$storm_coverage_table <- renderDT({ + raw <- get_storm_data_coverage() %>% select(-storm_basin) + col_names <- names(raw) + + df <- raw %>% + mutate( + data = trimws(paste( + ifelse(as.logical(.data[[col_names[3]]]), 'Fatality', ""), + ifelse(as.logical(.data[[col_names[4]]]), 'Cost', "") + )) + ) %>% + select(1, 2, data) + + datatable( + df, + rownames = F, + escape = F, + colnames = c("Year", "Name", "Data"), + selection = "single", + options = list( + pageLength = 1000, + order = list(0, 'desc'), + searching = F, + paging = F, + info = F, + lengthChange = F + ) + ) +}) + +#DT with storm, hurdatid, base damage, mmh, mmp, maybe multipliers?, sparkline? +output$normalized_storms_full_table <- renderDT({ + datatable( + latest_normalized_losses, + rownames = F, + colnames = c("HURDAT Code", "Storm", "Year", "MMH24", "MMP24"), + selection = "single", + options = list( + pageLength = 20, + order = list(0, 'asc'), + server = T + ) + ) %>% + formatCurrency(c("mmh", "mmp"), "$", digits = 0) +}) + +DTOutput("storm_coverage_table") +``` + +Col {data-width=400} +---------------------------------------------- + +### {data-height=200 .no-padding} +```{r} + +``` + +### {data-height=800 .no-padding} +```{r} +# Tracking - Storms Map + +output$all_storms_map <- renderLeaflet({ + leaflet() %>% + addProviderTiles("Stadia.AlidadeSmooth") %>% + addCircleMarkers( + data = all_conus_landfalls, + lng = ~lon, + lat = ~lat, + radius = 2, + popup = ~ paste0(storm_name, " ", storm_year), + weight = 0, + color = "blue", + fillColor = "blue", + fillOpacity = 0.5 + ) %>% + addCircles( + data = all_conus_landfalls, + lng = ~lon, + lat = ~lat, + radius = ~rmw_meters, + popup = ~ paste0(storm_name, " ", storm_year), + weight = 1, + color = "blue", + fillColor = "blue", + fillOpacity = 0.05 + ) +}) + +leafletOutput("all_storms_map", height = "100%") +``` + +Storm Track {data-navmenu="Meteorology"} +==================================== + +Col {data-width=500} +---------------------------------------------- ### Track Map {.no-padding} ```{r} # Overview - Track Map @@ -548,10 +649,59 @@ output$track_map <- renderLeaflet({ leafletOutput("track_map", height = "100%") ``` -Col {data-width=500 .tabset} ------------------------------------- -### Normalization and Landfalls {} +Col {data-width=500} +---------------------------------------------- +### Track Data {.no-padding} +```{r} +# Overview - Track Data + +output$track_data <- renderDT({ + datatable( + storm_track() %>% + select( + formatted_datetime, + storm_status, + lon, + lat, + rmw, + pressure, + windspeed + ), + rownames = F, + colnames = c( + "Date", + "Status", + "Lon", + "Lat", + "RMW", + "Pressure", + "Windspeed" + ), + selection = "none", + options = list( + pageLength = 1000, + order = list(0, 'asc'), + searching = F, + paging = F, + info = F, + lengthChange = F, + server = T + ) + ) +}) + +DTOutput("track_data") +``` + +Meteorology {data-navmenu="Meteorology"} +==================================== + +Normalizations {data-navmenu="Costs"} +==================================== +Col {data-width=500} +---------------------------------------------- +### MMH/MMP Normalization {data-height=500} ```{r} # Overview - Normalization and Landfalls @@ -651,129 +801,58 @@ output$cost_index_chart <- renderDygraph({ input$storm_overview_cost_index_y_scale ) -hurdat_landfalls <- reactive({ - req(storm_selection$storm_basin, storm_selection$storm_year, storm_selection$storm_name) - get_hurdat_landfalls(storm_selection) -}) %>% - bindCache(storm_selection$storm_year, storm_selection$storm_name, storm_selection$storm_basin) - -output$landfalls_table <- renderDT({ - datatable( - hurdat_landfalls(), - rownames = F, - colnames = c( - "Date", - "Longitude", - "Latitude", - "RMW", - "Pressure", - "Windspeed" - ), - options = list( - order = list(0, 'asc'), - paging = F, - searching = F, - info = F, - lengthChange = F, - server = T - ) - ) %>% - formatDate(columns = "datetime", method = "toUTCString") -}) - -fillCol( - flex = c(0.5, 0.5), - div( - fluidRow( - style = "height: 100%", - column( - 3, - virtualSelectInput( - "storm_overview_cost_index_lf_select", - "Landfalls", - 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 - ), - radioGroupButtons( - "storm_overview_cost_index_y_scale", - label = "Y-Axis Scale", - choices = c("Linear", "Log"), - status = "outline-primary rounded-0", - justified = T - ) +div( + fluidRow( + style = "height: 100%", + column( + 3, + virtualSelectInput( + "storm_overview_cost_index_lf_select", + "Landfalls", + choices = NULL, + showValueAsTags = T, + multiple = T, + autoSelectFirstOption = T ), - column(9, dygraphOutput("cost_index_chart")) - ) - ), - div( - DTOutput("landfalls_table") + 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 + ), + radioGroupButtons( + "storm_overview_cost_index_y_scale", + label = "Y-Axis Scale", + choices = c("Linear", "Log"), + status = "outline-primary rounded-0", + justified = T + ) + ), + column(9, dygraphOutput("cost_index_chart")) ) ) ``` -### Track Data {.no-padding} -```{r} -# Overview - Track Data +### Other1 {data-height=500} -output$track_data <- renderDT({ - datatable( - storm_track() %>% - select( - formatted_datetime, - storm_status, - lon, - lat, - rmw, - pressure, - windspeed - ), - rownames = F, - colnames = c( - "Date", - "Status", - "Lon", - "Lat", - "RMW", - "Pressure", - "Windspeed" - ), - selection = "none", - options = list( - pageLength = 1000, - order = list(0, 'asc'), - searching = F, - paging = F, - info = F, - lengthChange = F, - server = T - ) - ) -}) +Col {data-width=500} +---------------------------------------------- +### Other2 {data-height=500} -DTOutput("track_data") -``` +### Other3 {data-height=500} - -Growth Trends {data-navmenu="Storm Details"} -================================ +Growth Factors {data-navmenu="Costs"} +==================================== Column {data-width=550} ------------------------------- @@ -1068,446 +1147,29 @@ output$county_growth_dt <- renderDT({ DTOutput("county_growth_dt") ``` -Normalization Calculator {data-navmenu="Compute"} -=== - -```{r} -# Calculator - Setup Code - -calculator_storm_selection <- reactiveValues( - storm_year = NULL, - storm_name = NULL, - storm_basin = NULL, - full_lf_id = NULL, -) - -observeEvent(input$impact_populate_storm, { - calculator_storm_selection$storm_basin = input$impact_storm_basin - calculator_storm_selection$storm_year = input$impact_storm_year - calculator_storm_selection$storm_name = input$impact_storm_name - calculator_storm_selection$full_lf_id = input$impact_storm_full_lf_id - - calculator_storm_details <- get_lf_type_factors(calculator_storm_selection) - - updateTextInput( - session, - "impact_lat", - value = calculator_storm_details$lat - ) - - updateTextInput( - session, - "impact_lon", - value = calculator_storm_details$lon - ) - - updateTextInput( - session, - "impact_rmw", - value = calculator_storm_details$rmw - ) - - updateSliderInput( - session, - "impact_rmw_slider", - value = calculator_storm_details$rmw - ) - - updateTextInput( - session, - "impact_base_year", - value = calculator_storm_details$storm_year - ) - - updateTextInput( - session, - "impact_ref_year", - value = "2024" - ) - - updateTextInput( - session, - "impact_base_damage", - value = calculator_storm_details$mwr - ) -}) -``` - -Column {data-width=700} ---- - -### Impact Map {.no-padding} -```{r} -# Calculator - Impact Map - -output$impact_analysis_map <- renderLeaflet({ - leaflet() %>% - addProviderTiles("Stadia.AlidadeSmooth") #%>% - #setView(lng = -80.3, lat = 25.6, zoom = 10) %>% - #addCircles( - # lng = -80.3, - # lat = 25.6, - # radius = 37040, - # color = "blue", - # weight = 2, - # opacity = 0.3 - #) %>% - #addCircleMarkers( - # lng = -80.3, - # lat = 25.6, - # radius = 5, - # weight = 0, - # color = "blue", - # fillColor = "blue", - # fillOpacity = 0.6 - #) -}) - -leafletOutput("impact_analysis_map", height = "100%") -``` - -Column {data-width=300} ---- - -### {} -```{r} -# Calculator - Input -# TODO: add data population and compute - -observeEvent(input$impact_storm_year, { - stormsByChosenYear <- all_lf_type_storms[all_lf_type_storms$storm_year == input$impact_storm_year, ] - - stormsByYear <- all_lf_type_storms %>% filter(storm_year == input$impact_storm_year) - - updateSelectInput( - session, - "impact_storm_name", - choices = stormsByYear$storm_name, - selected = NULL - ) -}) - -observeEvent(input$impact_storm_name, { - uniqueLfs <- all_lf_type_storms %>% - filter( - storm_basin == input$impact_storm_basin, - storm_year == input$impact_storm_year, - storm_name == input$impact_storm_name - ) - - updateSelectInput( - session, - "impact_storm_full_lf_id", - choices = uniqueLfs$full_lf_id - ) -}) - -observe({ - req( - input$impact_lat, - input$impact_lon - ) - - new_lat <- as.numeric(input$impact_lat) - new_lon <- as.numeric(input$impact_lon) - - if(new_lat >= -90 & new_lat <= 90 & new_lon >= -180 & new_lon <= 180) { - rmw_meters <- input$impact_rmw_slider * 1852 - - leafletProxy("impact_analysis_map") %>% - setView(lat = new_lat, lng = new_lon, zoom = 9) %>% - clearShapes() %>% - clearMarkers() %>% - addCircleMarkers( - lng = new_lon, - lat = new_lat, - radius = 2, - weight = 0, - color = "blue", - fillColor = "blue", - fillOpacity = 0.5 - ) %>% - addCircles( - lng = new_lon, - lat = new_lat, - radius = rmw_meters, - weight = 1, - color = "blue", - fillColor = "blue", - fillOpacity = 0.05 - ) - } -}) - -observe({ - req(input$impact_rmw) - - if(as.numeric(input$impact_rmw) > 0) { - updateSliderInput( - session, - "impact_rmw_slider", - value = input$impact_rmw - ) - } -}) - -observe({ - req(input$impact_rmw_slider) - - updateTextInput( - session, - "impact_rmw", - value = input$impact_rmw_slider - ) -}) - -observe({ - req(input$impact_rmw, input$impact_rmw_slider) - - rmw_meters <- input$impact_rmw_slider * 1852 - - new_lon = input$impact_storm_lon - new_lat = input$impact_storm_lat - - req(new_lon, new_lat) - - if(new_lat >= -90 & new_lat <= 90 & new_lon >= -180 & new_lon <= 180) { - leafletProxy("impact_analysis_map") %>% - clearShapes() %>% - clearMarkers() %>% - addCircleMarkers( - lng = new_lon, - lat = new_lat, - radius = 2, - weight = 0, - color = "blue", - fillColor = "blue", - fillOpacity = 0.5 - ) %>% - addCircles( - lng = new_lon, - lat = new_lat, - radius = rmw_meters, - weight = 1, - color = "blue", - fillColor = "blue", - fillOpacity = 0.05 - ) - } -}) - -div( - h6("Storm Selector"), - - fluidRow( - column( - 6, - selectInput( - "impact_storm_basin", - label = NULL, - choices = "AL", - width = "100%" - ), - ), - column( - 6, - selectInput( - "impact_storm_year", - label = NULL, - choices = all_lf_type_storms$storm_year, - width = "100%" - ), - ) - ), - fluidRow( - column( - 6, - selectInput( - "impact_storm_name", - label = NULL, - choices = NULL, - width = "100%" - ), - ), - column( - 6, - selectInput( - "impact_storm_full_lf_id", - label = NULL, - choices = "1", - width = "100%" - ) - ) - ), - - actionButton( - "impact_populate_storm", - label = "Populate", - width = "100%", - class = "btn-primary rounded" - ) -) - -hr() - -div( - fluidRow( - column( - 6, - textInput( - "impact_lat", - placeholder = "Lat", - value = "25.6", - label = "Latitude", - width = "100%" - ) - ), - column( - 6, - textInput( - "impact_lon", - placeholder = "Lon", - value = "-80.3", - label = "Longitude", - width = "100%" - ) - ) - ), - - fluidRow( - column( - 4, - textInput( - "impact_rmw", - placeholder = "RMW", - value = "20", - label = "RMW (NM)", - width = "100%" - ) - ), - column( - 8, - sliderInput( - "impact_rmw_slider", - label = NULL, - min = 1, - max = 150, - value = 20, - ticks = F, - width = "100%" - ) - ) - ), - - radioGroupButtons( - "impact_rmw_multiplier", - label = "RMW Multiplier", - choices = c("1x", "2x", "3x"), - selected = "2x", - status = "outline-primary rounded-0", - justified = T - ), - - fluidRow( - column( - 6, - textInput( - "impact_base_year", - placeholder = "Impact Year", - value = "1926", - label = "Base Year", - width = "100%" - ) - ), - column( - 6, - textInput( - "impact_ref_year", - placeholder = "Reference Year", - value = "2024", - label = "Ref Year", - width = "100%" - ) - ) - ), - - textInput( - "impact_base_damage", - placeholder = "Storm Base Damage", - label = "Base Damage", - value = "76,000,000", - width = "100%" - ), - - actionButton( - "impact_calculate", - label = "Calculate", - width = "100%", - class = "btn-primary rounded" - ) -) -``` - -Download Report {data-navmenu="Compute"} -=== - -Column {data-width=400} ---- - -### Report Options {} -```{r} -downloadButton("report", "Generate Report") - -output$report <- downloadHandler( - filename = function() { - paste0( - storm_selection$hurdatid, - "_", - storm_selection$storm_name, - "_", - storm_selection$storm_year, - ".pdf" - ) - }, - content = function(file) { - params <- list( - storm_basin = storm_selection$storm_basin, - storm_year = storm_selection$storm_year, - storm_name = storm_selection$storm_name, - hurdat_id = storm_selection$hurdatid - ) - - id <- showNotification( - "Rendering report...", - duration = NULL, - closeButton = FALSE - ) - - on.exit(removeNotification(id), add = TRUE) - - temp_pdf <- file.path(APP_DIR, "storm_report.pdf") - - quarto::quarto_render( - input = file.path(APP_DIR, "storm_report.qmd"), - execute_params = params, - output_format = "pdf" - ) - - file.copy(temp_pdf, file) - } -) -``` - -Column {data-width=600} ---- +Fatality Map {data-navmenu="Fatalities"} +==================================== ### {.no-padding} ```{r} +output$fatality_map <- renderLeaflet({ + leaflet() %>% + addProviderTiles("Stadia.AlidadeSmooth") +}) + +leafletOutput("fatality_map", height = "100%") ``` -Data Export {data-navmenu="Compute"} -=== +Peril Breakdown {data-navmenu="Fatalities"} +==================================== + + +What We Track {data-navmenu="Data"} +==================================== + +Export {data-navmenu="Data"} +==================================== ```{r} # Export - Mock Data @@ -1792,71 +1454,8 @@ div( ) ``` -Tracked Storms {data-navmenu="All Storms"} -=== +Our Methodology {data-navmenu="About"} +==================================== -Column {data-width=650} ---- - -### {} -```{r} -# Tracking - Storms Table - -#DT with storm, hurdatid, base damage, mmh, mmp, maybe multipliers?, sparkline? -output$normalized_storms_full_table <- renderDT({ - datatable( - latest_normalized_losses, - rownames = F, - colnames = c("HURDAT Code", "Storm", "Year", "MMH24", "MMP24"), - selection = "none", - options = list( - pageLength = 20, - order = list(0, 'asc'), - server = T - ) - ) %>% - formatCurrency(c("mmh", "mmp"), "$", digits = 0) -}) - -DTOutput("normalized_storms_full_table") -``` - -Column {data-width=350} ---- - -### {.no-padding} -```{r} -# Tracking - Storms Map - -output$all_storms_map <- renderLeaflet({ - leaflet() %>% - addProviderTiles("Stadia.AlidadeSmooth") %>% - addCircleMarkers( - data = all_conus_landfalls, - lng = ~lon, - lat = ~lat, - radius = 2, - popup = ~ paste0(storm_name, " ", storm_year), - weight = 0, - color = "blue", - fillColor = "blue", - fillOpacity = 0.5 - ) %>% - addCircles( - data = all_conus_landfalls, - lng = ~lon, - lat = ~lat, - radius = ~rmw_meters, - popup = ~ paste0(storm_name, " ", storm_year), - weight = 1, - color = "blue", - fillColor = "blue", - fillOpacity = 0.05 - ) -}) - -leafletOutput("all_storms_map", height = "100%") -``` - -About -=== +Contact {data-navmenu="About"} +==================================== \ No newline at end of file diff --git a/app/queries.R b/app/queries.R index e42bca0..dcf6636 100644 --- a/app/queries.R +++ b/app/queries.R @@ -100,6 +100,14 @@ get_latest_normalization_year <- function() { return(result) } +get_storm_data_coverage <- function() { + query <- get_tbl("storm_data_coverage") + + result <- query %>% collect() + + return(result) +} + get_yearly_usa_pop_hu <- function(yr) { query <- get_tbl("usa_pop_hu", "metrics") %>% filter(year == yr)