R Under development (unstable) (2023-11-16 r85542 ucrt) -- "Unsuffered Consequences" Copyright (C) 2023 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. > library("R.utils") Loading required package: R.oo Loading required package: R.methodsS3 R.methodsS3 v1.8.2 (2022-06-13 22:00:14 UTC) successfully loaded. See ?R.methodsS3 for help. R.oo v1.25.0 (2022-06-12 02:20:02 UTC) successfully loaded. See ?R.oo for help. Attaching package: 'R.oo' The following object is masked from 'package:R.methodsS3': throw The following objects are masked from 'package:methods': getClasses, getMethods The following objects are masked from 'package:base': attach, detach, load, save R.utils v2.12.3 successfully loaded. See ?R.utils for help. Attaching package: 'R.utils' The following object is masked from 'package:utils': timestamp The following objects are masked from 'package:base': cat, commandArgs, getOption, isOpen, nullfile, parse, warnings > > > > > > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > # A matrix > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > cat("\nWrap a matrix 'y' to a vector and back again:\n") Wrap a matrix 'y' to a vector and back again: > x <- matrix(1:8, nrow=2, dimnames=list(letters[1:2], 1:4)) > y <- wrap(x) > z <- unwrap(y) > print(z) 1 2 3 4 a 1 3 5 7 b 2 4 6 8 > stopifnot(identical(z,x)) > > # Drop dimensions, iff applicable > z <- unwrap(y, drop=TRUE) > print(z) 1 2 3 4 a 1 3 5 7 b 2 4 6 8 > > > # Argument 'split' can also be a list of functions > split <- list(function(names, ...) strsplit(names, split="[.]", ...)) > z2 <- unwrap(y, split=split) > print(z2) 1 2 3 4 a 1 3 5 7 b 2 4 6 8 > stopifnot(identical(z2, z)) > > > > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > # A matrix and a data frame > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > x3 <- matrix(1:27, nrow=3L, ncol=9L) > rownames(x3) <- LETTERS[1:3] > colnames(x3) <- letters[1:9] > x3b <- as.data.frame(x3, stringsAsFactors=FALSE) > > y3 <- wrap(x3) > print(y3) A.a B.a C.a A.b B.b C.b A.c B.c C.c A.d B.d C.d A.e B.e C.e A.f B.f C.f A.g B.g 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 C.g A.h B.h C.h A.i B.i C.i 21 22 23 24 25 26 27 > > y3b <- wrap(x3b) > print(y3b) A.a B.a C.a A.b B.b C.b A.c B.c C.c A.d B.d C.d A.e B.e C.e A.f B.f C.f A.g B.g 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 C.g A.h B.h C.h A.i B.i C.i 21 22 23 24 25 26 27 > > stopifnot(identical(y3b,y3)) > > z3 <- unwrap(y3) > stopifnot(identical(z3,x3)) > > y3b <- as.data.frame(y3, stringsAsFactors=FALSE) > z3b <- unwrap(y3b) > stopifnot(identical(z3b,x3)) > > > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > # A 3x2x3 array > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > dim <- c(3,2,3) > ndim <- length(dim) > dimnames <- list() > for (kk in 1:ndim) + dimnames[[kk]] <- sprintf("%s%d", letters[kk], 1:dim[kk]) > x <- 1:prod(dim) > x <- array(x, dim=dim, dimnames=dimnames) > > > cat("Array 'x':\n") Array 'x': > print(x) , , c1 b1 b2 a1 1 4 a2 2 5 a3 3 6 , , c2 b1 b2 a1 7 10 a2 8 11 a3 9 12 , , c3 b1 b2 a1 13 16 a2 14 17 a3 15 18 > > > cat("\nReshape 'x' to its identity:\n") Reshape 'x' to its identity: > y <- wrap(x, map=list(1, 2, 3)) > print(y) , , c1 b1 b2 a1 1 4 a2 2 5 a3 3 6 , , c2 b1 b2 a1 7 10 a2 8 11 a3 9 12 , , c3 b1 b2 a1 13 16 a2 14 17 a3 15 18 > # Assert correctness of reshaping > stopifnot(identical(y, x)) > > > cat("\nReshape 'x' by swapping dimensions 2 and 3, i.e. aperm(x, perm=c(1,3,2)):\n") Reshape 'x' by swapping dimensions 2 and 3, i.e. aperm(x, perm=c(1,3,2)): > y <- wrap(x, map=list(1, 3, 2)) > print(y) , , b1 c1 c2 c3 a1 1 7 13 a2 2 8 14 a3 3 9 15 , , b2 c1 c2 c3 a1 4 10 16 a2 5 11 17 a3 6 12 18 > # Assert correctness of reshaping > stopifnot(identical(y, aperm(x, perm=c(1,3,2)))) > > > cat("\nWrap 'x' to a matrix 'y' by keeping dimension 1 and joining the others:\n") Wrap 'x' to a matrix 'y' by keeping dimension 1 and joining the others: > y <- wrap(x, map=list(1, NA)) > print(y) b1.c1 b2.c1 b1.c2 b2.c2 b1.c3 b2.c3 a1 1 4 7 10 13 16 a2 2 5 8 11 14 17 a3 3 6 9 12 15 18 > # Assert correctness of reshaping > for (aa in dimnames(x)[[1]]) { + for (bb in dimnames(x)[[2]]) { + for (cc in dimnames(x)[[3]]) { + tt <- paste(bb, cc, sep=".") + stopifnot(identical(y[aa,tt], x[aa,bb,cc])) + } + } + } > > > cat("\nUnwrap matrix 'y' back to array 'x':\n") Unwrap matrix 'y' back to array 'x': > z <- unwrap(y) > print(z) , , c1 b1 b2 a1 1 4 a2 2 5 a3 3 6 , , c2 b1 b2 a1 7 10 a2 8 11 a3 9 12 , , c3 b1 b2 a1 13 16 a2 14 17 a3 15 18 > stopifnot(identical(z,x)) > > > > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > # An array with a random number of dimensions > # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - > cat("\nWrap and unwrap a randomly sized and shaped array 'x2':\n") Wrap and unwrap a randomly sized and shaped array 'x2': > maxdim <- 5 > dim <- sample(1:maxdim, size=sample(2:maxdim, size=1)) > ndim <- length(dim) > dimnames <- list() > for (kk in 1:ndim) + dimnames[[kk]] <- sprintf("%s%d", letters[kk], 1:dim[kk]) > x2 <- 1:prod(dim) > x2 <- array(x, dim=dim, dimnames=dimnames) > > cat("\nArray 'x2':\n") Array 'x2': > print(x) , , c1 b1 b2 a1 1 4 a2 2 5 a3 3 6 , , c2 b1 b2 a1 7 10 a2 8 11 a3 9 12 , , c3 b1 b2 a1 13 16 a2 14 17 a3 15 18 > > # Number of dimensions of wrapped array > ndim2 <- sample(1:(ndim-1), size=1) > > # Create a random map for joining dimensions > splits <- NULL > if (ndim > 2) + splits <- sort(sample(2:(ndim-1), size=ndim2-1)) > splits <- c(0, splits, ndim) > map <- list() > for (kk in 1:ndim2) + map[[kk]] <- (splits[kk]+1):splits[kk+1] > > cat("\nRandom 'map':\n") Random 'map': > print(map) [[1]] [1] 1 2 3 4 5 > > cat("\nArray 'y2':\n") Array 'y2': > y2 <- wrap(x2, map=map) > print(y2) a1.b1.c1.d1.e1 a2.b1.c1.d1.e1 a1.b1.c2.d1.e1 a2.b1.c2.d1.e1 a1.b1.c3.d1.e1 1 2 3 4 5 a2.b1.c3.d1.e1 a1.b1.c1.d2.e1 a2.b1.c1.d2.e1 a1.b1.c2.d2.e1 a2.b1.c2.d2.e1 6 7 8 9 10 a1.b1.c3.d2.e1 a2.b1.c3.d2.e1 a1.b1.c1.d3.e1 a2.b1.c1.d3.e1 a1.b1.c2.d3.e1 11 12 13 14 15 a2.b1.c2.d3.e1 a1.b1.c3.d3.e1 a2.b1.c3.d3.e1 a1.b1.c1.d4.e1 a2.b1.c1.d4.e1 16 17 18 1 2 a1.b1.c2.d4.e1 a2.b1.c2.d4.e1 a1.b1.c3.d4.e1 a2.b1.c3.d4.e1 a1.b1.c1.d1.e2 3 4 5 6 7 a2.b1.c1.d1.e2 a1.b1.c2.d1.e2 a2.b1.c2.d1.e2 a1.b1.c3.d1.e2 a2.b1.c3.d1.e2 8 9 10 11 12 a1.b1.c1.d2.e2 a2.b1.c1.d2.e2 a1.b1.c2.d2.e2 a2.b1.c2.d2.e2 a1.b1.c3.d2.e2 13 14 15 16 17 a2.b1.c3.d2.e2 a1.b1.c1.d3.e2 a2.b1.c1.d3.e2 a1.b1.c2.d3.e2 a2.b1.c2.d3.e2 18 1 2 3 4 a1.b1.c3.d3.e2 a2.b1.c3.d3.e2 a1.b1.c1.d4.e2 a2.b1.c1.d4.e2 a1.b1.c2.d4.e2 5 6 7 8 9 a2.b1.c2.d4.e2 a1.b1.c3.d4.e2 a2.b1.c3.d4.e2 a1.b1.c1.d1.e3 a2.b1.c1.d1.e3 10 11 12 13 14 a1.b1.c2.d1.e3 a2.b1.c2.d1.e3 a1.b1.c3.d1.e3 a2.b1.c3.d1.e3 a1.b1.c1.d2.e3 15 16 17 18 1 a2.b1.c1.d2.e3 a1.b1.c2.d2.e3 a2.b1.c2.d2.e3 a1.b1.c3.d2.e3 a2.b1.c3.d2.e3 2 3 4 5 6 a1.b1.c1.d3.e3 a2.b1.c1.d3.e3 a1.b1.c2.d3.e3 a2.b1.c2.d3.e3 a1.b1.c3.d3.e3 7 8 9 10 11 a2.b1.c3.d3.e3 a1.b1.c1.d4.e3 a2.b1.c1.d4.e3 a1.b1.c2.d4.e3 a2.b1.c2.d4.e3 12 13 14 15 16 a1.b1.c3.d4.e3 a2.b1.c3.d4.e3 a1.b1.c1.d1.e4 a2.b1.c1.d1.e4 a1.b1.c2.d1.e4 17 18 1 2 3 a2.b1.c2.d1.e4 a1.b1.c3.d1.e4 a2.b1.c3.d1.e4 a1.b1.c1.d2.e4 a2.b1.c1.d2.e4 4 5 6 7 8 a1.b1.c2.d2.e4 a2.b1.c2.d2.e4 a1.b1.c3.d2.e4 a2.b1.c3.d2.e4 a1.b1.c1.d3.e4 9 10 11 12 13 a2.b1.c1.d3.e4 a1.b1.c2.d3.e4 a2.b1.c2.d3.e4 a1.b1.c3.d3.e4 a2.b1.c3.d3.e4 14 15 16 17 18 a1.b1.c1.d4.e4 a2.b1.c1.d4.e4 a1.b1.c2.d4.e4 a2.b1.c2.d4.e4 a1.b1.c3.d4.e4 1 2 3 4 5 a2.b1.c3.d4.e4 a1.b1.c1.d1.e5 a2.b1.c1.d1.e5 a1.b1.c2.d1.e5 a2.b1.c2.d1.e5 6 7 8 9 10 a1.b1.c3.d1.e5 a2.b1.c3.d1.e5 a1.b1.c1.d2.e5 a2.b1.c1.d2.e5 a1.b1.c2.d2.e5 11 12 13 14 15 a2.b1.c2.d2.e5 a1.b1.c3.d2.e5 a2.b1.c3.d2.e5 a1.b1.c1.d3.e5 a2.b1.c1.d3.e5 16 17 18 1 2 a1.b1.c2.d3.e5 a2.b1.c2.d3.e5 a1.b1.c3.d3.e5 a2.b1.c3.d3.e5 a1.b1.c1.d4.e5 3 4 5 6 7 a2.b1.c1.d4.e5 a1.b1.c2.d4.e5 a2.b1.c2.d4.e5 a1.b1.c3.d4.e5 a2.b1.c3.d4.e5 8 9 10 11 12 > > cat("\nArray 'x2':\n") Array 'x2': > z2 <- unwrap(y2) > print(z2) , , c1, d1, e1 b1 a1 1 a2 2 , , c2, d1, e1 b1 a1 3 a2 4 , , c3, d1, e1 b1 a1 5 a2 6 , , c1, d2, e1 b1 a1 7 a2 8 , , c2, d2, e1 b1 a1 9 a2 10 , , c3, d2, e1 b1 a1 11 a2 12 , , c1, d3, e1 b1 a1 13 a2 14 , , c2, d3, e1 b1 a1 15 a2 16 , , c3, d3, e1 b1 a1 17 a2 18 , , c1, d4, e1 b1 a1 1 a2 2 , , c2, d4, e1 b1 a1 3 a2 4 , , c3, d4, e1 b1 a1 5 a2 6 , , c1, d1, e2 b1 a1 7 a2 8 , , c2, d1, e2 b1 a1 9 a2 10 , , c3, d1, e2 b1 a1 11 a2 12 , , c1, d2, e2 b1 a1 13 a2 14 , , c2, d2, e2 b1 a1 15 a2 16 , , c3, d2, e2 b1 a1 17 a2 18 , , c1, d3, e2 b1 a1 1 a2 2 , , c2, d3, e2 b1 a1 3 a2 4 , , c3, d3, e2 b1 a1 5 a2 6 , , c1, d4, e2 b1 a1 7 a2 8 , , c2, d4, e2 b1 a1 9 a2 10 , , c3, d4, e2 b1 a1 11 a2 12 , , c1, d1, e3 b1 a1 13 a2 14 , , c2, d1, e3 b1 a1 15 a2 16 , , c3, d1, e3 b1 a1 17 a2 18 , , c1, d2, e3 b1 a1 1 a2 2 , , c2, d2, e3 b1 a1 3 a2 4 , , c3, d2, e3 b1 a1 5 a2 6 , , c1, d3, e3 b1 a1 7 a2 8 , , c2, d3, e3 b1 a1 9 a2 10 , , c3, d3, e3 b1 a1 11 a2 12 , , c1, d4, e3 b1 a1 13 a2 14 , , c2, d4, e3 b1 a1 15 a2 16 , , c3, d4, e3 b1 a1 17 a2 18 , , c1, d1, e4 b1 a1 1 a2 2 , , c2, d1, e4 b1 a1 3 a2 4 , , c3, d1, e4 b1 a1 5 a2 6 , , c1, d2, e4 b1 a1 7 a2 8 , , c2, d2, e4 b1 a1 9 a2 10 , , c3, d2, e4 b1 a1 11 a2 12 , , c1, d3, e4 b1 a1 13 a2 14 , , c2, d3, e4 b1 a1 15 a2 16 , , c3, d3, e4 b1 a1 17 a2 18 , , c1, d4, e4 b1 a1 1 a2 2 , , c2, d4, e4 b1 a1 3 a2 4 , , c3, d4, e4 b1 a1 5 a2 6 , , c1, d1, e5 b1 a1 7 a2 8 , , c2, d1, e5 b1 a1 9 a2 10 , , c3, d1, e5 b1 a1 11 a2 12 , , c1, d2, e5 b1 a1 13 a2 14 , , c2, d2, e5 b1 a1 15 a2 16 , , c3, d2, e5 b1 a1 17 a2 18 , , c1, d3, e5 b1 a1 1 a2 2 , , c2, d3, e5 b1 a1 3 a2 4 , , c3, d3, e5 b1 a1 5 a2 6 , , c1, d4, e5 b1 a1 7 a2 8 , , c2, d4, e5 b1 a1 9 a2 10 , , c3, d4, e5 b1 a1 11 a2 12 > > stopifnot(identical(z2,x2)) > > > > proc.time() user system elapsed 0.29 0.10 0.39