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 1704, Fri Dec 15 23:19:41 2006 UTC revision 1705, Sat Dec 16 12:37:25 2006 UTC
# Line 218  Line 218 
218            function(x) callGeneric(as(x, "CsparseMatrix")))            function(x) callGeneric(as(x, "CsparseMatrix")))
219    
220  setMethod("Compare", signature(e1 = "sparseMatrix", e2 = "sparseMatrix"),  setMethod("Compare", signature(e1 = "sparseMatrix", e2 = "sparseMatrix"),
221            function(e1, e2) {            function(e1, e2) callGeneric(as(e1, "CsparseMatrix"),
222                d <- dimCheck(e1,e2)                                         as(e2, "CsparseMatrix")))
223    ##-> ./Csparse.R
               ## NB non-diagonalMatrix := Union{ general, symmetric, triangular}  
               gen1 <- is(e1, "generalMatrix")  
               gen2 <- is(e2, "generalMatrix")  
               sym1 <- !gen1 && is(e1, "symmetricMatrix")  
               sym2 <- !gen2 && is(e2, "symmetricMatrix")  
               tri1 <- !gen1 && !sym1  
               tri2 <- !gen2 && !sym2  
   
               if((G <- gen1 && gen2) ||  
                  (S <- sym1 && sym2 && e1@uplo == e2@uplo) ||  
                  (T <- tri1 && tri2 && e1@uplo == e2@uplo)) {  
   
                   if(T && e1@diag != e2@diag) {  
                       ## one is "U" the other "N"  
                       if(e1@diag == "U")  
                           e1 <- diagU2N(e1)  
                       else ## (e2@diag == "U"  
                           e2 <- diagU2N(e2)  
                   }  
   
               }  
               else { ## coerce to generalMatrix and go  
                   if(!gen1) e1 <- as(e1, "generalMatrix", strict = FALSE)  
                   if(!gen2) e2 <- as(e2, "generalMatrix", strict = FALSE)  
               }  
   
               ## now the 'x' slots *should* match  
   
               new(class2(class(e1), "l"),  
                   x = callGeneric(e1@x, e2@x),  
                   Dim = d, Dimnames = dimnames(e1))  
           })  
224    
225  ### --- show() method ---  ### --- show() method ---
226    
227  ## FIXME(?) -- ``merge this'' (at least ``synchronize'') with  ## FIXME(?) -- ``merge this'' (at least ``synchronize'') with
228  ## - - -   prMatrix() from ./Auxiliaries.R  ## - - -   prMatrix() from ./Auxiliaries.R
229  prSpMatrix <- function(object, digits = getOption("digits"),  prSpMatrix <- function(object, digits = getOption("digits"),
230                         maxp = getOption("max.print"), zero.print = ".")                         maxp = getOption("max.print"), zero.print = ".",
231                           align = c("fancy", "right"))
232    ## FIXME: prTriang() in ./Auxiliaries.R  should also get  align = "fancy"
233  {  {
234      stopifnot(is(object, "sparseMatrix"))      stopifnot(is(object, "sparseMatrix"))
235      d <- dim(object)      d <- dim(object)
# Line 290  Line 260 
260      } else { # non logical      } else { # non logical
261          ## show only "structural" zeros as 'zero.print', not all of them..          ## show only "structural" zeros as 'zero.print', not all of them..
262          ## -> cannot use 'm'          ## -> cannot use 'm'
263          iN0 <- 1:1 + encodeInd(non0ind(object), nr = nrow(x))          d <- dim(x)
264          if(length(iN0)) {          ne <- length(iN0 <- 1:1 + encodeInd(non0ind(object), nr = d[1]))
265              decP <- apply(m, 2, function(x) format.info(x)[2])          if(0 < ne && ne < prod(d)) {
266              x[-iN0] <- zero.print ## FIXME: ``format it'' such that columns align              align <- match.arg(align)
267          }              if(align == "fancy") {
268          else x[] <- zero.print                  fi <- apply(m, 2, format.info) ## fi[3,] == 0  <==> not expo.
269                    ## now 'format' the zero.print by padding it with ' ' on the right:
270                    ## case 1: non-exponent:  fi[2,] + as.logical(fi[2,] > 0)
271                    ## the column numbers of all 'zero' entries -- (*large*)
272                    cols <- 1:1 + (0:(prod(d)-1:1))[-iN0] %/% d[1]
273                    pad <-
274                        ifelse(fi[3,] == 0,
275                               fi[2,] + as.logical(fi[2,] > 0),
276                               ## exponential:
277                               fi[2,] + fi[3,] + 4)
278                    zero.print <- sprintf("%-*s", pad[cols] + 1, zero.print)
279                } ## else "right" : nothing to do
280    
281                x[-iN0] <- zero.print
282            } else if (ne == 0)# all zeroes
283                x[] <- zero.print
284      }      }
285      print(x, quote = FALSE, max = maxp)      ## right = TRUE : cheap attempt to get better "." alignment
286        print(x, quote = FALSE, right = TRUE, max = maxp)
287      invisible(object)      invisible(object)
288  }  }
289    

Legend:
Removed from v.1704  
changed lines
  Added in v.1705

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