Question

我有以下功能：http://i.stack.imgur.com/yXA67.png，其中 mu 是矩阵（n_X行和n_Y列）。 d_X和d_Y是距离矩阵。

在R中实现此功能的一种方法是：

H_mu <- function(mu, d_X, d_Y){

    value <- 0
    for(i in 1:nrow(d_X)){
       for(ii in 1:nrow(d_X)){
          for(j in 1:nrow(d_Y)){
             for(jj in 1:nrow(d_Y)){
                value <- value + mu[i,j]*mu[ii,jj]*abs(d_X[i,ii]-d_Y[j,jj])
          }}}} 
}

例如：

X <- matrix(rep(1,50),nrow = 50)
Y <- matrix(c(1:50),nrow = 50)
d_X <- as.matrix(dist(X, method = "euclidean", diag = T, upper = T))
d_Y <- as.matrix(dist(Y, method = "euclidean", diag = T, upper = T)) 
mu <- matrix(1/50, nrow = nrow(X), ncol = nrow(Y))

H_mu(mu, d_X, d_Y)
[1] 41650

> system.time(H_mu(mu, d_X, d_Y))
   user  system elapsed 
  22.67    0.01   23.06

仅用50分计算需要23秒。

如何加快这项功能？

Answer 1

似乎@Marat Talipov的建议还有很长的路要走。如果您不熟悉C ++编码，可以使用typedFunction为简单的R函数自动生成Rcpp代码。它接受R函数及其参数及其类型，假设有明确的return调用，并返回文本代码。

 H_mu <- function(mu, d_X, d_Y){      
  value <- 0
  for(i in 1:nrow(d_X)){
    for(ii in 1:nrow(d_X)){
      for(j in 1:nrow(d_Y)){
        for(jj in 1:nrow(d_Y)){
          value <- value + mu[i,j]*mu[ii,jj]*abs(d_X[i,ii]-d_Y[j,jj])
        }}}} 
  return (value)
}

此处我已将return(value)添加到您的H_mu功能

text <- typedFunction(H_mu, H_mu='double', value='double',
              mu='NumericVector',
              d_X='NumericVector',
              d_Y='NumericVector',
              i='int',
              ii='int',
              jj='int',
              j='int')
cat(text)

将结果复制粘贴到您的Rcpp编辑器中，经过一些小的调整后，您就拥有了可执行的H_mu_typed函数。

Rcpp::cppFunction('double H_mu_typed(NumericMatrix mu, NumericMatrix d_X, NumericMatrix d_Y) {
  double value=0;
                  value = 0;
                  for (int i = 0; i <d_X.nrow(); i++) {
                  for (int ii = 0; ii < d_X.nrow(); ii++) {
                  for (int j = 0; j < d_Y.nrow(); j++) {
                  for (int jj = 0; jj < d_Y.nrow(); jj++) {
                  value = value + mu(i, j) * mu(ii, jj) * abs(d_X(i, ii) - d_Y(j, jj));
                  };
                  };
                  };
                  };
                  return(value);
                  }
                  ')

享受C ++速度。

H_mu_typed(mu, d_X, d_Y)
[1] 41650

system.time(H_mu_typed(mu, d_X, d_Y))[3]
elapsed 
   0.01

Answer 2

这样可以为每个循环节省2个名字查找和一个函数调用（即[），这样可以快8％（所以真的@Marat Talipov＆＃39的建议是要走的路）：

H_mu_2 <- function(mu, d_X, d_Y){
    value <- 0
    for(i in 1:nrow(d_X))
    for(j in 1:nrow(d_Y)){
        tmp <- mu[i,j]
        for(ii in 1:nrow(d_X))
        for(jj in 1:nrow(d_Y)){
            value <- value + tmp*mu[ii,jj]*abs(d_X[i,ii]-d_Y[j,jj])
        }} 
}

如何使功能更快？

2 个答案: