Question

我目前有一个有效的解决方案。我想知道是否有更优雅的方法？

首先是设置：

set.seed(315)
mat <- matrix(sample(1:5, 20, replace = TRUE), nrow = 4, ncol = 5)
> mat
     [,1] [,2] [,3] [,4] [,5]
[1,]    3    4    1    3    3
[2,]    5    3    5    1    4
[3,]    4    1    1    4    3
[4,]    3    3    1    1    1

从这个矩阵中，我想创建一个5x5输出矩阵，其中 i，j 中的条目是列 j中的元素数大于输入矩阵的列 i 。

编辑：最初我描述了一个解决方案，输出解决方案的条目 i，j 是列 i 大于列 j ，但在输出中提供了相反的关系。我更改了描述以匹配输出，并且提供的答案中的任何差异都可能是由此产生的。

此解决方案提供了所需的输出：

mat.pm <- apply(mat, MARGIN = 2,
                function(x) {
                  return(apply(mat, MARGIN = 2, function(y) {
                    return(sum(x > y))
                  }))
                })

> mat.pm
     [,1] [,2] [,3] [,4] [,5]
[1,]    0    1    0    0    0
[2,]    2    0    1    1    2
[3,]    3    2    0    2    2
[4,]    2    3    1    0    1
[5,]    3    2    1    1    0

是否有更好的方法可以不涉及双嵌套应用函数？

编辑：这是针对各种方法的一些基准测试：

library(microbenchmark)

set.seed(315)
bm_data <- matrix(sample(1:5, 6000, replace = TRUE), nrow = 200, ncol = 30)

op <- microbenchmark(
  APPLY1 = apply(bm_data, MARGIN = 2,
                function(x) {
                  return(apply(bm_data, MARGIN = 2, function(y) {
                    return(sum(x > y))
                  }))
                }),
  APPLY2 = apply(bm_data, 2 , function(x) colSums( x > bm_data)),
  SWEEP = apply(bm_data,2,function(x) colSums(sweep(bm_data,1,x,"-")<0)),
  VECTORIZE = {
    n <- 1:ncol(bm_data);
    ind <- expand.grid(n, n)
    out <- colSums(bm_data[,c(ind[,2])] > bm_data[,c(ind[,1])])
  },
  SAPPLY = sapply(seq(ncol(bm_data)), function(i) colSums(bm_data[, i] > bm_data)),
  times = 100L
)

> summary(op)
       expr      min        lq    median        uq       max neval
1    APPLY1 9742.091 10519.757 10923.896 11876.614 13006.850   100
2    APPLY2 1012.097  1080.926  1148.111  1247.965  3338.314   100
3     SWEEP 7020.979  7667.972  8580.420  8943.674 33601.336   100
4 VECTORIZE 3036.700  3266.815  3516.449  4476.769 28638.246   100
5    SAPPLY  978.812  1021.754  1078.461  1150.782  3303.798   100

@ Ricardo的 SAPPLY 和@ Simon的 APPLY2 策略都很不错，一线解决方案的执行速度比我的 APPLY1 方法快得多。在优雅方面，@ Simon使用 APPLY2 进行的更新达到了标记 - 简单，可读和快速。

我通过讨论得到的一个结论是，与apply相比，data.frame函数在矩阵中的速度有多快。转换，然后尽可能计算。

@ Simon的expand.grid是最有创意的 - 我甚至没想过以这种方式解决问题。好的。

Answer 1

编辑：

请参阅下面的详细信息，但您可以在一个apply循环中执行此操作：

apply( mat , 2 , function(x) colSums( x > mat )

apply在这里速度很快，因为它已针对矩阵进行了优化。在将apply转换为矩阵时，使用data.frame花费的大部分时间通常都是。

原始

完全向量化可以做到这一点，因为>有matrices和data.frame s的方法。因此，您可以使用expand.grid()获取要比较的列索引，使用此子集矩阵，进行逻辑比较，然后使用colSums获取结果，并使用matrix将其包装回来达到正确的尺寸。所有这些都在4行（实际上可能是2行）：

n <- 1:ncol(mat)
ind <- expand.grid(n,n)
out <- colSums( mat[,c(ind[,1])] > mat[,c(ind[,2])] )

matrix( out , ncol(mat) , byrow = TRUE )
#     [,1] [,2] [,3] [,4] [,5]
#[1,]    0    1    0    0    0
#[2,]    2    0    1    1    2
#[3,]    3    2    0    2    2
#[4,]    2    3    1    0    1
#[5,]    3    2    1    1    0

更新

apply似乎更快，将apply与@ Ricardo对整个matrix的比较结合起来，将我们引向一个单一的，最快的（？）apply解决方案比OP快4倍：

#  Single apply loop
f1 <- function(mat) apply( mat , 2 , function(x) colSums( x > mat ) )

#  OP double apply loop
f2 <- function(mat) {apply(mat, MARGIN = 2,
                function(x) {
                  return(apply(mat, MARGIN = 2, function(y) {
                    return(sum(x > y))
                  }))})}

require(microbenchmark)
microbenchmark( f1(mat) , f2(mat) )

#Unit: microseconds
#    expr     min       lq   median       uq      max neval
# f1(mat)  95.190  97.6405 102.7145 111.4635  159.584   100
# f2(mat) 361.862 370.7860 398.7830 418.3810 1336.506   100

Answer 2

我认为您的结果是转置的：

## This gives you what you show as output
sapply(seq(ncol(mat)), function(i) colSums(mat[, i] > mat))

## This gives you what you _describe_ in the question
t(sapply(seq(ncol(mat)), function(i) colSums(mat[, i] > mat)))

     [,1] [,2] [,3] [,4] [,5]
[1,]    0    2    3    2    3
[2,]    1    0    2    3    2
[3,]    0    1    0    1    1
[4,]    0    1    2    0    1
[5,]    0    2    2    1    0

Answer 3

这是一种只使用1 apply的方法，但用sweep替换另一种，所以不确定它是否重要：

apply(mat,2,function(x) colSums(sweep(mat,1,x,"-")<0))
     [,1] [,2] [,3] [,4] [,5]
[1,]    0    1    0    0    0
[2,]    2    0    1    1    2
[3,]    3    2    0    2    2
[4,]    2    3    1    0    1
[5,]    3    2    1    1    0

Answer 4

基准：

 bigmat<-matrix(sample(0:5,200,rep=T),nr=10)
    gridfoo <- function(mat) {
    n <- 1:ncol(mat)
    ind <- expand.grid(n,n)
    out <- colSums( mat[,c(ind[,1])] > mat[,c(ind[,2])] )
    }

    appfoo<- function(mat) apply(mat,2,function(x) colSums(sweep(mat,1,x,"-")<0))


    app2foo<- function(mat) t(sapply(seq(ncol(mat)), function(i) colSums(mat[, i] > mat)))

 microbenchmark(gridfoo(bigmat),appfoo(bigmat),app2foo(bigmat),times=10)
Unit: microseconds
            expr      min       lq    median       uq      max neval
 gridfoo(bigmat)  363.909  369.895  381.4410  413.086  522.557    10
  appfoo(bigmat) 1208.892 1231.129 1238.1850 1252.083 1521.913    10
 app2foo(bigmat)  298.482  310.883  317.0835  323.284  762.454    10

但......（注意时间单位的差异）

Rgames> bigmat<-matrix(sample(0:5,20000,rep=T),nr=100)
Rgames> microbenchmark(gridfoo(bigmat),appfoo(bigmat),app2foo(bigmat),times=10)
Unit: milliseconds
            expr       min        lq   median        uq       max neval
 gridfoo(bigmat) 106.15115 112.98458 149.5746 183.87987 249.35418    10
  appfoo(bigmat) 127.44553 127.92874 132.5372 136.42562 199.12123    10
 app2foo(bigmat)  14.64483  14.99676  18.6089  20.51824  20.91122    10

Answer 5

这很有效，但由于合并步骤繁重，它可能无法很好地扩展。

library(reshape2)
matmelted <- melt(mat)
matmeltedcross<- merge(matmelted,matmelted,by = 'Var1', allow.cartesian = TRUE)
matmeltedcross$count <- matmeltedcross$value.x > matmeltedcross$value.y
mat.pm <- with(
  matmeltedcross[matmeltedcross$count == TRUE,],
  table(Var2.y,Var2.x)
)

输出 -

> mat.pm
      Var2.x
Var2.y 1 2 3 4 5
     1 0 1 0 0 0
     2 2 0 1 1 2
     3 3 2 0 2 2
     4 2 3 1 0 1
     5 3 2 1 1 0

优雅的方法来计算矩阵的每列中的元素数量是否大于其他列中的元素数量？

5 个答案:

编辑：

原始

更新