tests/testthat/test_get_residuals.R

In jonotuke/graphResiduals: Calculates sampled residuals for random networks

library(graphResiduals)

context("Residual functions")

test_that("random_sample",
          {
            set.seed(1000)
            x <- random_sample(1000,100)
            set.seed(1000)
            y <- sort(sample(0:999,100))
            expect_equal(x,y)
          }
)

test_that("get_residuals",
          {
            d <- sim_erdos(1000,0.5)
            s <- 10
            q <- 1
            tmp <- get_residuals(d, sample_size = 100, q = q, s = s)
            expect_equal(tmp$`sample age`, mean(tmp$`sample index`))
            D <- d[tmp$`sample index`+1, tmp$`sample index`+1]
            D <- D[upper.tri(D)]
            expect_equal(tmp$`sample edge fraction`, mean(D<0))
            expect_equal(tmp$`sample average distance`, mean(abs(D)))
            expect_equal(tmp$`sample waxman prob`, mean(q*exp(-s*abs(D))))
            s <- 1
            q <- 1
            tmp <- get_residuals(d, sample_size = 100, q = q, s = s)
            expect_equal(tmp$`sample age`, mean(tmp$`sample index`))
            D <- d[tmp$`sample index`+1, tmp$`sample index`+1]
            D <- D[upper.tri(D)]
            expect_equal(tmp$`sample edge fraction`, mean(D<0))
            expect_equal(tmp$`sample average distance`, mean(abs(D)))
            expect_equal(tmp$`sample waxman prob`, mean(q*exp(-s*abs(D))))
          }
)

test_that("get_residuals_multi",
          {
            d <- sim_erdos(100,0.5)
            set.seed(1000)
            tmp <- get_residuals(d,10,1,1)
            set.seed(1000)
            tmp2 <- get_residuals_multi(d,10,10,1,1)
            expect_equal(tmp$`sample age`, tmp2$age[1])
            expect_equal(tmp$`sample edge fraction`, tmp2$frac[1])
            expect_equal(tmp$`sample waxman prob`, tmp2$wax[1])
            expect_equal(tmp$`sample average distance`, tmp2$dist[1])
          })

test_that("get_sample_size",
          {
            expect_equal(get_sample_size(1000), 707)
            expect_equal(get_sample_size(100), 71)
          }
)

test_that("get_residual_wrapper erdos",
          {
            erdos_sim <- sim_erdos(1000,0.5)
            erdos_residuals <- get_residuals_wrapper(erdos_sim, 0.5, 1, 1,n_samples = 100)
            expect_gte(cor.test(erdos_residuals$age,
                                erdos_residuals$erdos_residuals)$p.value,0.05)
            expect_gte(cor.test(erdos_residuals$dist,
                                erdos_residuals$erdos_residuals)$p.value,0.05)
          })

test_that("get_residual_wrapper waxman",
          {
            waxman_sim <- sim_waxman(1000,0.5,1)
            waxman_residuals <- get_residuals_wrapper(dist = waxman_sim,
                                                      p = 1, q = 0.5, s = 1,
                                                      n_samples = 100)
            expect_lte(cor.test(waxman_residuals$dist,
                                waxman_residuals$frac)$p.value,0.05)
            expect_gte(cor.test(waxman_residuals$dist,
                                waxman_residuals$waxman_residuals)$p.value,0.05)
          })

test_that("get_residual_wrapper barabasi",
          {
            # Set PA empirical model
            barabasi_sim <- sim_barabasi(1000,m = 10)
            barabasi_residuals <- get_residuals_wrapper(dist = barabasi_sim,
                                                      p = 1, q = 0.5, s = 1,
                                                      n_samples = 500)
            PA_loess <- loess(frac ~ age, data =barabasi_residuals)

            barabasi_sim <- sim_barabasi(1000,m = 10)
            barabasi_residuals <- get_residuals_wrapper(dist = barabasi_sim,
                                                      p = 1, q = 0.5, s = 1,
                                                      n_samples = 100,
                                                      PA_model = PA_loess)

            expect_lte(cor.test(barabasi_residuals$age,
                                barabasi_residuals$frac)$p.value,0.05)
            expect_gte(cor.test(barabasi_residuals$age,
                                barabasi_residuals$barabasi_residuals)$p.value,0.05)
          })