※ 引述《pk790127 (<>)》之铭言： : ※ 引述《pk790127 (<>)》之铭言： : : [问题类型]: : : [软体熟悉度]: : : 使用者(已经有用R 做过不少作品) : : 算是有学了一阵子,但感觉程式逻辑还是很差 : : [问题叙述]: : : [关键字]: dtw , 距离矩阵 ,两两比较 : : 以上 就是我的问题叙述,不晓得有没有表达清楚 : : 基本上就是多层回圈太慢了,我也正在尝试使用lapply家族进行运算 : : 谢谢~~ : 回应自己的问题,板友提出我的问题瓶颈不在於矩阵填值的部份,在於我修改的演算法上 : 实际上,我修改了dtw套件当中的dtw的函式,把权重的概念加进去 : 我测试了同笔资料用於原始dtw函式与我修改後的dtw(kai_dtw)函式去做运算时间的比较 : 果真...差了6秒多,问题在於我修改的函式!! (非常感谢两位版友) : dtw的程式码如下,我尽截录我修改的部份,只有增加一个矩阵并做相乘 : lm <- NULL : if (is.null(y)) { : if (!is.matrix(x)) : stop("Single argument requires a global cost matrix") : lm <- x : } : else if (is.character(dist.method)) { : x <- as.matrix(x) : y <- as.matrix(y) : lm <- proxy::dist(x, y, method = dist.method) #lm x,y 距离矩阵 : lm.v<- as.vector(lm) #转成vector# : weight<-vector() #weight function# : for(i in lm.v){ : tmp<-logisticWeight(i,median(lm.v),g) : weight<-c(weight,tmp) : } : lm.v_weight <- lm.v*weight #相乘# : lm<-matrix(lm.v_weight ,length(x),length(y)) #转回矩阵# : } : else if (is.function(dist.method)) { : stop("Unimplemented") : } : . : . : . : 红色表示我新增的部份,原始程式码下面还有很多,但我直接省略 : 在原始function中填入x与y目的是要计算距离矩阵lm : 我先将它转成vector的形式,并且利用logisticWeight函式(自己写的公式) : 并搭配for回圈逐一的给予Weight(vector的形式),再将lm.v与weight相乘 : 最後再转成适当大小矩阵。 : 简单来说,原先是矩阵,我运算完(乘上weight)後转回矩阵,让它做DTW的运算 : logisticWeight函式内容,仅是一般的S形函数 : logisticWeight <- function(i,mc,g){ : 1 / (1 + exp(-g * (i - mc ))) : } : 我想我应该要优化它赋与权重与相乘的动作,才能达到我降低运算时间的需求 : 谢谢~ : 小试了一下,将for loop改成用apply家族,大大改善运算效率 : (应该没有错吧!?) : weight<-vector() #weight function# : for(i in lm.v){ : tmp<-logisticWeight(i,median(lm.v),0.05) : weight<-c(weight,tm) : } : 改成 : tmp<-sapply(1,function(x){logisticWeight(lm.v,median(lm.v),0.05)}) : weight<- as.vector(tmp) 其实可以直接改成 lm.v<- as.vector(lm) lm.v_weight <- sapply(seq_along(lm.v), function(i){ logisticWeight(i, median(lm.v), g) }) lm.v_weight <- lm.v*weight ... 快就快在sapply会预先配置输出的vector大小 不然其实weight先给他输出长度，在用回圈，速度是一样的 (详细可以在板上/preallocation可以找到我的文章) 至於你之前的code可以直接这样改： library(dtw) library(Matrix) # 产生资料 x <- replicate(10, rnorm(sample(6:10, 1)), simplify = FALSE) # 直接产生出来要比较的i, j位置，然後用apply喂进去 out <- apply(subset(expand.grid(seq_along(x), seq_along(x)), Var1 > Var2), 1, function(v){ c(v, dtw(x[[v[1]]], x[[v[2]]])$distance) }) # 把out转成距离矩阵 output <- as.dist(sparseMatrix(out[1, ], out[2, ], x = out[3, ], dims = rep(length(x), 2))) 这样就会很快了(摊手 --

※ 发信站: 批踢踢实业坊(ptt.cc), 来自: 36.235.40.154 ※ 文章网址: https://webptt.com/cn.aspx?n=bbs/R_Language/M.1504264562.A.98C.html ※ 编辑: celestialgod (36.235.40.154), 09/01/2017 19:18:16