tests/testthat/test-rdiffnet.R

In USCCANA/diffusiontest: Analysis of Diffusion and Contagion Processes on Networks

context("Random diffusion graphs")

# Checking input
test_that("Input", {
  # Simple matrix --------------------------------------------------------------

  # Baseline graph
  set.seed(12312)
  x <- rgraph_ba(t=5e2-1L)

  # Using a dgCMatrix
  set.seed(131)
  x_dgCMatrix <- rdiffnet(seed.graph = x, t=10,rewire.args = list(p=c(0, rep(.1,9))))

  # Using matrix
  set.seed(131)
  x_matrix <- rdiffnet(
    seed.graph=as.array(x_dgCMatrix)[,,1],
    t=10,
    rewire.args = list(p=c(0, rep(.1,9)))
    )

  # Using a function
  set.seed(12312)
  x <- function() {
    out <- rgraph_ba(t=5e2-1L)
    set.seed(131)
    out
  }
  x_fun <- rdiffnet(seed.graph = x, t=10,rewire.args = list(p=c(0, rep(.1,9))))

  # Coercing into arrays (this is easier to compare)
  x_dgCMatrix$graph <- as.array(x_dgCMatrix)
  x_matrix$graph    <- as.array(x_matrix)
  x_fun$graph       <- as.array(x_fun)

  # Comparing
  expect_equal(x_dgCMatrix,x_matrix)
  expect_equal(x_dgCMatrix,x_fun)


  # Dynamic matrix -------------------------------------------------------------
  set.seed(12312)
  x <- rgraph_ba(t=5e2-1L)
  x <- list(x, rewire_graph(x, .1))

  set.seed(131)
  x_dgCMatrix <- rdiffnet(seed.graph = x,
                          rewire.args = list(p=0))

  set.seed(131)
  x_matrix    <- rdiffnet(seed.graph=as.array(x_dgCMatrix),
                          rewire.args = list(p=0))

  set.seed(131)
  x_diffnet   <- rdiffnet(seed.graph=x_dgCMatrix,
                          rewire.args = list(p=0))

  # Coercing into arrays (this is easier to compare)
  x_dgCMatrix$graph <- as.array(x_dgCMatrix)
  x_matrix$graph    <- as.array(x_matrix)
  x_diffnet$graph   <- as.array(x_diffnet)

  # Comparing
  expect_equal(x_dgCMatrix,x_matrix)
  expect_equal(x_dgCMatrix,x_diffnet)

})

# Seed of first adopters
test_that("All should be equal!", {
  set.seed(12131)
  g    <- rgraph_ws(20, 4, p=.3)
  set0 <- c(1,5,7,10)
  thr  <- runif(20, .4,.7)

  # Generating identical networks
  net1 <- rdiffnet(seed.graph = g, seed.nodes = set0, t = 4, rewire = FALSE,
                   threshold.dist = thr)
  net2 <- rdiffnet(seed.graph = g, seed.nodes = set0, t = 4, rewire = FALSE,
                   threshold.dist = thr)

  expect_equal(net1, net2)
})


test_that("Error and warning on rdiffnet", {

  set.seed(111)

  expect_error(rdiffnet(100, 5, threshold.dist = rep(10,10)))
  expect_error(rdiffnet(100, 5, threshold.dist = rep(10,100)), "No diffusion")
  expect_warning(rdiffnet(100, 5, threshold.dist = rep(10,100), stop.no.diff = FALSE), "No diffusion")

})

test_that("Simulation study", {

  set.seed(1)
  f <- function(x) mean(x$toa, na.rm=TRUE)
  ans0 <- suppressWarnings(rdiffnet_multiple(5, f, n=50, t=4, stop.no.diff=FALSE))

  set.seed(1)
  ans1 <- suppressWarnings(sapply(1:5, function(x) f(rdiffnet(n=50, t=4, stop.no.diff=FALSE))))

  expect_equal(ans0, ans1)

})

# Testing diffnet class across several inputs (single)
test_that("rdiffnet must run across several inputs (single)", {
  expect_s3_class(rdiffnet(100, 5), "diffnet")
  expect_s3_class(rdiffnet(100, 5, seed.p.adopt = 0.1), "diffnet")
  expect_s3_class(rdiffnet(100, 5, seed.p.adopt = 0.1, seed.nodes = 'random'), "diffnet")
  expect_s3_class(rdiffnet(100, 5, seed.nodes = c(1, 3, 5)), "diffnet")

  # summary
  net_1 <- rdiffnet(100, 5, seed.nodes = c(1,3,5))
  expect_s3_class(summary(net_1), "data.frame")
})

# Testing diffnet class across several inputs (multiple)
test_that("rdiffnet must run across several inputs (multiple)", {
  expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08)), "diffnet")
  expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), behavior = c('tabacco', 'alcohol')), "diffnet")
  expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), seed.nodes = 'random'), "diffnet")
  expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), seed.nodes = c('random', 'central')), "diffnet")
  expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), threshold.dist = 0.3), "diffnet")
  expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), threshold.dist = list(0.1, 0.2)), "diffnet")
  expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), threshold.dist = rexp(100)), "diffnet")
  expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), threshold.dist = list(rexp(100), runif(100))), "diffnet")
  expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), threshold.dist = function(x) 0.3), "diffnet")
  expect_s3_class(rdiffnet(100, 5, seed.p.adopt = list(0.1, 0.08), threshold.dist = list(function(x) 0.3, function(x) 0.2)), "diffnet")

  net_2 <- rdiffnet(100, 5, seed.p.adopt = list(0.05,0.05), seed.nodes = c(1,3,5))
  expect_s3_class(summary(net_2), "data.frame")
})

test_that("All should be equal! (multiple)", {
  set.seed(12131)
  n            <- 50
  t            <- 5
  graph        <- rgraph_ws(n, 4, p=.3)
  seed.p.adopt <- list(0.1, 0.1)
  seed.nodes   <- c(1,5,7,10)
  thr          <- runif(n, .2,.4)
  thr_list     <- list(thr,thr)

  # Generating identical networks
  net1 <- rdiffnet(seed.graph = graph, seed.nodes = seed.nodes, seed.p.adopt = seed.p.adopt,
                   t = t, rewire = FALSE, threshold.dist = thr_list)

  net2 <- rdiffnet(seed.graph = graph, seed.nodes = seed.nodes, seed.p.adopt = seed.p.adopt,
                   t = t, rewire = FALSE, threshold.dist = thr_list)

  expect_equal(net1, net2)
})


test_that("toa, adopt, and cumadopt should be equal! (split_behaviors tests)", {
  set.seed(12131)
  n            <- 50
  t            <- 5
  graph        <- rgraph_ws(n, 4, p=.3)
  seed.nodes   <- c(1,5,7,10)
  thr          <- runif(n, .2,.4)

  # Generating identical networks
  net_single <- rdiffnet(seed.graph = graph, seed.nodes = seed.nodes, seed.p.adopt = 0.1,
                         t = t, rewire = FALSE, threshold.dist = thr)

  net_multiple <- rdiffnet(seed.graph = graph, seed.nodes = seed.nodes, seed.p.adopt = list(0.1, 0.1),
                           t = t, rewire = FALSE, threshold.dist = thr)

  net_single_from_multiple <- split_behaviors(net_multiple)
  net_single_from_multiple_1 <- net_single_from_multiple[[1]]

  expect_equal(net_single_from_multiple_1$toa, net_single$toa)
  expect_equal(net_single_from_multiple_1$adopt, net_single$adopt)
  expect_equal(net_single_from_multiple_1$cumadopt, net_single$cumadopt)
})

test_that("Disadoption works", {


  set.seed(1231)
  n <- 500

  d_adopt <- function(expo, cumadopt, time) {

    # Id double adopters
    ids <- which(apply(cumadopt[, time, , drop=FALSE], 1, sum) > 1)

    if (length(ids) == 0)
      return(list(integer(), integer()))

    # Otherwise, make them pick one (literally, you can only adopt
    # A single behavior, in this case, we prefer the second)
    return(list(ids, integer()))

  }

  ans_d_adopt <- rdiffnet(n = n, t = 10, disadopt = d_adopt, seed.p.adopt = list(0.1, 0.1))

  tmat <- toa_mat(ans_d_adopt)
  should_be_ones_or_zeros <- tmat[[1]]$cumadopt[, 10] + tmat[[2]]$cumadopt[, 10]
  expect_true(all(should_be_ones_or_zeros %in% c(0,1)))

})