作者celestialgod (天)
看板R_Language
标题Re: [问题] 关於这段程式码 要如何优化?
时间Sat Mar 12 01:52:25 2016
※ 引述《jackhzt (巴克球)》之铭言：
: [问题类型]:
: 效能谘询(我想让R 跑更快)
: [软体熟悉度]:
: 使用者(已经有用R 做过不少作品)
: [问题叙述]:如何将以下的程式码跑快一点
: [程式范例]:R中的dist这function 因为想使用不同的计算方式，所以希望可以做到
: 和此function表现差不多的function
: 程式码可贴於以下网站：
: https://gist.github.com/anonymous/cf844933bb6858936e25
: 希望有提高效率的方法
1. 如果距离函数是常见的，通常建议用dist达成
2. 如果不常见，尽量考虑用矩阵运算求出来
EX: (以欧式距离来说)
library(magrittr)
x <- matrix(rnorm(50), 5, 10)
distMat <- sweep(-x %*% t(x) * 2, 2, rowSums(x^2), '+') %>%
sweep(1, rowSums(x^2), '+')
diag(distMat) <- 0
distMat %<>% sqrt
all.equal(distMat, as.matrix(dist(x)), check.attributes = FALSE) # TRUE
3. 用简单的平行，我可能会这样做：
library(magrittr)
library(foreach)
library(doSNOW)
library(plyr)
library(Matrix)
dis <- function(x, y) sum(abs(as.numeric(x)-as.numeric(y)))
x <- matrix(rnorm(50), 5, 10)
allCombinations <- combn(1:nrow(x), 2)
cl <- makeCluster(8, type = "SOCK")
registerDoSNOW(cl)
clusterExport(cl, list = c("dis", "x"))
res <- aaply(allCombinations, 2, function(v){
dis(x[v[1],], x[v[2],])
}, .parallel = TRUE)
stopCluster(cl)
distMat <- sparseMatrix(i = allCombinations[1,],
j = allCombinations[2,], x = res) %>%
rbind(0) %>% as.matrix
distMat[lower.tri(distMat)] <- res
4. 或是乾脆用RcppArmadillo:
(下面是用之前kernel matrix估计的方法，之前有发过更快的方法...)
library(Rcpp)
library(RcppArmadillo)
## For windows user
# library(inline)
# settings <- getPlugin("Rcpp")
# settings$env$PKG_CXXFLAGS <- paste('-fopenmp', settings$env$PKG_CXXFLAGS)
# settings$env$PKG_LIBS <- paste('-fopenmp -lgomp', settings$env$PKG_LIBS)
# do.call(Sys.setenv, settings$env)
sourceCpp(code = '
// [[Rcpp::depends(RcppArmadillo)]]
#include <RcppArmadillo.h>
#include <omp.h>
// [[Rcpp::plugins(openmp)]]
using namespace Rcpp;
using namespace arma;
// [[Rcpp::export]]
NumericMatrix kernelMatrix_cpp(NumericMatrix Xr, NumericMatrix Centerr,
double sigma) {
omp_set_num_threads(omp_get_max_threads());
uword n = Xr.nrow(), b = Centerr.nrow(), row_index, col_index;
mat X(Xr.begin(), n, Xr.ncol(), false);
mat Center(Centerr.begin(), b, Centerr.ncol(), false);
mat KerX(n, b);
#pragma omp parallel private(row_index, col_index)
for (row_index = 0; row_index < n; row_index++)
{
#pragma omp for nowait
for (col_index = 0; col_index < b; col_index++)
{
KerX(row_index, col_index) = exp(sum(square(X.row(row_index)
- Center.row(col_index))) / (-2.0 * sigma * sigma));
}
}
return wrap(KerX);
}')
--
R资料整理套件系列文：
magrittr #1LhSWhpH (R_Language) http://tinyurl.com/1LhSWhpH
data.table #1LhW7Tvj (R_Language) http://tinyurl.com/1LhW7Tvj
dplyr(上) #1LhpJCfB (R_Language) http://tinyurl.com/1LhpJCfB
dplyr(下) #1Lhw8b-s (R_Language)
tidyr #1Liqls1R (R_Language) http://tinyurl.com/1Liqls1R
--
※ 发信站: 批踢踢实业坊(ptt.cc), 来自: 140.109.73.238
※ 文章网址: https://webptt.com/cn.aspx?n=bbs/R_Language/M.1457718749.A.B23.html
※ 编辑: celestialgod (140.109.73.238), 03/12/2016 01:55:02
1F：推 jackhzt: 感谢大大 <303/12 02:03
2F：推 jackhzt: 问一下 <anonymous>: ... may be used in an incorrect03/12 03:27
3F：→ jackhzt: context: ‘.fun(piece, ...)出现这是正常的吗?03/12 03:27
正常
4F：推 jackhzt: 再请教一下 在後面一定要加.parallel = TRUE才有平行运03/12 03:42
对
5F：→ jackhzt: 还有参考以前的文章 使用平行时 如果不使用parApply03/12 03:43
6F：→ jackhzt: 或是其他 parCapply等等的函数 依然会有加速的效果吗?03/12 03:44
没有
7F：→ jackhzt: 刚刚看了大大的教学 开始读了些平行运算的东西03/12 03:45
8F：→ jackhzt: 还是蛮多不懂的地方03/12 03:46
可以回文继续问
9F：推 jackhzt: 试做3000多条向量，使用snow好像依样跑不太动...03/12 17:43
po一下你的计算公式，我测试看看
10F：推 jackhzt: 我用的也是测试用的 实际的公式还在推 目前尝试的是用 03/12 18:24
11F：→ jackhzt: dis = function(x, y)sum(as.numeric(x)!=as.numeric(y)) 03/12 18:24
12F：→ jackhzt: x为 R17的向量 03/12 18:25
13F：→ jackhzt: 都是类别变数 1～4 03/12 18:26
请问什麽是R17？
14F：推 jackhzt: X1=[x11,x12,x13...x17] 03/12 19:34
15F：→ jackhzt: 向量数为 X1,X2,X3...X3000 03/12 19:35
这个可以向量化运算，我写了一个比较
你可以测试看看双回圈跟向量化运算的差异
能向量化的方法绝对不要用for or apply：
http://pastebin.com/y8gC3ap7
16F：推 jackhzt: 谢谢大大 我认真研读一下 感激涕零~ 03/12 20:03
不客气，简单平行还太慢就得想办法(摊手
※ 编辑: celestialgod (180.218.152.118), 03/12/2016 20:11:27