Как получить среднее манхэттенское расстояние от каждой точки до других в наборе данных более быстро

Question

Я хочу более быстро получить среднее манхэттенское расстояние каждой точки до других в том же наборе данных: мы можем использовать функцию dist(), чтобы получить матрицу расстояний, но ее пространственная сложность слишком велика, чтобы этого избежать,мой код такой же, как и ниже: d - это набор данных, каждый столбец d - это точка, среднее расстояние Манхэттена между точкой и другими точками записано в векторе a, я хочу получить вектор aв конце концов.

d <- matrix(rnorm(100000), nrow = 2)
s <- ncol(d)
a <- vector("numeric", s)
for (i in 1:s)
{
  L1 <- abs(d[, i ] - d)
  a[i] <- sum(L1) / s
}

Answer 1

Я немного изменился в цикле Rcpp, это проще, но он не может сильно ускориться:

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]

NumericVector DSS_Rcpp(NumericMatrix d) {
  int nc=d.ncol();
  NumericVector a (nc);
  for(int i=0; i<nc; ++i){
    a(i)=sum(abs(rep(d( _ , i ),nc)-d));
  }
  return a;
}


/*** R
set.seed(0)
d <- matrix(rnorm(10000), nrow = 2)


DSS <- function(d) {
  s <- ncol(d)
  a <- vector("numeric", s)
  for (i in 1:s)
  {
    L1 <- abs(d[, i ] - d)
    a[i] <- sum(L1)
  }
  return(a)
}

library(microbenchmark)

microbenchmark(
  a1 <- DSS(d),
  a2 <- DSS_Rcpp(d),
  times = 10L
)

  */

Единица: миллисекунды

              expr      min       lq     mean   median   uq      max      neval cld

      a1 <- DSS(d) 125.4228 127.8480 134.4085 131.7876 134.3736 157.8660    10  a
 a2 <- DSS_Rcpp(d) 404.6676 407.1085 414.5449 409.6840 421.5335 433.7639    10   b 

Answer 2

У меня есть другой метод - использование пакета «purrr» ，, но он все еще немного медленнее

set.seed(0)
d <- matrix(rnorm(10000), nrow = 2)

DSS <- function(d) {
  s <- ncol(d)
  a <- vector("numeric", s)
  for (i in 1:s)
  {
    L1 <- abs(d[, i ] - d)
    a[i] <- sum(L1)
  }
  return(a)
}


dd=as.data.frame(d)

DSS_p <- function(v) {
  return(sum(abs(v-d)))
}


library("purrr")   
library(microbenchmark)

microbenchmark(
  a1 <- DSS(d),
  a2 <- map_dbl(dd, DSS_p),
  times = 10L
)

Единица: миллисекунды

                   expr      min       lq     mean   median       uq      max neval cld
            a1 <- DSS(d) 147.6936 151.5399 155.4522 154.9177 158.1982 167.6370    10  a 
a2 <- map_dbl(dd, DSS_p) 175.3692 181.0500 206.8654 184.5267 188.3336 320.7597    10   b

Answer 3

ниже - мой код Rcpp, но он медленнее, чем код R:

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]
NumericVector DSS_Rcpp(NumericMatrix d) {
  int nc=d.ncol();
  int nr=d.nrow();  
  NumericVector a (nc);
  NumericVector v (nc*nr);
  for(int i=0; i<nc; ++i){
    v=rep(d( _ , i ),nc);
    v.attr("dim") = Dimension(nr, nc);
    a(i)=sum(abs(v-d));
  }
  return a;
}


/*** R
set.seed(0)
d <- matrix(rnorm(10000), nrow = 2)


DSS <- function(d) {
  s <- ncol(d)
  a <- vector("numeric", s)
  for (i in 1:s)
  {
    L1 <- abs(d[, i ] - d)
    a[i] <- sum(L1)
  }
  return(a)
}

library(microbenchmark)

microbenchmark(
  a1 <- DSS(d),
  a2 <- DSS_Rcpp(d),
  times = 10L
)

  */

Unit: milliseconds
           expr      min       lq       mean   median     uq      max    neval cld 

      a1 <- DSS(d) 149.0534 150.8763 162.4359 151.4906 152.5008 249.0534    10  a 

 a2 <- DSS_Rcpp(d) 432.9250 433.5424 434.9274 434.2949 435.8276 438.6070    10   b