Как отстать от вектора, а затем создать матрицу?

Question

Я планирую написать функцию с именем lagit(a,k), чтобы получить такой результат:

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

, тогда он должен вывести:

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

Я столкнулся с 2проблемы сейчас:
1. отставать каждый столбец как каждый элемент в векторе k;
2. как связать вектор с матрицей (я использовал for loop.

Меня попросилииспользуйте функции только в * 1013. * Поэтому я не могу вызывать функции из других пакетов.

Answer 1

Еще один вариант, который использует vapply и length<- под капотом

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

Answer 2

A base R раствор

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

Answer 3

Вот альтернативный подход

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)])
}

Хотя это не является строго необходимым, я добавил оператор stopifnot, чтобы убедиться, что задержка положительна и меньше или равна длине вектора.

# 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

Answer 4

A рекурсивное решение:

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

Способность этой функции эквивалентна dplyr::lag() и data.table::shift().Давайте проверим это:

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

В вашем случае:

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

Answer 5

Попробуйте это:

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

Где:

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