Related
I need to find the value of a parameter which make my function produce a specific result.
I write down something like this:
## Defining the function
f = function(a, b, c, x) sqrt(t(c(a, b, c, x)) %*% rho %*% c(a, b, c, x))
## Set di input needed
rho <- matrix(c(1,0.3,0.2,0.4,
0.3,1,0.1,0.1,
0.2,0.1,1,0.5,
0.4,0.1,0.5,1),
nrow = 4, ncol = 4)
target <- 10000
## Optimize
output <- optimize(f, c(0, target), tol = 0.0001, a = 1000, b = 1000, c = 1000, maximum = TRUE)
I would like to derive di value of x related to the maximum of my function (the target value).
Thanks,
Ric
You can find one such x with closed formula. For symmetric matrices (like the one you have) you can achieve target value by vector x where x is defined as:
spectral_decomp <- eigen(rho, TRUE)
eigen_vec1 <- spectral_decomp$vectors[,1]
lambda1 <- spectral_decomp$values[[1]]
target <- 1000
x <- (target / sqrt(lambda1)) * eigen_vec1
check:
sqrt(matrix(x, nrow = 1) %*% rho %*% matrix(x, ncol = 1))
Here's the code:
function (n = 1, mu, Sigma, tol = 1e-06, empirical = FALSE, EISPACK = FALSE)
{
p <- length(mu)
if (!all(dim(Sigma) == c(p, p)))
stop("incompatible arguments")
if (EISPACK)
stop("'EISPACK' is no longer supported by R", domain = NA)
eS <- eigen(Sigma, symmetric = TRUE)
ev <- eS$values
if (!all(ev >= -tol * abs(ev[1L])))
stop("'Sigma' is not positive definite")
X <- matrix(rnorm(p * n), n)
if (empirical) {
X <- scale(X, TRUE, FALSE)
X <- X %*% svd(X, nu = 0)$v
X <- scale(X, FALSE, TRUE)
}
X <- drop(mu) + eS$vectors %*% diag(sqrt(pmax(ev, 0)), p) %*%
t(X)
nm <- names(mu)
if (is.null(nm) && !is.null(dn <- dimnames(Sigma)))
nm <- dn[[1L]]
dimnames(X) <- list(nm, NULL)
if (n == 1)
drop(X)
else t(X)
}
The line in question I am curious about is this:
x <- eS$vectors %*% diag(sqrt(ev)) %*% t(x) # ignoring drop(mu)
...
t(x)
Why is it that
X^T = UVZ^T, where Z is a standardized MVN?
I had thought that this would be X = UVZ, where X ~ MVN(0, UV(I)(UV)^T) = MVN(0, Sigma)?
In response to Siong Thye Goh's answer:
I can see the algebra, and that it does work only doing it this way by just considering the dimensions, but the whole act of transposing everything seems strange to do considering the properties of a multivariate normal. That is, X = UVZ
I did some reviewing and I found that this is actually a Matrix Normal, and the affine transformation there works in the similar fashion. That is, X = Z (UV)^T.
I'm not sure if there is just something silly I'm missing in understanding this or if I'm missing the picture altogether on why everything is transposed in regards to, say, Wikipedias Affine Transformation of a MVN
U is the eigenvector of Sigma. That is Sigma = UV^2 U^T, where V is a diagonal matrix.
Let's compute the covariance matrix E[X^TX] and see if it is equal to Sigma where X=UVZ^T and Z^T satisfy E[Z^TZ]=I, the identity matrix.
We have
E[X^TX]=E[UVZ^TZVU^T]=UVE[Z^TZ]VU^T=UV^2U^T=Sigma
I need to speed up the calculation of the inverse of a WLS covariance matrix in R, where the matrix, wls.cov.matrix, is given by (full example below):
n = 10000
X = matrix(c(rnorm(n,1,2), sample(c(1,-1), n, replace = TRUE), rnorm(n,2,0.5)), nrow = 1000, ncol = 3)
Q = diag(rnorm(n, 1.5, 0.3))
wls.cov.matrix = solve(t(X)%*%diag(1/diag(Q))%*%X)
Is it possible to speed up this calculation?
MORE INFO VERY RELEVANT TO THE FINAL GOAL:
This is still little information, let me explain more my goal and will be clearer if there are ways to speed up my code.
I run 1,0000s of times wls.cov.matrix so I need it to be much faster.
However, each time I run it I use the same X, the only matrix that changes is Q, which is a diagonal matrix.
If X was a square matrix, of same dim as Q, I could just precompute X^-1 and (X^T)^(-1),
X.inv = solve(X)
X.inv.trans = solve(t(X))
and then for each iteration run:
Q.inv = diag(1/diag(Q))
wls.cov.matrix = X.inv%*%Q.inv%*%X.inv.trans
But my X is not square, so is there any other trick?
The main time-consuming part here is t(X)%*%diag(1/diag(Q))%*%X, not the calculation of its inverse.
A nice trick is to calculate it as
crossprod(X / sqrt(diag(Q)));
Confirmation:
all.equal( (t(X) %*% diag(1/diag(Q)) %*% X) , crossprod(X / sqrt(diag(Q))) );
[1] TRUE
To compare the timing run:
Qdiag = diag(Q);
system.time({(t(X) %*% diag(1/Qdiag) %*% X)})
system.time({crossprod(X / sqrt(Qdiag))})
Well, Q is a diagonal matrix, so its inverse is just given by the inverses of the diagonal entries. You can thus do
X = matrix(c(rnorm(n,1,2), sample(c(1,-1), n, replace = TRUE), rnorm(n,2,0.5)), nrow = 1000, ncol = 3)
Qinv = diag(1/rnorm(n, 1.5, 0.3))
wls.cov.matrix = solve(t(X)%*%Qinv%*%X)
And in fact, this speeds things up by about a factor of 20.
I have found the mahalanobis.dist function in package StatMatch (http://cran.r-project.org/web/packages/StatMatch/StatMatch.pdf) but it isn't doing exactly what I want. It seems to be calculating the mahalanobis distance from each observation in data.y to each observation in data.x
I would like to calculate the mahalanobis distance of one observation in data.y to all observations in data.x. Basically calculate a mahalanobis distance of one point to a "cloud" of points if that makes sense. Kind of getting at the idea of the probability of an observation being part of another group of observations
This person (http://people.revoledu.com/kardi/tutorial/Similarity/MahalanobisDistance.html) seems to be doing this and I've tried to replicate his process in R but it is failing when I get to the bottom part of the equation:
mahaldist = sqrt((inversepooledcov %*% t(meandiffmatrix)) %*% meandiffmatrix)
All the code I am working with is here:
a = rbind(c(2,2), c(2,5), c(6,5),c(7,3))
colnames(a) = c('x', 'y')
b = rbind(c(6,5),c(3,4))
colnames(b) = c('x', 'y')
acov = cov(a)
bcov = cov(b)
meandiff1 = mean(a[,1]) - mean(b[,1])
meandiff2 = mean(a[,2]) - mean(b[,2])
meandiffmatrix = rbind(c(meandiff1,meandiff2))
totaldata = dim(a)[1] + dim(b)[1]
pooledcov = (dim(a)[1]/totaldata * acov) + (dim(b)[1]/totaldata * bcov)
inversepooledcov = solve(pooledcov)
mahaldist = sqrt((inversepooledcov %*% t(meandiffmatrix)) %*% meandiffmatrix)
How about using the mahalanobis function in the stats package:
mahalanobis(x, center, cov, inverted = FALSE, ...)
I've been trying this out from the same website that you looked at and then stumbled upon this question. I managed to get the script to work, But I get a different result.
#WORKING EXAMPLE
#MAHALANOBIS DIST OF TWO MATRICES
#define matrix
mat1<-matrix(data=c(2,2,6,7,4,6,5,4,2,1,2,5,5,3,7,4,3,6,5,3),nrow=10)
mat2<-matrix(data=c(6,7,8,5,5,5,4,7,6,4),nrow=5)
#center data
mat1.1<-scale(mat1,center=T,scale=F)
mat2.1<-scale(mat2,center=T,scale=F)
#cov matrix
mat1.2<-cov(mat1.1,method="pearson")
mat2.2<-cov(mat2.1,method="pearson")
n1<-nrow(mat1)
n2<-nrow(mat2)
n3<-n1+n2
#pooled matrix
mat3<-((n1/n3)*mat1.2) + ((n2/n3)*mat2.2)
#inverse pooled matrix
mat4<-solve(mat3)
#mean diff
mat5<-as.matrix((colMeans(mat1)-colMeans(mat2)))
#multiply
mat6<-t(mat5) %*% mat4
#multiply
sqrt(mat6 %*% mat5)
I think the function mahalanobis() is used to compute mahalanobis distances between individuals (rows) in one matrix. The function pairwise.mahalanobis() from package(HDMD) can compare two or more matrices and give mahalanobis distances between the matrices.
You can wrap the function stats::mahalanobis as bellow to output a mahalanobis distance matrix (pairwise mahalanobis distances):
# x - data frame
# cx - covariance matrix; if not provided,
# it will be estimated from the data
mah <- function(x, cx = NULL) {
if(is.null(cx)) cx <- cov(x)
out <- lapply(1:nrow(x), function(i) {
mahalanobis(x = x,
center = do.call("c", x[i, ]),
cov = cx)
})
return(as.dist(do.call("rbind", out)))
}
Then, you can cluster your data and plot it, for example:
# Dummy data
x <- data.frame(X = c(rnorm(10, 0), rnorm(10, 5)),
Y = c(rnorm(10, 0), rnorm(10, 7)),
Z = c(rnorm(10, 0), rnorm(10, 12)))
rownames(x) <- LETTERS[1:20]
plot(x, pch = LETTERS[1:20])
# Comute the mahalanobis distance matrix
d <- mah(x)
d
# Cluster and plot
hc <- hclust(d)
plot(hc)
Your output before taking the square root is :
inversepooledcov %*% t(meandiffmatrix) %*% meandiffmatrix
[,1] [,2]
x -0.004349227 -0.01304768
y 0.114529639 0.34358892
I think you can'take the square root of negative numbers number, so you have NAN for negative elements:
sqrt(inversepooledcov %*% t(meandiffmatrix) %*% meandiffmatrix)
[,1] [,2]
x NaN NaN
y 0.3384223 0.5861646
Warning message:
In sqrt(inversepooledcov %*% t(meandiffmatrix) %*% meandiffmatrix) :
NaNs produced
Mahalanobis distance is equivalent to (squared) Euclidean distance if the covariance matrix is identity. If you have covariance between your variables, you can make Mahalanobis and sq Euclidean equal by whitening the matrix first to remove the covariance. I.e., do:
#X is your matrix
if (!require("whitening")) install.packages("whitening")
X <- whitening::whiten(X) # default is ZCA (Mahalanobis) whitening
X_dist <- dist(X, diag = T, method = "euclidean")^2
You can confirm that this gives you the same distance matrix as the code that Davit provided in one of the previous answers.
There a very easy way to do it using R Package "biotools". In this case you will get a Squared Distance Mahalanobis Matrix.
#Manly (2004, p.65-66)
x1 <- c(131.37, 132.37, 134.47, 135.50, 136.17)
x2 <- c(133.60, 132.70, 133.80, 132.30, 130.33)
x3 <- c(99.17, 99.07, 96.03, 94.53, 93.50)
x4 <- c(50.53, 50.23, 50.57, 51.97, 51.37)
#size (n x p) #Means
x <- cbind(x1, x2, x3, x4)
#size (p x p) #Variances and Covariances
Cov <- matrix(c(21.112,0.038,0.078,2.01, 0.038,23.486,5.2,2.844,
0.078,5.2,24.18,1.134, 2.01,2.844,1.134,10.154), 4, 4)
library(biotools)
Mahalanobis_Distance<-D2.dist(x, Cov)
print(Mahalanobis_Distance)
You can calculate Mahalanobis distance now through metan package. Refer functions mahala() and mahala_design(). Package documet
I'm trying to find the solution in the following problem:
Arbitrary values for reproducability:
AZ2k <- seq(1:14)
noAZ2k <- matrix(seq(1:25), 14, 50)
par <- rep(0.02 , 50)
vw <- function(w)
{
t(AZ2k - noAZ2k %*% par)%*%w%*%(AZ2k - noAZ2k %*% par )
}
vweights <- optim(diag(1,14), vw, gr = NULL,
method = c("L-BFGS-B"),
lower = 0, upper = 10000,control = list( factr = 1e4, maxit = 1000, pgtol = .01 ),
hessian = FALSE)
When I type in
t(AZ2k - noAZ2k %*% par)%*%diag(1,14)%*%(AZ2k - noAZ2k %*% par )
I get a result, however when I try to run the optimization it says that the values aren't fitting which is surprising to me.
I'm probably missing something totally obvious, but I just can't find where I went wrong, unless optim is just the wrong function to use, but I can't figure out the appropriate alternative.
Your w parameter is converted to a vector , so you need to coerce it to a matrix with the right dimensions:
vw <- function(w){
w <- matrix(w,nrow=14,ncol=14,byrow=T)
t(AZ2k - noAZ2k %*% par)%*%w%*%(AZ2k - noAZ2k %*% par )
}