SCM Repository

[matrix] Diff of /pkg/R/ddenseMatrix.R
 [matrix] / pkg / R / ddenseMatrix.R

Diff of /pkg/R/ddenseMatrix.R

revision 1575, Mon Sep 18 14:47:40 2006 UTC revision 1707, Thu Dec 21 08:03:05 2006 UTC
# Line 32  Line 32
32        function(from) .Call(dense_to_Csparse, from))        function(from) .Call(dense_to_Csparse, from))
33
34  setAs("matrix", "CsparseMatrix",  setAs("matrix", "CsparseMatrix",
35        function(from)        function(from) {
36        .Call(dense_to_Csparse, .Call(dup_mMatrix_as_dgeMatrix, from)))              if(is.numeric(from))
37                    .Call(dense_to_Csparse, .Call(dup_mMatrix_as_dgeMatrix, from))
38                else if(is.logical(from)) ## FIXME: this works, but maybe wastefully
39                    as(Matrix(from, sparse=TRUE), "CsparseMatrix")
40                else stop('not-yet-implemented coercion to "CsparseMatrix"')
41          })
42
43
44  ## special case needed in the Matrix function  ## special case needed in the Matrix function
45  setAs("matrix", "dgCMatrix",  setAs("matrix", "dgCMatrix",
# Line 97  Line 103
103  setMethod("lu", signature(x = "ddenseMatrix"),  setMethod("lu", signature(x = "ddenseMatrix"),
104            function(x, ...) callGeneric(as(x, "dgeMatrix")))            function(x, ...) callGeneric(as(x, "dgeMatrix")))
105
106    setMethod("chol", signature(x = "ddenseMatrix", pivot = "ANY"), cholMat)
107
108  setMethod("determinant", signature(x = "ddenseMatrix", logarithm = "missing"),  setMethod("determinant", signature(x = "ddenseMatrix", logarithm = "missing"),
109            function(x, logarithm, ...) callGeneric(as(x, "dgeMatrix")))            function(x, logarithm, ...) callGeneric(as(x, "dgeMatrix")))
110
# Line 133  Line 141
141            function(x) callGeneric(as(x, "dgeMatrix")))            function(x) callGeneric(as(x, "dgeMatrix")))
142
143
144    ##  "cbind2" / "rbind2" --> moved to  ./denseMatrix.R
### 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"))))
})
145
146  ### FIXME: band() et al should be extended from "ddense" to "dense" !  ### FIXME: band() et al should be extended from "ddense" to "dense" !
147  ###        However, needs much work to generalize dup_mMatrix_as_dgeMatrix()  ###        However, needs much work to generalize dup_mMatrix_as_dgeMatrix()

Legend:
 Removed from v.1575 changed lines Added in v.1707