Add function to Optionally get site.info if not present

base/db/NAMESPACE

@@ -30,6 +30,7 @@ export(derive.traits)
 export(dplyr.count)
 export(fancy_scientific)
 export(get.id)
+export(get.new.site)
 export(get.trait.data)
 export(get.trait.data.pft)
 export(get_postgres_envvars)

base/db/R/get.new.site.R

@@ -0,0 +1,153 @@
+#-------------------------------------------------------------------------------
+# Copyright (c) 2012 University of Illinois, NCSA.
+# All rights reserved. This program and the accompanying materials
+# are made available under the terms of the
+# University of Illinois/NCSA Open Source License
+# which accompanies this distribution, and is available at
+# http://opensource.ncsa.illinois.edu/license.html
+#-------------------------------------------------------------------------------
+
+##' Get new site info using provided site information
+##'
+##' @title Get New Site Info
+##' @param site a dataframe with site information including id, lat, lon, and time_zone.
+##' @param con Database connection object.
+##' @param latlon Optional global latlon object which will store updated lat/lon.
+##' @return a dataframe with new site information on lat, lon and time_zone
+##' @export
+##' @author Abhinav Pandey
+##'
+##' @examples
+##' get.new.site(site=data.frame(id=1,lat=40.1,lon=-88.2,time_zone="UTC"),con=NULL,latlon=NULL)
+
+get.new.site <- function(site, con = NULL, latlon = NULL) {
+    if (is.null(con)) {
+        PEcAn.logger::logger.debug("DB connection is closed. Trying to generate a new site ID or use pre-existing one.")
+        # No DB connection present. Generate a new ID using one of below steps:
+
+        if (is.null(site$id) | is.na(site$id)) {
+            if ((!is.null(site$lat) && !is.null(site$lon)) |
+                (!is.na(site$lat) && !is.na(site$lon))
+            ) {
+                site.id <- generate_siteID(site$lat, site$lon)
+                new.site <- data.frame(
+                    id = as.numeric(site.id),
+                    lat = site$lat,
+                    lon = site$lon
+                )
+                str_ns <- paste0(new.site$lat, "-", new.site$lon)
+            } # lat/lon present but ID is absent
+            # Use Pre-existing normalised lat/lon
+            else {
+                PEcAn.logger::logger.warn("Site dataframe does not have an id column")
+                site.id <- generate_new_siteID()
+                PEcAn.logger::logger.info(paste0("Generated siteID:", site.id))
+                # Optionally, create a new site data frame with the random ID
+                new.site <- data.frame(
+                    id = site.id,
+                    lat = NULL,
+                    lon = NULL
+                )
+                str_ns <- paste0(new.site$id %/% 1e+09, "-", new.site$id %% 1e+09)
+                # We used a different str_ns as identifier here due to absence of lat/lon
+            }
+            # ID as well as lat/lon absent.
+            # Return a WARN as we will be unable to identify such an instance due to lack of information.
+            # We'll try to Generate a new ID similar to previous ones.
+        } else {
+            if ((!is.null(site$lat) && !is.null(site$lon)) |
+                (!is.na(site$lat) && !is.na(site$lon))
+            ) {
+                new.site <- data.frame(
+                    id = as.numeric(site$id),
+                    lat = site$lat,
+                    lon = site$lon
+                )
+                str_ns <- paste0(new.site$lat, "-", new.site$lon)
+            } # siteId as well as lat/lon present
+            else {
+                new.site <- data.frame(
+                    id = site$id,
+                    lat = NULL,
+                    lon = NULL
+                )
+                str_ns <- paste0(new.site$id %/% 1e+09, "-", new.site$id %% 1e+09)
+            } # siteId present but lat/lon absent
+        }
+    } else {
+        # Check if site dataframe has an id column
+        if (is.null(site$id) | is.na(site$id)) {
+            PEcAn.logger::logger.warn("Site dataframe does not have an id column. Generating a unique ID")
+            site.id <- generate_new_siteID()
+            PEcAn.logger::logger.info(paste0("Generated siteID:", site.id))
+            if ((!is.null(site$lat) && !is.null(site$lon)) |
+                (!is.na(site$lat) && !is.na(site$lon))
+            ) {
+                new.site <- data.frame(
+                    id = as.numeric(site.id),
+                    lat = site$lat,
+                    lon = site$lon
+                )
+                str_ns <- paste0(site$lat, "-", site$lon)
+            } else {
+                new.site <- data.frame(
+                    id = site.id,
+                    lat = NULL,
+                    lon = NULL
+                )
+                str_ns <- paste0(new.site$id %/% 1e+09, "-", new.site$id %% 1e+09)
+                # We used a different str_ns as identifier here due to absence of lat/lon
+            }
+        } else {
+            # setup site database number, lat, lon and name and copy for format.vars if new input
+            if ((!is.null(site$lat) && !is.null(site$lon)) |
+                (!is.na(site$lat) && !is.na(site$lon))
+            ) {
+                new.site <- data.frame(
+                    id = as.numeric(site$id),
+                    lat = site$lat,
+                    lon = site$lon
+                )
+                str_ns <- paste0(site$lat, "-", site$lon)
+            } else {
+                latlon <- query.site(site$id, con = con)[c("lat", "lon")]
+                new.site <- data.frame(
+                    id = as.numeric(site$id),
+                    lat = latlon$lat,
+                    lon = latlon$lon
+                )
+                str_ns <- paste0(new.site$lat, "-", new.site$lon)
+            }
+        }
+    }
+
+    site.info <- list(new.site = new.site, str_ns = str_ns)
+
+    return(site.info)
+}
+
+# Function to generate a normalized site ID using lat / lon
+# Example usage
+# siteID <- generate_siteID(-34.9284989, 138.6007456)
+generate_siteID <- function(lat, lon) {
+    # Normalize latitude and longitude
+    norm_lat <- lat + 90 # Shift range to [0, 180]
+    norm_lon <- lon + 180 # Shift range to [0, 360]
+
+    # Scale normalized values (Assuming 4 digits each for lat and lon)
+    scaled_lat <- as.integer((norm_lat / 180) * 9999) # Scaled latitude
+    scaled_lon <- as.integer((norm_lon / 360) * 9999) # Scaled longitude
+
+    # Create a unique ID by concatenating scaled values
+    siteID <- as.integer(paste0(scaled_lat, scaled_lon))
+
+    # Return the siteID
+    return(siteID)
+}
+
+# Function to generate a new siteID (db-less runs ONLY)
+generate_new_siteID <- function() {
+    # Generate a random number. Assuming higher order integers to increase randomness in IDs
+    random_id <- sample(10000:99999999, 1)
+    return(as.numeric(random_id))
+}

base/workflow/R/do_conversions.R

@@ -9,6 +9,7 @@
 ##' @author Ryan Kelly, Rob Kooper, Betsy Cowdery, Istem Fer
 
 do_conversions <- function(settings, overwrite.met = FALSE, overwrite.fia = FALSE, overwrite.ic = FALSE) {
+
   if (PEcAn.settings::is.MultiSettings(settings)) {
     return(PEcAn.settings::papply(settings, do_conversions))
   }
@@ -52,7 +53,7 @@ do_conversions <- function(settings, overwrite.met = FALSE, overwrite.fia = FALS
     # IC conversion : for now for ED only, hence the css/pss/site check
     # <useic>TRUE</useic>
     if (ic.flag) {
-      settings <- PEcAn.data.land::ic_process(settings, input, dir = dbfiles, overwrite  = overwrite.ic)
+      settings <- PEcAn.data.land::ic_process(settings, input, dir = dbfiles, overwrite  = overwrite.ic, site = settings$run$site)
       needsave <- TRUE
     }
 

modules/data.atmosphere/R/met.process.R

@@ -161,11 +161,12 @@ met.process <- function(site, input_met, start_date, end_date, model,
   }
 
   # setup site database number, lat, lon and name and copy for format.vars if new input
-  latlon <- PEcAn.DB::query.site(site$id, con = con)[c("lat", "lon")] 
-  new.site <- data.frame(id = as.numeric(site$id), 
-                         lat = latlon$lat, 
-                         lon = latlon$lon)
-  str_ns <- paste0(new.site$id %/% 1e+09, "-", new.site$id %% 1e+09)
+  latlon <- NULL
+  site.info <- PEcAn.DB::get.new.site(site, con=con, latlon = latlon)
+
+  # extract new.site and str_ns from site.info
+  new.site <- site.info$new.site
+  str_ns <- site.info$str_ns
 
   if (is.null(format.vars$lat)) {
     format.vars$lat <- new.site$lat

modules/data.atmosphere/tests/testthat/test.met.process.R

@@ -1,4 +1,4 @@
-test_that("`met.process` able to call .download.raw.met.module based on met process stage params", {
+test_that("'met.proces' able to call .download.raw.met.module based on met process stage params", {
   input_met <- list(source = 'CRUNCEP', id = '1')
 
   mockery::stub(met.process, 'PEcAn.DB::db.open', 1)
@@ -8,7 +8,7 @@ test_that("`met.process` able to call .download.raw.met.module based on met proc
   mockery::stub(met.process, 'PEcAn.DB::query.format.vars', list())
   mockery::stub(met.process, 'PEcAn.DB::dbfile.check', list(id = 1))
   mockery::stub(met.process, 'assign', 1)
-  mockery::stub(met.process, 'PEcAn.DB::query.site', list(lat = 0, lon = 0))
+  mockery::stub(met.process, 'PEcAn.DB::get.new.site', list(new.site = data.frame(id = 1, lat = 0, lon = 0), str_ns = "0-0"))
   mockery::stub(met.process, 'met.process.stage', list(download.raw = TRUE, met2cf = FALSE, standardize = FALSE, met2model = FALSE))
 
   mocked_res <- mockery::mock(1)

modules/data.land/R/ic_process.R

@@ -6,14 +6,14 @@
 ##' @param input Taken from settings$run$inputs. This should include id, path, and source
 ##' @param dir settings$database$dbfiles
 ##' @param overwrite Default = FALSE. whether to force ic_process to proceed
+##' @param site Current site information
 ##'
 ##' @author Istem Fer, Hamze Dokoohaki
-ic_process <- function(settings, input, dir, overwrite = FALSE){
+ic_process <- function(settings, input, dir, overwrite = FALSE, site = settings$run$site){
 
 
   #--------------------------------------------------------------------------------------------------#
   # Extract info from settings and setup
-  site       <- settings$run$site
   model <- list()
     model$type <- settings$model$type
     model$id <- settings$model$id
@@ -49,15 +49,25 @@ ic_process <- function(settings, input, dir, overwrite = FALSE){
   con <- PEcAn.DB::db.open(dbparms$bety)
   on.exit(PEcAn.DB::db.close(con), add = TRUE)
 
-  #grab site lat and lon info
-  latlon <- PEcAn.DB::query.site(site$id, con = con)[c("lat", "lon")] 
   # setup site database number, lat, lon and name and copy for format.vars if new input
-  new.site <- data.frame(id = as.numeric(site$id),
-                         lat = latlon$lat,
-                         lon = latlon$lon)
+  latlon <- NULL
+  if(is.null(site$lat) | is.null(site$lon)) {
+    site.info <- PEcAn.DB::get.new.site(site, con=con, latlon = latlon)
 
-  new.site$name <- settings$run$site$name
+    # extract new.site and str_ns from site.info
+    new.site <- site.info$new.site
+    str_ns <- site.info$str_ns
+  } else {
+    latlon <- list(lon = site$lat, lon=site$lon)
+    new.site <- data.frame(
+      id = as.numeric(site$id),
+      lat = site$lat,
+      lon = site$lon
+    )
+    str_ns <- paste0(site$lat, "-", site$lon)
+  }
 
+  new.site$name <- settings$run$site$name
 
   str_ns <- paste0(new.site$id %/% 1e+09, "-", new.site$id %% 1e+09)
 

modules/data.land/R/soil_process.R

@@ -28,13 +28,14 @@ soil_process <- function(settings, input, dbfiles, overwrite = FALSE,run.local=T
   # set up bety connection
   con <- PEcAn.DB::db.open(dbparms$bety)
   on.exit(PEcAn.DB::db.close(con), add = TRUE)
-  # get site info
-  latlon <- PEcAn.DB::query.site(site$id, con = con)[c("lat", "lon")]
-  new.site <- data.frame(id = as.numeric(site$id),
-                         lat = latlon$lat,
-                         lon = latlon$lon)
-
-  str_ns <- paste0(new.site$id %/% 1e+09, "-", new.site$id %% 1e+09)
+
+  # setup site database number, lat, lon and name and copy for format.vars if new input
+  latlon <- NULL
+  site.info <- PEcAn.DB::get.new.site(site, con=con, latlon = latlon)
+
+  # extract new.site and str_ns from site.info
+  new.site <- site.info$new.site
+  str_ns <- site.info$str_ns
 
   outfolder <- file.path(dbfiles, paste0(input$source, "_site_", str_ns))