Nothing
## ----eval=FALSE---------------------------------------------------------------
# install.packages("devtools")
# devtools::install_github("pboesu/rucrdtw")
## -----------------------------------------------------------------------------
library("rucrdtw")
## ----random-walk--------------------------------------------------------------
set.seed(123)
rwalk <- cumsum(runif(1e7, min = -0.5, max = 0.5))
## ----rw-query-----------------------------------------------------------------
qstart <- sample(length(rwalk), 1)
query <- rwalk[qstart:(qstart+100)]
## ----rw-search----------------------------------------------------------------
system.time(dtw_search <- ucrdtw_vv(data = rwalk, query = query, dtwwindow = 0.05))
all.equal(qstart, dtw_search$location)
system.time(ed_search <- ucred_vv(data = rwalk, query = query))
all.equal(qstart, ed_search$location)
## ----load-data----------------------------------------------------------------
data("synthetic_control")
## ----plot-examples, fig.width=6-----------------------------------------------
par(mfrow = c(3,2),
mar = c(1,1,1,1))
classes = c("Normal", "Cyclic", "Increasing", "Decreasing", "Upward shift", "Downward shift")
for (i in 1:6){
plot(synthetic_control[i*100-99,], type = "l", xaxt = "n", yaxt = "n", ylab="", xlab = "", bty="n", main=classes[i])
}
## ---- echo=TRUE, message=TRUE, warning=TRUE-----------------------------------
index <- 600
query <- synthetic_control[index,]
dtw_search <- ucrdtw_mv(synthetic_control[-index,], query, 0.05, byrow = TRUE)
ed_search <- ucred_mv(synthetic_control[-index,], query, byrow= TRUE)
## ----plot-search, fig.width=6-------------------------------------------------
plot(synthetic_control[dtw_search$location,], type="l", ylim=c(0,55), ylab="")
lines(query, col="red")
lines(synthetic_control[ed_search$location,], col="blue", lty=3, lwd=3)
legend("topright", legend = c("query", "DTW match", "ED match"), col=c("red", "black", "blue"), lty=c(1,1,3), bty="n")
## ----dtw-comparison, message=FALSE--------------------------------------------
set.seed(123)
rwalk <- cumsum(runif(5e3, min = -0.5, max = 0.5))
qstart <- 876
query <- rwalk[qstart:(qstart+99)]
library(dtw)
## ----naive-function-----------------------------------------------------------
naive_dtw <- function(data, query){
n_comps <- (length(data)-length(query)+1)
dtw_dist <- numeric(n_comps)
for (i in 1:n_comps){
dtw_dist[i] <- dtw(query, data[i:(i+length(query)-1)], distance.only = TRUE, window.type="sakoechiba", window.size=5)$distance
}
which.min(dtw_dist)
}
## ----run-benchmark, fig.width=6-----------------------------------------------
if(require(rbenchmark)){
benchmarks <- rbenchmark::benchmark(
naive_1000 = naive_dtw(rwalk[1:1000], query),
naive_2000 = naive_dtw(rwalk[1:2000], query),
naive_5000 = naive_dtw(rwalk, query),
ucrdtw_1000 = ucrdtw_vv(rwalk[1:1000], query, 0.05),
ucrdtw_2000 = ucrdtw_vv(rwalk[1:2000], query, 0.05),
ucrdtw_5000 = ucrdtw_vv(rwalk, query, 0.05),
replications = 5)
#ensure benchmark test column is of type factor for compatibility with r-devel
benchmarks$test <- as.factor(benchmarks$test)
colors <- rep(c("#33a02c","#1f78b4"), each=3)
#plot with log1p transformed axes, as some execution times may be numerically zero
plot(log1p(benchmarks$elapsed*200) ~ benchmarks$test, cex.axis=0.7, las = 2, yaxt = "n", xlab = "", ylab = "execution time [ms]", ylim = c(0,10), medcol = colors, staplecol=colors, boxcol=colors)
axis(2, at = log1p(c(1,10,100,1000,10000)), labels = c(1,10,100,1000,10000), cex.axis = 0.7)
legend("topright", legend = c("naive DTW", "UCR DTW"), fill = c("#33a02c","#1f78b4"), bty="n")
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.