重新排列组而不重复主题

Tat*_*ato 5 algorithm r combinatorics

我面临着一个独特的情况,我的班级有 31 名学生,我希望他们分为 8 组(每组 4 人,其中一组只有 3 名成员)。我试图遵循的具体规则是,如果学生已经一起工作过,那么任何学生都不应与其他学生一起工作。

我需要在三周内创建三个小组集(每次包括 8 组)并遵循这个逻辑。手动操作有点复杂,我希望我可以在 R 中编写代码以获得所需的结果,但是我不知如何纠正以下内容,因为在某些情况下它没有给我写入顺序。

# 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")
}
Run Code Online (Sandbox Code Playgroud)

一旦找到正确的序列,有没有办法确定它是否有效?

Tho*_*ing 5

您可以使用循环方式来安排组,例如

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
  )
)
Run Code Online (Sandbox Code Playgroud)

你将获得

> 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
Run Code Online (Sandbox Code Playgroud)

其中每列表示一个组


下面是检查器函数,用于检查组间是否存在重复项

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

从那以后我们就没有看到重复的内容

> all(combn(res, 2, nodupchecker))
[1] TRUE
Run Code Online (Sandbox Code Playgroud)