Updates to slab()

R/genSlabLabels.R

@@ -1,54 +1,70 @@
-## TODO: documentation / generalization
-# note source data must be normalized via dice() first, e.g. all share the same number of horizons
+# does not assume logical horizons (may overlap, resulting in different # of slices per profile)
+.genSlabLabels2 <- function(spc, diced, slab.structure = 1) {
+  if (length(slab.structure) == 1) {
+    i <- seq(from = 0, length.out = (max(spc) / slab.structure) + 1) * slab.structure
+  } else if (length(slab.structure) > 1) {
+    i <- slab.structure
+  } else {
+    stop("empty slab.structure", call. = FALSE)
+  }
+  j <- diff(i)
+  idx1 <- cumsum(do.call('c', lapply(seq_along(j), function(x) rep(1, j[x]))))
+  idx2 <- do.call('c', lapply(seq_along(j), function(x) rep(x, j[x])))
+  mt <- data.frame(idx1, slab_id = idx2, slab_label = paste0(i[idx2], "-", i[idx2 + 1]))
+  hzdepb <- horizonDepths(spc)[2]
+  colnames(mt) <- c(hzdepb, "slab_id", "slab_label")
+  res <- merge(diced, mt, by = hzdepb, all.x = TRUE, sort = FALSE)
+  res <- res[order(res[[idname(spc)]], res[[hzdepb]]),]
+  factor(res$slab_id, labels = na.omit(unique(res$slab_label)))
+}
 
+# note source data must be "normalized" via dice() first; assumes each profile has the same number of horizons
 # generate labels for slabs
-genSlabLabels <- function(slab.structure=1, max.d, n.profiles) {
-  
+genSlabLabels <- function(slab.structure = 1, max.d, n.profiles) {
+
   # fixed-size slabs
-  if(length(slab.structure) == 1) {
+  if (length(slab.structure) == 1) {
     # generate sequence of segment labels
-    seg.label <- rep(1:ceiling(max.d / slab.structure), each=slab.structure, length=max.d)
+    seg.label <- rep(1:ceiling(max.d / slab.structure), each = slab.structure, length = max.d)
+
     # general segment labels
-    seg.label.levels <- tapply(1:max.d, seg.label, function(i) {r <- range(i); paste(c(r[1]-1, r[2]), collapse='-') } )
+    seg.label.levels <- tapply(1:max.d, seg.label, 
+                               function(i) {
+                                 r <- range(i, na.rm = TRUE)
+                                 paste(c(r[1] - 1, r[2]), collapse = '-')
+                               })
   }
 
   # user-defined slabs
-  if(length(slab.structure) > 1) {
-    # trival case where segments start from 0
-    if(slab.structure[1] == 0 & length(slab.structure) > 2)
-      seg.label <- rep(slab.structure[-1], times=diff(slab.structure))[1:max.d]
+  if (length(slab.structure) > 1) {
+    if (slab.structure[1] == 0 & length(slab.structure) > 2) {
+      # trivial case where segments start from 0
+
+      seg.label <- rep(slab.structure[-1], times = diff(slab.structure))[1:max.d]
 
-    # other case: user defines an arbitrary lower and upper limit
-    else {
-      if(length(slab.structure) != 2)
+    } else {
+      # other case: user defines an arbitrary lower and upper limit
+      if (length(slab.structure) != 2)
         stop('user-defined slab boundaries must either start from 0, or contain two values between 0 and the max soil depth')
 
-      # proceed
+      # calculate thickness of slab
       slab.thickness <- diff(slab.structure)
-      # how many slices of NA before the slab?
-      padding.before <- rep(NA, times=slab.structure[1])
-      # how many slices of NA afer the slab
-      padding.after <- rep(NA, times=abs(max.d - slab.structure[2]))
+
       # make a new label for the slab
-      new.label <- paste(slab.structure, collapse='-')
-      # generate an index for the slab
-      slab.idx <- rep(new.label, times=slab.thickness)
-      # generate the entire index: padding+slab+padding = total number of slices (max_d)
-      # seg.label <- c(padding.before, slab.idx, padding.after)
-      seg.label <- slab.idx 
+      new.label <- paste(slab.structure, collapse = '-')
+
+      slab.idx <- rep(new.label, times = slab.thickness)
+      seg.label <- slab.idx
     }
 
     # generate segment labels	
-    seg.label.levels <- sapply(1:(length(slab.structure)-1), function(i) paste(c(slab.structure[i], slab.structure[i+1]), collapse='-'))
+    seg.label.levels <- sapply(1:(length(slab.structure) - 1), function(i) {
+      paste(c(slab.structure[i], slab.structure[i + 1]), collapse = '-')
+    })
   }
 
   # covert into a factor that can be used to split profiles into slabs
-  res <- factor(rep(seg.label, times=n.profiles), labels=seg.label.levels)
+  res <- factor(rep(seg.label, times = n.profiles), labels = seg.label.levels)
 
   return(res)
 }
-
-
-
-
-

R/segment.R

@@ -3,19 +3,20 @@
 
 #' Segmenting of Soil Horizon Data by Depth Interval
 #' 
-#' This function segments or subdivides horizon data from a `SoilProfileCollection` or `data.frame` by depth interval (e.g. `c(0, 10)`, `c(0, 50)`, or `25:100`). This results in horizon records being split at the specified depth intervals, which duplicates the original horizon data but also adds new horizon depths. In addition, labels (i.e. `"segment_id"`) are added to each horizon record that correspond with their depth interval (e.g. `025-100`). This function is intended to harmonize horizons to a common support (i.e. depth interval) for further aggregation or summary. See the examples.
+#' @description This function segments or subdivides horizon data from a `SoilProfileCollection` or `data.frame` by depth interval (e.g. `c(0, 10)`, `c(0, 50)`, or `25:100`). This results in horizon records being split at the specified depth intervals, which duplicates the original horizon data but also adds new horizon depths. In addition, labels (i.e. `"segment_id"`) are added to each horizon record that correspond with their depth interval (e.g. `025-100`). This function is intended to harmonize horizons to a common support (i.e. depth interval) for further aggregation or summary. See the examples.
+#'
 #' @param object either a `SoilProfileCollection` or `data.frame`
 #' @param intervals a vector of integers over which to slice the horizon data (e.g. `c(25, 100)` or `25:100`)
-#' @param trim logical, when `TRUE` horizons in `object` are truncated to the min/max specified in `intervals`. When `FALSE`, those horizons overlapping an interval are marked as such. Care should be taken when specifying more than one depth interval and `trim = FALSE`.
+#' @param trim logical, when `TRUE` horizons in `object` are truncated to the min/max specified in `intervals`. When `FALSE`, those horizons overlapping an interval are marked as such. Care should be taken when specifying more than one depth interval and \code{`trim = FALSE`}.
 #' @param hzdepcols a character vector of length 2 specifying the names of the horizon depths (e.g. `c("hzdept", "hzdepb")`), only necessary if `object` is a `data.frame`.
 #' 
-#' @details `segment()` performs no aggregation or resampling of the source data, rather, labels are added to horizon records for subsequent aggregation or summary. This makes it possible to process a very large number of records outside of the constraints associated with e.g. `slice()` or `slab()`.
+#' @details `segment()` performs no aggregation or resampling of the source data, rather, labels are added to horizon records for subsequent aggregation or summary. This makes it possible to process a very large number of records outside of the constraints associated with e.g. \code{slice} or \code{slab}.
 #'
-#' @return Either a `SoilProfileCollection` or `data.frame` with the original horizon data segmented by depth intervals. There are usually more records in the resulting object, one for each time a segment interval partially overlaps with a horizon. A new column called `segment_id` identifying the depth interval is added.
+#' @return Either a `SoilProfileCollection` or `data.frame` with the original horizon data segmented by depth intervals. There are usually more records in the resulting object, one for each time a segment interval partially overlaps with a horizon. A new column called \code{segment_id} identifying the depth interval is added.
 #' 
 #' @author Stephen Roecker
 #' 
-#' @seealso [dice()], [glom()]
+#' @seealso [dice()] [glom()]
 #' 
 #' @export
 #'