SCM

SCM Repository

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

Diff of /pkg/R/Rsparse.R

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

revision 1910, Mon Jun 18 16:34:38 2007 UTC revision 1911, Tue Jun 19 16:16:58 2007 UTC
# Line 16  Line 16 
16  if(FALSE)  if(FALSE)
17  .R.2.T <- function(from) as(.R.2.C(from), "TsparseMatrix")  .R.2.T <- function(from) as(.R.2.C(from), "TsparseMatrix")
18    
19  ## R_to_CMatrix -- fails on 32bit--enable-R-shlib with segfault {Kurt}  ## R_to_CMatrix
20  ## ------------ --> ../src/dgCMatrix.c  ## ------------ --> ../src/dgCMatrix.c
21  .R.2.C <- function(from) .Call(R_to_CMatrix, from)  .R.2.C <- function(from) .Call(R_to_CMatrix, from)
22    
23  if(FALSE)## "slow" R-level workaround  if(FALSE)## "slow" R-level workaround
24  .R.2.C <- function(from)  .R.2.C <- function(from)
25  {  {
# Line 46  Line 47 
47      r      r
48  }  }
49    
50    ## However, a quick way to "treat a t(<R..>) as corresponding <C..> " :
51    .tR.2.C <- function(from)
52    {
53        cl <- class(from)
54        valid <- c("dgRMatrix", "dsRMatrix", "dtRMatrix",
55                   "lgRMatrix", "lsRMatrix", "ltRMatrix",
56                   "ngRMatrix", "nsRMatrix", "ntRMatrix",
57                   "zgRMatrix", "zsRMatrix", "ztRMatrix")
58        icl <- match(cl, valid) - 1L
59        if(is.na(icl)) stop("invalid class:", cl)
60        Ccl <- sub("^(..)R","\\1C", cl)  # corresponding Csparse class name
61        r <- new(Ccl)
62        r@i <- from@j
63        ##-         -
64        r@p <- from@p
65        r@Dim      <- rev(from@Dim)
66        r@Dimnames <- rev(from@Dimnames)
67    
68        if(icl %/% 3 != 2) ## not "n..Matrix" --> has 'x' slot
69            r@x <- from@x
70        if(icl %% 3 != 0) {                 # symmetric or triangular
71            r@uplo <- from@uplo
72            if(icl %% 3 == 2)               # triangular
73                r@diag <- from@diag
74        }
75        r
76    }
77    
78    
79    
80  ## coercion to other virtual classes --- the functionality we want to encourage  ## coercion to other virtual classes --- the functionality we want to encourage
81    
82  setAs("RsparseMatrix", "TsparseMatrix", .R.2.T)  setAs("RsparseMatrix", "TsparseMatrix", .R.2.T)
# Line 138  Line 169 
169  setMethod("band", "RsparseMatrix",  setMethod("band", "RsparseMatrix",
170            function(x, k1, k2, ...)            function(x, k1, k2, ...)
171            as(band(.R.2.C(x), k1 = k1, k2 = k2, ...), "RsparseMatrix"))            as(band(.R.2.C(x), k1 = k1, k2 = k2, ...), "RsparseMatrix"))
   
   
 ## These two are obviously more efficient than going through Tsparse:  
 setMethod("colSums", signature(x = "dgRMatrix"),  
           function(x, na.rm = FALSE, dims = 1, sparseResult = FALSE)  
           sparsapply(x, 2, sum, sparseResult = sparseResult, na.rm = na.rm))  
   
 setMethod("colMeans", signature(x = "dgRMatrix"), sp.colMeans)  
   

Legend:
Removed from v.1910  
changed lines
  Added in v.1911

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