我正在努力解决R中的人员问题。这是我的问题
鉴于步行中心在白天15小时内(上午7:00至晚上9:00)每小时给定的需求分配。找到满足需求所需的最佳人员配备数量。每个工作人员每小时的能力定义受制约因素
a)每个人到达的等待时间不能超过thresh hold(分钟)
b)在特定日期抵达的总人数应在同一天内送达以下是代码
#Create data inputs
# Input - Demand across 15 time zones
D = c(7,8,11,9,10,10,10,9,10,10,10,10,7,3,2)
Cp = 4 # Input - Capacity per hours per staff, Set to 4
# Input - Max Waiting time limit per person arriving set to 240 mins
WT_limit = rep(240,15)
# wait function
Wait_time1 <- function(Staff) {
Demand = D # demand input
Cap_per_staff = Cp # capacity per staff input
Capacity = Staff * Cap_per_staff
WT_lim = WT_limit # wait time limit input
Staff = as.matrix(Staff) #convert the decision variable to a matrix
temp = 0
######---------------------------------------------------------------------- # The following routine creates cumulative number of people wating each hour
# based on the capacity and demand.the routine loops through the 15
#operational hours during the day and
#calculates the effective number of people that would be waiting at the
# each hours
###### ---------------------------------------------------------------------
for (i in 1:15) {
if (Demand[i] - Capacity[i] <= 0) {
temp[i] = 0
}
else{
temp[i] = Demand[i] - Capacity[i]
}
}
Cum_wait = 0
for (j in 1:15) {
if (j == 1) {
Cum_wait[j] = temp[j]
}
else{
Cum_wait[j] = temp[j] + Cum_wait[j - 1]
}
}
#######This routine builds upon the cumulative waiting people routine
#and updates the hour in #which the people waiting would be served
##### -----------------------------------------------------------------
Wait_matrix = matrix(rep(0, 15 * 15), 15, 15)
for (i in 1:15) {
for (j in 1:15) {
if (j == i) {
Wait_matrix[i, j] = Cum_wait[i]
}
}
}
for (i in 1:15) {
for (j in 1:15) {
if (i >= j & i <= 14) {
if ((Wait_matrix[i, j] - Capacity[i]) > 0) {
Wait_matrix[i + 1, j] = Wait_matrix[i, j] - Capacity[i]
}
}
}
}
# the number of people that would be left for the last hour to be served
u = Wait_matrix[15, 1:15]
# maximum wait time for the person arriving in each hour
k = apply(Wait_matrix, 2, function(x)length(which(x != 0)))[1:15]
h = data.frame(rbind(as.double(k), as.double(u)), mode = "numeric")
return(h)
}
######objective function ---------------------------------------------------
eval_f0 <- function(x) {return(sum(x)}
######constraints function
eval_g0 <- function(x) {
o <- Wait_time1(Staff = x)
o1 <- matrix(as.double(o[1, ]))
o2 <- matrix(as.double(o[2, ]))
return( rbind(
# the waiting time for each hour shd be less that the limit
as.double(o1[1] * 60 - WT_limit[1]),
as.double(o1[2] * 60 - WT_limit[2]),
as.double(o1[3] * 60 - WT_limit[3]),
as.double(o1[4] * 60 - WT_limit[4]),
as.double(o1[5] * 60 - WT_limit[5]),
as.double(o1[6] * 60 - WT_limit[6]),
as.double(o1[7] * 60 - WT_limit[7]),
as.double(o1[8] * 60 - WT_limit[8]),
as.double(o1[9] * 60 - WT_limit[9]),
as.double(o1[10] * 60 - WT_limit[10]),
as.double(o1[11] * 60 - WT_limit[11]),
as.double(o1[12] * 60 - WT_limit[12]),
as.double(o1[13] * 60 - WT_limit[13]),
as.double(o1[14] * 60 - WT_limit[14]),
as.double(o1[15] * 60 - WT_limit[15]),
# solution for the first hour can not be greater that demand divided
#by capacity per staff
as.double(D[1] / Cp - x[1]),
# the solution should be an integer
as.double(ceiling(x[1]) - x[1]),
as.double(ceiling(x[2]) - x[2]),
as.double(ceiling(x[3]) - x[3]),
as.double(ceiling(x[4]) - x[4]),
as.double(ceiling(x[5]) - x[5]),
as.double(ceiling(x[6]) - x[6]),
as.double(ceiling(x[7]) - x[7]),
as.double(ceiling(x[8]) - x[8]),
as.double(ceiling(x[9]) - x[9]),
as.double(ceiling(x[10]) - x[10]),
as.double(ceiling(x[11]) - x[11]),
as.double(ceiling(x[12]) - x[12]),
as.double(ceiling(x[13]) - x[13]),
as.double(ceiling(x[14]) - x[14]),
as.double(ceiling(x[15]) - x[15]),
# the solution should be grater that zero
as.double(abs(x[1]) - x[1]),
as.double(abs(x[2]) - x[2]),
as.double(abs(x[3]) - x[3]),
as.double(abs(x[4]) - x[4]),
as.double(abs(x[5]) - x[5]),
as.double(abs(x[6]) - x[6]),
as.double(abs(x[7]) - x[7]),
as.double(abs(x[8]) - x[8]),
as.double(abs(x[9]) - x[9]),
as.double(abs(x[10]) - x[10]),
as.double(abs(x[11]) - x[11]),
as.double(abs(x[12]) - x[12]),
as.double(abs(x[13]) - x[13]),
as.double(abs(x[14]) - x[14]),
as.double(abs(x[15]) - x[15]),
# all people arriving on a specific day should all be served
as.double(o2[15] - D[15])
)
)
}
library(nloptr)
# initial value
P = rep(1, 15)
opts = list("algorithm" = "NLOPT_LN_COBYLA",
"xtol_rel" = 1.0e-8,
"maxeval" = 100000)
d1 <- nloptr( x0 = P,
eval_f = eval_f0,
eval_g_ineq = eval_g0,
opts = opts
)
d1$status
d1$message
d1$solution
优化不起作用。以下是我收到的错误消息
d1$status
[1] 4
> d1$message
[1] "NLOPT_XTOL_REACHED: Optimization stopped because xtol_rel or
xtol_abs (above) was reached."
> d1$solution
[1] 2.0061801 0.9878393 0.9940459 1.0010934 1.0058667
1.0070941 1.0031389 1.0028036 0.9943415
[10] 0.9921110
0.9984837 1.0076072 0.9967626 1.0026320 -50.5060964
> D
[1] 7 8 11 9 10 10 10 9 10 10 10 10 7 3 2
请告诉我他们是否可以用来解决这个问题的其他优化功能