смешанные комбинации / перестановки из разных наборов - PullRequest
Новая
       27

смешанные комбинации / перестановки из разных наборов

0 голосов
/ 06 октября 2018

Эти вопросы и ответы мотивированы Как построить перестановку с некоторыми условиями в R .

До сих пор было несколько хороших пакетов R, таких как RcppAlgos и * 1006.* предлагая эффективные комбинации / перестановки в одном наборе .Например, следующее дает все комбинации, если мы хотим выбрать 3 элемента из letters[1:6]: 

library(RcppAlgos)
comboGeneral(letters[1:6], 3)
#      [,1] [,2] [,3]
# [1,] "a"  "b"  "c" 
# [2,] "a"  "b"  "d" 
# [3,] "a"  "b"  "e" 
# [4,] "a"  "b"  "f" 
# [5,] "a"  "c"  "d" 
# [6,] "a"  "c"  "e" 
# [7,] "a"  "c"  "f" 
# [8,] "a"  "d"  "e" 
# [9,] "a"  "d"  "f" 
#[10,] "a"  "e"  "f" 
#[11,] "b"  "c"  "d" 
#[12,] "b"  "c"  "e" 
#[13,] "b"  "c"  "f" 
#[14,] "b"  "d"  "e" 
#[15,] "b"  "d"  "f" 
#[16,] "b"  "e"  "f" 
#[17,] "c"  "d"  "e" 
#[18,] "c"  "d"  "f" 
#[19,] "c"  "e"  "f" 
#[20,] "d"  "e"  "f"

Однако, что если нам нужно что-то более сложное, например,

  • , выберите1 элемент из LETTERS[1:2]
  • выберите 3 элемента из letters[1:6]
  • выберите 2 элемента из as.character(1:3)

Как создать все комбинации и, при необходимости, все перестановки

1 Ответ

0 голосов
/ 06 октября 2018

Предположим, у нас есть список наборов set_list, где k[i] элементы выбраны из set_list[[i]], а затем, математически, мы решим проблему следующим образом:

  1. сгенерируем все комбинациидля каждого набора;
  2. объединение комбинаций из всех наборов;
  3. создание всех перестановок для каждой комбинации.

Функция MixedCombnPerm ниже является моей реализацией с использованием RcppAlgos для шага 1 и шага 3. В настоящее время шаг 2 не использует оптимальный алгоритм.Это «грубая сила», предполагающая более быструю реализацию expand.grid и последующую rbind.Я знаю более быстрый рекурсивный метод (например, тот, который используется для формирования матрицы модели тензорного произведения в mgcv), который можно кодировать в Rcpp, но по причине времени я бы не стал делать это сейчас. 

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)
    }

  }

Функция выполняет строгую проверку ввода.Пользователь должен убедиться, что все наборы заданы как «вектор» и имеют одинаковый режим.Поэтому для примера в вопросе мы должны предоставить: 

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

Функция возвращает комбинации в матрице (каждый столбец является записью), если аргумент perm = FALSE (по умолчанию).В противном случае он возвращает список матриц, каждая из которых дает перестановки (каждая строка является записью) для определенной комбинации.

Попробуйте пример: 

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

Проверьте результат: 

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"
...