fix tiling bug and name error with caching

bcgov · Aug 13, 2024 · a5fcadf · a5fcadf
1 parent 4c508ca
commit a5fcadf
Show file tree

Hide file tree

Showing 4 changed files with 41 additions and 25 deletions.
diff --git a/R/dbGetRaster.R b/R/dbGetRaster.R
@@ -96,11 +96,11 @@ pgGetTerra <- function(conn, name, tile, rast = "rast", bands = 37:73,
 
     boundary_ls <- list()
     if (length(x_seq) < 2 | length(y_seq) < 2) {
-      boundary_ls[["11"]] <- boundary
+      boundary_ls[["1_1"]] <- boundary
     } else {
       for (i in 1:(length(x_seq) - 1)) {
         for (j in 1:(length(y_seq) - 1)) {
-          boundary_ls[[paste0(i, j)]] <- c(x_seq[i + 1], x_seq[i], y_seq[j + 1], y_seq[j])
+          boundary_ls[[paste0(i,"_", j)]] <- c(x_seq[i + 1], x_seq[i], y_seq[j + 1], y_seq[j])
         }
       }
     }

diff --git a/R/downscale.R b/R/downscale.R
@@ -155,12 +155,8 @@ downscale <- function(xyz, which_refmap = "auto",
   # xyz <- as.data.frame(xyz)
 
   message("Getting normals...")
-  if (which_refmap == "refmap_climatena") {
-    reference <- input_refmap(dbCon = dbCon, reference = "normal_na", bbox = thebb, cache = cache)
-  } else if (which_refmap == "refmap_prism") {
-    reference <- input_refmap(dbCon = dbCon, reference = "normal_bc", bbox = thebb, cache = cache)
-  } else if (which_refmap == "refmap_climr") {
-    reference <- input_refmap(dbCon = dbCon, reference = "normal_composite", bbox = thebb, cache = cache)
+  if(which_refmap %in% c("refmap_climatena","refmap_prism","refmap_climr")){
+    reference <- input_refmap(dbCon = dbCon, reference = which_refmap, bbox = thebb, cache = cache)
   } else {
     # message("Normals not specified, using highest resolution available for each point")
     rastFile <- system.file("extdata", "wna_outline.tif", package = "climr")
@@ -176,9 +172,9 @@ downscale <- function(xyz, which_refmap = "auto",
       xyz <- xyz[!is.na(pnts$PPT_01), ]
       thebb_bc <- get_bb(xyz)
       message("for BC...")
-      reference <- input_refmap(dbCon = dbCon, reference = "normal_bc", bbox = thebb_bc, cache = cache)
+      reference <- input_refmap(dbCon = dbCon, reference = "refmap_prism", bbox = thebb_bc, cache = cache)
     } else {
-      reference <- input_refmap(dbCon = dbCon, reference = "normal_na", bbox = thebb, cache = cache)
+      reference <- input_refmap(dbCon = dbCon, reference = "refmap_climatena", bbox = thebb, cache = cache)
     }
   }
 

diff --git a/R/refmap.R b/R/refmap.R
@@ -45,11 +45,20 @@ input_refmap <- function(dbCon, bbox, reference = "refmap_climatena", cache = TR
     .check_bb(bbox)
   }
 
-  ## check cached
-  ## check cached
   needDownload <- TRUE
+  if (!grepl("normal", reference)) {
+    rmap_nm <- switch(reference,
+                      refmap_prism = "normal_bc",
+                      refmap_climr = "normal_composite",
+                      refmap_climatena = "normal_na",
+                      auto = "normal_composite"
+    )
+  } else {
+    rmap_nm <- reference
+  }
+
 
-  cPath <- file.path(cache_path(), "reference", reference)
+  cPath <- file.path(cache_path(), "reference", rmap_nm)
 
   if (dir.exists(cPath)) {
     bnds <- try(fread(file.path(cPath, "meta_data.csv")), silent = TRUE)
@@ -83,17 +92,7 @@ input_refmap <- function(dbCon, bbox, reference = "refmap_climatena", cache = TR
   }
 
   if (needDownload) {
-    if (!grepl("normal", reference)) {
-      rmap_nm <- switch(reference,
-        refmap_prism = "normal_bc",
-        refmap_climr = "normal_composite",
-        refmap_climatena = "normal_na",
-        auto = "normal_composite"
-      )
-    } else {
-      rmap_nm <- reference
-    }
-
+
     message("Downloading new data...")
     res <- pgGetTerra(dbCon, rmap_nm, tile = TRUE, boundary = bbox, bands = 1:73)
     names(res) <- c(

diff --git a/data_processing/Test_Script.R b/data_processing/Test_Script.R
@@ -6,9 +6,30 @@ pts <- data.frame(lon = c(-124.11, -125.11), lat = rep(48.82, 2), elev = rep(25,
 
 bbox <- get_bb(pts[2,])
 dbcon <- data_connect()
-test <- normal_input(dbcon, bbox)
+test <- input_refmap(dbcon, bbox)
 plot(test[[8]])
 
+dem <- rast("../Common_Files/dem_noram_lowres.tif")
+test <- rast("../Common_Files/climatena_normals/Normal_1961_1990MP/Tmin07.asc")
+plot(test)
+
+my_grid <- as.data.frame(dem, cells = TRUE, xy = TRUE)
+colnames(my_grid) <- c("id", "lon", "lat", "elev") # rename column names to what climr expects
+climr <- downscale(
+  xyz = my_grid, which_refmap = "refmap_climatena", vars = "MAT"
+)
+
+X <- rast(dem) 
+X[climr[, id]] <- climr$MAT 
+plot(X)
+
+
+db <- data_connect()
+bbox <- get_bb(my_grid)
+bbox2 <- c(20,14.83,-80,-120)
+refmap <- input_refmap(db, bbox)
+
+
 projected <- climr_downscale(pts[2,], 
                                                           gcm_models = list_gcm()[c(4)],
                                                            ssp = list_ssp()[c(1,2)],