# SCM Repository

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

# Diff of /pkg/R/Auxiliaries.R

revision 1237, Thu Mar 30 15:23:47 2006 UTC revision 1238, Thu Mar 30 19:56:09 2006 UTC
# Line 315  Line 315
315                           useInherited = c(from = TRUE, to = FALSE)))                           useInherited = c(from = TRUE, to = FALSE)))
316  }  }
317
318  .is.triangular <- function(object, upper = NA) {  ## For *dense* matrices
319    isTriMat <- function(object, upper = NA) {
320      ## pretest: is it square?      ## pretest: is it square?
321      d <- dim(object)      d <- dim(object)
322      if(d[1] != d[2]) return(FALSE)      if(d[1] != d[2]) return(FALSE)
# Line 335  Line 336
336          all(object[upper.tri(object)] == 0)          all(object[upper.tri(object)] == 0)
337  }  }
338
339    ## For Csparse matrices
340    isTriC <- function(x, upper = NA) {
341        ## pretest: is it square?
342        d <- dim(x)
343        if(d[1] != d[2]) return(FALSE)
344        ## else
345        if(d[1] == 0) return(TRUE)
346        ni <- 1:d[1]
347        ## the row indices split according to column:
348        ilist <- split(x@i, factor(rep.int(ni, diff(x@p)), levels= ni))
349        lil <- unlist(lapply(ilist, length), use.names = FALSE)
350        if(any(lil == 0)) {
351            pos <- lil > 0
352            if(!any(pos)) ## matrix of all 0's
353                return(TRUE)
354            ilist <- ilist[pos]
355            ni <- ni[pos]
356        }
357        if(is.na(upper)) {
358            if(all(sapply(ilist, max, USE.NAMES = FALSE) <= ni))
359                structure(TRUE, kind = "U")
360            else if(all(sapply(ilist, min, USE.NAMES = FALSE) >= ni))
361                structure(TRUE, kind = "L")
362            else FALSE
363        } else if(upper) {
364            all(sapply(ilist, max, USE.NAMES = FALSE) <= ni)
365        } else { ## 'lower'
366            all(sapply(ilist, min, USE.NAMES = FALSE) >= ni)
367        }
368    }
369
370
371  .is.diagonal <- function(object) {  .is.diagonal <- function(object) {
372      d <- dim(object)      d <- dim(object)
373      if(d[1] != (n <- d[2])) FALSE      if(d[1] != (n <- d[2])) FALSE

Legend:
 Removed from v.1237 changed lines Added in v.1238