if (!testthat:::on_cran() # && identical(Sys.getenv("R_LOCAL_DEV"), "true") ) { # Stamps and Stomps agree ---- context("Testing if Stamps and Stomps algorithms agree") library(tsmp) ## Test errors ---- test_that("Errors", { # big window size expect_error(mstomp(mp_toy_data$data[1:400, ], window_size = 500), "too short relative") expect_error(mstomp_par(mp_toy_data$data[1:400, ], window_size = 500), "too short relative") expect_error(stomp(mp_toy_data$data[1:400, ], window_size = 500), "too short relative") expect_error(stomp_par(mp_toy_data$data[1:400, ], window_size = 500), "too short relative") expect_error(stamp(mp_toy_data$data[1:400, ], window_size = 500), "too short relative") expect_error(stamp_par(mp_toy_data$data[1:400, ], window_size = 500), "too short relative") expect_error(scrimp(mp_toy_data$data[1:400, ], window_size = 500), "too short relative") # intersect expect_error(mstomp(mp_toy_data$data[1:400, ], window_size = 40, must_dim = c(1, 2), exc_dim = c(2, 3)), "presented in both") expect_error(mstomp_par(mp_toy_data$data[1:400, ], window_size = 40, must_dim = c(1, 2), exc_dim = c(2, 3)), "presented in both") # too many must_dim expect_error(mstomp(mp_toy_data$data[1:400, ], window_size = 40, must_dim = c(1, 2, 3, 4)), "must_dim") expect_error(mstomp_par(mp_toy_data$data[1:400, ], window_size = 40, must_dim = c(1, 2, 3, 4)), "must_dim") # too many exc_dim expect_error(mstomp(mp_toy_data$data[1:400, ], window_size = 40, exc_dim = c(1, 2, 3, 4)), "exc_dim") expect_error(mstomp_par(mp_toy_data$data[1:400, ], window_size = 40, exc_dim = c(1, 2, 3, 4)), "exc_dim") # small window size expect_error(stamp(mp_toy_data$data[1:400, ], window_size = 2), "window_size") expect_error(stamp_par(mp_toy_data$data[1:400, ], window_size = 2), "window_size") expect_error(mstomp(mp_toy_data$data[1:400, ], window_size = 2), "window_size") expect_error(mstomp_par(mp_toy_data$data[1:400, ], window_size = 2), "window_size") expect_error(stomp(mp_toy_data$data[1:400, ], window_size = 2), "window_size") expect_error(stomp_par(mp_toy_data$data[1:400, ], window_size = 2), "window_size") expect_error(scrimp(mp_toy_data$data[1:400, ], window_size = 2), "window_size") # unknown data type expect_error(stamp(table(rpois(100, 5)), window_size = 40), "Unknown type") expect_error(stamp_par(table(rpois(100, 5)), window_size = 40), "Unknown type") expect_error(mstomp(table(rpois(100, 5)), window_size = 40), "Unknown type") expect_error(mstomp_par(table(rpois(100, 5)), window_size = 40), "Unknown type") expect_error(stomp(table(rpois(100, 5)), window_size = 40), "Unknown type") expect_error(stomp_par(table(rpois(100, 5)), window_size = 40), "Unknown type") expect_error(scrimp(table(rpois(100, 5)), window_size = 40), "Unknown type") }) ## Test finish ---- test_that("Finish", { expect_message(tsmp(mp_toy_data$data[1:400, 1], mode = "stamp", window_size = 40), "Finished") expect_message(tsmp(mp_toy_data$data[1:400, 1], mode = "stamp", window_size = 40, n_workers = 2), "Finished") expect_message(tsmp(mp_toy_data$data[1:400, 1], mode = "stomp", window_size = 40), "Finished") expect_message(tsmp(mp_toy_data$data[1:400, 1], mode = "stomp", window_size = 40, n_workers = 2), "Finished") expect_message(tsmp(mp_toy_data$data[1:400, 1], mode = "mstomp", window_size = 40), "Finished") expect_message(tsmp(mp_toy_data$data[1:400, 1], mode = "mstomp", window_size = 40, n_workers = 2), "Finished") expect_message(tsmp(mp_toy_data$data[1:400, 1], mode = "scrimp", window_size = 40), "Finished") expect_message(tsmp(mp_toy_data$data[1:400, 1], mp_toy_data$data[1:400, 1], mode = "scrimp", window_size = 40), "not implemented") }) ## Create MP's ---- # MPX mpx_test <- mpx(mp_toy_data$data[1:400, 1], window_size = 40) mpx_par_test <- mpx(mp_toy_data$data[1:400, 1], window_size = 40, n_workers = 2) mpx_join_test <- mpx(mp_toy_data$data[1:400, 1], query = mp_toy_data$data[1:100, 2], window_size = 40) mpx_par_join_test <- mpx(mp_toy_data$data[1:400, 1], query = mp_toy_data$data[1:100, 2], window_size = 40, n_workers = 2) # STAMP stamp_test <- stamp(mp_toy_data$data[1:400, 1], window_size = 40, verbose = 0) stamp_join_test <- stamp(mp_toy_data$data[1:400, 1], mp_toy_data$data[1:100, 2], window_size = 40, verbose = 0) stamp_par_test <- stamp_par(mp_toy_data$data[1:400, 1], window_size = 40, verbose = 0) stamp_par_join_test <- stamp_par(mp_toy_data$data[1:400, 1], mp_toy_data$data[1:100, 2], window_size = 40, verbose = 0) # STOMP stomp_test <- stomp(mp_toy_data$data[1:400, 1], window_size = 40, verbose = 0) stompi_test <- tsmp(mp_toy_data$data[1:200, 1], window_size = 40, verbose = 0) stompi_test <- stompi_update(stompi_test, mp_toy_data$data[201:400, 1]) stomp_join_test <- stomp(mp_toy_data$data[, 1], mp_toy_data$data[1:400, 2], window_size = 40, verbose = 0) stomp_par_test <- stomp_par(mp_toy_data$data[1:400, 1], window_size = 40, verbose = 0) stomp_par_join_test <- stomp_par(mp_toy_data$data[, 1], mp_toy_data$data[1:400, 2], window_size = 40, verbose = 0) # MSTOMP Uni mstomp_test1 <- mstomp(mp_toy_data$data[1:400, 1], window_size = 40, verbose = 0) mstomp_par_test1 <- mstomp_par(mp_toy_data$data[1:400, 1], window_size = 40, verbose = 0) # MSTOMP Multi mstomp_test <- mstomp(mp_toy_data$data[1:400, ], window_size = 40, verbose = 0) mstomp_test_must <- mstomp(mp_toy_data$data[1:400, ], window_size = 40, must_dim = c(1, 2), verbose = 0) mstomp_test_exc <- mstomp(mp_toy_data$data[1:400, ], window_size = 40, exc_dim = c(1, 2), verbose = 0) mstomp_par_test <- mstomp_par(mp_toy_data$data[1:400, ], window_size = 40, verbose = 0) mstomp_par_test_must <- mstomp_par(mp_toy_data$data[1:400, ], window_size = 40, must_dim = c(1, 2), verbose = 0) mstomp_par_test_exc <- mstomp_par(mp_toy_data$data[1:400, ], window_size = 40, exc_dim = c(1, 2), verbose = 0) scrimp_test <- scrimp(mp_toy_data$data[1:400, 1], window_size = 40, verbose = 0) ## Check consistency ---- test_that("Basic Results", { expect_equal(round(sum(stamp_test$mp) / sd(stamp_test$mp), 3), 1091.226) expect_equal(sum(which(is.infinite(stamp_test$rmp))), 7371) expect_equal(round(sum(stamp_test$rmp[1:155]) / sd(stamp_test$rmp[1:155]), 3), 445.228) expect_equal(sum(which(is.infinite(stamp_test$lmp))), 231) expect_equal(round(sum(stamp_test$lmp[22:150]) / sd(stamp_test$lmp[22:150]), 3), 284.888) expect_equal(round(sum(stamp_test$pi) / sd(stamp_test$pi), 3), 497.011) expect_equal(round(sum(stamp_test$rpi[1:340]) / sd(stamp_test$rpi[1:340]), 3), 1640.354) expect_equal(round(sum(stamp_test$lpi[22:361]) / sd(stamp_test$lpi[22:361]), 3), 352.708) expect_equal(stamp_test$w, 40) expect_equal(stamp_test$ez, 0.5) expect_equal(class(stamp_test), "MatrixProfile") expect_equal(class(stomp_test), "MatrixProfile") expect_equal(class(mstomp_test), "MultiMatrixProfile") }) ## Check MPX ---- test_that("MPX Results", { expect_true(all.equal(mpx_test, mpx_par_test)) expect_true(all.equal(mpx_join_test, mpx_par_join_test)) expect_equal(as.vector(stamp_test$mp), mpx_test$mp) expect_equal(as.vector(stamp_test$pi), mpx_test$pi) }) ## Check STOMP and STOMPI ---- test_that("Stompi Results", { expect_equal(stomp_test$mp, stompi_test$mp) expect_equal(stomp_test$pi, stompi_test$pi) expect_equal(stomp_test$rmp, stompi_test$rmp) expect_equal(stomp_test$rpi, stompi_test$rpi) expect_equal(stomp_test$lmp, stompi_test$lmp) expect_equal(stomp_test$lpi, stompi_test$lpi) }) ## Check consistency for SCRIMP ---- test_that("Scrimp Results", { expect_equal(class(scrimp_test), "MatrixProfile") expect_equal(round(sum(scrimp_test$mp) / sd(scrimp_test$mp), 2), 1091.23) expect_equal(round(sum(scrimp_test$pi) / sd(scrimp_test$pi), 3), 497.011) expect_equal(scrimp_test$w, 40) expect_equal(scrimp_test$ez, 0.5) }) ## Check inter-consistency ---- # stamp_test and stamp_par_test test_that("Stamp equals to Stamp_par", { expect_equal(stamp_test, stamp_par_test) }) # stamp_join_test and stamp_par_join_test test_that("Stamp Join equals to Stamp_par Join", { expect_equal(stamp_join_test, stamp_par_join_test) }) # stamp_test and stomp_test test_that("Stamp equals to Stomp", { expect_equal(stamp_test, stomp_test) }) # scrimp_test and stomp_test test_that("Scrimp equals to Stomp", { expect_equal(scrimp_test, stomp_test) }) test_that("Stomp Join equals to Stomp_par Join", { expect_equal(stomp_join_test, stomp_par_join_test) }) # stamp_test and stomp_par_test test_that("Stamp equals to Stomp_par", { expect_equal(stamp_test, stomp_par_test) }) # stamp_test and mstomp_test1 test_that("Stamp equals to mStomp", { expect_equal(stamp_test, mstomp_test1) }) # stamp_test and mstomp_par_test1 test_that("Stamp equals to Stomp", { expect_equal(stamp_test, mstomp_par_test1) }) # mstomp_test and mstomp_par_test test_that("mStomp equals to mStomp_par", { expect_equal(mstomp_test, mstomp_par_test) }) # mstomp_test_must and mstomp_par_test_must test_that("mStomp must equals to mStomp_par must", { expect_equal(mstomp_test_must, mstomp_par_test_must) }) # mstomp_test_exc and mstomp_par_test_exc test_that("mStomp exc equals to mStomp_par exc", { expect_equal(mstomp_test_exc, mstomp_par_test_exc) }) }