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 1654, Fri Oct 27 16:58:15 2006 UTC revision 1673, Mon Nov 6 20:54:26 2006 UTC
# Line 2  Line 2 
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  .isR_24 <- (paste(R.version$major, R.version$minor, sep=".") >= "2.4")  .isR_24 <- (paste(R.version$major, R.version$minor, sep=".") >= "2.4")
5    .isR_25 <- (paste(R.version$major, R.version$minor, sep=".") >= "2.5")
6    
7  ## Need to consider NAs ;  "== 0" even works for logical & complex:  ## Need to consider NAs ;  "== 0" even works for logical & complex:
8  is0  <- function(x) !is.na(x) & x == 0  is0  <- function(x) !is.na(x) & x == 0
# Line 435  Line 436 
436      else stop(" not yet be implemented for ", clx)      else stop(" not yet be implemented for ", clx)
437  }  }
438    
439    .type.kind <- c("d" = "double",
440                    "l" = "logical",
441                    "n" = "logical",
442                    "z" = "complex")
443    
444  .M.shape <- function(x, clx = class(x)) {  .M.shape <- function(x, clx = class(x)) {
445      if(is.matrix(x)) { ## 'old style matrix'      if(is.matrix(x)) { ## 'old style matrix'
446          if     (isDiagonal  (x)) "d"          if     (isDiagonal  (x)) "d"
# Line 623  Line 629 
629  }  }
630    
631    
 ## FIXME? -- this should also work for "ltT", "ntT", ... :  
632  diagU2N <- function(x)  diagU2N <- function(x)
633  {  {
634      ## Purpose: Transform a *unit diagonal* sparse triangular matrix      ## Purpose: Transform a *unit diagonal* sparse triangular matrix
635      ##  into one with explicit diagonal entries '1'      ##  into one with explicit diagonal entries '1'
636        if(is(x, "CsparseMatrix"))
637            return(.Call(Csparse_diagU2N, x))
638        ## else
639    
640        ## FIXME! -- for "ltT", "ntT", ... :
641      xT <- as(x, "dgTMatrix")      xT <- as(x, "dgTMatrix")
642      ## 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:
643      new("dtTMatrix", x = xT@x, i = xT@i, j = xT@j, Dim = x@Dim,      new("dtTMatrix", x = xT@x, i = xT@i, j = xT@j, Dim = x@Dim,
644          Dimnames = x@Dimnames, uplo = x@uplo, diag = "N")          Dimnames = x@Dimnames, uplo = x@uplo, diag = "N")
645  }  }
646    
647  ## FIXME: this should probably be dropped / replaced by as_Csparse  ## Needed, e.g., in ./Csparse.R for colSums() etc:
648  .as.dgC.Fun <- function(x, na.rm = FALSE, dims = 1) {  .as.dgC.Fun <- function(x, na.rm = FALSE, dims = 1) {
649      x <- as(x, "dgCMatrix")      x <- as(x, "dgCMatrix")
650      callGeneric()      callGeneric()
651  }  }
652    
653    .as.dgC.0.factors <- function(x) {
654        if(!is(x, "dgCMatrix"))
655            as(x, "dgCMatrix") # will not have 'factors'
656        else ## dgCMatrix
657            if(!length(x@factors)) x else { x@factors <- list() ; x }
658    }
659    
660  .as.dgT.Fun <- function(x, na.rm = FALSE, dims = 1) {  .as.dgT.Fun <- function(x, na.rm = FALSE, dims = 1) {
661      ## used e.g. inside colSums() etc methods      ## used e.g. inside colSums() etc methods
662      x <- as(x, "dgTMatrix")      x <- as(x, "dgTMatrix")

Legend:
Removed from v.1654  
changed lines
  Added in v.1673

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