※ 引述《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)))
这样就会很快了(摊手