在 R 中创建自定义距离矩阵函数

Question

我的任务是创建基于自定义距离度量的距离矩阵函数。 距离度量如下：

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

其中 u 和 v 是向量，w 是权重。

我要解决的问题：

我要创建一个距离矩阵函数 create-dm(x,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 的数据框，其中： 一个：（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

创建-dm(x,w)=

0     1.5   4.6

1.5   0     3.1

4.6   3.1   0

Answer 1

我最近遇到了类似的问题。我的最终解决方案是使用 Rcpp 包用 C++ 编写它。将此代码另存为 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++ 解决方案仍然更快。