问题已由标题解释。在我的问题中,向量很长,大约1,500。 我尝试的一种方法是生成矩阵,如下所示,
粗略地说,这个矩阵rbind
有三个对角矩阵,diag(1, 3)
,diag(1,2)
和diag(1,1)
。但是这些矩阵的列数不同。因此rbind
不适用于此处。有没有有效的方法来解决这个问题。
答案 0 :(得分:7)
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
答案 1 :(得分:3)
您也可以使用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的聪明回答慢一点。看他的基准测试。
答案 2 :(得分: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
答案 3 :(得分:2)
已有几个不错的解决方案。不过,我尝试使用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"
答案 4 :(得分:1)
迭代解决方案
seq_generator=function(vec) if (length(vec)-1>0) c(vec,seq_generator(vec[-1])) else tail(vec,1)
seq_generator(1:4)