SCM

SCM Repository

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

Diff of /pkg/R/Csparse.R

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

revision 1672, Mon Nov 6 20:25:10 2006 UTC revision 1673, Mon Nov 6 20:54:26 2006 UTC
# Line 121  Line 121 
121      if(lenV > lenRepl)      if(lenV > lenRepl)
122          stop("too many replacement values")          stop("too many replacement values")
123    
124      if(is(x, "symmetricMatrix")) ## only half the indices are there..      clx <- c(class(x)) # keep "symmetry" if changed here:
125    
126        x.sym <- is(x, "symmetricMatrix")
127        if(x.sym) { ## only half the indices are there..
128            x.sym <-
129                (dind[1] == dind[2] && i1 == i2 &&
130                 (lenRepl == 1 || isSymmetric(array(value, dim=dind))))
131            ## x.sym : result is *still* symmetric
132          x <- .Call(Csparse_symmetric_to_general, x)          x <- .Call(Csparse_symmetric_to_general, x)
133      clx <- c(class(x))      }
134    
135      xj <- .Call(Matrix_expand_pointers, x@p)      xj <- .Call(Matrix_expand_pointers, x@p)
136      sel <- (!is.na(match(x@i, i1)) &      sel <- (!is.na(match(x@i, i1)) &
137              !is.na(match( xj, i2)))              !is.na(match( xj, i2)))
138      has.x <- any("x" == slotNames(x)) # i.e. *not* logical      has.x <- any("x" == slotNames(x)) # i.e. *not* nonzero-pattern
139      if(has.x && sum(sel) == lenRepl) { ## all entries to be replaced are non-zero:      if(has.x && sum(sel) == lenRepl) { ## all entries to be replaced are non-zero:
140          value <- rep(value, length = lenRepl)          value <- rep(value, length = lenRepl)
141          ## Ideally we only replace them where value != 0 and drop the value==0          ## Ideally we only replace them where value != 0 and drop the value==0
# Line 138  Line 145 
145          ##-  --> ./dgTMatrix.R  and its  replTmat()          ##-  --> ./dgTMatrix.R  and its  replTmat()
146          ## x@x[sel[!v0]] <- value[!v0]          ## x@x[sel[!v0]] <- value[!v0]
147          x@x[sel] <- value          x@x[sel] <- value
148          return(x)          return(if(x.sym) as_CspClass(x, clx) else x)
149      }      }
150      ## else go via Tsparse.. {FIXME: a waste! - we already have 'xj' ..}      ## else go via Tsparse.. {FIXME: a waste! - we already have 'xj' ..}
151      x <- as(x, "TsparseMatrix")      x <- as(x, "TsparseMatrix")

Legend:
Removed from v.1672  
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