我将Excel中的问题翻译成了R.我希望以“Gesamt”(由函数返回)最大化的形式分配固定预算。
NrwGes <- function(Budget, Speed, maxnrw, cpcrp) {
BudgetA <- Budget[1]
BudgetB <- Budget[2]
BudgetC <- Budget[3]
BudgetD <- Budget[4]
BudgetE <- Budget[5]
MaxNRW <- c(90, 40, 40, 25, 15)
Speed <- c(0.9, 0.9, 0.9, 0.9, 0.9)
cpcrp <- c(6564, 4494, 3962, 4525, 4900)
TV <- BudgetA*1000/cpcrp[1]
Catchup <- BudgetB*1000/cpcrp[2]
YT <- BudgetC*1000/cpcrp[3]
FB <- BudgetD*1000/cpcrp[4]
Display <- BudgetE*1000/cpcrp[5]
a <- TV^Speed[1]/(1+abs((TV)^Speed[1]-1)/(MaxNRW[1]*0.98))
b <- Catchup^Speed[2]/(1+abs((Catchup)^Speed[2]-1)/(MaxNRW[2]*0.98))
c <- YT^Speed[3]/(1+abs((YT)^Speed[3] -1)/(MaxNRW[3]*0.98))
d <- FB^Speed[4]/(1+abs((FB)^Speed[4]-1)/(MaxNRW[4]*0.98))
e <- Display^Speed[5]/(1+abs((Display)^Speed[5]-1)/(MaxNRW[5]*0.93))
Gesamt <- a+(100-a)/100*b+((100-a)/100*(100-b)/100*c)+((100-a)/100*(100-b)/100*(100-c)/100*d)+((100-a)/100*(100-b)/100*(100-c)/100*(100-d)/100*e)
return(Gesamt)
}
我有一个总预算(即5000),可以不同地分配以最大化“Gesamt”。例子:
NrwGes(c(5000, 0, 0, 0, 0)) # 72.16038
NrwGes(c(2000, 1500, 1000, 500, 0)) # 84.23121
Brute Forcing或网格搜索不是一个选项,因为这将完成15-20次,算法将应用于R-Shiny应用程序。
答案 0 :(得分:3)
使用L-BFGS-U方法(允许边界)和0的下限尝试optim
。然后将输入组件投影到一个向量的总和为5000的向量上传递给NrwGes
。 fscale = -1
说要最大化而不是最小化。最终分配将为proj(res$par)
,如底部所示。没有包使用。
proj <- function(x) 5000 * x / sum(x)
st <- proj(rep(1, 5))
f <- function(x) NrwGes(proj(x))
res <- optim(st, f, lower = 0 * st, method = "L-BFGS-B", control = list(fnscale = -1))
,并提供:
> res
$`par`
[1] 2107.8438 482.5702 468.9409 268.0808 142.4305
$value
[1] 86.64285
$counts
function gradient
14 14
$convergence
[1] 0
$message
[1] "CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH"
> proj(res$par) # final allocation
[1] 3037.3561 695.3729 675.7334 386.2984 205.2391
答案 1 :(得分:0)
选项是nloptr
包:
library(nloptr)
# we use NLOPT_LN_COBYLA algorithm because it doesn't need gradient functions
opts <- list(algorithm="NLOPT_LN_COBYLA",
xtol_rel=1.0e-8,
maxeval=10000)
# objective function (negative because nloptr always minimize)
objFun <- function(x){ -NrwGes(x) }
# sum of budget <= 5000 (in the form g(x) <= 0)
g <- function(x){ sum(x) - 5000 }
res <- nloptr(x0=rep.int(0,5), # initial solution (all zeros)
eval_f=objFun,
lb=rep.int(0,5), # lowerbounds = 0
ub=rep.int(5000,5), # upperbounds = 5000
eval_g_ineq=g,
opts=opts)
结果:
> res
Call:
nloptr(x0 = rep.int(0, 5), eval_f = objFun, lb = rep.int(0, 5),
ub = rep.int(5000, 5), eval_g_ineq = g, opts = opts)
Minimization using NLopt version 2.4.2
NLopt solver status: 4 ( NLOPT_XTOL_REACHED: Optimization stopped because xtol_rel
or xtol_abs (above) was reached. )
Number of Iterations....: 261
Termination conditions: xtol_rel: 1e-08 maxeval: 10000
Number of inequality constraints: 1
Number of equality constraints: 0
Optimal value of objective function: -86.6428477187536
Optimal value of controls: 3037.382 695.3725 675.7232 386.2929 205.2291
N.B。您可以使用res$solution
,res$objective
等