fetchNASIS: cleanup multiple site observation and multiple labsampnum…

… QC output
ncss-tech · Sep 25, 2024 · 69ffaee · 69ffaee
1 parent 1ca1612
commit 69ffaee
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 10 deletions.
diff --git a/R/fetchNASIS_pedons.R b/R/fetchNASIS_pedons.R
@@ -269,10 +269,18 @@
     if (length(get('artifact.volume.gt100.phiid', envir = get_soilDB_env())) > 0)
       message("-> QC: pedon horizons with artifact volume >=100%: \n\tUse `get('artifact.volume.gt100.phiid', envir=get_soilDB_env())` for pedon horizon record IDs (phiid)")
 
+  if (exists('multisiteobs.surface', envir = get_soilDB_env()))
+    if (length(get('multisiteobs.surface', envir = get_soilDB_env())) > 0)
+      message("-> QC: surface fragment records from multiple site observations:\n\tUse `get('multisiteobs.surface', envir=get_soilDB_env())` for site (siteiid) and site observation (siteobsiid)")
+
   if (exists('surface.fragment.cover.gt100.siteobsiid', envir = get_soilDB_env()))
     if (length(get('surface.fragment.cover.gt100.siteobsiid', envir = get_soilDB_env())) > 0)
       message("-> QC: pedons with surface fragment cover >=100%: \n\tUse `get('surface.fragment.cover.gt100.siteobsiid', envir=get_soilDB_env())` for site observation record IDs (siteobsiid)")
 
+  if (exists('multiple.labsampnum.per.phiid', envir = get_soilDB_env()))
+    if (length(get('multiple.labsampnum.per.phiid', envir = get_soilDB_env())) > 0)
+      message("-> QC: horizons with multiple lab samples: \n\tUse `get('multiple.labsampnum.per.phiid', envir=get_soilDB_env())` for pedon horizon record IDs (phiid)")
+
   # set NASIS component specific horizon identifier
   if (!fill & length(filled.ids) == 0) {
     res <- try(hzidname(hz_data) <- 'phiid')

diff --git a/R/get_hz_data_from_NASIS_db.R b/R/get_hz_data_from_NASIS_db.R
@@ -72,17 +72,13 @@ get_hz_data_from_NASIS_db <- function(SS = TRUE,
   # re-implement texture_class column, with lieutex in cases where texcl is missing
   d$texture_class <- ifelse(is.na(d$texcl) & ! is.na(d$lieutex), as.character(d$lieutex), as.character(d$texcl))
 
-  # test for duplicate horizons:
-  #  bugs in our queries
-  #   multiple lab samples / genetic horizon
+  # test for multiple lab samples per genetic horizon
   hz.tab <- table(d$phiid)
-  dupe.hz <- which(hz.tab > 1)
-  dupe.hz.phiid <- names(hz.tab[dupe.hz])
-  dupe.hz.pedon.ids <- d$pedon_id[d$phiid %in% dupe.hz.phiid]
+  mult.labsampnum.phiid <- names(hz.tab[which(hz.tab > 1)])
 
-  if (length(dupe.hz) > 0) {
-    message(paste0('NOTICE: multiple `labsampnum` values / horizons; see pedon IDs:\n',
-                   paste(unique(dupe.hz.pedon.ids), collapse = ',')))
+  if (length(mult.labsampnum.phiid) > 0) {
+    message(paste0('NOTE: some phiid have multiple lab sample IDs (labsampnum)'))
+    assign("multiple.labsampnum.per.phiid", value = mult.labsampnum.phiid, envir = get_soilDB_env())
   }
 
   # done

diff --git a/R/get_site_data_from_NASIS_db.R b/R/get_site_data_from_NASIS_db.R
@@ -130,7 +130,6 @@ ORDER BY pedon_View_1.peiid ;"
 	multi.siteobs <- unique(sfr[, c("siteiid","siteobsiid")])
 	multisite <- table(multi.siteobs$siteiid) 
 	if (any(multisite > 1)) {
-	  message("-> QC: surface fragment records from multiple site observations.\n\tUse `get('multisiteobs.surface', envir=get_soilDB_env())` for site (siteiid) and site observation (siteobsiid)")
 	  assign("multisiteobs.surface", value = multi.siteobs[multi.siteobs$siteiid %in% names(multisite[multisite > 1]),], envir = get_soilDB_env())
 	}