I'm fairly new to optimisation and I'm struggling to understand a couple of things about R's ROI package. There are two issues:
(1) I have a solution that seems very sensitive to start values, and I would like to remove this.
(2) Ideally, I'd like to adjust my objective function to not only solve the primary problem, but do so in the most cost-effective way (I currently simple specify a budget, and if the solution is within budget will accept it, even if cheaper solutions are possible).
The code below should run fine, but the sensitivity to starting values is clear from the two solutions s1 (nearly perfect) and s2 (rubbish). The secondary issue I would only like to consider if there is an optimal solution within my budget - ie, I'm not trying to balance costs and benefits if the cost is below the threshold, which I appreciate adds a further non-linearity to the problem and make things things impossible. Any guidance welcome!
Thanks
library(ROI)
library(nloptr)
library(ROI.plugin.nloptr)
### define constants:
B <- 8000 ## total budget available
c1 = -0.15 ## growth rate at zero spend
c2 = 0.001 ## improvement in growth rate per unit spend
dum.dat1 <- data.frame(os = c(10, 100, 1000, 10, 200),
ne = c(10, 10, 200, 200, 200),
me = c(100, 200, 300, 300, 1000))
Nsites <- NROW(dum.dat1) ## number of rows
## define (non-linear) function for optimisation:
eg <- function(ns = runif(Nsites*2, 0, 50)) {
ns.mat <- matrix(ns, ncol = Nsites)
dat.vec <- unlist(dum.dat1)
dat.arr <- array(c(ns, rep(dat.vec, each = NROW(ns.mat))),
dim = c(NROW(ns.mat), NROW(dum.dat1), ncol(dum.dat1)+1))
basic.fun <- function(pars) round(apply(cbind(pars[,4], pars[,3] * exp(c1 + (pars[,2] + pars[,1]) * c2)), 1, min))
result <- -1 * colSums(apply(dat.arr, 1, basic.fun))
return(result)
}
test.fun <- function(ns = rep(2000, 5)) {
ns.mat <- matrix(ns, ncol = Nsites)
dat.vec <- unlist(dum.dat1)
dat.arr <- array(c(ns, rep(dat.vec, each = NROW(ns.mat))),
dim = c(NROW(ns.mat), NROW(dum.dat1), ncol(dum.dat1)+1))
basic.fun <- function(pars) round(apply(cbind(pars[,4], pars[,3] * exp(c1 + (pars[,2] + pars[,1]) * c2)), 1, min))
result <- apply(dat.arr, 1, basic.fun)
return(result)
}
## objective function:
F_ob <- F_objective(eg, Nsites)
## constraints:
cons <- L_constraint(
L = rbind(matrix(rep(1, Nsites), # first constraint, sum of costs at all sites
ncol = Nsites)),
dir = rep("<=", 1), # just one constraint
rhs = c(B))
## define upper boundaries (though probably not needed):
bound <- V_bound( ui = 1:5, ub = rep(B, Nsites), nobj = Nsites)
nlmp <- OP(objective = F_ob, # Not the right objective yet - need to do more complex function?
constraint = cons,
bounds = bound,
maximum = FALSE)
ROI_applicable_solvers(nlmp)
## define starting parameters
start1 <- rep(B / Nsites, Nsites)
start2 <- rep(10, Nsites)
## solve it:
s1 <- ROI_solve(nlmp, solver = "nloptr.cobyla", start = start1)
s2 <- ROI_solve(nlmp, solver = "nloptr.cobyla", start = start2)
# what is optimal solution:
solution(s1) ## almost works, but more costly than necessary
solution(s2) ## no good at alll
## check this makes sense:
test.fun(solution(s1))
test.fun(solution(s2)) ## not good
test.fun(c(2500, 3100, 10, 550, 1700)) ## This is pretty much the real optimal solution
