From 09a58d24a81cfad45521207682b0e71bf4d193c9 Mon Sep 17 00:00:00 2001 From: Abhinav Pandey Date: Sat, 21 Sep 2024 13:19:44 +0530 Subject: [PATCH] Refactor `met.process` and `dbfiles` (#3319) * Refactor met.process.R to correctly handle standerdized_result Signed-off-by: Abhinav Pandey * Remove ucommented sections and replace NULL declarations with c() Signed-off-by: Abhinav Pandey * Revert to default NULL instead of c() Signed-off-by: Abhinav Pandey * Add small modification to dbfiles.R Signed-off-by: Abhinav Pandey * Fix 'return' mistake in dbfiles.R Signed-off-by: Abhinav Pandey * Omit return Type Signed-off-by: Abhinav Pandey * Update return statement in dbfiles.R Signed-off-by: Abhinav Pandey * Update invisible statements to `return` after execution Signed-off-by: Abhinav Pandey * refactor return statements Signed-off-by: Abhinav Pandey * Update base/db/R/dbfiles.R Co-authored-by: Chris Black * Apply suggestions from code review Co-authored-by: Chris Black * Apply standardization changes Signed-off-by: Abhinav Pandey --------- Signed-off-by: Abhinav Pandey Co-authored-by: Chris Black --- base/db/R/dbfiles.R | 28 ++++++++++++------------- modules/data.atmosphere/R/met.process.R | 21 ++++++++++--------- 2 files changed, 25 insertions(+), 24 deletions(-) diff --git a/base/db/R/dbfiles.R b/base/db/R/dbfiles.R index 4214c06837..1cab9e069e 100644 --- a/base/db/R/dbfiles.R +++ b/base/db/R/dbfiles.R @@ -50,9 +50,8 @@ dbfile.input.insert <- function(in.path, in.prefix, siteid, startdate, enddate, # setup parent part of query if specified - if (is.na(parentid)) { - parent <- "" - } else { + parent <- "" + if (!is.na(parentid)) { parent <- paste0(" AND parent_id=", parentid) } @@ -242,13 +241,13 @@ dbfile.input.check <- function(siteid, startdate = NULL, enddate = NULL, mimetyp formatid <- get.id(table = "formats", colnames = c("mimetype_id", "name"), values = c(mimetypeid, formatname), con = con) if (is.null(formatid)) { - invisible(data.frame()) + return (invisible(data.frame())) } # setup parent part of query if specified - if (is.na(parentid)) { - parent <- "" - } else { + parent <- "" + + if (!is.na(parentid)) { parent <- paste0(" AND parent_id=", parentid) } @@ -450,7 +449,7 @@ dbfile.posterior.check <- function(pft, mimetype, formatname, con, hostname = PE # find appropriate pft pftid <- get.id(table = "pfts", values = "name", colnames = pft, con = con) if (is.null(pftid)) { - invisible(data.frame()) + return (invisible(data.frame())) } # find appropriate format @@ -461,7 +460,7 @@ dbfile.posterior.check <- function(pft, mimetype, formatname, con, hostname = PE formatid <- get.id(table = "formats", colnames = c("mimetype_id", "name"), values = c(mimetypeid, formatname), con = con) if (is.null(formatid)) { - invisible(data.frame()) + return (invisible(data.frame())) } # find appropriate posterior @@ -473,7 +472,7 @@ dbfile.posterior.check <- function(pft, mimetype, formatname, con, hostname = PE con = con )[["id"]] if (is.null(posteriorid)) { - invisible(data.frame()) + return (invisible(data.frame())) } invisible(dbfile.check(type = "Posterior", container.id = posteriorid, con = con, hostname = hostname)) @@ -639,12 +638,12 @@ dbfile.file <- function(type, id, con, hostname = PEcAn.remote::fqdn()) { if (nrow(files) > 1) { PEcAn.logger::logger.warn("multiple files found for", id, "returned; using the first one found") - invisible(file.path(files[1, "file_path"], files[1, "file_name"])) + return(invisible(file.path(files[1, "file_path"], files[1, "file_name"]))) } else if (nrow(files) == 1) { - invisible(file.path(files[1, "file_path"], files[1, "file_name"])) + return(invisible(file.path(files[1, "file_path"], files[1, "file_name"]))) } else { PEcAn.logger::logger.warn("no files found for ", id, "in database") - invisible(NA) + return(invisible(NA)) } } @@ -662,7 +661,8 @@ dbfile.id <- function(type, file, con, hostname = PEcAn.remote::fqdn()) { # find appropriate host hostid <- db.query(query = paste0("SELECT id FROM machines WHERE hostname='", hostname, "'"), con = con)[["id"]] if (is.null(hostid)) { - invisible(NA) + PEcAn.logger::logger.warn("hostid not found in database") + return (invisible(NA)) } # find file diff --git a/modules/data.atmosphere/R/met.process.R b/modules/data.atmosphere/R/met.process.R index 1380e32474..047defde30 100644 --- a/modules/data.atmosphere/R/met.process.R +++ b/modules/data.atmosphere/R/met.process.R @@ -255,13 +255,14 @@ met.process <- function(site, input_met, start_date, end_date, model, #--------------------------------------------------------------------------------------------------# # Change to Site Level - Standardized Met (i.e. ready for conversion to model specific format) if (stage$standardize) { - standardize_result <- list() - + id_stdized <- list() + ready.id <- list(input.id = NULL, dbfile.id = NULL) + for (i in seq_along(cf.id[[1]])) { if (register$scale == "regional") { #### Site extraction - standardize_result[[i]] <- .extract.nc.module(cf.id = list(input.id = cf.id$container_id[i], + id_stdized <- .extract.nc.module(cf.id = list(input.id = cf.id$container_id[i], dbfile.id = cf.id$id[i]), register = register, dir = dir, @@ -277,7 +278,7 @@ met.process <- function(site, input_met, start_date, end_date, model, # Expand to support ensemble names in the future } else if (register$scale == "site") { ##### Site Level Processing - standardize_result[[i]] <- .metgapfill.module(cf.id = list(input.id = cf.id$input.id[i], dbfile.id = cf.id$dbfile.id[i]), + id_stdized <- .metgapfill.module(cf.id = list(input.id = cf.id$input.id[i], dbfile.id = cf.id$dbfile.id[i]), register = register, dir = dir, met = met, @@ -288,15 +289,15 @@ met.process <- function(site, input_met, start_date, end_date, model, host = host, overwrite = overwrite$standardize, ensemble_name = i) + } else { + # No action taken. These ids will be dropped from ready.id + id_stdized <- NULL } + + ready.id$input.id <- c(ready.id$input.id, id_stdized$input.id) + ready.id$dbfile.id <- c(ready.id$dbfile.id, id_stdized$dbfile.id) } # End for loop - ready.id <- list(input.id = NULL, dbfile.id = NULL) - - for (i in seq_along(standardize_result)) { - ready.id$input.id <- c(ready.id$input.id, standardize_result[[i]]$input.id) - ready.id$dbfile.id <- c(ready.id$dbfile.id, standardize_result[[i]]$dbfile.id) - } } else { ready.id <- input_met$id