Nothing
#### Testing cbind() & rbind() -- based on cbind2() & rbind2()
## (where using 'cBind()' and 'rBind()' in Matrix)
## for R_DEFAULT_PACKAGES=NULL :
library(utils)
library(Matrix)
source(system.file("test-tools.R", package = "Matrix"))# identical3() etc
### --- Dense Matrices ---
m1 <- m2 <- m <- matrix(1:12, 3,4)
dimnames(m2) <- list(LETTERS[1:3],
letters[1:4])
dimnames(m1) <- list(NULL,letters[1:4])
M <- Matrix(m)
M1 <- Matrix(m1)
M2 <- Matrix(m2)
stopifnot(
identical3(cbind ( M, 10*M),
show(cbind2( M, 10*M)),
Matrix(cbind ( m, 10*m)))
,
identical3(cbind (M1, 100+M1),
show(cbind2(M1, 100+M1)),
Matrix(cbind (m1, 100+m1)))
,
identical3(cbind (M1, 10*M2),
show(cbind2(M1, 10*M2)),
Matrix(cbind (m1, 10*m2)))
,
identical3(cbind (M2, M1+M2),
show(cbind2(M2, M1+M2)),
Matrix(cbind (m2, m1+m2)))
,
identical(colnames(show(cbind(M1, MM = -1))),
c(colnames(M1), "MM"))
,
identical3(rbind ( M, 10*M),
show(rbind2( M, 10*M)),
Matrix(rbind ( m, 10*m)))
,
identical3(rbind (M2, M1+M2),
show(rbind2(M2, M1+M2)),
Matrix(rbind (m2, m1+m2)))
,
Qidentical(show (rbind(R1 = 10:11, M1)),
Matrix(rbind(R1 = 10:11, m1)), strictClass=FALSE)
, TRUE)
identical.or.eq <- function(x,y, tol=0, ...) {
if(identical(x,y, ...))
TRUE
else if(isTRUE(aeq <- all.equal(x,y, tolerance = tol)))
structure(TRUE, comment = "not identical")
else aeq
}
identicalShow <- function(x,y, ...)
if(!isTRUE(id <- identical.or.eq(x, y, ...))) cat(id,"\n")
## Checking deparse.level { <==> example at end of ?cbind }:
checkRN <- function(dd, B = rbind) {
FN <- function(deparse.level)
rownames(B(1:4, c=2,"a+"=10, dd, deparse.level=deparse.level))
rn <- c("1:4", "c", "a+", "dd", "")
isMatr <- (length(dim(dd)) == 2)
id <- if(isMatr) 5 else 4
identicalShow(rn[c(5,2:3, 5)], FN(deparse.level= 0)) # middle two names
identicalShow(rn[c(5,2:3,id)], FN(deparse.level= 1)) # last shown if vector
identicalShow(rn[c(1,2:3,id)], FN(deparse.level= 2)) # first shown; (last if vec.)
}
checkRN(10) # <==> ?cbind's ex
checkRN(1:4)
checkRN( rbind(c(0:1,0,0)))
checkRN(Matrix(rbind(c(0:1,0,0)))) ## in R <= 3.4.1, from methods:::rbind bug :
## Modes: character, NULL Lengths: 4, 0 target is character, current is NULL
checkRN(10 , rbind)
checkRN(1:4, rbind)
checkRN( rbind(c(0:1,0,0)), rbind)
checkRN(Matrix(rbind(c(0:1,0,0))), rbind)
cbind(0, Matrix(0+0:1, 1,2), 3:2)# FIXME? should warn - as with matrix()
as(rbind(0, Matrix(0+0:1, 1,2), 3:2),
"sparseMatrix")
cbind(M2, 10*M2[nrow(M2):1 ,])# keeps the rownames from the first
(im <- cbind(I = 100, M))
str(im)
(mi <- cbind(M2, I = 1000))
str(mi)
(m1m <- cbind(M,I=100,M2))
showProc.time()
## lgeMatrix -- rbind2() had bug (in C code):
is.lge <- function(M) isValid(M, "lgeMatrix")
stopifnot(exprs = {
is.lge(rbind(M2 > 0, M2 < 0)) # had Error in rbind2():
## REAL() can only be applied to a 'numeric', not a 'logical'
is.lge(rbind(M2 < 0, M2 > 0)) # ditto
is.lge(rbind(Matrix(1:6 %% 3 != 0, 2,3), FALSE))
is.lge(L <- rbind(Matrix(TRUE, 2,3), TRUE))
all(L)
is.lge(rbind(Matrix(TRUE, 2,3), FALSE))
})
### --- Diagonal / Sparse - had bugs
D4 <- Diagonal(4)
(D4T <- as(D4, "TsparseMatrix"))
D4C <- as(D4T, "CsparseMatrix")
c1 <- Matrix(0+0:3, 4, sparse=TRUE) ; r1 <- t(c1); r1
d4 <- rbind(Diagonal(4), 0:3)
m4 <- cbind(Diagonal(x=-1:2), 0:3)
c4. <- cbind(Diagonal(4), c1)
c.4 <- cbind(c1, Diagonal(4))
r4. <- rbind(Diagonal(4), r1)
r.4 <- rbind(r1, Diagonal(4))
assert.EQ.mat(d4, rbind(diag(4), 0:3))
assert.EQ.mat(m4, cbind(diag(-1:2), 0:3))
stopifnot(identical(Matrix(cbind(diag(3),0)), cbind2(Diagonal(3),0)),
is(d4, "sparseMatrix"), is(m4, "sparseMatrix"),
identical(.tCRT(d4), cbind(Diagonal(4), 0:3)),
identical(.tCRT(m4), rbind(Diagonal(x=-1:2), 0:3)))
showProc.time()
### --- Sparse Matrices ---
identical4(cbind(diag(4), diag(4)),
cbind(D4C, D4C),
cbind(D4T, D4C),
cbind(D4C, D4T))
nr <- 4
nc <- 6
m. <- matrix(rep_len(c(0, 2:-1), nr * nc), nr, nc)
M <- Matrix(m.)
(mC <- as(M, "CsparseMatrix"))
(mT <- as(M, "TsparseMatrix"))
stopifnot(identical(mT, as(mC, "TsparseMatrix")),
identical(mC, as(mT, "CsparseMatrix")))
for(v in list(0, 2, 1:0))
for(fnam in c("cbind", "rbind")) {
cat(fnam,"(m, v=", deparse(v),"), class(m) :")
FUN <- get(fnam)
for(m in list(M, mC, mT)) {
cat("", class(m),"")
assert.EQ.mat(FUN(v, m), FUN(v, m.)) ; cat(",")
assert.EQ.mat(FUN(m, v), FUN(m., v)) ; cat(".")
}
cat("\n")
}
showProc.time()
cbind(0, mC); cbind(mC, 0)
cbind(0, mT); cbind(mT, 2)
cbind(diag(nr), mT)
stopifnot(identical(t(cbind(diag(nr), mT)),
rbind(diag(nr), t(mT))))
(cc <- cbind(mC, 0,7,0, diag(nr), 0))
stopifnot(identical3(cc,
as(cbind(mT, 0, 7, 0, diag(nr), 0), "CsparseMatrix"),
as(cbind( M, 0, 7, 0, diag(nr), 0), "CsparseMatrix")))
cbind(mC, 1, 100*mC, 0, 0:2)
cbind(mT, 1, 0, mT+10*mT, 0, 0:2)
one <- 1
zero <- 0
dimnames(mC) <- dimnames(mT) <- list(LETTERS[1:4], letters[1:6])
op <- options(sparse.colnames = TRUE)# show colnames in print :
cbind(mC, one, 100*mC, zero, 0:2)
cbind(mC, one, 100*mC, zero, 0:2, deparse.level=0)# no "zero", "one"
cbind(mC, one, 100*mC, zero, 0:2, deparse.level=2)# even "0:2"
cbind(mT, one, zero, mT+10*mT, zero, 0:2)
## logical (sparse) - should remain logical :
L5 <- Diagonal(n = 5, x = TRUE)
v5 <- rep(x = c(FALSE,TRUE), length.out = ncol(L5))
stopifnot(is(show(rbind(L5,v5)), "lsparseMatrix"),
is(show(cbind(v5,L5)), "lsparseMatrix"),
is(rbind(L5, 2* v5), "dsparseMatrix"),
is(cbind(2* v5, L5), "dsparseMatrix"))
## print() / show() of non-structural zeros:
(m <- Matrix(c(0, 0, 2:0), 3, 5))
(m2 <- cbind(m,m))
(m4 <- rbind(m2,m2))
diag(m4)
for(i in 1:6) {
m4[i, i ] <- i
m4[i,i+1] <- 0
}
m4 ## now show some non-structural zeros:
## Mixture of dense and sparse/diagonal -- used to fail, even in 1.0-0
D5 <- Diagonal(x = 10*(1:5))
(D5.1 <- cbind2(D5, 1))
## "FIXME" in newer versions of R, do not need Matrix() here:
s42 <- Matrix(z42 <- cbind2(rep(0:1,4), rep(1:0,4)),
sparse=TRUE)
(C86 <- rbind(1, 0, D5.1, 0))
stopifnotValid(D5.1, "dgCMatrix")
stopifnotValid(print(rbind2(Matrix(1:10, 2,5), D5)), "dgRMatrix")
stopifnotValid(print(cbind2(Matrix(10:1, 5,2), D5.1)), "dgCMatrix")
stopifnotValid(zz <- cbind2(z42, C86), "dgCMatrix")
stopifnot(identical(zz, cbind2(s42, C86)))
## Using "nMatrix"
(m1 <- sparseMatrix(1:3, 1:3)) # ngCMatrix
m2 <- sparseMatrix(1:3, 1:3, x = 1:3)
stopifnotValid(c12 <- cbind(m1,m2), "dgCMatrix") # was "ngC.." because of cholmod_horzcat !
stopifnotValid(c21 <- cbind(m2,m1), "dgCMatrix") # ditto
stopifnotValid(r12 <- rbind(m1,m2), "dgCMatrix") # was "ngC.." because of cholmod_vertcat !
stopifnotValid(r21 <- rbind(m2,m1), "dgCMatrix") # ditto
d1 <- as(m1, "denseMatrix")
d2 <- as(m2, "denseMatrix")
stopifnotValid(cbind2(d2,d1), "dgeMatrix")
stopifnotValid(cbind2(d1,d2), "dgeMatrix")## gave an error in Matrix 1.1-5
stopifnotValid(rbind2(d2,d1), "dgeMatrix")
stopifnotValid(rbind2(d1,d2), "dgeMatrix")## gave an error in Matrix 1.1-5
## rbind2() / cbind2() mixing sparse/dense: used to "fail",
## ------------------- then (in 'devel', ~ 2015-03): completely wrong
S <- .sparseDiagonal(2)
s <- diag(2)
S9 <- rbind(S,0,0,S,0,NaN,0,0,0,2)## r/cbind2() failed to determine 'sparse' in Matrix <= 1.2-2
s9 <- rbind(s,0,0,s,0,NaN,0,0,0,2)
assert.EQ.mat(S9, s9)
D <- Matrix(1:6, 3,2); d <- as(D, "matrix")
T9 <- t(S9); t9 <- t(s9); T <- t(D); t <- t(d)
stopifnot(identical(rbind (s9,d), rbind2(s9,d)),
identical(rbind2(D,S9), t(cbind2(T,T9))),
identical(rbind2(S9,D), t(cbind2(T9,T))))
assert.EQ.mat(rbind2(S9,D), rbind2(s9,d))
assert.EQ.mat(rbind2(D,S9), rbind2(d,s9))
## now with cbind2() -- no problem!
stopifnot(identical(cbind (t9,t), cbind2(t9,t)))
assert.EQ.mat(cbind2(T9,T), cbind2(t9,t))
assert.EQ.mat(cbind2(T,T9), cbind2(t,t9))
options(op)
showProc.time()
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.