tests/testthat/test-bootnet.r

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

context("Network bootstrap")

# rn(list=ls())
# library(microbenchmark)
# library(netdiffuseR)
#
# set.seed(1231)
# g <- rgraph_ba(t=1e2, m=2)
# index <- sample(1:nnodes(g), nnodes(g), TRUE)
# E <- g@x
# g <- g[index,index]
#
# microbenchmark(
#   R   = netdiffuseR:::bootnet_fillselfR(g, index, E),
#   Cpp = netdiffuseR:::bootnet_fillself(g, index, E), times=1e3,
#   unit= "relative"
# )

# ------------------------------------------------------------------------------
test_that("Filling zeros", {

  set.seed(123)
  n <- 5
  g <- rgraph_ba(t = n-1, self=FALSE, m = 1)

  set.seed(1)
  ans0 <- bootnet(g, function(w, i, ...) length(w@x), R=100,
                  resample.args = list(self=FALSE, useR=FALSE))

  set.seed(1)
  ans1 <- bootnet(g, function(w, i, ...) length(w@x), R=100,
                  resample.args = list(self=FALSE, useR=TRUE))

  expect_equal(ans1[-length(ans0)], ans1[-length(ans1)])
})

# ------------------------------------------------------------------------------
test_that("Methods", {
  # Generating the data
  set.seed(1291)

  # Static graphs
  graphdg <- rgraph_ba(t=9)
  graphmt <- as.matrix(graphdg)

  set.seed(123); ans0 <- resample_graph(graphdg)
  set.seed(123); ans1 <- resample_graph(graphmt)

  expect_equal(ans0, ans1)

  # Dynamic graphs
  graphls <- lapply(1:3, function(x) rgraph_ba(t=9))
  names(graphls) <- 2001:2003
  toa <- sample(c(2001:2003, NA), 10, TRUE)

  graphdn <- as_diffnet(graphls, toa, t0=2001, t1=2003)$graph
  graphar <- lapply(graphls, as.matrix)
  graphar <- array(unlist(graphar), dim=c(10,10,3),
                   dimnames = list(1:10, 1:10, 2001:2003))

  set.seed(123); ans0 <- resample_graph(graphls)
  set.seed(123); ans1 <- resample_graph(graphdn)
  set.seed(123); ans2 <- resample_graph(graphar)

  expect_equivalent(ans0, ans1)
  expect_equivalent(ans0, ans2)
})

# ------------------------------------------------------------------------------
test_that("diffnet_bootnet methods", {
  set.seed(1222)
  x <- rgraph_ba(t=19, m=1)
  ans <- bootnet(x, function(g,...) mean(dgr(g)), R=50)

  expect_output(print(ans), "Network Bootstrap")
  expect_silent(hist(ans, ask=FALSE))
  expect_s3_class(c(ans, ans), "diffnet_bootnet")
  expect_output(print(c(ans, ans)), ": 100")

})
# rn(list=ls())
# library(microbenchmark)
# library(netdiffuseR)
#
# set.seed(1231)
# g <- rgraph_ba(t=1e2, m=2)
# index <- sample(1:nnodes(g), nnodes(g), TRUE)
# E <- g@x
# g <- g[index,index]
#
# microbenchmark(
#   R   = netdiffuseR:::bootnet_fillselfR(g, index, E),
#   Cpp = netdiffuseR:::bootnet_fillself(g, index, E), times=1e3,
#   unit= "relative"
# )

# rm(list=ls())
# library(netdiffuseR)
# set.seed(123)
# n <- 5
# g <- rgraph_ba(t = n-1, self=FALSE, m = 1)
#
# set.seed(1); ans0 <- bootnet(g, function(w, ...) ifelse(inherits(w, "list"), length(w$graph@x), length(w@x)), R=100)
# set.seed(1); ans1 <- bootnet(g, function(w, ...) ifelse(inherits(w, "list"), length(w$graph@x), length(w@x)), R=100,
#                              resample.args = list(self=FALSE, useR=FALSE))
#

# library(netdiffuseR)
# n <- 100
# G <- rgraph_ws(n=n, p = .5, undirected = FALSE, self=FALSE, k=4)
# G <- list(G,G)
# Y1 <- sample(c(0,1), n, TRUE)
# Y2 <- Y1
# Y2[Y2==0] <- sample(c(0,1), sum(Y2==0), TRUE)
# X <- runif(n*2)
# dat <- data.frame(Y=c(Y1, Y2), X, year=c(rep(1,n), rep(2,n)))
# dat1 <- subset(dat, year==1)
# dat2 <- subset(dat, year==2)
#
# ans1 <- bootnet(G, function(g, idx) {
#   d <- rbind(dat1[idx,], dat2[idx,])
#   suppressMessages(netmatch(d, g, "year", "Y", "X", treat_thr = 3, method="cem")$fATT)
# }, R=1e3)
#
# ans2 <- struct_test(G, function(g, idx) {
#   suppressMessages(netmatch(dat, g, "year", "Y", "X", treat_thr = 3, method="cem")$fATT)
# }, R=1e3)
#