Optimizing in R using multiple variables using Rsolnp

Question

I had asked this question earlier, and wanted to continue with a follow-up since I tried some other things and they didn't quite work out.

I am essentially trying to optimize an NLP type problem in R, which has binary and integer constraints. The code for the same is below :

# Input Data
DTM <- sample(1:30,10,replace=T)
DIM <- rep(30,10)
Price <- 100 - seq(0.4,1,length.out=10)

# Variables that shall be changed to find optimal solution
Hike <- c(1,0,0,1,0,0,0,0,0,1)
Position <- c(0,1,-2,1,0,0,0,0,0,0)

# Bounds for Hikes/Positions
HikeLB <- rep(0,10)
HikeUB <- rep(1,10)
PositionLB <- rep(-2,10)
PositionUB <- rep(2,10)

library(Rsolnp)

# x <- c(Hike, Position)
# Combining two arrays into one since I want 
# to optimize using both these variables

opt_func <- function(x) {

  Hike <- head(x,length(x)/2)
  Position <- tail(x,length(x)/2)

  hikes_till_now <- cumsum(Hike) - Hike
  PostHike <- numeric(length(Hike))
  for (i in seq_along(Hike)){
    PostHike[i] <- 99.60 - 0.25*(Hike[i]*(1-DTM[i]/DIM[i]))
    if(i>1) {
      PostHike[i] <- PostHike[i] - 0.25*hikes_till_now[i]
    }
  }
  Pnl <- Position*(PostHike-Price)
  return(-sum(Pnl)) # Since I want to maximize sum(Pnl)

}

#specify the in-equality function for Hike
unequal <- function(x) {
  Hike <- head(x,length(x)/2)
  return(sum(Hike))
}

#specify the equality function for Position
equal <- function(x) {
  Position <- tail(x,length(x)/2)
  return(sum(Position))
}

#the optimiser
solnp(c(Hike,Position), opt_func, 
      eqfun=equal, eqB=0,   
      ineqfun=unequal, ineqUB=3, ineqLB=1, 
      LB=c(HikeLB,PositionLB), UB=c(HikeUB,PositionUB))

I get the following warning/error :

# solnp--> Solution not reliable....Problem Inverting Hessian.

What I understand is that the Hessian is a sparse matrix and therefore there might be issues in inverting? Also, might there be some better way to do this optimization, since it doesn't seem like a complicated problem and I feel I am missing something fairly straightforward here!

The description of the problem is given in this question in good detail.

Any help would be greatly appreciated.

Answer 1

I think the algorithm is stuck in a local minimum. I helped the algorithm with a "pre-minimization" procedure with the R package DEoptim and it seems to work. You can check the output below.

# Input Data
DTM <- sample(1 : 30, 10, replace = TRUE)
DIM <- rep(30, 10)
Price <- 100 - seq(0.4, 1, length.out = 10)

# Variables that shall be changed to find optimal solution
Hike <- c(1,0,0,1,0,0,0,0,0,1)
Position <- c(0,1,-2,1,0,0,0,0,0,0)

# Bounds for Hikes/Positions
HikeLB <- rep(0,10)
HikeUB <- rep(1,10)
PositionLB <- rep(-2,10)
PositionUB <- rep(2,10)

# specify the in-equality function for Hike
unequal <- function(x)
{
  Hike <- head(x,length(x) / 2)
  return(sum(Hike))
}

# specify the equality function for Position
equal <- function(x) 
{
  Position <- tail(x,length(x) / 2)
  return(sum(Position))
}

opt_func <- function(x, const = 10 ^ 30, const_Include = 0) 
{
  val_Eq <- equal(x) 
  val_Uneq <- unequal(x)
  
  if(val_Uneq > 3)
  {
    return(const)
    
  }else if(val_Uneq < 1)
  {
    return(const)
    
  }else
  {
    Hike <- head(x,length(x) / 2)
    Position <- tail(x,length(x) / 2) 
    hikes_till_now <- cumsum(Hike) - Hike
    PostHike <- numeric(length(Hike))
    
    for(i in seq_along(Hike))
    {
      PostHike[i] <- 99.60 - 0.25 * (Hike[i] * (1 - DTM[i] / DIM[i]))
      
      if(i > 1)
      {
        PostHike[i] <- PostHike[i] - 0.25 * hikes_till_now[i]
      }
    }
    
    Pnl <- Position * (PostHike - Price)
    return((-sum(Pnl) + const_Include * 10 ^ 5 * val_Eq ^ 2))
  }
}

library(DEoptim)
obj_DEoptIter <- DEoptim(fn = opt_func, lower = c(HikeLB, PositionLB), 
                         upper = c(HikeUB, PositionUB),
                         list(itermax = 4000), const_Include = 1)

equal(obj_DEoptIter$optim$bestmem) 
opt_func(obj_DEoptIter$optim$bestmem, const_Include = 0) 

vector_Eta <- c(0.5, 0.25, 0.15, 0.1, 0.05, 0.05)
nb_Eta <- length(vector_Eta)
list_Obj_DEoptim <- list()
list_Obj_DEoptim[[1]] <- obj_DEoptIter

for(i in 1 : nb_Eta)
{
  eta <- vector_Eta[i]
  obj_DEoptIter1 <- list_Obj_DEoptim[[i]]
  lower <- ifelse(obj_DEoptIter1$optim$bestmem < 0, (1 + eta) * obj_DEoptIter1$optim$bestmem, (1 - eta) * obj_DEoptIter1$optim$bestmem)
  lower <- pmax(lower, c(HikeLB, PositionLB))
  upper <- ifelse(obj_DEoptIter1$optim$bestmem < 0, (1 - eta) * obj_DEoptIter1$optim$bestmem, (1 + eta) * obj_DEoptIter1$optim$bestmem)
  upper <- pmin(upper, c(HikeUB, PositionUB))
  list_Obj_DEoptim[[i + 1]] <- DEoptim(fn = opt_func, lower = lower, upper = upper, list(itermax = 2000), const_Include = 1)
}

library(Rsolnp)
pars <- list_Obj_DEoptim[[nb_Eta + 1]]$optim$bestmem
pars 
         par1          par2          par3          par4          par5          par6          par7          par8          par9         par10         par11 
 1.378436e-05  2.024484e-05  1.770700e-06  2.826411e-06  4.351425e-05  9.483165e-05  6.086782e-04  2.978773e-04  3.993085e-04  9.990947e-01 -1.987184e+00 
        par12         par13         par14         par15         par16         par17         par18         par19         par20 
-1.338216e+00 -1.996457e+00 -8.111605e-01  8.450319e-01  9.434997e-01  1.262152e+00 -8.391519e-01  1.977017e+00  1.944523e+00 

solnp(pars, opt_func, eqfun = equal, eqB = 0,   
      ineqfun = unequal, ineqUB = 3, ineqLB = 1, 
      LB = c(HikeLB, PositionLB), UB = c(HikeUB,PositionUB))

Iter: 1 fn: -3.3333  Pars:   0.0000002057324  0.0000000422716  0.0000000203609  0.0000000069049  0.0000000042465  0.0000000005265  0.0000000053055  0.0000000110825  0.0000000281918  0.9999998374786 -1.9999999156676 -1.9999999139568 -1.9999998417164 -1.9999997579607 -1.9999976211239  1.9999981198069  1.9999995045018  1.9999997029469  1.9999998414763  1.9999998815401
Iter: 2 fn: -3.3333  Pars:   0.0000002031041  0.0000000416019  0.0000000198673  0.0000000066085  0.0000000039753  0.0000000003308  0.0000000050202  0.0000000107497  0.0000000277094  0.9999998403129 -1.9999999168693 -1.9999999149208 -1.9999998437310 -1.9999997605837 -1.9999976915876  1.9999981741728  1.9999995155922  1.9999997097596  1.9999998444069  1.9999998837611
solnp--> Completed in 2 iterations
$pars
         par1          par2          par3          par4          par5          par6          par7          par8          par9         par10         par11 
 2.031041e-07  4.160187e-08  1.986733e-08  6.608512e-09  3.975269e-09  3.307675e-10  5.020223e-09  1.074966e-08  2.770940e-08  9.999998e-01 -2.000000e+00 
        par12         par13         par14         par15         par16         par17         par18         par19         par20 
-2.000000e+00 -2.000000e+00 -2.000000e+00 -1.999998e+00  1.999998e+00  2.000000e+00  2.000000e+00  2.000000e+00  2.000000e+00 

$convergence
[1] 0

$values
[1] -2.355177 -3.333333 -3.333333

$lagrange
           [,1]
[1,] -0.2965841
[2,]  0.2187991

$hessian
               [,1]         [,2]         [,3]         [,4]         [,5]        [,6]         [,7]        [,8]        [,9]        [,10]         [,11]
 [1,]  9.999798e-01   0.02742111   0.03375175   0.03362079   0.01640916 -0.10340640   -3.6590783  -3.9063315  -3.2571705  0.007948037  2.162646e-05
 [2,]  2.742111e-02  66.88899630  61.41701189  -1.06357113 -65.20163998 -5.08593318  -15.3210883  24.7495950  95.4918041 -2.592847895 -2.660031e-02
 [3,]  3.375175e-02  61.41701189  65.27279520   1.65679327 -64.08506082 -6.26030243  -61.7149713 -33.0447996  34.1906702 -2.048842423 -3.406531e-02
 [4,]  3.362079e-02  -1.06357113   1.65679327   2.75444192   1.01778735 -1.88727085  -40.6383890 -21.7241256 -23.0845472  0.273012820 -3.390742e-02
 [5,]  1.640916e-02 -65.20163998 -64.08506082   1.01778735  69.06953922  3.45702004   -0.3026398   1.5544219 -70.1962042  2.543536245 -1.651286e-02
 [6,] -1.034064e-01  -5.08593318  -6.26030243  -1.88727085   3.45702004  4.31393562   52.9263744   8.0690045   4.1293583 -0.052762820  1.038279e-01
 [7,] -3.659078e+00 -15.32108825 -61.71497133 -40.63838903  -0.30263981 52.92637439 1036.8692392 424.2554909 416.5996364 -5.304528929  3.673517e+00
 [8,] -3.906331e+00  24.74959499 -33.04479955 -21.72412557   1.55442188  8.06900454  424.2554909 611.1234552 605.6589299 -4.994038897  3.923389e+00
 [9,] -3.257170e+00  95.49180407  34.19067019 -23.08454723 -70.19620420  4.12935827  416.5996364 605.6589299 681.7605089 -7.626377583  3.273432e+00
[10,]  7.948037e-03  -2.59284790  -2.04884242   0.27301282   2.54353625 -0.05276282   -5.3045289  -4.9940389  -7.6263776  1.136211890 -8.005497e-03
[11,]  2.162646e-05  -0.02660031  -0.03406531  -0.03390742  -0.01651286  0.10382789    3.6735172   3.9233885   3.2734322 -0.008005497  9.999767e-01
[12,]  2.560506e-04  -1.28441997  -1.03624297   0.12124532   1.25787404 -0.01537463   -3.1259275  -3.7153566  -4.7747487  0.067321907 -3.004553e-04
[13,]  5.123418e-04  -1.43173666  -0.93034646   0.22381646   1.30268827 -0.06388374   -4.8019860  -5.5804183  -6.7831527  0.087150919 -6.003854e-04
[14,]  5.554612e-04   0.98471992   1.35764165   0.19241155  -1.11681403 -0.25008321   -6.2599910  -6.4421787  -4.7866436 -0.004199357 -6.259218e-04
[15,]  4.473410e-04  -0.11869196   0.19819250   0.19407189   0.08815337 -0.17579817   -6.5077248  -7.1035569  -6.4692030  0.040393548 -5.242930e-04
[16,] -2.085873e-04  -1.96550988  -0.68338138   0.45350085   1.39119548 -0.11589229   -6.9686856  -8.8689925 -10.9267740  0.133277513  2.221037e-04
[17,] -2.873929e-04  -0.65632927   0.37181355   0.35099772   0.14218820 -0.14396492   -5.5117954  -6.9879800  -7.6638548  0.070739356  3.402369e-04
[18,]  2.361230e-03   1.85793311   0.66958680  -0.46036814  -1.38871483  0.11073021    8.3464247  11.2659358  12.7138766 -0.143080948 -2.682272e-03
[19,] -4.073214e-04   1.74650856   2.64058481   0.30085238  -2.28580164 -0.29320084   -5.5232047  -6.2299486  -4.3128641 -0.025281367  4.807052e-04
[20,]  6.691791e-04   0.97282574   1.27569962   0.11147845  -1.15542498 -0.06862054    0.1078153   0.3291076   0.9647769 -0.022334033 -7.534958e-04
[21,]  6.199951e-04   0.95352282   1.29179584   0.12737426  -1.14776727 -0.09857535   -0.8077458  -0.5834213   0.1413152 -0.019358184 -6.974727e-04
              [,12]         [,13]         [,14]        [,15]         [,16]         [,17]        [,18]         [,19]         [,20]         [,21]
 [1,]  0.0002560506  0.0005123418  0.0005554612  0.000447341 -2.085873e-04 -0.0002873929  0.002361230 -0.0004073214  0.0006691791  0.0006199951
 [2,] -1.2844199676 -1.4317366600  0.9847199178 -0.118691962 -1.965510e+00 -0.6563292684  1.857933110  1.7465085621  0.9728257362  0.9535228153
 [3,] -1.0362429738 -0.9303464586  1.3576416527  0.198192496 -6.833814e-01  0.3718135470  0.669586799  2.6405848119  1.2756996162  1.2917958363
 [4,]  0.1212453150  0.2238164645  0.1924115460  0.194071891  4.535009e-01  0.3509977184 -0.460368143  0.3008523758  0.1114784546  0.1273742585
 [5,]  1.2578740408  1.3026882661 -1.1168140329  0.088153370  1.391195e+00  0.1421882038 -1.388714829 -2.2858016360 -1.1554249791 -1.1477672657
 [6,] -0.0153746283 -0.0638837380 -0.2500832107 -0.175798170 -1.158923e-01 -0.1439649211  0.110730209 -0.2932008389 -0.0686205407 -0.0985753501
 [7,] -3.1259275281 -4.8019860058 -6.2599909562 -6.507724752 -6.968686e+00 -5.5117954046  8.346424660 -5.5232046808  0.1078153176 -0.8077458454
 [8,] -3.7153565741 -5.5804183495 -6.4421786729 -7.103556916 -8.868992e+00 -6.9879799717 11.265935833 -6.2299486257  0.3291076177 -0.5834213196
 [9,] -4.7747486553 -6.7831526938 -4.7866436050 -6.469203037 -1.092677e+01 -7.6638548254 12.713876638 -4.3128641023  0.9647769448  0.1413152244
[10,]  0.0673219073  0.0871509195 -0.0041993566  0.040393548  1.332775e-01  0.0707393560 -0.143080948 -0.0252813670 -0.0223340333 -0.0193581838
[11,] -0.0003004553 -0.0006003854 -0.0006259218 -0.000524293  2.221037e-04  0.0003402369 -0.002682272  0.0004807052 -0.0007534958 -0.0006974727
[12,]  1.0298639515  0.0384261248 -0.0088672552  0.010364778  6.830500e-02  0.0382383110 -0.069344565 -0.0092977594 -0.0116491404 -0.0102362279
[13,]  0.0384261248  1.0557371024  0.0039723626  0.021060697  1.151472e-01  0.0762447552 -0.116140750  0.0240732365 -0.0015522014  0.0012502622
[14,] -0.0088672552  0.0039723626  1.0405811350  0.015598750  5.107293e-02  0.0597045666 -0.056121550  0.0958555701  0.0358818177  0.0381463360
[15,]  0.0103647784  0.0210606967  0.0155987497  1.011768391  7.077174e-02  0.0599946674 -0.087157476  0.0541735129  0.0107826788  0.0132195770
[16,]  0.0683050028  0.1151472294  0.0510729318  0.070771744  4.640564e-01  0.3981262980  0.045718792  0.3317973279  0.0521686203  0.0517223181
[17,]  0.0382383110  0.0762447552  0.0597045666  0.059994667  3.981263e-01  0.3625712839  0.107458944  0.3438763827  0.0629936354  0.0613058394
[18,] -0.0693445652 -0.1161407495 -0.0561215497 -0.087157476  4.571879e-02  0.1074589438  0.557297695  0.1719157196 -0.0771914128 -0.0669185711
[19,] -0.0092977594  0.0240732365  0.0958555701  0.054173513  3.317973e-01  0.3438763827  0.171915720  0.4136119154  0.1004220146  0.0980924411
[20,] -0.0116491404 -0.0015522014  0.0358818177  0.010782679  5.216862e-02  0.0629936354 -0.077191413  0.1004220146  1.0302634816  0.0329624994
[21,] -0.0102362279  0.0012502622  0.0381463360  0.013219577  5.172232e-02  0.0613058394 -0.066918571  0.0980924411  0.0329624994  1.0354545441

$ineqx0
[1] 1

$nfuneval
[1] 1048

$outer.iter
[1] 2

$elapsed
Time difference of 0.1874812 secs

$vscale
 [1] 3.33333273 0.00000001 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000
[14] 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000 1.00000000