Question

我大约六个月前就开始使用R了，我在R中获得了一些经验。最近，我遇到了一个关于矩阵内子集的问题，并希望能帮助我制定更高效的解决方案。

我想做的是以下内容。假设我有一个矩阵和两个向量，如下所示：

# matrix
a <- matrix(seq(1,100,by=1),10,10)
# vector (first column of matrix a)
b <- c(2,4,5,6,7,8)
# vector (column numbers of matrix a)
c <- c(5,3,1,4,6,2)

重申一下，

向量b是指矩阵a的第一列。
向量c是指矩阵a的列号。

我想获得tmp99 <- a[b,c:8]。但是，当我这样做时，我收到以下警告信息。

Warning message:
In c:8 : numerical expression has 6 elements: only the 
        first used (index has to be scalar and not vector)

所以，我尝试使用循环和列表解决问题，我得到了我想要的解决方案。我假设有一个比这更有效的解决方案。我到目前为止的解决方案如下：

a <- matrix(seq(1,100,by=1),10,10)
b <- c(2,4,5,6,7,8)
c <- c(5,3,1,4,6,2)
tmp <- list()
for (i in 1:length(b)) tmp[[i]] <- c(a[b[i],(c[i]:8)])
tmp99 <- t(sapply(tmp, '[', 1:max(sapply(tmp, length))))
tmp99[is.na(tmp99)] <- 0

我想知道的是如果有办法避免使用循环来实现上述目标，因为我的矩阵维度为200000 x 200，因为我必须做很多事情（在我的问题中，b和c被确定为代码的另一部分的一部分，因此我无法使用绝对索引号），我想减少相同的时间。任何帮助将不胜感激。谢谢。

Answer 1

您可以尝试某种矩阵索引解决方案，就像这样。目前尚不清楚它是否会更快或更快;在小的情况下，我认为肯定会，但在大的情况下，从创建矩阵到索引的开销可能需要更长的时间，而不是仅仅运行for循环。要获得更好的答案，请构建一个与我们可以测试的数据集类似的数据集。

idx.in <- cbind(rep(b, 8-c+1), unlist(lapply(c, function(x) x:8)))
idx.out <- cbind(rep(seq_along(b), 8-c+1), unlist(lapply(c, function(x) 1:(8-x+1))))
tmp99 <- array(0, dim=apply(idx.out, 2, max))
tmp99[idx.out] <- a[idx.in]

这是一个带矩阵索引的版本，但每个行都单独执行。这可能会更快，具体取决于要替换的行数和列数。你想要避免的是内存耗尽，for循环可以帮助它，因为它不会同时保留内存中每个步骤的所有细节。

out <- array(0, dim=c(length(b), 8-min(c)+1))
for(idx in seq_along(b)) {
  out[cbind(idx, 1:(8-c[idx]+1))] <- a[cbind(b[idx], c[idx]:8)]
}
out

Answer 2

以下是使用base包进行此操作的一种方法。使用data.table可能有更好的解决方案，但以下工作：）

a <- matrix(seq(1, 100, by = 1), 10, 10)
b <- c(2, 4, 5, 6, 7, 8)
c <- c(5, 3, 1, 4, 6, 2)

res <- t(sapply(X = mapply(FUN = function(b, c) expand.grid(b, seq(from = c, to = 8)), b, c, SIMPLIFY = FALSE), FUN = function(x) {
    c(a[as.matrix(x)], rep(0, 8 - nrow(x)))
}))

res
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
## [1,]   42   52   62   72    0    0    0    0
## [2,]   24   34   44   54   64   74    0    0
## [3,]    5   15   25   35   45   55   65   75
## [4,]   36   46   56   66   76    0    0    0
## [5,]   57   67   77    0    0    0    0    0
## [6,]   18   28   38   48   58   68   78    0



# Let's break it down in multiple steps.

coordinates <- mapply(FUN = function(b, c) expand.grid(b, seq(from = c, to = 8)), b, c, SIMPLIFY = FALSE)

# below sapply subsets c using each element in coordinates and pads result with additional 0s such that total 8 elements are returned.

res <- sapply(X = coordinates, FUN = function(x) {
    c(a[as.matrix(x)], rep(0, 8 - nrow(x)))
})
res
##      [,1] [,2] [,3] [,4] [,5] [,6]
## [1,]   42   24    5   36   57   18
## [2,]   52   34   15   46   67   28
## [3,]   62   44   25   56   77   38
## [4,]   72   54   35   66    0   48
## [5,]    0   64   45   76    0   58
## [6,]    0   74   55    0    0   68
## [7,]    0    0   65    0    0   78
## [8,]    0    0   75    0    0    0


# you probably need result as traspose
res <- t(res)

res
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
## [1,]   42   52   62   72    0    0    0    0
## [2,]   24   34   44   54   64   74    0    0
## [3,]    5   15   25   35   45   55   65   75
## [4,]   36   46   56   66   76    0    0    0
## [5,]   57   67   77    0    0    0    0    0
## [6,]   18   28   38   48   58   68   78    0

Answer 3

tmp <- lapply(seq_len(length(b)),function(i) {
  res <- a[b[i],c[i]:8]
  res <- c(res,rep(0,c[i]-1))
  res
                                              })
tmp99 <- do.call("rbind",tmp)
#       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
# [1,]   42   52   62   72    0    0    0    0
# [2,]   24   34   44   54   64   74    0    0
# [3,]    5   15   25   35   45   55   65   75
# [4,]   36   46   56   66   76    0    0    0
# [5,]   57   67   77    0    0    0    0    0
# [6,]   18   28   38   48   58   68   78    0

'R'矩阵子集没有循环

3 个答案: