Question

语言是R。

我有一个nxm矩阵，我想把它分成3x3部分并计算每个部分的平均值（或任何函数）。（如果有一个剩余的不是3x3的位，那么就使用剩下的东西了。）

我确信有apply - 这样做的方法 - 这是我的舌头 - 但我的大脑目前正在让我失望。我想这有点像一个移动的窗口问题，除了我想要不重叠的窗口（所以它更容易）。

任何人都可以想到这样做的内置函数吗？还是矢量化的方式？

这是我的循环版本：

winSize <- 3
mat <- matrix(runif(6*11),nrow=6,ncol=11)
nr <- nrow(mat)
nc <- ncol(mat)
outMat <- matrix(NA,nrow=ceiling(nr/winSize),
                    ncol=ceiling(nc/winSize))
FUN <- mean
for ( i in seq(1,nr,by=winSize) ) {
    for ( j in seq(1,nc,by=winSize) ) {
        # work out mean in 3x3 window, fancy footwork
        #  with pmin just to make sure we don't go out of bounds
        outMat[ ceiling(i/winSize), ceiling(j/winSize) ] <-
               FUN(mat[ pmin(i-1 + 1:winSize,nr), pmin(j-1 + 1:winSize,nc)])
    }
}

欢呼声。

Answer 1

您可以使用row和col来提取行号和列号，然后计算每个块的坐标。

tapply( 
  mat, 
  list( floor((row(mat)-1)/winSize), floor((col(mat)-1)/winSize) ), 
  mean 
)

编辑：通过使用以下函数替换row和col，可以将其推广到更高维数组。

a <- function( m, k ) {
  stopifnot( "array" %in% class(m) || "matrix" %in% class(m) )
  stopifnot( k == floor(k) )
  stopifnot( k > 0 )
  n <- length(dim(m))
  stopifnot( k <= n )
  i <- rep(
    1:dim(m)[k],
    each  = prod(dim(m)[ 1:n < k ]),
    times = prod(dim(m)[ 1:n > k ])
  )  
  array(i, dim=dim(m))
}

# A few tests
m <- array(NA, dim=c(2,3))
all( row(m) == a(m,1) )
all( col(m) == a(m,2) )
# In dimension 3, it can be done manually:
m <- array(NA, dim=c(2,3,5))
all( a(m,1) == array( rep(1:dim(m)[1], times=prod(dim(m)[2:3])), dim=dim(m) ) )
all( a(m,2) == array( rep(1:dim(m)[2], each=dim(m)[1], times=dim(m)[3]), dim=dim(m) ) )
all( a(m,3) == array( rep(1:dim(m)[3], each=prod(dim(m)[-3])), dim=dim(m) ) )

Answer 2

只想总结一下这方面的不同方法。

首先，@ VincentZoonekynd的解决方案。这非常通用 - 它允许我将任何函数应用于我的矩阵。然而它有点慢，因为我将这些应用于约5000x1000x3的矩阵并想要退出（5000 / kernelSize）x（1000 / kernelSize）x 3图像。

首先，生成一个要测试的矩阵（我把它做得更小，以免在测试各种方法时杀死我的计算机）：

sz <- c(1000,300,3)
img <- array(runif(prod(sz)),dim=sz)
kernelSize <- 3
outSz <- c(ceiling(sz[1:2]/kernelSize),3)
FUN <- mean

方法0：循环

############
# METHOD 0 #
############
# Loopy. base standard.
t0 <- system.time({
out0 <- array(NA,dim=outSz)
for ( i in seq(1,sz[1],by=kernelSize) ) {
    for ( j in seq(1,sz[2],by=kernelSize) ) {
        for ( c in 1:sz[3] ) {
        # work out mean in 3x3 window, fancy footwork
        #  with pmin just to make sure we don't go out of bounds
        out0[ ceiling(i/kernelSize), ceiling(j/kernelSize),c ] <-
               FUN(img[ pmin(i-1 + 1:kernelSize,sz[1]), 
                        pmin(j-1 + 1:kernelSize,sz[2]),
                        c]) 
        }
    }
}})

方法1：tapply

############
# METHOD 1 #
############
# @Vincent Zoonekynd.
# I can apply *any* function I want. how awesome!
# NOTE: I just realised that there is a slice.index(img,i)
#       is the same as his a(img,i) function.
t1 <- system.time({
out1 <- tapply(
         img,
         list( floor((slice.index(img,1)-1)/kernelSize), 
               floor((slice.index(img,2)-1)/kernelSize),
               slice.index(img,3) ),
         FUN )
})

cat('METHOD 0:',t0['elapsed'],'\n')
cat('METHOD 1:',t1['elapsed'],'\n')
cat(all(out0==out1),'\n')

这给出了：

METHOD 0: 13.549 
METHOD 1: 19.415 
TRUE

考虑到我希望将其应用于更大的img矩阵，这有点慢。

让我感到惊讶的是（起初）方法0（循环）比方法1（tapply）快。

然而，我记得tapply因为没有比显式循环快得多而声名远扬（为什么会这样？我记得在某处读过它......功能代码看起来好像可以做for循环无论如何，而不是调用外部代码。）

我也有一种普遍的感觉，vapply和sapply是apply的快速版本（再次，不确定这是否真的是真的，但我当然已经找到了）。

方法2：vapply

所以，我尝试使用vapply重写我的循环版本。（可能有更好的方法来处理第三维，但是哦......）。这基本上会生成一个大的坐标列表img。坐标给出了每个(i,j)正方形角的kernelSize*kernelSize。

然后vapply遍历它们并计算平均值。

##########
# METHOD 2 
##########
# use 'vapply'
t2 <- system.time({
is <- seq(1,sz[1],by=kernelSize)
js <- seq(1,sz[2],by=kernelSize)
# generate a (nrow*nsize) x 2 array with
# all (i,j) combinations for corners of
# kernelSize*kernelSize squares.
# Do it column-major so we can reshape after.
coords <- cbind( rep.int(is,length(js)), rep(js,each=length(is)) ) 
out2 <- array(NA,dim=outSz)
for ( c in 1:sz[3] ) { 
    out2[,,c] <- array(
    vapply( 1:nrow(coords), function(i) {
          FUN(img[coords[i,1]:pmin(sz[1],coords[i,1]+kernelSize-1),
                   coords[i,2]:pmin(sz[2],coords[i,2]+kernelSize-1),
                   c])
            }, 0 ),
                dim=outSz[1:2] ) 
}})
cat('METHOD 2:',t2['elapsed'],'\n')
cat(all(out0==out2),'\n')

这给出了：

METHOD 2: 12.627 
TRUE

所以，它比使用vapply的循环要快一点（我觉得我没有尽可能多地从vapply获得尽可能多的东西......就像我一样我没有以正确的方式使用它。）

方法3：过滤

这仍然不够快，所以我在每个窗口中加入了我只想要一个均值的信息，这基本上是[ 1/3 1/3 1/3 ]与矩阵的卷积在每个方面。

这会失去应用任意FUN的普遍适用性，但会获得大幅加速。

基本上，我创建一个内核[1/3, 1/3, 1/3]并将其与img进行两次卷积，一次在x方向，一次在y方向。然后我只提取每个第3个值（因为我想要不重叠的窗口）。

这对我来说似乎有点浪费，因为我计算了原始矩阵中每个 3x3窗口的平均值，而不仅仅是非重叠的窗口，但我不知道我不知道如何告诉R不要计算那些我将要抛弃的值。

然而，你必须在边界处稍微小心 - 比如只留下2x2补丁，然后平均值超过4而不是9个值。我当前的代码没有处理这个问题，但我不介意它是否只是边框，因为我只是为了显示目的而进行下采样。</ p>

（尽管......最后还是修好了这个......）

##########
# METHOD 3 
##########
# Convolve using `filter`,
# since the mean in a window is just a 
# convolution.
t3 <- system.time({
is <- pmin(seq(1,sz[1],by=kernelSize) + floor(kernelSize/2),sz[1]-1)
js <- pmin(seq(1,sz[2],by=kernelSize) + floor(kernelSize/2),sz[2]-1)
out3 <- array(NA,dim=outSz)
for ( c in 1:3 ) {
    out3[,,c] <- (t(filter(
                    t(filter(img[,,c],rep(1,kernelSize))),
                    rep(1,kernelSize))))[is,js]
}
out3 <- out3/(kernelSize*kernelSize)
})
cat('METHOD 3:',t3['elapsed'],'\n')
cat(sum(out0!=out3),'\n')

返回：

METHOD 3: 1.593 
300

所以这个方法到目前为止是最快的，而错误就在out3的最后一列（每个通道一次），因为（我猜）有边界条件。< / p>

R：将FUN应用于数组的kxk子部分

2 个答案:

方法0：循环

方法1：tapply

方法2：vapply

方法3：过滤