r - R中的匹配算法（二分匹配，匈牙利算法）

Question

我想知道如何在R中设置一些基本匹配程序的示例。各种编程语言中有很多示例，但是我还没有找到R的好示例。

假设我想让学生与项目相匹配，我会考虑在谷歌上搜索这个问题时遇到的 3 种替代方法：

1）二分匹配案例：我要求每个学生说出 3 个要从事的项目（没有说明这 3 个项目中的任何偏好排名）。

ID  T.1 T.2 T.3 T.4 T.5 T.6 T.7
1   1   1   1   0   0   0   0
2   0   0   0   0   1   1   1
3   0   1   1   1   0   0   0
4   0   0   0   1   1   1   0
5   1   0   1   0   1   0   0
6   0   1   0   0   0   1   1
7   0   1   1   0   1   0   0

--

d.1 <- structure(list(Student.ID = 1:7, Project.1 = c(1L, 0L, 0L, 0L, 
1L, 0L, 0L), Project.2 = c(1L, 0L, 1L, 0L, 0L, 1L, 1L), Project.3 = c(1L, 
0L, 1L, 0L, 1L, 0L, 1L), Project.4 = c(0L, 0L, 1L, 1L, 0L, 0L, 
0L), Project.5 = c(0L, 1L, 0L, 1L, 1L, 0L, 1L), Project.6 = c(0L, 
1L, 0L, 1L, 0L, 1L, 0L), Project.7 = c(0L, 1L, 0L, 0L, 0L, 1L, 
0L)), .Names = c("Student.ID", "Project.1", "Project.2", "Project.3", 
"Project.4", "Project.5", "Project.6", "Project.7"), class = "data.frame", row.names = c(NA, 
-7L))

2）匈牙利算法：我要求每个学生命名 3 个项目，并说明这 3 个项目中的偏好排名。据我了解，在这种情况下应用该算法的推理类似于：排名越好，排名越低学生的“成本”。

ID  T.1 T.2 T.3 T.4 T.5 T.6 T.7
1   3   2   1   na  na  na  na
2   na  na  na  na  1   2   3
3   na  1   3   2   na  na  na
4   na  na  na  1   2   3   na
5   2   na  3   na  1   na  na
6   na  3   na  na  na  2   1
7   na  1   2   na  3   na  na

--

d.2 <- structure(list(Student.ID = 1:7, Project.1 = structure(c(2L, 3L, 
3L, 3L, 1L, 3L, 3L), .Label = c("2", "3", "na"), class = "factor"), 
    Project.2 = structure(c(2L, 4L, 1L, 4L, 4L, 3L, 1L), .Label = c("1", 
    "2", "3", "na"), class = "factor"), Project.3 = structure(c(1L, 
    4L, 3L, 4L, 3L, 4L, 2L), .Label = c("1", "2", "3", "na"), class = "factor"), 
    Project.4 = structure(c(3L, 3L, 2L, 1L, 3L, 3L, 3L), .Label = c("1", 
    "2", "na"), class = "factor"), Project.5 = structure(c(4L, 
    1L, 4L, 2L, 1L, 4L, 3L), .Label = c("1", "2", "3", "na"), class = "factor"), 
    Project.6 = structure(c(3L, 1L, 3L, 2L, 3L, 1L, 3L), .Label = c("2", 
    "3", "na"), class = "factor"), Project.7 = structure(c(3L, 
    2L, 3L, 3L, 3L, 1L, 3L), .Label = c("1", "3", "na"), class = "factor")), .Names = c("Student.ID", 
"Project.1", "Project.2", "Project.3", "Project.4", "Project.5", 
"Project.6", "Project.7"), class = "data.frame", row.names = c(NA, 
-7L))

3）？？？方法：这应该与（2）非常相关。但是，我认为这可能是一种更好/更公平的方法（至少在示例的设置中）。学生不能选择项目，他们甚至不知道项目，但是他们已经对他们的资格（1“不存在”到10“专业水平”）进行了评价。此外，讲师还对每个项目所需的技能进行了评级。除了 (2) 之外，第一步是计算相似度矩阵，然后从上面运行优化程序。

PS: Programming Skills
SK: Statistical Knowledge
IE: Industry Experience

ID  PS  SK  IE
1   10  9   8
2   1   2   10
3   10  2   5
4   2   5   3
5   10  2   10
6   1   10  1
7   5   5   5

--

d.3a <- structure(list(Student.ID = 1:7, Programming.Skills = c(10L, 1L, 
10L, 2L, 10L, 1L, 5L), Statistical.knowlegde = c(9L, 2L, 2L, 
5L, 2L, 10L, 5L), Industry.Expertise = c(8L, 10L, 5L, 3L, 10L, 
1L, 5L)), .Names = c("Student.ID", "Programming.Skills", "Statistical.knowlegde", 
"Industry.Expertise"), class = "data.frame", row.names = c(NA, 
-7L))

--

T: Topic ID
PS: Programming Skills
SK: Statistical Knowledge
IE: Industry Experience

T  PS   SK  IE
1   10  5   1
2   1   1   5
3   10  10  10
4   2   8   3
5   4   3   2
6   1   1   1
7   5   7   2

--

d.3b <- structure(list(Project.ID = 1:7, Programming.Skills = c(10L, 
1L, 10L, 2L, 4L, 1L, 5L), Statistical.Knowlegde = c(5L, 1L, 10L, 
8L, 3L, 1L, 7L), Industry.Expertise = c(1L, 5L, 10L, 3L, 2L, 
1L, 2L)), .Names = c("Project.ID", "Programming.Skills", "Statistical.Knowlegde", 
"Industry.Expertise"), class = "data.frame", row.names = c(NA, 
-7L))

我将不胜感激在 R 中实施这 3 种方法的任何帮助。谢谢。

更新：以下问题似乎是相关的，但没有一个显示如何在 R 中解决它： https://math.stackexchange.com/questions/132829/group-membership-assignment-by-preferences-optimization-problem https://math.stackexchange.com/questions/132829/group-membership-assignment-by-preferences-optimization-problem /superuser.com/questions/467577/using-optimization-to-assign-by-preference

score 3 · Accepted Answer

以下是使用二分匹配和匈牙利算法的可能解决方案。

我提出的使用二分匹配的解决方案可能不是您的想法。下面的所有代码都是针对指定次数的迭代随机抽样，之后希望至少能确定一个解决方案。这可能需要大量的迭代和长时间的大问题。下面的代码在 200 次迭代中为您的示例问题找到了三个解决方案。

matrix1 <- matrix(c( 1,   1,   1,  NA,  NA,  NA,  NA,
                    NA,  NA,  NA,  NA,   1,   1,   1,
                    NA,   1,   1,   1,  NA,  NA,  NA,
                    NA,  NA,  NA,   1,   1,   1,  NA,
                     1,  NA,   1,  NA,   1,  NA,  NA,
                    NA,   1,  NA,  NA,  NA,   1,   1,
                    NA,   1,   1,  NA,   1,  NA,  NA), nrow=7, byrow=TRUE)

set.seed(1234)

iters <- 200

my.match <- matrix(NA, nrow=iters, ncol=ncol(matrix1))

for(i in 1:iters) {

     for(j in 1:nrow(matrix1)) {

          my.match[i,j] <- sample(which(matrix1[j,] == 1), 1)

     }
}

n.unique <- apply(my.match, 1, function(x) length(unique(x)))

my.match[n.unique==ncol(matrix1),]

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

clue这是使用包和solve_LSAP()@jackStinger 建议的匈牙利算法的代码。为此，我必须替换缺失的观察结果，并随意用 4 替换它们。第 5 个人没有得到他们的第一选择，第 7 个人没有得到他们三个选择中的任何一个。

library(clue)

matrix1 <- matrix(c( 3,   2,   1,   4,   4,   4,   4,
                     4,   4,   4,   4,   1,   2,   3,
                     4,   1,   3,   2,   4,   4,   4,
                     4,   4,   4,   1,   2,   3,   4,
                     2,   4,   3,   4,   1,   4,   4,
                     4,   3,   4,   4,   4,   2,   1,
                     4,   1,   2,   4,   3,   4,   4), nrow=7, byrow=TRUE)

matrix1

solve_LSAP(matrix1, maximum = FALSE)

# Optimal assignment:
# 1 => 3, 2 => 5, 3 => 2, 4 => 4, 5 => 1, 6 => 7, 7 => 6

这是一个显示匈牙利算法如何工作的网站的链接：http: //www.wikihow.com/Use-the-Hungarian-Algorithm

编辑：2014 年 6 月 5 日

这是我第一次尝试优化第三种情况。我将每个学生随机分配到一个项目，然后计算该组作业的成本。成本是通过找出学生的技能组合与项目所需技能之间的差异来计算的。将这些差异的绝对值相加，得出七项任务的总成本。

下面我将这个过程重复 10,000 次，并确定这 10,000 个任务中的哪一个导致成本最低。

另一种方法是对所有可能的学生项目作业进行详尽的搜索。

随机搜索和详尽搜索都不是您的想法。但是，前者会给出一个近似的最优解，而后者会给出一个精确的最优解。

稍后我可能会回到这个问题。

students <- matrix(c(10,   9,   8,
                      1,   2,  10,
                     10,   2,   5,
                      2,   5,   3,
                     10,   2,  10,
                      1,  10,   1,
                      5,   5,   5), nrow=7, ncol=3, byrow=TRUE)

projects <- matrix(c(10,   5,    1,
                      1,   1,    5,
                     10,  10,   10,
                      2,   8,    3,
                      4,   3,    2,
                      1,   1,    1,
                      5,   7,    2), nrow=7, ncol=3, byrow=TRUE)

iters <- 10000

# col = student, cell = project
assignments <- matrix(NA, nrow=iters, ncol=nrow(students))

for(i in 1:iters) {
      assignments[i,1:7] <- sample(7,7,replace=FALSE)
}

cost <- matrix(NA, nrow=iters, ncol=nrow(students))

for(i in 1:iters) {

     for(j in 1:nrow(students)) {

          student <- j
          project <- assignments[i,student]

          student.cost <- rep(NA,3)

          for(k in 1:3) {     

               student.cost[k] <- abs(students[student,k] - projects[project,k])

          } 

          cost[i,j] <- sum(student.cost)

     }

}


total.costs <- rowSums(cost)

assignment.costs <- cbind(assignments, total.costs)
head(assignment.costs)

assignment.costs[assignment.costs[,8]==min(assignment.costs[,8]),]

#                    total.costs
# [1,] 3 2 1 4 5 6 7          48
# [2,] 3 2 1 6 5 4 7          48
# [3,] 3 2 1 6 5 4 7          48

# student 1, project 3, cost = 3
# student 2, project 2, cost = 6
# student 3, project 1, cost = 7
# student 4, project 4, cost = 3
# student 5, project 5, cost = 15
# student 6, project 6, cost = 9
# student 7, project 7, cost = 5

3+6+7+3+15+9+5

# [1] 48

编辑：2014 年 6 月 6 日

这是详尽的搜索。将项目分配给七名学生的方法只有 5040 种。此搜索返回四个最佳解决方案：

students <- matrix(c(10,   9,   8,
                      1,   2,  10,
                     10,   2,   5,
                      2,   5,   3,
                     10,   2,  10,
                      1,  10,   1,
                      5,   5,   5), nrow=7, ncol=3, byrow=TRUE)

projects <- matrix(c(10,   5,    1,
                      1,   1,    5,
                     10,  10,   10,
                      2,   8,    3,
                      4,   3,    2,
                      1,   1,    1,
                      5,   7,    2), nrow=7, ncol=3, byrow=TRUE)

library(combinat)

n <- nrow(students)

assignments <- permn(1:n)
assignments <- do.call(rbind, assignments)
dim(assignments)

# column of assignments = student
# row of assignments = iteration
# cell of assignments = project

cost <- matrix(NA, nrow=nrow(assignments), ncol=n)

for(i in 1:(nrow(assignments))) {
     for(student in 1:n) {

          project      <- assignments[i,student]
          student.cost <- rep(NA,3)

          for(k in 1:3) {     
               student.cost[k] <- abs(students[student,k] - projects[project,k])
          } 

          cost[i,student] <- sum(student.cost)
     }
}


total.costs <- rowSums(cost)

assignment.costs <- cbind(assignments, total.costs)
head(assignment.costs)

assignment.costs[assignment.costs[,(n+1)]==min(assignment.costs[,(n+1)]),]

                   total.costs
[1,] 3 2 5 4 1 6 7          48
[2,] 3 2 5 6 1 4 7          48
[3,] 3 2 1 6 5 4 7          48
[4,] 3 2 1 4 5 6 7          48

r - R中的匹配算法（二分匹配，匈牙利算法）

1 回答 1

Related

Reference