R: How to add additional constraints to DEoptim - r

I am trying to minimize an objective function using DEoptim, subject to a simple constraint. I am not clear as to how to add the simple constraint to the call to DEoptim. Here is the objective function:
obj_min <- function(n,in_data) {
gamma <- in_data$Gamma
delta <- in_data$Delta
theta <- in_data$Theta
gammaSum <- sum(n * gamma)
deltaSum <- sum(n * delta)
thetaSum <- sum(n * theta)
abs((EPC * gammaSum - 2 * abs(deltaSum)) / thetaSum )
}
My mapping function (to impose integer constraints) is as follows:
mappingFun <- function(x) {
x[1:length(x)] <- round(x[1:length(x)], 0)
}
My call to DEoptim is:
out <- DEoptim(DTRRR_min, lower = c(rep(-5, length(in_data[, 1]))),
upper = c(rep(5, length(in_data[, 1]))),
fnMap = mappingFun, DEoptim.control(trace = F),in_data)
My in_data object (data frame) is:
Underlying.Price Delta Gamma Theta Vega Rho Implied.Volatility
1 40.69 0.9237 3.2188 -0.7111 2.0493 0.0033 0.3119
2 40.69 0.7713 6.2267 -1.6352 4.3240 0.0032 0.3402
3 40.69 0.5822 8.4631 -2.0019 5.5782 0.0338 0.3229
4 40.69 0.3642 8.5186 -1.8403 5.3661 0.0210 0.3086
5 40.69 0.1802 6.1968 -1.2366 3.7517 0.0093 0.2966
I would like to add a simple constraint that:
sum(n * delta) = target
In other words, the summation of the optimized parameters, n, multiplied by the deltas in my in_data data frame sum to a target of some sort. For simplicity, lets just say 0.5. How do I impose
sum(n * delta) = 0.5
as a constraint? Thank you for your help!

OK, thank you for all of your suggestions. I have researched and worked through my problem from many angles, and I wanted to share my thoughts with everyone, in case they can be helpful to some of you.
Most obvious, in my particular objective function, deltaSum is a variable, and I am attempting to constrain it to a particular value. Simple substitution of this constrained value into the objective function is the solution to this (trivial). However, assuming I was to introduce a constraint on a variable which is not already a variable in the objective function, I can simply run a for loop which returns Inf for any constraint I wish to impose, ie:
obj_func_sum_RRRs <- function(n, in_data) {
#Declare deltaSum, gammaSum, thetaSum, vegaSum, and rhoSum from in_data
#Impose constraints
#No dividing by 0:
if (thetaSum == 0) {
return(Inf)
}
#Specify that regardless of the length of vector of variables to
#be optimized, we only want our final results to include either 4 or 6
#nonzero n's in our final optimized solution
if (!sum(n[1:length(n)] != 0) == 4 &
!sum(n[1:length(n)] != 0) == 6) {
return(Inf)
}
(deltaSum + gammaSum)/thetaSum
}
The first for loop, (thetaSum == 0, return Inf) works because while Inf is a solution which the optimizer understands (and will never select as optimal), division by 0 in R returns NaN, which "breaks" the optimization process. This is a bit "hacky", in that it is likely NOT the most computationally efficient way to approach the problem, but to be honest, with the infrastructure that I am developing with a close friend and software architect guru (which utilizes microservices deployed through the Microsoft Service Fabric), our long-range backtesting is still lightening quick. This methodology actually allows you to impose any number of constraints on your problem, although further testing would need to be done to see how burdensome the computational complexity could become using this technique...
The Lagrange technique above can be viable, but only if you derive an analytical form of lambda on paper, then implement in code. It is not always practical in application, and while you may be able to code up an algorithm to optimize the parameter, it sounds like a bad idea to paint yourself into a corner where you have to optimize a parameter which is, in turn, necessary to the optimizing of the original objective function. Just setting a for loop as advised above seems the better way to go.
Food for thought....

DEOptim package description says
Implements the differential evolution algorithm for global
optimization of a realvalued function of a real-valued parameter
vector.
The concept of global optimization doesn't have place for constraints and it is also known as unconstrained optimization. So sorry but its not possible directly. Having said that you can always use "Lagrange's multiplier" hack if you must do it. To do it you need to do something like:
abs((EPC * gammaSum - 2 * abs(deltaSum))/thetaSum) - lambda* (sum(n * delta) - 0.5)
where you penalizing slack of your constraint.

I am using a wrapper which customises the call of DEoptim based on external constraints. Not very elegant I admit it but it works to some extent.
My objective function - a Monte Carlo simulation - is quite time consuming
so constraints are really helpful...
Chris
Due to the very specific character of what I am doing (Monte Carlo raytracing for the optimisation of neutron beam optics) I did not see any reason to add code. I think it is really the concept what matters here. I'll gladly share what I have with anybody interested. Just let me know.... Chris

Related

chen's chaotic system solution using differential transform method

I am calculating the solution of Chen's chaotic system using differential transform method. The code that I am using is:
x=zeros(1,7);
x(1)=-0.1;
y=zeros(1,7);
y(1)=0.5;
z=zeros(1,7);
z(1)=-0.6;
for k=0:5
x(k+2)=(40*gamma(1+k)/gamma(2+k))*(y(k+1)-x(k+1));
sum=0;
for l=0:k
sum=sum+x(l+1)*z(k+1-l);
end
y(k+2)=(gamma(1+k)/gamma(2+k))*(-12*x(k+1)-sum+28*y(k+1));
sum=0;
for l=0:k
sum=sum+x(l+1)*y(k+1-l);
end
z(k+2)=(gamma(1+k)/(1+k))*(sum-3*z(k+1));
end
s=fliplr(x);
t=0:0.05:2;
a=polyval(s,t);
plot(t,a)
What this code does is calculate x(k), y(k) and z(k) these are the coefficients of the polynomial that is approximating the solution.
The solution x(t) = sum_0^infinity x(k)t^k, and similarly the others. But this code doesn't give the desired output of a chaotic sequence the graph of x(t) that I am getting is:
This is not an answer, but a clearer and more correct (programmatically speaking) to write your loop:
for k = 1:6
x(k+1)=(40*1/k)*(y(k)-x(k));
temp_sum = sum(x(1:k).*z(k:-1:1),2);
y(k+1) = (1/k)*(-12*x(k)-temp_sum+28*y(k));
temp_sum = sum(x(1:k).*y(k:-1:1),2);
z(k+1) = (1/k)*(temp_sum-3*z(k));
end
The most important issue here is not overloading the built-in function sum (I replaced it with temp_sum. Other things include vectorization of the inner loops (using sum...), indexing that starts in 1 (instead of writing k+1 all the time), and removing unnecessary calls to gamma (gamma(k)/gamma(k+1) = 1/k).

Reparametrize to remove constraints for optimization (R)

I am teaching myself how to run some Markov models in R, by working through the textbook "Hidden Markov Models for Time Series: An Introduction using R". I am a bit stuck on how to go about implementing something that is mentioned in the text.
So, I have the following function:
f <- function(samples,lambda,delta) -sum(log(outer(samples,lambda,dpois)%*%delta))
Which I can optimize with respect to, say, lambda using:
optim(par, fn=f, samples=x, delta=d)
where "par" is the initial guess for lambda, for some x and d.
Which works perfectly fine. However, in the part of the text corresponding to the example I am trying to reproduce, they note: "The parameters delta and lambda are constrained by sum(delta_i)=1 for i=1,...m, delta_i>0, and lambda_i>0. It is therefore necessary to reparametrize if one wishes to use an unconstrained optimizer such as nlm". One possibility is to maximize the likelihood with respect to the 2m-1 unconstrained parameters".
The unconstrained parameters are given by
eta<-log(lambda)
tau<-log(delta/(1-sum(delta))
I don't entirely understand how to go about implementing this. How would I write a function to optimize over this transformed parameter space?
When using optim() without parmater transfromations like so:
simpleFun <- function(x)
(x-3)^2
out = optim(par=5,
fn=simpleFun)
the set of parmaters estimates would be obtained via out$par which is 3 in
the case, as you might expect. Alternatively, you can wrap your function
f in a transformation the parameters like so:
out = optim(par=5,
fn=function(x)
# apply the transformation x -> x^3
simpleFun(x^3))
and now the trick to get the correct set of optimal parmeters to your
function you need to apply the same transfromation to the parameter
estimates as in:
(out$par)^3
#> 2.99741
(and yes, the parameter estimate is slightly different. For this contrived
example, you could set method="BFGS" for a slightly better estimate. Anyhow, this goes to show that the choice of transformation does matter in
some cases, but that's for another discussion...)
To complete the answer, It sounds like you a want to use a wrapper like so
# the function to be optimized
f <- function(samples,lambda,delta)
-sum(log(outer(samples,lambda,dpois)%*%delta))
out <- optim(# par it now a 2m vector
par = c(eta1 = 1,
eta2 = 1,
eta3 = 1,
tau1 = 1,
tau2 = 1,
tau3 = 1),
# a wrapper that applies the constraints
fn=function(x,samples){
# exp() guarantees that the values of lambda are > 0
lambda = exp(x[1:3])
# delta is also > 0
delta = exp(x[4:6])
# and now it sums to 1
delta = delta / sum(delta)
f(samples,lambda,delta)
},
samples=samples)
The above guarantees that the the parameters passed to f()have the correct constraints, and as long as you apply the same transformation to out$par, optim() will estimate an optimal set of parameters for f().

Harmonic series sum function in R

I am trying to write a function which takes a positive real number and keeps adding terms of the harmonic series until the total sum exceeds the initial argument.
I need my function to display the total number of terms of the series that were added.
Here's my code so far:
harmonic<-function(n){
x<-c(0,1)
while (length(x) < n) {
position <- length(x)
new <- 1/(x[position] + x[position-1])
x <- c(x,new)
}
return(x)
}
I apologise for the errors in my code, unfortunately I have been working with R only for a month and this is the first time that I am using the while loop and I couldn't find any useful information around.
Thank you, I'd really appreciate your help.
Here's an attempt based on some info from this post at maths.stackexchange: https://math.stackexchange.com/q/496116
I can't speak as to whether it is highly accurate in all circumstances or even the best or an appropriate way to go about this. Caveat emptor.
harmsum.cnt <- function(x,tol=1e-09) {
em.cons <- 0.577215664901533
difffun <- function(x,n) x - (log(n) + em.cons + 1/(2*n) - 1/(12*n^2))
ceiling(uniroot(difffun, c(1, 1e10), tol = tol, x = x)$root)
}
Seems to work alright though:
harmsum.cnt(7)
#[1] 616
harmsum.cnt(15)
#[1] 1835421
Compare:
tail(cumsum(1/1:616),1); tail(cumsum(1/1:615),1)
#7.001274
#6.999651
dput(tail(cumsum(1/1:1835421),1)); dput(tail(cumsum(1/1:1835420),1))
#15.0000003782678
#14.9999998334336
This is a partial answer, which I'll try to fill in later. On the assumption that you want an exact answer, rather than the excellent approximation formula thelatemail found, there are a few tools to consider.
First, use of a hash-table or memoise methods will allow you to save previous calculations, thus saving a lot of time.
Second, since the sum of a (finite) sequence is independent of the grouping, you can calculate, e.g. the first N terms and the second (N+1):2N terms independently. Use parallel package to divide and conquer.
Third, before you get too deep into the morass, check the limits of floating-point accuracy via a call to .Machine$double.eps Once your 1/n term comes close to that, you'll need to switch over to gmp and Rmpfr to get full accuracy in your calculations.
Now, just to clarify what you "should" be doing, a correct loop is
mylimit <- [pick a value]
harmsum<-0
for(k in 1:N){
harmsum <- harmsum + 1/k
if (harmsum >= mylimit) break
}
(or similar setup using while)

Translating code that carries out SOCP/SDP optimisation from MATLAB to R

I have the following MATLAB code which was used in the linked paper (http://www.optimization-online.org/DB_FILE/2014/05/4366.pdf), and would like to be able to use the Rsocp package to be able to carry out the same function but in R. The Rsocp package is available by using the command:
install.packages("Rsocp", repos="http://R-Forge.R-project.org")
and through the socp() function it carries out a similar function to solvesdp(constraints, -wcvar, ops) in the MATLAB code below.
I do not have MATLAB which makes this problem more difficult for me to solve.
The issue I have is the R's socp() function takes matrices as inputs that reflect the data(/covariance matrix and average return values) and constraints all together, where as the MATLAB code seems to be optimising a function...in this specific case it looks like its optimising -wcvar to get the optimal weights, so I am unsure of how to set up my problem in R to get similar results.
The MATLAB code I would therefore like help in translating to R is as follows:
function [w] = rgop(T, mu, sigma, epsilon)
% This function determines the robust growth-optimal portfolio
% Input parameters:
% T - the number of time periods
% mu - the mean vector of asset returns
% sigma - the covariance matrix of asset returns
% epsilon - violation probability
% Output parameters:
% w - robust growth-optimal portfolios
% the number of assets
n = length(mu);
% portfolio weights
w = sdpvar(n,1);
% mean and standard deviation of portfolio
rp = w'*mu;
sigmap = sqrt(w'*sigma*w);
% preclude short selling
constraints = [w >= 0]; %#ok<NBRAK>
% budget constraint
constraints = [constraints, sum(w) == 1];
% worst-case value-at-risk (theorem 4.1)
wcvar = 1/2*(1 - (1 - rp + sqrt((1-epsilon)/epsilon/T)*sigmap)^2 - ((T-1)/epsilon/T)*sigmap^2);
% maximise WCVAR
ops = sdpsettings('solver','sdpt3','verbose',0);
solvesdp(constraints, -wcvar, ops);
w = double(w);
end
For the square root function of the covariance matrix one can use:
Rsocp:::.SqrtMatrix()
Note this question is partially related to my previous question however is more focused on getting the worst case VaR weights:
SOCP Solver Error for fPortoflio using solveRsocp
Perhaps a good start would be to use this code where the Rsocp package has already been used...
https://r-forge.r-project.org/scm/viewvc.php/pkg/fPortfolio/R/solveRsocp.R?view=markup&root=rmetrics&pathrev=3507
EDIT
I think the MATLAB code for the solvesdp function is available from this link:
https://code.google.com/p/vroster/source/browse/trunk/matlab/yalmip/solvesdp.m?r=11
Also a quick question about SOCP optimisations in general...would the result obtained via SOCP optimisation be the same as that achieved using other methods of optimisation? will the only difference be speed and efficiency?
EDIT2
Since it was requested...
rgop <- function(tp, mu, sigma, epsilon){
# INPUTS
# tp - the number of time periods
# mu - the mean vector of asset returns
# sigma - the covariance matrix of asset returns
# epsilon - violation probability
# OUTPUT
# w - robust growth-optimal portfolios
#n is number of assets
n <- length(mu)
# portfolio weights (BUT THIS IS THE OUTPUT)
# for now will assume equal weight
w <- rep(1/n,n)
# mean and standard deviation of portfolio
rp <- sum(w*mu)
sigmap <- as.numeric(sqrt(t(w) %*% sigma %*% w))
# worst-case value-at-risk (theorem 4.1)
wcvar = 1/2*(1 - (1 - rp + sqrt((1-epsilon)/epsilon/tp)*sigmap)^2 - ((tp-1)/epsilon/tp)*sigmap^2);
# optimise...not sure how to carry out this optimisation...
# which is the main thrust of this question...
# could use DEoptim...but would like to understand the SOCP method
}
SOCP is just a fast way of finding the minimum in cases where you know enough about the problem to constrain it in certain technical ways. As you're discovering these constraints can be tricky to formulate, so it is worth asking if you need the speed. Often the answer is yes, but for debugging/exploration purposes brute numerical optimisation using R's optim function can be fruitful.

Why is nlogn so hard to invert?

Let's say I have a function that is nlogn in space requirements, I want to work out the maximum size of input for that function for a given available space. i.e. I want to find n where nlogn=c.
I followed an approach to calculate n, that looks like this in R:
step = function(R, z) { log(log(R)-z)}
guess = function(R) log(log(R))
inverse_nlogn = function(R, accuracy=1e-10) {
zi_1 = 0
z = guess(R)
while(abs(z - zi_1)>accuracy) {
zi_1 = z
z = step(R, z)
}
exp(exp(z))
}
But I can't get understand why it must be solved iteratively. For the range we are interested (n>1), the function is non singular.
There's nothing special about n log n — nearly all elementary functions fail to have elementary inverses, and so have to be solved by some other means: bisection, Newton's method, Lagrange inversion theorem, series reversion, Lambert W function...
As Gareth hinted the Lambert W function (eg here) gets you almost there, indeed n = c/W(c)
A wee google found this, which might be helpful.
Following up (being completely explicit):
library(emdbook)
n <- 2.5
c <- 2.5*log(2.5)
exp(lambertW(c)) ## 2.5
library(gsl)
exp(lambert_W0(c)) ## 2.5
There are probably minor differences in speed, accuracy, etc. of the two implementations. I haven't tested/benchmarked them extensively. (Now that I tried
library(sos)
findFn("lambert W")
I discover that it's implemented all over the place: the games package, and a whole package that's called LambertW ...

Resources