From f6ee56fa672a4b5e0416cbd392088482d4c28bd1 Mon Sep 17 00:00:00 2001
From: Stephen Roecker <stephen.roecker@gmail.com>
Date: Tue, 21 May 2024 22:55:45 -0500
Subject: [PATCH] Update hz_lag()

---
 R/segment.R   | 32 ++++++++++++++++++++------------
 man/hz_lag.Rd | 10 +++++-----
 2 files changed, 25 insertions(+), 17 deletions(-)

diff --git a/R/segment.R b/R/segment.R
index c482ee8a..b70530de 100644
--- a/R/segment.R
+++ b/R/segment.R
@@ -558,10 +558,10 @@ hz_intersect <- function(x, y, idcol = "id", depthcols = c("top", "bottom")) {
 #' clay   = c(10, 12, 27, 35, 16)
 #' )
 #' 
-#' h |> hz_lag(c("texcl", "clay"), 1)
+#' h |> hz_lag()
 #' 
 #' h |> 
-#' hz_lag(c("texcl", "clay"), 1) |> 
+#' hz_lag() |> 
 #' cbind(h) |>
 #' transform(
 #' clay_dif = clay - clay_lag.1,
@@ -570,7 +570,12 @@ hz_intersect <- function(x, y, idcol = "id", depthcols = c("top", "bottom")) {
 
 
 
-hz_lag <- function(object, vars, lag = 1, idcol = "id", depthcols = c("top", "bottom"), order = FALSE) {
+hz_lag <- function(object, lag = 1, vars = NULL, idcol = "id", depthcols = c("top", "bottom"), order = FALSE) {
+  
+  nm <- names(object)
+  idx <- which(! nm %in% c(idcol, depthcols))
+  if (is.null(vars)) vars <- nm[idx]
+  
   
   # check arguments ----
   .check_depthcols_l(depthcols)
@@ -590,7 +595,7 @@ hz_lag <- function(object, vars, lag = 1, idcol = "id", depthcols = c("top", "bo
   
   
   # lag ----
-  .lag <- function(x, lag = lag, var = NULL) {
+  .lag <- function(x, lag = lag, vars = NULL) {
     
     nr  <- nrow(x)
     top <- 1:nr
@@ -598,17 +603,20 @@ hz_lag <- function(object, vars, lag = 1, idcol = "id", depthcols = c("top", "bo
     
     test_idcol <- x$idcol[top] == x$idcol[bot] 
     # test_deps  <- x$bot[top]   == x$top[bot]
-    lag_var <- ifelse(
-      test_idcol & !is.na(test_idcol), 
-      x[bot, var], 
-      NA)
+    # lag_vars <- ifelse(
+    #   test_idcol & !is.na(test_idcol),
+    #   x[bot, var],
+    #   NA)
+    lag_vars <- x[test_idcol * bot, vars]
+    names(lag_vars) <- paste0(vars, "_lag.", lag)
     
-    return(lag_var)
+    return(lag_vars)
   }
   
-  x_lag <- lapply(vars, function(y) .lag(x, lag = lag, y)) |>
-    do.call("data.frame", args = _)
-  names(x_lag) <- paste0(vars, "_lag.", lag)
+  # x_lag <- lapply(vars, function(y) .lag(x, lag = lag, y)) |>
+  #   do.call("data.frame", args = _)
+  # names(x_lag) <- paste0(vars, "_lag.", lag)
+  x_lag <- .lag(x, lag, vars)
   
   # # reset inputs ----
   # x <- .reset_inputs(cbind(x, x_lag), x_conversion)
diff --git a/man/hz_lag.Rd b/man/hz_lag.Rd
index bdd73f10..f234da02 100644
--- a/man/hz_lag.Rd
+++ b/man/hz_lag.Rd
@@ -6,8 +6,8 @@
 \usage{
 hz_lag(
   object,
-  vars,
   lag = 1,
+  vars = NULL,
   idcol = "id",
   depthcols = c("top", "bottom"),
   order = FALSE
@@ -16,10 +16,10 @@ hz_lag(
 \arguments{
 \item{object}{a \code{data.frame}}
 
-\item{vars}{character: column names, to lag.}
-
 \item{lag}{integer: number of horizons to lag}
 
+\item{vars}{character: column names, to lag.}
+
 \item{idcol}{character: column name of the pedon ID within the object.}
 
 \item{depthcols}{a character vector of length 2 specifying the names of the horizon depths (e.g. \code{c("top", "bottom")}).}
@@ -45,10 +45,10 @@ texcl     = c("SL", "SL", "CL", "CL", "L"),
 clay   = c(10, 12, 27, 35, 16)
 )
 
-h |> hz_lag(c("texcl", "clay"), 1)
+h |> hz_lag()
 
 h |> 
-hz_lag(c("texcl", "clay"), 1) |> 
+hz_lag() |> 
 cbind(h) |>
 transform(
 clay_dif = clay - clay_lag.1,