Создать собственную матричную функцию расстояния в R

Question

Мне поручено создать матричную функцию расстояния на основе определенной пользователем меры расстояния.Мера расстояния следующая:

wabs_dist = function(u, v, w){
   return( sum((abs(u-v))*w) )
}

Где u и v - векторы, а w - вес.

Проблема, которую я должен решить:

Я должен создать функцию матрицы расстояний create-dm (x, w), которая возвращает матрицу расстояний для объектов в фрейме данных x, вызывая wabs-дист (a, b, w) для всех пар объектов a и b, принадлежащих x.Если x является набором данных с 4 атрибутами, то w является вектором, например, w = c (1,1,3,2), назначенным каждому атрибуту.Да, уже есть стандартные функции, такие как dist (), но я должен создать свою собственную, используя wabs_dist.

Мое решение до сих пор:

create_dm = function(x, w){ #x is a dataframe
distances = matrix(0, nrow = nrow(x), ncol = nrow(x))
for (i in 1:nrow(x)) {
 for(j in 1:(i-1)){
     distances[i, j] = wabs_dist(x[i,], x[j,], w)
     distances[j, i] = distances[i, j]
   }
}
 return(distances)  
}

Как реализовать вектор весов, потому что я написал эту функцию с мыслью о передаче только одного веса, но теперь мне нужно записать его впринять список.Как я могу реализовать эту функцию, используя список весов?

Эта функция занимает много времени для запуска.На самом деле он никогда не печатает матричную функцию расстояния.Я не могу понять, почему

Пример:

Пусть x будет фреймом данных, содержащим векторы a, b и c, где: a: (1, 2) b: (4, 5) c: (9, 12)

w - весовой вектор: (0,2, 0,3)

wabs-dist (a, b, w) = 1,5 wabs-dist (b, c, w)= 3.1

create-dm (x, w) =

0     1.5   4.6

1.5   0     3.1

4.6   3.1   0

Answer 1

У меня была похожая проблема в последнее время.Мое окончательное решение было написать на C ++ с пакетом Rcpp.Сохраните этот код как dmat.cpp

#include <Rcpp.h>

using namespace Rcpp;


// [[Rcpp::export]]
NumericMatrix dmat(NumericMatrix x, NumericVector w) {
  int n = x.nrow();
  NumericMatrix d = no_init_matrix(n, n);

  for(int i=0; i<n;i++){
    for(int j=i+1; j<n;j++){
      d(i,j)=sum(w*abs((x(i,_)-x(j,_))));
      d(j,i)=d(i,j);
    }

    d(i,i)=0;

  }
  return d;
}

Затем установите и загрузите пакет "Rcpp" и используйте sourceCpp() для загрузки функции.После этого вы можете использовать его как любую другую функцию R

library(Rcpp)
sourceCpp("path/to/file/dmat.cpp")

x <- matrix(rnorm(1500),ncol=3)
w <- 1:3

system.time(distR <- create_dm(x,w))
       User      System verstrichen 
   1.81        0.02        1.84 

system.time(distCpp <- dmat(x,w))
       User      System verstrichen 
      0           0           0

identical(round(distR,10), round(distCpp,10))
[1] TRUE

Если вы просто используете identical() без округления, это дает FALSE.Не знаю почему.Возможно, на это может ответить кто-то еще.

Если вы можете использовать евклидово расстояние вместо абсолютного расстояния, вы можете использовать пакет apcluster.Это было мое первое решение.Но решение C ++ было еще быстрее.