Расстояние Махаланобиса каждой пары наблюдений

Question

Я пытаюсь вычислить расстояние Махаланобиса между каждым наблюдением набора данных dat, где каждая строка является наблюдением, а каждый столбец является переменной. Такое расстояние определяется как:

Я написал функцию, которая делает это, но я чувствую, что это очень медленный процесс. Есть ли лучший способ вычислить это в R?

Для создания некоторых данных для тестирования функции:

generateData <- function(nObs, nVar){ 
    library(MASS) 
    mvrnorm(n=nObs, rep(0,nVar), diag(nVar)) 
    } 

Это функция, которую я написал до сих пор. Они работают и для моих данных (800 общ и 90 переменных), для method = "forLoop" и method = "apply" требуется приблизительно 30 и 33 секунды соответственно.

mhbd_calc2 <- function(dat, method) { #Method is either "forLoop" or "apply" 
    dat <- as.matrix(na.omit(dat)) 
    nObs <- nrow(dat) 
    mhbd <- matrix(nrow=nObs,ncol = nObs) 
    cv_mat_inv = solve(var(dat)) 

    distMH = function(x){ #Mahalanobis distance function 
    diff = dat[x[1],]-dat[x[2],] 
    diff %*% cv_mat_inv %*% diff 
    } 

    if(method=="forLoop") 
    { 
    for (i in 1:nObs){ 
     for(j in 1:i){ 
     mhbd[i,j] <- distMH(c(i,j)) 
     } 
    } 
    } 
    if(method=="apply") 
    { 
    mhbd[lower.tri(mhbd)] = apply(combn(nrow(dat),2),2, distMH) 
    } 
    result = sqrt(mhbd) 
    colnames(result)=rownames(dat) 
    rownames(result)=rownames(dat) 
    return(as.dist(result)) 
} 

NB: Я попытался с помощью outer(), но это было еще медленнее (60seconds)

Answer 1

Вы нужны математические знания.

1. Сделайте cholesky факторизацию эмпирической ковариации, затем стандартизируйте свои наблюдения;
2. использовать dist для вычисления евклидова расстояния по преобразованным наблюдениям.

---

dist.maha <- function (dat) { 
    X <- as.matrix(na.omit(dat)) ## ensure a valid matrix 
    V <- cov(X) ## empirical covariance; positive definite 
    L <- t(chol(V)) ## lower triangular factor 
    stdX <- t(forwardsolve(L, t(X))) ## standardization 
    dist(stdX) ## use `dist` 
    } 

Пример

set.seed(0) 
x <- matrix(rnorm(6 * 3), 6, 3) 

dist.maha(x) 
#   1  2  3  4  5 
#2 2.362109          
#3 1.725084 1.495655       
#4 2.959946 2.715641 2.690788     
#5 3.044610 1.218184 1.531026 2.717390   
#6 2.740958 1.694767 2.877993 2.978265 2.794879 

Результат согласуется с mhbd_calc2.