tests/testthat/test-02-integration-01-proxy.R

In dtwclust: Time Series Clustering Along with Optimizations for the Dynamic Time Warping Distance

# ==================================================================================================
# setup
# ==================================================================================================

## Original objects in env
ols <- ls()

## Data
x <- data_reinterpolated[3L:8L]

# ==================================================================================================
# proxy distances
# ==================================================================================================

test_that("Included proxy distances can be called and give expected dimensions.", {
    for (distance in dtwclust:::distances_included) {
        suppressWarnings(
            d <- proxy::dist(x, method = distance, window.size = 15L, sigma = 100, normalize = TRUE)
        )
        expect_identical(dim(d), c(length(x), length(x)), info = paste(distance, "single-arg"))

        d2 <- proxy::dist(x, x, method = distance, window.size = 15L, sigma = 100, normalize = TRUE)
        if (distance != "sdtw") {
            expect_equal(unclass(d2), as.matrix(d), ignore_attr = TRUE,
                         info = paste(distance, "double-arg"))
        }

        d3 <- proxy::dist(x[1L], x, method = distance, window.size = 15L, sigma = 100, normalize = TRUE)
        class(d3) <- c("matrix", "array")
        expect_identical(dim(d3), c(1L, length(x)), info = paste(distance, "one-vs-many"))

        d4 <- proxy::dist(x, x[1L], method = distance, window.size = 15L, sigma = 100, normalize = TRUE)
        class(d4) <- c("matrix", "array")
        expect_identical(dim(d4), c(length(x), 1L), info = paste(distance, "many-vs-one"))

        # dtw_lb will give different results below because of how it works
        if (distance == "dtw_lb") next

        expect_equal(d3, d2[1L, , drop = FALSE], ignore_attr = TRUE,
                     info = paste(distance, "one-vs-many-vs-distmat"))
        expect_equal(d4, d2[ , 1L, drop = FALSE], ignore_attr = TRUE,
                     info = paste(distance, "many-vs-one-vs-distmat"))

        dots <- list()
        if (distance %in% c("lb_keogh", "lb_improved"))
            dots <- list(window.size = 15L)
        else if (distance %in% c("gak"))
            dots <- list(window.size = 15L, sigma = 100)
        else if (distance %in% c("dtw_basic"))
            dots <- list(window.size = 15L, normalize = TRUE)

        manual_distmat <- sapply(x, function(j) {
            sapply(x, function(i) {
                d <- do.call(distance, dtwclust:::enlist(x = i, y = j, dots = dots), TRUE)
                if (distance %in% c("lb_keogh", "sbd")) d <- d$d
                d
            })
        })
        if (distance == "sdtw") diag(manual_distmat) <- 0
        expect_equal(as.matrix(d), manual_distmat, ignore_attr = TRUE,
                     info = paste("manual distmat vs proxy version using", distance))
    }
})

test_that("Parameter errors in included distances are detected.", {
    expect_error(proxy::dist(data_multivariate, method = "dtw_lb"), "multivariate")
    expect_error(proxy::dist(list(), method = "dtw_lb"), "Empty")
    expect_error(proxy::dist(data_subset, list(), method = "dtw_lb"), "Empty")
    expect_error(proxy::dist(data_subset, method = "sdtw", gamma = -1))
    expect_error(proxy::dist(data_subset, method = "gak", sigma = -1))
    expect_error(proxy::dist(data_subset, method = "dtw_basic", step.pattern = dtw::asymmetric))
    expect_error(proxy::dist(data_subset, method = "dtw_basic",
                             step.pattern = dtw::symmetric1, normalize = TRUE))
})

# ==================================================================================================
# proxy pairwise distances
# ==================================================================================================

test_that("Included proxy distances can be called for pairwise = TRUE and give expected length", {
    for (distance in dtwclust:::distances_included) {
        ## sbd doesn't always return zero, so tolerance is left alone here

        d <- proxy::dist(x, method = distance,
                         window.size = 15L, step.pattern = dtw::symmetric1,
                         pairwise = TRUE)
        class(d) <- "numeric"
        expect_null(dim(d), paste("distance =", distance))
        expect_identical(length(d), length(x), info = paste(distance, "pairwise single-arg"))
        if (distance != "sdtw")
            expect_equal(d, rep(0, length(d)), ignore_attr = TRUE,
                         info = paste(distance, "pairwise single all zero"))

        d2 <- proxy::dist(x, x, method = distance,
                          window.size = 15L, step.pattern = dtw::symmetric1,
                          pairwise = TRUE)
        class(d2) <- "numeric"
        expect_null(dim(d2), paste("distance =", distance))
        expect_identical(length(d2), length(x), info = paste(distance, "pairwise double-arg"))
        if (distance != "sdtw")
            expect_equal(d, rep(0, length(d2)), ignore_attr = TRUE,
                         info = paste(distance, "pairwise double all zero"))

        expect_error(proxy::dist(x[1L:3L], x[4L:5L], method = distance,
                                 window.size = 15L, pairwise = TRUE),
                     "same amount",
                     info = paste(distance, "invalid pairwise"))
    }
})

# ==================================================================================================
# proxy similarities
# ==================================================================================================

test_that("Included proxy similarities can be called and give expected dimensions.", {
    for (distance in c("uGAK")) {
        d <- proxy::simil(x, method = distance, sigma = 100)
        expect_identical(dim(d), c(length(x), length(x)), info = paste(distance, "single-arg"))

        d2 <- proxy::simil(x, x, method = distance, sigma = 100)
        expect_equal(d2, d, ignore_attr = TRUE,
                     info = paste(distance, "double-arg"))

        d3 <- proxy::simil(x[1L], x, method = distance, sigma = 100)
        class(d3) <- c("matrix", "array")
        expect_identical(dim(d3), c(1L, length(x)), info = paste(distance, "one-vs-many"))

        d4 <- proxy::simil(x, x[1L], method = distance, sigma = 100)
        class(d4) <- c("matrix", "array")
        expect_identical(dim(d4), c(length(x), 1L), info = paste(distance, "many-vs-one"))

        expect_equal(d3, d[1L, , drop = FALSE], ignore_attr = TRUE,
                     info = paste(distance, "one-vs-many-vs-distmat"))
        expect_equal(d4, d[ , 1L, drop = FALSE], ignore_attr = TRUE,
                     info = paste(distance, "many-vs-one-vs-distmat"))
    }
})

# ==================================================================================================
# clean
# ==================================================================================================

rm(list = setdiff(ls(), ols))