SCM

SCM Repository

[matrix] Diff of /pkg/Matrix/R/dgTMatrix.R
ViewVC logotype

Diff of /pkg/Matrix/R/dgTMatrix.R

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

revision 2944, Thu Dec 19 13:50:47 2013 UTC revision 2945, Thu Dec 19 13:52:00 2013 UTC
# Line 25  Line 25 
25            new("dsCMatrix", Dim = uC@Dim, p = uC@p, i = uC@i, x = uC@x, uplo = "U")            new("dsCMatrix", Dim = uC@Dim, p = uC@p, i = uC@i, x = uC@x, uplo = "U")
26        })        })
27    
 setAs("dgTMatrix", "dsTMatrix",  
       function(from) {  
           if(isSymmetric(from)) {  
               upper <- from@i <= from@j  
               new("dsTMatrix", Dim = from@Dim, Dimnames = from@Dimnames,  
                   i = from@i[upper],  
                   j = from@j[upper], x = from@x[upper], uplo = "U")  
           }  
           else  
               stop("not a symmetric matrix; consider forceSymmetric() or symmpart()")  
       })  
   
28  ## This is faster:  ## This is faster:
29  setAs("dgTMatrix", "dtCMatrix",  setAs("dgTMatrix", "dtCMatrix",
30        function(from) {        function(from) {
# Line 48  Line 36 
36        })        })
37    
38  setAs("dgTMatrix", "dtTMatrix",  setAs("dgTMatrix", "dtTMatrix",
39        function(from) check.gT2tT(from, cl = "dgTMatrix", toClass = "dtTMatrix",        function(from) check.gT2tT(from, toClass = "dtTMatrix", do.n=FALSE))
                                  do.n = FALSE))  
40  setAs("dgTMatrix", "triangularMatrix",  setAs("dgTMatrix", "triangularMatrix",
41        function(from) check.gT2tT(from, cl = "dgTMatrix", toClass = "dtTMatrix",        function(from) check.gT2tT(from, toClass = "dtTMatrix", do.n=FALSE))
42                                   do.n = FALSE))  
43    setAs("dgTMatrix", "dsTMatrix",
44          function(from) check.gT2sT(from, toClass = "dsTMatrix", do.n=FALSE))
45    setAs("dgTMatrix", "symmetricMatrix",
46          function(from) check.gT2sT(from, toClass = "dsTMatrix", do.n=FALSE))
47    
48  mat2dgT <- function(from) {  mat2dgT <- function(from) {
49      x <- as.double(from)      x <- as.double(from)
# Line 124  Line 115 
115                      num.r <- length(col.regions)                      num.r <- length(col.regions)
116                      col.regions <-                      col.regions <-
117                          if (num.r <= numcol)                          if (num.r <= numcol)
118                              rep(col.regions, length = numcol)                              rep_len(col.regions, numcol)
119                          else col.regions[1+ ((1:numcol-1)*(num.r-1)) %/% (numcol-1)]                          else col.regions[1+ ((1:numcol-1)*(num.r-1)) %/% (numcol-1)]
120                      zcol <- rep.int(NA_integer_, length(z))                      zcol <- rep.int(NA_integer_, length(z))
121                      for (i in seq_along(col.regions))                      for (i in seq_along(col.regions))

Legend:
Removed from v.2944  
changed lines
  Added in v.2945

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