fix merge conflicts

dashboard.Rmd

@@ -1014,7 +1014,69 @@ Storm Fatalities {data-navmenu="Storm Details"}
 Normalization Calculator {data-navmenu="Compute"}
 ===
 
-Column {data-width=700 .tabset}
+```{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}
@@ -1023,35 +1085,30 @@ Column {data-width=700 .tabset}
 
 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
-    )
+    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%")
 ```
 
-### Impact Data {.no-padding}
-```{r}
-# Calculator - Impact Data
-```
-
 Column {data-width=300}
 ---
 
@@ -1059,18 +1116,7 @@ Column {data-width=300}
 ```{r}
 # Calculator - Input
 # TODO: add data population and compute
-#observeEvent(input$stormYear, {
-#  stormsByChosenYear <- loss_storms[loss_storms$storm_year == input$stormYear, ]
-#
-#  stormsByYear <- loss_storms %>% filter(storm_year == input$stormYear)
-#
-#  updateSelectInput(
-#    session,
-#    "stormName",
-#    choices = stormsByYear$storm_name,
-#    selected = NULL
-#  )
-#})
+
 observeEvent(input$impact_storm_year, {
   stormsByChosenYear <- all_lf_type_storms[all_lf_type_storms$storm_year == input$impact_storm_year, ]
 
@@ -1084,41 +1130,152 @@ observeEvent(input$impact_storm_year, {
   )
 })
 
+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"),
-  selectInput(
-    "impact_storm_basin",
-    label = NULL,
-    choices = "AL",
-    width = "100%"
-  ),
-  selectInput(
-    "impact_storm_year",
-    label = NULL,
-    choices = all_lf_type_storms$storm_year,
-    width = "100%"
-  ),
-  selectInput(
-    "impact_storm_name",
-    label = NULL,
-    choices = NULL,
-    width = "100%"
-  ),
 
   fluidRow(
     column(
       6,
       selectInput(
-        "impact_storm_lf_type",
+        "impact_storm_basin",
         label = NULL,
-        choices = "LF",
+        choices = "AL",
         width = "100%"
-      )
+      ),
     ),
     column(
       6,
       selectInput(
-        "impact_storm_lf_id",
+        "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%"
@@ -1189,6 +1346,7 @@ div(
     "impact_rmw_multiplier",
     label = "RMW Multiplier",
     choices = c("1x", "2x", "3x"),
+    selected = "2x",
     status = "outline-primary rounded-0",
     justified = T
   ),

queries.R

@@ -57,7 +57,8 @@ view.all_loss_storms_tracks <- tbl(con, "all_loss_storms_tracks")
 view.all_conus_landfalls <- tbl(con, "all_conus_landfalls")
 view.hurdat_ids <- tbl(con, "hurdat_ids")
 view.all_lf_type_landfalls <- tbl(con, "all_lf_type_landfalls")
-
+view.lf_id_location <- tbl(con, "lf_id_location")
+view.lf_landfall_gis <- tbl(con, "lf_landfall_gis")
 #qry <- econ.storm_base_loss %>%
 #  left_join(view.hurdat_track, by = c("storm_basin", "storm_year", "storm_name"))
 
@@ -449,7 +450,31 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
 
 # returns all lf type landfalls
 get_all_lf_type_landfalls <- function() {
-  query <- view.all_lf_type_landfalls
+  query <- view.lf_id_location
+
+  result <- query %>% collect()
+
+  return(result)
+}
+
+# returns all storms and factors needed to normalize a lf type landfall
+get_all_lf_type_factors <- function() {
+  query <- view.lf_landfall_gis
+
+  result <- query %>% collect()
+
+  return(result)
+}
+
+# returns one storm and factors needed to normalize a lf type landfall
+get_lf_type_factors <- function(storm) {
+  query <- view.lf_landfall_gis %>%
+    filter(
+      storm_basin == storm$storm_basin,
+      storm_year == storm$storm_year,
+      storm_name == storm$storm_name,
+      full_lf_id == storm$full_lf_id
+    )
 
   result <- query %>% collect()