diff --git a/R/dbGetRaster.R b/R/dbGetRaster.R index 2175934..37be005 100644 --- 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 index ae53e08..df7d45f 100644 --- 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 index 86c60d9..5dfbac8 100644 --- 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 index d25d2cf..1533723 100644 --- 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)],