Generate a summary matrix of a series of hexmode flags.

hexmode_matrix.R

require(plyr)

# determine the flags that make up the number
find_flags = function(x, dense=TRUE) {
  # collapse flags if more than one provided
  if (length(x) > 1) {
    x = Reduce(`|.hexmode`, x)
  }

  # nothing to do if nothing has been set...
  if (x == 0) {
    return()
  }

  # determine the upper-bound
  n = max(floor(log2(x)), 0)
  flags = as.hexmode(2 ^ (0:n))
  if (!dense) {
    flags = Filter(function(y) {y != 0}, x & flags)
  }
  return(flags)
}

# generate a summary matrix of a vector of hexmode combinations
hexmode_matrix = function(flags, modes=find_flags(flags, dense=TRUE), n=2, total=TRUE, id=NULL) {

    # get the "all-on" mode
    all_modes = sum(modes)

    # add in total mode if required
    modes = c(modes, 0)
    if (total) {
        modes = c(modes, all_modes)
    }

    # generate all n-combinations of the modes
    n = min(n, length(modes))
    dims = rep(list(modes), n)
    names(dims) = LETTERS[1:n]

    combinations = do.call(expand.grid, dims)

    # label the total column
    if (total) {
        for (i in 1:n) {
            dims[[i]][length(dims[[i]])] = 'Total'
        }
    }

    # generate matrix
    result = aaply(combinations, 1, function(combo) {
        # accumulate the cell for the combination
        cell = TRUE
        for (mode in combo) {
            mask = ifelse(mode > 0, mode, all_modes)
            cell = cell & (mode == all_modes | mode == (mask & flags))
        }

        # if unique ID given, count the distinct instances
        if (!is.null(id)) {
          return(length(unique(id[cell])))
        }
        else {
          return(sum(cell))
        }
    })

    # rearrange columns into original order
    if (n == 1) {
      names_ = function(x) {
        list(names(x))
      }
    }
    else {
      names_ = dimnames
    }
    shuffle = lapply(names_(result), function(x) {order(match(x, modes))})
    result = do.call(`[`, c(list(result), shuffle))  # hack dynamic n-indexing, e.g. result[shuffle_1, shuffle_2, ..., shuffle_n]
    
    if (n == 1) {
      names(result) = unlist(dims)
    }
    else {
      dimnames(result) = dims
    }

    return(result)
}

# test it
m = 5
modes = 2^(0:m)
flags = as.hexmode(floor(runif(1000, 0, 2^(m + 1) - 1)))

result = hexmode_matrix(flags, modes, 3)
print(result)