diff --git a/dashboard.Rmd b/dashboard.Rmd index 62585da..0f92a93 100644 --- a/dashboard.Rmd +++ b/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,42 +417,76 @@ DTOutput("landfalls_table") ``` ### Storm Track {data-height=500 .no-padding} -```{r} +```{r eval=FALSE, include=FALSE} +track_data <- reactiveVal(NULL) +mirai_job <- reactiveVal(NULL) + observe({ req(storm_selection$is_selected) - storm_track <- get_hurdat_track(storm_selection) + 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 - ) + 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({ @@ -462,6 +498,52 @@ output$track_map <- renderLeaflet({ leafletOutput("track_map", height="100%") ``` +```{r} +observe({ + req(storm_selection$is_selected) + + storm_track <- get_hurdat_track(storm_selection) + + 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 + ) +}) + +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%") +``` 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 ) }) diff --git a/queries.R b/queries.R index ee5e70c..4b65e59 100644 --- a/queries.R +++ b/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)