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))
I want to solve the optimazation problem to search best weights for groups of vectors. Would you like to give some suggestions about how to solve it by R? Thanks very much.
The problem is as follows.
Given there are N groups, we know their similarity matrix among these N groups. The dimension of S is N*N.
In each group, there are K vectors . There are M elements in each vector which value is 0 or 1. .
we can fit an average vector based on these K vectors. For example, average vector
Based on these avearge vectors in each group, we could calculate the correlation among these avearge vectors.
The object is to minimize the differene between correlation matrix C and known similarity matrix S.
Beacuse you didn't provide any data I will generate random and demonstrate way you can approach your problem.
Similarity matrix:
N <- 6
S <- matrix(runif(N^2, -1, 1), ncol = N, nrow = N)
similarity_matrix <- (S + t(S)) / 2
N is number of groups. Each value of similarity matrix is between -1 and 1 and matrix is symmetric (beacuse you want to compare it to covariance matrix these makes sense).
group vectors:
M <- 10
K <- 8
group_vectors <- replicate(N, replicate(K, sample(c(0, 1), M, TRUE)), FALSE)
M is dimension of vector and K is number of binary vectors in each group.
fitness function
fitness <- function(W, group_vectors, similarity_matrix){
W <- as.data.frame(matrix(W, nrow = K, ncol = N))
SS <- cov(
mapply(function(x,y) rowSums(sweep(x, 2, y, "*")), group_vectors, W)
)
sum(abs(SS - similarity_matrix))
}
fitness for given weights calculates described covariance matrix and its distance from similarity_matrix.
differential evolution approach
res <- DEoptim::DEoptim(
fn = fitness,
lower = rep(-1, K*N),
upper = rep(1, K*N),
group_vectors = group_vectors,
similarity_matrix = similarity_matrix,
control = DEoptim::DEoptim.control(VTR = 0, itermax = 1000, trace = 50, NP = 100)
)
W <- matrix(res$optim$bestmem, nrow = K, ncol = N)
genetic algorithm approach
res <- GA::ga(
type = "real-valued",
fitness = function(W, ...) -fitness(W, ...),
lower = rep(-1, K*N),
upper = rep(1, K*N),
group_vectors = group_vectors,
similarity_matrix = similarity_matrix,
maxiter = 10000,
run = 200
)
W <- matrix(res#solution[1,], nrow = K, ncol = N)
Is there a way to fix the signs of the eigenvectors as returned by eigen or svd? princomp() has a fix_sign argument, which when set to TRUE, forces the first element of each eigenvector column to be positive. Does eigen or svd have something similar?
eigen and svd are preferred because I want to directly work with X'X, without scaling, centering etc.
I know that it is possible to replicate this effects of this by specifying X'X as a covmat argument to princomp, but this is a little unwieldy.
set.seed(123)
X <- data.frame(
x1 = arima.sim(list(ar = 0.5), n = 100),
x2 = arima.sim(list(ar = 0.5), n = 100),
x3 = arima.sim(list(ar = 0.5), n = 100)
) |> as.matrix()
eigen(t(X) %*% X)$vectors
svd(t(X) %*% X)
# This below approach works, but is a little unwieldy
princomp(covmat = t(X) %*% X, fix_sign = TRUE)
N <- 1000
arr_p_True <- runif(N)
arr_simulated <- sapply(arr_p_True, function(p) {
sample(c(T, F), 1, prob = c(p, 1 - p))
})
arr_p_True is what I want to get, but with very large N this is very inefficient. sample() does not seem to be the right function to consider in this case, because it is vectorized over the probability of choosing each of the elements in x, but not vectorized over the probability of choosing the first element in x as required in my example.
I cannot find the right keyword for the purpose... I keep on being directed back to sample(). Any help is appreciated.
I think you can do
arr_p_True <- runif(N)
as.logical(rbinom(N, size = 1, prob = arr_p_True))
But if arr_p_True is runif(N) in your real code, then this is equivalent to
as.logical(rbinom(N, size = 1, prob = 0.5))
You could generate a vector of random numbers from the unit interval. With probability p the value will be smaler than p:
N <- 1000
arr_p_True <- runif(N)
arr_simulated <- runif(N) < arr_p_True
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