Как я могу сделать свою оптимизацию с ROI менее чувствительной к начальным значениям? - PullRequest
Новая
       25

Как я могу сделать свою оптимизацию с ROI менее чувствительной к начальным значениям?

0 голосов
/ 20 февраля 2020

Я довольно новичок в оптимизации и изо всех сил пытаюсь понять кое-что о пакете ROI от R. Есть две проблемы: (1) У меня есть решение, которое кажется очень чувствительным к начальным значениям, и я хотел бы удалить это. (2) В идеале я хотел бы изменить целевую функцию, чтобы не только решить основную проблему, но и сделать это наиболее экономически эффективным способом (в настоящее время я просто указываю бюджет, и если решение в рамках бюджета, примет его , даже если возможны более дешевые решения).

Приведенный ниже код должен работать нормально, но чувствительность к начальным значениям очевидна из двух решений s1 (почти идеально) и s2 (рубби sh). Вторичный вопрос, который я хотел бы рассмотреть, только если в моем бюджете есть оптимальное решение - ie, я не пытаюсь сбалансировать затраты и выгоды, если затраты ниже порогового значения, что, я ценю, добавляет дополнительную нелинейность к проблеме и сделать вещи невозможными. Любое руководство приветствуется!

Спасибо 

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
...