# SCM Repository

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

# Diff of /pkg/R/sparseMatrix.R

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]
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: