有效地索引矩阵并使包 CoopGame 占用更少的内存

Efficiently indexing matrix and making package CoopGame less memory intensive

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

更具体地说: 我正在使用 R 包 CoopGame::createBitMatrix 中的函数。此函数 returns 具有 n+1 列和 2^(n - 1) 行的矩阵。矩阵中包含的元素为 0 或 1(有关详细信息,请参见下文[1])。

createBitMatrix 所需的唯一参数是 n,在我的情况下它非常高 (n = 27),结果 R 运行s 内存不足。

这是 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) 行的位矩阵,其中包含所有可能的联盟(除了空联盟)所有玩家。

经过反复试验,我通过使用稀疏矩阵和并行处理找到了这个解决方案。它允许以相对快速的方式处理非常大的 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) 

}