Portfolio optimisation in R - group ratio constraints - r

Let's say we have a simple long-only problem with four assets and several constraints. Below is how I would normally optimise portfolio weights with some basic constraints, such as weights sum to 1, no short selling and no leverage.
# set the covariance matrix:
cov <- cbind(c(0.1486, 0.0778, -0.0240, -0.0154),
c(0.0778, 0.1170, 0.0066, 0.0029),
c(-0.0240, 0.0066, 0.0444, 0.0193),
c(-0.0154, 0.0029, 0.0193, 0.0148)
)
# expected returns:
dvec <- c(0.0308, 0.0269, 0.0145, 0.0130)
# constraints:
# 1) weights to sum to 1
# 2) minimum weight for each asset = 0
# 3) maximum weight for each asset = 1
Amat <- cbind(c(1, 1, 1, 1), diag(1,4,4), diag(-1,4,4))
bvec <- c(1, 0, 0, 0, 0, -1, -1, -1, -1)
meq = 1
# The solution for portfolio weights is as follows:
round(solve.QP(cov, dvec=dvec, Amat=Amat, bvec=bvec, meq=meq)$solution,4)
Now, I would like to add a constraint that the first asset is less or equal than 60% of the first three assets taken together. How could I add this constraint to the above portfolio? It is easy to set the upper bound for an asset as a percentage of the overall portfolio, but I don't know how to set the upper bound for an asset as a percentage of a certain group of assets.
Any thoughts would be much appreciated.

Related

Quadratic optimization - portfolio maximization problems

In portfolio analysis, given the expectation, we aim to find the weight of each asset to minimize the variance
here is the code
install.packages("quadprog")
library(quadprog)
#Denoting annualized risk as an vector sigma
sigma <- c(0.56, 7.77, 13.48, 16.64)
#Formulazing the correlation matrix proposed by question
m <- diag(0.5, nrow = 4, ncol = 4)
m[upper.tri(m)] <- c(-0.07, -0.095, 0.959, -0.095, 0.936, 0.997)
corr <- m + t(m)
sig <- corr * outer(sigma, sigma)
#Defining the mean
mu = matrix(c(1.73, 6.65, 9.11, 10.30), nrow = 4)
m0 = 8
Amat <- t(matrix(c(1, 1, 1, 1,
c(mu),
1, 0, 0, 0,
0, 1, 0, 0,
0, 0, 1, 0,
0, 0, 0, 1), 6, 4, byrow = TRUE))
bvec <- c(1, m0, 0, 0, 0, 0)
qp <- solve.QP(sig, rep(0, nrow(sig)), Amat, bvec, meq = 2)
qp
x = matrix(qp$solution)
x
(t(x) %*% sig %*% x)^0.5
I understand the formulation of mu and covariance matrix and know the usage of the quadprog plot
However, I don‘t understand why Amat and bvec are defined in this way, why the are 6 by 4 matrix.
$mu0$ is the expectation we aim to have for the portfolio and it is fixed at value 8%
Attached is the question
As you are probably aware, the reason that Amat has four columns is that there are four assets that you are allocating over. It has six rows because there are six constraints in your problem:
The allocations add up to 1 (100%)
Expected return = 8%
'Money market' allocation >= 0
'Capital stable' allocation >= 0
'Balance' allocation >= 0
'Growth' allocation >= 0
Look at the numbers that define each constraint. They are why bvec is [1, 8, 0, 0, 0, 0]. Of these six, the first two are equality constraints, which is why meq is set to 2 (the other four are greater than or equal constraints).
Edited to add:
The way the constraints work is this: each column of Amat defines a constraint, which is then multiplied by the asset allocations, with the result equal to (or greater-than-or-equal-to) some target that is set in bvec. For example:
The first column of Amat is [1, 1, 1, 1], and the first entry of bvec is 1. So the first constraint is:
1 * money_market + 1 * capital_stable + 1 * balance + 1 * growth = 1
This is a way of saying that the asset allocations add up to 1.
The second constraint says that the expected returns add up to 8:
1.73 * money_market + 6.65 * capital_stable + 9.11 * balance + 10.32 * growth = 8
Now consider the third constraint, which says that the 'Money market' allocation is greater than or equal to zero. That's because the 3rd column of Amat is [1, 0, 0, 0] and the third entry of bvec is 0. So this constraint looks like:
1 * money_market + 0 * capital_stable + 0 * balance + 0 * growth >= 0
Simplifying, that's the same as:
money_market >= 0

How to identify each instance of a data-frame with normalized vectors into quantiles (like 0, 0.25, 0.5, 0.75,1)?

I have a data-frame with 20 variables and 400k instances. All variables are normalized with mean 0 and standard deviation 1. I want to write a function which could classify each instance of each variables into quantiles.
Lets say we have a normalized vector
a <- c(0.2132821 -1.5136988 0.6450274 1.5085178 0.2132821 1.5085178 0.6450274)
And the quantiles for this vector are
quant.a <- c(-1.5136988 -1.0819535 0.2132821 1.0767726 1.5085178)
where -1.5136988 is 0%
-1.0819535 is 25%
0.2132821 is 50%
1.0767726 is 75%
1.5085178 is 100% (all are elements in vector 'quant.a')
Now, I want to classify each element of vector 'a' as follows
new.a <- c(0.5, 0, 0.75, 1, 0.5, 1, 0.75)
You can use the following code to workout through the example as it is not possible for me to share the actual data
# Generate random data
set.seed(99)
# All variables are on a scale of 1-9
a <- floor(runif(500, min = 1, max = 9))
b <- floor(runif(500, min = 1, max = 9))
c <- floor(runif(500, min = 1, max = 9))
# store variables as dataframe
x <- data.frame(cbind(a,b,c))
#Scale variables
scaled.dat <- data.frame(scale(x))
# check that we get mean of 0 and sd of 1
colMeans(scaled.dat)
apply(scaled.dat, 2, sd)
# generate quantiles for each variables
quantiles <- data.frame(apply(scaled.dat,2,quantile))
Thanks in advance
a <- c(0.2132821, -1.5136988, 0.6450274 , 1.5085178 , 0.2132821 , 1.5085178 , 0.6450274)
quant.a = quantile(a)
aux_matrix = findInterval(a, quant.a)
new.a = ifelse(aux_matrix == 1|aux_matrix == 0, 0,
ifelse(aux_matrix == 2, 0.5,
ifelse(aux_matrix==3,0.75,
1)))
print(new.a)
0.50 0.00 0.75 1.00 0.50 1.00 0.75
library(dplyr)
yourdataframe %>%
mutate_all(funs(ntile(., 4)/4)

How to change the per-step weighting coefficient in the R package DTW

I would like to change the default step-pattern weight of the cost function because I need to standardize my results with some others in a paper that doesn't use the weight 2 for the diagonal distance. I've read the JSS paper but I just found other step-patterns that are not what I'm really looking for, I guess. For example, imagine we have two timeSeries Q, C:
Q = array(c(0,1,0,0,0,0,0,0,0,0,0,0,0,1,1,0),dim=c(8,2))
C = array(c(0,1,0,0,0,0,0,0,0,1,1,0,0,0,0,0),dim=c(8,2))
When I calculate the dtw distance, I obtain
alignment = dtw(Q,C,keep=TRUE)
With a alginment$distance of 2.41 and a cost matrix where for example the [2,2] element is 2 instead of 1 because of the weight or penalization of 2*d[i,j] in the diagonal when selecting the minimum between:
g[i,j] = min( g[i-1,j-1] + 2 * d[i ,j ] ,
g[i ,j-1] + d[i ,j ] ,
g[i-1,j ] + d[i ,j ] )
plot(asymmetricP1)
edit(asymmetricP1)
structure(c(1, 1, 1, 2, 2, 3, 3, 3, 1, 0, 0, 1, 0, 2, 1, 0, 2,
1, 0, 1, 0, 1, 0, 0, -1, 0.5, 0.5, -1, 1, -1, 1, 1), .Dim = c(8L, 4L), class = "stepPattern", npat = 3, norm = "N")
Look at the plot, and consider the branches as ordered from right to left (ie. branch1 = 0.5 weight)
Everything in the script below is in the context of plot(asymmetricP1) and edit(asymmetricP1)
#first 8 digit sequence (1,1,1,2,2,3,3,3....
#branch1: "1,1,1" <- amount of intervals assigned to specificaly branch1; (end, joint, origin)
#branch2: "2,2" <- only 2 intervals, this is the middle diagnol line.
#branch3: "3,3,3" <- amount of interals
#note: Don't be confused by the numbers themselves, ie. "4,4,4" <- 3 intervals; "2,2,2" <- 3 intervals
#for the next sequences consider:
#the sequence of each branch is to be read as farthest from origin -> 0,0
#each interval assignment is accounted for in this order
#next 8 digit sequence: 1, 0, 0, 1, 0, 2, 1, 0,
#branch1: 1,0,0 <- interval position in relation to the query index
#branch2: 1,0 <- interval position in relation to the query index
#branch3: 2,1,0 <- interval position in relation to the query index (again see in plot)
#next 8 digit sequence: 2, 1, 0, 1, 0, 1, 0, 0
#branch1: 2,1,0 <- interval position in relation to the REFERENCE index
#branch2: 1,0 <- interval position in relation to the reference index
#branch3: 1,0,0 <- interval position in relation to the reference index (again see in plot)
#next 8 digit sequence: -1, 0.5, 0.5, -1, 1, -1, 1, 1
#note: "-1" is a signal that indicates weighting values follow
#note: notice that for each -1 that occurs, there is one value less, for example branch 1
# .....which has 3 intervals can only contain 2 weights (0.5 and 0.5)
#branch1: -1,0.5,0.5 <- changing the first 0.5 changes weight of [-1:0] segment (query index)
#branch2: -1,1 <- weight of middle branch
#branch3: -1,1,1 <- changing the second 1 changes weight of[-1,0] segment (query index)
#.Dim=c(8L, 4L):
#8 represents the number of intervals (1,1,1,2,2,3,3,3)
#4 (from what I understand) is the (length of all the branch sequences mentioned previously)/8
#npat = 3
#3 is the number of patterns you described in the structure. ie(1,1,1,2,2,3,3,3)
Hope this helps, good luck!

How to use R package Quadprog to solve SVM?

I was wondering what's the proper way to implement Quadprog to solve quadratic programming.
I have the following question(ripped from the internet)and also was looking at the following http://cbio.ensmp.fr/~thocking/mines-course/2011-04-01-svm/svm-qp.pdf
What would be the proper way to solve this issue? Would this tutorial be useful to solve if i was given a question like above?
http://www.r-bloggers.com/solving-quadratic-progams-with-rs-quadprog-package/
Here is an implementation, for linear C-SVM, which is based on the primal optimization problem:
min_{beta_0, beta, zeta} 1/2 w^T w + C sum_{i = 1}^N zeta_i
subject to:
y_i (w^T x_i + b) >= 1 - zeta_i, for all i = 1, 2, ..., N
zeta_i >= 0, for all i = 1, 2, ..., N
where N is the number of data points.
Note that using quadprog to solve this is, to some degree, more of a pedagogical exercise, as quadprog relies on an interior point algorithm, while in practice a specialized algorithm would be used, such as Platt's SMO, which takes advantage of particular properties of the SVM optimization problem.
In order to use quadprog, given the equations above, it all boils down to setting up the matrices and vectors that specify the optimization problem.
One issue, however, is that quadprog requires the matrix appearing in the quadratic function to be positive definite (see, for example, http://www.r-bloggers.com/more-on-quadratic-progamming-in-r/), while the implementation used here leads to it being positive semi-definite, since the intercept beta_0 and the zeta_i do not appear in the quadratic function. To go around this issue, I set the diagonal elements corresponding to these values in the matrix to a very small value.
To setup the example code, using the spam dataset, a binary classification problem:
library(kernlab) # for the spam data
# Load the input data to be used
data(spam)
# Use only a subset of the data (20%)
spam <- spam[sample(nrow(spam), round(0.2 * nrow(spam)), replace = FALSE), ]
# Retrieve the features and data
X <- spam[, 1:(ncol(spam) - 1)]
Y_f <- spam[, ncol(spam)]
Y <- 2 * (as.numeric(Y_f) - 1.5) # {-1, 1}
# Sample size
N <- nrow(X)
# Number of dimensions
n_d <- ncol(X)
# Value of the regularization parameter
C <- 1
In order to setup the optimization problem, keep in mind the format employed by package quadprog:
#
# Formulation: min(−d^T * b + 0.5 * b^T * D * b) with the constraints A^T * b >= b_0
#
# solve.QP(Dmat, dvec, Amat, bvec, meq=0, factorized=FALSE)
#
# Arguments
# Dmat: matrix appearing in the quadratic function to be minimized.
# dvec: vector appearing in the quadratic function to be minimized.
# Amat: matrix defining the constraints under which we want to minimize the quadratic function.
# bvec: vector holding the values of b0 (defaults to zero).
# meq: the first meq constraints are treated as equality constraints, all further as inequality
# constraints (defaults to 0).
# factorized logical flag: if TRUE, then we are passing R−1 (where D = RT R) instead of the
# matrix D in the argument Dmat.
#
Then, organizing the parameter vector as:
# b = (beta_0, beta, zeta),
# where: beta_0 in R, beta in Re^n_d, zeta in Re^N
such that:
d <- c(0, rep(0, n_d), rep(-C, N)) # -C * sum(zeta)
# Need a work-around for the matrix D, which must be positive definite (being
# positive semi-definite is not enough...)
# See http://www.r-bloggers.com/more-on-quadratic-progamming-in-r/
eps <- 1e-10 # this will ultimately be the lowest eigenvalue of matrix D (with multiplicity N + 1)
D <- diag(c(eps, rep(1, n_d), rep(eps, N))) # beta^T * beta
#
# Matrix specifying the constraints
# For zeta_i > 0:
# beta_0 | beta | zeta
# A_1 = [ 0, 0, 0, ..., 0, 1, 0, 0, ..., 0]
# [ 0, 0, 0, ..., 0, 0, 1, 0, ..., 0]
# [ 0, 0, 0, ..., 0, 0, 0, 1, ..., 0]
# ...
# [ 0, 0, 0, ..., 0, 0, 0, 0, ..., 1]
# where matrix A_1 has N rows, and N + n_d + 1 columns
#
# For beta_0 * y_i + beta^T * x_i * y_i + zeta_i >= 1:
# beta_0 | beta | zeta
# A_2 = [ y_1, y_1 * x_{1, 1}, y_1 * x_{2, 2}, ..., y_1 * x{i, n_d}, 1, 0, 0, ..., 0]
# [ y_2, y_2 * x_{2, 1}, y_2 * x_{2, 2}, ..., y_2 * x{i, n_d}, 0, 1, 0, ..., 0]
# ...
# [ y_N, y_N * x_{N, 1}, y_2 * x_{N, 2}, ..., y_N * x{N, n_d}, 0, 0, 0, ..., 1]
#
I_N <- diag(N) # N x N identity matrix
A_1 <- cbind(matrix(0, ncol = n_d + 1, nrow = N), I_N) # zeta_i > 0, for all i; N rows
A_2 <- as.matrix(cbind(as.matrix(Y), X * as.matrix(Y)[, rep(1, n_d)], I_N)) # zeta_i + beta_0 * y_i + beta^T * x_i * y_i >= 1, for all i; N rows
rownames(A_1) <- NULL; rownames(A_2) <- NULL
colnames(A_1) <- NULL; colnames(A_2) <- NULL
A <- t(rbind(A_1, A_2))
b_0 <- c(rep(0, N), rep(1, N))
Finally, solve the optimization problem and retrieve the parameter values:
library(quadprog)
results <- solve.QP(D, d, A, b_0)
# Retrieve the results
b_optim <- results$solution
beta_0 <- b_optim[1]
beta <- b_optim[1 + (1:n_d)]
zeta <- b_optim[(n_d + 1) + (1:N)]
Afterwards, given a matrix X_test, the model can be used to predict via:
Y_pred <- sign(apply(X_test, 1, function(x) beta_0 + sum(beta * as.vector(x))))

get.basis() in lpSolveAPI

I am confused with the return of function get.basis(). For example,
lprec <- make.lp(0, 4)
set.objfn(lprec, c(1, 3, 6.24, 0.1))
add.constraint(lprec, c(0, 78.26, 0, 2.9), ">=", 92.3)
add.constraint(lprec, c(0.24, 0, 11.31, 0), "<=", 14.8)
add.constraint(lprec, c(12.68, 0, 0.08, 0.9), ">=", 4)
set.bounds(lprec, lower = c(28.6, 18), columns = c(1, 4))
set.bounds(lprec, upper = 48.98, columns = 4)
RowNames <- c("THISROW", "THATROW", "LASTROW")
ColNames <- c("COLONE", "COLTWO", "COLTHREE", "COLFOUR")
dimnames(lprec) <- list(RowNames, ColNames)
solve(lprec)
Then the basic variables are
> get.basis(lprec)
[1] -7 -2 -3
However, the solution is
> get.variables(lprec)
[1] 28.60000 0.00000 0.00000 31.82759
From the solution, it seems variable 1 and variable 4 are basis. Hence how does vector (-7, -2, -3) come from?
I am guessing it is from 3 constraints and 4 decision variables.
After I reviewed the simplex method for bounded variables, finally I understood how it happens. These two links are helpful. Example; Video
Come back to this problem, the structure is like
lpSolveAPI (R interface for lp_solve) would rewrite the constraint structure as the following format after adding appropriate slack variables. The first three columns are for slack variables. Hence, the return of get.basis(), which is -7,-2,-3, are column 7, 2, 3 that represent variable 4, slack variable 2 and 3.
With respect to this kind of LP with bounded variables, a variable could be nonbasic at either lower bound or upper bound. The return of get.basis(lp, nonbasic=TRUE) is -1,-4,-5,-6. Minus means these variables are at their lower bound. It means slack variable 1 = 0, variable 4 = 28.6, variable 5 = 0, variable 6 = 0.
Thus, the optimal solution is 28.6(nonbasic), 0(nonbasic), 0(nonbasic), 31.82(basic)

Resources