Related
I am working on a research project and a while back I asked this question on Mathematics Stack Exchange, where I was looking for a way to calculate the variance of the period-to-period change in income given a transition matrix, where each state corresponds to a log level of income in a vector, which is given. I want to calculate what the variance of an individual's change in income is over some n number of periods given that they began in each state. My state space consists of 11 states, so I hope to end up with a vector consisting of 11 different variances. When I asked the question, I received a satisfactory answer, but I am running into some issues when trying to code it in R I was hoping to receive help with.
I have created this piece of code to calculate the variances:
install.packages("expm")
library(expm)
# creating standard basis vectors
e <- function(i) {
e_i = rep(0, length(alpha))
e_i[i] = 1
return(e_i)
}
# compute variances
p2p_variance = function(n, alpha, P) {
variance = list()
pi_n = list()
for (i in 1:length(alpha)) {
pi_n[[i]] = e(i) %*% (P %^% n)
beta = (t(alpha) - t(alpha)[i])^2
variance[[i]] = (pi_n[[i]] %*% t(beta)) - (((pi_n[[i]] %*% alpha) - alpha[i]) %^% 2)
}
return(t(variance))
}
And for my values of alpha (vector of log levels of income) and P (transition matrix) I use:
alpha = c(3.4965, 3.5835, 3.6636, 3.7377, 3.8067, 3.8712, 3.9318, 3.9890, 4.0431, 4.0943, 4.1431)
P = rbind(c(0.9004, 0.0734, 0.0203, 0.0043, 0.0010, 0.0003, 0.0001, 0.0001, 0.0000, 0.0000, 0.0000),
c(0.3359, 0.3498, 0.2401, 0.0589, 0.0115, 0.0026, 0.0007, 0.0003, 0.0001, 0.0001, 0.0000),
c(0.1583, 0.1538, 0.3931, 0.2346, 0.0481, 0.0090, 0.0021, 0.0007, 0.0003, 0.0001, 0.0001),
c(0.0746, 0.0609, 0.1600, 0.4368, 0.2178, 0.0397, 0.0073, 0.0019, 0.0006, 0.0002, 0.0001),
c(0.0349, 0.0271, 0.0559, 0.1724, 0.4628, 0.2031, 0.0344, 0.0067, 0.0018, 0.0006, 0.0003),
c(0.0155, 0.0122, 0.0230, 0.0537, 0.1817, 0.4870, 0.1860, 0.0316, 0.0066, 0.0018, 0.0009),
c(0.0066, 0.0054, 0.0100, 0.0204, 0.0529, 0.1956, 0.4925, 0.1772, 0.0307, 0.0064, 0.0023),
c(0.0025, 0.0023, 0.0043, 0.0084, 0.0186, 0.0530, 0.2025, 0.4980, 0.1760, 0.0275, 0.0067),
c(0.0009, 0.0009, 0.0017, 0.0035, 0.0072, 0.0168, 0.0490, 0.2025, 0.5194, 0.1721, 0.0260),
c(0.0003, 0.0003, 0.0007, 0.0013, 0.0029, 0.0061, 0.0142, 0.0430, 0.2023, 0.5485, 0.1804),
c(0.0001, 0.0001, 0.0002, 0.0003, 0.0008, 0.0017, 0.0032, 0.0068, 0.0212, 0.1079, 0.8578))
For instance, a call of p2p_variance(100, alpha, P) (calculating the variance over 100 periods) results in the following vector of variances:
0.04393012 0.04091066 0.03856503 0.03636202 0.03472286 0.03331921 0.03213084 0.03068901 0.03143765 0.03255994 0.03522346
Which seem plausible. However, If I run p2p_variance(1000, alpha, P), it results in:
0.06126449 0.03445073 0.009621497 -0.01447615 -0.03652425 -0.05752316 -0.07753646 -0.09726683 -0.1134972 -0.1287498 -0.141676
This is obviously not correct, since we cannot have negative variance. I cannot figure out why simply increasing n to 1000 is resulting in negative variance here. I have most likely coded my p2p_variance function incorrectly, but I cannot for the life of me find the issue. Or perhaps is the process I am using to find these variances flawed somehow? I would really appreciate if anyone could look over this code and help me diagnose the issue
Your variance function is returning the difference, and if you want the absolute value (variance) just wrap it inside abs() like this:
p2p_variance = function(n, alpha, P) {
variance = list()
pi_n = list()
for (i in 1:length(alpha)) {
pi_n[[i]] = e(i) %*% (P %^% n)
beta = (t(alpha) - t(alpha)[i])^2
variance[[i]] = abs((pi_n[[i]] %*% t(beta)) - (((pi_n[[i]] %*% alpha) - alpha[i]) %^% 2))
}
return(t(variance))
}
p2p_variance(1000, alpha, P)
Output:
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11]
[1,] 0.06126449 0.03445073 0.009621497 0.01447615 0.03652425 0.05752316 0.07753646 0.09726683 0.1134972 0.1287498 0.141676
I'm interested in finding the mean and covariance of a truncated normal random vector. Suppose Y is a vector containing [Y1 Y2 Y3]. Y follows a multivariate normal distribution with the following mean and covariance:
mu <- c(0.5, 0.5, 0.5)
sigma <- matrix(c( 1, 0.6, 0.3,
0.6, 1, 0.2,
0.3, 0.2, 2), 3, 3)
The truncation region is the set of Ys such that AY >= 0. For instance,
A <- matrix(c(1, -2, -0.5, 1.5, -2, 0, 3, -1, -1, 4, 0, -2), byrow = TRUE, nrow = 4)
> A
[,1] [,2] [,3]
[1,] 1.0 -2 -0.5
[2,] 1.5 -2 0.0
[3,] 3.0 -1 -1.0
[4,] 4.0 0 -2.0
For the following draw of Y, it does not satisfy AY >= 0:
set.seed(3)
Y <- rmvnorm(n = 1, mean = mu, sigma = sigma)
> all(A %*% as.matrix(t(Y)) >= 0)
[1] FALSE
But for other draws of Y, they will satisfy AY >= 0, and I want to find the mean and covariance of those Ys that satisfy AY >= 0.
There are existing packages in R that compute the mean and covariance of a truncated normal distribution. For example, mtmvnorm from the tmvtnorm package:
library(tmvtnorm)
mtmvnorm(mu, sigma, lower = ???, upper = ???)
However, the truncation set that I have, i.e, set of Ys that satisfy AY >= 0, cannot be described by just lower and upper bounds. Is there another way to R to compute the mean and covariance of a truncated normal?
You had correct understanding (or maybe noticed) that this is NOT truncated multivariate normal distribution. You have AY>=0 as a linear constraint over Y, rather than simple element-wise lower/upper bounds.
If you are not a math guy, i.e., pursuing explicit solutions of mean and covariance, I guess a straightforward and efficient way is using Monte Carlo simulation.
More specifically, you can presume a sufficient large N to generate big enough set of samples Y and then filter out the samples that satisfy the constraint AY>=0. In turn, you can compute mean and covariance over the selected samples. An attempt is given as below
N <- 1e7
Y <- rmvnorm(n = N, mean = mu, sigma = sigma)
Y_h <- subset(Y, colSums(tcrossprod(A, Y) >= 0) == nrow(A))
mu_h <- colMeans(Y_h)
sigma_h <- cov(Y_h)
and you will see
> mu_h
[1] 0.8614791 -0.1365222 -0.3456582
> sigma_h
[,1] [,2] [,3]
[1,] 0.5669915 0.29392671 0.37487421
[2,] 0.2939267 0.36318397 0.07193513
[3,] 0.3748742 0.07193513 1.37194669
Another way follows the similar idea, but we can presume the set size of selected samples, i.e., N samples Y all should make AY>=0 stand. Then we can use while loop to do this
N <- 1e6
Y_h <- list()
nl <- 0
while (nl < N) {
Y <- rmvnorm(n = N, mean = mu, sigma = sigma)
v <- subset(Y, colSums(tcrossprod(A, Y) >= 0) == nrow(A))
nl <- nl + nrow(v)
Y_h[[length(Y_h) + 1]] <- v
}
Y_h <- head(do.call(rbind, Y_h), N)
mu_h <- colMeans(Y_h)
sigma_h <- cov(Y_h)
and you will see
> mu_h
[1] 0.8604944 -0.1364895 -0.3463887
> sigma_h
[,1] [,2] [,3]
[1,] 0.5683498 0.29492573 0.37524248
[2,] 0.2949257 0.36352022 0.07252898
[3,] 0.3752425 0.07252898 1.37427521
Note: The advantage of the second option is that, it gives you the sufficient large number of selected Y_h as you want.
I am struggling with Solve.QP to get a solution to minimize tracking error. I have a benchmark consisting of 6 assets (asset_a to asset_f). For my portfolio I have upper and lower bounds (I cannot have a position in asset_f). The cov matrix is also given. I want to get the portfolio weights for the 6 assets that minimizes tracking error vs the benchmark (with position in asset_f equal to zero).
benchmark:
asset_a: 0.3
asset_b: 0.3
asset_c: 0.1
asset_d: 0.1
asset_e: 0.1
asset_f: 0.1
lowerbounds:
asset_a: 0.166
asset_b: 0.133
asset_c: 0.037
asset_d: 0.035
asset_e: 0.039
asset_f: 0
upperbounds:
asset_a: 1
asset_b: 1
asset_c: 1
asset_d: 1
asset_e: 1
asset_f: 0
benchmark weights and bounds:
test.benchmark_weights = c(0.3, 0.3, 0.1, 0.1, 0.1, 0.1)
test.lowerbound = c(0.166, 0.133, 0.037, 0.035, 0.039,0)
test.upperbound = c(1, 1, 1, 1, 1, 0)
cov matrix (test.Dmat):
test.dmat = matrix(c(0.0119127162, 0.010862842, 0.010266683, 0.0009550136, 0.008242322, 0.00964462, 0.0108628421, 0.010603072, 0.009872992, 0.0011019412, 0.007422522, 0.0092528873, 0.0102666826, 0.009872992, 0.010487808, 0.0012107665, 0.006489204, 0.0096216627, 0.0009550136, 0.001101941, 0.001210766, 0.0115527788, 0.001181745, 0.0008387247, 0.0082423222, 0.007422522, 0.006489204, 0.0011817453, 0.012920482, 0.005973886, 0.00964462, 0.009252887, 0.009621663, 0.0008387247, 0.005973886, 0.0089904809), nrow=6, ncol=6)
dvec (test.dvec):
test.dvec = matrix(c(0, 0, 0, 0, 0, 0), nrow=6, ncol=1)
Amat constraints matrix (test.Amat):
test.amat = matrix(c(1,1,1,1,1,1, 1,1,1,1,1,0, -1,0,0,0,0,0, 0,-1,0,0,0,0, 0,0,-1,0,0,0, 0,0,0,-1,0,0, 0,0,0,0,-1,0, 0,0,0,0,0,-1, 1,0,0,0,0,0, 0,1,0,0,0,0, 0,0,1,0,0,0, 0,0,0,1,0,0, 0,0,0,0,1,0, 0,0,0,0,0,0, -1,0,0,0,0,0, 0,-1,0,0,0,0, 0,0,-1,0,0,0, 0,0,0,-1,0,0, 0,0,0,0,-1,0, 0,0,0,0,0,0), nrow=6, ncol=20)
bvec (test.bvec)
test.bvec =cbind(0, 1, t(test.benchmark_weights), t(test.lowerbound), -t(test.upperbound)) %>% as.matrix()
then running the solver
solve.QP(as.matrix(test.Dmat), test.dvec, test.Amat, test.bvec)
gives me
constraints are inconsistent, no solution!
Seems like there is something wrong with your Amat and bvec, i.e. you need not have to pass in both sum of weights on first 5 assets equal to 1 and sum of 6 assets equal 1 and also benchmark weights are not constraints but the bounds are:
library(quadprog)
N = 6L
test.dvec = rep(0, N)
test.amat = cbind(
rep(1, N),
diag(1, N),
diag(-1, N))
test.bvec = c(1, test.lowerbound, -test.upperbound)
res = solve.QP(test.dmat, test.dvec, test.amat, test.bvec, meq=1L)
round(res$solution, 2)
#[1] 0.17 0.13 0.10 0.44 0.17 0.00
I am multplying a matrix tm by a vector tb to produce a "response" vector. I need to apply this to a list of n tb vectors, which would produce a list containing n response vectors. I am struggling to get this to iterate over the list, for a single case it is this:
set.seed(19)
n <- 10
k <- 4
tb <- list(split(rnorm(n*k, 0, 1),seq(1:n)))
tm <- matrix(c(1.0, 0.1, 0.2, 0.3, 0.1, 1.0, 0.2, 0.1, 0.2, 0.2, 1.0, 0.5, 0.3, 0.1, 0.5, 1.0), ncol = k)
tm %*% as.vector(unlist(tb[[1]][1]))
Which produces the first response vector when doing this calculation in isolation:
> tm %*% as.vector(unlist(tb[[1]][1]))
[,1]
[1,] -0.4014836
[2,] 0.8348435
[3,] 2.0416294
[4,] 1.9114801
However, I've tried to get all 10 response vectors using lapply/sapply but this gives me an unexpected output:
> sapply(tm, function(x) x %*% as.vector(unlist(tb)))
[,1] [,2] [,3] [,4] [,5]
[1,] -1.189453745 -0.1189453745 -0.2378907491 -0.3568361236 -0.1189453745
[2,] 0.518629988 0.0518629988 0.1037259975 0.1555889963 0.0518629988
[3,] 1.423423.. ... ... ...
Just showing a snippet of the output here, it's 16 columns and 40 rows, in other words - one column per element of the matrix, and n x k rows. It's seemingly taking the first cell of the matrix, and doing the calculation, then the second cell, and the third cell and so on - as you can see this matches the output from sapply when I take a single element of tm:
> tm[1] %*% as.vector(unlist(tb[[1]][1]))
[,1] [,2] [,3] [,4]
[1,] -1.189454 0.51863 1.423423 1.504741
My question is, how do I get this multiplication to take the whole matrix when using lapply/sapply as it does when I do it in isolation?
I think you just need to remove the list() function from your tb definition:
set.seed(19)
n <- 10
k <- 4
tb <- split(rnorm(n*k, 0, 1),seq(1:n))
tm <- matrix(c(1.0, 0.1, 0.2, 0.3, 0.1, 1.0, 0.2, 0.1, 0.2, 0.2, 1.0, 0.5, 0.3, 0.1, 0.5, 1.0), ncol = k)
you can then produce your first response vector simpler:
tm %*% tb[[1]]
[,1]
[1,] -0.4014836
[2,] 0.8348435
[3,] 2.0416294
[4,] 1.9114801
and all the response vectors with sapply:
sapply(tb, function(x) x %*%tm )
1 2 3 4 5 6 7 8 9 10
[1,] -0.4014836 0.1513720 -0.1113092 -0.28636882 1.1300914 -0.7037464 1.5886556 -0.8908194 -0.6891749 -0.4927336
[2,] 0.8348435 0.6747836 0.6135654 -0.01236765 0.6523212 -0.3599526 -0.2293118 1.5190890 0.1165567 -0.7644372
[3,] 2.0416294 -0.9832891 0.3399474 1.04671293 -0.1986427 -0.4779628 1.3585457 1.0673985 -1.7597788 -0.4059126
[4,] 1.9114801 -0.7064887 0.5356257 0.57154412 0.8048432 -1.6563305 2.9935210 -1.3916476 -1.3746462 -0.9662248
I have a correlation matrix
cor.mat <- structure(c(1, -0.25, 0.11, 0.25, 0.18, -0.25, 1, -0.14, -0.22,
-0.15, 0.11, -0.14, 1, 0.21, 0.19, 0.25, -0.22, 0.21, 1, 0.53,
0.18, -0.15, 0.19, 0.53, 1), .Dim = c(5L, 5L))
I also have a matrix of standard errors
sd <- structure(c(0.33, 0.62, 1, 0.54, 0.47), .Dim = c(1L, 5L))
dim(cor.mat)
#[1] 5 5
dim(sd)
#[1] 1 5
is.matrix(cor.mat)
#[1] TRUE
is.matrix(sd)
#[1] TRUE
cov.mat <-cor2cov(cor.mat, sd)
# Error in sds * R : non-conformable arrays
So, the matrices have compatible dimensions, why doesn't cor2cov function work for me?
OK, I don't know where your cor2cov comes from. But actually, it is really straightforward to obtain covariance matrix from correlation matrix and standard errors:
cov.mat <- sweep(sweep(cor.mat, 1L, sd, "*"), 2L, sd, "*")
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0.108900 -0.051150 0.0363 0.044550 0.027918
#[2,] -0.051150 0.384400 -0.0868 -0.073656 -0.043710
#[3,] 0.036300 -0.086800 1.0000 0.113400 0.089300
#[4,] 0.044550 -0.073656 0.1134 0.291600 0.134514
#[5,] 0.027918 -0.043710 0.0893 0.134514 0.220900
Yes, it is just a symmetric row & column rescaling.
We can verify this by transforming this covariance matrix back to correlation matrix using cov2cor, which is exactly your correlation matrix:
all.equal(cov2cor(cov.mat), cor.mat)
# [1] TRUE
My guess on your cor2cov
If you read How to rescale a matrix by row / column, you will see there are lots of different ways for rescaling. The sweep used above is just one option.
R base function cov2cor(V) is using:
Is <- sqrt(1/diag(V)) ## inverse of square root diagonal (inverse of sd)
Is * V * rep(Is, each = p)
I think your cor2cov(R, sds) is written in the same style:
sds * R * rep(sds, each = p) ## `sd` must be a vector
If so, sd must be a vector, otherwise "*" will complain (note, the error message you got is indeed reported from "*").
Your argument "the matrices have compatible dimensions" is a bogus one. Purely in terms of linear algebra, you need sd to be a diagonal matrix, so that you can do:
sd %*% cor.mat %*% sd
But row / column rescaling is never done by matrix computations as this is too expensive.
By definition of correlation and covariance matrix, you can simply do this:
cov.mat <- cor.mat * matrix(outer(sd, sd), nrow=5, byrow=TRUE)
cov.mat
[,1] [,2] [,3] [,4] [,5]
[1,] 0.108900 -0.051150 0.0363 0.044550 0.027918
[2,] -0.051150 0.384400 -0.0868 -0.073656 -0.043710
[3,] 0.036300 -0.086800 1.0000 0.113400 0.089300
[4,] 0.044550 -0.073656 0.1134 0.291600 0.134514
[5,] 0.027918 -0.043710 0.0893 0.134514 0.220900
I think I might have found an answer on another post: Non-conformable arrays error in code
When I treat sd matrix as vertor, it works (I hope, it's correct?)
sd = as.vector(sd)
cov.mat <- cor2cov(cor.mat, sd)
Thank you and please let me know if this operation makes the results not equivalent to what I was initially asking about.