# SCM Repository

[matrix] Diff of /pkg/Matrix/R/diagMatrix.R
 [matrix] / pkg / Matrix / R / diagMatrix.R

# Diff of /pkg/Matrix/R/diagMatrix.R

revision 1832, Tue May 1 10:18:27 2007 UTC revision 1845, Wed May 16 21:24:41 2007 UTC
# Line 43  Line 43
43      ## make sure we had all matrices:      ## make sure we had all matrices:
44      if(!(is.matrix(dims) && nrow(dims) == 2))      if(!(is.matrix(dims) && nrow(dims) == 2))
45          stop("some arguments are not matrices")          stop("some arguments are not matrices")
46      csdim <- rbind(rep.int(0:0, 2),      csdim <- rbind(rep.int(0L, 2),
47                     apply(sapply(mlist, dim), 1, cumsum))                     apply(sapply(mlist, dim), 1, cumsum))
48      ret <- new("dgTMatrix", Dim = as.integer(csdim[nrow(csdim),]))      ret <- new("dgTMatrix", Dim = as.integer(csdim[nrow(csdim),]))
# Line 58  Line 58
58      as(ret, "CsparseMatrix")      as(ret, "CsparseMatrix")
59  }  }
60
61  diag2T <- function(from) {  diag2tT <- function(from) {
62      i <- if(from@diag == "U") integer(0) else seq_len(from@Dim[1]) - 1:1      i <- if(from@diag == "U") integer(0) else seq_len(from@Dim[1]) - 1L
63      new(paste(.M.kind(from), "tTMatrix", sep=''),      new(paste(.M.kind(from), "tTMatrix", sep=''),
64          diag = from@diag, Dim = from@Dim, Dimnames = from@Dimnames,          diag = from@diag, Dim = from@Dim, Dimnames = from@Dimnames,
65          x = from@x, # <- ok for diag = "U" and "N" (!)          x = from@x, # <- ok for diag = "U" and "N" (!)
66          i = i, j = i)          i = i, j = i)
67  }  }
68
69  setAs("diagonalMatrix", "triangularMatrix", diag2T)  diag2sT <- function(from) { # to symmetric Tsparse
70  setAs("diagonalMatrix", "sparseMatrix", diag2T)      i <- if(from@diag == "U") integer(0) else seq_len(from@Dim[1]) - 1L
71        new(paste(.M.kind(from), "sTMatrix", sep=''),
72            Dim = from@Dim, Dimnames = from@Dimnames,
73            x = from@x, i = i, j = i)
74    }
75
76    setAs("diagonalMatrix", "triangularMatrix", diag2tT)
77    setAs("diagonalMatrix", "sparseMatrix", diag2tT)
78  ## needed too (otherwise <dense> -> Tsparse is taken):  ## needed too (otherwise <dense> -> Tsparse is taken):
79  setAs("diagonalMatrix", "TsparseMatrix", diag2T)  setAs("diagonalMatrix", "TsparseMatrix", diag2tT)
80  ## is better than this:  ## is better than this:
81  ## setAs("diagonalMatrix", "sparseMatrix",  ## setAs("diagonalMatrix", "sparseMatrix",
82  ##       function(from)  ##       function(from)
83  ##        as(from, if(is(from, "dMatrix")) "dgCMatrix" else "lgCMatrix"))  ##        as(from, if(is(from, "dMatrix")) "dgCMatrix" else "lgCMatrix"))
84  setAs("diagonalMatrix", "CsparseMatrix",  setAs("diagonalMatrix", "CsparseMatrix",
85        function(from) as(diag2T(from), "CsparseMatrix"))        function(from) as(diag2tT(from), "CsparseMatrix"))
86
87    setAs("diagonalMatrix", "symmetricMatrix", diag2sT)
88
89  setAs("diagonalMatrix", "matrix",  setAs("diagonalMatrix", "matrix",
90        function(from) {        function(from) {
# Line 106  Line 115
115        function(from) {        function(from) {
116            .Deprecated("as(, \"sparseMatrix\")")            .Deprecated("as(, \"sparseMatrix\")")
117            n <- from@Dim[1]            n <- from@Dim[1]
118            i <- seq_len(n) - 1:1            i <- seq_len(n) - 1L
119            new("dgTMatrix", i = i, j = i, x = .diag.x(from),            new("dgTMatrix", i = i, j = i, x = .diag.x(from),
120                Dim = c(n,n), Dimnames = from@Dimnames) })                Dim = c(n,n), Dimnames = from@Dimnames) })
121
# Line 119  Line 128
128            n <- from@Dim[1]            n <- from@Dim[1]
129            if(from@diag == "U") { # unit-diagonal            if(from@diag == "U") { # unit-diagonal
130                x <- rep.int(TRUE, n)                x <- rep.int(TRUE, n)
131                i <- seq_len(n) - 1:1                i <- seq_len(n) - 1L
132            } else { # "normal"            } else { # "normal"
133                nz <- nz.NA(from@x, na. = TRUE)                nz <- nz.NA(from@x, na. = TRUE)
134                x <- from@x[nz]                x <- from@x[nz]
135                i <- which(nz) - 1:1                i <- which(nz) - 1L
136            }            }
137            new("lgTMatrix", i = i, j = i, x = x,            new("lgTMatrix", i = i, j = i, x = x,
138                Dim = c(n,n), Dimnames = from@Dimnames) })                Dim = c(n,n), Dimnames = from@Dimnames) })
# Line 418  Line 427
427  setMethod("Ops", signature(e1 = "diagonalMatrix", e2 = "ddiMatrix"),  setMethod("Ops", signature(e1 = "diagonalMatrix", e2 = "ddiMatrix"),
428            diagOdiag)            diagOdiag)
429
430    ## FIXME:    diagonal  o  triangular  |-->  triangular
431    ## -----     diagonal  o  symmetric   |-->  symmetric
432    ##    {also when other is sparse: do these "here" --
433    ##     before conversion to sparse, since that loses "diagonality"}
434
435  ## For almost everything else, diag* shall be treated "as sparse" :  ## For almost everything else, diag* shall be treated "as sparse" :
436  ## These are cheap implementations via coercion  ## These are cheap implementations via coercion
437

Legend:
 Removed from v.1832 changed lines Added in v.1845