208 |
identical(M, as(m, "dgeMatrix")), |
identical(M, as(m, "dgeMatrix")), |
209 |
identical(dimnames(M), dimnames(m))) |
identical(dimnames(M), dimnames(m))) |
210 |
|
|
211 |
|
## dimnames(.) of symmpart() / skewpart() : |
212 |
|
ns <- c("symmpart", "skewpart", "forceSymmetric") |
213 |
|
symFUNs <- setNames(lapply(ns, get), ns); rm(ns) |
214 |
|
chkSS <- function(m) { |
215 |
|
r <- lapply(symFUNs, function(fn) fn(m)) |
216 |
|
m0 <- as(m, "matrix") |
217 |
|
r0 <- lapply(symFUNs, function(fn) fn(m0)) |
218 |
|
isValid(fS <- r [["forceSymmetric"]], "symmetricMatrix") |
219 |
|
isValid(fS0 <- r0[["forceSymmetric"]], "symmetricMatrix") |
220 |
|
dnms <- dimnames(m) |
221 |
|
d.sy <- dimnames(r[["symmpart"]]) |
222 |
|
id <- if(is.null(dnms[[2]]) && !is.null(dnms[[1]])) 1 else 2 |
223 |
|
stopifnot(identical(d.sy, dnms[c(id,id)]), |
224 |
|
identical(d.sy, dimnames(r [["skewpart"]])), |
225 |
|
identical(d.sy, dimnames(r0[["skewpart"]])), |
226 |
|
all(m == with(r, symmpart + skewpart)), |
227 |
|
all(m0 == with(r0, symmpart + skewpart)), |
228 |
|
identical(dS <- dimnames(fS), dimnames(fS0)), |
229 |
|
identical(dS[1], dS[2]), |
230 |
|
TRUE) |
231 |
|
} |
232 |
|
for(m in list(Matrix(1:4, 2,2), Matrix(c(0, rep(1:0, 3),0:1), 3,3))) { |
233 |
|
cat("\n---\nm:\n"); show(m) |
234 |
|
chkSS(m) |
235 |
|
dn <- list(row = paste0("r", 1:nrow(m)), col = paste0("var.", 1:ncol(m))) |
236 |
|
dimnames(m) <- dn ; chkSS(m) |
237 |
|
colnames(m) <- NULL ; chkSS(m) |
238 |
|
dimnames(m) <- unname(dn) ; chkSS(m) |
239 |
|
} |
240 |
|
|
241 |
m. <- matrix(c(0, 0, 2:0), 3, 5) |
m. <- matrix(c(0, 0, 2:0), 3, 5) |
242 |
dimnames(m.) <- list(LETTERS[1:3], letters[1:5]) |
dimnames(m.) <- list(LETTERS[1:3], letters[1:5]) |
243 |
(m0 <- m <- Matrix(m.)) |
(m0 <- m <- Matrix(m.)) |
244 |
m@Dimnames[[2]] <- m@Dimnames[[1]] |
m@Dimnames[[2]] <- m@Dimnames[[1]] |
245 |
## not valid anymore: |
## not valid anymore: |
246 |
(val <- validObject(m, test=TRUE)); stopifnot(is.character(val)) |
(val <- validObject(m, test=TRUE)); stopifnot(is.character(val)) |
247 |
dm <- as(m0, "denseMatrix") |
dm <- as(m0, "denseMatrix"); rm(m) |
248 |
stopifnot(all.equal(rcond(dm), rcond(m.), tolerance = 1e-14), |
stopifnot(all.equal(rcond(dm), rcond(m.), tolerance = 1e-14), |
249 |
##^^^^^^^ dm and m. are both dense, interestingly small differences |
##^^^^^^^ dm and m. are both dense, interestingly small differences |
250 |
## show in at least one case of optimized BLAS |
## show in at least one case of optimized BLAS |
252 |
## show(<dgRMatrix>) had revealed a bug in C: |
## show(<dgRMatrix>) had revealed a bug in C: |
253 |
identical(capture.output(show(as(m0, "RsparseMatrix")))[-(1:2)], |
identical(capture.output(show(as(m0, "RsparseMatrix")))[-(1:2)], |
254 |
gsub("0", ".", capture.output(show(m.))[-1]))) |
gsub("0", ".", capture.output(show(m.))[-1]))) |
255 |
rm(m) |
m.1 <- m.; dimnames(m.1) <- list(row=NULL, col=NULL) |
256 |
|
M.1 <- Matrix(m.1, sparse=TRUE) |
257 |
|
show(M.1)# had bug in .formatSparseSimple() |
258 |
|
|
259 |
###-- Sparse Triangular : |
###-- Sparse Triangular : |
260 |
|
|
269 |
## Maybe move to R once 'Matrix' is recommended |
## Maybe move to R once 'Matrix' is recommended |
270 |
sm <- selectMethod(coerce, c("dgCMatrix", "triangularMatrix"), verbose=TRUE) |
sm <- selectMethod(coerce, c("dgCMatrix", "triangularMatrix"), verbose=TRUE) |
271 |
stopifnot(identical(sm(g5), t5)) |
stopifnot(identical(sm(g5), t5)) |
272 |
|
dimnames(t5) <- list(row=paste0("r",1:5), col=paste0("C.",1:5)) |
273 |
|
s5 <- symmpart(t5) # gave an error |
274 |
|
|
275 |
(t1 <- new("dtTMatrix", x= c(3,7), i= 0:1, j=3:2, |
(t1 <- new("dtTMatrix", x= c(3,7), i= 0:1, j=3:2, |
276 |
Dim= as.integer(c(4,4)))) |
Dim= as.integer(c(4,4)))) |