tests/testthat/test_dtw.R

In IncDTW: Incremental Calculation of Dynamic Time Warping

context("Equal dtw package")
library(dtw)


test_that("Bub: dtw normalized mv", {
   Q <- matrix(rnorm(100), ncol=2)
   C <- matrix(rnorm(800), ncol=2)
   
   tmp <- IncDTW::dtw(Q, C)
   # tmp$distance
   # tmp$normalized_distance
   
   dist_norm <- tmp$distance/(nrow(Q)+nrow(C))
   dist_norm2 <- tmp$normalized_distance
   expect_equal(dist_norm, dist_norm2)
   
})


test_that("IncDTW:dtw2vec is equal dtw::dtw", {
   Q <- cumsum(rnorm(100))
   C <- Q[11:100] + rnorm(90, 0, 0.5)
   ws <- NULL
   fooInc <- function(Q,C,ws){ dtw2vec(Q = Q, C = C, ws = ws, step_pattern = "symmetric2") }
   foodtw <- function(Q,C,ws){ dtw::dtw(Q,C, step.pattern = symmetric2,
                                        window.type = "sakoechiba", window.size = ws)}
   
   expect_equal(fooInc(Q, C, ws = NULL)$distance, foodtw(Q, C, ws = Inf)$distance)
   expect_equal(fooInc(Q, C, ws = 50)$normalized_distance,   foodtw(Q, C, ws = 50)$normalizedDistance)
   expect_equal(fooInc(Q, C, ws = 20)$distance,   foodtw(Q, C, ws = 20)$distance)
   expect_equal(fooInc(Q, C, ws = 20)$normalized_distance,   foodtw(Q, C, ws = 20)$normalizedDistance)
})


test_that("IncDTW:dtw2vec is equal dtw::dtw, symmetric2", {
   Q <- cumsum(rnorm(100))
   C <- Q[11:100] + rnorm(90, 0, 0.5)
   nd <- abs(length(Q) - length(C))# ndiff
   fooVec  <- function(Q,C,ws){ dtw2vec(Q = Q, C = C, ws = ws, step_pattern = "symmetric2")$distance }
   foodtw0 <- function(Q,C,ws){ IncDTW::dtw(Q,C, step_pattern = "symmetric2",
                                        ws = ws)$distance }
   
   foodtw  <- function(Q,C,ws){ dtw::dtw(Q,C, step.pattern = symmetric2,
                                        window.type = "sakoechiba", window.size = ws)$distance }
   
   expect_equal(fooVec(Q, C, ws = NULL), foodtw(Q, C, ws = Inf))
   expect_equal(fooVec(Q, C, ws = nd),   foodtw(Q, C, ws = nd))# fail
   expect_equal(fooVec(Q, C, ws = nd * 3),   foodtw(Q, C, ws = nd * 3))
   
   expect_equal(fooVec(Q, C, ws = NULL), foodtw0(Q, C, ws = NULL))
   expect_equal(fooVec(Q, C, ws = nd),   foodtw0(Q, C, ws = nd))#fail
   expect_equal(fooVec(Q, C, ws = nd * 3),   foodtw0(Q, C, ws = nd * 3))
   
   expect_equal(foodtw(Q, C, ws = Inf),  foodtw0(Q, C, ws = NULL))
   expect_equal(foodtw(Q, C, ws = nd),   foodtw0(Q, C, ws = nd))
   expect_equal(foodtw(Q, C, ws = nd * 3),   foodtw0(Q, C, ws = nd * 3))
   
   if(FALSE){
      fooVec  <- function(Q,C,ws){ dtw2vec(Q = Q, C = C, ws = ws, step_pattern = "symmetric1")$distance }
      foodtw0 <- function(Q,C,ws){ IncDTW::dtw(Q,C, step_pattern = "symmetric1",
                                               ws = ws)$distance }
      
      foodtw  <- function(Q,C,ws){ dtw::dtw(Q,C, step.pattern = dtw::symmetric1,
                                            window.type = "sakoechiba", window.size = ws)$distance }
      counter <- 0
      for(i in 1:100){
         set.seed(i)
         # i <- 3
         Q <- cumsum(rnorm(5))
         C <- Q[3:5] + rnorm(3, 0, 0.5)
         nd <- abs(length(Q) - length(C))# ndiff
         counter <- counter + 
            abs(fooVec(Q, C, ws = nd)- foodtw(Q, C, ws = nd))# fail
            +
               abs(fooVec(Q, C, ws = nd)-   foodtw0(Q, C, ws = nd))            
         
      }
      print(counter)
      
      tmp <- dtw::dtw(Q, C, step.pattern = symmetric2,
                      window.type = "sakoechiba", window.size = nd, keep.internals = T)
      tmp1 <- IncDTW::dtw(Q, C, step_pattern = "symmetric2", ws = nd)
      tmp$costMatrix - tmp1$gcm
      dtw2vec(Q = Q, C = C, ws = nd, step_pattern = "symmetric2")$distance
      
      tmp$costMatrix
      tmp1$gcm
      
   }
   
})



test_that("IncDTW:dtw2vec is equal dtw::dtw, symmetric2_mv", {
   Q <- matrix(rnorm(100), ncol=2)
   C <- matrix(rnorm(80), ncol=2)
   nd <- abs(nrow(Q)-nrow(C))# ndiff
   ws <- 20
   fooVec  <- function(Q,C,ws){ dtw2vec(Q = Q, C = C, ws = ws, step_pattern = "symmetric2", dist_method = "norm2")$distance }
   foodtw0 <- function(Q,C,ws){ dtw2vec_multiv(Q,C, step_pattern = "symmetric2", dist_method = "norm2",
                                            ws = ws)$distance }
   
   foodtw  <- function(Q,C,ws){ dtw::dtw(Q,C, step.pattern = symmetric2,
                                         window.type = "sakoechiba", window.size = ws)$distance }
   
   expect_equal(fooVec(Q, C, ws = NULL), foodtw(Q, C, ws = Inf))
   expect_equal(fooVec(Q, C, ws = 50),   foodtw(Q, C, ws = 50))
   expect_equal(fooVec(Q, C, ws = 20),   foodtw(Q, C, ws = 20))
   
   expect_equal(fooVec(Q, C, ws = NULL), foodtw0(Q, C, ws = NULL))
   expect_equal(fooVec(Q, C, ws = nd),   foodtw0(Q, C, ws = nd))
   expect_equal(fooVec(Q, C, ws = 2*nd), foodtw0(Q, C, ws = 2*nd))
   
   expect_equal(foodtw(Q, C, ws = Inf),  foodtw0(Q, C, ws = NULL))
   expect_equal(foodtw(Q, C, ws = nd),   foodtw0(Q, C, ws = nd))
   expect_equal(foodtw(Q, C, ws = 2*nd), foodtw0(Q, C, ws = 2*nd))
   
   
 
   
})


test_that("Warping paths are equal", {
   set.seed(sample(100, 1))
   Q <- cumsum(rnorm(100))
   C <- Q[11:100] + rnorm(90, 0, 0.5)
   fooInc <- function(Q,C,ws){ IncDTW::dtw(Q = Q, C = C, ws = ws, step_pattern = 'symmetric1', return_wp = TRUE)$wp }
   foodtw <- function(Q,C,ws){ dtw::dtw(Q,C, step.pattern = symmetric1,
                                        window.type = "sakoechiba", window.size = ws)$stepsTaken }
   
   expect_equal(fooInc(Q, C, ws = NULL), foodtw(Q, C, ws = Inf))
   expect_equal(fooInc(Q, C, ws = 50),   foodtw(Q, C, ws = 50))
   expect_equal(fooInc(Q, C, ws = 20),   foodtw(Q, C, ws = 20))
})



test_that("Equal 1-norm", {
   Q <- cumsum(rnorm(100))
   C <- cumsum(rnorm(100))
   fooInc <- function(Q,C,ws){ IncDTW::dtw2vec(Q = Q, step_pattern = "symmetric1", C = C, ws = ws)$distance }
   foo1norm <- function(Q,C){ sum(abs(Q-C)) }
   
   expect_equal(fooInc(Q, C, ws = 0), foo1norm(Q, C))
})




test_that("Equal dtw2vec and dtw", {
   Q <- cumsum(rnorm(100))
   C <- Q[11:100] + rnorm(90, 0, 0.5)
   foo2vec <- function(Q,C,ws){ IncDTW::dtw2vec(Q = Q, C = C, ws = ws)$distance }
   foodtw  <- function(Q,C,ws){ IncDTW::dtw(Q, C, ws = ws)$distance }
   foocm <- function(Q, C, ws){ 
      cm <- IncDTW::dtw(Q, C, ws = ws, return_cm = TRUE)$cm
      IncDTW::dtw2vec(Q = cm, C="cm", ws = ws)$distance}
   
   expect_equal(foo2vec(Q, C, ws = NULL), foodtw(Q, C, ws = NULL))
   expect_equal(foo2vec(Q, C, ws = 50),   foodtw(Q, C, ws = 50))
   expect_equal(foo2vec(Q, C, ws = 20),   foodtw(Q, C, ws = 20))
   
   expect_equal(foo2vec(Q, C, ws = NULL), foocm(Q, C, ws = NULL))
   expect_equal(foo2vec(Q, C, ws = 50),   foocm(Q, C, ws = 50))
   expect_equal(foo2vec(Q, C, ws = 20),   foocm(Q, C, ws = 20))
})


test_that("Equal Incremental vs. Scratch vec-based", {
   Q <- cumsum(rnorm(100))
   C <- Q[11:100] + rnorm(90, 0, 0.5)
   nC <- length(C)
   
   res0  <- idtw2vec(Q = Q, newObs = C[1:(nC-10)], gcm_lc = NULL)#initial
   res1  <- idtw2vec(Q = Q, newObs = C[(nC-9):nC], gcm_lc = res0$gcm_lc_new, nC = nC-10)#incremental
   resfs <- idtw2vec(Q = Q, newObs = C, gcm_lc = NULL)#from scratch
   
   expect_equal(res1$distance, resfs$distance)
   expect_equal(res1$normalized_distance, resfs$normalized_distance)
   
   
   # multivariate
   Q <- matrix(rnorm(20), ncol=2)
   C <- matrix(rnorm(6), ncol=2)
   nC <- nrow(C)
   
   res0  <- idtw2vec(Q = Q, newObs = C[1:(nC-1), ], gcm_lc = NULL)#initial
   res1  <- idtw2vec(Q = Q, newObs = C[(nC-1+1):nC,, drop = FALSE], gcm_lc = res0$gcm_lc_new, nC = nC-1)#incremental
   resfs <- idtw2vec(Q = Q, newObs = C, gcm_lc = NULL)#from scratch
   
   expect_equal(res1$distance, resfs$distance)
   expect_equal(res1$normalized_distance, resfs$normalized_distance)
   
})


test_that("Equal Incremental vs. Scratch vec-based with WS", {
   Q <- cumsum(rnorm(100))
   C <- Q[11:100] + rnorm(90, 0, 0.5)
   nC <- length(C)
   # skip("skip this: just for testing")
   res0  <- idtw2vec(Q = Q, newObs = C[1:(nC-10)]   , ws = 30, nC = 1    , gcm_lc = NULL)#initial
   res1  <- idtw2vec(Q = Q, newObs = C[(nC-10+1):nC], ws = 30, nC = nC-10, gcm_lc = res0$gcm_lc_new)#incremental
   resfs <-  dtw2vec(Q = Q, C = C,                    ws = 30)#from scratch
   
   expect_equal(res1$distance, resfs$distance)
})



test_that("Equal Incremental vs. Scratch vec-based, with cost matrix", {
   Q <- cumsum(rnorm(100))
   C <- Q[11:100] + rnorm(90, 0, 0.5)
   nC <- length(C)
   # skip("skip this: just for testing")
   cm <- IncDTW::cm(Q, C)
   res00 <- dtw(Q = cm, C = "cm")
   res0  <- idtw2vec_cm(cm = cm[,1:(nC-10), drop = FALSE],     gcm_lc = NULL)#initial
   res1  <- idtw2vec_cm(cm = cm[, (nC-10+1):nC, drop = FALSE], gcm_lc = res0$gcm_lc_new)#incremental
   
   expect_equal(res1$distance, res00$distance)
   
   
   WS <- 30
   res00 <- dtw(Q = cm, C = "cm", ws = WS)
   res0  <- idtw2vec_cm(cm = cm[,1:(nC-10), drop = FALSE], ws = WS,     gcm_lc = NULL)#initial
   res1  <- idtw2vec_cm(cm = cm[, (nC-10+1):nC, drop = FALSE], ws = WS, nC = nC-10, gcm_lc = res0$gcm_lc_new)#incremental
   
   expect_equal(res1$distance, res00$distance)
   expect_equal(res1$normalized_distance, res00$normalized_distance)
   
   
   WS <- 30
   res00 <- dtw(Q = cm, C = "cm", ws = WS)
   res0  <- idtw2vec(Q = cm[,1:(nC-10), drop = FALSE], newObs = "cm", ws = WS,     gcm_lc = NULL)#initial
   res1  <- idtw2vec(Q = cm[, (nC-10+1):nC, drop = FALSE], newObs = "cm",ws = WS, nC = nC-10, gcm_lc = res0$gcm_lc_new)#incremental
   
   expect_equal(res1$distance, res00$distance)
   expect_equal(res1$normalized_distance, res00$normalized_distance)
})






test_that("Equal Incremental vs. Scratch with ws", {
   # skip("test")
   Q <- cumsum(rnorm(10))
   C <- cumsum(rnorm(8))
   WS <- 5
   newObs <-  c(2,3)# new observation
   base <- dtw(Q=Q, C=C, ws = WS, return_diffM = TRUE) # the ordinary calculation
   
   
   #--- recalculation from scratch with new observations
   result0 <- dtw(Q=Q, C=c(C, newObs), ws = WS,  return_diffM = TRUE) # the ordinary calculation
   
   #--- the incremental step with new observations
   result1 <- idtw(Q, C, ws = WS, newObs = newObs, gcm=base$gcm, dm=base$dm, diffM = base$diffM, 
                   return_diffp = TRUE,  return_diffM = TRUE) 
   
   #--- the incremental step with new observations, 
   #     but already calculated additive costMatrix cm_add
   mQ <- matrix(Q, ncol = length(newObs), nrow = length(Q), byrow = FALSE)
   mC <- matrix(newObs, ncol = length(newObs), nrow = length(Q), byrow = TRUE)
   cm_add <- matrix(abs(mQ - mC), ncol = length(newObs))
   result2 <- idtw(Q=cm_add, C="cm_add", ws = WS, newObs = newObs, gcm=base$gcm, dm=base$dm) 
   
   expect_equal(result0$distance, result1$distance)
   expect_equal(result0$distance, result2$distance)
})



test_that("Double Incremental Matrix EQUAL Scratch", {
   # skip("test")
   # in very rare cases the solution of the cheapest path through the gcm is not unique, even though
   # the GCM and DTW distance measure are identical.
   # => the solution of the direction matrix, and the warping path can differ slightly 
   # This happens for example for myseed = 407. 
   # To pass the CRAN tests, I fix the seed.
   myseed <- 123
   set.seed(myseed)
   Q <- cumsum(rnorm(10))
   C <- cumsum(rnorm(8))
   WS <- 5
   newObsQ <-  rnorm(2)# new observation
   newObsC <-  rnorm(3)# new observation
   base <- IncDTW::dtw(Q=Q, C=C, ws = WS, return_diffM = TRUE) # the ordinary calculation
   
   
   #--- recalculation from scratch with new observations
   result0 <- IncDTW::dtw(Q = c(C, newObsC), C = c(Q, newObsQ), ws = WS,  
                          return_diffp = TRUE,return_diffM = TRUE, return_wp = TRUE) # the ordinary calculation
   
   #--- the incremental step with new observations
   result1 <- IncDTW::idtw(Q = Q, C = C, ws = WS, newObs = newObsC, gcm=base$gcm, 
                           dm=base$dm, diffM = base$diffM, 
                           return_diffp = TRUE,  return_diffM = TRUE) 
   
   tmp <- result1$dm
   tmp2 <- which(tmp==2)
   tmp3 <- which(tmp==3)
   tmp[tmp2] <- 3
   tmp[tmp3] <- 2
   tmp <- t(tmp)
   result2 <- IncDTW::idtw(Q = c(C, newObsC), C = Q, ws = WS, newObs = newObsQ, 
                           gcm = t(result1$gcm), dm = tmp, diffM = -t(result1$diffM), 
                           return_diffp = TRUE,  return_diffM = TRUE) 
   
   
   expect_equal(result0$gcm, result2$gcm)
   expect_equal(result0$dm, result2$dm)
   expect_equal(result0$diffp, result2$diffp)
   expect_equal(result0$diffM, result2$diffM)
   expect_equal(result0$wp, result2$wp)
   expect_equal(result0$distance, result2$distance)
})






test_that("Double Incremental Vector EQUAL Scratch", {

   C0 <- cumsum(rnorm(100))
   Q0 <- cumsum(rnorm(80))
   C_new <- cumsum(rnorm(10))
   Q_new <- cumsum(rnorm(10))
   C_update <- c(C0, C_new) 
   Q_update <- c(Q0, Q_new) 
   
   res_scratch <- IncDTW::dtw2vec(Q = Q_update, C = C_update)
   resV_init <- IncDTW::idtw2vec(Q = Q0, newObs = C0, gcm_lc = NULL)
   resV_inc <-  IncDTW::idtw2vec(Q = Q0, newObs = C_new, 
                                gcm_lc = resV_init$gcm_lc_new)
   resV_inc2 <- IncDTW::idtw2vec(Q = C_update, newObs = Q_new, 
                                 gcm_lc = c(resV_init$gcm_lr_new,
                                            resV_inc$gcm_lr_new))
   
   expect_equal(res_scratch$distance, resV_inc2$distance)
   
   
   # again with last row already in first incremntal step
   resV_init <- IncDTW::idtw2vec(Q = Q0, newObs = C0, gcm_lc = NULL)
   resV_inc <-  IncDTW::idtw2vec(Q = Q0, newObs = C_new, 
                                 gcm_lc = resV_init$gcm_lc_new,
                                 gcm_lr = resV_init$gcm_lr_new)
   
   resV_inc2 <- IncDTW::idtw2vec(Q = C_update, newObs = Q_new, 
                                 gcm_lc = resV_inc$gcm_lr_new)
   
   expect_equal(res_scratch$distance, resV_inc2$distance)
   
   
})




test_that("dtw_partial() based on dtw()", {
   
   C <- cos(1:100)
   Q <- c(C, rnorm(100))
   
   tmp <- IncDTW::dtw(Q = Q, C = C, return_QC = T, return_wp = T, step_pattern = "symmetric2")
   ret <- dtw_partial(tmp)
   
   expect_equal(ret$normalized_distance, 0)
   expect_equal(ret$rangeQ[2], 100)
   
   
})




test_that("dtw_partial() based on idtw2vec()", {
   
   C <- cos(1:100)
   Q <- c(C, rnorm(100))
   
   tmp <- IncDTW::idtw2vec(Q = Q, newObs = C, step_pattern = "symmetric2")
   ret <- dtw_partial(tmp)
   
   expect_equal(ret$normalized_distance, 0)
   expect_equal(ret$rangeQ[2], 100)
   
})



test_that("dtw_partial() reverse", {
   
   C <- cos(1:100)
   Q <- c(rnorm(100), C)
   
   tmp <- IncDTW::idtw2vec(Q = rev(Q), newObs = rev(C), step_pattern = "symmetric2")
   #tmp <- dtw(Q = rev(Q), C = rev(C), step_pattern = "symmetric2")
   ret <- dtw_partial(tmp, reverse = TRUE)
   
   expect_equal(ret$normalized_distance, 0)
   expect_equal(ret$rangeQ[1], 101)
   
})


test_that("dec_dm", {
   Q <- cos(1:100)
   C <- cumsum(rnorm(80))
   # the ordinary calculation
   result_base <- dtw(Q=Q, C=C, return_wp = TRUE) 
   
   # the ordinary calculation without the last 4 observations
   result_decr <- dtw(Q=Q, C=C[1:(length(C) - 4)], return_wp = TRUE) 
   # the decremental step: reduce C for 4 observation
   result_decr2 <- dec_dm(result_base$dm, Ndec = 4) 
   
   # compare ii, jj and wp of result_decr and those of 
   expect_equal(result_decr$ii, result_decr2$ii)
   expect_equal(result_decr$jj, result_decr2$jj)
   expect_equal(result_decr$wp, result_decr2$wp)

})