SCM

SCM Repository

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

Diff of /pkg/R/sparseMatrix.R

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

revision 1664, Fri Nov 3 13:38:32 2006 UTC revision 1665, Fri Nov 3 23:18:07 2006 UTC
# Line 169  Line 169 
169                           i = "index", j = "index", drop = "logical"),                           i = "index", j = "index", drop = "logical"),
170            function (x, i, j, drop) {            function (x, i, j, drop) {
171                cl <- class(x)                cl <- class(x)
172                viaCl <- paste(.M.kind(x,cl), "gTMatrix", sep='')                ## be smart to keep symmetric indexing of <symm.Mat.> symmetric:
173                  doSym <- (extends(cl, "symmetricMatrix") &&
174                            length(i) == length(j) && all(i == j))
175                  viaCl <- paste(.M.kind(x,cl),
176                                 if(doSym) "sTMatrix" else "gTMatrix", sep='')
177                x <- callGeneric(x = as(x, viaCl), i=i, j=j, drop=drop)                x <- callGeneric(x = as(x, viaCl), i=i, j=j, drop=drop)
178                ## try_as(x, c(cl, sub("T","C", viaCl)))                ## try_as(x, c(cl, sub("T","C", viaCl)))
179                if(is(x, "Matrix") && extends(cl, "CsparseMatrix"))                if(is(x, "Matrix") && extends(cl, "CsparseMatrix"))
# Line 204  Line 208 
208  ##                  })  ##                  })
209    
210    
211    ## "Arith" short cuts / exceptions
212  setMethod("-", signature(e1 = "sparseMatrix", e2 = "missing"),  setMethod("-", signature(e1 = "sparseMatrix", e2 = "missing"),
213            function(e1) { e1@x <- -e1@x ; e1 })            function(e1) { e1@x <- -e1@x ; e1 })
214  ## with the following exceptions:  ## with the following exceptions:
# Line 233  Line 237 
237            signature(x = "sparseMatrix"),            signature(x = "sparseMatrix"),
238            function(x) callGeneric(as(x, "CsparseMatrix")))            function(x) callGeneric(as(x, "CsparseMatrix")))
239    
240    setMethod("Compare", signature(e1 = "sparseMatrix", e2 = "sparseMatrix"),
241              function(e1, e2) {
242                  d <- dimCheck(e1,e2)
243    
244                  ## NB non-diagonalMatrix := Union{ general, symmetric, triangular}
245                  gen1 <- is(e1, "generalMatrix")
246                  gen2 <- is(e2, "generalMatrix")
247                  sym1 <- !gen1 && is(e1, "symmetricMatrix")
248                  sym2 <- !gen2 && is(e2, "symmetricMatrix")
249                  tri1 <- !gen1 && !sym1
250                  tri2 <- !gen2 && !sym2
251    
252                  if((G <- gen1 && gen2) ||
253                     (S <- sym1 && sym2 && e1@uplo == e2@uplo) ||
254                     (T <- tri1 && tri2 && e1@uplo == e2@uplo)) {
255    
256                      if(T && e1@diag != e2@diag) {
257                          ## one is "U" the other "N"
258                          if(e1@diag == "U")
259                              e1 <- diagU2N(e1)
260                          else ## (e2@diag == "U"
261                              e2 <- diagU2N(e2)
262                      }
263    
264                  }
265                  else { ## coerce to generalMatrix and go
266                      if(!gen1) e1 <- as(e1, "generalMatrix", strict = FALSE)
267                      if(!gen2) e2 <- as(e2, "generalMatrix", strict = FALSE)
268                  }
269    
270                  ## now the 'x' slots *should* match
271    
272                  new(class2(class(e1), "l"),
273                      x = callGeneric(e1@x, e2@x),
274                      Dim = d, Dimnames = dimnames(e1))
275              })
276    
277  ### --- show() method ---  ### --- show() method ---
278    

Legend:
Removed from v.1664  
changed lines
  Added in v.1665

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