非线性优化求解R中的最优资源分配

时间:2018-02-23 15:31:02

标签: r mathematical-optimization nonlinear-optimization

我正在努力解决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

请告诉我他们是否可以用来解决这个问题的其他优化功能

0 个答案:

没有答案