| 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)))) |
Parent Directory
| 
Revision Log
| 
Patch
