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 1946, Wed Jul 4 18:38:25 2007 UTC revision 1947, Thu Jul 5 08:22:00 2007 UTC
# Line 223  Line 223 
223    
224  ## FIXME(?) -- ``merge this'' (at least ``synchronize'') with  ## FIXME(?) -- ``merge this'' (at least ``synchronize'') with
225  ## - - -   prMatrix() from ./Auxiliaries.R  ## - - -   prMatrix() from ./Auxiliaries.R
226  prSpMatrix <- function(x, digits = getOption("digits"),  ## FIXME: prTriang() in ./Auxiliaries.R  should also get  align = "fancy"
227    ## --> help for this is currently (rudimentary) in ../man/sparseMatrix-class.Rd
228    printSpMatrix <- function(x, digits = getOption("digits"),
229                         maxp = getOption("max.print"), zero.print = ".",                         maxp = getOption("max.print"), zero.print = ".",
230                         col.names = FALSE, note.dropping.colnames = TRUE,                         col.names, note.dropping.colnames = TRUE,
231                         col.trailer = '', align = c("fancy", "right"))                         col.trailer = '', align = c("fancy", "right"))
 ## FIXME: prTriang() in ./Auxiliaries.R  should also get  align = "fancy"  
232  {  {
233      cl <- getClassDef(class(x))      cl <- getClassDef(class(x))
234      stopifnot(extends(cl, "sparseMatrix"))      stopifnot(extends(cl, "sparseMatrix"))
# Line 239  Line 240 
240      } else {      } else {
241          m <- as(x, "matrix")          m <- as(x, "matrix")
242      }      }
243        dn <- dimnames(m) ## will be === dimnames(cx)
244      logi <- extends(cl,"lsparseMatrix") || extends(cl,"nsparseMatrix")      logi <- extends(cl,"lsparseMatrix") || extends(cl,"nsparseMatrix")
245      if(logi)      if(logi)
246          cx <- array("N", # or as.character(NA),          cx <- array("N", dim(m), dimnames=dn)
                    dim(m), dimnames=dimnames(m))  
247      else { ## numeric (or --not yet-- complex):      else { ## numeric (or --not yet-- complex):
248          cx <- apply(m, 2, format)          cx <- apply(m, 2, format)
249          if(is.null(dim(cx))) {# e.g. in 1 x 1 case          if(is.null(dim(cx))) {# e.g. in 1 x 1 case
250              dim(cx) <- dim(m)              dim(cx) <- dim(m)
251              dimnames(cx) <- dimnames(m)              dimnames(cx) <- dn
252            }
253          }          }
254        if (missing(col.names))
255            col.names <- {
256                if(!is.null(cc <- getOption("sparse.colnames")))
257                    cc
258                else if(is.null(dn[[2]]))
259                    FALSE
260                else { # has column names == dn[[2]]
261                    ncol(x) < 10
262      }      }
263      if(!col.names)          }
264        if(identical(col.names, FALSE))
265          cx <- emptyColnames(cx, msg.if.not.empty = note.dropping.colnames)          cx <- emptyColnames(cx, msg.if.not.empty = note.dropping.colnames)
266        else if(is.character(col.names)) {
267            stopifnot(length(col.names) == 1)
268            cn <- col.names
269            switch(substr(cn, 1,3),
270                   "abb" = {
271                       iarg <- as.integer(sub("^[^0-9]*", '', cn))
272                       colnames(cx) <- abbreviate(colnames(cx), minlength = iarg)
273                   },
274                   "sub" = {
275                       iarg <- as.integer(sub("^[^0-9]*", '', cn))
276                       colnames(cx) <- substr(colnames(cx), 1, iarg)
277                   },
278                   stop("invalid 'col.names' string: ", cn))
279        }
280        ## else: nothing to do for col.names == TRUE
281      if(is.logical(zero.print))      if(is.logical(zero.print))
282          zero.print <- if(zero.print) "0" else " "          zero.print <- if(zero.print) "0" else " "
283      if(logi) {      if(logi) {
# Line 299  Line 325 
325      invisible(x)      invisible(x)
326  }  }
327    
328  setMethod("print", signature(x = "sparseMatrix"), prSpMatrix)  setMethod("print", signature(x = "sparseMatrix"), printSpMatrix)
329    
330  setMethod("show", signature(object = "sparseMatrix"),  setMethod("show", signature(object = "sparseMatrix"),
331     function(object) {     function(object) {
# Line 308  Line 334 
334         cat(sprintf('%d x %d sparse Matrix of class "%s"\n', d[1], d[2], cl))         cat(sprintf('%d x %d sparse Matrix of class "%s"\n', d[1], d[2], cl))
335         maxp <- getOption("max.print")         maxp <- getOption("max.print")
336         if(prod(d) <= maxp)         if(prod(d) <= maxp)
337             prSpMatrix(object, maxp = maxp)             printSpMatrix(object, maxp = maxp)
338         else { ## d[1] > maxp / d[2] >= nr : -- this needs [,] working:         else { ## d[1] > maxp / d[2] >= nr : -- this needs [,] working:
339    
340             nR <- d[1] # nrow             nR <- d[1] # nrow
# Line 327  Line 353 
353                 if(suppCols)                 if(suppCols)
354                     object <- object[ , 1:nc, drop = FALSE]                     object <- object[ , 1:nc, drop = FALSE]
355                 n2 <- ceiling(nr / 2)                 n2 <- ceiling(nr / 2)
356                 prSpMatrix(object[seq_len(min(nR, max(1, n2))), , drop=FALSE],                 printSpMatrix(object[seq_len(min(nR, max(1, n2))), , drop=FALSE],
357                            col.trailer = col.trailer)                            col.trailer = col.trailer)
358                 cat("\n ..............................",                 cat("\n ..............................",
359                     "\n ..........suppressing rows in show(); maybe adjust 'options(max.print= *)'",                     "\n ..........suppressing rows in show(); maybe adjust 'options(max.print= *)'",
360                     "\n ..............................\n\n", sep='')                     "\n ..............................\n\n", sep='')
361                 ## tail() automagically uses "[..,]" rownames:                 ## tail() automagically uses "[..,]" rownames:
362                 prSpMatrix(tail(object, max(1, nr-n2)),                 printSpMatrix(tail(object, max(1, nr-n2)),
363                            col.trailer = col.trailer)                            col.trailer = col.trailer)
364             }             }
365             else if(suppCols) {             else if(suppCols) {
366                 prSpMatrix(object[ , 1:nc , drop = FALSE],                 printSpMatrix(object[ , 1:nc , drop = FALSE],
367                            col.trailer = col.trailer)                            col.trailer = col.trailer)
368    
369                 cat("\n .....suppressing columns in show(); maybe adjust 'options(max.print= *)'",                 cat("\n .....suppressing columns in show(); maybe adjust 'options(max.print= *)'",
370                     "\n ..............................\n", sep='')                     "\n ..............................\n", sep='')
371             }             }
372             else stop("logic programming error in prSpMatrix(), please report")             else stop("logic programming error in printSpMatrix(), please report")
373    
374             invisible(object)             invisible(object)
375         }         }

Legend:
Removed from v.1946  
changed lines
  Added in v.1947

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