add demo growth trend map

dashboard.Rmd

@@ -41,8 +41,9 @@ library(caret)
 library(scales)
 library(billboarder)
 library(mirai)
+library(promises)
 
-#mirai::daemons(3)
+daemons(3)
 
 linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/"
 macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/"
@@ -110,6 +111,8 @@ loading_states <- reactiveValues(
 onStop(function() {
   dbDisconnect(con)
   
+  daemons(0)
+  
   #if(!is.null(async_reqs$hurdat_track)) {
   #  tryCatch({
   #    async_reqs$hurdat_track <- NULL
@@ -332,7 +335,6 @@ HTML('
 ### Normalization Cost Index {data-height=800}
 ```{r}
 
-
 output$cost_index_chart <- renderDygraph({
   req(storm_selection$is_selected, input$storm_overview_cost_index_lf)
   
@@ -415,6 +417,87 @@ DTOutput("landfalls_table")
 ```
 
 ### Storm Track {data-height=500 .no-padding}
+```{r eval=FALSE, include=FALSE}
+track_data <- reactiveVal(NULL)
+mirai_job <- reactiveVal(NULL)
+
+observe({
+  req(storm_selection$is_selected)
+  
+  storm <- reactiveValuesToList(storm_selection)
+  
+  cat("starting qry for storm track")
+  
+  m <- async_db_query(get_hurdat_track, storm)
+  
+  mirai_job(m)
+  
+  track_data(NULL)
+})
+
+observe({
+  req(mirai_job())
+  
+  if(!unresolved(mirai_job())) {
+    result <- mirai_job()$data
+    
+    track_data(result)
+    mirai_job(NULL)
+  } else {
+    invalidateLater(100)
+  }
+})
+
+observe({
+  req(track_data())
+  
+  storm_track <- track_data()
+  
+  cat("updating map")
+    
+  leafletProxy("track_map", data = storm_track) %>% 
+  clearShapes() %>% 
+  clearMarkers() %>%
+  addPolylines(
+    data = storm_track,
+    lng = ~lon,
+    lat = ~lat,
+    weight = 4,
+    color = "blue"
+  ) %>% 
+  addCircleMarkers(
+    data = storm_track %>% filter(record_identifier == "L"),
+    lng = ~lon,
+    lat = ~lat,
+    radius = 5,
+    weight = 0,
+    color = "red",
+    fillColor = "red",
+    fillOpacity = 0.8
+  ) %>% 
+  addCircles(
+    data = storm_track %>% filter(record_identifier == "L"),
+    lng = ~lon,
+    lat = ~lat,
+    radius = ~rmw_meters,
+    weight = 2,
+    color = "red",
+    fillColor = "red",
+    fillOpacity = 0.3
+  ) 
+  
+  track_data(NULL)
+})
+
+output$track_map <- renderLeaflet({
+  leaflet() %>% 
+    addProviderTiles("CartoDB.Positron", option = providerTileOptions(minZoom = 2, maxZoom = 18)) %>% 
+    setView(lng = -80, lat = 32, zoom = 4)
+})
+
+leafletOutput("track_map", height="100%")
+```
+
 ```{r}
 observe({
   req(storm_selection$is_selected)
@@ -461,7 +544,6 @@ output$track_map <- renderLeaflet({
 
 leafletOutput("track_map", height="100%")
 ```
-
 Growth Trends {data-navmenu="Storm Details"}
 ================================
 
@@ -532,10 +614,14 @@ test_storm <- reactiveValues(
 katrina_counties <- reactive({
   req(storm_selection$is_selected)
   
-  counties <- get_normalized_metric_growth(test_storm, "LF1")
+  counties <- get_normalized_metric_growth(test_storm, "LF2")
   
   result <- counties %>% 
     filter(year == 2006) %>% 
+    mutate(
+      population_opacity = rescale(normalized_population, to = c(0.2, 0.8), from = range(normalized_population, na.rm = T)),
+      housing_opacity = rescale(normalized_housing, to = c(0.2, 0.8), from = range(normalized_housing, na.rm = T))
+    ) %>% 
     st_as_sf(wkt = "geom_wkt")
   
   return(result)
@@ -560,7 +646,17 @@ observe({
     clearShapes() %>% 
     addPolygons(
       fillColor = "red",
-      fillOpacity = 0.5,
+      color = "red",
+      fillOpacity = ~population_opacity,
+      weight = 2
+    )
+  
+  leafletProxy("housing_growth_map", data = katrina_counties()) %>% 
+    clearShapes() %>% 
+    addPolygons(
+      fillColor = "blue",
+      color = "blue",
+      fillOpacity = ~housing_opacity,
       weight = 2
     )
 })

queries.R

@@ -230,6 +230,8 @@ get_hurdat_landfalls <- function(storm) {
 
 # returns storm track from HURDAT
 get_hurdat_track <- function(storm) {
+  #Sys.sleep(5)
+  
   query <- hurdat.best_track %>% 
     filter(
       storm_basin == storm$storm_basin,
@@ -326,6 +328,31 @@ get_normalized_metric_growth <- function(storm, full_lf_id) {
   return(result)
 }
 
+async_db_query <- function(query_func, ...) {
+  args <- list(...)
+  
+  mirai_call <- mirai({
+    linuxdir <- "/home/dylan/Personal/Projects/Hurricane Normalization/"
+    macdir <- "~/Desktop/Personal/Projects/Hurricane Normalization/"
+    #baseDir <- macdir
+    baseDir <- linuxdir
+    
+    config <- config::get(file = paste0(baseDir, "R/dataScripts/restructured/app/config.yml"))
+    
+    source(file = paste0(baseDir, "R/dataScripts/restructured/app/queries.R"))
+    
+    if(length(args) == 0) {
+      query_func()
+    }else{
+      do.call(query_func, args)
+    }
+  },
+    environment()
+  )
+  
+  return(mirai_call)
+}
+
 # test functions
 
 #storm <- list(storm_basin = "AL", storm_name = "KATRINA", storm_year = 2005)