Merge pull request #313 from ncss-tech/fix312

Fix to enforce character data type for ID in diagnostics and restriction slots of SPC
ncss-tech · Mar 22, 2024 · 3b8a22f · 3b8a22f
2 parents 84fc1f3 + 8fc9327
commit 3b8a22f
Showing 1 changed file with 32 additions and 25 deletions.
diff --git a/R/SoilProfileCollection-setters.R b/R/SoilProfileCollection-setters.R
@@ -683,26 +683,29 @@ setReplaceMethod("diagnostic_hz",
   # test for the special case where internally-used functions
   # are copying over data from one object to another, and diagnostic_hz(obj) is a 0-row data.frame
   # short-circut, and return original object
-  if(nrow(d) == 0 & nrow(value) == 0)
+  if (nrow(d) == 0 && nrow(value) == 0)
   	return(object)
 
   # test to make sure that our common ID is present in the new data
-  if(! idn %in% nm)
-  	stop(paste("diagnostic horizon data are missing pedon ID column: ", idn), call.=FALSE)
-
-  # test to make sure that at least one of the IDS in candidate data are present within SPC
-  if(all( ! unique(value[[idn]]) %in% pIDs) )
-  	warning('candidate diagnostic horizon data have NO matching IDs in target SoilProfileCollection object!', call. = FALSE)
+  if (!idn %in% nm)
+    stop(paste("diagnostic horizon data are missing pedon ID column: ", idn), call. = FALSE)
 
+  uidm <- unique(value[[idn]]) %in% pIDs
   # warn user if some of the IDs in the candidate data are missing
-  if(any( ! unique(value[[idn]]) %in% pIDs) ) {
-    warning('some records in candidate diagnostic horizon data have no matching IDs in target SoilProfileCollection object')
+  if (any(!uidm)) {
+    # test to make sure that at least one of the IDS in candidate data are present within SPC
+    if (all(!uidm)) {
+      warning('candidate diagnostic horizon data have NO matching IDs in target SoilProfileCollection object!', call. = FALSE)
+    } else warning('some records in candidate diagnostic horizon data have no matching IDs in target SoilProfileCollection object', call. = FALSE)
   }
 
   # if data are already present, warn the user
-  if(nrow(d) > 0)
-  	warning('overwriting existing diagnostic horizon data!', call.=FALSE)
-
+  if (nrow(d) > 0)
+  	warning('overwriting existing diagnostic horizon data!', call. = FALSE)
+
+  # convert id column to character to match @site
+  value[[idn]] <- as.character(value[[idn]])
+
   # copy data over
   object@diagnostic <- .as.data.frame.aqp(value, metadata(object)$aqp_df_class)
 
@@ -760,31 +763,35 @@ setReplaceMethod("restrictions", signature(object = "SoilProfileCollection"),
 
                    # testing the class of the new data
                    if (!inherits(value, "data.frame"))
-                     stop("restriction data must be a data.frame", call.=FALSE)
+                     stop("restriction data must be a data.frame", call. = FALSE)
 
                    # test for the special case where internally-used functions
                    # are copying over data from one object to another, and diagnostic_hz(obj) is a 0-row data.frame
                    # short-circuit, and return original object
-                   if(nrow(d) == 0 & nrow(value) == 0)
+                   if (nrow(d) == 0 && nrow(value) == 0)
                      return(object)
 
                    # test to make sure that our common ID is present in the new data
-                   if(! idn %in% nm)
-                     stop(paste("restriction data are missing pedon ID column: ", idn), call.=FALSE)
-
-                   # test to make sure that at least one of the IDs in candidate data are present within SPC
-                   if(all(!unique(value[[idn]]) %in% pIDs) )
-                     warning('restriction data have no matching IDs in target SoilProfileCollection object!', call. = FALSE)
-
+                   if (!idn %in% nm)
+                     stop(paste("restriction data are missing pedon ID column: ", idn), call. = FALSE)
+
+                   uidm <- unique(value[[idn]]) %in% pIDs
                    # warn user if some of the IDs in the candidate data are missing
-                   if(any( ! unique(value[[idn]]) %in% pIDs) ) {
-                     warning('some records in restriction data have no matching IDs in target SoilProfileCollection object')
+                   if (any(!uidm)) {
+                     # test to make sure that at least one of the IDs in candidate data are present within SPC
+                     if (all(!uidm)) {
+                       warning('restriction data have no matching IDs in target SoilProfileCollection object!', call. = FALSE)
+                     } else warning('some records in restriction data have no matching IDs in target SoilProfileCollection object', call. = FALSE)
                    }
 
                    # if data are already present, warn the user
-                   if(nrow(d) > 0)
-                     warning('overwriting existing restriction data!', call.=FALSE)
 
+                   if (nrow(d) > 0)
+                     warning('overwriting existing restriction data!', call.=FALSE)
+
+                   # convert id column to character to match @site
+                   value[[idn]] <- as.character(value[[idn]])
+
                    # copy data over
                    object@restrictions <- .as.data.frame.aqp(value, metadata(object)$aqp_df_class)