tests/testthat/test_planedtw.R

In IncDTW: Incremental Calculation of Dynamic Time Warping

context("planedtw and friends")


test_that("in-/decrement", {
   
   rw <- function(nn) cumsum(rnorm(nn))
   Q <- sin(1:100)
   C <- Q[1:90] + rnorm(90, 0, 0.1)
   WS <- 40
   # initial calculation
   x <- initialize_plane(Q, C, ws = WS)
   
   # incremental calculation for new observations
   y1 <- Q[91:92] + rnorm(2, 0, 0.1)# new observations
   x <- increment(x, newObs = y1)
   y2 <- Q[93:95] + rnorm(3, 0, 0.1)# new observations
   x <- increment(x, newObs = y2)
   y3 <- c(Q[96:100] + rnorm(5, 0, 0.1), rw(10))# new observations
   x <- increment(x, newObs = y3)
   
   ist <- x$control$nC
   soll <- 110
   expect_equal(ist, soll)
   
   ist <- x$normalized_distance 
   soll <- dtw2vec(Q, c(C, y1, y2, y3) , ws = WS)$normalized_distance
   expect_equal(ist, soll)
   
   x <- decrement(x, direction = "C", refresh_dtw = TRUE)
   ist <- x$normalized_distance 
   soll <- dtw2vec(Q, c(C, y1, y2, y3[1:5]) , ws = WS)$normalized_distance
   expect_lte(ist, soll) # 'ist' can be smaller, if the partial found fit is of diff length
   
})


test_that("reverse increment", {
   
   
   #--- 2. example: first increment, then reverse increment
   rw <- function(nn) cumsum(rnorm(nn))
   Q <- rw(100)
   C <- Q[11:90] + rnorm(80, 0, 0.1)
   WS <- 40
   # initial calculation
   x <- initialize_plane(Q, C, ws = WS)
   
   # incremental calculation for new observations
   y1 <- Q[91:100] + rnorm(10, 0, 0.1)# new observations
   x <- increment(x, newObs = y1)
   x <- reverse(x)
   y2 <- Q[10:6] + rnorm(5, 0, 0.1)# new observations in reverse order
   x <- increment(x, newObs = y2)
   y3 <- Q[5:1] + rnorm(5, 0, 0.1)# again new obs in reverse order
   x <- increment(x, newObs = y3)
   #x <- reverse(x)
   ist <- x$distance 
   soll <- dtw2vec(rev(Q), rev(c(rev(y3), rev(y2), C, y1)),ws = WS)$distance
   
   expect_equal(ist, soll)
   
   
})


test_that("refresh", {
   
   
   rw <- function(nn) cumsum(rnorm(nn))
   Q <- rw(100)
   C <- Q[11:90] + rnorm(80, 0, 0.1)
   WS <- 40
   # initial calculation
   x <- initialize_plane(Q, C, ws = WS)
   x <- refresh(x)
   
   ist <- x$normalized_distance
   soll <- dtw2vec(Q, C, ws = WS)$normalized_distance
   expect_equal(ist, soll)
   
   
   x <- decrement(x, refresh_dtw = FALSE)
   x <- refresh(x)
   ist <- x$normalized_distance
   soll <- dtw2vec(Q, C[1:x$control$nC], ws = WS)$normalized_distance
   expect_equal(ist, soll)
   
})



test_that("primitive decrement", {
   
   
   rw <- function(nn) cumsum(rnorm(nn))
   Q <- rw(100)
   C <- Q[11:90] + rnorm(80, 0, 0.1)
   WS <- 100
   # initial calculation
   x <- initialize_plane(Q, C, ws = WS)
   x <- decrement(x, nC = 20)
   expect_equal(x$gcm_lc_new, NULL)
   expect_equal(x$gcm_lr_new, NULL)
   expect_equal(x$control$nC, 20)
   
   x <- initialize_plane(Q, C, ws = WS)
   x <- decrement(x, nC = 20, refresh_dtw = TRUE)
   
   expect_equal(x$normalized_distance, dtw2vec(Q, C[1:20], ws = WS)$normalized_distance)
   expect_equal(x$control$nC, 20)
   
})



test_that("partial decrement", {
   
   rw <- function(nn) cumsum(rnorm(nn))
   Q <- rw(100)
   C <- c(Q[1:90] + rnorm(90, 0, 0.1), rnorm(20))
   WS <- 30
   
   # initial calculation
   x <- initialize_plane(Q, C, ws = WS)
   par <- dtw_partial(x, partial_Q = FALSE, partial_C = TRUE)
   x1 <- decrement(x, refresh_dtw = TRUE)
   x2 <- decrement(x, nC = par$rangeC[2], refresh_dtw = TRUE)
   expect_equal(x1, x2)
   
   x1 <- decrement(x, refresh_dtw = FALSE)
   x2 <- decrement(x, nC = par$rangeC[2], refresh_dtw = FALSE)
   expect_equal(x1, x2)
   
   x <- decrement(x, direction = "C")
   expect_equal(x$gcm_lc_new, NULL)
   expect_equal(x$gcm_lr_new, NULL)
   
   x <- initialize_plane(Q, C, ws = WS)
   x <- decrement(x, nC = 75, refresh_dtw = TRUE)
   
   tmp <- dtw2vec(Q, C[1:75], ws = WS)
   expect_equal(x$normalized_distance, tmp$normalized_distance)
   expect_equal(x$distance, tmp$distance)
   expect_equal(x$control$nC, 75)
   

})