R Under development (unstable) (2024-03-01 r86033 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> #
> # Test cases for bdsmatrix.reconcile
> #
> library(bdsmatrix)

Attaching package: 'bdsmatrix'

The following object is masked from 'package:base':

    backsolve

> aeq <- function(x,y) all.equal(as.vector(x), as.vector(y))
> 
> tmat <- bdsmatrix(c(3,2,2,4), 
+               c(22,1,2,21,3,20,19,4,18,17,5,16,15,6,7, 8,14,9,10,13,11,12),
+               matrix(c(1,0,1,1,0,0,1,1,0,1,0,10,0,
+                        0,1,1,0,1,1,0,1,1,0,1,0,10), ncol=2))
> id <- letters[1:13]
> dimnames(tmat) <- list(id, id)
> 
> rmat <- matrix(1:169, 13,13)
> rmat <- (rmat + t(rmat))/2
> dimnames(rmat) <- list(rev(id), rev(id))
> 
> xmat <- bdsmatrix.reconcile(list(tmat, rmat), group=id)
> temp <- xmat[[1]]
> aeq(temp@blocksize, 13)
[1] TRUE
> aeq(as.matrix(temp), as.matrix(tmat))
[1] TRUE
> 
> temp <- xmat[[2]]
> aeq(temp@blocksize, 13)
[1] TRUE
> aeq(as.matrix(temp), rmat[13:1, 13:1])
[1] TRUE
> 
> xmat <- bdsmatrix.reconcile(list(rmat, bdsI, tmat), group= rev(id))
> temp <- xmat[[1]]
> aeq(as.matrix(temp), rmat)
[1] TRUE
> 
> temp <- xmat[[2]]
> aeq(as.matrix(temp), diag(13))
[1] TRUE
> 
> temp <- xmat[[3]]
> aeq(as.matrix(temp), (as.matrix(tmat))[13:1,13:1])
[1] TRUE
> 
> #
> # Simplest case
> #
> xmat <- bdsmatrix.reconcile(bdsI, id)
> all(xmat@blocksize==1)
[1] TRUE
> aeq(as.matrix(xmat), diag(13))
[1] TRUE
> 
> #
> # The case list(tmat, tmat) will fail  - can't have 2 rmats
> #
> #xmat <- bdsmatrix.reconcile(list(tmat, tmat), id)
> 
> xmat <- bdsmatrix.reconcile(list(tmat, bdsI), rev(id))
> temp <- xmat[[1]]
> aeq(as.matrix(temp), as.matrix(tmat))
[1] TRUE
> aeq(dimnames(temp)[[1]], id)
[1] TRUE
> 
> aeq(as.matrix(xmat[[2]]), diag(13))
[1] TRUE
> 
> #
> # Now for the hard one: 2 bdsmatrices, different orders, different
> #   blocksize, but one contains the other
> #
> tmat <- tmat[1:11, 1:11]
> tord <- c(11:8, 2,1,3, 6,7,5,4)
> rmat <- (as.matrix(tmat))[tord, tord]
> rmat <- bdsmatrix(blocksize=c(4,5,2),
+                   blocks=c(rmat[1:4,1:4], rmat[5:9,5:9], rmat[10:11, 10:11]),
+                   dimnames=list(id[tord], id[tord]))
> 
> aeq(as.matrix(tmat)[tord,tord], as.matrix(rmat))
[1] TRUE
> 
> xmat <- bdsmatrix.reconcile(list(tmat/2, rmat), id[1:11])
> all.equal(xmat[[2]], rmat)
[1] TRUE
> all.equal(xmat[[1]]*2, rmat)
[1] TRUE
> 
> # Now toss out a row/col
> #  Give it a different name, too
> xx <- id[tord]
> xx[1] <- 44
> dimnames(rmat) <- list(xx,xx)
> xmat <- bdsmatrix.reconcile(list(tmat/2, rmat), id[1:9])
> all.equal(xmat[[1]]*2, xmat[[2]])
[1] TRUE
> 
> proc.time()
   user  system elapsed 
   0.39    0.04    0.43