R_Language 板


LINE

[关键字]: bsxfun in R [出处]: http://stackoverflow.com/questions/3643555/multiply-rows-of-matrix-by-vector [重点摘要]: pastebin link: http://pastebin.com/jGtHeYuj M = 3 N = 5 (mat = replicate(N, 1:M)) # [,1] [,2] [,3] [,4] [,5] # [1,] 1 1 1 1 1 # [2,] 2 2 2 2 2 # [3,] 3 3 3 3 3 (vec = 1:N) # [1] 1 2 3 4 5 (sweep(mat, MARGIN=2, vec,`+`)) # [,1] [,2] [,3] [,4] [,5] # [1,] 2 3 4 5 6 # [2,] 3 4 5 6 7 # [3,] 4 5 6 7 8 (sweep(mat, MARGIN=2, vec,`*`)) # [,1] [,2] [,3] [,4] [,5] # [1,] 1 2 3 4 5 # [2,] 2 4 6 8 10 # [3,] 3 6 9 12 15 (sweep(mat, MARGIN=2, vec,`/`)) # [,1] [,2] [,3] [,4] [,5] # [1,] 1 0.5 0.3333333 0.25 0.2 # [2,] 2 1.0 0.6666667 0.50 0.4 # [3,] 3 1.5 1.0000000 0.75 0.6 (sweep(mat, MARGIN=2, vec,`-`)) # [,1] [,2] [,3] [,4] [,5] # [1,] 0 -1 -2 -3 -4 # [2,] 1 0 -1 -2 -3 # [3,] 2 1 0 -1 -2 (sweep(mat, MARGIN=2, vec, pmax)) # [,1] [,2] [,3] [,4] [,5] # [1,] 1 2 3 4 5 # [2,] 2 2 3 4 5 # [3,] 3 3 3 4 5 (sweep(mat, MARGIN=2, vec, pmin)) # [,1] [,2] [,3] [,4] [,5] # [1,] 1 1 1 1 1 # [2,] 1 2 2 2 2 # [3,] 1 2 3 3 3 ## usage in scaling N = 10; p = 3 dat = matrix(rnorm(N*p), N) dat_standardized = sweep(sweep(dat, 2, colMeans(dat)), 2, apply(dat, 2, sd), '/') dat_normalized = sweep(sweep(dat, 2, apply(dat, 2, min)), 2, apply(dat, 2, function(x) diff(range(x))), '/') ## usage in computing kernel kernelMatrix_f = function(X, center, sigma){ exp(sweep(sweep(X %*% t(center), 1, rowSums(X**2)/2), 2, rowSums(center**2)/2) / (sigma**2)) } ## compare with Rcpp and kernlab library(kernlab) library(Rcpp) library(RcppArmadillo) sourceCpp(code = ' // [[Rcpp::depends(RcppArmadillo)]] #include <RcppArmadillo.h> using namespace Rcpp; using namespace arma; // [[Rcpp::export]] NumericMatrix kernelMatrix_cpp(NumericMatrix Xr, NumericMatrix Centerr, double sigma) { uword n = Xr.nrow(), b = Centerr.nrow(), row_index, col_index; mat X(Xr.begin(), n, Xr.ncol(), false), Center(Centerr.begin(), b, Centerr.ncol(), false), KerX(X*Center.t()); colvec X_sq = sum(square(X), 1) / 2; rowvec Center_sq = (sum(square(Center), 1)).t() / 2; KerX.each_row() -= Center_sq; KerX.each_col() -= X_sq; KerX *= 1 / (sigma * sigma); KerX = exp(KerX); return wrap(KerX); }') N = 8000 p = 500 b = 1000 X = matrix(rnorm(N*p), ncol = p) center = X[sample(1:N, b),] sigma = 3 all.equal(kernelMatrix(rbfdot(sigma=1/(2*sigma^2)), X, center)@.Data, kernelMatrix_cpp(X, center, sigma)) # TRUE all.equal(kernelMatrix(rbfdot(sigma=1/(2*sigma^2)), X, center)@.Data, kernelMatrix_f(X, center, sigma)) # TRUE library(microbenchmark) microbenchmark(Rfun = kernelMatrix_f(X, center, sigma), kernlab = kernelMatrix(rbfdot(sigma=1/(2*sigma^2)), X, center), Rcpp = kernelMatrix_cpp(X, center, sigma), times = 20L ) # Unit: milliseconds # expr min lq mean median uq max neval # Rfun 872.8854 981.1995 1036.2209 1074.0526 1098.9185 1132.9356 20 # kernlab 773.7489 841.9028 1059.3098 862.7476 883.3874 2979.2541 20 # Rcpp 490.2462 501.2993 520.1283 522.5060 532.5426 571.0949 20 速度不输package: kernlab。 --



※ 发信站: 批踢踢实业坊(ptt.cc), 来自: 36.225.212.167
※ 文章网址: https://webptt.com/cn.aspx?n=bbs/R_Language/M.1429191476.A.F82.html
1F:→ Wush978: 这不知道能不能用BLAS算 04/16 22:51
DGER可以做 A = alpha*x*y' + A (+, -的case) alpha: constant, x: m by 1, y: 1 by n, A: m by n x 对应到上面的vec y 是全部都1的向量 A 是mat alpha = 1 http://tinyurl.com/mqwv2hc
2F:→ Wush978: 就我的理解,你应该直接#include "cblas.h"然後和R 04/17 01:50
3F:→ Wush978: linking就可以了。因为R应该内带blas 04/17 01:50
4F:→ Wush978: 另外没意外的话,用blas可能会是最快的算法 04/17 01:51
不过现在看起来BLAS能做的case只有+/-,*或是/或是min, max都无法
5F:推 penolove5566: 谢分享 04/17 02:20
6F:→ clickhere: 那是fortran函式,用 include "R_ext/BLAS.h" 04/17 02:53
也试过了 ※ 编辑: celestialgod (36.225.212.167), 04/17/2015 14:43:28







like.gif 您可能会有兴趣的文章
icon.png[问题/行为] 猫晚上进房间会不会有憋尿问题
icon.pngRe: [闲聊] 选了错误的女孩成为魔法少女 XDDDDDDDDDD
icon.png[正妹] 瑞典 一张
icon.png[心得] EMS高领长版毛衣.墨小楼MC1002
icon.png[分享] 丹龙隔热纸GE55+33+22
icon.png[问题] 清洗洗衣机
icon.png[寻物] 窗台下的空间
icon.png[闲聊] 双极の女神1 木魔爵
icon.png[售车] 新竹 1997 march 1297cc 白色 四门
icon.png[讨论] 能从照片感受到摄影者心情吗
icon.png[狂贺] 贺贺贺贺 贺!岛村卯月!总选举NO.1
icon.png[难过] 羡慕白皮肤的女生
icon.png阅读文章
icon.png[黑特]
icon.png[问题] SBK S1安装於安全帽位置
icon.png[分享] 旧woo100绝版开箱!!
icon.pngRe: [无言] 关於小包卫生纸
icon.png[开箱] E5-2683V3 RX480Strix 快睿C1 简单测试
icon.png[心得] 苍の海贼龙 地狱 执行者16PT
icon.png[售车] 1999年Virage iO 1.8EXi
icon.png[心得] 挑战33 LV10 狮子座pt solo
icon.png[闲聊] 手把手教你不被桶之新手主购教学
icon.png[分享] Civic Type R 量产版官方照无预警流出
icon.png[售车] Golf 4 2.0 银色 自排
icon.png[出售] Graco提篮汽座(有底座)2000元诚可议
icon.png[问题] 请问补牙材质掉了还能再补吗?(台中半年内
icon.png[问题] 44th 单曲 生写竟然都给重复的啊啊!
icon.png[心得] 华南红卡/icash 核卡
icon.png[问题] 拔牙矫正这样正常吗
icon.png[赠送] 老莫高业 初业 102年版
icon.png[情报] 三大行动支付 本季掀战火
icon.png[宝宝] 博客来Amos水蜡笔5/1特价五折
icon.pngRe: [心得] 新鲜人一些面试分享
icon.png[心得] 苍の海贼龙 地狱 麒麟25PT
icon.pngRe: [闲聊] (君の名は。雷慎入) 君名二创漫画翻译
icon.pngRe: [闲聊] OGN中场影片:失踪人口局 (英文字幕)
icon.png[问题] 台湾大哥大4G讯号差
icon.png[出售] [全国]全新千寻侘草LED灯, 水草

请输入看板名称,例如:Soft_Job站内搜寻

TOP