SCM

SCM Repository

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

Diff of /pkg/R/Auxiliaries.R

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

revision 918, Thu Sep 15 18:08:59 2005 UTC revision 919, Fri Sep 16 17:27:06 2005 UTC
# Line 38  Line 38 
38  }  }
39    
40    
41    prTriang <- function(x, digits = getOption("digits"),
42                         justify = "none", right = TRUE)
43    {
44        ## modeled along stats:::print.dist
45        diag <- TRUE
46        upper <- x@uplo == "U"
47    
48        m <- as(x, "matrix")
49        cf <- format(m, digits = digits, justify = justify)
50        if(upper)
51            cf[row(cf) > col(cf)] <- "."
52        else
53            cf[row(cf) < col(cf)] <- "."
54        print(cf, quote = FALSE, right = right)
55        invisible(x)
56    }
57    
58    prMatrix <- function(x, digits = getOption("digits")) {
59        d <- dim(x)
60        cl <- class(x)
61        cat(sprintf('%d x %d Matrix of class "%s"\n', d[1], d[2], cl))
62        maxp <- getOption("max.print")
63        if(prod(d) <= maxp) {
64            if(is(x, "triangularMatrix"))
65                prTriang(x, digits = digits)
66            else
67                print(as(x, "matrix"), digits = digits)
68        }
69        else { ## d[1] > maxp / d[2] >= nr :
70            m <- as(x, "matrix")
71            nr <- maxp %/% d[2]
72            n2 <- ceiling(nr / 2)
73            print(head(m, max(1, n2)))
74            cat("\n ..........\n\n")
75            print(tail(m, max(1, nr - n2)))
76        }
77        ## DEBUG: cat("str(.):\n") ; str(x)
78        invisible(x)# as print() S3 methods do
79    }
80    
81    ## For sparseness handling
82    non0ind <- function(x) {
83        if(is.numeric(x))
84            return(if((n <- length(x))) (0:(n-1))[x != 0] else integer(0))
85    
86        ## else return a (i,j) matrix of non-zero-indices
87    
88        stopifnot(is(x, "sparseMatrix"))
89        if(is(x, "gTMatrix"))
90            stop("'x' must be column- or row-compressed  'sparseMatrix'")
91        isCol <- function(M) any("i" == slotNames(M))
92        .Call("compressed_non_0_ij", x, isCol(x), PACKAGE = "Matrix")
93    }
94    
95    ### These are currently tests in ../tests/dgTMatrix.R !!!
96    uniq <- function(x) {
97        if(is(x, "gTMatrix")) {
98            ## Purpose: produce a *unique* triplet representation:
99            ##              by having (i,j) sorted and unique
100            ## -----------------------------------------------------------
101            ## The following is *not* efficient {but easy to program}:
102            if(is(x, "dgTMatrix")) as(as(x, "dgCMatrix"), "dgTMatrix")
103            else if(is(x, "lgTMatrix")) as(as(x, "lgCMatrix"), "lgTMatrix")
104            else stop("not implemented for class", class(x))
105    
106        } else x      # not 'gT' ; i.e. "uniquely" represented in any case
107    }
108    
109    if(FALSE) ## try an "efficient" version
110    uniq_gT <- function(x)
111    {
112        ## Purpose: produce a *unique* triplet representation:
113        ##          by having (i,j) sorted and unique
114        ## ----------------------------------------------------------------------
115        ## Arguments: a "gT" Matrix
116        stopifnot(is(x, "gTMatrix"))
117        if((n <- length(x@i)) == 0) return(x)
118        ii <- order(x@i, x@j)
119        if(any(ii != 1:n)) {
120            x@i <- x@i[ii]
121            x@j <- x@j[ii]
122            x@x <- x@x[ii]
123        }
124        ij <- x@i + nrow(x) * x@j
125        if(any(dup <- duplicated(ij))) {
126    
127        }
128        ### We should use a .Call() based utility for this!
129    
130    }
131    

Legend:
Removed from v.918  
changed lines
  Added in v.919

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