--- pkg/R/ddenseMatrix.R 2006/09/18 14:47:40 1575 +++ pkg/R/ddenseMatrix.R 2006/12/21 08:03:05 1707 @@ -32,8 +32,14 @@ function(from) .Call(dense_to_Csparse, from)) setAs("matrix", "CsparseMatrix", - function(from) - .Call(dense_to_Csparse, .Call(dup_mMatrix_as_dgeMatrix, from))) + function(from) { + if(is.numeric(from)) + .Call(dense_to_Csparse, .Call(dup_mMatrix_as_dgeMatrix, from)) + else if(is.logical(from)) ## FIXME: this works, but maybe wastefully + as(Matrix(from, sparse=TRUE), "CsparseMatrix") + else stop('not-yet-implemented coercion to "CsparseMatrix"') + }) + ## special case needed in the Matrix function setAs("matrix", "dgCMatrix", @@ -97,6 +103,8 @@ setMethod("lu", signature(x = "ddenseMatrix"), function(x, ...) callGeneric(as(x, "dgeMatrix"))) +setMethod("chol", signature(x = "ddenseMatrix", pivot = "ANY"), cholMat) + setMethod("determinant", signature(x = "ddenseMatrix", logarithm = "missing"), function(x, logarithm, ...) callGeneric(as(x, "dgeMatrix"))) @@ -133,109 +141,7 @@ function(x) callGeneric(as(x, "dgeMatrix"))) - -### for R 2.2.x (and later): -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- - -### cbind2 -setMethod("cbind2", signature(x = "ddenseMatrix", y = "numeric"), - function(x, y) { - d <- dim(x); nr <- d[1]; nc <- d[2] - y <- rep(y, length.out = nr) # 'silent procrustes' - ## beware of (packed) triangular, symmetric, ... - x <- as(x, "dgeMatrix") - x@x <- c(x@x, as.double(y)) - x@Dim[2] <- nc + 1:1 - if(is.character(dn <- x@Dimnames[[2]])) - x@Dimnames[[2]] <- c(dn, "") - x - }) -## the same, (x,y) <-> (y,x): -setMethod("cbind2", signature(x = "numeric", y = "ddenseMatrix"), - function(x, y) { - d <- dim(y); nr <- d[1]; nc <- d[2] - x <- rep(x, length.out = nr) - y <- as(y, "dgeMatrix") - y@x <- c(as.double(x), y@x) - y@Dim[2] <- nc + 1:1 - if(is.character(dn <- y@Dimnames[[2]])) - y@Dimnames[[2]] <- c("", dn) - y - }) - -setMethod("cbind2", signature(x = "ddenseMatrix", y = "matrix"), - function(x, y) callGeneric(x, as(y, "dgeMatrix"))) -setMethod("cbind2", signature(x = "matrix", y = "ddenseMatrix"), - function(x, y) callGeneric(as(x, "dgeMatrix"), y)) - -setMethod("cbind2", signature(x = "ddenseMatrix", y = "ddenseMatrix"), - function(x, y) { - nr <- rowCheck(x,y) - ncx <- x@Dim[2] - ncy <- y@Dim[2] - ## beware of (packed) triangular, symmetric, ... - hasDN <- !is.null(dnx <- dimnames(x)) | - !is.null(dny <- dimnames(y)) - x <- as(x, "dgeMatrix") - y <- as(y, "dgeMatrix") - x@x <- c(x@x, y@x) - x@Dim[2] <- ncx + ncy - if(hasDN) { - ## R and S+ are different in which names they take - ## if they differ -- but there's no warning in any case - rn <- if(!is.null(dnx[[1]])) dnx[[1]] else dny[[1]] - cx <- dnx[[2]] ; cy <- dny[[2]] - cn <- if(is.null(cx) && is.null(cy)) NULL - else c(if(!is.null(cx)) cx else rep.int("", ncx), - if(!is.null(cy)) cy else rep.int("", ncy)) - x@Dimnames <- list(rn, cn) - } - x - }) - -### rbind2 -- analogous to cbind2 --- more to do for @x though: - -setMethod("rbind2", signature(x = "ddenseMatrix", y = "numeric"), - function(x, y) { - if(is.character(dn <- x@Dimnames[[1]])) dn <- c(dn, "") - new("dgeMatrix", Dim = x@Dim + 1:0, - Dimnames = list(dn, x@Dimnames[[2]]), - x = c(rbind2(as(x,"matrix"), y))) - }) -## the same, (x,y) <-> (y,x): -setMethod("rbind2", signature(x = "numeric", y = "ddenseMatrix"), - function(x, y) { - if(is.character(dn <- y@Dimnames[[1]])) dn <- c("", dn) - new("dgeMatrix", Dim = y@Dim + 1:0, - Dimnames = list(dn, y@Dimnames[[2]]), - x = c(rbind2(x, as(y,"matrix")))) - }) - -setMethod("rbind2", signature(x = "ddenseMatrix", y = "matrix"), - function(x, y) callGeneric(x, as(y, "dgeMatrix"))) -setMethod("rbind2", signature(x = "matrix", y = "ddenseMatrix"), - function(x, y) callGeneric(as(x, "dgeMatrix"), y)) - -setMethod("rbind2", signature(x = "ddenseMatrix", y = "ddenseMatrix"), - function(x, y) { - nc <- colCheck(x,y) - nrx <- x@Dim[1] - nry <- y@Dim[1] - dn <- - if(!is.null(dnx <- dimnames(x)) | - !is.null(dny <- dimnames(y))) { - ## R and S+ are different in which names they take - ## if they differ -- but there's no warning in any case - list(if(is.null(rx <- dnx[[1]]) && is.null(ry <- dny[[1]])) - NULL else - c(if(!is.null(rx)) rx else rep.int("", nrx), - if(!is.null(ry)) ry else rep.int("", nry)), - if(!is.null(dnx[[2]])) dnx[[2]] else dny[[2]]) - - } else list(NULL, NULL) - ## beware of (packed) triangular, symmetric, ... - new("dgeMatrix", Dim = c(nrx + nry, nc), Dimnames = dn, - x = c(rbind2(as(x,"matrix"), as(y,"matrix")))) - }) +## "cbind2" / "rbind2" --> moved to ./denseMatrix.R ### FIXME: band() et al should be extended from "ddense" to "dense" ! ### However, needs much work to generalize dup_mMatrix_as_dgeMatrix()