Fix mutate_profile() with mixed site and horizon-level expressions

ncss-tech · Aug 31, 2023 · 0c449aa · 0c449aa
1 parent 3b70a8e
commit 0c449aa
Show file tree

Hide file tree

Showing 2 changed files with 19 additions and 10 deletions.
diff --git a/R/mutate_profile.R b/R/mutate_profile.R
@@ -28,17 +28,24 @@ setMethod("mutate_profile", signature(object = "SoilProfileCollection"), functio
 
     # iterate over expressions left to right
     for (i in 1:length(.dots)) {
+
+      # default is to create site-level properties unless result matches number of horizons
       if (is.null(horizon_level) || !is.logical(horizon_level)) {
-        horizon_level <- FALSE
-
         # decide whether we are adding/modifying a site or horizon level variable so
         #  that degenerate cases do not create identical columns in site and horizon table or get put in unexpected slot
-        #  
         #  2021-10-29: updated to use first and last profile, and allowing user override via argument
         res_eval1 <- .data_dots(compositeSPC(object[1,]), eval(.dots[[i]]))[[1]]
         res_eval2 <- .data_dots(compositeSPC(object[nrow(object),]), eval(.dots[[i]]))[[1]]
-        if (length(res_eval1) == nrow(object[1,]) && length(res_eval2) == nrow(object[nrow(object),])) {
-           horizon_level <- TRUE
+        # allow user to override the determination
+        if (!missing(horizon_level)) {
+          # check length of first/last profile result against number of horizons
+          if (length(res_eval1) == nrow(object[1,]) && 
+              length(res_eval2) == nrow(object[nrow(object),])) {
+            horizon_level <- TRUE
+          } else {
+            # otherwise, assume site-level
+            horizon_level <- FALSE 
+          }
         }
       }
 

diff --git a/tests/testthat/test-mutate_profile.R b/tests/testthat/test-mutate_profile.R
@@ -5,22 +5,24 @@ test_that("transform & mutate_profile", {
 
   # transform
   res <- transform(sp3, thickness = bottom - top)
-  expect_equal(mean(res$thickness), 18.5652174)
+  expect_equal(sum(res$thickness), 854)
 
   # transform (existing column)
   res <- transform(sp3, thickness = (bottom - top) / 100)
-  expect_equal(mean(res$thickness), 0.18565217)
+  expect_equal(sum(res$thickness), 8.54)
 
   # mutate_profile
   res <- mutate_profile(res, relthickness = (bottom - top) / (sum(thickness) * 100))
-  expect_equal(mean(res$relthickness), 0.2173913)
+  expect_equal(sum(res$relthickness), 10)
 
   # mutate_profile (two existing columns)
   res <- mutate_profile(res, thickness = bottom - top,
                              relthickness = (thickness) / sum(thickness),
-                             sumrelthickness = sum(relthickness))
+                             sumrelthickness1 = sum(relthickness))
+  res <- mutate_profile(res, sumrelthickness2 = sum(relthickness))
   expect_equal(mean(res$relthickness), 0.2173913)
-  expect_true(all(res$sumrelthickness == 1))
+  expect_equal(length(res$sumrelthickness1), 10)
+  expect_equal(length(res$sumrelthickness2), 10)
 
   # mutate existing column name (using same column as input)
   res <- mutate_profile(res, thickness = thickness / 10,