tests/testthat/test-HMN.R

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

testHMN <- function(n.iter) {
  if(requireNamespace("hypoRF", 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, -1, 1))
      X2 <- mvtnorm::rmvnorm(100, mean = runif(10, -1, 1), 
                             sigma = matrix(0.5, 10, 10) + diag(0.5, 10, 10))
      
      res.hypoRF <- hypoRF::hypoRF(as.data.frame(X1), as.data.frame(X2), K = 1, 
                                   seed = i)
      res.hypoRF.perm <- hypoRF::hypoRF(as.data.frame(X1), as.data.frame(X2),
                                        K = 10, seed = i)
      res.HMN <- DataSimilarity::HMN(X1, as.data.frame(X2), n.perm = 0, seed = i)
      res.HMN.perm <- DataSimilarity::HMN(X1, as.data.frame(X2), n.perm = 10, seed = i)
      
      res.hypoRF.OverallOOB <- hypoRF::hypoRF(as.data.frame(X1), as.data.frame(X2), 
                                              K = 1, statistic = "OverallOOB", seed = i)
      res.hypoRF.perm.OverallOOB <- hypoRF::hypoRF(as.data.frame(X1), as.data.frame(X2), 
                                                   K = 10, statistic = "OverallOOB", 
                                                   seed = i)
      res.HMN.OverallOOB <- DataSimilarity::HMN(X1, as.data.frame(X2), n.perm = 0, 
                                                statistic = "OverallOOB", seed = i)
      res.HMN.perm.OverallOOB <- DataSimilarity::HMN(X1, as.data.frame(X2), n.perm = 10, 
                                                     statistic = "OverallOOB", seed = i)
      
      res.hypoRF.n <- hypoRF::hypoRF(as.data.frame(X1), as.data.frame(X2), K = 1, 
                                     normalapprox = TRUE, seed = i)
      res.hypoRF.perm.n <- hypoRF::hypoRF(as.data.frame(X1), as.data.frame(X2), 
                                          K = 10, normalapprox = TRUE, seed = i)
      res.HMN.n <- DataSimilarity::HMN(X1, as.data.frame(X2), n.perm = 0,
                                       normal.approx = TRUE, seed = i)
      res.HMN.perm.n <- DataSimilarity::HMN(X1, as.data.frame(X2), n.perm = 10,
                                            normal.approx = TRUE, seed = i)
      
      res.hypoRF.OverallOOB.n <- hypoRF::hypoRF(as.data.frame(X1), as.data.frame(X2), K = 1, 
                                                statistic = "OverallOOB", normalapprox = TRUE,
                                                seed = i)
      res.hypoRF.perm.OverallOOB.n <- hypoRF::hypoRF(as.data.frame(X1), as.data.frame(X2),
                                                     K = 10, statistic = "OverallOOB", 
                                                     normalapprox = TRUE, seed = i)
      res.HMN.OverallOOB.n <- DataSimilarity::HMN(X1, as.data.frame(X2), n.perm = 0, 
                                                  statistic = "OverallOOB", 
                                                  normal.approx = TRUE, seed = i)
      res.HMN.perm.OverallOOB.n <- DataSimilarity::HMN(X1, as.data.frame(X2), 
                                                       n.perm = 10, statistic = "OverallOOB", 
                                                       normal.approx = TRUE, seed = i)
      
      testthat::test_that("output type", {
        # check length and names of output
        testthat::expect_length(res.HMN, 12)
        testthat::expect_named(res.HMN, 
                               c("statistic", "parameter", "p.value", "estimate", 
                                 "alternative", "method","data.name",  "val", "varest", 
                                 "importance.ranking", "importance.distribution",
                                 "cut.off"))
        testthat::expect_length(res.HMN.perm, 12)
        testthat::expect_named(res.HMN.perm,
                               c("statistic", "parameter", "p.value",  "estimate", 
                                 "alternative", "method",  "data.name", "val", 
                                 "varest", "importance.ranking", 
                                 "importance.distribution", "cut.off"))
        testthat::expect_length(res.HMN.OverallOOB, 12)
        testthat::expect_named(res.HMN.OverallOOB, 
                               c("statistic", "parameter", "p.value", "estimate", 
                                 "alternative", "method", "data.name", "val", 
                                 "varest", "importance.ranking", 
                                 "importance.distribution", "cut.off"))
        testthat::expect_length(res.HMN.perm.OverallOOB, 12)
        testthat::expect_named(res.HMN.perm.OverallOOB, 
                               c("statistic", "parameter", "p.value", "estimate", 
                                 "alternative", "method", "data.name", "val", 
                                 "varest", "importance.ranking", 
                                 "importance.distribution", "cut.off"))
        
        testthat::expect_length(res.HMN.n, 12)
        testthat::expect_named(res.HMN.n,
                               c("statistic", "parameter", "p.value", "estimate",  
                                 "alternative",  "method", "data.name", "val",
                                 "varest", "importance.ranking", 
                                 "importance.distribution", "cut.off"))
        testthat::expect_length(res.HMN.perm.n, 12)
        testthat::expect_named(res.HMN.perm.n, 
                               c("statistic", "parameter", "p.value", "estimate", 
                                 "alternative", "method", "data.name", "val",
                                 "varest", "importance.ranking", 
                                 "importance.distribution", "cut.off"))
        testthat::expect_length(res.HMN.OverallOOB.n, 12)
        testthat::expect_named(res.HMN.OverallOOB.n, 
                               c("statistic", "parameter", "p.value", "estimate", 
                                 "alternative", "method", "data.name", "val", 
                                 "varest", "importance.ranking", 
                                 "importance.distribution", "cut.off"))
        testthat::expect_length(res.HMN.perm.OverallOOB.n, 12)
        testthat::expect_named(res.HMN.perm.OverallOOB.n,
                               c("statistic", "parameter", "p.value", "estimate", 
                                 "alternative", "method", "data.name", "val",
                                 "varest", "importance.ranking", 
                                 "importance.distribution", "cut.off"))
        
        # check p values in [0,1]
        testthat::expect_lte(res.HMN$p.value, 1)
        testthat::expect_gte(res.HMN$p.value, 0)
        testthat::expect_lte(res.HMN.perm$p.value, 1)
        testthat::expect_gte(res.HMN.perm$p.value, 0)
        testthat::expect_lte(res.HMN.OverallOOB$p.value, 1)
        testthat::expect_gte(res.HMN.OverallOOB$p.value, 0)
        testthat::expect_lte(res.HMN.perm.OverallOOB$p.value, 1)
        testthat::expect_gte(res.HMN.perm.OverallOOB$p.value, 0)
        testthat::expect_lte(res.HMN.n$p.value, 1)
        testthat::expect_gte(res.HMN.n$p.value, 0)
        testthat::expect_lte(res.HMN.perm.n$p.value, 1)
        testthat::expect_gte(res.HMN.perm.n$p.value, 0)
        testthat::expect_lte(res.HMN.OverallOOB.n$p.value, 1)
        testthat::expect_gte(res.HMN.OverallOOB.n$p.value, 0)
        testthat::expect_lte(res.HMN.perm.OverallOOB.n$p.value, 1)
        testthat::expect_gte(res.HMN.perm.OverallOOB.n$p.value, 0)
        # statistic is not NA
        testthat::expect_false(is.na(res.HMN$statistic))
        testthat::expect_false(is.na(res.HMN.perm$statistic))
        testthat::expect_false(is.na(res.HMN.OverallOOB$statistic))
        testthat::expect_false(is.na(res.HMN.perm.OverallOOB$statistic))
        testthat::expect_false(is.na(res.HMN.n$statistic))
        testthat::expect_false(is.na(res.HMN.perm.n$statistic))
        testthat::expect_false(is.na(res.HMN.OverallOOB.n$statistic))
        testthat::expect_false(is.na(res.HMN.perm.OverallOOB.n$statistic))
        # output should be numeric
        testthat::expect_s3_class(res.HMN, "htest")
        testthat::expect_s3_class(res.HMN.perm, "htest")
        testthat::expect_s3_class(res.HMN.OverallOOB, "htest")
        testthat::expect_s3_class(res.HMN.perm.OverallOOB, "htest")
        testthat::expect_s3_class(res.HMN.n, "htest")
        testthat::expect_s3_class(res.HMN.perm.n, "htest")
        testthat::expect_s3_class(res.HMN.OverallOOB.n, "htest")
        testthat::expect_s3_class(res.HMN.perm.OverallOOB.n, "htest")
      })
      
      testthat::test_that("output values", {
        # check test statistic values
        testthat::expect_equal(res.HMN$statistic, res.hypoRF$obs,
                               check.attributes = FALSE)
        testthat::expect_equal(res.HMN.perm$statistic, res.hypoRF.perm$obs, 
                               check.attributes = FALSE)
        testthat::expect_equal(res.HMN.OverallOOB$statistic,
                               res.hypoRF.OverallOOB$obs,
                               check.attributes = FALSE)
        testthat::expect_equal(res.HMN.perm.OverallOOB$statistic, 
                               res.hypoRF.perm.OverallOOB$obs,
                               check.attributes = FALSE)
        testthat::expect_equal(res.HMN.n$statistic, res.hypoRF.n$obs, 
                               check.attributes = FALSE)
        testthat::expect_equal(res.HMN.perm.n$statistic, res.hypoRF.perm.n$obs, 
                               check.attributes = FALSE)
        testthat::expect_equal(res.HMN.OverallOOB.n$statistic, 
                               res.hypoRF.OverallOOB.n$obs,
                               check.attributes = FALSE)
        testthat::expect_equal(res.HMN.perm.OverallOOB.n$statistic, 
                               res.hypoRF.perm.OverallOOB.n$obs,
                               check.attributes = FALSE)
        # check test p values
        testthat::expect_equal(res.HMN$p.value, res.hypoRF$pvalue,
                               check.attributes = FALSE)
        testthat::expect_equal(res.HMN.perm$p.value, res.hypoRF.perm$pvalue, 
                               check.attributes = FALSE)
        testthat::expect_equal(res.HMN.OverallOOB$p.value,
                               res.hypoRF.OverallOOB$pvalue, 
                               check.attributes = FALSE)
        testthat::expect_equal(res.HMN.perm.OverallOOB$p.value, 
                               res.hypoRF.perm.OverallOOB$pvalue, 
                               check.attributes = FALSE)
        testthat::expect_equal(res.HMN.n$p.value, res.hypoRF.n$pvalue,
                               check.attributes = FALSE)
        testthat::expect_equal(res.HMN.perm.n$p.value, res.hypoRF.perm.n$pvalue,
                               check.attributes = FALSE)
        testthat::expect_equal(res.HMN.OverallOOB.n$p.value,
                               res.hypoRF.OverallOOB.n$pvalue, 
                               check.attributes = FALSE)
        testthat::expect_equal(res.HMN.perm.OverallOOB.n$p.value, 
                               res.hypoRF.perm.OverallOOB.n$pvalue,
                               check.attributes = FALSE)
      })
      
      
      res.HMN.1 <- DataSimilarity::HMN(X1[, 1, drop = FALSE], 
                                       as.data.frame(X2)[, 1, drop = FALSE],
                                       n.perm = 0, seed = i)
      res.HMN.perm.1 <- DataSimilarity::HMN(X1[, 1, drop = FALSE], 
                                            as.data.frame(X2)[, 1, drop = FALSE], 
                                            n.perm = 10, seed = i)
      res.HMN.OverallOOB.1 <- DataSimilarity::HMN(X1[, 1, drop = FALSE], 
                                                  as.data.frame(X2)[, 1, drop = FALSE],
                                                  n.perm = 0, statistic = "OverallOOB",
                                                  seed = i)
      res.HMN.perm.OverallOOB.1 <- DataSimilarity::HMN(X1[, 1, drop = FALSE], 
                                                       as.data.frame(X2)[, 1, drop = FALSE], 
                                                       n.perm = 10, 
                                                       statistic = "OverallOOB", 
                                                       seed = i)
      res.HMN.n.1 <- DataSimilarity::HMN(X1[, 1, drop = FALSE], 
                                         as.data.frame(X2)[, 1, drop = FALSE], 
                                         n.perm = 0, normal.approx = TRUE, seed = i)
      res.HMN.perm.n.1 <- DataSimilarity::HMN(X1[, 1, drop = FALSE], 
                                              as.data.frame(X2)[, 1, drop = FALSE], 
                                              n.perm = 10, normal.approx = TRUE, 
                                              seed = i)
      res.HMN.OverallOOB.n.1 <- DataSimilarity::HMN(X1[, 1, drop = FALSE], 
                                                    as.data.frame(X2)[, 1, drop = FALSE], 
                                                    n.perm = 0, 
                                                    statistic = "OverallOOB", 
                                                    normal.approx = TRUE, 
                                                    seed = i)
      res.HMN.perm.OverallOOB.n.1 <- DataSimilarity::HMN(X1[, 1, drop = FALSE], 
                                                         as.data.frame(X2)[, 1, drop = FALSE], 
                                                         n.perm = 10, 
                                                         statistic = "OverallOOB", 
                                                         normal.approx = TRUE, 
                                                         seed = i)
      
      testthat::test_that("output type", {
        # check length and names of output
        testthat::expect_length(res.HMN.1, 12)
        testthat::expect_named(res.HMN.1, 
                               c("statistic", "parameter", "p.value", "estimate", 
                                 "alternative", "method","data.name",  "val", "varest", 
                                 "importance.ranking", "importance.distribution",
                                 "cut.off"))
        testthat::expect_length(res.HMN.perm.1, 12)
        testthat::expect_named(res.HMN.perm.1,
                               c("statistic", "parameter", "p.value",  "estimate", 
                                 "alternative", "method",  "data.name", "val", 
                                 "varest", "importance.ranking", 
                                 "importance.distribution", "cut.off"))
        testthat::expect_length(res.HMN.OverallOOB.1, 12)
        testthat::expect_named(res.HMN.OverallOOB.1, 
                               c("statistic", "parameter", "p.value", "estimate", 
                                 "alternative", "method", "data.name", "val", 
                                 "varest", "importance.ranking", 
                                 "importance.distribution", "cut.off"))
        testthat::expect_length(res.HMN.perm.OverallOOB.1, 12)
        testthat::expect_named(res.HMN.perm.OverallOOB.1, 
                               c("statistic", "parameter", "p.value", "estimate", 
                                 "alternative", "method", "data.name", "val", 
                                 "varest", "importance.ranking", 
                                 "importance.distribution", "cut.off"))
        
        testthat::expect_length(res.HMN.n.1, 12)
        testthat::expect_named(res.HMN.n.1,
                               c("statistic", "parameter", "p.value", "estimate",  
                                 "alternative",  "method", "data.name", "val",
                                 "varest", "importance.ranking", 
                                 "importance.distribution", "cut.off"))
        testthat::expect_length(res.HMN.perm.n.1, 12)
        testthat::expect_named(res.HMN.perm.n.1, 
                               c("statistic", "parameter", "p.value", "estimate", 
                                 "alternative", "method", "data.name", "val",
                                 "varest", "importance.ranking", 
                                 "importance.distribution", "cut.off"))
        testthat::expect_length(res.HMN.OverallOOB.n.1, 12)
        testthat::expect_named(res.HMN.OverallOOB.n.1, 
                               c("statistic", "parameter", "p.value", "estimate", 
                                 "alternative", "method", "data.name", "val", 
                                 "varest", "importance.ranking", 
                                 "importance.distribution", "cut.off"))
        testthat::expect_length(res.HMN.perm.OverallOOB.n.1, 12)
        testthat::expect_named(res.HMN.perm.OverallOOB.n.1,
                               c("statistic", "parameter", "p.value", "estimate", 
                                 "alternative", "method", "data.name", "val",
                                 "varest", "importance.ranking", 
                                 "importance.distribution", "cut.off"))
        
        # check p values in [0,1]
        testthat::expect_lte(res.HMN.1$p.value, 1)
        testthat::expect_gte(res.HMN.1$p.value, 0)
        testthat::expect_lte(res.HMN.perm.1$p.value, 1)
        testthat::expect_gte(res.HMN.perm.1$p.value, 0)
        testthat::expect_lte(res.HMN.OverallOOB.1$p.value, 1)
        testthat::expect_gte(res.HMN.OverallOOB.1$p.value, 0)
        testthat::expect_lte(res.HMN.perm.OverallOOB.1$p.value, 1)
        testthat::expect_gte(res.HMN.perm.OverallOOB.1$p.value, 0)
        testthat::expect_lte(res.HMN.n.1$p.value, 1)
        testthat::expect_gte(res.HMN.n.1$p.value, 0)
        testthat::expect_lte(res.HMN.perm.n.1$p.value, 1)
        testthat::expect_gte(res.HMN.perm.n.1$p.value, 0)
        testthat::expect_lte(res.HMN.OverallOOB.n.1$p.value, 1)
        testthat::expect_gte(res.HMN.OverallOOB.n.1$p.value, 0)
        testthat::expect_lte(res.HMN.perm.OverallOOB.n.1$p.value, 1)
        testthat::expect_gte(res.HMN.perm.OverallOOB.n.1$p.value, 0)
        # statistic is not NA
        testthat::expect_false(is.na(res.HMN.1$statistic))
        testthat::expect_false(is.na(res.HMN.perm.1$statistic))
        testthat::expect_false(is.na(res.HMN.OverallOOB.1$statistic))
        testthat::expect_false(is.na(res.HMN.perm.OverallOOB.1$statistic))
        testthat::expect_false(is.na(res.HMN.n.1$statistic))
        testthat::expect_false(is.na(res.HMN.perm.n.1$statistic))
        testthat::expect_false(is.na(res.HMN.OverallOOB.n.1$statistic))
        testthat::expect_false(is.na(res.HMN.perm.OverallOOB.n.1$statistic))
        # output should be htest object
        testthat::expect_s3_class(res.HMN.1, "htest")
        testthat::expect_s3_class(res.HMN.perm.1, "htest")
        testthat::expect_s3_class(res.HMN.OverallOOB.1, "htest")
        testthat::expect_s3_class(res.HMN.perm.OverallOOB.1, "htest")
        testthat::expect_s3_class(res.HMN.n.1, "htest")
        testthat::expect_s3_class(res.HMN.perm.n.1, "htest")
        testthat::expect_s3_class(res.HMN.OverallOOB.n.1, "htest")
        testthat::expect_s3_class(res.HMN.perm.OverallOOB.n.1, "htest")
      })
    }
  }
}

set.seed(0305)
testHMN(1)