高效地建立索引矩阵并使包CoopGame的内存占用减少

如何解决高效地建立索引矩阵并使包CoopGame的内存占用减少

简而言之：索引非常大的矩阵时，我的内存不足。我正在尝试通过使用稀疏矩阵和更有效的索引方法来解决该问题。

更具体地说：我正在使用R包CoopGame :: createBitMatrix中的函数。此函数返回具有n + 1列和2 ^（n-1）行的矩阵。矩阵中包含的元素为0或1（请参阅下面的更多详细信息[1]）。

createBitMatrix所需的唯一参数是n，在我的情况下，该参数很高（n = 27），结果R内存不足。

这是createBitMatrix的工作方式（我正在从函数的代码中复制粘贴）。观察到我将n减小到10，以便更快地复制代码。

n = 10
N = 2^n - 1
bm <- matrix(rep(0,N * n),nrow = N,ncol = n,byrow = TRUE)
rownum <- 1
for (i in 1:n) {
    combo <- utils::combn(n,i)
    for (j in 1:ncol(combo)) {
        for (k in 1:nrow(combo)) {
            bm[rownum,combo[k,j]] <- 1
        }
        rownum <- rownum + 1
    }
}

为了使此操作更有效，我编写了以下代码，以使用较少的内存复制createBitMatrix返回的输出。

在此代码中，我利用可以将矩阵索引为向量的事实来减少所需循环的数量。另外，我利用稀疏矩阵。

library(Matrix)
bm2 <- sparseMatrix(i={},j={},dims=list(N,n))
rownum <- 1
ind_i <- c()
for (i in 1:n) {
    combo <- utils::combn(n,i)
    ind_j <- c()
    for (j in 1:ncol(combo)) {
        y <- combo[,j]
        ind <- rownum + nrow(bm) * (y - 1)
        ind_j <- c(ind_j,ind)
        rownum <- rownum + 1
    }
    ind_i <- c(ind_i,ind_j)
    print(n - i)
}
bm2[ind_i] <- TRUE

这两个矩阵是相同的（即TRUE和FALSE值在bm和bm2中的定位完全相同）。但是我的代码非常慢，当我将n设置为27时，我什至无法判断R是否最终会耗尽内存（我不得不在一段时间后停止代码）。

我正在努力了解是否有可能进一步减少循环次数并减少计算时间。

任何建议将不胜感激。

[1]从帮助页面：createBitMatrix创建一个具有（numberOfPlayers + 1）列和（2 ^ numberOfPlayers-1）行的位矩阵，其中包含所有玩家集合的所有可能联盟（除了null联盟之外）

解决方法

经过反复试验，我通过使用稀疏矩阵和并行处理找到了该解决方案。它允许以相对较快的方式处理非常大的n。结果等于CoopGame :: createBitMatrix提供的结果。

createBitMatrix_parallel(n,cl = 2) {

require(parallel)
require(doParallel)
require(progressr)
require(foreach)
require(Matrix)
require(purrr)

cl <- makeCluster(cl)
doParallel::registerDoParallel(cl)
iterations <- n
progressr::with_progress({
    p <- progressr::progressor(along = iterations)
   
    bm <- foreach(i = 1:iterations,.packages = c("Matrix")) %dopar%
        {
            combo <- combn(n,i)
            ncol_combo <- ncol(combo)
            nrow_combo <- nrow(combo)
            is <- rep(1:ncol_combo,each = nrow_combo)
            res <- sparseMatrix(i={is},j={combo},dims=list(ncol_combo,n))
            return(res)
        }
})

bm <- do.call("rbind",bm)
return(bm) 

}