Заданный вектор c (a1, a2, a3), как сгенерировать c (a1, a2, a3, a2, a3, a3) в R?

Question

Вопрос был объяснен заголовком. В моей проблеме вектор довольно длинный, примерно 1500. Один из способов я пытался это генерировать матрицу следующим образом,

Грубо говоря, эта матрица rbind три диагональные матрицы, diag(1, 3), diag(1,2) и diag(1,1). Но эти матрицы имеют разное количество столбцов. Следовательно, здесь не применяется rbind. Есть ли эффективный способ решить эту проблему.

Answer 1

vec <- 1:4 
n <- length(vec) 
as.vector(rev(setNames(vec, n:1)[as.character(sequence(1:n))])) 
# [1] 1 2 3 4 2 3 4 3 4 4 

пару трюков здесь; as.vector не нужно, он просто пропускает имена векторов.

Tyler <- function() do.call(rbind, mapply(compile, rows, nums, lst)) 
Julius <- function() as.vector(rev(setNames(vec, n:1)[as.character(sequence(1:n))])) 

# Vector of length 3 
# Unit: microseconds 
#  expr  min  lq median  uq  max neval 
# Tyler() 144.183 148.383 151.649 155.382 2241.617 1000 
# Julius() 73.724 76.058 80.724 82.590 276.236 1000 

# Vector of length 1500 
# Unit: seconds 
#  expr min  lq median  uq  max neval 
# Julius() 1.2181 1.270544 1.469416 1.506019 1.518471 10 
# (list of 1500 diagonal matrices took too much memory, couldn't compare) 

Редактировать.

JuliusTwo <- function() rev(vec[n + 1 - sequence(1:n)]) 

vec <- 1:3 
n <- length(vec) 
microbenchmark(Julius(), JuliusTwo(), times = 1000) 
# Unit: microseconds 
#   expr min  lq median  uq  max neval 
#  Julius() 72.326 75.125 76.525 78.392 259.905 1000 
# JuliusTwo() 49.461 51.794 53.194 54.595 1950.450 1000 

vec <- 1:1500 
n <- length(vec) 
microbenchmark(Julius(), JuliusTwo(), Henrik(x2), times = 10) 
# Unit: milliseconds 
#   expr  min  lq median  uq  max neval 
#  Julius() 1497.9588 1499.9438 1547.660 1582.0843 1590.2048 10 
# JuliusTwo() 157.0313 157.9193 177.682 200.7433 214.9415 10 
# Henrik(x2) 4639.1891 6157.247 7178.9953 7350.8146 7640.8685 10 

Matthew <- function() {m <- matrix(rep(vec, n), n);m[lower.tri(m, diag=TRUE)]} 
microbenchmark(JuliusTwo(), Matthew(), Arun(vec), times = 100) 
# Unit: milliseconds 
#   expr  min  lq median  uq  max neval 
# JuliusTwo() 113.25630 121.69106 126.16566 150.42730 237.51304 100 
# Matthew() 119.59806 126.87538 152.28000 157.42816 415.27231 100 
# Arun(vec) 32.93695 37.78204 40.99725 43.19757 98.69791 100 

Answer 2

Я не знаю об эффективной, но вот решение, которое я использовал:

lst <- list( 
    diag(1, 3), 
    diag(1,2) , 
    diag(1,1) 
) 

cols <- sapply(lst, ncol) 
mcol <- max(cols) 
rows <- sapply(lst, nrow) 
nums <- (mcol - cols)*rows 


compile <- function(x, y, z) { 
    if (y == 0) return(z) 
    cbind(matrix(rep(0, y), nrow = x), z) 
} 

do.call(rbind, mapply(compile, rows, nums, lst)) 

#'  [,1] [,2] [,3] 
#' [1,] 1 0 0 
#' [2,] 0 1 0 
#' [3,] 0 0 1 
#' [4,] 0 1 0 
#' [5,] 0 0 1 
#' [6,] 0 0 1 

Answer 3

Итерационного решение

seq_generator=function(vec) if (length(vec)-1>0) c(vec,seq_generator(vec[-1])) else tail(vec,1) 
seq_generator(1:4) 

Answer 4

Несколько хороших решений уже. Тем не менее, я даю ему попробовать с zoo альтернативой:

library(zoo) 

# the vector 
x1 <- c("a1", "a2", "a3") 
n <- length(x1) 

# convert to zoo object 
x2 <- zoo(x1) 

# lag the vector with a vector of lags 
x3 <- lag(x2, k = seq(from = 0, by = 1, length.out = n)) 

# convert back to vector 
na.omit(as.vector(x3)) 
# [1] "a1" "a2" "a3" "a2" "a3" "a3" 

Answer 5

Вы также можете сделать это довольно просто с lower.tri.

vec <- 1:4 
m <- matrix(rep(vec, length(vec)), length(vec)) 
m[lower.tri(m, diag=TRUE)] 
# [1] 1 2 3 4 2 3 4 3 4 4 

Это немного медленнее, чем умный ответ @Julius. См. Его для тестов.