# SCM Repository

[matrix] Diff of /pkg/R/Auxiliaries.R
 [matrix] / pkg / R / Auxiliaries.R # Diff of /pkg/R/Auxiliaries.R

revision 1575, Mon Sep 18 14:47:40 2006 UTC revision 1592, Thu Sep 28 15:31:17 2006 UTC
# Line 121  Line 121
121      x      x
122  }  }
123
124    ### TODO:  write in C and port to base (or 'utils') R
125    indTri <- function(n, upper = TRUE) {
126        ## == which(upper.tri(diag(n)) or
127        ##    which(lower.tri(diag(n)) -- but much more efficiently for largish 'n'
128        stopifnot(length(n) == 1, n == (n. <- as.integer(n)), (n <- n.) >= 0)
129        if(n <= 2)
130            return(if(n == 2) as.integer(if(upper) n+1 else n) else integer(0))
131        ## First, compute the 'diff(.)'  fast.  Use integers
132        one <- 1:1 ; two <- 2:2
133        n1 <- n - one
134        n2 <- n1 - one
135        r <- rep.int(one, n*n1/two - one)
136        r[cumsum(if(upper) 1:n2 else c(n1, if(n >= 4) n2:two))] <- if(upper) n:3 else 3:n
137        ## now have "dliu" difference; revert to "liu":
138        cumsum(c(if(upper) n+one else two, r))
139    }
140
141
142  prTriang <- function(x, digits = getOption("digits"),  prTriang <- function(x, digits = getOption("digits"),
143                       maxp = getOption("max.print"),                       maxp = getOption("max.print"),
144                       justify = "none", right = TRUE)                       justify = "none", right = TRUE)
# Line 183  Line 201
201      else                x != 0 & !is.na(x)      else                x != 0 & !is.na(x)
202  }  }
203
204  ### FIXME? -- make this into a generic function (?)  ## Number of non-zeros :
205    ## FIXME? -- make this into a generic function (?)
206  nnzero <- function(x, na.counted = NA) {  nnzero <- function(x, na.counted = NA) {
207      ## na.counted: TRUE: NA's are counted, they are not 0      ## na.counted: TRUE: NA's are counted, they are not 0
208      ##               NA: NA's are not known (0 or not) ==>  result := NA      ##               NA: NA's are not known (0 or not) ==>  result := NA
# Line 594  Line 613
613  }  }
614
615
616    ## FIXME? -- this should also work for "ltT", "ntT", ... :
617  diagU2N <- function(x)  diagU2N <- function(x)
618  {  {
619      ## Purpose: Transform a *unit diagonal* triangular matrix      ## Purpose: Transform a *unit diagonal* sparse triangular matrix
620      ##  into one with explicit diagonal entries '1'      ##  into one with explicit diagonal entries '1'
621      xT <- as(x, "dgTMatrix")      xT <- as(x, "dgTMatrix")
622      ## leave it as  T* - the caller can always coerce to C* if needed:      ## leave it as  T* - the caller can always coerce to C* if needed:

Legend:
 Removed from v.1575 changed lines Added in v.1592  