SCM

SCM Repository

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

Diff of /pkg/R/Rsparse.R

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

revision 1750, Mon Jan 29 21:10:53 2007 UTC revision 1751, Tue Jan 30 17:41:02 2007 UTC
# Line 7  Line 7 
7    
8  ### contains = "dMatrix"  ### contains = "dMatrix"
9    
10  setAs("RsparseMatrix", "TsparseMatrix",  .R.2.T <- function(from) .Call(compressed_to_TMatrix, from, FALSE)
11        function(from) .Call(compressed_to_TMatrix, from, FALSE))  .R.2.C <- function(from) .Call(R_to_CMatrix, from)
12    
13  setAs("RsparseMatrix", "CsparseMatrix",  setAs("RsparseMatrix", "TsparseMatrix", .R.2.T)
14        function(from) .Call(R_to_CMatrix, from))  setAs("RsparseMatrix", "CsparseMatrix", .R.2.C)
15    ## for printing etc:
16    setAs("RsparseMatrix", "dgeMatrix",
17          function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "dgeMatrix"))
18    setAs("RsparseMatrix", "matrix",
19          function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "matrix"))
20    
21    setAs("RsparseMatrix", "dsparseMatrix",
22          function(from) as(.Call(R_to_CMatrix, from), "dsparseMatrix"))
23    setAs("RsparseMatrix", "lsparseMatrix",
24          function(from) as(.Call(R_to_CMatrix, from), "lsparseMatrix"))
25    setAs("RsparseMatrix", "nsparseMatrix",
26          function(from) as(.Call(R_to_CMatrix, from), "nsparseMatrix"))
27    
28    setAs("RsparseMatrix", "dMatrix",
29          function(from) as(.Call(R_to_CMatrix, from), "dMatrix"))
30    setAs("RsparseMatrix", "lMatrix",
31          function(from) as(.Call(R_to_CMatrix, from), "lMatrix"))
32    setAs("RsparseMatrix", "nMatrix",
33          function(from) as(.Call(R_to_CMatrix, from), "nMatrix"))
34    
35  ##--- and all these are just "the essential low-level coercions" : ----------  ##--- and all these are just "the essential low-level coercions" : ----------
36    
37  setAs("dgRMatrix", "matrix",  ## setAs("dgRMatrix", "matrix",
38        function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "matrix"))  ##       function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "matrix"))
39  setAs("lgRMatrix", "matrix",  ## setAs("lgRMatrix", "matrix",
40        function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "matrix"))  ##       function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "matrix"))
41  setAs("ngRMatrix", "matrix",  ## setAs("ngRMatrix", "matrix",
42        function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "matrix"))  ##       function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "matrix"))
43    
44  setAs("dgRMatrix", "dgeMatrix",  setAs("dgRMatrix", "dgeMatrix",
45        function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "dgeMatrix"))        function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "dgeMatrix"))
# Line 29  Line 48 
48  setAs("ngRMatrix", "ngeMatrix",  setAs("ngRMatrix", "ngeMatrix",
49        function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "ngeMatrix"))        function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "ngeMatrix"))
50    
51  setAs("dgRMatrix", "dgCMatrix",  setAs("dgRMatrix", "dgCMatrix", .R.2.C)
52        function(from) .Call(R_to_CMatrix, from))  setAs("lgRMatrix", "lgCMatrix", .R.2.C)
53  setAs("lgRMatrix", "lgCMatrix",  setAs("ngRMatrix", "ngCMatrix", .R.2.C)
       function(from) .Call(R_to_CMatrix, from))  
 setAs("ngRMatrix", "ngCMatrix",  
       function(from) .Call(R_to_CMatrix, from))  
54  ## really needed? :  ## really needed? :
55  setAs("dgRMatrix", "CsparseMatrix", function(from) as(from, "dgCMatrix"))  setAs("dgRMatrix", "CsparseMatrix", function(from) as(from, "dgCMatrix"))
56    
57    
58  setAs("dgRMatrix", "dgTMatrix",  setAs("dgRMatrix", "dgTMatrix", .R.2.T)
59        function(from) .Call(compressed_to_TMatrix, from, FALSE))  setAs("lgRMatrix", "lgTMatrix", .R.2.T)
60  setAs("lgRMatrix", "lgTMatrix",  setAs("ngRMatrix", "ngTMatrix", .R.2.T)
61        function(from) .Call(compressed_to_TMatrix, from, FALSE))  
62  setAs("ngRMatrix", "ngTMatrix",  ##=== Now the same stories for the "s" (symmetric) and "t" (triangular) ones ===
63        function(from) .Call(compressed_to_TMatrix, from, FALSE))  
64    setAs("dsRMatrix", "dsCMatrix", .R.2.C)
65    setAs("lsRMatrix", "lsCMatrix", .R.2.C)
66    setAs("nsRMatrix", "nsCMatrix", .R.2.C)
67    
68    setAs("dsRMatrix", "dsTMatrix", .R.2.T)
69    setAs("lsRMatrix", "lsTMatrix", .R.2.T)
70    setAs("nsRMatrix", "nsTMatrix", .R.2.T)
71    
72  setAs("dsRMatrix", "dsyMatrix",  setAs("dsRMatrix", "dsyMatrix",
73        function(from) .Call(compressed_to_TMatrix, from, FALSE))        function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "dsyMatrix"))
74  setAs("lsRMatrix", "lsyMatrix",  setAs("lsRMatrix", "lsyMatrix",
75        function(from) .Call(compressed_to_TMatrix, from, FALSE))        function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "lsyMatrix"))
76  setAs("nsRMatrix", "nsyMatrix",  setAs("nsRMatrix", "nsyMatrix",
77        function(from) .Call(compressed_to_TMatrix, from, FALSE))        function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "nsyMatrix"))
78    
79    setAs("dtRMatrix", "dtCMatrix", .R.2.C)
80    setAs("ltRMatrix", "ltCMatrix", .R.2.C)
81    setAs("ntRMatrix", "ntCMatrix", .R.2.C)
82    
83    setAs("dtRMatrix", "dtTMatrix", .R.2.T)
84    setAs("ltRMatrix", "ltTMatrix", .R.2.T)
85    setAs("ntRMatrix", "ntTMatrix", .R.2.T)
86    
87  setAs("dtRMatrix", "dtrMatrix",  setAs("dtRMatrix", "dtrMatrix",
88        function(from) .Call(compressed_to_TMatrix, from, FALSE))        function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "dtrMatrix"))
89  setAs("ltRMatrix", "ltrMatrix",  setAs("ltRMatrix", "ltrMatrix",
90        function(from) .Call(compressed_to_TMatrix, from, FALSE))        function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "ltrMatrix"))
91  setAs("ntRMatrix", "ntrMatrix",  setAs("ntRMatrix", "ntrMatrix",
92        function(from) .Call(compressed_to_TMatrix, from, FALSE))        function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "ntrMatrix"))
93    
94  ##setAs("matrix", "dgRMatrix",  ##setAs("matrix", "dgRMatrix",
95  ##      function(from) {  ##      function(from) {
# Line 67  Line 98 
98  ##      })  ##      })
99    
100  ## **VERY** cheap substitutes:  work via dgC and t(.)  ## **VERY** cheap substitutes:  work via dgC and t(.)
101  .to.dgR <- function(from) {  .viaC.to.dgR <- function(from) {
102      m <- as(t(from), "dgCMatrix")      m <- as(t(from), "dgCMatrix")
103      new("dgRMatrix", Dim = dim(from), Dimnames = .M.DN(from),      new("dgRMatrix", Dim = dim(from), Dimnames = .M.DN(from),
104          p = m@p, j = m@i, x = m@x)          p = m@p, j = m@i, x = m@x)
105  }  }
106    
107  setAs("matrix",    "dgRMatrix", .to.dgR)  setAs("matrix",    "dgRMatrix", .viaC.to.dgR)
108  setAs("dgeMatrix", "dgRMatrix", .to.dgR)  setAs("dgeMatrix", "dgRMatrix", .viaC.to.dgR)
109  setAs("dgCMatrix", "dgRMatrix", .to.dgR)  setAs("dgCMatrix", "dgRMatrix", .viaC.to.dgR)
110  setAs("dgTMatrix", "dgRMatrix", .to.dgR)  setAs("dgTMatrix", "dgRMatrix", .viaC.to.dgR)
111    
112    ## symmetric: can use same 'p' slot
113  setAs("dsCMatrix", "dsRMatrix",  setAs("dsCMatrix", "dsRMatrix",
114        function(from) new("dsRMatrix", Dim = dim(from), Dimnames = .M.DN(from),        function(from) new("dsRMatrix", Dim = dim(from), Dimnames = .M.DN(from),
115                p = from@p, j = from@i, x = from@x,                p = from@p, j = from@i, x = from@x,
116                uplo = if (from@uplo == "U") "L" else "U"))                uplo = if (from@uplo == "U") "L" else "U"))
117    
118  setAs("dtCMatrix", "dtRMatrix",  setAs("dtCMatrix", "dtRMatrix", .viaC.to.dgR) # should work; can NOT use 'p'
       function(from) new("dtRMatrix", Dim = dim(from), Dimnames = .M.DN(from),  
               p = from@p, j = from@i, x = from@x, diag = from@diag,  
               uplo = if (from@uplo == "U") "L" else "U"))  
119    
120    
121  ##setAs("dgRMatrix", "dgeMatrix",  ##setAs("dgRMatrix", "dgeMatrix",
# Line 116  Line 145 
145                callGeneric()                callGeneric()
146            })            })
147    
148  setMethod("t", "RsparseMatrix",  setMethod("t", "RsparseMatrix", function(x) as_Rsparse(t(.R.2.T(x))))
           function(x) as_Rsparse(t(as_Tsparse(x))))  
149    
150    
151  ## Want tril(), triu(), band() --- just as "indexing" ---  ## Want tril(), triu(), band() --- just as "indexing" ---
152  ## return a "close" class:  ## return a "close" class:
153  setMethod("tril", "RsparseMatrix",  setMethod("tril", "RsparseMatrix",
154            function(x, k = 0, ...) as_Rsparse(tril(as_Csparse(x), k = k, ...)))            function(x, k = 0, ...) as_Rsparse(tril(.R.2.C(x), k = k, ...)))
155  setMethod("triu", "RsparseMatrix",  setMethod("triu", "RsparseMatrix",
156            function(x, k = 0, ...) as_Rsparse(triu(as_Csparse(x), k = k, ...)))            function(x, k = 0, ...) as_Rsparse(triu(.R.2.C(x), k = k, ...)))
157  setMethod("band", "RsparseMatrix",  setMethod("band", "RsparseMatrix",
158            function(x, k1, k2, ...)            function(x, k1, k2, ...)
159            as_Rsparse(band(as_Csparse(x), k1 = k1, k2 = k2, ...)))            as_Rsparse(band(.R.2.C(x), k1 = k1, k2 = k2, ...)))

Legend:
Removed from v.1750  
changed lines
  Added in v.1751

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