Question

我试图在R中乘以矩阵但使用apply函数。在这种特殊情况下，我希望处理NAs，我在crossprod中没有看到任何内容，或者使用％*％

set.seed(3141)
mat1 <- c(1:50)
pos <- sample(c(1:50),14)
mat1[pos] <- NA
mat1 <- matrix(mat1,10,5)
mat2 <- matrix(sample(c(0,1),20,replace=T),5,4)

MAT1：

       [,1] [,2] [,3] [,4] [,5]
  [1,]    1   11   NA   31   41
  [2,]   NA   12   NA   32   NA
  [3,]   NA   13   NA   NA   NA
  [4,]    4   14   24   34   44
  [5,]    5   15   25   NA   45
  [6,]    6   16   26   36   46
  [7,]    7   17   27   37   47
  [8,]    8   18   28   NA   NA
  [9,]    9   19   29   NA   49
 [10,]   10   20   NA   40   NA

MAT2：

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

所以mat1抛出一些NAs，mat2就像是旧的穿孔卡，跟踪mat1的哪些元素保留在结果中（所以它在最真实的意义上不是完全乘法 - 穿孔卡真的是我所追求的，乘法似乎是一种获得它的方式）。使用％*％，

mat3 <- mat1 %*% mat2

      [,1] [,2] [,3] [,4]
 [1,]   NA   NA   NA   NA
 [2,]   NA   NA   NA   NA
 [3,]   NA   NA   NA   NA
 [4,]   58  102   92   62
 [5,]   NA   NA   NA   NA
 [6,]   62  108   98   68
 [7,]   64  111  101   71
 [8,]   NA   NA   NA   NA
 [9,]   NA   NA   NA   NA
[10,]   NA   NA   NA   NA

遍布全国各地。首先尝试处理它们：

    mat4 <- t(apply(mat1,1,function(x){apply(mat2,2,function(y){sum(x*y,na.rm=T)})}))

      [,1] [,2] [,3] [,4]
 [1,]   52   72   83   53
 [2,]   12   32   44   12
 [3,]   13    0   13   13
 [4,]   58  102   92   62
 [5,]   60   70   60   65
 [6,]   62  108   98   68
 [7,]   64  111  101   71
 [8,]   18   28   18   26
 [9,]   68   78   68   77
[10,]   20   40   60   30

哪个更好，但挑剔的复杂性是我想要删除任何试图从mat1中包含NA的结果，因此它不会为决赛做出贡献。

mat5 <- t(apply(mat1,1,function(x){
  apply(mat2,2,function(y){
    ifelse(is.na(sum(x[as.logical(y)])),
           0,
           sum(x*y,na.rm=T))
  })}))

      [,1] [,2] [,3] [,4]
 [1,]   52    0   83   53
 [2,]    0    0    0    0
 [3,]    0    0    0    0
 [4,]   58  102   92   62
 [5,]   60    0    0   65
 [6,]   62  108   98   68
 [7,]   64  111  101   71
 [8,]    0    0    0    0
 [9,]   68    0    0   77
[10,]    0    0    0    0

这就是我的目标，因为如果mat1中有一个NA，我只会抛出结果（即mat2有一个相应的1，但如果没有，那么NA很好）。

问题是，这是一种有效的解决方案吗？我是否遗漏了一些可以让它变得更快的基础？（没有并行化，因为我很遗憾地在Windows上，这样的事情不适合胆小的人）。这看起来很笨重，并且必须在多个阵列上执行数百万次，因此任何加速都会很有用。感谢。

更新谢谢你到目前为止的两个回复。我以为我会在我的机器上运行时序比较，看看方法可能有什么不同。不幸的是，我无法让C ++工作。我收到一条错误消息，指出构建共享库时出错。它建议从CRAN下载兼容版本的Rtools（我使用的是R3.2.3），但我也想到这一点必须在其他计算机上运行（比如我的老板）需要额外安装以及使其正常工作的地方可能并不理想。包，我可以写入代码，但如果代码引发错误修复它，访问网站下载的东西不是标准安装的一部分，有点复杂。无论如何，对于其他人：

meth1 <- function(m1,m2){
  t(apply(m1,1,function(x){
    apply(m2,2,function(y){
      ifelse(is.na(sum(x[as.logical(y)])),
             0,
             sum(x*y,na.rm=T))
    })}))
}
meth2 <- function(m1,m2){
  m1[is.na(m1)] <- 10^20
  res <- m1 %*% m2
  res[abs(res) > 10^10] <- 0
  res
}

library(Matrix)
meth4 <- function(m1,m2){
  M1 <- Matrix(m1,sparse=TRUE)
  M2 <- Matrix(m2,sparse=TRUE)
  res <- M1 %*% M2
  res[is.na(res)] <- 0
  Matrix(res,sparse = F)
}

library(microbenchmark)
microbenchmark({meth1(mat1,mat2)},{meth2(mat1,mat2)},{meth4(mat1,mat2)},times=100)

得到以下特性：

Unit: microseconds
                      expr      min       lq       mean   median       uq
 {     meth1(mat1, mat2) }  475.957  516.155  563.41297  535.826  568.754
 {     meth2(mat1, mat2) }    8.126    9.836   14.78396   15.609   18.816
 {     meth4(mat1, mat2) } 4535.489 4764.701 5016.47097 4901.331 5008.025
      max neval
 1763.565   100
   30.791   100
 9722.265   100

对Rcpp感到羞耻 - 我很欣赏它看起来不费吹灰之力，C中的东西往往会跑得更快。那快速又脏兮兮的＆＃34;有点以数量级赢得了一天，只使用了基数。感谢您的建议（全部三个）

Answer 1

快速但又脏的解决方案是将NA替换为具有足够高的值，然后使用阈值来选择零：

mat1[is.na(mat1)] <- 10^200
A <- mat1 %*% mat2
A[abs(A) > 10^100] <- 0
A
      [,1] [,2] [,3] [,4]
 [1,]   52    0   83   53
 [2,]    0    0    0    0
 [3,]    0    0    0    0
 [4,]   58  102   92   62
 [5,]   60    0    0   65
 [6,]   62  108   98   68
 [7,]   64  111  101   71
 [8,]    0    0    0    0
 [9,]   68    0    0   77
[10,]    0    0    0    0

或者您可以简单地使用Rcpp编写自己的方法：

library(inline)
library(Rcpp)
cppFunction(
    'NumericMatrix f(NumericMatrix mat1, NumericMatrix mat2) {
        double val;
        NumericMatrix X(mat1.nrow(), mat2.ncol());
        for (int i = 0; i < mat1.nrow(); ++i) {
            for (int j = 0; j < mat1.ncol(); ++j) {
                val = 0;
                for(int k = 0; k < mat1.ncol(); k++){
                    if(NumericVector::is_na(mat1(i, k))){
                        if( mat2(k, j) != 0) {
                            val = 0;
                            break;
                        }
                    } else val += mat1(i, k)*mat2(k, j);
                }
                X(i, j) = val;
            }
        }
        return X;
    }'
)

> f(mat1, mat2)
      [,1] [,2] [,3] [,4]
 [1,]   52    0   83   53
 [2,]    0    0    0    0
 [3,]    0    0    0    0
 [4,]   58  102   92   62
 [5,]   60    0    0   65
 [6,]   62  108   98   68
 [7,]   64  111  101   71
 [8,]    0    0    0    0
 [9,]   68    0    0   77
[10,]    0    0    0    0

Answer 2

最简单的方法可能是使用稀疏矩阵。

library(Matrix)
M1 <- Matrix(mat1,sparse=TRUE)
M2 <- Matrix(mat2,sparse=TRUE)
ans <- M1 %*% M2
ans
10 x 4 sparse Matrix of class "dgCMatrix"

 [1,] 52  NA  83 53
 [2,] NA  NA  NA NA
 [3,] NA  NA  NA NA
 [4,] 58 102  92 62
 [5,] 60  NA  NA 65
 [6,] 62 108  98 68
 [7,] 64 111 101 71
 [8,] NA  NA  NA NA
 [9,] 68  NA  NA 77
[10,] NA  NA  NA NA

如果您愿意，可以用0替换NA：

ans[is.na(ans)] <- 0
Matrix(ans,sparse = F)

 10 x 4 Matrix of class "dgeMatrix"
      [,1] [,2] [,3] [,4]
 [1,]   52    0   83   53
 [2,]    0    0    0    0
 [3,]    0    0    0    0
 [4,]   58  102   92   62
 [5,]   60    0    0   65
 [6,]   62  108   98   68
 [7,]   64  111  101   71
 [8,]    0    0    0    0
 [9,]   68    0    0   77
[10,]    0    0    0    0

矩阵乘法的特例

2 个答案: