Menu
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.
366
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
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With
