Merge pull request #400 from Uni-of-Exeter/399-save-and-load-downscaling-results-to-disk

399 save and load downscaling results to disk

Author: timothee-bacri

ShinyForestry/backend/plumber_apis.R

@@ -1157,14 +1157,104 @@ function(res, MAX_LIMIT_LOG_LEVEL = "debug") {
 
     # Downscaling
     if (isTRUE(RUN_DOWNSCALING)) {
-      msg <- "Downscaling ..."
-      notif(msg)
-      downscaling_result <- value(future(expr = { downscaling(max_limit_log_level = MAX_LIMIT_LOG_LEVEL, log_ntfy = FALSE) },
-                                         globals = list(downscaling = downscaling,
-                                                        MAX_LIMIT_LOG_LEVEL = MAX_LIMIT_LOG_LEVEL),
-                                         seed = TRUE))
-      notif(paste(msg, "done"))
+      
+      # If downscaling results already exist, load them. Otherwise, downscale and save to the downscaling_result_folder folder
+      downscaling_result_folder <- normalizePath(file.path(ElicitorAppFolder, "downscaling_results"))
+      dir.create(downscaling_result_folder, showWarnings = FALSE)
+      downscaling_result_file <- normalizePath(file.path(downscaling_result_folder, "downscaling_result.RData"))
+      downscaling_mesoclimate_list_file <- normalizePath(file.path(downscaling_result_folder, "downscaling_mesoclimate_list.RData"))
+      
+      if (file.exists(downscaling_result_file) &&
+          file.exists(downscaling_mesoclimate_list_file)) {
+        
+        msg <- "Loading downscaling results ..."
+        notif(msg, log_level = "debug")
+        
+        downscaling_result <-  value(future(get(load(downscaling_result_file))))
+        temp <- value(future(get(load(downscaling_mesoclimate_list_file))))
+        downscaling_mesoclimate_list <- lapply(temp, function(x) {
+          
+          lapply(x, function(y) {
+            if ("PackedSpatRaster" %in% class(y)) {
+              return(terra::unwrap(y))
+            } else {
+              return(y)
+            }
+          })
+          
+        })
+        rm(temp)
+        
+        notif(paste(msg, "done"), log_level = "debug")
+        
+      } else {
+        
+        msg <- "Downscaling ..."
+        notif(msg)
+        downscaling_results <- value(future(expr = { downscaling(max_limit_log_level = MAX_LIMIT_LOG_LEVEL,
+                                                                log_ntfy = FALSE) },
+                                           globals = c("downscaling",
+                                                       "MAX_LIMIT_LOG_LEVEL",
+                                                       "get_backend_folder_save_data",
+                                                       "get_foldersource",
+                                                       "notif"),
+                                           seed = TRUE))
+        downscaling_result <- downscaling_results$results
+        # The result requires terra stuff which cannot be passed by the future unless terra::wrap
+        # So now, it needs to terra::unwrap
+        downscaling_mesoclimate_list <- lapply(downscaling_results$mesoclimate_list_wrapped, function(x) {
+          
+          lapply(x, function(y) {
+            if ("PackedSpatRaster" %in% class(y)) {
+              return(terra::unwrap(y))
+            } else {
+              return(y)
+            }
+          })
+          
+        })
+        notif(paste(msg, "done"))
+        
+        msg <- "Saving downscaling normal results to disk ..."
+        notif(msg)
+        save(downscaling_result, file = downscaling_result_file)
+        notif(paste(msg, "done"))
+        
+        msg <- "Saving downscaling mesoclimates to disk ..."
+        notif(msg, log_level = "debug")
+        mesoclimate_list_wrapped <- downscaling_results$mesoclimate_list_wrapped
+        save(mesoclimate_list_wrapped, file = downscaling_mesoclimate_list_file)
+        rm(mesoclimate_list_wrapped)
+        notif(paste(msg, "done"), log_level = "debug")
+        
+        rm(downscaling_results)
+        # Alternative by David Baker TODO: needs testing
+        # a <- lapply(downscaled_results_original_grid_list, function(x) {
+        #   
+        #   lapply(x, function(y) {
+        #     if ("PackedSpatRaster" %in% class(y)) {
+        #       return(terra::unwrap(y))
+        #     } else {
+        #       return(y)
+        #     }
+        #   })
+        #   
+        # })
+        # library(addTreesBiodiv)
+        # 
+        # # Compute bioclimate variables per time period from mesoclimate output
+        # bioclimate_meso <- mesoclimate_to_bioclimate(mesoclimate_list)
+        # 
+        # outpath <- file.path("mesoclim_rast")
+        # dir.create(outpath)
+        # for (i in 1:length(bioclimate_meso)) {
+        #   r_i <- bioclimate_meso[[i]]
+        #   v_i <- sub("^([^_]+)_.*$", "\\1", names(r_i)[1])
+        #   writeRaster(r_i, paste0(outpath, "/", v_i, ".tif"))
+        # }
+      }
     }
+    
     notif(paste("Waiting for", normalizePath(file.path(ElicitorAppFolder, "decision_units.json"))))
     if (!file.exists(normalizePath(file.path(ElicitorAppFolder, "decision_units.json")))) {
       res$status <- 403
@@ -1387,7 +1477,7 @@ function(res, MAX_LIMIT_LOG_LEVEL = "debug") {
 
       # Outcomes
       notif(paste("Waiting for", normalizePath(file.path(ElicitorAppFolder, "outcomes.json"))))
-      while (!file.exists(normalizePath(file.path(ElicitorAppFolder, "outcomes.json")))) {
+      if (!file.exists(normalizePath(file.path(ElicitorAppFolder, "outcomes.json")))) {
         res$status <- 403
         return("Please upload outcomes.json")
       }

ShinyForestry/backend/trigger_plumber_for_dev.R

@@ -13,4 +13,5 @@ if (file.exists(file.path(getwd(), "ShinyForestry", "backend", "plumber_apis.R")
 plumb(path) |>
   pr_set_debug(debug = TRUE) |>
   pr_run(port = port,
-         host = "0.0.0.0")
+         host = "0.0.0.0",
+         docs = isFALSE(interactive()))