SCM

SCM Repository

[matrix] Annotation of /pkg/Matrix/R/Csparse.R
ViewVC logotype

Annotation of /pkg/Matrix/R/Csparse.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2677 - (view) (download)

1 : maechler 1331 #### Methods for the virtual class 'CsparseMatrix' of sparse matrices stored in
2 :     #### "column compressed" format.
3 :     #### -- many more specific things are e.g. in ./dgCMatrix.R
4 :    
5 : bates 1367 setAs("CsparseMatrix", "TsparseMatrix",
6 :     function(from)
7 :     ## |-> cholmod_C -> cholmod_T -> chm_triplet_to_SEXP
8 :     ## modified to support triangular (../src/Csparse.c)
9 :     .Call(Csparse_to_Tsparse, from, is(from, "triangularMatrix")))
10 : maechler 1331
11 : maechler 1747
12 : bates 1372 ## special cases (when a specific "to" class is specified)
13 :     setAs("dgCMatrix", "dgTMatrix",
14 :     function(from) .Call(Csparse_to_Tsparse, from, FALSE))
15 : bates 1367
16 : bates 1372 setAs("dsCMatrix", "dsTMatrix",
17 :     function(from) .Call(Csparse_to_Tsparse, from, FALSE))
18 :    
19 : maechler 1374 setAs("dsCMatrix", "dgCMatrix",
20 :     function(from) .Call(Csparse_symmetric_to_general, from))
21 :    
22 : maechler 1747 for(prefix in c("d", "l", "n"))
23 :     setAs(paste(prefix,"sCMatrix",sep=''), "generalMatrix",
24 :     function(from) .Call(Csparse_symmetric_to_general, from))
25 :    
26 : bates 1372 setAs("dtCMatrix", "dtTMatrix",
27 :     function(from) .Call(Csparse_to_Tsparse, from, TRUE))
28 :    
29 : bates 1367 setAs("CsparseMatrix", "denseMatrix",
30 : maechler 1331 function(from) {
31 : maechler 1725 ## |-> cholmod_C -> cholmod_dense -> chm_dense_to_dense
32 :     cld <- getClassDef(class(from))
33 :     if (extends(cld, "generalMatrix"))
34 :     .Call(Csparse_to_dense, from)
35 :     else {
36 :     ## Csparse_to_dense loses symmetry and triangularity properties.
37 :     ## With suitable changes to chm_dense_to_SEXP (../src/chm_common.c)
38 : maechler 1751 ## we could do this in C code -- or do differently in C {FIXME!}
39 : maechler 1725 if (extends(cld, "triangularMatrix") && from@diag == "U")
40 :     from <- .Call(Csparse_diagU2N, from)
41 : maechler 1751 as(.Call(Csparse_to_dense, from), # -> "[dln]geMatrix"
42 : maechler 1725 paste(.M.kind(from, cld),
43 :     .dense.prefixes[.M.shape(from, cld)], "Matrix", sep=''))
44 :     }
45 : maechler 1331 })
46 :    
47 : bates 1372 ## special cases (when a specific "to" class is specified)
48 :     setAs("dgCMatrix", "dgeMatrix",
49 :     function(from) .Call(Csparse_to_dense, from))
50 :    
51 : bates 1369 ## cholmod_sparse_to_dense converts symmetric storage to general
52 : bates 1372 ## storage so symmetric classes are ok for conversion to matrix.
53 : bates 1369 ## unit triangular needs special handling
54 : bates 1367 setAs("CsparseMatrix", "matrix",
55 : maechler 1331 function(from) {
56 : bates 1369 ## |-> cholmod_C -> cholmod_dense -> chm_dense_to_matrix
57 :     if (is(from, "triangularMatrix") && from@diag == "U")
58 :     from <- .Call(Csparse_diagU2N, from)
59 : bates 1367 .Call(Csparse_to_matrix, from)
60 : maechler 1331 })
61 :    
62 : maechler 2115 setAs("CsparseMatrix", "symmetricMatrix",
63 :     function(from) {
64 : mmaechler 2490 if(isSymmetric(from)) {
65 :     isTri <- is(from, "triangularMatrix")# i.e. effectively *diagonal*
66 : maechler 2115 if (isTri && from@diag == "U")
67 :     from <- .Call(Csparse_diagU2N, from)
68 :     .Call(Csparse_general_to_symmetric, from,
69 :     uplo = if(isTri) from@uplo else "U")
70 :     } else
71 :     stop("not a symmetric matrix; consider forceSymmetric() or symmpart()")
72 :     })
73 :    
74 :    
75 : mmaechler 2312 .validateCsparse <- function(x, sort.if.needed = FALSE)
76 :     .Call(Csparse_validate2, x, sort.if.needed)
77 : mmaechler 2608 ##-> to be used in sparseMatrix(.), e.g. --- but is unused currently
78 :     ## NB: 'sort.if.needed' is called 'maybe_modify' in C -- so be careful
79 : mmaechler 2312
80 : maechler 1331 ### Some group methods:
81 :    
82 :     setMethod("Math",
83 :     signature(x = "CsparseMatrix"),
84 :     function(x) {
85 :     f0 <- callGeneric(0.)
86 : maechler 1472 if(is0(f0)) {
87 : maechler 1331 ## sparseness, symm., triang.,... preserved
88 : maechler 2005 cl <- class(x)
89 :     has.x <- !extends(cl, "nsparseMatrix")
90 :     ## has.x <==> *not* nonzero-pattern == "nMatrix"
91 :     if(has.x) {
92 :     type <- storage.mode(x@x)
93 :     r <- callGeneric(x@x)
94 :     } else { ## nsparseMatrix
95 :     type <- ""
96 :     r <- rep.int(as.double(callGeneric(TRUE)),
97 :     switch(.sp.class(cl),
98 :     CsparseMatrix = length(x@i),
99 :     TsparseMatrix = length(x@i),
100 :     RsparseMatrix = length(x@j)))
101 :     }
102 :     if(type == storage.mode(r)) {
103 :     x@x <- r
104 :     x
105 :     } else { ## e.g. abs( <lgC> ) --> integer Csparse
106 :     ## FIXME: when we have 'i*' classes, use them here:
107 :     rx <- new(sub("^.", "d", cl))
108 :     rx@x <- as.double(r)
109 :     ## result is "same"
110 :     sNams <- slotNames(cl)
111 :     for(nm in sNams[sNams != "x"])
112 :     slot(rx, nm) <- slot(x, nm)
113 :     rx
114 :     }
115 : maechler 1331 } else { ## no sparseness
116 :     callGeneric(as_dense(x))
117 :     }
118 : mmaechler 2508 }) ## {Math}
119 :    
120 :    
121 :     ### Subsetting -- basic things (drop = "missing") are done in ./Matrix.R
122 :     ### ---------- "[" and (currently) also ./sparseMatrix.R
123 :    
124 :     subCsp_cols <- function(x, j, drop)
125 :     {
126 :     ## x[ , j, drop=drop] where we know that x is Csparse*
127 : mmaechler 2519 dn <- x@Dimnames
128 :     jj <- intI(j, n = x@Dim[2], dn[[2]], give.dn = FALSE)
129 :     r <- .Call(Csparse_submatrix, x, NULL, jj)
130 :     if(!is.null(n <- dn[[1]])) r@Dimnames[[1]] <- n
131 : mmaechler 2523 if(!is.null(n <- dn[[2]])) r@Dimnames[[2]] <- n[jj+1L]
132 : mmaechler 2519 if(drop && any(r@Dim == 1L)) drop(as(r, "matrix")) else r
133 : mmaechler 2508 }
134 :    
135 :     subCsp_rows <- function(x, i, drop)# , cl = getClassDef(class(x))
136 :     {
137 :     ## x[ i, drop=drop] where we know that x is Csparse*
138 : mmaechler 2519 dn <- x@Dimnames
139 :     ii <- intI(i, n = x@Dim[1], dn[[1]], give.dn = FALSE)
140 :     r <- .Call(Csparse_submatrix, x, ii, NULL)
141 : mmaechler 2523 if(!is.null(n <- dn[[1]])) r@Dimnames[[1]] <- n[ii+1L]
142 : mmaechler 2519 if(!is.null(n <- dn[[2]])) r@Dimnames[[2]] <- n
143 :     if(drop && any(r@Dim == 1L)) drop(as(r, "matrix")) else r
144 : mmaechler 2508 }
145 :    
146 :     subCsp_ij <- function(x, i, j, drop)
147 :     {
148 :     ## x[i, j, drop=drop] where we know that x is Csparse*
149 :     d <- x@Dim
150 :     dn <- x@Dimnames
151 :     ## Take care that x[i,i] for symmetricM* stays symmetric
152 :     i.eq.j <- identical(i,j) # < want fast check
153 : mmaechler 2519 ii <- intI(i, n = d[1], dn[[1]], give.dn = FALSE)
154 : mmaechler 2523 jj <- if(i.eq.j && d[1] == d[2]) ii
155 :     else intI(j, n = d[2], dn[[2]], give.dn = FALSE)
156 :     r <- .Call(Csparse_submatrix, x, ii, jj)
157 :     if(!is.null(n <- dn[[1]])) r@Dimnames[[1]] <- n[ii + 1L]
158 :     if(!is.null(n <- dn[[2]])) r@Dimnames[[2]] <- n[jj + 1L]
159 : mmaechler 2508 if(!i.eq.j) {
160 :     if(drop && any(r@Dim == 1L)) drop(as(r, "matrix")) else r
161 :     } else { ## i == j
162 : mmaechler 2519 if(drop) drop <- any(r@Dim == 1L)
163 : mmaechler 2508 if(drop)
164 :     drop(as(r, "matrix"))
165 : mmaechler 2523 else if(extends((cx <- getClassDef(class(x))),
166 :     "symmetricMatrix")) ## TODO? make more efficient:
167 : mmaechler 2508 .gC2sym(r, uplo = x@uplo)## preserve uplo !
168 :     else if(extends(cx, "triangularMatrix") && !is.unsorted(ii))
169 :     as(r, "triangularMatrix")
170 :     else r
171 :     }
172 :     }
173 :    
174 :     setMethod("[", signature(x = "CsparseMatrix", i = "index", j = "missing",
175 :     drop = "logical"),
176 :     function (x, i,j, ..., drop) {
177 :     na <- nargs()
178 :     Matrix.msg("Csp[i,m,l] : nargs()=",na, .M.level = 2)
179 :     if(na == 4)
180 :     subCsp_rows(x, i, drop=drop)
181 :     else if(na == 3)
182 :     .M.vectorSub(x, i) # as(x, "TsparseMatrix")[i, drop=drop]
183 :     else ## should not happen
184 :     stop("Matrix-internal error in <CsparseM>[i,,d]; please report")
185 : maechler 1331 })
186 :    
187 : mmaechler 2508 setMethod("[", signature(x = "CsparseMatrix", i = "missing", j = "index",
188 :     drop = "logical"),
189 :     function (x,i,j, ..., drop) {
190 :     Matrix.msg("Csp[m,i,l] : nargs()=",nargs(), .M.level = 2)
191 :     subCsp_cols(x, j, drop=drop)
192 :     })
193 : maechler 1331
194 : mmaechler 2508 setMethod("[", signature(x = "CsparseMatrix",
195 :     i = "index", j = "index", drop = "logical"),
196 :     function (x, i, j, ..., drop) {
197 :     Matrix.msg("Csp[i,i,l] : nargs()=",nargs(), .M.level = 2)
198 :     subCsp_ij(x, i, j, drop=drop)
199 :     })
200 : maechler 1331
201 : mmaechler 2508
202 :    
203 :    
204 : maechler 2110 ## workhorse for "[<-" -- both for d* and l* C-sparse matrices :
205 :     ## --------- ----- FIXME(2): keep in sync with replTmat() in ./Tsparse.R
206 : maechler 2098 replCmat <- function (x, i, j, ..., value)
207 : maechler 1331 {
208 :     di <- dim(x)
209 :     dn <- dimnames(x)
210 : maechler 2098 iMi <- missing(i)
211 :     jMi <- missing(j)
212 : mmaechler 2207 spV <- is(value, "sparseVector")
213 : maechler 2098 na <- nargs()
214 : mmaechler 2539 Matrix.msg("replCmat[x,i,j,.., val] : nargs()=", na,"; ",
215 :     if(iMi | jMi) sprintf("missing (i,j) = (%d,%d)", iMi,jMi),
216 : mmaechler 2661 .M.level = 2)
217 : maechler 2098 if(na == 3) { ## "vector (or 2-col) indexing" M[i] <- v
218 :     x <- as(x, "TsparseMatrix")
219 :     x[i] <- value # may change class e.g. from dtT* to dgT*
220 :     clx <- sub(".Matrix$", "CMatrix", class(x))
221 :     return(if(any(is0(x@x))) ## drop all values that "happen to be 0"
222 : mmaechler 2256 drop0(x, is.Csparse=FALSE) else as_CspClass(x, clx))
223 : maechler 2098 }
224 :     ## nargs() == 4 :
225 :    
226 : mmaechler 2661 lenV <- length(value)
227 : maechler 2098 i1 <- if(iMi) 0:(di[1] - 1L) else .ind.prep2(i, 1, di, dn)
228 :     i2 <- if(jMi) 0:(di[2] - 1L) else .ind.prep2(j, 2, di, dn)
229 : maechler 1331 dind <- c(length(i1), length(i2)) # dimension of replacement region
230 :     lenRepl <- prod(dind)
231 :     if(lenV == 0) {
232 :     if(lenRepl != 0)
233 :     stop("nothing to replace with")
234 :     else return(x)
235 :     }
236 :     ## else: lenV := length(value) is > 0
237 :     if(lenRepl %% lenV != 0)
238 : maechler 1618 stop("number of items to replace is not a multiple of replacement length")
239 : maechler 1331 if(lenV > lenRepl)
240 : maechler 1618 stop("too many replacement values")
241 : maechler 1331
242 : maechler 1724 clx <- class(x)
243 :     clDx <- getClassDef(clx) # extends() , is() etc all use the class definition
244 : maechler 1673
245 : maechler 1724 ## keep "symmetry" if changed here:
246 :     x.sym <- extends(clDx, "symmetricMatrix")
247 : maechler 1673 if(x.sym) { ## only half the indices are there..
248 : mmaechler 2661 ## using array() for large dind is a disaster...
249 :     mkArray <- if(spV) # TODO: room for improvement
250 :     function(v, dim) spV2M(v, dim[1],dim[2]) else array
251 : maechler 1673 x.sym <-
252 : maechler 1724 (dind[1] == dind[2] && all(i1 == i2) &&
253 : mmaechler 2661 (lenRepl == 1 || lenV == 1 ||
254 :     isSymmetric(mkArray(value, dim=dind))))
255 : maechler 1673 ## x.sym : result is *still* symmetric
256 : maechler 1724 x <- .Call(Csparse_symmetric_to_general, x) ## but do *not* redefine clx!
257 : maechler 1673 }
258 : mmaechler 2242 else if(extends(clDx, "triangularMatrix")) {
259 : maechler 1710 xU <- x@uplo == "U"
260 : maechler 2110 r.tri <- ((any(dind == 1) || dind[1] == dind[2]) &&
261 : mmaechler 2175 if(xU) max(i1) <= min(i2) else max(i2) <= min(i1))
262 : maechler 1710 if(r.tri) { ## result is *still* triangular
263 :     if(any(i1 == i2)) # diagonal will be changed
264 : maechler 1724 x <- diagU2N(x) # keeps class (!)
265 : maechler 1710 }
266 :     else { # go to "generalMatrix" and continue
267 : maechler 1724 x <- as(x, paste(.M.kind(x), "gCMatrix", sep='')) ## & do not redefine clx!
268 : maechler 1710 }
269 :     }
270 : maechler 1374
271 : mmaechler 2677 if(extends(clDx, "dMatrix")) {
272 :     has.x <- TRUE
273 :     x <- .Call(Csparse_subassign,
274 :     if(clx == "dgCMatrix")x else as(x, "dgCMatrix"),
275 :     i1, i2,
276 :     as(value, "dsparseVector"))
277 :     }
278 :     else {
279 : maechler 1331 xj <- .Call(Matrix_expand_pointers, x@p)
280 :     sel <- (!is.na(match(x@i, i1)) &
281 : maechler 1673 !is.na(match( xj, i2)))
282 : maechler 1724 has.x <- "x" %in% slotNames(clDx)# === slotNames(x),
283 :     ## has.x <==> *not* nonzero-pattern == "nMatrix"
284 :    
285 : maechler 1374 if(has.x && sum(sel) == lenRepl) { ## all entries to be replaced are non-zero:
286 : maechler 1724 ## need indices instead of just 'sel', for, e.g., A[2:1, 2:1] <- v
287 :     non0 <- cbind(match(x@i[sel], i1),
288 : maechler 1832 match(xj [sel], i2)) - 1L
289 : mmaechler 2525 iN0 <- 1L + .Call(m_encodeInd, non0, di = dind, checkBounds = FALSE)
290 : maechler 1724
291 : mmaechler 2207 has0 <-
292 :     if(spV) length(value@i) < lenV else any(value[!is.na(value)] == 0)
293 : maechler 1724 if(lenV < lenRepl)
294 :     value <- rep(value, length = lenRepl)
295 : maechler 1673 ## Ideally we only replace them where value != 0 and drop the value==0
296 : maechler 2115 ## ones; FIXME: see Davis(2006) "2.7 Removing entries", p.16, e.g. use cs_dropzeros()
297 :     ## but really could be faster and write something like cs_drop_k(A, k)
298 : maechler 1673 ## v0 <- 0 == value
299 :     ## if (lenRepl == 1) and v0 is TRUE, the following is not doing anything
300 :     ##- --> ./dgTMatrix.R and its replTmat()
301 :     ## x@x[sel[!v0]] <- value[!v0]
302 : mmaechler 2207 x@x[sel] <- as.vector(value[iN0])
303 : mmaechler 2490 if(extends(clDx, "compMatrix") && length(x@factors)) # drop cashed ones
304 :     x@factors <- list()
305 : maechler 2115 if(has0) x <- .Call(Csparse_drop, x, 0)
306 : maechler 1724
307 : maechler 1673 return(if(x.sym) as_CspClass(x, clx) else x)
308 : maechler 1331 }
309 : maechler 1600 ## else go via Tsparse.. {FIXME: a waste! - we already have 'xj' ..}
310 : maechler 1707 ## and inside Tsparse... the above i1, i2,..., sel are *all* redone!
311 : maechler 2115 ## Happens too often:
312 : mmaechler 2363 ## Matrix.msg("wasteful C -> T -> C in replCmat(x,i,j,v) for <sparse>[i,j] <- v")
313 : maechler 1331 x <- as(x, "TsparseMatrix")
314 : maechler 1600 if(missing(i))
315 :     x[ ,j] <- value
316 :     else if(missing(j))
317 :     x[i, ] <- value
318 :     else
319 :     x[i,j] <- value
320 : mmaechler 2490 if(extends(clDx, "compMatrix") && length(x@factors)) # drop cashed ones
321 :     x@factors <- list()
322 : mmaechler 2677 }# else{ not using new memory-sparse code
323 : mmaechler 2335 if(has.x && any(is0(x@x))) ## drop all values that "happen to be 0"
324 : mmaechler 2677 as_CspClass(drop0(x), clx)
325 : maechler 1619 else as_CspClass(x, clx)
326 : mmaechler 2490 } ## replCmat
327 : maechler 1331
328 :     setReplaceMethod("[", signature(x = "CsparseMatrix", i = "index", j = "missing",
329 :     value = "replValue"),
330 : maechler 2098 replCmat)
331 : maechler 1331
332 :     setReplaceMethod("[", signature(x = "CsparseMatrix", i = "missing", j = "index",
333 :     value = "replValue"),
334 : maechler 2098 replCmat)
335 : maechler 1331
336 :     setReplaceMethod("[", signature(x = "CsparseMatrix", i = "index", j = "index",
337 :     value = "replValue"),
338 :     replCmat)
339 :    
340 : mmaechler 2207 ### When the RHS 'value' is a sparseVector, now can use replCmat as well
341 :     setReplaceMethod("[", signature(x = "CsparseMatrix", i = "missing", j = "index",
342 :     value = "sparseVector"),
343 :     replCmat)
344 :    
345 :     setReplaceMethod("[", signature(x = "CsparseMatrix", i = "index", j = "missing",
346 :     value = "sparseVector"),
347 :     replCmat)
348 :    
349 :     setReplaceMethod("[", signature(x = "CsparseMatrix", i = "index", j = "index",
350 :     value = "sparseVector"),
351 :     replCmat)
352 :    
353 : maechler 1724 ## A[ ij ] <- value, where ij is (i,j) 2-column matrix
354 :     setReplaceMethod("[", signature(x = "CsparseMatrix", i = "matrix", j = "missing",
355 :     value = "replValue"),
356 :     function(x, i, value)
357 :     ## goto Tsparse modify and convert back:
358 : mmaechler 2549 as(.TM.repl.i.mat(as(x, "TsparseMatrix"), i=i, value=value),
359 : maechler 1724 "CsparseMatrix"))
360 : mmaechler 2549 ## more in ./Matrix.R
361 : maechler 1331
362 : mmaechler 2551
363 : bates 1369 setMethod("t", signature(x = "CsparseMatrix"),
364 :     function(x) .Call(Csparse_transpose, x, is(x, "triangularMatrix")))
365 :    
366 : bates 1059
367 : maechler 2113 ## NB: have extra tril(), triu() methods for symmetric ["dsC" and "lsC"] and
368 :     ## NB: for all triangular ones, where the latter may 'callNextMethod()' these:
369 : bates 1268 setMethod("tril", "CsparseMatrix",
370 : maechler 1331 function(x, k = 0, ...) {
371 :     k <- as.integer(k[1])
372 : maechler 1452 dd <- dim(x); sqr <- dd[1] == dd[2]
373 : maechler 1331 stopifnot(-dd[1] <= k, k <= dd[1]) # had k <= 0
374 :     r <- .Call(Csparse_band, x, -dd[1], k)
375 :     ## return "lower triangular" if k <= 0
376 : maechler 1452 if(sqr && k <= 0)
377 :     as(r, paste(.M.kind(x), "tCMatrix", sep='')) else r
378 : maechler 1331 })
379 : bates 1265
380 : bates 1268 setMethod("triu", "CsparseMatrix",
381 : maechler 1331 function(x, k = 0, ...) {
382 :     k <- as.integer(k[1])
383 : maechler 1452 dd <- dim(x); sqr <- dd[1] == dd[2]
384 : maechler 1331 stopifnot(-dd[1] <= k, k <= dd[1]) # had k >= 0
385 :     r <- .Call(Csparse_band, x, k, dd[2])
386 :     ## return "upper triangular" if k >= 0
387 : maechler 1452 if(sqr && k >= 0)
388 :     as(r, paste(.M.kind(x), "tCMatrix", sep='')) else r
389 : maechler 1331 })
390 : bates 1268
391 :     setMethod("band", "CsparseMatrix",
392 : maechler 1331 function(x, k1, k2, ...) {
393 :     k1 <- as.integer(k1[1])
394 :     k2 <- as.integer(k2[1])
395 : maechler 1452 dd <- dim(x); sqr <- dd[1] == dd[2]
396 : mmaechler 2346 stopifnot(-dd[1] <= k1, k1 <= k2, k2 <= dd[2])
397 : mmaechler 2175 r <- .Call(Csparse_band, diagU2N(x), k1, k2)
398 : maechler 1452 if(sqr && k1 * k2 >= 0) ## triangular
399 : maechler 1331 as(r, paste(.M.kind(x), "tCMatrix", sep=''))
400 :     else if (k1 < 0 && k1 == -k2 && isSymmetric(x)) ## symmetric
401 :     as(r, paste(.M.kind(x), "sCMatrix", sep=''))
402 :     else
403 :     r
404 :     })
405 : maechler 1290
406 : bates 1369 setMethod("diag", "CsparseMatrix",
407 : maechler 2052 function(x, nrow, ncol) {
408 : maechler 2137 ## "FIXME": could be more efficient; creates new ..CMatrix:
409 : mmaechler 2175 dm <- .Call(Csparse_band, diagU2N(x), 0, 0)
410 : maechler 1548 dlen <- min(dm@Dim)
411 : maechler 1832 ind1 <- dm@i + 1L # 1-based index vector
412 : maechler 1548 if (is(dm, "nMatrix")) {
413 :     val <- rep.int(FALSE, dlen)
414 :     val[ind1] <- TRUE
415 :     }
416 :     else if (is(dm, "lMatrix")) {
417 :     val <- rep.int(FALSE, dlen)
418 :     val[ind1] <- as.logical(dm@x)
419 :     }
420 :     else {
421 :     val <- rep.int(0, dlen)
422 :     ## cMatrix not yet active but for future expansion
423 :     if (is(dm, "cMatrix")) val <- as.complex(val)
424 :     val[ind1] <- dm@x
425 :     }
426 :     val
427 :     })
428 : bates 2049
429 :     setMethod("writeMM", "CsparseMatrix",
430 :     function(obj, file, ...)
431 :     .Call(Csparse_MatrixMarket, obj, as.character(file)))
432 : mmaechler 2442
433 :     setMethod("Cholesky", signature(A = "CsparseMatrix"),
434 :     function(A, perm = TRUE, LDL = !super, super = FALSE, Imult = 0, ...)
435 :     Cholesky(as(A, "symmetricMatrix"),
436 :     perm=perm, LDL=LDL, super=super, Imult=Imult, ...))
437 :    
438 :     ## TODO (in ../TODO for quite a while .....):
439 :     setMethod("Cholesky", signature(A = "nsparseMatrix"),
440 :     function(A, perm = TRUE, LDL = !super, super = FALSE, Imult = 0, ...)
441 :     stop("Cholesky(<nsparse...>) -> *symbolic* factorization -- not yet implemented"))

R-Forge@R-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business University of Wisconsin - Madison Powered By FusionForge