矩阵横向扩展答案

【问题标题】：Matrix scale-out矩阵横向扩展
【发布时间】：2013-01-23 04:01:54
【问题描述】：

给定一个 100x100 的矩阵，我们要计算一个 20x20 的矩阵，它的每个单元格代表原始矩阵的 5x5 平方的平均值。

如何执行？（如果您对此操作有更好的名称，请评论以重命名问题）。

【问题讨论】：

【解决方案1】：

这里有几个选项。

直接的方法是使用 raster 包中的aggregate()：

m <- matrix(1:10000, ncol=100)

library(raster)
r <- raster(m)
as.matrix(aggregate(r, 5))

## aggregate() also supports non-square aggregation windows
as.matrix(aggregate(r, c(20, 50)))
#        [,1]   [,2]   [,3]   [,4]   [,5]
# [1,]  975.5 2975.5 4975.5 6975.5 8975.5
# [2,] 1025.5 3025.5 5025.5 7025.5 9025.5

对于更优雅或更模糊的方法（取决于您的观点），请使用几个矩阵乘法：

m <- matrix(1:10000, ncol=100)

mm <- suppressWarnings(matrix(rep(c(1, rep(0, 20)), each=5), ncol=20, nrow=100))
(t(mm) %*% m %*% mm)/25

【讨论】：

优雅、模糊、深奥。这里也有要点。
@Ali：看看 rep(c(1, rep(0, 20)) , each=5) 看看为什么。 Josh 和 R 一样给了你一个警告。
@Ali -- 我真正的建议是使用第一个想法。我只是为了好玩把第二个扔进去=）
@Ali -- raster::aggregate() 将支持非方形窗口，如果传递的第二个参数是长度为 2 的向量。试试这个，例如：as.matrix(aggregate(r, fact=c(50, 20)))。
@Ali -- 要消除警告，请使用suppressWarnings()（正如我现在在主帖的编辑中所做的那样）。

【解决方案2】：

让我做一个小玩具的例子：

R > mat = matrix(1:36, 6,6)
R > mat
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1    7   13   19   25   31
[2,]    2    8   14   20   26   32
[3,]    3    9   15   21   27   33
[4,]    4   10   16   22   28   34
[5,]    5   11   17   23   29   35
[6,]    6   12   18   24   30   36

R > A = matrix(paste(ceiling(col(mat)/2), ceiling(row(mat)/2), sep = "-"), nc = ncol(mat))
R > A
     [,1]  [,2]  [,3]  [,4]  [,5]  [,6] 
[1,] "1-1" "1-1" "2-1" "2-1" "3-1" "3-1"
[2,] "1-1" "1-1" "2-1" "2-1" "3-1" "3-1"
[3,] "1-2" "1-2" "2-2" "2-2" "3-2" "3-2"
[4,] "1-2" "1-2" "2-2" "2-2" "3-2" "3-2"
[5,] "1-3" "1-3" "2-3" "2-3" "3-3" "3-3"
[6,] "1-3" "1-3" "2-3" "2-3" "3-3" "3-3"

R > matrix(tapply(mat, A, mean), 3, 3)
     [,1] [,2] [,3]
[1,]  4.5 16.5 28.5
[2,]  6.5 18.5 30.5
[3,]  8.5 20.5 32.5

这样，对于一个 6*6 的矩阵，计算每个 2*2 的块矩阵，我们得到一个 3*3 的汇总矩阵。

Reference

【讨论】：

点给你。容易理解。

【解决方案3】：

派对迟到了，但你走了：

# width/height of the sub-squares
side <- 5
# test matrix
test <- outer(1:100,1:100)
# make a selection matrix categorising each cell
select <- matrix(
                  rep(1:(length(test)/(side^2)),each=side),
                  nrow=nrow(test)
                )[,rep(1:(ncol(test)/side),each=side)]
# get the result
matrix(
        sapply(1:(length(test)/(side^2)),function(x) mean(test[select==x])),
        nrow=(ncol(test)/side)
      )

【讨论】：