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 1390, Fri Aug 18 15:41:36 2006 UTC revision 1467, Wed Aug 30 21:35:09 2006 UTC
# Line 1  Line 1 
1  #### "Namespace private" Auxiliaries  such as method functions  #### "Namespace private" Auxiliaries  such as method functions
2  #### (called from more than one place --> need to be defined early)  #### (called from more than one place --> need to be defined early)
3    
4    ## Need to consider NAs ;  "== 0" even works for logical & complex:
5    is0  <- function(x) !is.na(x) & x == 0
6    all0 <- function(x) !any(is.na(x)) && all(x == 0)
7    
8  ## For %*% (M = Matrix; v = vector (double or integer {complex maybe?}):  ## For %*% (M = Matrix; v = vector (double or integer {complex maybe?}):
9  .M.v <- function(x, y) callGeneric(x, as.matrix(y))  .M.v <- function(x, y) callGeneric(x, as.matrix(y))
10  .v.M <- function(x, y) callGeneric(rbind(x), y)  .v.M <- function(x, y) callGeneric(rbind(x), y)
# Line 142  Line 146 
146  }  }
147    
148  ## For sparseness handling  ## For sparseness handling
149    ## return a 2-column (i,j) matrix of
150    ## 0-based indices of non-zero entries  :
151  non0ind <- function(x) {  non0ind <- function(x) {
152    
153      if(is.numeric(x))      if(is.numeric(x))
154          return(if((n <- length(x))) (0:(n-1))[x != 0] else integer(0))          return(if((n <- length(x))) (0:(n-1))[x != 0] else integer(0))
155      ## else      ## else
156      stopifnot(is(x, "sparseMatrix"))      stopifnot(is(x, "sparseMatrix"))
     ## return a 2-column (i,j) matrix of  
     ## 0-based indices of non-zero entries  :  
157      non0.i <- function(M) {      non0.i <- function(M) {
158          if(is(M, "TsparseMatrix"))          if(is(M, "TsparseMatrix"))
159              return(unique(cbind(M@i,M@j)))              return(unique(cbind(M@i,M@j)))
# Line 427  Line 432 
432      ## else slower test      ## else slower test
433      if(!is.matrix(object))      if(!is.matrix(object))
434          object <- as(object,"matrix")          object <- as(object,"matrix")
     ## == 0 even works for logical & complex:  
435      if(is.na(upper)) {      if(is.na(upper)) {
436          if(all(object[lower.tri(object)] == 0))          if(all0(object[lower.tri(object)]))
437              structure(TRUE, kind = "U")              structure(TRUE, kind = "U")
438          else if(all(object[upper.tri(object)] == 0))          else if(all0(object[upper.tri(object)]))
439              structure(TRUE, kind = "L")              structure(TRUE, kind = "L")
440          else FALSE          else FALSE
441      } else if(upper)      } else if(upper)
442          all(object[lower.tri(object)] == 0)          all0(object[lower.tri(object)])
443      else ## upper is FALSE      else ## upper is FALSE
444          all(object[upper.tri(object)] == 0)          all0(object[upper.tri(object)])
445  }  }
446    
447  ## For Csparse matrices  ## For Csparse matrices
# Line 478  Line 482 
482      if(d[1] != (n <- d[2])) FALSE      if(d[1] != (n <- d[2])) FALSE
483      else if(is.matrix(object))      else if(is.matrix(object))
484          ## requires that "vector-indexing" works for 'object' :          ## requires that "vector-indexing" works for 'object' :
485          all(object[rep(c(FALSE, rep.int(TRUE,n)), length = n^2)] == 0)          all0(object[rep(c(FALSE, rep.int(TRUE,n)), length = n^2)])
486      else ## "denseMatrix" -- packed or unpacked      else ## "denseMatrix" -- packed or unpacked
487          if(is(object, "generalMatrix")) # "dge", "lge", ...          if(is(object, "generalMatrix")) # "dge", "lge", ...
488              all(object@x[rep(c(FALSE, rep.int(TRUE,n)), length = n^2)] == 0)              all0(object@x[rep(c(FALSE, rep.int(TRUE,n)), length = n^2)])
489          else { ## "dense" but not {diag, general}, i.e. triangular or symmetric:          else { ## "dense" but not {diag, general}, i.e. triangular or symmetric:
490              ## -> has 'uplo'  differentiate between packed and unpacked              ## -> has 'uplo'  differentiate between packed and unpacked
491    
# Line 493  Line 497 
497              }              }
498    
499  ### very cheap workaround  ### very cheap workaround
500              all(as.matrix(object)[rep(c(FALSE, rep.int(TRUE,n)), length = n^2)]              all0(as.matrix(object)[rep(c(FALSE, rep.int(TRUE,n)), length = n^2)])
                 == 0)  
501          }          }
502  }  }
503    

Legend:
Removed from v.1390  
changed lines
  Added in v.1467

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