nDimCubeAdjacency <- function(dim, steps = FALSE, self = FALSE) { adjacency <- matrix(nrow = 2 ^ dim, ncol = 2 ^ dim) adjacency[1, 1] <- if ( self ) 1 else 0 if ( dim ) { for ( curDim in 1 : dim ) { adjValue <- if ( steps ) curDim else 1 width <- 2 ^ curDim width2 <- width / 2 adjacency[(width2 + 1) : width , (width2 + 1) : width ] <- sign(adjacency[1 : width2, 1 : width2]) * adjValue adjacency[(width2 + 1) : width , 1 : width2] <- adjacency[1 : width2, (width2 + 1) : width ] <- diag(adjValue, nrow = width2) } } return(adjacency) } plot.matrix.image <- function(matrix, colLevels = 2, emptyColor = 'white', col = NULL) { if ( is.null(col) ) { col <- c(emptyColor , gray(seq(0, by = 1 / (colLevels - 1), length.out = colLevels - 1))) breaks <- 0 : colLevels - 0.5 } else breaks <- 0 : length(col) - 0.5 breaks[1] <- min(matrix) - 0.5 breaks[length(breaks)] <- max(matrix) + 0.5 image( 1 : ncol(matrix) , 1 : nrow(matrix) , t(matrix) , ylim = c(nrow(matrix) + 0.5, 0.5) , axes = FALSE, xlab = '', ylab = '' , col = col , breaks = breaks ) col <- 'lightgray' box(col = col) grid(ncol(matrix), nrow(matrix), lty = 'solid', col = col) } test.plot.matrix.image <- function(dim, steps = TRUE, self = FALSE, emptyColor = 'white', col = NULL) { plot.matrix.image(nDimCubeAdjacency(dim, steps = steps, self = self) , if ( steps && dim ) dim + 1 else 2, emptyColor, col = col) } adDimSeparators <- function(dim, col = 'red', lwd = 3, ...) { start <- 0.5 end <- 2 ^ (0 : (dim - 1)) + start segments(start, end, end, end , col = col, lwd = lwd, ...) segments(end , end, end, start, col = col, lwd = lwd, ...) } test.overall.plot.matrix.image <- function(cellWidth = 16) { dim <- 4 ###### currently FIX, because of fixec color vector size <- 2 ^ dim * cellWidth + 2 png(filename = 'T:\\nDimCubeAdjacency.png', width = size, height = size) par <- par() par(mar = c(0, 0, 0, 0)) test.plot.matrix.image(dim, col = (c('#0000C040', '#EFEFEF', '#A0A0A0', '#787878', 'black'))) adDimSeparators(dim, lwd = 2) # adDimSeparators(dim) # adDimSeparators(dim, col = 'yellow', lwd = 1) dev.off() } edgesNDimCube <- function(dim) { return( if ( 0 == dim ) 0 else 2 * edgesNDimCube(dim - 1) + 2 ^ (dim - 1) ) } edges2cornerNDimCubeRatios <- function(dim) { return(sapply(0 : dim, edgesNDimCube) / 2 ^ (0 : dim)) }