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.
Related
Within some matrix algebra I found the expression B = ker(A), where A is a 3x4 transformation matrix. The following two links gave me some vague idea about ker() in general:
Wolfram: Kernel
Calculate the dimensions and basis of the kernel Ker(f)
But frankly, I still can not square how to get a 4x1 vector as result. How would this kernel be calculated in R? And some additional background/links would be appreciated.
Here is the matrix A and the result B (or its transpose...).
A = structure(c(0.9, 1.1, 1.2, 0.8, 0, 0.5, 0.3, 0.1, 0.5, 0, 0.2,
0.7), .Dim = 4:3)
B = structure(c(0.533, 0.452, -0.692, -0.183), .Dim = c(4L, 1L))
I did get as far as realizing, that each row of the A-matrix times B equals zero, just like in the examples. But for solving the set of linear equations I am missing one more equation, don't I?
With the pracma package:
pracma::nullspace(t(A))
# [,1]
# [1,] -0.5330006
# [2,] -0.4516264
# [3,] 0.6916801
# [4,] 0.1830918
With the MASS package:
MASS::Null(A)
I'm new to optimisation/calibration of models in R, but i'm eager to learn and really need some help. My question relates to demographic modelling.
I've done some research and found help here and here but neither have quite answered my question.
I have a matrix of scalars (propensities) where each column must total to 1. These propensities are used to estimate the number of households that would arise from a given population (persons by age). The propensities model tends to overestimate the number of households in history (for which I know the true number of households).
I want to calibrate the model to minimise the error in the number of households by tweaking the propensities such that the columns still add to 1 and propensities with an initial value of zero must remain zero.
Simple example:
# Propensities matrix
mtx <- matrix(c(0.00, 0.00, 0.85, 0.00, 0.15, 0.35, 0.45, 0.00,
0.20, 0.00, 0.65, 0.15, 0.00, 0.20, 0.00), ncol = 3)
# Population by age cohort
pop <- c(2600, 16200, 13400)
# True number of households
target <- c(7000, 4500, 5500)
# Function to optimise
hh <- function(mtx, pop, target) {
# Estimate living arrangements
x <- mtx %*% pop
# Estimate number of households using parent cohorts (1,2 and 4)
x <- c(x[1,1]/2, x[2,1]/2, x[4,1]) - target
return(x)
}
I haven't included any of my code for the optimisation/calibration step as it would be embarrassing and I've haven't been able to get anything to work!
Ideally i will have one set of propensities that generalises well for lots of different regions at the end of this process. Any advice on how i should go about achieving it? Helpful links?
Update
The snippet of code below executes the local search method as suggested by Enrico.
library(tidyverse)
library(NMOF)
data <- list(mtx = matrix(c(0.00, 0.00, 0.90, 0.00, 0.10, 0.25, 0.50, 0.00,
0.25, 0.00, 0.60, 0.20, 0.00, 0.20, 0.00), ncol = 3),
pop = c(2600, 16200, 13400),
target = c(7190, 4650, 5920))
# True mtx
mtx.true <- matrix(c(0.00, 0.00, 0.75, 0.00, 0.25, 0.35, 0.45, 0.00,
0.20, 0.00, 0.65, 0.15, 0.00, 0.20, 0.00), ncol = 3)
# Function to optimise
households <- function(x, data) {
# Estimate living arrangements
z <- x %*% data$pop
# Estimate number of households using parent cohorts (1,2 and 4)
z <- c(z[1,1]/2, z[2,1]/2, z[4,1]) - data$target
sum(abs(z))
}
# Local search function to perturb propensities
neighbour <- function(x, data) {
# Choose random column from mtx
i <- sample(1:ncol(x), 1)
# Select two non-zero propensities from mtx column
j <- which(x[, i] != 0) %>% sample(2, replace = FALSE)
# Randomnly select one to perturb positively
x[j[1], i] <- 0.1 * (1 - x[j[1], i]) + x[j[1], i]
# Perturb second propensity to ensure mtx column adds to 1
x[j[2], i] <- x[j[2], i] + (1 - sum(x[,i]))
x
}
# Local search algorithm inputs
localsearch <- list(x0 = data$mtx,
neighbour = neighbour,
nS = 50000,
printBar = FALSE)
# Execute
now <- Sys.time()
solution <- LSopt(OF = households, algo = localsearch, data)
#>
#> Local Search.
#> Initial solution: 2695
#> Finished.
#> Best solution overall: 425.25
Sys.time() - now
#> Time difference of 6.33272 secs
# Inspect propensity matrices
print(solution$xbest)
#> [,1] [,2] [,3]
#> [1,] 0.0000000 0.3925 0.6
#> [2,] 0.0000000 0.4250 0.2
#> [3,] 0.2937976 0.0000 0.0
#> [4,] 0.0000000 0.1825 0.2
#> [5,] 0.7062024 0.0000 0.0
print(mtx.true)
#> [,1] [,2] [,3]
#> [1,] 0.00 0.35 0.65
#> [2,] 0.00 0.45 0.15
#> [3,] 0.75 0.00 0.00
#> [4,] 0.00 0.20 0.20
#> [5,] 0.25 0.00 0.00
Thanks!
I can only comment on the optimisation part.
The code you have provided is sufficient; only your objective function evaluates to a vector. You will need to transform this vector into a single number that is to be minimised, such as the sum of squares or of absolute values.
When it comes to methods, I would try heuristics; in fact, I would try a Local-Search method. These methods operate on the solution through functions which you define; thus, you may code your solution as a matrix. More specifically, you would need two functions: the objective function (which you essentially have) and a neighbourhood function, which takes as input a solution and modifies it. In your particular case, it could take a matrix, select two none-zero elements from one column, and increase one and decrease the other. Thus, the column sum would remain unchanged.
Perhaps the tutorial http://enricoschumann.net/files/NMOF_Rmetrics2012.pdf is of interest, with R code http://enricoschumann.net/files/NMOF_Rmetrics2012.R .
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
For a simulation study I need to create nxn covariance matrices. for example I can input 2x2 covariance matrices like
[,1] [,2]
[1,] 1.0 1.5
[2,] 1.5 2.0
into a r function/object:
var <- c(1,2) ## variances
covar <- c(1.5,1.5) ## covariance(s)
mat <- matrix(c(var[1],covar[1],covar[2],var[2]),ncol=length(var))
then I only have to change var & covar values to form the matrices. but unfortunately I'm not just dealing with 2x2s but 2x2:30x30 or even higher! so is it possible to write only one function for any matrix of nxn dimension in r?
You can do:
m <- diag(variance)
m[lower.tri(m)] = m[upper.tri(m)] <- head(covar, length(covar)/2)
For example:
variance = c(0.25, 0.75, 0.6)
covar = c(0.1, 0.3, 0.2, 0.1, 0.3, 0.2)
#>m
# [,1] [,2] [,3]
#[1,] 0.25 0.10 0.3
#[2,] 0.10 0.75 0.2
#[3,] 0.30 0.20 0.6
I am new to world of matrix, sorry for this basic question I could not figure out:
I have four matrix (one unknown).
Matrix X
x <- c(44.412, 0.238, -0.027, 93.128, 0.238, 0.427, -0.193, 0.673, 0.027,
-0.193, 0.094, -0.428, 93.128, 0.673, -0.428, 224.099)
X <- matrix(x, ncol = 4 )
Matrix B : need to be solved , 1 X 4 (column x nrows), with b1, b2, b3, b4 values
Matrix G
g <- c(33.575, 0.080, -0.006, 68.123, 0.080, 0.238, -0.033, 0.468, -0.006,
-0.033, 0.084, -0.764, 68.123, 0.468, -0.764, 205.144)
G <- matrix(g, ncol = 4)
Matrix A
a <- c(1, 1, 1, 1) # one this case but can be any value
A <- matrix(a, ncol = 1)
Solution:
B = inv(X) G A # inv(X) is inverse of the X matrix multiplied by G and A
I did not know how to solve this properly, particularly inverse of the matrix. Appreciate your help.
I'm guessing that Nick and Ben are both teachers and have even greater scruples than I do about doing other peoples' homework, but the path to a complete solution was really so glaringly obvious that it didn't make a lot of sense not to tae the next step:
B = solve(X) %*% G %*% A
> B
[,1]
[1,] -2.622000509
[2,] 7.566857261
[3,] 17.691911600
[4,] 2.318762273
The QR method of inversion can be invoked by supplying an identity matrix as the second argument:
> qr.solve(G, diag(1,4))
[,1] [,2] [,3] [,4]
[1,] 0.098084556856 -0.0087200426695 -0.3027373205 -0.0336789016478
[2,] -0.008720042669 4.4473233701790 1.7395207242 -0.0007717410073
[3,] -0.302737320546 1.7395207241703 13.9161591761 0.1483895429511
[4,] -0.033678901648 -0.0007717410073 0.1483895430 0.0166129089935
A more computationally stable solution is to use qr rather than solve.
method1 <- solve(X) %*% G %*% A
method2 <- qr.coef(qr(X), G) %*% A
stopifnot(isTRUE(all.equal(method1, method2)))
See the examples in ?qr.