abind/0000755000175100001440000000000011664377541011363 5ustar hornikusersabind/MD50000644000175100001440000000175511664377541011703 0ustar hornikusers256e57b146d70c149d355538dcb9d655 *ChangeLog d1672a53c98099d69529a2b978df1cea *DESCRIPTION e85d6edfcf64e01488c1cc1ca900c861 *DevNotes.txt 0ec95b7d0916189c4d2f65132af553a1 *NAMESPACE de7c847244094966857a850e80bbf43f *R/abind.R 9aa6111e78914f82786267abf410a89a *R/adrop.R e2328c75f1851ac339c5a4bb0a7de61b *R/afill.R b91a43dfa5f33edc454581eee8d489ee *R/asub.R 758d4820d0e96a34e48e158999f22d0f *man/abind.Rd 0d3af220daec9e9b109bdda9917a5d85 *man/adrop.Rd 62762ef7274f38c3caccf14190b4d974 *man/afill.Rd 5dbcde0fee5b2aab3f2b44ee1dfe5a9f *man/asub.Rd 96aecf5ef7f3345bd1f26f0ba98df6f7 *tests/abind.R acb3f244ade2efc066825652c1207d01 *tests/abind.Rout.save 0e6deb6ea58cbae7e1617b67c2641d36 *tests/adrop.R 7513f2bbec5263ea69e1b085b5c71465 *tests/adrop.Rout.save 2e427a53aca2f42cee992325c2272bc1 *tests/afill.R 2971533ac03b1e065474a4975bfd8698 *tests/afill.Rout.save 455c0dcd4dd7eef26d5008d5952e9ba8 *tests/asub.R 6bd3795000cb1b1d20d71d656a18ddb6 *tests/asub.Rout.save 621efaf7e1d36a7b69541f44df99d856 *tests/tmp.txt abind/tests/0000755000175100001440000000000011664205225012512 5ustar hornikusersabind/tests/tmp.txt0000755000175100001440000000234311664205225014060 0ustar hornikusers> x <- array(1:24, dim=c(6,4), dimnames=list(LETTERS[1:6], letters[23:26])) > x1 <- x > x1[2:4,2:3] <- -(1:6) > x1 w x y z A 1 7 13 19 B 2 -1 -4 20 C 3 -2 -5 21 D 4 -3 -6 22 E 5 11 17 23 F 6 12 18 24 > x1 <- x > x1[LETTERS[2:4],letters[24:25]] <- -(1:6) > x1 w x y z A 1 7 13 19 B 2 -1 -4 20 C 3 -2 -5 21 D 4 -3 -6 22 E 5 11 17 23 F 6 12 18 24 > x2 <- x > subfill(x2) <- array(-(1:6),dim=c(3,2), dimnames=list(LETTERS[2:4],letters[24:25])) > x2 w x y z A 1 7 13 19 B 2 -1 -4 20 C 3 -2 -5 21 D 4 -3 -6 22 E 5 11 17 23 F 6 12 18 24 > identical(x1, x2) [1] T > x2 <- x > subfill(x2) <- array(-(1:6),dim=c(3,2), dimnames=list(LETTERS[5:7],letters[24:25])) Problem in "subfill<-.default"(x2, value = structure..: value has dimnames that are not in x; on dim[1]: 'G' > x2 <- x > subfill(x2,excess.ok=T) <- array(-(1:6),dim=c(3,2), dimnames=list(LETTERS[5:7],letters[24:25])) > x2 w x y z A 1 7 13 19 B 2 8 14 20 C 3 9 15 21 D 4 10 16 22 E 5 -1 -4 23 F 6 -2 -5 24 > x2 <- x > subfill(x2, local=T) <- array(-(1:6),dim=c(3,2), dimnames=list(LETTERS[2:4],letters[24:25])) > x2 w x y z A 1 7 13 19 B 2 -1 -4 20 C 3 -2 -5 21 D 4 -3 -6 22 E 5 11 17 23 F 6 12 18 24 > abind/tests/asub.Rout.save0000755000175100001440000001231411664205225015260 0ustar hornikusers > library(abind) > x <- array(1:24,dim=c(2,3,4),dimnames=list(letters[1:2],LETTERS[1:3],letters[23:26])) > dimnames(x) [[1]] [1] "a" "b" [[2]] [1] "A" "B" "C" [[3]] [1] "w" "x" "y" "z" > dimnames(asub(x, 1, 1)) [[1]] [1] "A" "B" "C" [[2]] [1] "w" "x" "y" "z" > # example using y to check that we're getting the right 'x' in the eval inside asub() > y <- array(1:24,dim=c(2,3,4),dimnames=list(LETTERS[1:2],letters[1:3],LETTERS[23:26])) > dimnames(asub(y, 1, 1, drop=TRUE)) [[1]] [1] "a" "b" "c" [[2]] [1] "W" "X" "Y" "Z" > dimnames(asub(x, 1, 1, drop=FALSE)) [[1]] [1] "a" [[2]] [1] "A" "B" "C" [[3]] [1] "w" "x" "y" "z" > dimnames(asub(x, 1, 2)) [[1]] [1] "a" "b" [[2]] [1] "w" "x" "y" "z" > dimnames(asub(x, 1, 2, drop=TRUE)) [[1]] [1] "a" "b" [[2]] [1] "w" "x" "y" "z" > dimnames(asub(x, 1, 2, drop=FALSE)) [[1]] [1] "a" "b" [[2]] [1] "A" [[3]] [1] "w" "x" "y" "z" > dimnames(asub(x, 1, 3)) [[1]] [1] "a" "b" [[2]] [1] "A" "B" "C" > dimnames(asub(x, 1, 3, drop=TRUE)) [[1]] [1] "a" "b" [[2]] [1] "A" "B" "C" > dimnames(asub(x, 1, 3, drop=FALSE)) [[1]] [1] "a" "b" [[2]] [1] "A" "B" "C" [[3]] [1] "w" > dimnames(asub(x, 1:2, 1)) [[1]] [1] "a" "b" [[2]] [1] "A" "B" "C" [[3]] [1] "w" "x" "y" "z" > dimnames(asub(x, 1:2, 1, drop=TRUE)) [[1]] [1] "a" "b" [[2]] [1] "A" "B" "C" [[3]] [1] "w" "x" "y" "z" > dimnames(asub(x, 1:2, 1, drop=FALSE)) [[1]] [1] "a" "b" [[2]] [1] "A" "B" "C" [[3]] [1] "w" "x" "y" "z" > dimnames(asub(x, 1:2, 2)) [[1]] [1] "a" "b" [[2]] [1] "A" "B" [[3]] [1] "w" "x" "y" "z" > dimnames(asub(x, 1:2, 2, drop=TRUE)) [[1]] [1] "a" "b" [[2]] [1] "A" "B" [[3]] [1] "w" "x" "y" "z" > dimnames(asub(x, 1:2, 2, drop=FALSE)) [[1]] [1] "a" "b" [[2]] [1] "A" "B" [[3]] [1] "w" "x" "y" "z" > dimnames(asub(x, 1:2, 3)) [[1]] [1] "a" "b" [[2]] [1] "A" "B" "C" [[3]] [1] "w" "x" > dimnames(asub(x, 1:2, 3, drop=TRUE)) [[1]] [1] "a" "b" [[2]] [1] "A" "B" "C" [[3]] [1] "w" "x" > dimnames(asub(x, 1:2, 3, drop=FALSE)) [[1]] [1] "a" "b" [[2]] [1] "A" "B" "C" [[3]] [1] "w" "x" > dimnames(asub(x, list(1:2,2), c(1,2))) [[1]] [1] "a" "b" [[2]] [1] "w" "x" "y" "z" > dimnames(asub(x, list(1:2,2), c(1,2), drop=TRUE)) [[1]] [1] "a" "b" [[2]] [1] "w" "x" "y" "z" > dimnames(asub(x, list(1:2,2), c(1,2), drop=FALSE)) [[1]] [1] "a" "b" [[2]] [1] "B" [[3]] [1] "w" "x" "y" "z" > dimnames(asub(x, list(1:2,2), c(2,1))) [[1]] [1] "A" "B" [[2]] [1] "w" "x" "y" "z" > dimnames(asub(x, list(1:2,2), c(2,1), drop=TRUE)) [[1]] [1] "A" "B" [[2]] [1] "w" "x" "y" "z" > dimnames(asub(x, list(1:2,2), c(2,1), drop=FALSE)) [[1]] [1] "b" [[2]] [1] "A" "B" [[3]] [1] "w" "x" "y" "z" > dimnames(asub(x, list(1:2,2), c(1,3))) [[1]] [1] "a" "b" [[2]] [1] "A" "B" "C" > dimnames(asub(x, list(1:2,2), c(1,3), drop=TRUE)) [[1]] [1] "a" "b" [[2]] [1] "A" "B" "C" > dimnames(asub(x, list(1:2,2), c(1,3), drop=FALSE)) [[1]] [1] "a" "b" [[2]] [1] "A" "B" "C" [[3]] [1] "x" > dimnames(asub(x, list(1:2,2), c(3,1))) [[1]] [1] "A" "B" "C" [[2]] [1] "w" "x" > dimnames(asub(x, list(1:2,2), c(3,1), drop=TRUE)) [[1]] [1] "A" "B" "C" [[2]] [1] "w" "x" > dimnames(asub(x, list(1:2,2), c(3,1), drop=FALSE)) [[1]] [1] "b" [[2]] [1] "A" "B" "C" [[3]] [1] "w" "x" > dimnames(asub(x, list(1:2,2), c(3,2))) [[1]] [1] "a" "b" [[2]] [1] "w" "x" > dimnames(asub(x, list(1:2,2), c(3,2), drop=TRUE)) [[1]] [1] "a" "b" [[2]] [1] "w" "x" > dimnames(asub(x, list(1:2,2), c(3,2), drop=FALSE)) [[1]] [1] "a" "b" [[2]] [1] "B" [[3]] [1] "w" "x" > dimnames(asub(x, list(1:2,2), c(2,3))) [[1]] [1] "a" "b" [[2]] [1] "A" "B" > dimnames(asub(x, list(1:2,2), c(2,3), drop=TRUE)) [[1]] [1] "a" "b" [[2]] [1] "A" "B" > dimnames(asub(x, list(1:2,2), c(2,3), drop=FALSE)) [[1]] [1] "a" "b" [[2]] [1] "A" "B" [[3]] [1] "x" > dimnames(asub(x, list(1:2,2:3,1:2), c(1,2,3))) [[1]] [1] "a" "b" [[2]] [1] "B" "C" [[3]] [1] "w" "x" > dimnames(asub(x, list(1:2,2:3,1:2), c(1,3,2))) [[1]] [1] "a" "b" [[2]] [1] "A" "B" [[3]] [1] "x" "y" > dimnames(asub(x, list(1:2,2:3,1:2))) [[1]] [1] "a" "b" [[2]] [1] "B" "C" [[3]] [1] "w" "x" > dimnames(asub(x, list(1:2,2,1:2))) [[1]] [1] "a" "b" [[2]] [1] "w" "x" > x <- 5:1 > asub(x, 2:3) [1] 4 3 > asub(x, list(2:3)) [1] 4 3 > x <- matrix(1:6, ncol=2) > asub(x, list(2:3,NULL)) [,1] [,2] [1,] 2 5 [2,] 3 6 > asub(x, list(2:3,NULL), drop=FALSE) [,1] [,2] [1,] 2 5 [2,] 3 6 > asub(x, list(NULL,1), drop=FALSE) [,1] [1,] 1 [2,] 2 [3,] 3 > asub(x, list(1), 1, drop=FALSE) [,1] [,2] [1,] 1 4 > asub(x, list(1), 2, drop=FALSE) [,1] [1,] 1 [2,] 2 [3,] 3 > i <- 1 > asub(x, i, 1) [1] 1 4 > (function() {i <- 2; asub(x, i, 1)})() [1] 2 5 > j <- 3 > (function() {i <- 2; asub(x, j, 1)})() [1] 3 6 > j <- 1 > (function() {i <- 2; asub(x, j, i)})() [1] 1 2 3 > (function() {i <- 2; (function() asub(x, j, i))()})() [1] 1 2 3 > > # 10-d example > x <- array(seq(len=prod(1:10)), dim=1:10) > dim(x) [1] 1 2 3 4 5 6 7 8 9 10 > dim(asub(x, 1, 1)) [1] 2 3 4 5 6 7 8 9 10 > dim(asub(x, 1, 2)) [1] 3 4 5 6 7 8 9 10 > dim(asub(x, 1, 3)) [1] 2 4 5 6 7 8 9 10 > dim(asub(x, 1, 3, drop=F)) [1] 1 2 1 4 5 6 7 8 9 10 > dim(asub(x, list(1,1), c(3,5), drop=F)) [1] 1 2 1 4 1 6 7 8 9 10 > dim(asub(x, list(1,1), c(3,5))) [1] 2 4 6 7 8 9 10 > abind/tests/asub.R0000755000175100001440000000474211664205225013601 0ustar hornikuserslibrary(abind) x <- array(1:24,dim=c(2,3,4),dimnames=list(letters[1:2],LETTERS[1:3],letters[23:26])) dimnames(x) dimnames(asub(x, 1, 1)) # example using y to check that we're getting the right 'x' in the eval inside asub() y <- array(1:24,dim=c(2,3,4),dimnames=list(LETTERS[1:2],letters[1:3],LETTERS[23:26])) dimnames(asub(y, 1, 1, drop=TRUE)) dimnames(asub(x, 1, 1, drop=FALSE)) dimnames(asub(x, 1, 2)) dimnames(asub(x, 1, 2, drop=TRUE)) dimnames(asub(x, 1, 2, drop=FALSE)) dimnames(asub(x, 1, 3)) dimnames(asub(x, 1, 3, drop=TRUE)) dimnames(asub(x, 1, 3, drop=FALSE)) dimnames(asub(x, 1:2, 1)) dimnames(asub(x, 1:2, 1, drop=TRUE)) dimnames(asub(x, 1:2, 1, drop=FALSE)) dimnames(asub(x, 1:2, 2)) dimnames(asub(x, 1:2, 2, drop=TRUE)) dimnames(asub(x, 1:2, 2, drop=FALSE)) dimnames(asub(x, 1:2, 3)) dimnames(asub(x, 1:2, 3, drop=TRUE)) dimnames(asub(x, 1:2, 3, drop=FALSE)) dimnames(asub(x, list(1:2,2), c(1,2))) dimnames(asub(x, list(1:2,2), c(1,2), drop=TRUE)) dimnames(asub(x, list(1:2,2), c(1,2), drop=FALSE)) dimnames(asub(x, list(1:2,2), c(2,1))) dimnames(asub(x, list(1:2,2), c(2,1), drop=TRUE)) dimnames(asub(x, list(1:2,2), c(2,1), drop=FALSE)) dimnames(asub(x, list(1:2,2), c(1,3))) dimnames(asub(x, list(1:2,2), c(1,3), drop=TRUE)) dimnames(asub(x, list(1:2,2), c(1,3), drop=FALSE)) dimnames(asub(x, list(1:2,2), c(3,1))) dimnames(asub(x, list(1:2,2), c(3,1), drop=TRUE)) dimnames(asub(x, list(1:2,2), c(3,1), drop=FALSE)) dimnames(asub(x, list(1:2,2), c(3,2))) dimnames(asub(x, list(1:2,2), c(3,2), drop=TRUE)) dimnames(asub(x, list(1:2,2), c(3,2), drop=FALSE)) dimnames(asub(x, list(1:2,2), c(2,3))) dimnames(asub(x, list(1:2,2), c(2,3), drop=TRUE)) dimnames(asub(x, list(1:2,2), c(2,3), drop=FALSE)) dimnames(asub(x, list(1:2,2:3,1:2), c(1,2,3))) dimnames(asub(x, list(1:2,2:3,1:2), c(1,3,2))) dimnames(asub(x, list(1:2,2:3,1:2))) dimnames(asub(x, list(1:2,2,1:2))) x <- 5:1 asub(x, 2:3) asub(x, list(2:3)) x <- matrix(1:6, ncol=2) asub(x, list(2:3,NULL)) asub(x, list(2:3,NULL), drop=FALSE) asub(x, list(NULL,1), drop=FALSE) asub(x, list(1), 1, drop=FALSE) asub(x, list(1), 2, drop=FALSE) i <- 1 asub(x, i, 1) (function() {i <- 2; asub(x, i, 1)})() j <- 3 (function() {i <- 2; asub(x, j, 1)})() j <- 1 (function() {i <- 2; asub(x, j, i)})() (function() {i <- 2; (function() asub(x, j, i))()})() # 10-d example x <- array(seq(len=prod(1:10)), dim=1:10) dim(x) dim(asub(x, 1, 1)) dim(asub(x, 1, 2)) dim(asub(x, 1, 3)) dim(asub(x, 1, 3, drop=F)) dim(asub(x, list(1,1), c(3,5), drop=F)) dim(asub(x, list(1,1), c(3,5))) abind/tests/afill.Rout.save0000755000175100001440000001067111664205225015421 0ustar hornikusers > library(abind) > options(error=function() NULL) > x <- array(0, dim=c(2,3,4),dimnames=list(letters[1:2],LETTERS[1:3],letters[23:26])) > # What we want to do here is get slices x[i,c("A","B"),c("w","x","y")] (for all i) > # to be matrix(1:6,ncol=3). > # If we assign in the standard way, and specify submatrices of the same shape in > # indices and as the value of the assign (but leave some indices on the LHS empty), > # then it is possible that submatrices do not end up being assigned to in the way > # we might expect, because the RHS value is flattened and replicated. > # This is only a problem when the repeating index has a lower dim number (here 1) > # than the specified indices (here 2 and 3). > x[,c("A","B"),c("w","x","y")] <- matrix(1:6,ncol=3) > x[1,c("A","B"),c("w","x","y")] w x y A 1 5 3 B 3 1 5 > x[2,c("A","B"),c("w","x","y")] w x y A 2 6 4 B 4 2 6 > # Assign in a way so that the RHS has its elements laid out in the same way > # as the LHS. > x[,c("A","B"),c("w","x","y")] <- rep(matrix(1:6,ncol=3), each=2) > # first slice > x[1,c("A","B"),c("w","x","y")] w x y A 1 3 5 B 2 4 6 > # second slice > x[2,c("A","B"),c("w","x","y")] w x y A 1 3 5 B 2 4 6 > > # now do it with afill() > x[] <- 0 > afill(x, TRUE, , ) <- matrix(1:6,ncol=3, dimnames=list(c("A","B"),c("w","x","y"))) > x[1,c("A","B"),c("w","x","y")] w x y A 1 3 5 B 2 4 6 > x[2,c("A","B"),c("w","x","y")] w x y A 1 3 5 B 2 4 6 > # mix up the order of the RHS of the assignment, afill will sort it back to match the LHS > x[] <- 0 > afill(x, T, , ) <- matrix(1:6,ncol=3, dimnames=list(c("A","B"),c("w","x","y")))[2:1,] > x[1,c("A","B"),c("w","x","y")] w x y A 1 3 5 B 2 4 6 > x[2,c("A","B"),c("w","x","y")] w x y A 1 3 5 B 2 4 6 > table(x==0) FALSE TRUE 12 12 > > # 4-d example > x <- array(0, dim=c(2,3,3,4),dimnames=list(letters[1:2],LETTERS[1:3],letters[24:26],LETTERS[23:26])) > x[1,c("A","B"),1,c("W","X","Y")] <- 1:6 > x[1,c("A","B"),2,c("W","X","Y")] <- 1:6 > x[1,c("A","B"),3,c("W","X","Y")] <- 1:6 > x[2,c("A","B"),1,c("W","X","Y")] <- 1:6 > x[2,c("A","B"),2,c("W","X","Y")] <- 1:6 > x[2,c("A","B"),3,c("W","X","Y")] <- 1:6 > c(x[1:2,c("A","B"),1:3,c("W","X","Y")]) [1] 1 1 2 2 1 1 2 2 1 1 2 2 3 3 4 4 3 3 4 4 3 3 4 4 5 5 6 6 5 5 6 6 5 5 6 6 > c(matrix(1:6, ncol=3)[rep(1:2, each=2),rep(1:3,each=3)]) [1] 1 1 2 2 1 1 2 2 1 1 2 2 3 3 4 4 3 3 4 4 3 3 4 4 5 5 6 6 5 5 6 6 5 5 6 6 > > afill(x, T, , T, ) <- matrix(1:6,ncol=3, dimnames=list(c("A","B"),c("W","X","Y"))) > x[1,c("A","B"),1,c("W","X","Y")] W X Y A 1 3 5 B 2 4 6 > x[1,c("A","B"),2,c("W","X","Y")] W X Y A 1 3 5 B 2 4 6 > x[1,c("A","B"),3,c("W","X","Y")] W X Y A 1 3 5 B 2 4 6 > x[2,c("A","B"),1,c("W","X","Y")] W X Y A 1 3 5 B 2 4 6 > x[2,c("A","B"),2,c("W","X","Y")] W X Y A 1 3 5 B 2 4 6 > x[2,c("A","B"),3,c("W","X","Y")] W X Y A 1 3 5 B 2 4 6 > table(x==0) FALSE TRUE 36 36 > > # 2-d example > x <- array(1:24, dim=c(6,4), dimnames=list(LETTERS[1:6], letters[23:26])) > x1 <- x > x1[2:4,2:3] <- -(1:6) > x1 w x y z A 1 7 13 19 B 2 -1 -4 20 C 3 -2 -5 21 D 4 -3 -6 22 E 5 11 17 23 F 6 12 18 24 > x1 <- x > x1[LETTERS[2:4],letters[24:25]] <- -(1:6) > x1 w x y z A 1 7 13 19 B 2 -1 -4 20 C 3 -2 -5 21 D 4 -3 -6 22 E 5 11 17 23 F 6 12 18 24 > x2 <- x > afill(x2) <- array(-(1:6),dim=c(3,2), dimnames=list(LETTERS[2:4],letters[24:25])) > x2 w x y z A 1 7 13 19 B 2 -1 -4 20 C 3 -2 -5 21 D 4 -3 -6 22 E 5 11 17 23 F 6 12 18 24 > identical(x1, x2) [1] TRUE > x2 <- x > afill(x2) <- array(-(1:6),dim=c(3,2), dimnames=list(LETTERS[5:7],letters[24:25])) Error in `afill<-.default`(`*tmp*`, value = c(-1L, -2L, -3L, -4L, -5L, : value has dimnames that are not in 'x' on dim[1]: 'G' Calls: afill<- -> afill<-.default > x2 <- x > afill(x2,excess.ok=T) <- array(-(1:6),dim=c(3,2), dimnames=list(LETTERS[5:7],letters[24:25])) > x2 w x y z A 1 7 13 19 B 2 8 14 20 C 3 9 15 21 D 4 10 16 22 E 5 -1 -4 23 F 6 -2 -5 24 > x2 <- x > afill(x2, local=T) <- array(-(1:6),dim=c(3,2), dimnames=list(LETTERS[2:4],letters[24:25])) > x2 w x y z A 1 7 13 19 B 2 -1 -4 20 C 3 -2 -5 21 D 4 -3 -6 22 E 5 11 17 23 F 6 12 18 24 > > # 1-d named-vector example > x <- c(A=0,B=0,C=0,D=0) > afill(x) <- c(B=1,C=2) > x A B C D 0 1 2 0 > # return value is the part of x that is assigned to > (afill(x) <- c(B=1,C=2)) B C 1 2 > (x[2:3] <- 0) [1] 0 > abind/tests/afill.R0000755000175100001440000000577011664205225013740 0ustar hornikuserslibrary(abind) options(error=function() NULL) x <- array(0, dim=c(2,3,4),dimnames=list(letters[1:2],LETTERS[1:3],letters[23:26])) # What we want to do here is get slices x[i,c("A","B"),c("w","x","y")] (for all i) # to be matrix(1:6,ncol=3). # If we assign in the standard way, and specify submatrices of the same shape in # indices and as the value of the assign (but leave some indices on the LHS empty), # then it is possible that submatrices do not end up being assigned to in the way # we might expect, because the RHS value is flattened and replicated. # This is only a problem when the repeating index has a lower dim number (here 1) # than the specified indices (here 2 and 3). x[,c("A","B"),c("w","x","y")] <- matrix(1:6,ncol=3) x[1,c("A","B"),c("w","x","y")] x[2,c("A","B"),c("w","x","y")] # Assign in a way so that the RHS has its elements laid out in the same way # as the LHS. x[,c("A","B"),c("w","x","y")] <- rep(matrix(1:6,ncol=3), each=2) # first slice x[1,c("A","B"),c("w","x","y")] # second slice x[2,c("A","B"),c("w","x","y")] # now do it with afill() x[] <- 0 afill(x, TRUE, , ) <- matrix(1:6,ncol=3, dimnames=list(c("A","B"),c("w","x","y"))) x[1,c("A","B"),c("w","x","y")] x[2,c("A","B"),c("w","x","y")] # mix up the order of the RHS of the assignment, afill will sort it back to match the LHS x[] <- 0 afill(x, T, , ) <- matrix(1:6,ncol=3, dimnames=list(c("A","B"),c("w","x","y")))[2:1,] x[1,c("A","B"),c("w","x","y")] x[2,c("A","B"),c("w","x","y")] table(x==0) # 4-d example x <- array(0, dim=c(2,3,3,4),dimnames=list(letters[1:2],LETTERS[1:3],letters[24:26],LETTERS[23:26])) x[1,c("A","B"),1,c("W","X","Y")] <- 1:6 x[1,c("A","B"),2,c("W","X","Y")] <- 1:6 x[1,c("A","B"),3,c("W","X","Y")] <- 1:6 x[2,c("A","B"),1,c("W","X","Y")] <- 1:6 x[2,c("A","B"),2,c("W","X","Y")] <- 1:6 x[2,c("A","B"),3,c("W","X","Y")] <- 1:6 c(x[1:2,c("A","B"),1:3,c("W","X","Y")]) c(matrix(1:6, ncol=3)[rep(1:2, each=2),rep(1:3,each=3)]) afill(x, T, , T, ) <- matrix(1:6,ncol=3, dimnames=list(c("A","B"),c("W","X","Y"))) x[1,c("A","B"),1,c("W","X","Y")] x[1,c("A","B"),2,c("W","X","Y")] x[1,c("A","B"),3,c("W","X","Y")] x[2,c("A","B"),1,c("W","X","Y")] x[2,c("A","B"),2,c("W","X","Y")] x[2,c("A","B"),3,c("W","X","Y")] table(x==0) # 2-d example x <- array(1:24, dim=c(6,4), dimnames=list(LETTERS[1:6], letters[23:26])) x1 <- x x1[2:4,2:3] <- -(1:6) x1 x1 <- x x1[LETTERS[2:4],letters[24:25]] <- -(1:6) x1 x2 <- x afill(x2) <- array(-(1:6),dim=c(3,2), dimnames=list(LETTERS[2:4],letters[24:25])) x2 identical(x1, x2) x2 <- x afill(x2) <- array(-(1:6),dim=c(3,2), dimnames=list(LETTERS[5:7],letters[24:25])) x2 <- x afill(x2,excess.ok=T) <- array(-(1:6),dim=c(3,2), dimnames=list(LETTERS[5:7],letters[24:25])) x2 x2 <- x afill(x2, local=T) <- array(-(1:6),dim=c(3,2), dimnames=list(LETTERS[2:4],letters[24:25])) x2 # 1-d named-vector example x <- c(A=0,B=0,C=0,D=0) afill(x) <- c(B=1,C=2) x # return value is the part of x that is assigned to (afill(x) <- c(B=1,C=2)) (x[2:3] <- 0) abind/tests/adrop.Rout.save0000755000175100001440000000257611664205225015444 0ustar hornikusers > library(abind) > x <- array(1:24,dim=c(2,3,4),dimnames=list(letters[1:2],LETTERS[1:3],letters[23:26])) > adrop(x[1,,,drop=FALSE],drop=1) w x y z A 1 7 13 19 B 3 9 15 21 C 5 11 17 23 > adrop(x[,1,,drop=FALSE],drop=2) w x y z a 1 7 13 19 b 2 8 14 20 > adrop(x[,,1,drop=FALSE],drop=3) A B C a 1 3 5 b 2 4 6 > adrop(x[1,1,1,drop=FALSE],drop=1) w A 1 > adrop(x[1,1,1,drop=FALSE],drop=2) w a 1 > adrop(x[1,1,1,drop=FALSE],drop=3) A a 1 > adrop(x[1,1,1,drop=FALSE],drop=1:2) w 1 > adrop(x[1,1,1,drop=FALSE],drop=1:2,one.d=TRUE) w 1 > adrop(x[1,1,1,drop=FALSE],drop=1:2,named=FALSE) [1] 1 > dim(adrop(x[1,1,1,drop=FALSE],drop=1:2,one.d=TRUE)) [1] 1 > dimnames(adrop(x[1,1,1,drop=FALSE],drop=1:2,one.d=TRUE)) [[1]] [1] "w" > names(adrop(x[1,1,1,drop=FALSE],drop=1:2,one.d=TRUE)) [1] "w" > dim(adrop(x[1,1,1,drop=FALSE],drop=1:2)) NULL > dimnames(adrop(x[1,1,1,drop=FALSE],drop=1:2)) NULL > names(adrop(x[1,1,1,drop=FALSE],drop=1:2)) [1] "w" > x <- array(1:3, dimnames=list(letters[1:3])) > x a b c 1 2 3 > options(error=function() NULL) > adrop(x) Error in adrop.default(x) : dimensions to drop (1) do not have length 1 Calls: adrop -> adrop.default > dim(adrop(x)) Error in adrop.default(x) : dimensions to drop (1) do not have length 1 Calls: adrop -> adrop.default > adrop(x, NULL) a b c 1 2 3 > dim(adrop(x, NULL)) NULL > abind/tests/adrop.R0000755000175100001440000000156311664205225013752 0ustar hornikuserslibrary(abind) x <- array(1:24,dim=c(2,3,4),dimnames=list(letters[1:2],LETTERS[1:3],letters[23:26])) adrop(x[1,,,drop=FALSE],drop=1) adrop(x[,1,,drop=FALSE],drop=2) adrop(x[,,1,drop=FALSE],drop=3) adrop(x[1,1,1,drop=FALSE],drop=1) adrop(x[1,1,1,drop=FALSE],drop=2) adrop(x[1,1,1,drop=FALSE],drop=3) adrop(x[1,1,1,drop=FALSE],drop=1:2) adrop(x[1,1,1,drop=FALSE],drop=1:2,one.d=TRUE) adrop(x[1,1,1,drop=FALSE],drop=1:2,named=FALSE) dim(adrop(x[1,1,1,drop=FALSE],drop=1:2,one.d=TRUE)) dimnames(adrop(x[1,1,1,drop=FALSE],drop=1:2,one.d=TRUE)) names(adrop(x[1,1,1,drop=FALSE],drop=1:2,one.d=TRUE)) dim(adrop(x[1,1,1,drop=FALSE],drop=1:2)) dimnames(adrop(x[1,1,1,drop=FALSE],drop=1:2)) names(adrop(x[1,1,1,drop=FALSE],drop=1:2)) x <- array(1:3, dimnames=list(letters[1:3])) x options(error=function() NULL) adrop(x) dim(adrop(x)) adrop(x, NULL) dim(adrop(x, NULL)) abind/tests/abind.Rout.save0000755000175100001440000002724511664205225015414 0ustar hornikusers > library(abind) > # unlike cbind or rbind > abind(x=1:4,y=5:8) x1 x2 x3 x4 y1 y2 y3 y4 1 2 3 4 5 6 7 8 > # like cbind > abind(x=1:4,y=5:8,along=2) x y [1,] 1 5 [2,] 2 6 [3,] 3 7 [4,] 4 8 > abind(x=1:4,matrix(5:20,nrow=4),along=2) x [1,] 1 5 9 13 17 [2,] 2 6 10 14 18 [3,] 3 7 11 15 19 [4,] 4 8 12 16 20 > abind(1:4,matrix(5:20,nrow=4),along=2) [,1] [,2] [,3] [,4] [,5] [1,] 1 5 9 13 17 [2,] 2 6 10 14 18 [3,] 3 7 11 15 19 [4,] 4 8 12 16 20 > # like rbind > abind(x=1:4,matrix(5:20,nrow=4),along=1) [,1] [,2] [,3] [,4] x 1 2 3 4 5 9 13 17 6 10 14 18 7 11 15 19 8 12 16 20 > abind(1:4,matrix(5:20,nrow=4),along=1,make.names=TRUE) [,1] [,2] [,3] [,4] 1:4 1 2 3 4 matrix(5:20, nrow = 4)1 5 9 13 17 matrix(5:20, nrow = 4)2 6 10 14 18 matrix(5:20, nrow = 4)3 7 11 15 19 matrix(5:20, nrow = 4)4 8 12 16 20 > # different default dimnames: > abind(x=1:4,matrix(5:20,nrow=4),along=1) [,1] [,2] [,3] [,4] x 1 2 3 4 5 9 13 17 6 10 14 18 7 11 15 19 8 12 16 20 > abind(x=1:4,matrix(5:20,nrow=4),along=1,force.array=FALSE) [,1] [,2] [,3] [,4] x 1 2 3 4 5 9 13 17 6 10 14 18 7 11 15 19 8 12 16 20 > # concatenates two vectors: > abind(x=1:4,y=5:8) x1 x2 x3 x4 y1 y2 y3 y4 1 2 3 4 5 6 7 8 > abind(x=c(a=1,b=2),y=3:4) a b y1 y2 1 2 3 4 > abind(x=c(a=1,b=2),y=c(c=3,d=4)) a b c d 1 2 3 4 > # simulate rbind with row vectors in three ways: > # (1) easiest way: insert new dimension before 1 (use any number less than 1 for along) > abind(x=1:4,y=5:8,along=0.5) [,1] [,2] [,3] [,4] x 1 2 3 4 y 5 6 7 8 > abind(x=c(a=1,b=2),y=c(c=3,d=4), along=0) # with names c d x 1 2 y 3 4 > abind(x=c(a=1,b=2),y=c(c=3,d=4), along=0, use.first.dimnames=TRUE) a b x 1 2 y 3 4 > # (2) permute the result: > aperm(abind(1:4,5:8,along=2),c(2,1)) [,1] [,2] [,3] [,4] [1,] 1 2 3 4 [2,] 5 6 7 8 > # different default dimnames: > aperm(abind(1:4,5:8,along=2,make.names=TRUE),c(2,1)) [,1] [,2] [,3] [,4] 1:4 1 2 3 4 5:8 5 6 7 8 > # (3) convert arguments to row vectors > abind(matrix(1:4,nrow=1),matrix(5:8,nrow=1),along=1) [,1] [,2] [,3] [,4] [1,] 1 2 3 4 [2,] 5 6 7 8 > # bind two matrices, 5 possible values for along > abind(x=matrix(1:16,nrow=4),y=matrix(17:32,nrow=4),along=1) [,1] [,2] [,3] [,4] x1 1 5 9 13 x2 2 6 10 14 x3 3 7 11 15 x4 4 8 12 16 y1 17 21 25 29 y2 18 22 26 30 y3 19 23 27 31 y4 20 24 28 32 > abind(x=matrix(1:16,nrow=4),y=matrix(17:32,nrow=4),along=2) x1 x2 x3 x4 y1 y2 y3 y4 [1,] 1 5 9 13 17 21 25 29 [2,] 2 6 10 14 18 22 26 30 [3,] 3 7 11 15 19 23 27 31 [4,] 4 8 12 16 20 24 28 32 > abind(x=matrix(1:16,nrow=4),y=matrix(17:32,nrow=4),along=3) , , x [,1] [,2] [,3] [,4] [1,] 1 5 9 13 [2,] 2 6 10 14 [3,] 3 7 11 15 [4,] 4 8 12 16 , , y [,1] [,2] [,3] [,4] [1,] 17 21 25 29 [2,] 18 22 26 30 [3,] 19 23 27 31 [4,] 20 24 28 32 > abind(x=matrix(1:16,nrow=4),y=matrix(17:32,nrow=4),along=0.5) , , 1 [,1] [,2] [,3] [,4] x 1 2 3 4 y 17 18 19 20 , , 2 [,1] [,2] [,3] [,4] x 5 6 7 8 y 21 22 23 24 , , 3 [,1] [,2] [,3] [,4] x 9 10 11 12 y 25 26 27 28 , , 4 [,1] [,2] [,3] [,4] x 13 14 15 16 y 29 30 31 32 > abind(x=matrix(1:16,nrow=4),y=matrix(17:32,nrow=4),along=1.5) , , 1 x y [1,] 1 17 [2,] 2 18 [3,] 3 19 [4,] 4 20 , , 2 x y [1,] 5 21 [2,] 6 22 [3,] 7 23 [4,] 8 24 , , 3 x y [1,] 9 25 [2,] 10 26 [3,] 11 27 [4,] 12 28 , , 4 x y [1,] 13 29 [2,] 14 30 [3,] 15 31 [4,] 16 32 > # examples with three matrices > cc <- as.data.frame(matrix(25:36,nrow=3)) > aa <- matrix(1:12,nrow=3,dimnames=list(letters[1:3],LETTERS[1:4])) > # Note that names on cc are lost with as.matrix > rownames(cc) [1] "1" "2" "3" > rownames(as.matrix(cc)) NULL > abind(a=aa, cc, matrix(25:36,3,4), along=0, use.first.dimnames=TRUE) , , A a b c a 1 2 3 25 26 27 25 26 27 , , B a b c a 4 5 6 28 29 30 28 29 30 , , C a b c a 7 8 9 31 32 33 31 32 33 , , D a b c a 10 11 12 34 35 36 34 35 36 > abind(a=aa, cc, matrix(25:36,3,4), along=1, use.first.dimnames=TRUE) A B C D a 1 4 7 10 b 2 5 8 11 c 3 6 9 12 25 28 31 34 26 29 32 35 27 30 33 36 25 28 31 34 26 29 32 35 27 30 33 36 > abind(a=aa, cc, matrix(25:36,3,4), along=1.1, use.first.dimnames=TRUE) , , A a a 1 25 25 b 2 26 26 c 3 27 27 , , B a a 4 28 28 b 5 29 29 c 6 30 30 , , C a a 7 31 31 b 8 32 32 c 9 33 33 , , D a a 10 34 34 b 11 35 35 c 12 36 36 > abind(a=aa, cc, matrix(25:36,3,4), along=2) A B C D V1 V2 V3 V4 a 1 4 7 10 25 28 31 34 25 28 31 34 b 2 5 8 11 26 29 32 35 26 29 32 35 c 3 6 9 12 27 30 33 36 27 30 33 36 > abind(a=aa, cc, matrix(25:36,3,4), along=2, use.first.dimnames=TRUE) A B C D V1 V2 V3 V4 a 1 4 7 10 25 28 31 34 25 28 31 34 b 2 5 8 11 26 29 32 35 26 29 32 35 c 3 6 9 12 27 30 33 36 27 30 33 36 > abind(a=aa, cc, matrix(25:36,3,4), along=3, use.first.dimnames=TRUE) , , a A B C D a 1 4 7 10 b 2 5 8 11 c 3 6 9 12 , , A B C D a 25 28 31 34 b 26 29 32 35 c 27 30 33 36 , , A B C D a 25 28 31 34 b 26 29 32 35 c 27 30 33 36 > abind(a=aa, cc, matrix(25:36,3,4), along=3, make.names=TRUE, use.first.dimnames=TRUE) , , a A B C D a 1 4 7 10 b 2 5 8 11 c 3 6 9 12 , , cc A B C D a 25 28 31 34 b 26 29 32 35 c 27 30 33 36 , , matrix(25:36, 3, 4) A B C D a 25 28 31 34 b 26 29 32 35 c 27 30 33 36 > abind(a=aa, cc, dd=matrix(25:36,3,4), along=1.1, use.first.dimnames=TRUE) , , A a dd a 1 25 25 b 2 26 26 c 3 27 27 , , B a dd a 4 28 28 b 5 29 29 c 6 30 30 , , C a dd a 7 31 31 b 8 32 32 c 9 33 33 , , D a dd a 10 34 34 b 11 35 35 c 12 36 36 > x1 <- array(1:8,dim=c(2,2,2),dimnames=list(letters[6:7],letters[1:2],letters[24:25])) > x1 , , x a b f 1 3 g 2 4 , , y a b f 5 7 g 6 8 > # test that we get dimnames correctly when we need to expand dimensions > x2.1 <- array(11:14,dim=c(2,2),dimnames=list(letters[1:2],letters[24:25])) > x2.2 <- array(11:14,dim=c(2,2),dimnames=list(letters[6:7],letters[24:25])) > x2.3 <- array(11:14,dim=c(2,2),dimnames=list(letters[6:7],letters[1:2])) > abind(x1, h=x2.1, along=1) , , x a b f 1 3 g 2 4 h 11 12 , , y a b f 5 7 g 6 8 h 13 14 > abind(x1, c=x2.2, along=2) , , x a b c f 1 3 11 g 2 4 12 , , y a b c f 5 7 13 g 6 8 14 > abind(x1, z=x2.3, along=3) , , x a b f 1 3 g 2 4 , , y a b f 5 7 g 6 8 , , z a b f 11 13 g 12 14 > # Five different ways of binding together two matrices > x <- matrix(1:12,3,4) > y <- x+100 > dim(abind(x,y,along=0)) [1] 2 3 4 > dim(abind(x,y,along=1)) [1] 6 4 > dim(abind(x,y,along=1.5)) [1] 3 2 4 > dim(abind(x,y,along=2)) [1] 3 8 > dim(abind(x,y,along=3)) [1] 3 4 2 > dim(abind(x,y,rev.along=0)) [1] 3 4 2 > dim(abind(x,y,rev.along=1)) [1] 3 8 > # using a list argument > abind(list(x=1:4,y=5:8)) x1 x2 x3 x4 y1 y2 y3 y4 1 2 3 4 5 6 7 8 > abind(list(x=1:4,y=5:8),along=2) x y [1,] 1 5 [2,] 2 6 [3,] 3 7 [4,] 4 8 > abind(list(x=1:4,matrix(5:20,nrow=4)),along=2) x [1,] 1 5 9 13 17 [2,] 2 6 10 14 18 [3,] 3 7 11 15 19 [4,] 4 8 12 16 20 > abind(list(1:4,matrix(5:20,nrow=4)),along=2) [,1] [,2] [,3] [,4] [,5] [1,] 1 5 9 13 17 [2,] 2 6 10 14 18 [3,] 3 7 11 15 19 [4,] 4 8 12 16 20 > L <- list(1:4,matrix(5:20,nrow=4)) > abind(L,along=2) [,1] [,2] [,3] [,4] [,5] [1,] 1 5 9 13 17 [2,] 2 6 10 14 18 [3,] 3 7 11 15 19 [4,] 4 8 12 16 20 > abind(L,along=1) [,1] [,2] [,3] [,4] [1,] 1 2 3 4 [2,] 5 9 13 17 [3,] 6 10 14 18 [4,] 7 11 15 19 [5,] 8 12 16 20 > L <- list(x=1:4,matrix(5:20,nrow=4)) > abind(L,along=2) x [1,] 1 5 9 13 17 [2,] 2 6 10 14 18 [3,] 3 7 11 15 19 [4,] 4 8 12 16 20 > # Equivalent call to cbind > do.call("cbind", L) x [1,] 1 5 9 13 17 [2,] 2 6 10 14 18 [3,] 3 7 11 15 19 [4,] 4 8 12 16 20 > # Equivalent call to rbind > abind(L,along=1) [,1] [,2] [,3] [,4] x 1 2 3 4 5 9 13 17 6 10 14 18 7 11 15 19 8 12 16 20 > do.call("rbind", L) [,1] [,2] [,3] [,4] x 1 2 3 4 5 9 13 17 6 10 14 18 7 11 15 19 8 12 16 20 > L <- list(x=1:4,y=5:8) > abind(L,along=0) [,1] [,2] [,3] [,4] x 1 2 3 4 y 5 6 7 8 > abind(L,along=1) x1 x2 x3 x4 y1 y2 y3 y4 1 2 3 4 5 6 7 8 > abind(L,along=2) x y [1,] 1 5 [2,] 2 6 [3,] 3 7 [4,] 4 8 > # behavior with NULL objects > dim(abind(list(a=NULL, b=NULL), along=1)) NULL > abind(list(a=NULL, b=NULL), along=1) NULL > dimnames(abind(list(a=NULL, b=NULL), along=1)) NULL > abind(list(a=NULL, b=NULL), along=2) NULL > dim(abind(list(a=NULL, b=NULL), along=2)) NULL > dimnames(abind(list(a=NULL, b=NULL), along=2)) NULL > abind(list(a=NULL, b=NULL), along=0) NULL > dim(abind(list(a=NULL, b=NULL), along=0)) NULL > dimnames(abind(list(a=NULL, b=NULL), along=0)) NULL > abind(list(a=NULL, b=NULL), along=3) NULL > # behavior with numeric(0) objects > dim(abind(list(a=numeric(0), b=numeric(0)), along=1)) [1] 0 > abind(list(a=numeric(0), b=numeric(0)), along=1) numeric(0) > dimnames(abind(list(a=numeric(0), b=numeric(0)), along=1)) [[1]] NULL > abind(list(a=numeric(0), b=numeric(0)), along=2) a b > dim(abind(list(a=numeric(0), b=numeric(0)), along=2)) [1] 0 2 > dimnames(abind(list(a=numeric(0), b=numeric(0)), along=2)) [[1]] NULL [[2]] [1] "a" "b" > abind(list(a=numeric(0), b=numeric(0)), along=0) a b > dim(abind(list(a=numeric(0), b=numeric(0)), along=0)) [1] 2 0 > dimnames(abind(list(a=numeric(0), b=numeric(0)), along=0)) [[1]] [1] "a" "b" [[2]] NULL > # check hierarchical name construction > abind(x=cbind(1:3,4:6)) x1 x2 [1,] 1 4 [2,] 2 5 [3,] 3 6 > abind(x=cbind(a=1:3,b=4:6), hier.names=TRUE) x.a x.b [1,] 1 4 [2,] 2 5 [3,] 3 6 > abind(x=cbind(1:3,4:6), hier.names=TRUE) x1 x2 [1,] 1 4 [2,] 2 5 [3,] 3 6 > abind(cbind(a=1:3,b=4:6)) a b [1,] 1 4 [2,] 2 5 [3,] 3 6 > abind(cbind(1:3,4:6), hier.names=TRUE) [,1] [,2] [1,] 1 4 [2,] 2 5 [3,] 3 6 > abind(cbind(a=1:3,b=4:6), hier.names=TRUE) a b [1,] 1 4 [2,] 2 5 [3,] 3 6 > abind(cbind(a=1:3,b=4:6), cbind(a=7:9,b=10:12), hier.names=TRUE) a b a b [1,] 1 4 7 10 [2,] 2 5 8 11 [3,] 3 6 9 12 > abind(x=cbind(a=1:3,b=4:6), y=cbind(a=7:9,b=10:12), hier.names=TRUE) x.a x.b y.a y.b [1,] 1 4 7 10 [2,] 2 5 8 11 [3,] 3 6 9 12 > abind(x=cbind(1:3,4:6), y=cbind(7:9,10:12), hier.names=TRUE) x1 x2 y1 y2 [1,] 1 4 7 10 [2,] 2 5 8 11 [3,] 3 6 9 12 > abind(cbind(1:3,4:6), cbind(7:9,10:12), hier.names=TRUE) [,1] [,2] [,3] [,4] [1,] 1 4 7 10 [2,] 2 5 8 11 [3,] 3 6 9 12 > abind/tests/abind.R0000755000175100001440000001156711664205225013727 0ustar hornikuserslibrary(abind) # unlike cbind or rbind abind(x=1:4,y=5:8) # like cbind abind(x=1:4,y=5:8,along=2) abind(x=1:4,matrix(5:20,nrow=4),along=2) abind(1:4,matrix(5:20,nrow=4),along=2) # like rbind abind(x=1:4,matrix(5:20,nrow=4),along=1) abind(1:4,matrix(5:20,nrow=4),along=1,make.names=TRUE) # different default dimnames: abind(x=1:4,matrix(5:20,nrow=4),along=1) abind(x=1:4,matrix(5:20,nrow=4),along=1,force.array=FALSE) # concatenates two vectors: abind(x=1:4,y=5:8) abind(x=c(a=1,b=2),y=3:4) abind(x=c(a=1,b=2),y=c(c=3,d=4)) # simulate rbind with row vectors in three ways: # (1) easiest way: insert new dimension before 1 (use any number less than 1 for along) abind(x=1:4,y=5:8,along=0.5) abind(x=c(a=1,b=2),y=c(c=3,d=4), along=0) # with names abind(x=c(a=1,b=2),y=c(c=3,d=4), along=0, use.first.dimnames=TRUE) # (2) permute the result: aperm(abind(1:4,5:8,along=2),c(2,1)) # different default dimnames: aperm(abind(1:4,5:8,along=2,make.names=TRUE),c(2,1)) # (3) convert arguments to row vectors abind(matrix(1:4,nrow=1),matrix(5:8,nrow=1),along=1) # bind two matrices, 5 possible values for along abind(x=matrix(1:16,nrow=4),y=matrix(17:32,nrow=4),along=1) abind(x=matrix(1:16,nrow=4),y=matrix(17:32,nrow=4),along=2) abind(x=matrix(1:16,nrow=4),y=matrix(17:32,nrow=4),along=3) abind(x=matrix(1:16,nrow=4),y=matrix(17:32,nrow=4),along=0.5) abind(x=matrix(1:16,nrow=4),y=matrix(17:32,nrow=4),along=1.5) # examples with three matrices cc <- as.data.frame(matrix(25:36,nrow=3)) aa <- matrix(1:12,nrow=3,dimnames=list(letters[1:3],LETTERS[1:4])) # Note that names on cc are lost with as.matrix rownames(cc) rownames(as.matrix(cc)) abind(a=aa, cc, matrix(25:36,3,4), along=0, use.first.dimnames=TRUE) abind(a=aa, cc, matrix(25:36,3,4), along=1, use.first.dimnames=TRUE) abind(a=aa, cc, matrix(25:36,3,4), along=1.1, use.first.dimnames=TRUE) abind(a=aa, cc, matrix(25:36,3,4), along=2) abind(a=aa, cc, matrix(25:36,3,4), along=2, use.first.dimnames=TRUE) abind(a=aa, cc, matrix(25:36,3,4), along=3, use.first.dimnames=TRUE) abind(a=aa, cc, matrix(25:36,3,4), along=3, make.names=TRUE, use.first.dimnames=TRUE) abind(a=aa, cc, dd=matrix(25:36,3,4), along=1.1, use.first.dimnames=TRUE) x1 <- array(1:8,dim=c(2,2,2),dimnames=list(letters[6:7],letters[1:2],letters[24:25])) x1 # test that we get dimnames correctly when we need to expand dimensions x2.1 <- array(11:14,dim=c(2,2),dimnames=list(letters[1:2],letters[24:25])) x2.2 <- array(11:14,dim=c(2,2),dimnames=list(letters[6:7],letters[24:25])) x2.3 <- array(11:14,dim=c(2,2),dimnames=list(letters[6:7],letters[1:2])) abind(x1, h=x2.1, along=1) abind(x1, c=x2.2, along=2) abind(x1, z=x2.3, along=3) # Five different ways of binding together two matrices x <- matrix(1:12,3,4) y <- x+100 dim(abind(x,y,along=0)) dim(abind(x,y,along=1)) dim(abind(x,y,along=1.5)) dim(abind(x,y,along=2)) dim(abind(x,y,along=3)) dim(abind(x,y,rev.along=0)) dim(abind(x,y,rev.along=1)) # using a list argument abind(list(x=1:4,y=5:8)) abind(list(x=1:4,y=5:8),along=2) abind(list(x=1:4,matrix(5:20,nrow=4)),along=2) abind(list(1:4,matrix(5:20,nrow=4)),along=2) L <- list(1:4,matrix(5:20,nrow=4)) abind(L,along=2) abind(L,along=1) L <- list(x=1:4,matrix(5:20,nrow=4)) abind(L,along=2) # Equivalent call to cbind do.call("cbind", L) # Equivalent call to rbind abind(L,along=1) do.call("rbind", L) L <- list(x=1:4,y=5:8) abind(L,along=0) abind(L,along=1) abind(L,along=2) # behavior with NULL objects dim(abind(list(a=NULL, b=NULL), along=1)) abind(list(a=NULL, b=NULL), along=1) dimnames(abind(list(a=NULL, b=NULL), along=1)) abind(list(a=NULL, b=NULL), along=2) dim(abind(list(a=NULL, b=NULL), along=2)) dimnames(abind(list(a=NULL, b=NULL), along=2)) abind(list(a=NULL, b=NULL), along=0) dim(abind(list(a=NULL, b=NULL), along=0)) dimnames(abind(list(a=NULL, b=NULL), along=0)) abind(list(a=NULL, b=NULL), along=3) # behavior with numeric(0) objects dim(abind(list(a=numeric(0), b=numeric(0)), along=1)) abind(list(a=numeric(0), b=numeric(0)), along=1) dimnames(abind(list(a=numeric(0), b=numeric(0)), along=1)) abind(list(a=numeric(0), b=numeric(0)), along=2) dim(abind(list(a=numeric(0), b=numeric(0)), along=2)) dimnames(abind(list(a=numeric(0), b=numeric(0)), along=2)) abind(list(a=numeric(0), b=numeric(0)), along=0) dim(abind(list(a=numeric(0), b=numeric(0)), along=0)) dimnames(abind(list(a=numeric(0), b=numeric(0)), along=0)) # check hierarchical name construction abind(x=cbind(1:3,4:6)) abind(x=cbind(a=1:3,b=4:6), hier.names=TRUE) abind(x=cbind(1:3,4:6), hier.names=TRUE) abind(cbind(a=1:3,b=4:6)) abind(cbind(1:3,4:6), hier.names=TRUE) abind(cbind(a=1:3,b=4:6), hier.names=TRUE) abind(cbind(a=1:3,b=4:6), cbind(a=7:9,b=10:12), hier.names=TRUE) abind(x=cbind(a=1:3,b=4:6), y=cbind(a=7:9,b=10:12), hier.names=TRUE) abind(x=cbind(1:3,4:6), y=cbind(7:9,10:12), hier.names=TRUE) abind(cbind(1:3,4:6), cbind(7:9,10:12), hier.names=TRUE) abind/R/0000755000175100001440000000000011664205225011551 5ustar hornikusersabind/R/asub.R0000755000175100001440000000206311664205225012632 0ustar hornikusersasub <- function(x, idx, dims=seq(len=max(length(dim(x)), 1)), drop=NULL) UseMethod("asub") asub.default <- function(x, idx, dims=seq(len=max(length(dim(x)), 1)), drop=NULL) { # Do arbitrary indexing of x as positions in dims if (length(dims)>1 && !is.list(idx)) stop("idx must be a list when length dims>1") if (!is.list(idx)) idx <- list(idx) if (length(idx) != length(dims)) stop("idx has different number of indices than dims") # Construct a skeleton call xic <- Quote(x[,drop=drop]) d <- dim(x) if (is.null(d)) d <- length(x) if (any(dims < 1 | dims > length(d))) stop("dims out of range") # Now duplicate the empty index argument the appropriate number of times xic <- xic[c(1, 2, rep(3, length(d)), 4)] if (is.null(drop)) { xic <- xic[-length(xic)] } else { xic[[length(xic)]] <- drop } for (i in seq(along=dims)) if (!is.null(idx[[i]])) xic[2+dims[i]] <- idx[i] return(eval(xic)) # , envir=parent.frame(), enclos=baseenv())) } abind/R/afill.R0000755000175100001440000001531311664205225012771 0ustar hornikusers"afill<-" <- function(x, ..., excess.ok=FALSE, local=TRUE, value) UseMethod("afill<-") "afill<-.default" <- function(x, ..., excess.ok=FALSE, local=TRUE, value) { # The idea of afill<- is that some of the indices can be specified on the LHS # and the others are taken from the dimnames of the RHS, e.g., if length(dim(x))==4 # and y is a matrix, then # afill(x, , 2:3, , T) <- y # will use the indices list(rownames(y), 2:3, colnames(y), T) to assign # the values of y into x. x.dn <- if (length(dim(x))) dimnames(x) else list(names(x)) x.d <- if (length(dim(x))) dim(x) else length(x) value.dn <- if (length(dim(value))) dimnames(value) else list(names(value)) value.d <- if (length(dim(value))) dim(value) else length(value) # to find the empty anon args, must work with the unevaluated dot args dot.args.uneval <- match.call(expand.dots=FALSE)$... if (length(dot.args.uneval)) missing.dot.args <- sapply(dot.args.uneval, function(arg) is.symbol(arg) && as.character(arg)=="") else missing.dot.args <- logical(0) if (length(value.d) < length(x.d)) { if (length(dot.args.uneval)==0) { stop("must supply anonymous args to show how value matches up with x") } else { if (sum(!missing.dot.args) + max(length(value.d),1) != max(length(x.d),1)) stop("must have ", length(x.d)-max(length(value.d),1), " non-missing anon args to assign a ", max(length(value.d), 1), "-d value into a ", max(length(x.d), 1), "-d array") } } else if (length(value.d) == length(x.d)) { if (length(dot.args.uneval)==0) { dot.args.uneval <- vector("list", length(x.d)) missing.dot.args <- rep(TRUE, length(x.d)) } else if (length(dot.args.uneval) != length(x.d)) { stop("must have 0 or ", length(x.d), " empty arguments when 'x' and 'value' have same number of dims") } } else { stop("does not make sense to have more dims in value than x") } if (any(missing.dot.args) && (is.null(x.dn) || any(missing.dot.args & sapply(x.dn, length)==0 & x.d!=0))) stop("'x' must have names on dimensions corresponding to those in 'value'") if (any(missing.dot.args) && (is.null(value.dn) || any(sapply(value.dn, length)==0 & value.d!=0))) stop("'value' must have names on dimensions corresponding to empty args on the LHS") # Now we can work with evaluated dot args. # Can't do dot.args <- list(...) because that will # stop with an error for missing args. dot.args <- mapply(dot.args.uneval, missing.dot.args, FUN=function(arg, m) if (!m) eval(arg) else NULL) # construct the numeric indices idxs <- vector("list", length(x.d)) strip.excess <- FALSE for (i in seq(len=length(x.d))) { if (missing.dot.args[i]) { j <- cumsum(missing.dot.args)[i] # dim-num in value idxs[[i]] <- match(value.dn[[j]], x.dn[[i]], nomatch=0) if (any(idxs[[i]]==0)) { if (!excess.ok) stop("value has dimnames that are not in 'x' on dim[", i, "]: ", paste("'", value.dn[[j]][which(idxs[[i]]==0)[min(3, sum(idxs[[i]]==0))]], "'", sep="", collapse=", "), if (sum(idxs[[i]]==0)>3) " ...") strip.excess <- TRUE } } else { if (is.character(dot.args[[i]])) { if (length(x.dn[[i]]) != x.d[i]) stop("'x' doesn't have dimnames on dim ", i) idxs[[i]] <- match(dot.args[[i]], x.dn[[i]], nomatch=NA) if (any(is.na(idxs[[i]]))) stop("LHS character indicies at on dim ", i, " not matched: ", paste("'", dot.args[[i]][which(is.na(idxs[[i]]))[seq(len=min(3, sum(is.na(idxs[[i]]))))]], "'", collapse=", ")) } else if (is.logical(dot.args[[i]])) { idxs[[i]] <- seq(len=x.d[i])[dot.args[[i]]] if (any(is.na(idxs[[i]]))) stop("LHS logical indicies at on dim ", i, " have NA value") } else if (is.numeric(dot.args[[i]]) & all(dot.args[[i]] >= 0)) { if (any(ii <- dot.args[[i]] == 0)) idxs[[i]] <- dot.args[[i]][!ii] else idxs[[i]] <- dot.args[[i]] if (any(idxs[[i]] > x.d[i])) stop("LHS numeric indicies at on dim ", i, " values too large") } else if (is.numeric(dot.args[[i]]) & all(dot.args[[i]] <= 0)) { idxs[[i]] <- seq(len=x.d[i])[dot.args[[i]]] } else { stop("LHS args for indices at dim ", i, " must be character, logical, numeric>0 or numeric<=0") } } } if (strip.excess) { value <- eval(as.call(c(list(as.name("["), as.name("value")), lapply(idxs[missing.dot.args], function(i) which(i!=0))))) } # replicate value appropriately if needed # look in the examples/tests for afill for the 4-d case for an example # that explains the logical here. if (prod(value.d)>1 && length(unique(value))>1) { j <- 0 need.rep <- 1 for (i in seq(along=missing.dot.args)) { if (missing.dot.args[i]) { j <- j+1 if (need.rep > 1) value <- asub(value, rep(seq(len=value.d[j]), each=need.rep), dims=j) need.rep <- 1 } else { need.rep <- need.rep * length(idxs[[i]]) } } } if (length(value)) { # Construct a skeleton call that we can pull an empty arg out of (xic[[3]]) xic <- Quote(x[,drop=drop]) # Find the name of x in the caller's frame x.caller <- substitute(x) if (local || !is.name(x.caller)) { # Evaluate the assignment in the frame of the function. This # will create a duplicate of 'x', but trying to evaluate in # the frame of the caller is tricky... subcall <- call("<-", as.call(c(list(as.name("["), as.name("x")), idxs)), as.name("value")) if (length(i <- which(sapply(idxs, is.null))+2)) subcall[[2]][i] <- xic[[3]] eval(subcall) return(x) } else { # Attempt to evaluate in the frame of the caller subcall <- call("<-", as.call(c(list(as.name("["), x.caller), idxs)), value) if (length(i <- which(sapply(idxs, is.null))+2)) subcall[[2]][i] <- xic[[3]] eval(subcall, sys.parent(1)) return(eval(x.caller, sys.parent(1))) } } x } abind/R/adrop.R0000755000175100001440000000321111664205225013001 0ustar hornikusersadrop <- function(x, drop=TRUE, named.vector=TRUE, one.d.array=FALSE) UseMethod("adrop", x) adrop.default <- function(x, drop=TRUE, named.vector=TRUE, one.d.array=FALSE) { if (is.null(dim(x))) stop("require an object with a dim attribute") x.dim <- dim(x) if (is.logical(drop)) { if (length(drop) != length(x.dim)) stop("length of drop is not equal length of dim(x)") drop <- which(drop) } else if (is.character(drop)) { if (any(is.na(i <- match(drop, names(x.dim))))) stop("dimension names ", paste("'", drop[is.na(i)], "'", sep="", collapse=" "), " not found in x") drop <- i } else if (is.null(drop)) { drop <- numeric(0) } if (!is.numeric(drop) || any(is.na(drop)) || any(drop<1 | drop>length(x.dim))) stop("drop must contain dimension numbers") if (!all(x.dim[drop]==1)) stop("dimensions to drop (", paste(drop, collapse=", "), ") do not have length 1") x.dimnames <- dimnames(x) dimnames(x) <- NULL dim(x) <- NULL # can't use indexing like [-drop] because drop can be empty, and that # doesn't have the right semantics keep <- setdiff(seq(len=length(x.dim)), drop) if (length(x.dim[keep])>1 || (length(x.dim[keep])==1 && one.d.array)) { # array result dim(x) <- x.dim[keep] if (!is.null(x.dimnames)) dimnames(x) <- x.dimnames[keep] } else if (length(x.dim[keep])==1 && named.vector) { # named vector result names(x) <- x.dimnames[keep][[1]] } else { # unnamed vector or single element result } x } abind/R/abind.R0000755000175100001440000002725711664205225012771 0ustar hornikusersabind <- function(..., along=N, rev.along=NULL, new.names=NULL, force.array=TRUE, make.names=use.anon.names, use.anon.names=FALSE, use.first.dimnames=FALSE, hier.names=FALSE) { arg.list <- list(...) if (is.list(arg.list[[1]]) && !is.data.frame(arg.list[[1]])) { if (length(arg.list)!=1) stop("can only supply one list-valued argument for ...") if (make.names) stop("cannot have make.names=TRUE with a list argument") arg.list <- arg.list[[1]] have.list.arg <- TRUE } else { N <- max(1, sapply(list(...), function(x) length(dim(x)))) have.list.arg <- FALSE } if (any(discard <- sapply(arg.list, is.null))) arg.list <- arg.list[!discard] if (length(arg.list)==0) return(NULL) N <- max(1, sapply(arg.list, function(x) length(dim(x)))) ## N will eventually be length(dim(return.value)) if (!is.null(rev.along)) along <- N + 1 - rev.along if (along < 1 || along > N || (along > floor(along) && along < ceiling(along))) { N <- N + 1 along <- max(1, min(N+1, ceiling(along))) } ## this next check should be redundant, but keep it here for safety... if (length(along) > 1 || along < 1 || along > N + 1) stop(paste("\"along\" must specify one dimension of the array,", "or interpolate between two dimensions of the array", sep="\n")) if (!force.array && N==2) { if (!have.list.arg) { if (along==2) return(cbind(...)) if (along==1) return(rbind(...)) } else { if (along==2) return(do.call("cbind", arg.list)) if (along==1) return(do.call("rbind", arg.list)) } } if (along>N || along<0) stop("along must be between 0 and ", N) pre <- seq(from=1, len=along-1) post <- seq(to=N-1, len=N-along) ## "perm" specifies permutation to put join dimension (along) last perm <- c((1:N)[-along], along) arg.names <- names(arg.list) if (is.null(arg.names)) arg.names <- rep("", length(arg.list)) ## if new.names is a character vector, treat it as argument names if (is.character(new.names)) { arg.names[seq(along=new.names)[nchar(new.names)>0]] <- new.names[nchar(new.names)>0] new.names <- NULL } ## Be careful with dot.args, because if abind was called ## using do.call(), and had anonymous arguments, the expressions ## returned by match.call() are for the entire structure. ## This can be a problem in S-PLUS, not sure about R. ## E.g., in this one match.call() returns compact results: ## > (function(...)browser())(1:10,letters) ## Called from: (function(...) browser()).... ## b()> match.call(expand.dots=FALSE)$... ## list(1:10, letters) ## But in this one, match.call() returns evaluated results: ## > test <- function(...) browser() ## > do.call("test", list(1:3,letters[1:4])) ## Called from: test(c(1, 2, 3), c("a", "b.... ## b(test)> match.call(expand.dots=FALSE)$... ## list(c(1, 2, 3), c("a", "b", "c", "d") ## The problem here was largely mitigated by making abind() ## accept a single list argument, which removes most of the ## need for the use of do.call("abind", ...) ## Create deparsed versions of actual arguments in arg.alt.names ## These are used for error messages if (any(arg.names=="")) { if (make.names) { ## Create dot.args to be a list of calling expressions for the objects to be bound. ## Be careful here with translation to R -- ## dot.args does not have the "list" functor with R ## (and dot.args is not a call object), whereas with S-PLUS, dot.args ## must have the list functor removed dot.args <- match.call(expand.dots=FALSE)$... ## [[2]] if (is.call(dot.args) && identical(dot.args[[1]], as.name("list"))) dot.args <- dot.args[-1] arg.alt.names <- arg.names for (i in seq(along=arg.names)) { if (arg.alt.names[i]=="") { if (object.size(dot.args[[i]])<1000) { arg.alt.names[i] <- paste(deparse(dot.args[[i]], 40), collapse=";") } else { arg.alt.names[i] <- paste("X", i, sep="") } arg.names[i] <- arg.alt.names[i] } } ## unset(dot.args) don't need dot.args any more, but R doesn't have unset() } else { arg.alt.names <- arg.names arg.alt.names[arg.names==""] <- paste("X", seq(along=arg.names), sep="")[arg.names==""] } } else { arg.alt.names <- arg.names } use.along.names <- any(arg.names!="") ## need to have here: arg.names, arg.alt.names, don't need dot.args names(arg.list) <- arg.names ## arg.dimnames is a matrix of dimension names, each element of the ## the matrix is a character vector, e.g., arg.dimnames[j,i] is ## the vector of names for dimension j of arg i arg.dimnames <- matrix(vector("list", N*length(arg.names)), nrow=N, ncol=length(arg.names)) dimnames(arg.dimnames) <- list(NULL, arg.names) dimnames.new <- vector("list", N) ## Coerce all arguments to have the same number of dimensions ## (by adding one, if necessary) and permute them to put the ## join dimension last. ## Create arg.dim as a matrix with length(dim) rows and ## length(arg.list) columns: arg.dim[j,i]==dim(arg.list[[i]])[j], ## The dimension order of arg.dim is original arg.dim <- matrix(integer(1), nrow=N, ncol=length(arg.names)) for (i in 1:length(arg.list)) { m <- arg.list[[i]] m.changed <- FALSE ## be careful with conversion to array: as.array converts data frames badly if (is.data.frame(m)) { ## use as.matrix() in preference to data.matrix() because ## data.matrix() uses the unintuitive codes() function on factors m <- as.matrix(m) m.changed <- TRUE } else if (!is.array(m) && !is.null(m)) { if (!is.atomic(m)) stop("arg '", arg.alt.names[i], "' is non-atomic") ## make sure to get the names of a vector and attach them to the array dn <- names(m) m <- as.array(m) if (length(dim(m))==1 && !is.null(dn)) dimnames(m) <- list(dn) m.changed <- TRUE } new.dim <- dim(m) if (length(new.dim)==N) { ## Assign the dimnames of this argument to the i'th column of arg.dimnames. ## If dimnames(m) is NULL, would need to do arg.dimnames[,i] <- list(NULL) ## to set all elts to NULL, as arg.dimnames[,i] <- NULL does not actually ## change anything in S-PLUS (leaves whatever is there) and illegal in R. ## Since arg.dimnames has NULL entries to begin with, don't need to do ## anything when dimnames(m) is NULL if (!is.null(dimnames(m))) arg.dimnames[,i] <- dimnames(m) arg.dim[,i] <- new.dim } else if (length(new.dim)==N-1) { ## add another dimension (first set dimnames to NULL to prevent errors) if (!is.null(dimnames(m))) { ## arg.dimnames[,i] <- c(dimnames(m)[pre], list(NULL), dimnames(m))[post] ## is equivalent to arg.dimnames[-N,i] <- dimnames(m) arg.dimnames[-along,i] <- dimnames(m) ## remove the dimnames so that we can assign a dim of an extra length dimnames(m) <- NULL } arg.dim[,i] <- c(new.dim[pre], 1, new.dim[post]) if (any(perm!=seq(along=perm))) { dim(m) <- c(new.dim[pre], 1, new.dim[post]) m.changed <- TRUE } } else { stop("'", arg.alt.names[i], "' does not fit: should have `length(dim())'=", N, " or ", N-1) } if (any(perm!=seq(along=perm))) arg.list[[i]] <- aperm(m, perm) else if (m.changed) arg.list[[i]] <- m } ## Make sure all arguments conform conform.dim <- arg.dim[,1] for (i in seq(len=ncol(arg.dim))) { if (any((conform.dim!=arg.dim[,i])[-along])) { stop("arg '", arg.alt.names[i], "' has dims=", paste(arg.dim[,i], collapse=", "), "; but need dims=", paste(replace(conform.dim, along, "X"), collapse=", ")) } } ## find the last (or first) names for each dimensions except the join dimension if (N>1) for (dd in seq(len=N)[-along]) { for (i in (if (use.first.dimnames) seq(along=arg.names) else rev(seq(along=arg.names)))) { if (length(arg.dimnames[[dd,i]]) > 0) { dimnames.new[[dd]] <- arg.dimnames[[dd,i]] break } } } ## find or create names for the join dimension for (i in 1:length(arg.names)) { ## only use names if arg i contributes some elements if (arg.dim[along,i] > 0) { dnm.along <- arg.dimnames[[along,i]] if (length(dnm.along)==arg.dim[along,i]) { use.along.names <- TRUE if (hier.names && arg.names[i]!="") dnm.along <- paste(arg.names[i], dnm.along, sep=".") } else { ## make up names for the along dimension if (arg.dim[along,i]==1) dnm.along <- arg.names[i] else if (arg.names[i]=="") dnm.along <- rep("", arg.dim[along,i]) else dnm.along <- paste(arg.names[i], seq(length=arg.dim[along,i]), sep="") } dimnames.new[[along]] <- c(dimnames.new[[along]], dnm.along) } } ## if no names at all were given for the along dimension, use none if (!use.along.names) dimnames.new[along] <- list(NULL) ## Construct the output array from the pieces. ## Could experiment here with more efficient ways of constructing the ## result than using unlist(), e.g. ## out <- numeric(prod(c( arg.dim[-along,1], sum(arg.dim[along,])))) ## Don't use names in unlist because this can quickly exhaust memory when ## abind is called with "do.call" (which creates horrendous names in S-PLUS). out <- array(unlist(arg.list, use.names=FALSE), dim=c( arg.dim[-along,1], sum(arg.dim[along,])), dimnames=dimnames.new[perm]) ## permute the output array to put the join dimension back in the right place if (any(order(perm)!=seq(along=perm))) out <- aperm(out, order(perm)) ## if new.names is list of character vectors, use whichever are non-null ## for dimension names, checking that they are the right length if (!is.null(new.names) && is.list(new.names)) { for (dd in 1:N) if (!is.null(new.names[[dd]])) if (length(new.names[[dd]])==dim(out)[dd]) dimnames(out)[[dd]] <- new.names[[dd]] else if (length(new.names[[dd]])) warning(paste("Component ", dd, " of new.names ignored: has length ", length(new.names[[dd]]), ", should be ", dim(out)[dd], sep="")) } out } abind/NAMESPACE0000755000175100001440000000017011664205225012570 0ustar hornikusersexport(abind, asub, "afill<-", adrop) S3method(asub, default) S3method(adrop, default) S3method("afill<-", default) abind/man/0000755000175100001440000000000011664205225012123 5ustar hornikusersabind/man/asub.Rd0000755000175100001440000000445211664205225013354 0ustar hornikusers\name{asub} \alias{asub} \alias{asub.default} \title{ Arbitrary subsetting of array-like objects at specified indices } \description{ Subset array-like objects at specified indices. \code{asub()} is a S3 generic, with one method, \code{asub.default}, supplied in the \code{abind} package. } \usage{ asub(x, idx, dims = seq(len = max(length(dim(x)), 1)), drop = NULL) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ The object to index } \item{idx}{ A list of indices (e.g., a list of a mixture of integer, character, and logical vectors, but can actually be anything). Can be just a vector in the case that \code{length(dims)==1}. \code{NULL} entries in the list will be treated as empty indices.} \item{dims}{ The dimensions on which to index (a numeric or integer vector). The default is all of the dimensions. } \item{drop}{ The 'drop' argument to index with (the default is to not supply a 'drop' argument } } \details{ Constructs and evaluates an expression to do the requested indexing. E.g., for \code{x} with \code{length(dim(x))==4} the call \code{asub(x, list(c("a","b"), 3:5), 2:3)} will construct and evaluate the expression \code{x[, c("a","b"), 3:5, ]}, and the call \code{asub(x, 1, 2, drop=FALSE)} will construct and evaluate the expression \code{x[, 1, , , drop=FALSE]}. \code{asub} checks that the elements of \code{dims} are in the range 1 to \code{length(dim(x))} (in the case that \code{x} is a vector, \code{length(x)} is used for \code{dim(x)}). Other than that, no checks are made on the suitability of components of \code{idx} as indices for \code{x}. If the components of \code{idx} have any out-of-range values or unsuitable types, this will be left to the subsetting method for \code{x} to catch. } \value{ A subset of \code{x}, as returned by \code{x[...]}. } \references{ ~put references to the literature/web site here ~ } \author{Tony Plate \email{tplate@acm.org}} % \note{ ~~further notes~~ } \seealso{ \code{\link{Extract}} } \examples{ x <- array(1:24,dim=c(2,3,4),dimnames=list(letters[1:2],LETTERS[1:3],letters[23:26])) asub(x, 1, 1, drop=FALSE) asub(x, list(1:2,3:4), c(1,3)) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ manip } \keyword{ array } abind/man/afill.Rd0000755000175100001440000001176011664205225013511 0ustar hornikusers\name{afill} \alias{afill} \alias{afill<-} \alias{afill<-.default} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Fill an array with subarrays } \description{ Fill an array with subarrays. \code{afill} uses the dimension names in the value in determining how to fill the LHS, unlike standard array assignment, which ignores dimension names in the value. \code{afill()} is a S3 generic, with one method, \code{afill.default}, supplied in the \code{abind} package. } \usage{ afill(x, ..., excess.ok = FALSE, local = TRUE) <- value } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ An array to be changed } \item{\dots}{ Arguments that specify indices for \code{x}. If \code{length(dim(value)) < length(dim(x))}, then exactly \code{length(dim(x))} anonymous arguments must be supplied, with empty ones corresponding to dimensions of \code{x} that are supplied in \code{value}. } \item{excess.ok}{ If there are elements of the dimensions of \code{value} that are not found in the corresponding dimensions of x, they will be discarded if \code{excess.ok=TRUE}.} \item{local}{ Should the assignment be done in on a copy of x, and the result returned (normal behavior). If \code{local=FALSE} the assignment will be done directly on the actual argument supplied as \code{x}, which can be more space efficient.} \item{value}{ A vector or array, with dimension names that match some dimensions of \code{x} } } \details{ The simplest use of \code{afill} is to fill a sub-matrix. Here is an example of this usage: \preformatted{ > (x <- matrix(0, ncol=3, nrow=4, dimnames=list(letters[1:4], LETTERS[24:26]))) X Y Z a 0 0 0 b 0 0 0 c 0 0 0 d 0 0 0 > (y <- matrix(1:4, ncol=2, nrow=2, dimnames=list(letters[2:3], LETTERS[25:26]))) Y Z b 1 3 c 2 4 > afill(x) <- y > x X Y Z a 0 0 0 b 0 1 3 c 0 2 4 d 0 0 0 > } The above usage is equivalent (when x and y have appropriately matching dimnames) to \preformatted{ > x[match(rownames(y), rownames(x)), match(colnames(y), colnames(x))] <- y } A more complex usage of \code{afill} is to fill a sub-matrix in a slice of a higher-dimensional array. In this case, indices for \code{x} must be supplied as arguments to \code{afill}, with the dimensions corresponding to those of \code{value} being empty, e.g.: \preformatted{ > x <- array(0, dim=c(2,4,3), dimnames=list(LETTERS[1:2], letters[1:4], LETTERS[24:26])) > y <- matrix(1:4, ncol=2, nrow=2, dimnames=list(letters[2:3], LETTERS[25:26])) > afill(x, 1, , ) <- y > x[1,,] X Y Z a 0 0 0 b 0 1 3 c 0 2 4 d 0 0 0 > x[2,,] X Y Z a 0 0 0 b 0 0 0 c 0 0 0 d 0 0 0 > } The most complex usage of \code{afill} is to fill a sub-matrix in multiple slice of a higher-dimensional array. Again, indices for \code{x} must be supplied as arguments to \code{afill}, with the dimensions corresponding to those of \code{value} being empty. Indices in which all slices should be filled can be supplied as \code{TRUE}. E.g.: \preformatted{ > x <- array(0, dim=c(2,4,3), dimnames=list(LETTERS[1:2], letters[1:4], LETTERS[24:26])) > y <- matrix(1:4, ncol=2, nrow=2, dimnames=list(letters[2:3], LETTERS[25:26])) > afill(x, TRUE, , ) <- y > x[1,,] X Y Z a 0 0 0 b 0 1 3 c 0 2 4 d 0 0 0 > x[2,,] X Y Z a 0 0 0 b 0 1 3 c 0 2 4 d 0 0 0 > } In the above usage, \code{afill} takes care of replicating \code{value} in the appropriate fashion (which is not straghtforward in some cases). } \value{ The object \code{x} is changed. The return value of the assignment is the parts of the object \code{x} that are changed. This is similar to how regular subscript-replacement behaves, e.g., the expression \code{x[2:3] <- 1:2} returns the vector \code{1:2}, not the entire object \code{x}. However, note that there can be differences } % \references{ ~put references to the literature/web site here ~ } \author{Tony Plate \email{tplate@acm.org}} % \note{ ~~further notes~~ } \seealso{ \code{\link{Extract}} } \examples{ # fill a submatrix defined by the dimnames on y (x <- matrix(0, ncol=3, nrow=4, dimnames=list(letters[1:4], LETTERS[24:26]))) (y <- matrix(1:4, ncol=2, nrow=2, dimnames=list(letters[2:3], LETTERS[25:26]))) afill(x) <- y x all.equal(asub(x, dimnames(y)), y) # TRUE # fill a slice in a higher dimensional array x <- array(0, dim=c(2,4,3), dimnames=list(LETTERS[1:2], letters[1:4], LETTERS[24:26])) y <- matrix(1:4, ncol=2, nrow=2, dimnames=list(letters[2:3], LETTERS[25:26])) afill(x, 1, , ) <- y x[1,,] x[2,,] all.equal(asub(x, c(1,dimnames(y))), y) # TRUE # fill multiple slices x <- array(0, dim=c(2,4,3), dimnames=list(LETTERS[1:2], letters[1:4], LETTERS[24:26])) y <- matrix(1:4, ncol=2, nrow=2, dimnames=list(letters[2:3], LETTERS[25:26])) afill(x, TRUE, , ) <- y x[1,,] x[2,,] all.equal(asub(x, c(1,dimnames(y))), y) # TRUE all.equal(asub(x, c(2,dimnames(y))), y) # TRUE } \keyword{ manip } \keyword{ array } abind/man/adrop.Rd0000755000175100001440000000570011664205225013524 0ustar hornikusers\name{adrop} \alias{adrop} \alias{adrop.default} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Drop dimensions of an array object } \description{ Drop degenerate dimensions of an array object. Offers less automaticity and more control than the base \code{drop()} function. \code{adrop()} is a S3 generic, with one method, \code{adrop.default}, supplied in the \code{abind} package. } \usage{ adrop(x, drop = TRUE, named.vector = TRUE, one.d.array = FALSE) } \arguments{ \item{x}{ An array (including a matrix) } \item{drop}{ A logical or numeric vector describing exactly which dimensions to drop. It is intended that this argument be supplied always. The default is very rarely useful (\code{drop=TRUE} means drop the first dimension of a 1-d array).} \item{named.vector}{Optional, defaults to \code{TRUE}. Controls whether a vector result has names derived from the \code{dimnames} of \code{x}.} \item{one.d.array}{Optional, defaults to \code{FALSE}. If \code{TRUE}, a one-dimensional array result will be an object with a \code{dim} attribute of length 1, and possibly a \code{dimnames} attribute. If \code{FALSE}, a one-dimensional result will be a vector object (named if \code{named.vector==TRUE}).} } \details{ Dimensions can only be dropped if their extent is one, i.e., dimension \code{i} of array \code{x} can be dropped only if \code{dim(x)[i]==1}. It is an error to request \code{adrop} to drop a dimension whose extent is not 1. A 1-d array can be converted to a named vector by supplying \code{drop=NULL} (which means drop no dimensions, and return a 1-d array result as a named vector). } \value{ If \code{x} is an object with a \code{dim} attribute (e.g., a matrix or \code{array}), then \code{adrop} returns an object like \code{x}, but with the requested extents of length one removed. Any accompanying \code{dimnames} attribute is adjusted and returned with \code{x}. } \author{Tony Plate \email{tplate@acm.org}} % \note{ ~~further notes~~ } \seealso{ \code{\link{abind}} } \examples{ x <- array(1:24,dim=c(2,3,4),dimnames=list(letters[1:2],LETTERS[1:3],letters[23:26])) adrop(x[1,,,drop=FALSE],drop=1) adrop(x[,1,,drop=FALSE],drop=2) adrop(x[,,1,drop=FALSE],drop=3) adrop(x[1,1,1,drop=FALSE],drop=1) adrop(x[1,1,1,drop=FALSE],drop=2) adrop(x[1,1,1,drop=FALSE],drop=3) adrop(x[1,1,1,drop=FALSE],drop=1:2) adrop(x[1,1,1,drop=FALSE],drop=1:2,one.d=TRUE) adrop(x[1,1,1,drop=FALSE],drop=1:2,named=FALSE) dim(adrop(x[1,1,1,drop=FALSE],drop=1:2,one.d=TRUE)) dimnames(adrop(x[1,1,1,drop=FALSE],drop=1:2,one.d=TRUE)) names(adrop(x[1,1,1,drop=FALSE],drop=1:2,one.d=TRUE)) dim(adrop(x[1,1,1,drop=FALSE],drop=1:2)) dimnames(adrop(x[1,1,1,drop=FALSE],drop=1:2)) names(adrop(x[1,1,1,drop=FALSE],drop=1:2)) } \keyword{ manip }% at least one, from doc/KEYWORDS \keyword{ array }% __ONLY ONE__ keyword per line abind/man/abind.Rd0000755000175100001440000002056411664205225013501 0ustar hornikusers\name{abind} \alias{abind} \title{Combine multi-dimensional arrays} \description{ Combine multi-dimensional arrays. This is a generalization of cbind and rbind. Takes a sequence of vectors, matrices, or arrays and produces a single array of the same or higher dimension. } \usage{ abind(..., along=N, rev.along=NULL, new.names=NULL, force.array=TRUE, make.names=use.anon.names, use.anon.names=FALSE, use.first.dimnames=FALSE, hier.names=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{\dots}{ Any number of vectors, matrices, arrays, or data frames. The dimensions of all the arrays must match, except on one dimension (specified by \code{along=}). If these arguments are named, the name will be used for the name of the dimension along which the arrays are joined. Vectors are treated as having a dim attribute of length one. Alternatively, there can be one (and only one) list argument supplied, whose components are the objects to be bound together. Names of the list components are treated in the same way as argument names. } \item{along}{ (optional) The dimension along which to bind the arrays. The default is the last dimension, i.e., the maximum length of the dim attribute of the supplied arrays. \code{along=} can take any non-negative value up to the minimum length of the dim attribute of supplied arrays plus one. When \code{along=} has a fractional value, a value less than 1, or a value greater than N (N is the maximum of the lengths of the dim attribute of the objects to be bound together), a new dimension is created in the result. In these cases, the dimensions of all arguments must be identical. } \item{rev.along}{ (optional) Alternate way to specify the dimension along which to bind the arrays: \code{along = N + 1 - rev.along}. This is provided mainly to allow easy specification of \code{along = N + 1} (by supplying \code{rev.along=0}). If both \code{along} and \code{rev.along} are supplied, the supplied value of \code{along} is ignored. } \item{new.names}{ (optional) If new.names is a list, it is the first choice for the dimnames attribute of the result. It should have the same structure as a dimnames attribute. If the names for a particular dimension are \code{NULL}, names for this dimension are constructed in other ways. If \code{new.names} is a character vector, it is used for dimension names in the same way as argument names are used. Zero length ("") names are ignored. } \item{force.array}{ (optional) If \code{FALSE}, rbind or cbind are called when possible, i.e., when the arguments are all vectors, and along is not 1, or when the arguments are vectors or matrices or data frames and along is 1 or 2. If rbind or cbind are used, they will preserve the data.frame classes (or any other class that r/cbind preserve). Otherwise, abind will convert objects to class array. Thus, to guarantee that an array object is returned, supply the argument \code{force.array=TRUE}. Note that the use of rbind or cbind introduces some subtle changes in the way default dimension names are constructed: see the examples below. } \item{make.names}{ (optional) If \code{TRUE}, the last resort for dimnames for the along dimension will be the deparsed versions of anonymous arguments. This can result in cumbersome names when arguments are expressions.

The default is \code{FALSE}. } \item{use.anon.names}{ (optional) \code{use.anon.names} is a deprecated synonym for \code{make.names}. } \item{use.first.dimnames}{ (optional) When dimension names are present on more than one argument, should dimension names for the result be take from the first available (the default is to take them from the last available, which is the same behavior as \code{rbind} and \code{cbind}.) } \item{hier.names}{ (optional) If \code{TRUE}, dimension names on the concatenated dimension will be composed of the argument name and the dimension names of the objects being bound. If a single list argument is supplied, then the names of the components serve as the argument names. \code{use.anon.names} is a deprecated synonym for \code{make.names}. } } \details{ The dimensions of the supplied vectors or arrays do not need to be identical, e.g., arguments can be a mixture of vectors and matrices. \code{abind} coerces arguments by the addition of one dimension in order to make them consistent with other arguments and \code{along=}. The extra dimension is added in the place specified by \code{along=}. The default action of abind is to concatenate on the last dimension, rather than increase the number of dimensions. For example, the result of calling abind with vectors is a longer vector (see first example below). This differs from the action of \code{rbind} and cbind which is to return a matrix when called with vectors. abind can be made to behave like cbind on vectors by specifying \code{along=2}, and like rbind by specifying \code{along=0}. The dimnames of the returned object are pieced together from the dimnames of the arguments, and the names of the arguments. Names for each dimension are searched for in the following order: new.names, argument name, dimnames (or names) attribute of last argument, dimnames (or names) attribute of second last argument, etc. (Supplying the argument \code{use.first.dimnames=TRUE} changes this to cause \code{abind} to use dimnames or names from the first argument first. The default behavior is the same as for \code{rbind} and \code{cbind}: use dimnames from later arguments.) If some names are supplied for the along dimension (either as argument names or dimnames in arguments), names are constructed for anonymous arguments unless \code{use.anon.names=FALSE}. } \value{ An array with a dim attribute calculated as follows. Let \code{rMin=min(sapply(list(...), function(x) length(dim(x))))} and \code{rMax=max(sapply(list(...), function(x) length(dim(x))))} (where the length of the dimensions of a vector are taken to be 1). Then \code{rMax} should be equal to or one greater than \code{rMin}. If \code{along} refers to an existing dimension, then the length of the dim attribute of the result is \code{rMax}. If \code{along} does not refer to an existing dimension, then \code{rMax} should equal \code{rMin} and the length of the dim attribute of the result will be \code{rMax+1}. \code{rbind} or \code{cbind} are called to compute the result if (a) \code{force.array=FALSE}; and (b) the result will be a two-dimensional object. } \author{Tony Plate \email{tplate@acm.org} and Richard Heiberger } \note{ It would be nice to make \code{abind()} an S3 generic, but S3 generics cannot dispatch off anonymous arguments. The ability of \code{abind()} to accept a single list argument removes much of the need for constructs like \code{do.call("abind", list.of.arrays)}. Instead, just do \code{abind(list.of.arrays)}. The direct construct is preferred because \code{do.call()} construct can sometimes consume more memory during evaluation. } \examples{ # Five different ways of binding together two matrices x <- matrix(1:12,3,4) y <- x+100 dim(abind(x,y,along=0)) # binds on new dimension before first dim(abind(x,y,along=1)) # binds on first dimension dim(abind(x,y,along=1.5)) dim(abind(x,y,along=2)) dim(abind(x,y,along=3)) dim(abind(x,y,rev.along=1)) # binds on last dimension dim(abind(x,y,rev.along=0)) # binds on new dimension after last # Unlike cbind or rbind in that the default is to bind # along the last dimension of the inputs, which for vectors # means the result is a vector (because a vector is # treated as an array with length(dim(x))==1). abind(x=1:4,y=5:8) # Like cbind abind(x=1:4,y=5:8,along=2) abind(x=1:4,matrix(5:20,nrow=4),along=2) abind(1:4,matrix(5:20,nrow=4),along=2) # Like rbind abind(x=1:4,matrix(5:20,nrow=4),along=1) abind(1:4,matrix(5:20,nrow=4),along=1) # Create a 3-d array out of two matrices abind(x=matrix(1:16,nrow=4),y=matrix(17:32,nrow=4),along=3) # Use of hier.names abind(x=cbind(a=1:3,b=4:6), y=cbind(a=7:9,b=10:12), hier.names=TRUE) # Use a list argument abind(list(x=x, y=x), along=3) # Use lapply(..., get) to get the objects an <- c('x','y') names(an) <- an abind(lapply(an, get), along=3) } \keyword{ manip }% at least one, from doc/KEYWORDS \keyword{ array }% __ONLY ONE__ keyword per line abind/DevNotes.txt0000755000175100001440000000446411664205225013653 0ustar hornikusersThis is not implemented yet. 2009/01/03: trying to make more efficient in space & time The current version uses unlist() to put together the pieces Here's a trace with the unlist() version: > x <- matrix(numeric(1e6), ncol=1000) > y <- matrix(numeric(1e6), ncol=1000) > gc(reset=T) used (Mb) gc trigger (Mb) max used (Mb) Ncells 110503 3.0 350000 9.4 110503 3.0 Vcells 2075569 15.9 4524482 34.6 2075569 15.9 > gc() used (Mb) gc trigger (Mb) max used (Mb) Ncells 110508 3.0 350000 9.4 110654 3.0 Vcells 2075592 15.9 4524482 34.6 2075674 15.9 > invisible(gc(F,T)) > z <- abind(x, y, along=3) # get same mem usage for all values of along > gc() used (Mb) gc trigger (Mb) max used (Mb) Ncells 112809 3.1 350000 9.4 114257 3.1 Vcells 4075867 31.1 11874844 90.6 11076632 84.6 > gc(reset=T) used (Mb) gc trigger (Mb) max used (Mb) Ncells 112818 3.1 350000 9.4 112818 3.1 Vcells 4075890 31.1 11874844 90.6 4075890 31.1 > Should be able to do this with just this much memory: > rm(x) > rm(y) > rm(z) > gc(reset=T) used (Mb) gc trigger (Mb) max used (Mb) Ncells 112799 3.1 350000 9.4 112799 3.1 Vcells 75851 0.6 9499875 72.5 75851 0.6 > x <- matrix(numeric(1e6), ncol=1000) > y <- matrix(numeric(1e6), ncol=1000) > z <- matrix(numeric(2e6), ncol=1000) > gc() used (Mb) gc trigger (Mb) max used (Mb) Ncells 112809 3.1 350000 9.4 113137 3.1 Vcells 4075854 31.1 9499875 72.5 8075969 61.7 > gc(reset=T) used (Mb) gc trigger (Mb) max used (Mb) Ncells 112818 3.1 350000 9.4 112818 3.1 Vcells 4075877 31.1 9499875 72.5 4075877 31.1 > # Or even this, because, matrix() is not efficient with its input: > rm(x, y, z) > gc(reset=T) used (Mb) gc trigger (Mb) max used (Mb) Ncells 112799 3.1 350000 9.4 112799 3.1 Vcells 75851 0.6 7599899 58.0 75851 0.6 > x <- matrix(numeric(1e6), ncol=1000) > y <- matrix(numeric(1e6), ncol=1000) > z <- numeric(2e6) > gc() used (Mb) gc trigger (Mb) max used (Mb) Ncells 112807 3.1 350000 9.4 113103 3.1 Vcells 4075853 31.1 7599899 58.0 6075968 46.4 > gc(reset=T) used (Mb) gc trigger (Mb) max used (Mb) Ncells 112816 3.1 350000 9.4 112816 3.1 Vcells 4075876 31.1 7599899 58.0 4075876 31.1 > abind/DESCRIPTION0000755000175100001440000000114311664377541013073 0ustar hornikusersPackage: abind Version: 1.4-0 Date: 2011-07-17 Title: Combine multi-dimensional arrays Author: Tony Plate and Richard Heiberger Maintainer: Tony Plate Description: Combine multi-dimensional arrays into a single array. This is a generalization of cbind and rbind. Works with vectors, matrices, and higher-dimensional arrays. Also provides functions adrop, asub, and afill for manipulating, extracting and replacing data in arrays. Depends: R (>= 1.5.0) License: LGPL (>= 2) Packaged: 2011-11-26 15:49:41 UTC; tap Repository: CRAN Date/Publication: 2011-11-27 09:14:09 abind/ChangeLog0000755000175100001440000000277111664205225013134 0ustar hornikusers2010-09-26 Tony Plate * Version 1.4-0 * added NAMESPACE 2010-09-26 Tony Plate * Version 1.3-0 * R/adrop.R: Make able to drop a 1-d array to a named vector 2009-12-03 Tony Plate * Version 1.2-0 * R/abind.R: Make code more efficient and cleaner * R/adrop.R: Make adrop generic * R/asub.R: add function asub() to subscript arrays on specified dimensions * R/afill.R: add function afill() <- value to fill subarrays on specified dimensions 2004-03-12 Tony Plate * R/abind.R man/abind.Rd Allow first argument of abind() to be a list of objects to be bound -- this avoids the need for do.call() when one wants to bind a list of objects * R/abind.R man/abind.Rd Changed argument name 'use.anon.names' to the more intuitive 'make.names' (the argument 'use.anon.names' still works) * R/abind.R man/abind.Rd Changed default value for 'make.names' to FALSE (now more closely behaves like rbind() and cbind()). This means that dimension names for dimensions that have no names are only constructed when requested, not by default. * R/adrop.R man/adrop.Rd Added new function adrop(). This is a function like drop(), but it allows to user to specify which of the dimensions with extent one will be dropped.