R/apply_lag.r

In markanewman/mndredge: Data dredging in R

#' @title apply_lag
#'
#' @description lag some of the columns in a \code{\link[base]{data.frame}}
#'
#' @export
#'
#' @param data a \code{\link[base]{data.frame}} to operate over
#' @param hold a \code{\link[base]{vector}} of column names to hold steady
#' @param move a \code{\link[base]{vector}} of column names to lag
#' @param lag the number of rows to lag by
#' @return the laged \code{\link[base]{data.frame}}
#'
#' @author Mark Newman, \email{mark@trinetteandmark.com}
#' @keywords utilities
#' @family utilities
#'
#' @examples
#'   \dontshow{
#'     library(magrittr)
#'     library(mndredge) }
#'   data.frame(
#'     a = c(1,2,3,4),
#'     b = c(2,3,4,5),
#'     c = c(4,5,6,7)) %>%
#'     apply_lag(hold = "a", move = "b", lag = 1)
#'
apply_lag <- function(data, hold, move, lag = 0) {
  
  stopifnot(
    data %>% is.data.frame(),
    hold %>% is.character(),
    move %>% is.character())
  
  cn <- colnames(data)
  stopifnot(
    hold %in% cn %>% all(),
    move %in% cn %>% all(),
    is.numeric(lag),
    lag >= 0)
  
  n <- nrow(data)
  stopifnot(n > lag)

  df1 <- data[, hold] %>% as.data.frame()
  df2 <- data[, move] %>% as.data.frame()

  cbind(  
    df1[1:(n-lag),],
    df2[(1+lag):n,]) %>%
    as.data.frame() %>%
    set_colnames(c(hold, move)) %>%
    set_rownames(1:(n-lag))
}