Skip to content

Instantly share code, notes, and snippets.

@kaneplusplus
Last active December 20, 2015 03:59
Show Gist options
  • Save kaneplusplus/6067445 to your computer and use it in GitHub Desktop.
Save kaneplusplus/6067445 to your computer and use it in GitHub Desktop.
A parallel, block-matrix multiply for dense and sparse R matrices.
require(foreach)
require(itertools)
# block matrix multiplication
bmm <- function(x, y, chunkSize=max(1, floor(nrow(x)/6)), verbose=FALSE,
writeBlock=FALSE, returnResult=TRUE, filePrefix="block.", writeDir="",
projectionBlocks=FALSE) {
if (ncol(x) != nrow(y))
stop("Non-conformable matrices")
if (verbose) {
cat(ceiling(nrow(x)/chunkSize)^2, "block computations to perform.\n")
}
foreach(i=isplitVector(1:nrow(x), chunkSize=chunkSize), ic=icount(),
.combine=rbind) %do% {
ret <- foreach (j=isplitVector(1:ncol(y), chunkSize=chunkSize),
jc=icount(), .combine=cbind ) %dopar% {
if (projectionBlocks) {
blockMult <- foreach(k=isplitVector(1:ncol(x), chunkSize=chunkSize),
.combine="+") %do% {
x[i,k, drop=FALSE] %*% y[k,j, drop=FALSE]
}
} else {
blockMult <- x[i,, drop=FALSE] %*% y[,j,drop=FALSE]
}
if (writeBlock) {
saveRDS(blockMult,
paste(writeDir, filePrefix, ic, ".", jc, ".rds", sep=""))
}
if (!returnResult)
blockMult <- 1
}
ret
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment