SCM

SCM Repository

[matrix] Diff of /pkg/R/diagMatrix.R
ViewVC logotype

Diff of /pkg/R/diagMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1331, Sat Jul 22 17:59:53 2006 UTC revision 1575, Mon Sep 18 14:47:40 2006 UTC
# Line 16  Line 16 
16          stopifnot(length(x) == n)          stopifnot(length(x) == n)
17          if(is.logical(x))          if(is.logical(x))
18              cl <- "ldiMatrix"              cl <- "ldiMatrix"
19          else {          else if(is.numeric(x)) {
20              cl <- "ddiMatrix"              cl <- "ddiMatrix"
21              x <- as.numeric(x)              x <- as.numeric(x)
22          }          }
23            else if(is.complex(x)) {
24                cl <- "zdiMatrix"  # will not yet work
25            } else stop("'x' has invalid data type")
26          new(cl, Dim = c(n,n), diag = "N", x = x)          new(cl, Dim = c(n,n), diag = "N", x = x)
27      }      }
28  }  }
# Line 29  Line 32 
32            n <- from@Dim[1]            n <- from@Dim[1]
33            i <- seq(length = n)            i <- seq(length = n)
34            x <- from@x            x <- from@x
35            new(if(is.numeric(x)) "dtTMatrix" else "ltTMatrix",            new(paste(.M.kind(from), "tTMatrix", sep=''),
36                diag = from@diag, Dim = from@Dim, Dimnames = from@Dimnames,                diag = from@diag, Dim = from@Dim, Dimnames = from@Dimnames,
37                x = x, i = i, j = i)                x = x, i = i, j = i)
38            })            })
# Line 43  Line 46 
46        })        })
47    
48  setAs("diagonalMatrix", "generalMatrix",  setAs("diagonalMatrix", "generalMatrix",
49        function(from) {        function(from) as(from, paste(.M.kind(from), "geMatrix", sep='')))
           x <- as(from, "matrix")  
           as(x,  
              if(is.logical(x)) "lgeMatrix"  
 ## Not yet:  
 ##              else if(is.complex(x)) "zgeMatrix"  
 ##              else if(is.integer(x)) "igeMatrix"  
              else "dgeMatrix")  
       })  
50    
51  setAs("ddiMatrix", "dgTMatrix",  setAs("ddiMatrix", "dgTMatrix",
52        function(from) {        function(from) {
# Line 67  Line 62 
62  setAs("ldiMatrix", "lgTMatrix",  setAs("ldiMatrix", "lgTMatrix",
63        function(from) {        function(from) {
64            n <- from@Dim[1]            n <- from@Dim[1]
65            i <- (if(from@diag == "U") seq(length = n) else which(from@x)) - 1:1            if(from@diag == "U") { # unit-diagonal
66            new("lgTMatrix", i = i, j = i,                x <- rep.int(TRUE, n)
67                  i <- seq(length = n)
68              } else { # "normal"
69                  nz <- nz.NA(from@x, na. = TRUE)
70                  x <- from@x[nz]
71                  i <- which(nz) - 1:1
72              }
73              new("lgTMatrix", i = i, j = i, x = x,
74                Dim = c(n,n), Dimnames = from@Dimnames) })                Dim = c(n,n), Dimnames = from@Dimnames) })
75    
76  setAs("ldiMatrix", "lgCMatrix",  setAs("ldiMatrix", "lgCMatrix",
# Line 78  Line 80 
80        function(from)        function(from)
81            as(from, if(is(from, "dMatrix")) "dgCMatrix" else "lgCMatrix"))            as(from, if(is(from, "dMatrix")) "dgCMatrix" else "lgCMatrix"))
82    
83    if(FALSE) # now have faster  "ddense" -> "dge"
84  setAs("ddiMatrix", "dgeMatrix",  setAs("ddiMatrix", "dgeMatrix",
85        function(from) as(as(from, "matrix"), "dgeMatrix"))        function(from) as(as(from, "matrix"), "dgeMatrix"))
86    
# Line 95  Line 98 
98                cl <- "ddiMatrix"                cl <- "ddiMatrix"
99                uni <- all(x == 1)                uni <- all(x == 1)
100                storage.mode(x) <- "double"                storage.mode(x) <- "double"
101            }            } ## TODO: complex
102            new(cl, Dim = c(n,n), diag = if(uni) "U" else "N",            new(cl, Dim = c(n,n), diag = if(uni) "U" else "N",
103                x = if(uni) x[FALSE] else x)                x = if(uni) x[FALSE] else x)
104        })        })

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

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge