The R Project SVN
R-packages
(root)/trunk/Matrix/R/dgCMatrix.R – Rev 3684
Rev 3520 | Rev 3755 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed
#### Sparse Matrices in Compressed column-oriented format### contains = "dsparseMatrix", "CsparseMatrix"## Specific conversions, should they be necessary. Better to convert as## as(x, "TsparseMatrix") or as(x, "denseMatrix")## Moved to ./Csparse.R :## setAs("dgCMatrix", "dgTMatrix", ....## setAs("dgCMatrix", "dgeMatrix", ....## setAs("dgeMatrix", "dgCMatrix", ....## Can use method in Csparse.R## setAs("dgCMatrix", "matrix", ....## rather use Csparse* to lsparse* in ./lsparseMatrix.R ,## but this is for "back-compatibility" (have had tests for it..):setAs("dgCMatrix", "lgCMatrix",function(from) .Call(Csparse_to_logical, from,is(from, "triangularMatrix")))##was: function(from) new("lgCMatrix", i = from@i, p = from@p,## Dim = from@Dim, Dimnames = from@Dimnames)## can use method for CsparseMatrix## setMethod("crossprod", signature(x = "dgCMatrix", y = "missing"),## function(x, y = NULL) .Call(csc_crossprod, x),## valueClass = "dsCMatrix")## inherits method for x = "CsparseMatrix", y = "dgeMatrix" from ./Csparse.R## setMethod("crossprod", signature(x = "dgCMatrix", y = "dgeMatrix"),## function(x, y = NULL)## .Call(csc_matrix_crossprod, x, y, TRUE),## valueClass = "dgeMatrix")## can use method for x = "CsparseMatrix" from ./Csparse.R## setMethod("crossprod", signature(x = "dgCMatrix", y = "matrix"),## function(x, y = NULL) {## storage.mode(y) <- "double"## .Call(csc_matrix_crossprod, x, y, FALSE)## }, valueClass = "dgeMatrix")## can use method for x = "CsparseMatrix" from ./Csparse.R##setMethod("crossprod", signature(x = "dgCMatrix", y = "numeric"),## function(x, y = NULL) callGeneric(x, as.matrix(y)),## valueClass = "dgeMatrix")## can use method for y = "numeric" from ./Matrix.R followed by## method for x = "CsparseMatrix" from ./Csparse.R## setMethod("crossprod", signature(x = "dgCMatrix", y = "numeric"),## function(x, y = NULL)## .Call(csc_matrix_crossprod, x, as.matrix(y)))## can use method for x = "CsparseMatrix" from ./Csparse.R## setMethod("tcrossprod", signature(x = "dgCMatrix", y = "missing"),## function(x, y = NULL) .Call(csc_tcrossprod, x))## can use method for x = "CsparseMatrix" from ./Csparse.R## setMethod("diag", signature(x = "dgCMatrix"),## function(x, nrow, ncol = n) .Call(csc_getDiag, x))## try to define for "Matrix" -- once and for all -- but that fails -- why? __ FIXME __## setMethod("dim", signature(x = "dgCMatrix"),## function(x) x@Dim, valueClass = "integer")## can use method for x = "CsparseMatrix" from ./Csparse.R## setMethod("t", signature(x = "dgCMatrix"),## function(x) .Call(csc_transpose, x),## valueClass = "dgCMatrix")setMethod("image", "dgCMatrix",function(x, ...) {x <- as(x, "dgTMatrix")callGeneric()})## inherits from x = "CsparseMatrix", y = "denseMatrix"## setMethod("%*%", signature(x = "dgCMatrix", y = "dgeMatrix"),## function(x, y) .Call(csc_matrix_mm, x, y, TRUE, FALSE),## valueClass = "dgeMatrix")## inherits from x = "CsparseMatrix", y = "matrix"## setMethod("%*%", signature(x = "dgCMatrix", y = "matrix"),## function(x, y) {## storage.mode(y) <- "double"## .Call(csc_matrix_mm, x, y, FALSE, FALSE)## }, valueClass = "dgeMatrix")## Group Methods, see ?Arith (e.g.)## -----setMethod("Arith", ## "+", "-", "*", "^", "%%", "%/%", "/"signature(e1 = "dgCMatrix", e2 = "dgCMatrix"),function(e1, e2) {d <- dimCheck(e1, e2)dn <- dimNamesCheck(e1, e2)ij1 <- non0ind(e1)ij2 <- non0ind(e2)switch(.Generic,"+" = , "-" =## special "T" convention: repeated entries are *summed*as(new("dgTMatrix", Dim = d, Dimnames = dn,i = c(ij1[,1], ij2[,1]),j = c(ij1[,2], ij2[,2]),x = c(callGeneric(e1@x, 0), callGeneric(0,e2@x))),"dgCMatrix"),"*" ={ ## X * 0 == 0 * X == 0 --> keep common non-0ii <- WhichintersectInd(ij1, ij2, nrow=d[1])ij <- ij1[ii[[1]], , drop = FALSE]as(new("dgTMatrix", Dim = d, Dimnames = dn,i = ij[,1],j = ij[,2],x = e1@x[ii[[1]]] * e2@x[ii[[2]]]),"dgCMatrix")},"^" ={ii <- WhichintersectInd(ij1, ij2, nrow=d[1])## 3 cases:## 1) X^0 := 1 (even for X=0) ==> dense## 2) 0^Y := 0 for Y != 0 =====## 3) x^y :## FIXME: dgeM[cbind(i,j)] <- V is not yet possible## nor dgeM[ i_vect ] <- V## r <- as(e2, "dgeMatrix")## ...r <- as(e2, "matrix")Yis0 <- is0(r)r[complementInd(ij1, dim=d)] <- 0 ## 2)r[1:1 + ij2[ii[[2]], , drop=FALSE]] <-e1@x[ii[[1]]] ^ e2@x[ii[[2]]] ## 3)r[Yis0] <- 1 ## 1)as(r, "dgeMatrix")},"%%" = , "%/%" = , "/" = ## 0 op 0 |-> NaN => densecallGeneric(as(e1, "dgeMatrix"), e2))})setMethod("Arith",signature(e1 = "dgCMatrix", e2 = "numeric"),function(e1, e2) {if(length(e2) == 1) { ## e.g., Mat ^ af0 <- callGeneric(0, e2)if(is0(f0)) { # remain sparsee1@x <- callGeneric(e1@x, e2)e1} else { ## non-sparse, since '0 o e2' is not 0## FIXME: dgeMatrix [cbind(i,j)] <- .. is not yet possible## r <- as(e1, "dgeMatrix")## r[] <- f0## r[non0ind(e1)] <- callGeneric(e1@x, e2)r <- as(e1, "matrix")r[] <- f0r[non0ind(e1) + 1:1] <- callGeneric(e1@x, e2)as(r, "dgeMatrix")}} else {## FIXME: maybe far from optimal:warning("coercing sparse to dense matrix for arithmetic")callGeneric(as(e1, "dgeMatrix"), e2)}})setMethod("Arith",signature(e1 = "numeric", e2 = "dgCMatrix"),function(e1, e2) {if(length(e1) == 1) {f0 <- callGeneric(e1, 0)if(is0(f0)) {e2@x <- callGeneric(e1, e2@x)e2} else {## FIXME: dgeMatrix [cbind(i,j)] <- .. is not yet possibler <- as(e2, "matrix")r[] <- f0r[non0ind(e2) + 1:1] <- callGeneric(e1, e2@x)as(r, "dgeMatrix")}} else {## FIXME: maybe far from optimal:warning("coercing sparse to dense matrix for arithmetic")callGeneric(e1, as(e2, "dgeMatrix"))}})## "Math" is up in ./Csparse.R## "Math2" is up in ./dMatrix.R###---- end {Group Methods} -----------------## "[<-" methods { setReplaceMethod()s } are now in ./Csparse.RsetMethod("writeHB", signature(obj = "dgCMatrix"),function(obj, file, ...).Call(Matrix_writeHarwellBoeing, obj, as.character(file), "DGC"))setMethod("writeMM", signature(obj = "dgCMatrix"),function(obj, file, ...).Call(Matrix_writeMatrixMarket, obj, as.character(file), "DGC"))## TODO (in C):## setMethod("colSums", signature(x = "dgCMatrix"),## function(x, na.rm = FALSE, dims = 1)## .Call(dgCMatrix_colsums, x, na.rm, TRUE, FALSE),## valueClass = "numeric")## setMethod("colMeans", signature(x = "dgCMatrix"),## function(x, na.rm = FALSE, dims = 1)## .Call(dgCMatrix_colsums, x, na.rm, TRUE, TRUE),## valueClass = "numeric")setMethod("colSums", signature(x = "dgCMatrix"), .as.dgT.Fun)setMethod("colMeans", signature(x = "dgCMatrix"), .as.dgT.Fun)setMethod("rowSums", signature(x = "dgCMatrix"),function(x, na.rm = FALSE, dims = 1)tapply1(x@x, factor(x@i, 0:(x@Dim[1]-1)), sum, na.rm = na.rm),valueClass = "numeric")setMethod("rowMeans", signature(x = "dgCMatrix"),function(x, na.rm = FALSE, dims = 1)tapply1(x@x, factor(x@i, 0:(x@Dim[1]-1)), mean, na.rm = na.rm),valueClass = "numeric")setMethod("qr", signature(x = "dgCMatrix"),function(x, tol = 1e-07, LAPACK = FALSE).Call(dgCMatrix_QR, x, TRUE))setMethod("lu", signature(x = "dgCMatrix"),function(x, ...) .Call(dgCMatrix_LU, x, TRUE, 1))setMethod("solve", signature(a = "dgCMatrix", b = "matrix"),function(a, b, ...) .Call(dgCMatrix_matrix_solve, a, b),valueClass = "dgeMatrix")setMethod("solve", signature(a = "dgCMatrix", b = "ddenseMatrix"),function(a, b, ...) .Call(dgCMatrix_matrix_solve, a, b),valueClass = "dgeMatrix")