我正在尝试编写一些代码,以便根据学生的偏好选择最佳地分配项目。其目的是找到最佳分配,以便最多的学生获得他们排名最高的项目。到目前为止,我的尝试主要基于这里发布的非常有用的示例:https://dirkschumacher.github.io/ompr/articles/problem-course-assignment.html
只要我只想给学生分配项目,并考虑到每个项目的容量有限,这种方法就可以正常工作。
然而,我想把这一点扩展到也考虑到:
1.每个项目都有一名主管
1.主管可以提供一个以上的项目
1.监督员只能监督有限数量的学生
在下面的示例中,主管1可以提供2个项目,每个项目可以分配给最多4个学生。然而,总的来说,监督员不能监督超过4名学生,即。e.导师1指导的2个项目的学生人数之和不能超过4。
下面是我到目前为止得到的R代码,根据他们的喜好将15名学生分配到6个可能的项目。
在该示例中,解决方案为主管2分配了5个学生(1个分配给项目3,4个分配给项目4),超过了他们最多4个学生的能力,因为他们没有限制可以分配给主管的学生数量的约束。
尽管做了大量的搜索和尝试,我似乎还是无法弄清楚如何在模型中加入一个额外的约束,限制在同一个主管监督的所有项目中分配给同一个主管的学生总数。
任何建议将非常感谢。
示例代码:
library(purrr)
library(dplyr)
library(ompr)
library(ompr.roi)
library(ROI.plugin.glpk)
#Create model data
n <- 15 #Students
m <- 6 #Projects
o <- 4 #Supervisors
proj_capacity <- rep.int(4, m) # all have equal capacities
proj_info <- matrix(c(1:6,1,1,2,2,3,4,proj_capacity,4,4,4,4,4,4),6,4, dimnames = list(c(1,2,3,4,5,6), c("Project","Supervisor","Proj.Cap","Super.Cap")))
df_proj_info <- as.data.frame(proj_info)
set.seed(1234)
preference_data <- lapply(seq_len(n), function(x) sample(seq_len(m), 3))
##Functions
#Function that extracts vector for preferences of a single student
preferences <- function(student) preference_data[[student]]
preferences(1)
# Function that assigns each project a weight according to a student's choices
# if the project is not among the preferences, the weight is 10000
funcWeight <- function(student, project) {
p <- which(as.numeric(project) == preferences(as.numeric(student)))
as.integer(if (length(p) == 0) {
10000
} else {
p
})
}
#Build model
model <- MIPModel() %>%
# 1 iff student i is assigned to project j
add_variable(x[i, j], i = 1:n, j = 1:m, type = "binary") %>%
# maximize the preferences
set_objective(sum_over(funcWeight(i, j) * x[i, j], i = 1:n, j = 1:m),"min") %>%
# we cannot exceed the capacity of a project
add_constraint(sum_over(x[i, j], i = 1:n) <= proj_capacity[j], j = 1:m) %>%
# we cannot exceed the supervisor capacity
# add_constraint(students assigned to supervisor <= super_capacity[k], k = 1:o) %>%
# each student needs to be assigned to one project
add_constraint(sum_over(x[i, j], j = 1:m) == 1, i = 1:n)
#Model definition
model
#Solve model
result <- solve_model(model, with_ROI(solver = "glpk", verbose = TRUE))
#Extract Student-Project pairs
df_matching <- result %>%
get_solution(x[i,j]) %>%
filter(value > .9) %>%
select(i, j) %>%
rowwise() %>%
mutate(weight = funcWeight(as.numeric(i), as.numeric(j)),
preferences = paste0(preferences(as.numeric(i)), collapse = ",")) %>% ungroup
##Decode pairs
#And merge with Student-Project pairs info
df_proj_allocation<-merge(df_matching,df_proj_info, by.x=c("j"), by.y=c("Project"),all.x=TRUE)
df_proj_allocation<-df_proj_allocation %>%
rename(
Student=i,
Project=j
)
head(df_proj_allocation)
1条答案
按热度按时间ctzwtxfj1#
经过进一步的阅读和尝试,我提出了一个函数,可以提取由一个主管监督的所有项目的向量:
然后,这被用于过滤模型变量X,对每个管理器的所有分配进行计数,并将其约束为小于管理器的容量。以下是修改后的模型:
可能有更优雅的解决方案,但它正在为我的目的工作。
下面是修改后的完整代码: