Search code examples
ralgorithmcombinatorics

Rearrange groups without repeating subjects


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?


Solution

  • 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