inst/tinytest/reorient_vector/test-array2array.R

In broadcast: Broadcasted Array Operations Like 'NumPy'

# set-up ====
enumerate <- 0L

errorfun <- function(tt) {
  
  if(isFALSE(tt)) stop(print(tt))
}

for(iLen in seq(2, 100, 10L)) {
  for(iOrient in 1:16) {
    for(iNdim in seq(iOrient, 16L)) {
      for(iBc in c(TRUE, FALSE)) {
        for(iNamed in c(TRUE, FALSE, NA)) {
          
          x.dim <- rep(1L, iNdim)
          x.dim[iOrient] <- iLen
          if(is.na(iNamed)) {
            x.dimnames <- rep(NULL, iNdim)
          }
          else if(iNamed) {
            x.dimnames <- rep(NULL, iNdim)
            x.dimnames[[iOrient]] <- sample(month.abb, iLen, TRUE)
          }
          else if(!iNamed) {
            x.dimnames <- NULL
          }
          
          x <- array(sample(1:iLen), x.dim, x.dimnames)
          broadcaster(x) <- iBc
          
          out <- x
          out %orientbc<-% c(iOrient, iNdim)
          
          expected.dim <- rep(1L, iNdim)
          expected.dim[iOrient] <- iLen
          
          expect_equal(
            broadcaster(out),
            TRUE
          ) |> errorfun()
          
          expect_equal(
            dimnames(out),
            dimnames(x)
          ) |> errorfun()
          
          expect_equal(
            dim(out), dim(x)
          ) |> errorfun()
          
          expect_equal(
            as.vector(x),
            as.vector(out)
          ) |> errorfun()
          
          enumerate <- enumerate + 4L
        }
      }
    }
  }
}