mixed combinations / permutations from different sets

前端 未结 1 1433
南方客
南方客 2020-12-19 20:04

This Q & A is motivated by How to build permutation with some conditions in R.

So far, there has been a few good R packages like RcppAlgos and

相关标签:
1条回答
  • 2020-12-19 20:42

    Suppose we have a list of sets set_list, where k[i] items are chosen from set_list[[i]], then mathematically speaking, we would address the problem as such:

    1. generate all combinations for each set;
    2. merge combinations from all sets;
    3. create all permutations for each combination.

    The function MixedCombnPerm below is my implementation, using RcppAlgos for step 1 and step 3. Currently step 2 is not using the optimal algorithm. It is a "brutal force" relying a faster implementation of expand.grid and a subsequent rbind. I know a faster recursive method (like the one used for forming a tensor product model matrix in mgcv) which can be coded up in Rcpp, but for time reason I would not do it now.

    library(RcppAlgos)
    
    MixedCombnPerm <- function (set_list, k, perm = FALSE) {
    
      ###################
      ## mode checking ##
      ###################
    
      if (!all(vapply(set_list, is.vector, TRUE)))
        stop("All sets must be 'vectors'!")
    
      if (length(unique(vapply(set_list, mode, ""))) > 1L)
        stop("Please ensure that all sets have the same mode!")
    
      ################
      ## basic math ##
      ################
    
      ## size of each sets
      n <- lengths(set_list, FALSE)
      ## input validation
      if (length(n) != length(k)) stop("length of 'k' different from number of sets!")
      if (any(k > n)) stop("can't choose more items than set size!")
      ## number of sets
      n_sets <- length(n)
      ## total number of items
      n_items <- sum(k)
      ## number of combinations
      n_combinations_by_set <- choose(n, k)
      n_combinations <- prod(n_combinations_by_set)
    
      #################################
      ## step 1: combinations by set ##
      #################################
    
      ## generate `n_combinations[i]` combinations on set i
      combinations_by_set <- vector("list", n_sets)
      for (i in seq_len(n_sets)) {
        ## each column of combinations_by_set[[i]] is a record
        combinations_by_set[[i]] <- t.default(comboGeneral(set_list[[i]], k[i]))
        }
    
      ################################
      ## step 2: merge combinations ##
      ################################
    
      ## merge combinations from all sets
      ## slow_expand_grid <- function (m) expand.grid(lapply(m, seq_len))
      fast_expand_grid <- function (m) {
        n_sets <- length(m)      ## number of sets
        mm <- c(1L, cumprod(m))  ## cumulative leading dimension
        grid_size <- mm[n_sets + 1L]  ## size of the grid
        grid_ind <- vector("list", n_sets)
        for (i in seq_len(n_sets)) {
          ## grid_ind[[i]] <- rep_len(rep(seq_len(m[i]), each = mm[i]), M)
          grid_ind[[i]] <- rep_len(rep.int(seq_len(m[i]), rep.int(mm[i], m[i])), grid_size)
          }
        grid_ind
        }
      grid_ind <- fast_expand_grid(n_combinations_by_set)
    
      ## each column is a record
      combinations_grid <- mapply(function (x, j) x[, j, drop = FALSE],
                           combinations_by_set, grid_ind,
                           SIMPLIFY = FALSE, USE.NAMES = FALSE)
      all_combinations <- do.call("rbind", combinations_grid)
    
      ########################################################
      ## step 3: generate permutations for each combination ##
      ########################################################
    
      if (!perm) return(all_combinations)
      else {
        ## generate `factorial(n_items)` permutations for each combination
        all_permutations <- vector("list", n_combinations)
        for (i in seq_len(n_combinations)) {
          all_permutations[[i]] <- permuteGeneral(all_combinations[, i], n_items)
          }
        return(all_permutations)
        }
    
      }
    

    The function does a strict input checking. User should ensure that all sets are given as "vector" and they have the same mode. So for the example in the question, we should provide:

    ## note the "as.character(1:3)"
    set_list <- list(LETTERS[1:2], letters[1:6], as.character(1:3))
    k <- c(1, 3, 2)
    

    The function returns combinations in a matrix (each column is a record) if argument perm = FALSE (default). Otherwise it returns a list of matrices, each giving permutations (each row is a record) for a particular combination.

    Try the example:

    combinations <- MixedCombnPerm(set_list, k)
    permutations <- MixedCombnPerm(set_list, k, TRUE)
    

    Inspect the result:

    combinations[, 1:6]
    #     [,1] [,2] [,3] [,4] [,5] [,6]
    #[1,] "A"  "B"  "A"  "B"  "A"  "B" 
    #[2,] "a"  "a"  "a"  "a"  "a"  "a" 
    #[3,] "b"  "b"  "b"  "b"  "b"  "b" 
    #[4,] "c"  "c"  "d"  "d"  "e"  "e" 
    #[5,] "1"  "1"  "1"  "1"  "1"  "1" 
    #[6,] "2"  "2"  "2"  "2"  "2"  "2" 
    
    permutations[[1]][1:6, ]
    #     [,1] [,2] [,3] [,4] [,5] [,6]
    #[1,] "A"  "a"  "b"  "c"  "1"  "2" 
    #[2,] "A"  "a"  "b"  "c"  "2"  "1" 
    #[3,] "A"  "a"  "b"  "1"  "c"  "2" 
    #[4,] "A"  "a"  "b"  "1"  "2"  "c" 
    #[5,] "A"  "a"  "b"  "2"  "c"  "1" 
    #[6,] "A"  "a"  "b"  "2"  "1"  "c" 
    
    0 讨论(0)
提交回复
热议问题