r - 在 R 中查看最佳 dtw 对齐

Question

我正在使用 R 中的 dtw 包来对齐时间序列数据。我可以很容易地获得对齐，但无法弄清楚如何显示来自两个时间序列匹配(拉伸(stretch)/压缩对齐)的峰值的最佳对齐。绘制对齐结果会导致相应的峰在它们之间显示虚线，而不是显示拉伸(stretch)版本。如何同时显示两个波形的拉伸(stretch)版本。

这是我正在使用的代码:

library(dtw)

p149 <- c(-13.000,-20.637,-19.000,-11.000,2.604,10.000,44.000,57.327,44.000,10.000,2.313,-11.000,-20.000,-6.545,1.000,52.000,70.082,57.000,17.000,18.593,0.000,5.000,4.754,4.000,-3.000,-1.204,-1.000,10.000,26.964,25.000,43.000,57.435,40.000,17.000,12.874,-2.000,-16.000,-27.441,-23.000,-24.000,-31.418,-20.000,-11.000,-13.463,-6.000,-3.000,-4.643,-2.000,-2.000,-4.643,-3.000,-6.000,7.727,10.000,44.000,53.049,40.000,-3.000,-14.796,-24.000,-24.000,-31.708,-20.000,-11.000,-14.598,-7.000,-7.000,-10.321,-7.000,-7.000,-10.321,-7.000,-7.000,6.591,10.000,44.000,57.327,44.000,10.000,7.727,-6.000,-3.000,6.056,8.000,30.000,38.152,29.000,5.000,-2.474,-11.000,-19.000,-30.548,-23.000,-24.000,-31.418,-20.000,-11.000,-14.598,-7.000,-7.000,6.591,10.000,44.000,57.327,44.000,10.000,8.388,-5.000,-1.000,-3.134,-1.000,-5.000,-12.802,-11.000,-20.000,-27.431,-20.000,-11.000,-8.966,-1.000,10.000,12.209,10.000)
p547 <- c(-2.000,7.554,-2.000,40.000,49.062,40.000,-3.000,-14.796,-24.000,-24.000,-29.912,-18.000,-6.000,18.559,24.000,73.000,93.119,69.000,12.000,23.458,3.000,41.000,51.912,41.000,2.000,-0.353,-11.000,1.000,15.803,18.000,41.000,47.903,33.000,-5.000,-12.677,-20.000,-11.000,-18.876,-11.000,-20.000,-28.646,-21.000,-15.000,-23.738,-15.000,-21.000,-25.161,-16.000,-1.000,2.826,7.000,7.000,12.736,9.000,14.000,11.417,6.000,-14.000,-24.368,-22.000,-19.000,-28.863,-19.000,-21.000,-33.117,-23.000,-24.000,-35.696,-24.000,-24.000,-26.076,-14.000,6.000,3.654,6.000,-14.000,-9.964,-8.000,24.000,28.462,24.000,-8.000,-14.461,-19.000,-8.000,-8.920,-2.000,-2.000,-7.212,-6.000,-13.000,-23.740,-19.000,-22.000,-18.166,-8.000,24.000,38.372,34.000,22.000,25.179,11.000,2.000,-2.715,-6.000,-13.000,-2.550,2.000,41.000,66.592,56.000,46.000,49.651,24.000,-8.000,-9.964,-14.000,6.000,3.654,6.000,-14.000,-20.663,-19.000)


alignment<-dtw(p149,p547,keep=TRUE);

## Display the warping curve, i.e. the alignment curve
plot(alignment,type="twoway")

## Align and plot with the Rabiner-Juang type VI-c unsmoothed recursion
plot(
    dtw(p149,p547,keep=TRUE,
        step=rabinerJuangStepPattern(6,"c")),
    type="twoway",offset=-2)

未平滑和平滑的图如下所示:

但我需要它们看起来类似于我可以在 Mathematica 中使用 DTW 实现的图，如下所示:

Answer 1

我想出了如何做到这一点，我正在分享它以帮助任何可能最终在这里寻找 future 相同功能的人。

seqA <-c(-11.742,-1.551,1.308,27.407,35.801,28.623,4.954,-2.764,-11.158,-19.713,-23.946,-16.228,-0.704,2.448,6.681,5.925,6.727,3.576,-0.367,14.088,13.286,44.535,69.689,55.234,45.382,52.561,27.407,1.308,17.538,10.359,54.563,67.731,51.501,1.173,-9.114,-22.282,-18.866,-8.115,2.172,40.83,57.634,46.884,20.334,17.809,1.004,-11.104,-0.201,2.324,41.286,63.263,52.361,35.548,36.336,14.359,-11.207,1.961,1.173,51.501,70.743,57.575,19.396,20.859,1.617,4.237,15.738,14.274,31.729,61.01,49.509,67.613,82.489,53.209,6.298,5.921,-8.956,7.448,13.125,13.502,9.206,8.035,2.358,-7.042,9.188,10.359,54.563,77.641,61.411,30.903,34.231,11.153,2.159,11.689,8.361,29.758,50.607,41.077,42.317,56.964,36.116,22.472,50.634,35.987,76.662,96.623,68.461,11.382,4.157,-15.804,-13.096,-19.99,-12.765,-14.809,-21.703,-14.809,-12.765,-0.66,6.233,42.184,56.639,44.535,13.286,8.412,-6.043,-13.453,-10.957,-6.083,16.067,32.967,30.471,37.128,51.155,34.255,21.852,17.266,3.239,-21.581,-19.345,-14.759,23.705,33.855,31.619,8.981,18.511,8.361,29.758,55.064,45.534,55.689,81.615,56.309,47.395,53.84,27.914,-2.134,-7.008,-13.453,-6.043,-2.715,2.159,11.153)

seqB <-c(-11.742,-1.551,1.308,27.407,47.636,40.457,40.457,44.574,24.345,-7.879,-14.461,-18.577,-7.751,-8.259,-1.677,-0.355,-8.776,-8.268,-25.417,-23.801,-15.38,21.845,42.073,40.457,40.457,47.636,27.407,1.308,17.538,10.359,54.563,67.731,51.501,1.173,-9.114,-22.282,-18.866,-8.115,2.172,40.83,57.634,46.884,20.334,17.809,1.004,-11.104,-0.201,2.324,41.286,63.263,52.361,35.548,70.743,57.575,19.396,20.859,1.617,4.237,15.738,14.274,31.729,61.01,49.509,67.613,82.489,53.209,6.298,5.921,-8.956,7.448,13.125,13.502,9.206,7.013,1.336,-10.109,5.099,7.293,53.541,66.709,51.501,1.173,-5.409,-18.577,-7.751,1.779,8.361,29.758,50.607,41.077,42.317,56.964,36.116,22.472,50.634,35.987,76.662,102.299,74.137,28.41,26.861,1.225,-7.42,-14.313,-12.765,-14.809,-22.725,-15.832,-15.832,-4.75,3.166,41.162,55.617,44.535,13.286,8.412,-6.043,-13.453,-10.957,-6.083,16.067,32.967,30.471,37.128,51.155,34.255,21.852,17.266,3.239,-21.581,-19.345,-14.759,23.705,33.855,31.619,8.981,18.511,8.361,29.758,55.064,45.534,55.689,81.615,56.309,47.395,53.84,27.914,-2.134,-7.008,-13.453,-6.043,-4.863,0.011)

## Find the best match with dynamic time warping
library(dtw);
alignment<-dtw(seqA,seqB,keep=TRUE,dist.method="Euclidean");

##Extract just the warped version of seqA from the alignment
seqAindex<-dput(as.double(alignment$index1s));
stretchedseqA<-(seqA[c(seqAindex)]);

##Extract just the warped version of seqB from the alignment
seqBindex<-dput(as.double(alignment$index2s));
stretchedseqB<-(seqB[c(seqBindex)]);

##Plot the vectors after warping
plot(stretchedseqA, type="l", col="red",xlab="Position", ylab="Peak Height", main="Warped Vectors-The Alignment")
lines(stretchedseqB, type="l", col="blue")
legend(1, 95, legend=c("SeqA", "SeqB"),col=c("red", "blue"), lty=1:1, cex=0.8)