tests/testthat/test-MMD.R

In DataSimilarity: Quantifying Similarity of Datasets and Multivariate Two- And k-Sample Testing

testMMD <- function(n.iter) {
  if(requireNamespace("kernlab", quietly = TRUE)) {
    for(i in 1:n.iter) {
      set.seed(i)
      X1 <- mvtnorm::rmvnorm(100, sigma = matrix(0.2, 10, 10) + diag(0.8, 10, 10), 
                             mean = runif(10, -2, 2))
      X2 <- mvtnorm::rmvnorm(100, mean = runif(10, -2, 2),
                             sigma = matrix(0.5, 10, 10) + diag(0.5, 10, 10))
      
      set.seed(i)
      res.kmmd <- kernlab::kmmd(X1, X2)
      res.MMD <- DataSimilarity::MMD(X1, as.data.frame(X2), n.perm = 0, seed = i)
      res.MMD.perm <- DataSimilarity::MMD(X1, as.data.frame(X2), n.perm = 10, 
                                          seed = i)
      
      set.seed(i)
      res.kmmd.a <- kernlab::kmmd(X1, X2, asymptotic = TRUE)
      res.MMD.a <- DataSimilarity::MMD(X1, as.data.frame(X2), n.perm = 0, 
                                       asymptotic = TRUE, seed = i)
      res.MMD.perm.a <- DataSimilarity::MMD(X1, as.data.frame(X2), n.perm = 10, 
                                            asymptotic = TRUE, seed = i)
      
      testthat::test_that("output type", {
        # check length and names of output
        testthat::expect_length(res.MMD, 11)
        testthat::expect_named(res.MMD, c("statistic", "p.value", "estimate", 
                                          "alternative", "method", "data.name",
                                          "H0", "asymp.H0", "kernel.fun", 
                                          "Rademacher.bound", "asymp.bound"))
        testthat::expect_length(res.MMD.perm, 11)
        testthat::expect_named(res.MMD.perm, c("statistic", "p.value", "estimate", 
                                               "alternative", "method", "data.name", 
                                               "H0", "asymp.H0", "kernel.fun", 
                                               "Rademacher.bound", "asymp.bound"))
        testthat::expect_length(res.MMD.a, 11)
        testthat::expect_named(res.MMD.a, c("statistic", "p.value", "estimate", 
                                            "alternative", "method", "data.name", 
                                            "H0", "asymp.H0", "kernel.fun", 
                                            "Rademacher.bound", "asymp.bound"))
        testthat::expect_length(res.MMD.perm.a, 11)
        testthat::expect_named(res.MMD.perm.a, c("statistic", "p.value", "estimate", 
                                                 "alternative", "method", "data.name", 
                                                 "H0", "asymp.H0", "kernel.fun", 
                                                 "Rademacher.bound", "asymp.bound"))
        # check p values in [0,1]
        testthat::expect_lte(res.MMD.perm$p.value, 1)
        testthat::expect_gte(res.MMD.perm$p.value, 0)
        testthat::expect_lte(res.MMD.perm.a$p.value, 1)
        testthat::expect_gte(res.MMD.perm.a$p.value, 0)
        # check approx. p value is NA
        testthat::expect_true(is.na(res.MMD$p.value))
        testthat::expect_true(is.na(res.MMD.a$p.value))
        # statistic is not NA
        testthat::expect_false(is.na(res.MMD$statistic))
        testthat::expect_false(is.na(res.MMD.perm$statistic))
        testthat::expect_false(is.na(res.MMD.a$statistic))
        testthat::expect_false(is.na(res.MMD.perm.a$statistic))
        # output should be numeric
        testthat::expect_s3_class(res.MMD, "htest")
        testthat::expect_s3_class(res.MMD.perm, "htest")
        testthat::expect_s3_class(res.MMD.a, "htest")
        testthat::expect_s3_class(res.MMD.perm.a, "htest")
      })
      
      testthat::test_that("output values", {
        # check test statistic values
        testthat::expect_equal(res.MMD$statistic,
                               kernlab::mmdstats(res.kmmd)[1], 
                               check.attributes = FALSE)
        testthat::expect_equal(res.MMD.perm$statistic, 
                               kernlab::mmdstats(res.kmmd)[1], 
                               check.attributes = FALSE)
        testthat::expect_equal(res.MMD.a$statistic, 
                               kernlab::mmdstats(res.kmmd.a)[1], 
                               check.attributes = FALSE)
        testthat::expect_equal(res.MMD.perm.a$statistic, 
                               kernlab::mmdstats(res.kmmd.a)[1],
                               check.attributes = FALSE)
      })
      
      
      res.MMD.1 <- DataSimilarity::MMD(X1[, 1, drop = FALSE], 
                                       as.data.frame(X2)[, 1, drop = FALSE], 
                                       n.perm = 0, seed = i)
      res.MMD.perm.1 <- DataSimilarity::MMD(X1[, 1, drop = FALSE], 
                                            as.data.frame(X2)[, 1, drop = FALSE],
                                            n.perm = 3, seed = i)
      res.MMD.a.1 <- DataSimilarity::MMD(X1[, 1, drop = FALSE], 
                                         as.data.frame(X2)[, 1, drop = FALSE],
                                         n.perm = 0, asymptotic = TRUE, seed = i)
      res.MMD.perm.a.1 <- DataSimilarity::MMD(X1[, 1, drop = FALSE], 
                                              as.data.frame(X2)[, 1, drop = FALSE], 
                                              n.perm = 3, asymptotic = TRUE, 
                                              seed = i)
      
      testthat::test_that("output type", {
        # check length and names of output
        testthat::expect_length(res.MMD.1, 11)
        testthat::expect_named(res.MMD.1, c("statistic", "p.value", "estimate", 
                                            "alternative", "method", "data.name",
                                            "H0", "asymp.H0", "kernel.fun", 
                                            "Rademacher.bound", "asymp.bound"))
        testthat::expect_length(res.MMD.perm.1, 11)
        testthat::expect_named(res.MMD.perm.1, c("statistic", "p.value", "estimate", 
                                                 "alternative", "method", "data.name", 
                                                 "H0", "asymp.H0", "kernel.fun", 
                                                 "Rademacher.bound", "asymp.bound"))
        testthat::expect_length(res.MMD.a.1, 11)
        testthat::expect_named(res.MMD.a.1, c("statistic", "p.value", "estimate", 
                                              "alternative", "method", "data.name", 
                                              "H0", "asymp.H0", "kernel.fun", 
                                              "Rademacher.bound", "asymp.bound"))
        testthat::expect_length(res.MMD.perm.a.1, 11)
        testthat::expect_named(res.MMD.perm.a.1, c("statistic", "p.value", "estimate", 
                                                   "alternative", "method", "data.name", 
                                                   "H0", "asymp.H0", "kernel.fun", 
                                                   "Rademacher.bound", "asymp.bound"))
        # check p values in [0,1]
        testthat::expect_lte(res.MMD.perm.1$p.value, 1)
        testthat::expect_gte(res.MMD.perm.1$p.value, 0)
        testthat::expect_lte(res.MMD.perm.a.1$p.value, 1)
        testthat::expect_gte(res.MMD.perm.a.1$p.value, 0)
        # check approx. p value is NA
        testthat::expect_true(is.na(res.MMD.1$p.value))
        testthat::expect_true(is.na(res.MMD.a.1$p.value))
        # statistic is not NA
        testthat::expect_false(is.na(res.MMD.1$statistic))
        testthat::expect_false(is.na(res.MMD.perm.1$statistic))
        testthat::expect_false(is.na(res.MMD.a.1$statistic))
        testthat::expect_false(is.na(res.MMD.perm.a.1$statistic))
        # output should be numeric
        testthat::expect_s3_class(res.MMD.1, "htest")
        testthat::expect_s3_class(res.MMD.perm.1, "htest")
        testthat::expect_s3_class(res.MMD.a.1, "htest")
        testthat::expect_s3_class(res.MMD.perm.a.1, "htest")
      })
    }
  }
}

set.seed(0305)
testMMD(1)