Suppose that there is a main matrix A.
We want to find a matrix B such that:
B %*% B %*% B %*% B = A
where %*% is the matrix product in R.
The desired outcome is the matrix B.
Have you try to google it out? There is a sqrtm function present in package expm.
Details
The matrix square root S of M, S=sqrtm(M) is defined as one (the “principal”) S such that SS=S2=M, (in R, all.equal( S %*% S , M )).
The method works from the Schur decomposition.
Examples
# NOT RUN {
library(expm)
m <- diag(2)
sqrtm(m) == m # TRUE
(m <- rbind(cbind(1, diag(1:3)),2))
sm <- sqrtm(m)
sm
zapsmall(sm %*% sm) # Zap entries ~= 2e-16
stopifnot(all.equal(m, sm %*% sm))
# }
Please check http://www.inside-r.org/packages/cran/expm/docs/sqrtm
Another helpful link : http://realizationsinbiostatistics.blogspot.com/2008/08/matrix-square-roots-in-r_18.html
Related
I would like to recreate the following calculation with a random matrix:
I started out with the following, which gives a result:
kmin1 <- cbind(1:10,1:10,6:15,1:10,1:10,6:15,1:10,1:10,6:15)
C <- cbind(1, kmin1) # Column of 1s
diag(C) <- 1
Ccrosprod <-crossprod(C) # C'C
Ctranspose <- t(C) # C'
CCtransposeinv <- solve(Ccrosprod) # (C'C)^-1
W <- Ctranspose %*% CCtransposeinv # W=(C'C)^-1*C'
My assumption is however that C should be able to be an m x n matrix, as there is no good reason to assume that factors equal observations.
EDIT: Based on the comment by Hong Ooi, I changed kmin1 <- matrix(rexp(200, rate=.1), ncol=20) into kmin1 <- matrix(rexp(200, rate=.1), nrow=20)
I checked the wikipedia and learned that an m x n might have a left or a right inverse. To put this into practice I attempted the following:
kmin1 <- matrix(rexp(200, rate=.1), nrow=20)
C <- cbind(1, kmin1) # Column of 1s
Ccrosprod <-crossprod(C) # C'C
Ctranspose <- t(C) # C'
CCtransposeinv <- solve(Ccrosprod) # (C'C)^-1
W <- Ctranspose %*% CCtransposeinv # W=(C'C)^-1*C'
EDIT: Based on the comments below this questions everything works.
I would post this on stackexchange if I was sure this did not have anything to do with syntax, but as I am not experienced with matrices I am not sure.
If the columns of C are linearly independent then C'C is invertible and (C'C)-1C' equals any of these:
set.seed(123)
kmin1 <- matrix(rexp(200, rate=.1), nrow=20)
C <- cbind(1, kmin1)
r1 <- solve(crossprod(C), t(C))
r2 <- qr.solve(crossprod(C), t(C))
r3 <- chol2inv(chol(crossprod(C))) %*% t(C)
r4 <- with(svd(C), v %*% diag(1/d) %*% t(u))
r5 <- with(eigen(crossprod(C)), vectors %*% diag(1/values) %*% t(vectors)) %*% t(C)
r6 <- coef(lm.fit(C, diag(nrow(C))))
# check
all.equal(r1, r2)
## [1] TRUE
all.equal(r1, r3)
## [1] TRUE
all.equal(r1, r4)
## [1] TRUE
all.equal(r1, r5)
## [1] TRUE
dimnames(r6) <- NULL
all.equal(r1, r6)
## [1] TRUE
If C'C is not necessarily invertible then the answer is not necessarily unique (although if we were interested in C(C'C)-C' then that would be unique even though the pseudoinverse of C'C may not be). At any rate we can form one pseudo inverse by taking the singular value decomposition (or the eigenvalue decomposition) and using the reciprocal of the singular values (or eigenvalues) and using 0 for those that are near 0. This is equivalent to using the Moore Penrose pseudo inverse. (The lm.fit approach shown above will work too but will generate some NAs in the result.)
set.seed(123)
kmin1 <- matrix(rexp(200, rate=.1), nrow=20)
C <- cbind(1, kmin1)
C[, 11] <- C[, 2] + C[, 3] # force singularity
eps <- 1.e-5
s1 <- with(svd(C), v %*% diag(ifelse(abs(d) < eps, 0, 1/(d))) %*% t(u))
s2 <- with(eigen(crossprod(C)),
vectors %*% diag(ifelse(abs(values) < eps, 0, 1/values)) %*% t(vectors)) %*% t(C)
# check
all.equal(s1, s2)
## [1] TRUE
First off, I am not familiar with your area of research/work (econometrics?), so I'm not sure whether the following is sensible from a domain-specific knowledge point of view.
That aside, the library MASS allows to calculate the Moore-Penrose generalised inverse of a non-square matrix.
So a potential generalisation of your calculations to non-square matrices could look like
library(MASS)
W <- ginv(t(C) %*% C) %*% t(C)
I have to compute a product of 3 matrices D=ABC with:
A is a (1x3) matrix,
B is a (3x3) matrix,
C is a (3x1) matrix (and is equal to A', if it matters)
The result of this product is a simple value, and the calculation is very straightforward in R.
My problem is there is one unknown, namely X, inside A and C, and I would like to get the result as a formula: D = ABD = f(X).
Is there any way I could achieve this with R ?
Define D as shown below where argument B is the square matrix and A is a function of x returning a vector.
D <- function(B, A) function(x) t(A(x)) %*% B %*% A(x)
# test
A <- function(x) seq(3) * x
B <- matrix(1:9, 3)
Dfun <- D(B, A)
Dfun(10)
## [1] 22800
In R, the function solve can be used to solve matrix equations of form A %*% x = b for x.
I successfully performed x <- solve(A,b) with some valid set of linear equations, and went to check that my result was the correct answer.
I typed A %*% x == b and the result was
[1]
[1] FALSE
[2] FALSE
...
[5] TRUE
but when I queried A %*% x the result was identical to b
Does this have to do with how I created the matrices?
A <- matrix(c(1,2, ... , 1), nrow=5, byrow = T)
b <- matrix(c(7,...,7), nrow=5)
The elipses are just because the numbers are irrelevant
Suppose I have a positive semi-definite matrix S and I would like to get the inverse of square root of this matrix, that is S^(-1/2).
May I do like this?
ei <- eigen(S)
V <- ei$vectors
res <- V %*% diag(1 / sqrt(ei$values)) %*% t(V)
Is res equal to S^(-1/2)?
I just do inverse of square root for eigenvalue of S, is this correct?
I know that: if one wants to get S^(1/2), then res <- V %*% diag(sqrt(ei$values)) %*% t(V), which is res = S^(1/2).
How about for S^(-1/2)?
Thanks.
Yes. We can easily take an example S and check that S times res times res is the identity matrix:
set.seed(123)
S <- crossprod(matrix(rnorm(9), 3))
ei <- eigen(S)
V <- ei$vectors
res <- V %*% diag(1 / sqrt(ei$values)) %*% t(V)
S %*% res %*% res
## [,1] [,2] [,3]
## [1,] 1.0000e+00 -2.3731e-15 -1.6653e-16
## [2,] 3.3346e-15 1.0000e+00 -6.6613e-16
## [3,] -1.0235e-16 8.3267e-16 1.0000e+00
Also note that S and res commute, i.e. all.equal(S %*% res, res %*% S) is TRUE, so the 3 factors in the last line of code could have been written in any order.
If, as per the OP's enquiry, the input matrix is positive semi-definite (and not positive definite), its eigenvalues will not all be positive, and the method given in the answer above will fail, since
diag(1 / sqrt(ei$values))
will not be a finite matrix.
I have a 2396x34 double matrix named y wherein each row (2396) represents a separate situation consisting of 34 consecutive time segments.
I also have a numeric[34] named x that represents a single situation of 34 consecutive time segments.
Currently I am calculating the correlation between each row in y and x like this:
crs[,2] <- cor(t(y),x)
What I need now is to replace the cor function in the above statement with a weighted correlation. The weight vector xy.wt is 34 elements long so that a different weight can be assigned to each of the 34 consecutive time segments.
I found the Weighted Covariance Matrix function cov.wt and thought that if I first scale the data it should work just like the cor function. In fact you can specify for the function to return a correlation matrix as well. Unfortunately it does not seem like I can use it in the same manner because I cannot supply my two variables (x and y) separately.
Does anyone know of a way I can get a weighted correlation in the manner I described without sacrificing much speed?
Edit: Perhaps some mathematical function could be applied to y prior to the cor function in order to get the same results that I'm looking for. Maybe if I multiply each element by xy.wt/sum(xy.wt)?
Edit #2 I found another function corr in the boot package.
corr(d, w = rep(1, nrow(d))/nrow(d))
d
A matrix with two columns corresponding to the two variables whose correlation we wish to calculate.
w
A vector of weights to be applied to each pair of observations. The default is equal weights for each pair. Normalization takes place within the function so sum(w) need not equal 1.
This also is not what I need but it is closer.
Edit #3
Here is some code to generate the type of data I am working with:
x<-cumsum(rnorm(34))
y<- t(sapply(1:2396,function(u) cumsum(rnorm(34))))
xy.wt<-1/(34:1)
crs<-cor(t(y),x) #this works but I want to use xy.wt as weight
Unfortunately the accepted answer is wrong when y is a matrix of more than one row. The error is in the line
vy <- rowSums( w * y * y )
We want to multiply the columns of y by w, but this will multiply the rows by the elements of w, recycled as necessary. Thus
> f(x, y[1, , drop = FALSE], xy.wt)
[1] 0.103021
is correct, because in this case the multiplication is performed element-wise, which is equivalent to column-wise multiplication here, but
> f(x, y, xy.wt)[1]
[1] 0.05463575
gives a wrong answer due to the row-wise multiplication.
We can correct the function as follows
f2 <- function( x, y, w = rep(1,length(x))) {
stopifnot(length(x) == dim(y)[2] )
w <- w / sum(w)
# Center x and y, using the weighted means
x <- x - sum(x * w)
ty <- t(y - colSums(t(y) * w))
# Compute the variance
vx <- sum(w * x * x)
vy <- colSums(w * ty * ty)
# Compute the covariance
vxy <- colSums(ty * x * w)
# Compute the correlation
vxy / sqrt(vx * vy)
}
and check the results against those produced by corr from the boot package:
> res1 <- f2(x, y, xy.wt)
> res2 <- sapply(1:nrow(y),
+ function(i, x, y, w) corr(cbind(x, y[i,]), w = w),
+ x = x, y = y, w = xy.wt)
> all.equal(res1, res2)
[1] TRUE
which in itself gives another way that this problem could be solved.
You can go back to the definition of the correlation.
f <- function( x, y, w = rep(1,length(x))) {
stopifnot( length(x) == dim(y)[2] )
w <- w / sum(w)
# Center x and y, using the weighted means
x <- x - sum(x*w)
y <- y - apply( t(y) * w, 2, sum )
# Compute the variance
vx <- sum( w * x * x )
vy <- rowSums( w * y * y ) # Incorrect: see Heather's remark, in the other answer
# Compute the covariance
vxy <- colSums( t(y) * x * w )
# Compute the correlation
vxy / sqrt(vx * vy)
}
f(x,y)[1]
cor(x,y[1,]) # Identical
f(x, y, xy.wt)
Here is a generalization to compute the weighted Pearson correlation between two matrices (instead of a vector and a matrix, as in the original question):
matrix.corr <- function (a, b, w = rep(1, nrow(a))/nrow(a))
{
# normalize weights
w <- w / sum(w)
# center matrices
a <- sweep(a, 2, colSums(a * w))
b <- sweep(b, 2, colSums(b * w))
# compute weighted correlation
t(w*a) %*% b / sqrt( colSums(w * a**2) %*% t(colSums(w * b**2)) )
}
Using the above example and the correlation function from Heather, we can verify it:
> sum(matrix.corr(as.matrix(x, nrow=34),t(y),xy.wt) - f2(x,y,xy.wt))
[1] 1.537507e-15
In terms of calling syntax, this resembles the unweighted cor:
> a <- matrix( c(1,2,3,1,3,2), nrow=3)
> b <- matrix( c(2,3,1,1,7,3,5,2,8,1,10,12), nrow=3)
> matrix.corr(a,b)
[,1] [,2] [,3] [,4]
[1,] -0.5 0.3273268 0.5 0.9386522
[2,] 0.5 0.9819805 -0.5 0.7679882
> cor(a, b)
[,1] [,2] [,3] [,4]
[1,] -0.5 0.3273268 0.5 0.9386522
[2,] 0.5 0.9819805 -0.5 0.7679882