您可以使用**RcppAlgos (v >= 2.3.5)***中的comboGroups。

library(RcppAlgos)
a <- comboGroups(10, numGroups = 2, retType = "3Darray")

dim(a)
[1] 126   5   2

a[1,,]
     Grp1 Grp2
[1,]    1    6
[2,]    2    7
[3,]    3    8
[4,]    4    9
[5,]    5   10

a[126,,]
     Grp1 Grp2
[1,]    1    2
[2,]    7    3
[3,]    8    4
[4,]    9    5
[5,]   10    6

或者，如果您更喜欢矩阵：

a1 <- comboGroups(10, 2, retType = "matrix")

head(a1)
     Grp1 Grp1 Grp1 Grp1 Grp1 Grp2 Grp2 Grp2 Grp2 Grp2
[1,]    1    2    3    4    5    6    7    8    9   10
[2,]    1    2    3    4    6    5    7    8    9   10
[3,]    1    2    3    4    7    5    6    8    9   10
[4,]    1    2    3    4    8    5    6    7    9   10
[5,]    1    2    3    4    9    5    6    7    8   10
[6,]    1    2    3    4   10    5    6    7    8    9

它的速度也非常快，你甚至可以用nThreads或Parallel = TRUE（后者使用1减去系统最大线程数）并行生成，以获得更高的效率：

comboGroupsCount(16, 4)
[1] 2627625

system.time(comboGroups(16, 4, "matrix"))
 user  system elapsed 
0.107   0.030   0.137

system.time(comboGroups(16, 4, "matrix", nThreads = 4))
 user  system elapsed 
0.124   0.067   0.055
                                ## 7 threads on my machine
system.time(comboGroups(16, 4, "matrix", Parallel = TRUE))
 user  system elapsed 
0.142   0.126   0.047

一个非常好的特性是能够生成样本或特定的词典编纂组合组，特别是当结果数量很大时。

comboGroupsCount(factor(state.abb), numGroups = 10)
Big Integer ('bigz') :
[1] 13536281554808237495608549953475109376

mySamp <- comboGroupsSample(factor(state.abb), 
                            numGroups = 10, "3Darray", n = 5, seed = 42)
                            
mySamp[1,,]
     Grp1 Grp2 Grp3 Grp4 Grp5 Grp`6 Grp7 Grp8 Grp9 Grp10
[1,] AL   AK   AR   CA   CO   CT   DE   FL   LA   MD   
[2,] IA   AZ   ME   ID   GA   OR   IL   IN   MS   NM   
[3,] KY   ND   MO   MI   HI   PA   MN   KS   MT   OH   
[4,] TX   RI   SC   NH   NV   WI   NE   MA   NY   TN  
[5,] VA   VT   UT   OK   NJ   WY   WA   NC   SD   WV   
50 Levels: AK AL AR AZ CA CO CT DE FL GA HI IA ID IL IN KS KY LA MA MD ME MI MN MO MS MT NC ND NE NH NJ NM NV NY OH ... WY

firstAndLast <- comboGroupsSample(state.abb, 10, "3Darray",
                                  sampleVec = c("1",
                                                "13536281554808237495608549953475109376"))

firstAndLast[1,,]
     Grp1 Grp2 Grp3 Grp4 Grp5 Grp6 Grp7 Grp8 Grp9 Grp10
[1,] "AL" "CO" "HI" "KS" "MA" "MT" "NM" "OK" "SD" "VA" 
[2,] "AK" "CT" "ID" "KY" "MI" "NE" "NY" "OR" "TN" "WA" 
[3,] "AZ" "DE" "IL" "LA" "MN" "NV" "NC" "PA" "TX" "WV" 
[4,] "AR" "FL" "IN" "ME" "MS" "NH" "ND" "RI" "UT" "WI" 
[5,] "CA" "GA" "IA" "MD" "MO" "NJ" "OH" "SC" "VT" "WY"
    
firstAndLast[2,,]
     Grp1 Grp2 Grp3 Grp4 Grp5 Grp6 Grp7 Grp8 Grp9 Grp10
[1,] "AL" "AK" "AZ" "AR" "CA" "CO" "CT" "DE" "FL" "GA" 
[2,] "WA" "TX" "RI" "OH" "NM" "NE" "MN" "ME" "IA" "HI" 
[3,] "WV" "UT" "SC" "OK" "NY" "NV" "MS" "MD" "KS" "ID" 
[4,] "WI" "VT" "SD" "OR" "NC" "NH" "MO" "MA" "KY" "IL" 
[5,] "WY" "VA" "TN" "PA" "ND" "NJ" "MT" "MI" "LA" "IN"

最后，使用lower和upper参数，可以在一分钟内生成所有**2,546,168,625**组合，将20人的组分为5个组（OP要求的）：

system.time(aPar <- parallel::mclapply(seq(1, 2546168625, 969969), function(x) {
     combs <- comboGroups(20, 5, "3Darray", lower = x, upper = x + 969968)
     ### do something
     dim(combs)
}, mc.cores = 6))
   user  system elapsed 
217.667  22.932  48.482

sum(sapply(aPar, "[", 1))
[1] 2546168625

虽然我开始研究这个问题over a year ago，但是这个问题给了我很大的启发，使我能够在一个包中将其形式化。

• 我是**RcppAlgos**的作者

这在很大程度上依赖于以下答案：
可以创建所有组合和这些组合的所有组的算法
需要注意的是，答案并不是动态的--它只包含了一个针对3个组的解决方案。为了使它更健壮，我们可以基于输入参数创建代码。也就是说，下面的递归函数是针对3个组动态创建的：

group <- function(input, step){
 len <- length(input) 
 combination[1, step] <<- input[1] 

 for (i1 in 2:(len-1)) { 
   combination[2, step] <<- input[i1] 

   for (i2 in (i1+1):(len-0)) { 
     combination[3, step] <<- input[i2] 

     if (step == m) { 
       print(z); result[z, ,] <<- combination 
       z <<- z+1 
     } else { 
       rest <- setdiff(input, input[c(i1,i2, 1)]) 
       group(rest, step +1) #recursive if there are still additional possibilities
   }} 
 } 
}

运行N = 16和k = 4大约需要55秒。我想把它翻译成Rcpp，但不幸的是我没有这个技能。

group_N <- function(input, k = 2) {
  N = length(input)
  m = N/k
  combos <- factorial(N) / (factorial(k)^m * factorial(m))

  result <- array(NA_integer_, dim = c(combos, m, k))
  combination = matrix(NA_integer_, nrow = k, ncol = m)

  z = 1

  group_f_start = 'group <- function(input, step){\n len <- length(input) \n combination[1,  step] <<- input[1] \n '
  i_s <- paste0('i', seq_len(k-1))

  group_f_fors = paste0('for (', i_s, ' in ', c('2', if (length(i_s) != 1) {paste0('(', i_s[-length(i_s)], '+1)')}), ':(len-', rev(seq_len(k)[-k])-1, ')) { \n combination[', seq_len(k)[-1], ', step] <<- input[', i_s, '] \n', collapse = '\n ')

  group_f_inner = paste0('if (step == m) { \n result[z, ,] <<- combination \n z <<- z+1 \n } else { \n rest <- setdiff(input, input[c(',
                         paste0(i_s, collapse = ','),
                         ', 1)]) \n group(rest, step +1) \n }')

  eval(parse(text = paste0(group_f_start, group_f_fors, group_f_inner, paste0(rep('}', times = k), collapse = ' \n '))))

  group(input, 1)
  return(result)
}

业绩

system.time({test_1 <- group_N(seq_len(4), 2)})
#   user  system elapsed 
#   0.01    0.00    0.02
library(data.table)

#this funky step is just to better show the groups. the provided
## array is fine.

as.data.table(t(rbindlist(as.data.table(apply(test_1, c(1,3), list)))))
#    V1  V2
#1: 1,2 3,4
#2: 1,3 2,4
#3: 1,4 2,3

system.time({test_1 <- group_N(seq_len(16), 4)})
#   user  system elapsed 
#  55.00    0.19   55.29 

as.data.table(t(rbindlist(as.data.table(apply(test_1, c(1,3), list)))))
#very slow
#                  V1          V2          V3          V4
#      1:     1,2,3,4     5,6,7,8  9,10,11,12 13,14,15,16
#      2:     1,2,3,4     5,6,7,8  9,10,11,13 12,14,15,16
#      3:     1,2,3,4     5,6,7,8  9,10,11,14 12,13,15,16
#      4:     1,2,3,4     5,6,7,8  9,10,11,15 12,13,14,16
#      5:     1,2,3,4     5,6,7,8  9,10,11,16 12,13,14,15
#     ---                                                
#2627621:  1,14,15,16  2,11,12,13  3, 6, 9,10     4,5,7,8
#2627622:  1,14,15,16  2,11,12,13     3,7,8,9  4, 5, 6,10
#2627623:  1,14,15,16  2,11,12,13  3, 7, 8,10     4,5,6,9
#2627624:  1,14,15,16  2,11,12,13  3, 7, 9,10     4,5,6,8
#2627625:  1,14,15,16  2,11,12,13  3, 8, 9,10     4,5,6,7

这是一个具有计算挑战性的问题，因为我相信有25亿种可能性需要枚举（如果这是错误的，我欢迎任何关于这种方法哪里出错的见解）。
根据存储方式的不同，包含所有这些分组的表可能需要比大多数计算机所能处理的更多的RAM。如果能看到一种高效的方法来创建它，我会印象深刻。如果我们采取“一次创建一个组合”的方法，如果我们每秒能生成100万个组合，那么生成所有可能性仍然需要41分钟，如果我们只能生成1个组合，那么生成所有可能性需要一个月。000次/秒。

EDIT -在底部添加了部分实现，以创建从#1到#2，546，168，625的任何所需分组。出于某些目的，这几乎与实际存储整个序列一样好，因为整个序列非常大。

假设我们将分成5组，每组4名学生：A组、B组、C组、D组和E组。
我们将1号学生所在的组定义为A组，他们可以与其他19名学生中的任意3名配对，我相信其他学生的这种组合有969种：

> nrow(t(combn(1:19, 3)))
[1] 969

现在还有16个学生可以分到其他组，我们把第一个不在A组的学生分到B组，可能是2号、3号、4号、5号，都没关系;我们只需要知道只有15个学生可以和那个学生配对。2这样的组合有455个：

> nrow(t(combn(1:15, 3)))
[1] 455

现在还剩12个学生，我们再把第一个未分组的学生分配到C组，这样他们和其他11个学生就有165种组合：

> nrow(t(combn(1:11, 3)))
[1] 165

我们还有8个学生，其中7个可以用35种方式与第一个未分组的学生配对进入D组：

> nrow(t(combn(1:7, 3)))
[1] 35

然后，一旦我们确定了其他组，就只剩下一组四个学生，其中三个可以与第一个未分组的学生配对：

> nrow(t(combn(1:3, 3)))
[1] 1

这意味着有2546亿个组合：

> 969*455*165*35*1
[1] 2546168625

下面是一个正在进行中的函数，它可以根据任意序列号生成分组。
1)[进行中]将序列号转换为一个向量，该向量描述应将哪个#组合用于组A、B、C、D和E。例如，这应将#1转换为c(1, 1, 1, 1, 1)，将#2，546，168，625转换为c(969, 455, 165, 35, 1)。
2)将组合转换为描述每个组中学生的特定输出。

groupings <- function(seq_nums) {
  students <- 20
  group_size = 4
  grouped <- NULL
  remaining <- 1:20
  seq_nums_pad <- c(seq_nums, 1) # Last group always uses the only possible combination
  for (g in 1:5) {
    group_relative <- 
      c(1, 1 + t(combn(1:(length(remaining) - 1), group_size - 1))[seq_nums_pad[g], ])
    group <- remaining[group_relative]
    print(group)
    grouped = c(grouped, group)
    remaining <-  setdiff(remaining, grouped)
  }
}

> groupings(c(1,1,1,1))
#[1] 1 2 3 4
#[1] 5 6 7 8
#[1]  9 10 11 12
#[1] 13 14 15 16
#[1] 17 18 19 20
> groupings(c(1,1,1,2))
#[1] 1 2 3 4
#[1] 5 6 7 8
#[1]  9 10 11 12
#[1] 13 14 15 17
#[1] 16 18 19 20
> groupings(c(969, 455, 165, 35))   # This one uses the last possibility for
#[1]  1 18 19 20                    #   each grouping.
#[1]  2 15 16 17
#[1]  3 12 13 14
#[1]  4  9 10 11
#[1] 5 6 7 8

这里有一个小数字的例子。我不认为这将扩展到20名学生

total_students = 4
each_group = 2
total_groups = total_students/each_group

if (total_students %% each_group == 0) {
    library(arrangements)

    group_id = rep(1:total_groups, each = each_group)

    #There is room to increase efficiency here by generating only relevant permutations
    temp = permutations(1:total_students, total_students)
    temp = unique(t(apply(temp, 1, function(i) {
        x = group_id[i]
        match(x, unique(x))
    })))

    dimnames(temp) = list(COMBO = paste0("C", 1:NROW(temp)),
                          Student = paste0("S", 1:NCOL(temp)))
} else {
    cat("Total students not multiple of each_group")
    temp = NA
}
#> Warning: package 'arrangements' was built under R version 3.5.3
temp
#>      Student
#> COMBO S1 S2 S3 S4
#>    C1  1  1  2  2
#>    C2  1  2  1  2
#>    C3  1  2  2  1

由reprex package（v0.3.0）于2019年9月2日创建
可能路径的总数由以下函数（from here）给出

foo = function(N, k) {
    #N is total number or people, k is number of people in each group
    if (N %% k == 0) {
        m = N/k
        factorial(N)/(factorial(k)^m * factorial(m))
    } else {
        stop("N is not a multiple of n")
    }
}

foo(4, 2)
#[1] 3

foo(20, 4)
#[1] 2546168625

对于总共20人中的4人的组，可能的安排的数量是巨大的。

下面的代码可以工作。

# Create list of the 20 records
list <- c(1:20)

# Generate all combinations including repetitions
c <- data.frame(expand.grid(rep(list(list), 4))); rm(list)
c$combo <- paste(c$Var1, c$Var2, c$Var3, c$Var4)
# Remove repetitions
c <- subset(c, c$Var1 != c$Var2 & c$Var1 != c$Var3 & c$Var1 != c$Var4 & c$Var2 != c$Var3 & c$Var2 != c$Var4 & c$Var3 != c$Var4)

# Create common group labels (ex. abc, acb, bac, bca, cab, cba would all have "abc" as their group label).
key <- data.frame(paste(c$Var1, c$Var2, c$Var3, c$Var4))
key$group  <- apply(key, 1, function(x) paste(sort(unlist(strsplit(x, " "))), collapse = " "))
c$group <- key$group; rm(key)

# Sort by common group label and id combos by group
c <- c[order(c$group),]
c$Var1 <- NULL; c$Var2 <- NULL; c$Var3 <- NULL; c$Var4 <- NULL;
c$rank <- rep(1:24)

# Pivot
c <- reshape(data=c,idvar="group", v.names = "combo", timevar = "rank", direction="wide")

所以你可以用expand.grid函数得到所有的组合，只需要把数据向量加四次。然后结果会有c(1,1,1,1)这样的组合，所以我删除了每一行有重复值的行，最后一部分只是进行组合。这是2个循环，非常慢，但它会得到你想要的。它可以用Rcpp包加速。代码为：

ids = 1:20
d2 = expand.grid(ids,ids,ids,ids)
## Remove rows with duplicated values
pos_use = apply(apply(d2,1,duplicated),2,function(x) all(x == F))
d2_temp = t(apply(d2[pos_use,],1,sort))
list_temp = list()
pos_quitar = NULL
for(i in 1:nrow(d2_temp)){
  pos_quitar = c(pos_quitar,i)
  ini_comb = d2_temp[i,]
  d2_temp_use  = d2_temp[-pos_quitar,]
  temp_comb = ini_comb
  for(j in 2:5){
    pos_quitar_new = which(apply(d2_temp_use,1,function(x) !any(temp_comb%in%x)))[1]
    temp_comb = c(temp_comb,d2_temp_use[pos_quitar_new,])
  }
  pos_quitar = c(pos_quitar,pos_quitar_new)
  list_temp[[i]] = temp_comb
}

list_temp

下面是一个只使用base R函数来生成可能的组组合的函数。

Group_Assignment_Function <- function (Identifiers, Number_of_Items_in_Each_Group, Number_of_Groups) {
  Output <- vector(mode = 'list', length = Number_of_Groups)
  Possible_Groups_Function <- function (x) {
    if (is.list(x)) {
      lapply(x, Possible_Groups_Function)
    } else if (!is.list(x)) {
      as.list(as.data.frame(combn(x, Number_of_Items_in_Each_Group)))
    }
  }
  Remaining_Items_Function <- function (x, y) {
    if (!is.list(y)) {
      lapply(x, function (z) {
        setdiff(y, z)
      })
    } else if (is.list(y)) {
      mapply(Remaining_Items_Function, x = x, y = y, SIMPLIFY = F)
    }
  }
  All_Possible_Groups_Function <- function (x) {
    for (i in seq_len(Number_of_Groups - 1)) {
      if (i == 1) {
        Group_Possibilities <- Possible_Groups_Function(x)
      } else if (i > 1) {
        Group_Possibilities <- Possible_Groups_Function(Remaining_Items)
      }
      Output[[i]] <- Group_Possibilities
      if (!all(sapply(Group_Possibilities, is.list))) {
        Remaining_Items <- lapply(Group_Possibilities, function (y) {
          setdiff(x, y)
        })
      } else if (all(sapply(Group_Possibilities, is.list))) {
        Remaining_Items <- Remaining_Items_Function(Group_Possibilities, Remaining_Items)
      }
    }
    if (Number_of_Groups == 1) {
      Output[[Number_of_Groups]] <- Possible_Groups_Function(x)
    } else if (Number_of_Groups > 1) {
      Output[[Number_of_Groups]] <- Possible_Groups_Function(Remaining_Items)
    }
    Output
  }
  All_Possible_Groups <- All_Possible_Groups_Function(Identifiers)
  Repitition_Times <- choose(length(Identifiers) - (Number_of_Items_in_Each_Group * (0:(Number_of_Groups - 1))), Number_of_Items_in_Each_Group)
  Repitition_Times <- c(Repitition_Times[2:length(Repitition_Times)], 1)
  Repitition_Times <- lapply((length(Repitition_Times) - seq_len(length(Repitition_Times))) + 1, function (x) {
    rev(Repitition_Times)[1:x]
  })
  Repitition_Times <- lapply(Repitition_Times, function (y) {
    Reduce(`*`, y)
  })
  All_Possible_Groups <- lapply(All_Possible_Groups, function(x) {
    z <- sapply(x, function (y) {
      class(y)[1] == "list"
    })
    w <- c(x[!z], unlist(x[z], recursive = F))
    if (sum(z)){
      Recall(w)
    } else if (!sum(z)) {
      w
    }
  })
  All_Possible_Groups <- mapply(function (x, y) {
    x[rep(seq_len(length(x)), each = y)]
  }, x = All_Possible_Groups, y = Repitition_Times, SIMPLIFY = F)
  All_Possible_Groups <- lapply(seq_len(unique(sapply(All_Possible_Groups, length))), function (x) {
    lapply(All_Possible_Groups,"[[", x)
  })
  List_of_Possible_Groups <- lapply(All_Possible_Groups, function (x) {
    names(x) <- paste0("Group_", seq_len(Number_of_Groups))
    x
  })
  names(List_of_Possible_Groups) <- NULL
  Ordered_List_of_Possible_Groups_1 <- lapply(List_of_Possible_Groups, function (x) {
    lapply(x, sort)
  })
  Ordered_List_of_Possible_Groups_2 <- lapply(Ordered_List_of_Possible_Groups_1, function (x) {
    order(sapply(x, function (y) {
      y[1]
    }))
  })
  Ordered_List_of_Possible_Groups_1 <- mapply(function (x, y) {
    x[y]
  }, x = Ordered_List_of_Possible_Groups_1, y = Ordered_List_of_Possible_Groups_2, SIMPLIFY = F)
  Ordered_List_of_Possible_Groups_1 <- lapply(Ordered_List_of_Possible_Groups_1, function (x) {
    do.call('c', x)
      })
  Ordered_List_of_Possible_Groups_1 <- lapply(Ordered_List_of_Possible_Groups_1, function (x) {
    names(x) <- NULL
    x
  })
  List_of_Possible_Groups <- List_of_Possible_Groups[-c(which(duplicated(Ordered_List_of_Possible_Groups_1)))]
  names(List_of_Possible_Groups) <- paste("Possibility", seq_len(length(List_of_Possible_Groups)), sep = "_")
  List_of_Possible_Groups
}

下面是如何使用它的示例：

Identifiers <- as.character(1:5)
Number_of_Items_in_Each_Group <- 2
Number_of_Groups <- 2
Group_Assignment_Function(Identifiers = Identifiers, Number_of_Items_in_Each_Group = Number_of_Items_in_Each_Group, Number_of_Groups = Number_of_Groups)
# $Possibility_1
# $Possibility_1$Group_1
# [1] "1" "2"
# 
# $Possibility_1$Group_2
# [1] "3" "4"
# 
# 
# $Possibility_2
# $Possibility_2$Group_1
# [1] "1" "2"
# 
# $Possibility_2$Group_2
# [1] "3" "5"
# 
# 
# $Possibility_3
# $Possibility_3$Group_1
# [1] "1" "2"
# 
# $Possibility_3$Group_2
# [1] "4" "5"
# 
# 
# $Possibility_4
# $Possibility_4$Group_1
# [1] "1" "3"
# 
# $Possibility_4$Group_2
# [1] "2" "4"
# 
# 
# $Possibility_5
# $Possibility_5$Group_1
# [1] "1" "3"
# 
# $Possibility_5$Group_2
# [1] "2" "5"
# 
# 
# $Possibility_6
# $Possibility_6$Group_1
# [1] "1" "3"
# 
# $Possibility_6$Group_2
# [1] "4" "5"
# 
# 
# $Possibility_7
# $Possibility_7$Group_1
# [1] "1" "4"
# 
# $Possibility_7$Group_2
# [1] "2" "3"
# 
# 
# $Possibility_8
# $Possibility_8$Group_1
# [1] "1" "4"
# 
# $Possibility_8$Group_2
# [1] "2" "5"
# 
# 
# $Possibility_9
# $Possibility_9$Group_1
# [1] "1" "4"
# 
# $Possibility_9$Group_2
# [1] "3" "5"
# 
# 
# $Possibility_10
# $Possibility_10$Group_1
# [1] "1" "5"
# 
# $Possibility_10$Group_2
# [1] "2" "3"
# 
# 
# $Possibility_11
# $Possibility_11$Group_1
# [1] "1" "5"
# 
# $Possibility_11$Group_2
# [1] "2" "4"
# 
# 
# $Possibility_12
# $Possibility_12$Group_1
# [1] "1" "5"
# 
# $Possibility_12$Group_2
# [1] "3" "4"
# 
# 
# $Possibility_13
# $Possibility_13$Group_1
# [1] "2" "3"
# 
# $Possibility_13$Group_2
# [1] "4" "5"
# 
# 
# $Possibility_14
# $Possibility_14$Group_1
# [1] "2" "4"
# 
# $Possibility_14$Group_2
# [1] "3" "5"
# 
# 
# $Possibility_15
# $Possibility_15$Group_1
# [1] "2" "5"
# 
# $Possibility_15$Group_2
# [1] "3" "4"

如果有更好的base R解决方案，我很乐意去看看。我相信有更有效的方法，因为这种方法生成所有可能的排列，然后去掉每个组中实际上没有不同东西的排列。

下面的代码给出了从20个中选择的4个的所有唯一组合，没有重复。

x <- c(1:20)
combinations <- data.frame(t(combn(x, 4)))