Rearrange groups without repeating subjects

Question

I am facing a unique situation where I have 31 students in my class and I want them to be divided into 8 groups (4 each with exception of one with only 3 members). The specific rule I am trying to follow is that no student should work with another student if they have already worked together.

I need to create three group sets (that includes 8 groups each time) for three weeks and follow this logic. Manually it is a tad complicated and I was hoping I can write a code in R to get the desired result, however I am at loss, as to how to correct the following as it is not giving me the write sequence in some cases.

# List of student names
students <- c("Student1", "Student2", "Student3", "Student4", "Student5", "Student6", "Student7", "Student8", "Student9", "Student10",
              "Student11", "Student12", "Student13", "Student14", "Student15", "Student16", "Student17", "Student18", "Student19", "Student20",
              "Student21", "Student22", "Student23", "Student24", "Student25", "Student26", "Student27", "Student28", "Student29", "Student30", "Student31")

# Number of students
num_students <- length(students)

# Number of rounds
num_rounds <- 3

# Group size
group_size <- 4

# Create an empty list to store groups
all_groups <- list()

# Function to create groups
create_groups <- function(students, group_size) {
  shuffled_students <- sample(students)
  groups <- split(shuffled_students, ceiling(seq_along(shuffled_students)/group_size))
  return(groups)
}

# Loop through each round
for (round in 1:num_rounds) {
  # Create groups for the current round
  groups <- create_groups(students, group_size)
  
  # Append the groups to the list
  all_groups[[paste0("Round", round)]] <- groups
}

# Print the results
for (round in 1:num_rounds) {
  cat("Round", round, ":\n")
  print(all_groups[[paste0("Round", round)]])
  cat("\n")
}

And once the right sequence is found, is there a way to find out if that worked or not?

Answer 1

You can use round-robin way to schedule the groups, for example

v <- c(1:31, NA) # `NA` is just a placeholder to create matrix representations
p <- v[1:16]
q <- v[-(1:16)]
iter <- 3

fidx1 <- function(n, k) {
  seq(1, by = k, length.out = n) %% n + 1
}

fidx2 <- function(n, k) {
  p <- fidx1(n, k)
  c(p[-1], p[1])
}

res <- lapply(
  2 * seq_len(iter) - 1,
  \(k)
  matrix(
    rbind(p[fidx1(16, k)], q[fidx2(16, k + 2)]),
    4
  )
)

and you will obtain

> res
[[1]]
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]    2    4    6    8   10   12   14   16
[2,]   21   27   17   23   29   19   25   31
[3,]    3    5    7    9   11   13   15    1
[4,]   24   30   20   26   NA   22   28   18

[[2]]
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]    2    8   14    4   10   16    6   12
[2,]   23   17   27   21   31   25   19   29
[3,]    5   11    1    7   13    3    9   15
[4,]   28   22   NA   26   20   30   24   18

[[3]]
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]    2   12    6   16   10    4   14    8
[2,]   25   23   21   19   17   31   29   27
[3,]    7    1   11    5   15    9    3   13
[4,]   NA   30   28   26   24   22   20   18

where each column denotes a group

---

Below is the checker function to exam if there exists duplicates across group sets

nodupchecker <- function(...) {
  v <- as.list(...)
  u1 <- asplit(v[[1]], 2)
  u2 <- asplit(v[[2]], 2)
  all(lengths(outer(u1, u2, Vectorize(intersect))) <= 1)
}

and we see no duplicates since

> all(combn(res, 2, nodupchecker))
[1] TRUE

Answer 2

You can use group movement patterns for this one instead of random sampling. This is otherwise known as the Social Golfer Problem, and Wikipedia has a applicable solution for the 32 players, 4 per group problem which lasts 10 weeks.

library(data.table)

# You can drop the last student at the end.
dt <- data.table(students = 1:32)

dt[, week_1_group := rep(1:8, each = 4)]

# Shift students in a pattern.  First student goes to next group, 
# second student goes to previous group, third student -> group + 2 and
# fourth student stays where they are.
dt[, week_2_group := week_1_group + 
     (students %% 4 == 1) -
     (students %% 4 == 2) +
     2*(students %% 4 == 3)]
dt[week_2_group <= 0, week_2_group := 8 - week_2_group]
dt[week_2_group > 8, week_2_group := week_2_group - 8]

# And repeat for week 3, using week 2 as a starting point.
dt[, week_3_group := week_2_group + 
     (students %% 4 == 1) -
     (students %% 4 == 2) +
     2*(students %% 4 == 3)]
dt[week_3_group <= 0, week_3_group := 8 - week_3_group]
dt[week_3_group > 8, week_3_group := week_3_group - 8]

# Check this works - 4 students in each group.
dt[, .(count = .N), keyby = week_1_group]
dt[, .(count = .N), keyby = week_2_group]
dt[, .(count = .N), keyby = week_3_group]

# Don't work with the same student twice.
group_pairs <- rbindlist(list(
  dt[dt, .(students, worked_with = i.students), 
     on = .(week_1_group),
     allow.cartesian = TRUE][students != worked_with],
  dt[dt, .(students, worked_with = i.students), 
     on = .(week_2_group),
     allow.cartesian = TRUE][students != worked_with],
  dt[dt, .(students, worked_with = i.students), 
     on = .(week_3_group),
     allow.cartesian = TRUE][students != worked_with]
))

# Each student should have worked with 9 other unique students after 3 weeks
group_pairs[, .(count = uniqueN(worked_with),
                total = .N),
            keyby = students]

And 3 weeks worth of groups. Note these don't match the Wikipedia solution, which is generated a different way.

    students week_1_group week_2_group week_3_group
 1:        1            1            2            3
 2:        2            1            8            7
 3:        3            1            3            5
 4:        4            1            1            1
 5:        5            2            3            4
 6:        6            2            1            8
 7:        7            2            4            6
 8:        8            2            2            2
 9:        9            3            4            5
10:       10            3            2            1
11:       11            3            5            7
12:       12            3            3            3
13:       13            4            5            6
14:       14            4            3            2
15:       15            4            6            8
16:       16            4            4            4
17:       17            5            6            7
18:       18            5            4            3
19:       19            5            7            1
20:       20            5            5            5
21:       21            6            7            8
22:       22            6            5            4
23:       23            6            8            2
24:       24            6            6            6
25:       25            7            8            1
26:       26            7            6            5
27:       27            7            1            3
28:       28            7            7            7
29:       29            8            1            2
30:       30            8            7            6
31:       31            8            2            4
32:       32            8            8            8
    students week_1_group week_2_group week_3_group