if (FALSE) {
# ====================================================================================
# Understanding multivariate DTW
# ====================================================================================
# The variables for each multivariate time series are:
# tip force, x velocity, and y velocity
A1 <- CharTrajMV[[1L]] # A character
B1 <- CharTrajMV[[6L]] # B character
# Let's extract univariate time series
A1_TipForce <- A1[,1L] # first variable (column)
A1_VelX <- A1[,2L] # second variable (column)
A1_VelY <- A1[,3L] # third variable (column)
B1_TipForce <- B1[,1L] # first variable (column)
B1_VelX <- B1[,2L] # second variable (column)
B1_VelY <- B1[,3L] # third variable (column)
# Looking at each variable independently:
# Just force
dtw_basic(A1_TipForce, B1_TipForce, norm = "L1", step.pattern = symmetric1)
# Corresponding LCM
proxy::dist(A1_TipForce, B1_TipForce, method = "L1")
# Just x velocity
dtw_basic(A1_VelX, B1_VelX, norm = "L1", step.pattern = symmetric1)
# Corresponding LCM
proxy::dist(A1_VelX, B1_VelX, method = "L1")
# Just y velocity
dtw_basic(A1_VelY, B1_VelY, norm = "L1", step.pattern = symmetric1)
# Corresponding LCM
proxy::dist(A1_VelY, B1_VelY, method = "L1")
# NOTES:
# In the previous examples there was one LCM for each *pair* of series.
# Additionally, each LCM has dimensions length(A1_*) x length(B1_*)
# proxy::dist won't return the LCM for multivariate series,
# but we can do it manually:
mv_lcm <- function(mvts1, mvts2) {
# Notice how the number of variables (columns) doesn't come into play here
num_obs1 <- nrow(mvts1)
num_obs2 <- nrow(mvts2)
lcm <- matrix(0, nrow = num_obs1, ncol = num_obs2)
for (i in 1L:num_obs1) {
for (j in 1L:num_obs2) {
# L1 norm for ALL variables (columns).
# Consideration: mvts1 and mvts2 MUST have the same number of variables
lcm[i, j] <- sum(abs(mvts1[i,] - mvts2[j,]))
}
}
# return
lcm
}
# Let's say we start with only x velocity and y velocity for each character
mvts1 <- cbind(A1_VelX, A1_VelY)
mvts2 <- cbind(B1_VelX, B1_VelY)
# DTW distance
dtw_d <- dtw_basic(mvts1, mvts2, norm = "L1", step.pattern = symmetric1)
# Corresponding LCM
lcm <- mv_lcm(mvts1, mvts2) # still 178 x 174
# Sanity check
all.equal(
dtw_d,
dtw::dtw(lcm, step.pattern = symmetric1)$distance # supports LCM as input
)
# Now let's consider all variables for each character
mvts1 <- cbind(mvts1, A1_TipForce)
mvts2 <- cbind(mvts2, B1_TipForce)
# Notice how the next code is exactly the same as before,
# even though we have one extra variable now
# DTW distance
dtw_d <- dtw_basic(mvts1, mvts2, norm = "L1", step.pattern = symmetric1)
# Corresponding LCM
lcm <- mv_lcm(mvts1, mvts2) # still 178 x 174
# Sanity check
all.equal(
dtw_d,
dtw::dtw(lcm, step.pattern = symmetric1)$distance # supports LCM as input
)
# By putting things in a list,
# proxy::dist returns the *cross-distance matrix*, not the LCM
series_list <- list(mvts1, mvts2)
distmat <- proxy::dist(series_list, method = "dtw_basic",
norm = "L1", step.pattern = symmetric1)
# So this should be TRUE
all.equal(distmat[1L, 2L], dtw_d)
# NOTE: distmat is a 2 x 2 matrix, because there are 2 multivariate series.
# Each *cell* in distmat has a corresponding LCM (not returned by the function).
# Proof:
manual_distmat <- matrix(0, nrow = 2L, ncol = 2L)
for (i in 1L:nrow(manual_distmat)) {
for (j in 1L:ncol(manual_distmat)) {
lcm_cell <- mv_lcm(series_list[[i]], series_list[[j]]) # LCM for this pair
manual_distmat[i, j] <- dtw::dtw(lcm_cell, step.pattern = symmetric1)$distance
}
}
# TRUE
all.equal(
as.matrix(distmat),
manual_distmat
)
}
Run the code above in your browser using DataLab