SCM

SCM Repository

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

Diff of /pkg/R/dgCMatrix.R

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

revision 1330, Fri Jul 21 08:28:18 2006 UTC revision 1331, Sat Jul 22 17:59:53 2006 UTC
# Line 192  Line 192 
192            })            })
193    
194    
195  setMethod("Math",  ## "Math" is up in ./Csparse.R
           signature(x = "dgCMatrix"),  
           function(x) {  
               f0 <- callGeneric(0.)  
               if(!is.na(f0) && f0 == 0.) {  
                   ## sparseness preserved  
                   x@x <- callGeneric(x@x)  
                   x  
               } else { ## no sparseness  
                   callGeneric(as(x, "dgeMatrix"))  
               }  
           })  
196    
197  if(FALSE) ## unneeded with "Math2" in ./dMatrix.R  ## "Math2" is up in ./dMatrix.R
 setMethod("Math2",  
           signature(x = "dgCMatrix", digits = "numeric"),  
           function(x, digits) {  
               f0 <- callGeneric(0., digits = digits)  
               if(!is.na(f0) && f0 == 0.) {  
                   ## sparseness preserved  
                   x@x <- callGeneric(x@x, digits = digits)  
                   x  
               } else { ## no sparseness  
                   callGeneric(as(x, "dgeMatrix"), digits = digits)  
               }  
           })  
198    
 ###---- end {Group Methods} -----------------  
199    
200    ###---- end {Group Methods} -----------------
 replCmat <- function (x, i, j, value)  
 {  
     di <- dim(x)  
     dn <- dimnames(x)  
     i1 <- if(missing(i)) 0:(di[1] - 1:1) else .ind.prep2(i, 1, di, dn)  
     i2 <- if(missing(j)) 0:(di[2] - 1:1) else .ind.prep2(j, 2, di, dn)  
     dind <- c(length(i1), length(i2)) # dimension of replacement region  
     lenRepl <- prod(dind)  
     lenV <- length(value)  
     if(lenV == 0) {  
         if(lenRepl != 0)  
             stop("nothing to replace with")  
         else return(x)  
     }  
     ## else: lenV := length(value)       is > 0  
     if(lenRepl %% lenV != 0)  
         stop("number of items to replace is not a multiple of replacement length")  
     if(lenV > lenRepl)  
         stop("too many replacement values")  
   
     xj <- .Call(Matrix_expand_pointers, x@p)  
     sel <- (!is.na(match(x@i, i1)) &  
             !is.na(match( xj, i2)))  
   
     if(sum(sel) == lenRepl) { ## all entries to be replaced are non-zero:  
         value <- rep(value, length = lenRepl)  
         ## Ideally we only replace them where value != 0 and drop the value==0  
         ## ones; but that would have to (?) go through dgT*  
         ## v0 <- 0 == value  
         ## if (lenRepl == 1) and v0 is TRUE, the following is not doing anything  
         ##-  --> ./dgTMatrix.R  and its  replTmat()  
         ## x@x[sel[!v0]] <- value[!v0]  
         x@x[sel] <- value  
         return(x)  
     }  
     ## else go via dgT  
     x <- as(x, "dgTMatrix")  
     x[i,j] <- value  
     as(x, "dgCMatrix")  
 }  
   
 ### TODO (FIXME): almost the same for  "lgCMatrix" and "logical"  
   
 setReplaceMethod("[", signature(x = "dgCMatrix", i = "index", j = "missing",  
                                 value = "numeric"),  
                  function (x, i, value) replCmat(x, i=i, value=value))  
   
 setReplaceMethod("[", signature(x = "dgCMatrix", i = "missing", j = "index",  
                                 value = "numeric"),  
                  function (x, j, value) replCmat(x, j=j, value=value))  
   
 setReplaceMethod("[", signature(x = "dgCMatrix", i = "index", j = "index",  
                                 value = "numeric"),  
                  replCmat)  
201    
202    
203    ## "[<-" methods { setReplaceMethod()s }  are now in ./Csparse.R
204    
205    
206  setMethod("writeHB", signature(obj = "dgCMatrix"),  setMethod("writeHB", signature(obj = "dgCMatrix"),

Legend:
Removed from v.1330  
changed lines
  Added in v.1331

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