CODEWITHSUNDEEP
rvectorlag
richardzhang
richardzhang

Reputation: 71

How to lag a vector then create a matrix?

I'm plan to write a function called lagit(a,k) to get a result like this:

lagit(c(1,5,6,4,7),c(1,3))

then it should output:

    L0 L1 L3
    1  NA NA
    5  1  NA
    6  5  NA
    4  6  1
    7  4  5

I'm facing 2 problems right now:
1. lag each column as each element in vector k;
2. how to bind a vector to a matrix(I used a for loop.

I was asked to use the functions in base only. So I can't call any functions from other packages.

Upvotes: 1

Views: 613

Answers (5)

nicola
nicola

Reputation: 24480

Try this:

lagit <- function(a,k) {
   tmp <- lapply(k,function(i) c(rep(NA,i),head(a,length(a)-i)))
   res <- cbind(a,do.call(cbind,tmp))
   colnames(res) <- paste0("L",c(0,k))
   res
}
lagit(a,k)
#[1,] 1 NA NA
#[2,] 5  1 NA
#[3,] 6  5 NA
#[4,] 4  6  1
#[5,] 7  4  5

Where:

a <- c(1,5,6,4,7)
k <- c(1,3)

Upvotes: 2

Ben373
Ben373

Reputation: 971

A base R solution

myLag <- function(x, n){
  if(n >= length(x))
    return(rep(NA,n))
  else if(n < length(x) & n > 0) 
    c(rep(NA,n), x[1:(length(x)-n)]) 
  else 
    x
}

lagit <- function(x,y){
  cbind(x, sapply(y, function(z) myLag(x,z)))
}

> lagit(c(1,5,6,4,7),c(1,3))
     x      
[1,] 1 NA NA
[2,] 5  1 NA
[3,] 6  5 NA
[4,] 4  6  1
[5,] 7  4  5

Upvotes: 0

markus
markus

Reputation: 26343

Yet another option that uses vapply and length<- under the hood

lagit <- function(a, k) {
  l <- length(a)
  k <- if (0 %in% k) k else c(0, k)
  vapply(k, function(x) `length<-`(c(rep(NA, times = x), a), l), numeric(l))
}
lagit(1:5, c(1, 3, 6))
#     [,1] [,2] [,3] [,4]
#[1,]    1   NA   NA   NA
#[2,]    2    1   NA   NA
#[3,]    3    2   NA   NA
#[4,]    4    3    1   NA
#[5,]    5    4    2   NA

Upvotes: 0

Darren Tsai
Darren Tsai

Reputation: 35554

A recursive solution:

myLag <- function(x, n){
  if(n > 0) myLag(c(NA, x)[1:length(x)], n-1) else x
}

The ability of this function is equivalent to dplyr::lag() and data.table::shift(). Let's test it:

myLag(1:10, 3)
# [1] NA NA NA  1  2  3  4  5  6  7

In your case:

a <- c(1,5,6,4,7)
b <- c(1,3)

> sapply(b, myLag, x = a)

[1,]   NA   NA
[2,]    1   NA
[3,]    5   NA
[4,]    6    1
[5,]    4    5

> cbind(a, sapply(b, myLag, x = a))

[1,] 1 NA NA
[2,] 5  1 NA
[3,] 6  5 NA
[4,] 4  6  1
[5,] 7  4  5

Upvotes: 0

Maurits Evers
Maurits Evers

Reputation: 50678

Here is an alternative approach

x <- c(1,5,6,4,7)

# Define a function that operates on a vector x
lagit <- function(x, k) {
    stopifnot(k >= 0 & k <= length(x))
    replace(rep(NA, length(x)), (k + 1):length(x), x[1:(length(x) - k)])
}

While not strictly necessary I've added a stopifnot statement to ensure that the lag is positive and less or equal to the length of the vector.

# Use sapply to apply lagit to different lags and store result as a matrix
sapply(c(0, 1, 3), function(k) lagit(x, k))
#     [,1] [,2] [,3]
#[1,]    1   NA   NA
#[2,]    5    1   NA
#[3,]    6    5   NA
#[4,]    4    6    1
#[5,]    7    4    5

Upvotes: 1

Related Questions