I'm working on a paper for school.
I have to look for the tangency portfolio using this formula, which I translated in R as follows (basic tangency portfolio formula with matrician algebra.)
nom <- solve(Mat) %*% (ER - RF)
denom <- Ones %*% nom
w <- nom %*% solve(denom)
This formula gives me also negative weights (short selling), and I would like to add a constraint that only allows weights from 0 to 1, with sum 1.
Who can help me with this?
Example:
If I run the code as now, let's say with 3 assets, I will get also negative weights for some assets (ex c(0.20, -0.40, 0.80)), with sum == 1. (In this case, short selling would be enabled). This is the tangency portfolio that maximizes the sharpe ratio, given the expected return and variance. What I'd love to have is the tangency portfolio without short selling allowed. In the example, I would have the weights something like c(0.18, 0.05, 0.72). It will be incorrect to replace the negative numbers with 0 and also the >1 with 1, as the sum of all the weights should be one
as mentioned by #Shree, an example would help understanding more precisely what you're after.
From what I understood, you want w to be bounded between [0,1]? From the top of my head you could either shift and scale w
## Shifting
shift_w <- (w-min(w))
## Scaling
shift_w/max(shift_w)
Or, more brutally, replace the values <0 or >1 by a given value or function
## What to replace the value with when negative
replace_negative <- 0
## What to replace the value with when superior to 1
replace_one <- 1
## Making sure w is bounded between 0 and 1
ifelse(ifelse(w < 0, replace_negative, w) > 1, replace_one w)
Note that replace_negative and replace_one can also be a function f(w) if you want something more complex.
Related
I'm trying to maximize the portfolio return subject to 5 constraints:
1.- a certain level of portfolio risk
2.- the same above but oposite sign (I need that the risk to be exactly that number)
3.- the sum of weights have to be 1
4.- all the weights must be greater or equal to cero
5.- all the weights must be at most one
I'm using the optiSolve package because I didn't find any other package that allow me to write this problem (or al least that I understood how to use it).
I have three big problems here, the first is that the resulting weights vector sum more than 1 and the second problem is that I can't declare t(w) %*% varcov_matrix %*% w == 0 in the quadratic constraint because it only allows for "<=" and finally I don't know how to put a constraint to get only positives weights
vector_de_retornos <- rnorm(5)
matriz_de_varcov <- matrix(rnorm(25), ncol = 5)
library(optiSolve)
restriccion1 <- quadcon(Q = matriz_de_varcov, dir = "<=", val = 0.04237972)
restriccion1_neg <- quadcon(Q = -matriz_de_varcov, dir = "<=",
val = -mean(limite_inf, limite_sup))
restriccion2 <- lincon(t(vector_de_retornos),
d=rep(0, nrow(t(vector_de_retornos))),
dir=rep("==",nrow(t(vector_de_retornos))),
val = rep(1, nrow(t(vector_de_retornos))),
id=1:ncol(t(vector_de_retornos)),
name = nrow(t(vector_de_retornos)))
restriccion_nonnegativa <- lbcon(rep(0,length(vector_de_retornos)))
restriccion_positiva <- ubcon(rep(1,length(vector_de_retornos)))
funcion_lineal <- linfun(vector_de_retornos, name = "lin.fun")
funcion_obj <- cop(funcion_lineal, max = T, ub = restriccion_positiva,
lc = restriccion2, lb = restriccion_nonnegativa, restriccion1,
restriccion1_neg)
porfavor_funciona <- solvecop(funcion_obj, solver = "alabama")
> porfavor_funciona$x
1 2 3 4 5
-3.243313e-09 -4.709673e-09 9.741379e-01 3.689040e-01 -1.685290e-09
> sum(porfavor_funciona$x)
[1] 1.343042
Someone knows how to solve this maximization problem with all the constraints mentioned before or tell me what I'm doing wrong? I'll really appreciate that, because the result seems like is not taking into account the constraints. Thanks!
Your restriccion2 makes the weighted sum of x is 1, if you also want to ensure the regular sum of x is 1, you can modify the constraint as follows:
restriccion2 <- lincon(rbind(t(vector_de_retornos),
# make a second row of coefficients in the A matrix
t(rep(1,length(vector_de_retornos)))),
d=rep(0,2), # the scalar value for both constraints is 0
dir=rep('==',2), # the direction for both constraints is '=='
val=rep(1,2), # the rhs value for both constraints is 1
id=1:ncol(t(vector_de_retornos)), # the number of columns is the same as before
name= 1:2)
If you only want the regular sum to be 1 and not the weighted sum you can replace your first parameter in the lincon function as you've defined it to be t(rep(1,length(vector_de_retornos))) and that will just constrain the regular sum of x to be 1.
To make an inequality constraint using only inequalities you need the same constraint twice but with opposite signs on the coefficients and right hand side values between the two (for example: 2x <= 4 and -2x <= -4 combines to make the constraint 2*x == 4). In your edit above, you provide a different value to the val parameter so these two constraints won't combine to make the equality constraint unless they match except for opposite signs as below.
restriccion1_neg <- quadcon(Q = -matriz_de_varcov, dir = "<=", val = -0.04237972)
I'm not certain because I can't find precision information in the package documentation, but those "negative" values in the x vector are probably due to rounding. They are so small and are effectively 0 so I think the non-negativity constraint is functioning properly.
restriccion_nonnegativa <- lbcon(rep(0,length(vector_de_retornos)))
A constraint of the form
x'Qx = a
is non-convex. (More general: any nonlinear equality constraint is non-convex). Non-convex problems are much more difficult to solve than convex ones and require specialized, global solvers. For convex problems, there are quite a few solvers available. This is not the case for non-convex problems. Most portfolio models are formulated as convex QP (quadratic programming i.e. risk -- the quadratic term -- is in the objective) or convex QCP/SOCP problems (quadratic terms in the constraints, but in a convex fashion). So, the constraint
x'Qx <= a
is easy (convex), as long as Q is positive-semi definite. Rewriting x'Qx=a as
x'Qx <= a
-x'Qx <= -a
unfortunately does not make the non-convexity go away, as -Q is not PSD. If we are maximizing return, we usually only use x'Qx <= a to limit the risk and forget about the >= part. Even more popular is to put both the return and the risk in the objective (that is the standard mean-variable portfolio model).
A possible solver for solving non-convex quadratic problems under R is Gurobi.
Forgive me if this has been asked before (I feel it must have, but could not find precisely what I am looking for).
Have can I draw one element of a vector of whole numbers (from 1 through, say, 10) using a probability function that specifies different chances of the elements. If I want equal propabilities I use runif() to get a number between 1 and 10:
ceiling(runif(1,1,10))
How do I similarly sample from e.g. the exponential distribution to get a number between 1 and 10 (such that 1 is much more likely than 10), or a logistic probability function (if I want a sigmoid increasing probability from 1 through 10).
The only "solution" I can come up with is first to draw e6 numbers from the say sigmoid distribution and then scale min and max to 1 and 10 - but this looks clumpsy.
UPDATE:
This awkward solution (and I dont feel it very "correct") would go like this
#Draw enough from a distribution, here exponential
x <- rexp(1e3)
#Scale probs to e.g. 1-10
scaler <- function(vector, min, max){
(((vector - min(vector)) * (max - min))/(max(vector) - min(vector))) + min
}
x_scale <- scaler(x,1,10)
#And sample once (and round it)
round(sample(x_scale,1))
Are there not better solutions around ?
I believe sample() is what you are looking for, as #HubertL mentioned in the comments. You can specify an increasing function (e.g. logit()) and pass the vector you want to sample from v as an input. You can then use the output of that function as a vector of probabilities p. See the code below.
logit <- function(x) {
return(exp(x)/(exp(x)+1))
}
v <- c(seq(1,10,1))
p <- logit(seq(1,10,1))
sample(v, 1, prob = p, replace = TRUE)
I have a (non-symmetric) probability matrix, and an observed vector of integer outcomes. I would like to find a vector that maximises the probability of the outcomes, given the transition matrix. Simply, I am trying to estimate a distribution of particles at sea given their ultimate distribution on land, and a matrix of probabilities of a particle released from a given point in the ocean ending up at a given point on the land.
The vector that I want to find is subject to the constraint that all components must be between 0-1, and the sum of the components must equal 1. I am trying to figure out the best optimisation approach for the problem.
My transition matrix and data set are quite large, but I have created a smaller one here:
I used a simulated known at- sea distribution of
msim<-c(.3,.2,.1,.3,.1,0) and a simulated probability matrix (t) to come up with an estimated coastal matrix (Datasim2), as follows:
t<-matrix (c(0,.1,.1,.1,.1,.2,0,.1,0,0,.3,0,0,0,0,.4,.1,.3,0,.1,0,.1,.4,0,0,0,.1,0,.1,.1),
nrow=5,ncol=6, byrow=T)
rownames(t)<-c("C1","C2","C3","C4","C5") ### locations on land
colnames(t)<-c("S1","S2","S3","S4","S5","S6") ### locations at sea
Datasim<-as.numeric (round((t %*% msim)*500))
Datasim2<-c(rep("C1",95), rep("C2",35), rep("C3",90),rep("C4",15),rep("C5",30))
M <-c(0.1,0.1,0.1,0.1,0.1,0.1) ## starting M
I started with a straightforward function as follows:
EstimateSource3<-function(M,Data,T){
EstEndProbsall<-M%*%T
TotalLkhd<-rep(NA, times=dim(Data)[1])
for (j in 1:dim(Data)[1]){
ObsEstEndLkhd<-0
ObsEstEndLkhd<-1-EstEndProbsall[1,] ## likelihood of particle NOT ending up at locations other than the location of interest
IndexC<-which(colnames(EstEndProbsall)==Data$LocationCode[j], arr.ind=T) ## likelihood of ending up at location of interest
ObsEstEndLkhd[IndexC]<-EstEndProbsall[IndexC]
#Total likelihood
TotalLkhd[j]<-sum(log(ObsEstEndLkhd))
}
SumTotalLkhd<-sum(TotalLkhd)
return(SumTotalLkhd)
}
DistributionEstimate <- optim(par = M, fn = EstimateSource3, Data = Datasim2, T=t,
control = list(fnscale = -1, trace=5, maxit=500), lower = 0, upper = 1)
To constrain the sum to 1, I tried using a few of the suggestions posted here:How to set parameters' sum to 1 in constrained optimization
e.g. adding M<-M/sum(M) or SumTotalLkhd<-SumTotalLkhd-(10*pwr) to the body of the function, but neither yielded anything like msim, and in fact, the 2nd solution came up with the error “L-BFGS-B needs finite values of 'fn'”
I thought perhaps the quadprog package might be of some help, but I don’t think I have a symmetric positive definite matrix…
Thanks in advance for your help!
What about that: Let D = distribution at land, M = at sea, T the transition matrix. You know D, T, you want to calculate M. You have
D' = M' T
hence D' T' = M' (T T')
and accordingly D'T'(T T')^(-1) = M'
Basically you solve it as when doing linear regression (seems SO does not support math notation: ' is transpose, ^(-1) is ordinary matrix inverse.)
Alternatively, D may be counts of particles, and now you can ask questions like: what is the most likely distribution of particles at sea. That needs a different approach though.
Well, I have never done such models but think along the following lines. Let M be of length 3 and D of length 2, and T is hence 3x2. We know T and we observe D_1 particles at location 1 and D_2 particles at location 2.
What is the likelihood that you observe one particle at location D_1? It is Pr(D = 1) = M_1 T_11 + M_2 T_21 + M_3 T_32. Analogously, Pr(D = 2) = M_1 T_12 + M_2 T_22 + M_3 T_32. Now you can easily write the log-likelihood of observing D_1 and D_2 particles at locations 1 and 2. The code might look like this:
loglik <- function(M) {
if(M[1] < 0 | M[1] > 1)
return(NA)
if(M[2] < 0 | M[2] > 1)
return(NA)
M3 <- 1 - M[1] - M[2]
if(M3 < 0 | M3 > 1)
return(NA)
D[1]*log(T[1,1]*M[1] + T[2,1]*M[2] + T[3,1]*M3) +
D[2]*log(T[1,2]*M[1] + T[2,2]*M[2] + T[3,2]*M3)
}
T <- matrix(c(0.1,0.2,0.3,0.9,0.8,0.7), 3, 2)
D <- c(100,200)
library(maxLik)
m <- maxLik(loglik, start=c(0.4,0.4), method="BFGS")
summary(m)
I get the answer (0, 0.2, 0.8) when I estimate it but standard errors are very large.
As I told, I have never done it so I don't know it it makes sense.
I'm trying to calculate the weighted average of a statistic sample (vector) in R using this form:
The function takes a vector and the weight is adjusted according by a second parameter (1 - 3), which are:
where s is the standard deviation.
I've adjusted the weight accordingly if the parameter is 1 or 3 using else-if's, but I'm having trouble with the 2nd one given that there is criteria to meet...
I've been calculating X - xBar as a vector: m = x-mean(x)
I've been calculating s with an R function: s = sd(x)
My query is regarding how "the meeting of the conditions should be programmed" in the 2nd critera. So far I have an if for each condition, but...
When calculating the weighted average, (taking the top one as an eg), does each element of the x vector (m/s) need to be less than 1? or do I need to test each element and assign a weight from the 3 conditions accordingly?
eg. if the first elements answer was less than 1, assign a weight or 1, but second elements answer was inbetween 1 and 2, assign it a weight of 0.5?
I hope this makes sense. In R it throws a warning message saying the logic is only comparing the first element of the vector... so thats what raised the question.
Thanks in advance.
To avoid the warning message while staying reasonably efficient, you probably want to use ifelse rather than if and else, perhaps in something like
m <- mean(x)
s <- sd(x)
absstandardx <- abs( (x - m) / s )
w2 <- ifelse( absstandardx < 1, 1, ifelse( absstandardx < 2, 0.5, 0 ) )
weightedmean2 <- sum(w2 * x) / sum(w2)
Here's an interesting puzzle.
Below is an R snippet that identifies the tangency point of a quadratic function with respect to a line drawn from the point (0,rf) on the y-axis.
For those familiar with portfolio theory, this point is in return and risk space and the solution is set of weights that define the tangency portfolio (max sharpe ratio). The snippet allows for negative weights (i.e. shorts) and there is one equality weight constraint which requires the sum of the weights = 1.
require(quadprog)
# create artifical data
nO <- 100 # number of observations
nA <- 10 # number of assets
mData <- array(rnorm(nO * nA, mean = 0.001, sd = 0.01), dim = c(nO, nA))
rf <- 0.0001 # riskfree rate (2.5% pa)
mu <- apply(mData, 2, mean) # means
mu2 <- mu - rf # excess means
# qp
aMat <- as.matrix(mu2)
bVec <- 1 # set expectation of portfolio excess return to 1
zeros <- array(0, dim = c(nA,1))
solQP <- solve.QP(cov(mData), zeros, aMat, bVec, meq = 1)
# rescale variables to obtain weights
w <- as.matrix(solQP$solution/sum(solQP$solution))
# compute sharpe ratio
SR <- t(w) %*% mu2 / sqrt(t(w) %*% cov(mData) %*% w)
My question -- how to adapt the code to solve for the optimal set of weights such that the sum of weights sum to an arbitrary number (including the corner case of a self-financing portfolio where the sum of weights = 0) as opposed to unity?
Alternatively, you might consider adding an element 'cash' to the covariance matrix with variance-covariance of 0, and add an equality constraint requiring the weight on cash = 1. However this matrix would be not be positive semi-definite. Also I suspect the non-cash weights might be trivially zero.
Let us first explain why this
actually produces the maximum Sharpe ratio portfolio.
We want w to maximize w' mu / sqrt( w' V w ).
But that quantity is unchanged if we multiply w by a number
(it is "homogeneous of degree 0"):
we can therefore impose w' mu = 1, and the problem
of maximizing 1 / sqrt( w' V w ) is equivalent
to minimizing w' V w.
The maximum Sharpe ratio portfolio is not unique: they form a line.
If we want the weights to sum up to 1 (or any other non-zero number),
we just have to rescale them.
If we want the weights to sum up to 0,
we can add that constraint to the problem
-- it only works because the constraint is also homogeneous of degree 0.
You will still need to rescale the weights, e.g., to be 100% long and 100% short.
solQP <- solve.QP(cov(mData), zeros,
cbind(aMat,1),
c(bVec,0),
meq = 2
)
# Let us compare with another solver
V <- cov(mData)
library(Rsolnp)
r <- solnp(
rep(1/length(mu), length(mu)),
function(w) - t(w) %*% mu2 / sqrt( t(w) %*% V %*% w ),
eqfun = function(w) sum(w),
eqB = 0,
LB = rep(-1, length(mu))
)
solQP$solution / r$pars # constant
Looking at the link you have included. Apparently, the role of aMat, bVec, meq = 1 inside the solve.QP call is to fix the value of the numerator (your return) in the Sharpe ratio formula, so the optimization is focused on minimizing the denominator. In a sense, it is perfectly legal to fix the numerator, it is like fixing the total size of your portfolio. Your portfolio can later be scaled up or down, it will keep the same Sharpe ratio. To help you realize that, you can run your code above for any value of bVec (granted, other than zero) and you will get the same result for the weights w and the Sharpe ratio SR.
So I feel you might be misinterpreting the notion of "portfolio weights". They are ratios representing what your portfolio is made of, and they should sum to one. Once you have found the optimal weights, which you already did, you are free to scale your portfolio to whatever level you want, just multiply w by the current value you want for your portfolio.
This is not a good technique for long portfolios. Even portfolios than can short stocks have allocations weights of the wrong sign after normalizing by the sum of weights.
These situations arise with negative excess returns. Forcing w'mu = 1 puts the solution to the left of the origin (negative risk) in these cases.
library(quadprog)
nA = 2 # two assets
mu2 = c(-.1,.1) # one negative excess return
Dmat = matrix(c(1,0,0,10),2,2)
aMat <- as.matrix(mu2)
bVec <- 1 # set expectation of portfolio excess return to 1
zeros <- array(0, dim = c(nA,1))
solQP <- solve.QP(Dmat, zeros, aMat, bVec, meq = 1)
rawW = solQP$solution
cat('\nraw weights ')
cat(rawW)
netW = rawW/sum(rawW)
cat('\nnormalized weights ')
cat(netW)
portfReturn = sum(netW*mu2)
cat('\nportfolio excess return ')
cat(portfReturn)