Create Combinations in R by Groups
Asked Answered
C

9

13

I want to create a list for my classroom of every possible group of 4 students. If I have 20 students, how I can I create this, by group, in R where my rows are each combination and there are 20 columns for the full list of student ids and columns 1-4 are "group1", 5-9 are "group2" etc. etc.

The below gives a list of possible combinations for each single group of 4 students (x1, x2, x3, and x4). Now, for each row listed, what are the possibilities for the other 4 groups of 4 students? So, there should be 20 columns (Group1_1:4, Group2_1:4, Group3_1:4, Group4_1:4, Group5_1:4).

combn(c(1:20), m = 4)

Desired Output

Combination 1 = Group1[1, 2, 3, 4] Group2[5, 6, 7, 8], Group3[9, 10, 11, 12], etc. 
Combination 2 = Group1[1, 2, 3, 5]... etc. 

There are a lot of posts about combinations out there, it's possible this is already answered and I just couldn't find it. Any help is appreciated!

Caban answered 30/8, 2019 at 20:5 Comment(10)
Is your goal to assign groups or to get a list of all possible unique ways to create the groups? Because one is very easy and doesn't take much storage. The other would require a decent amount of storage just to save the results.Building
Yeah, I figured it would be a decently sized data set but my goal is the create a list of all possible unique ways to create the groups.Caban
Not to be a pest and I'm sure this is just a toy example. But can you provide a reason for why you want to do this?Building
That gives me a list of each possible single group of 4 values. What I want to know is if one combination of a group is [1, 2, 3, 4]... What are the possibilities for the other 4 groups. Let me know if that clears it up.Caban
Sure. 2 groups with 4 total students... combo1 - group1 = 1, 2, group 2 = 3, 4 combo2 - group1 = 1, 3, group2 = 2, 4 combo3 - group1 = 1, 4, group2 = 2, 3Caban
Maybe a card game is a better example. If there are 20 cards in a deck numbered 1-20 and there are 5 players and each player gets 4 cards. For each combination I could have (combn(c(1:20), m = 4)), what are the combinations of the other 4 players grouped by each player.Caban
there might be factorial(20) number of combinations. are you sure you want all of them?Mechanical
Are you trying to do this: https://mcmap.net/q/904766/-iterating-through-combinations-of-groups-of-4-within-a-group-of-16. If so, I think I can whip up something fairly easy in R.Billfish
@JosephWood, yes, I believe that is the same thing I am trying to do here. (Sorry, a bit late in responding to you)Caban
Here's the basic idea for an algorithm; not sure whether this translates to R: #39127212Maori
B
8

You can use comboGroups from RcppAlgos (v >= 2.3.5)*.

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

Or if you prefer matrices:

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

It is also really fast. You can even generate in parallel with nThreads or Parallel = TRUE (the latter uses one minus the system max threads) for greater efficiency gains:

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

A really nice feature is the ability to generate samples or specific lexicographical combination groups, especially when the number of results is large.

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"

And finally, generating all 2,546,168,625 combinations groups of 20 people into 5 groups (what the OP asked for) can be achieved in under a minute using the lower and upper arguments:

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

Although I started working on this problem over a year ago, this question was a huge inspiration for getting this formalized in a package.

* I am the author of RcppAlgos

Billfish answered 9/9, 2019 at 22:32 Comment(0)
R
6

This is a challenging problem computationally, since I believe there are 2.5 billion possibilities to enumerate. (If it's mistaken, I'd welcome any insight about where this approach goes wrong.)

Depending on how it's stored, a table with all those groupings might require more RAM than most computers can handle. I'd be impressed to see an efficient way to create that. If we took a "create one combination at a time" approach, it would still take 41 minutes to generate all the possibilities if we could generate 1,000,000 per second, or a month if we could only generate 1,000 per second.

EDIT - added partial implementation at the bottom to create any desired grouping from #1 to #2,546,168,625. For some purposes, this may be almost as good as actually storing the whole sequence, which is very large.


Let's say we are going to make 5 groups of four students each: Group A, B, C, D, and E.

Let's define Group A as the group Student #1 is in. They can be paired with any three of the other 19 students. I believe there are 969 such combinations of other students:

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

Now there are now 16 students left for other groups. Let's assign the first student not already in Group A into Group B. That might be student 2, 3, 4, or 5. It doesn't matter; all we need to know is that there are only 15 students that can be paired with that student. There are 455 such combinations:

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

Now there are 12 student left. Again, let's assign the first ungrouped student to Group C, and we have 165 combinations left for them with the other 11 students:

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

And we have 8 students left, 7 of whom can be paired with first ungrouped student into Group D in 35 ways:

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

And then, once our other groups are determined, there's only one group of four students left, three of whom can be paired with the first ungrouped student:

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

That implies 2.546B combinations:

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

Here's a work-in-progress function that produces a grouping based on any arbitrary sequence number.

1) [in progress] Convert sequence number to a vector describing which # combination should be used for Group A, B, C, D, and E. For instance, this should convert #1 to c(1, 1, 1, 1, 1) and #2,546,168,625 to c(969, 455, 165, 35, 1).

2) Convert the combinations to a specific output describing the students in each Group.

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
Rosalvarosalyn answered 8/9, 2019 at 21:46 Comment(3)
Your reasoning is correct and at the heart of calculating the nth combination group (not really sure about the proper terminology).Billfish
@JosephWood I think the proper terminology is that n is the "rank" of the n-th combination.Maori
@m69, ah yes, I've heard of rank/unrank before. I was actually asking about the proper terminology for these arrangements (i.e. the "combination groups"). They are kinda like combinations and permutations. They are definitely in the realm of combinatorics. Over years, after being exposed to new things in this field with a given name (e.g. I just got introduced to superpermutations), I'm betting this situation is no different.Billfish
R
6

This relies heavily on this answer:

Algorithm that can create all combinations and all groups of those combinations

One thing to note is that the answer is not that dynamic - it only included a solution for groups of 3. To make it more robust, we can create the code based on the input parameters. That is, the following recursive function is created on the fly for groups 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
   }} 
 } 
}

This takes around 55 seconds to run for N = 16 and k = 4. I'd like to translate it into Rcpp but unfortunately I do not have that skillset.

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

Performance

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
Reena answered 9/9, 2019 at 2:50 Comment(0)
A
4

Here's an example for smaller numbers. I don't think this will scale well for 20 students

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

Created on 2019-09-02 by the reprex package (v0.3.0)

The total number of possible ways is given by following function (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

For groups of 4 people from a total of 20 people, the number of possible arrangements is massive.

Abduce answered 30/8, 2019 at 22:19 Comment(1)
I think you are right and this can be simplified. For our sake, C1 and C6 (above) are the same. They group students 1 and 2 together and students 3 and 4 together.Caban
T
1

You can try defining a custom function with base R like below

f <- function(v, grpsz) {
    p <- combn(v, grpsz)
    lst <- asplit(p[, p[1, ] == min(p[1, ])], 2)
    cnt <- 1
    repeat {
        if (cnt == length(v) / grpsz) {
            return(lst)
        }
        lst <- unlist(lapply(lst, \(x) {
            p <- combn(v[!v %in% x], grpsz)
            Map(
                cbind,
                list(x),
                asplit(
                    p[, p[1, ] == min(p[1, ]), drop = FALSE],
                    2
                )
            )
        }), recursive = FALSE)
        cnt <- cnt + 1
    }
}

such that we can obtain results in a list of matrices (each column denotes a group) for example

> f(1:6, 2)
[[1]]
     [,1] [,2] [,3]
[1,]    1    3    5
[2,]    2    4    6

[[2]]
     [,1] [,2] [,3]
[1,]    1    3    4
[2,]    2    5    6

[[3]]
     [,1] [,2] [,3]
[1,]    1    3    4
[2,]    2    6    5

[[4]]
     [,1] [,2] [,3]
[1,]    1    2    5
[2,]    3    4    6

[[5]]
     [,1] [,2] [,3]
[1,]    1    2    4
[2,]    3    5    6

[[6]]
     [,1] [,2] [,3]
[1,]    1    2    4
[2,]    3    6    5

[[7]]
     [,1] [,2] [,3]
[1,]    1    2    5
[2,]    4    3    6

[[8]]
     [,1] [,2] [,3]
[1,]    1    2    3
[2,]    4    5    6

[[9]]
     [,1] [,2] [,3]
[1,]    1    2    3
[2,]    4    6    5

[[10]]
     [,1] [,2] [,3]
[1,]    1    2    4
[2,]    5    3    6

[[11]]
     [,1] [,2] [,3]
[1,]    1    2    3
[2,]    5    4    6

[[12]]
     [,1] [,2] [,3]
[1,]    1    2    3
[2,]    5    6    4

[[13]]
     [,1] [,2] [,3]
[1,]    1    2    4
[2,]    6    3    5

[[14]]
     [,1] [,2] [,3]
[1,]    1    2    3
[2,]    6    4    5

[[15]]
     [,1] [,2] [,3]
[1,]    1    2    3
[2,]    6    5    4


> f(1:6, 3)
[[1]]
     [,1] [,2]
[1,]    1    4
[2,]    2    5
[3,]    3    6

[[2]]
     [,1] [,2]
[1,]    1    3
[2,]    2    5
[3,]    4    6

[[3]]
     [,1] [,2]
[1,]    1    3
[2,]    2    4
[3,]    5    6

[[4]]
     [,1] [,2]
[1,]    1    3
[2,]    2    4
[3,]    6    5

[[5]]
     [,1] [,2]
[1,]    1    2
[2,]    3    5
[3,]    4    6

[[6]]
     [,1] [,2]
[1,]    1    2
[2,]    3    4
[3,]    5    6

[[7]]
     [,1] [,2]
[1,]    1    2
[2,]    3    4
[3,]    6    5

[[8]]
     [,1] [,2]
[1,]    1    2
[2,]    4    3
[3,]    5    6

[[9]]
     [,1] [,2]
[1,]    1    2
[2,]    4    3
[3,]    6    5

[[10]]
     [,1] [,2]
[1,]    1    2
[2,]    5    3
[3,]    6    4
Tarton answered 3/9, 2023 at 22:19 Comment(0)
B
0

This code below works.

# 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")
Brahear answered 31/8, 2019 at 12:6 Comment(2)
There are 4,845 unique combinations in 20C4. He's asking (I think), for any one of those combinations (ex. 1,2,3,4), what are all the permutation (ex. 1234, 1243, 1324, 1342, ...). There are a total of 24 possible permutations for each of the 4,845 combinations. So the final result is a 4,845 x 24 matrix (with one extra column representing the common group label).Brahear
Yeah, I think you're right. Looks like a dupe question for your answer.Brahear
B
0

So you could get all the combinations with the expand.grid function just adding the vector of data four times. Then the result will have combinations like c(1,1,1,1) so i remove each row that have any duplicated value and the last part is just making the combinations. It is 2 loops and it is quite slow but it will get what you want. It could be speed up with the Rcpp package. The code is:

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
Bartley answered 6/9, 2019 at 1:38 Comment(0)
C
0

Here's a function that uses only base R functions for generating possible combinations of groups.

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
}

Here's an example of how to use it:

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"

It takes a while for larger numbers of items. If anyone has a better base R solution I'd love to see it. I'm sure there are more efficient ways since this way generates all the possible permutations and then gets rid of ones that don't actually have different things in each group.

Collusive answered 2/1, 2022 at 19:15 Comment(0)
B
-1

This code below gives all unique combinations for 4 selected from 20 without duplicates.

x <- c(1:20)
combinations <- data.frame(t(combn(x, 4)))
Brahear answered 30/8, 2019 at 20:39 Comment(1)
This gives a list of possible combinations for each single group of 4 students (x1, x2, x3, and x4). Now, for each row listed, what are the possibilities for the other 4 groups of 4 students? So, there should be 20 columns (Group1_1:4, Group2_1:4, Group3_1:4, Group4_1:4, Group5_1:4). Let me know if that clears it up.Caban

© 2022 - 2024 — McMap. All rights reserved.