tests/testthat/test-diffnet-class.R

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

context("Diffnet class and methods")

# Checking attributes ----------------------------------------------------------
test_that("Checking attributes in new_diffnet", {
  # Generating data
  suppressWarnings(RNGversion("3.5.0"))
  set.seed(3312)
  graph <- lapply(1990:2001, function(x) rgraph_ba(t = 9))
  attrs <- matrix(runif(10*3), ncol=3)
  dynat <- lapply(1990:2001, function(x) attrs)
  toa   <- sample(c(NA,1990:2001), 10, TRUE)

  # Dynamic attributes --------------------------------------------------------
  # Number of rows
  expect_error(
    new_diffnet(graph, toa, t0=1990, t1=2001, vertex.dyn.attrs = attrs[-1,]),
    "incorrect number of rows")

  # Length of list
  expect_error(
    new_diffnet(graph, toa, t0=1990, t1=2001, vertex.dyn.attrs = dynat[-1]),
    "equal.+slices")

  # An element has different length
  expect_error({
    dynat[[2]] <- dynat[[1]][-1,]
    dynat[[4]] <- dynat[[1]][-1,]
    new_diffnet(graph, toa, t0=1990, t1=2001, vertex.dyn.attrs = dynat)
  }, "don't have n.+rows")
  dynat <- lapply(1990:2001, function(x) attrs)

  # Elements have different classes
  expect_error({
    dynat[[6]] <- as.data.frame(dynat[[6]])
    new_diffnet(graph, toa, t0=1990, t1=2001, vertex.dyn.attrs = dynat)
  }, "should be of the same class")
  dynat[[6]] <- dynat[[1]]

  # Have different colnames
  cnames <- netdiffuseR:::make_col_names(3, TRUE)
  dynat <- lapply(dynat, function(x) {
    colnames(x) <- cnames
    x
  })
  colnames(dynat[[4]]) <- paste0(colnames(dynat[[1]]),"col")
  expect_error({
    new_diffnet(graph, toa, t0=1990, t1=2001, vertex.dyn.attrs = dynat)
  }, "have the same colname")


  # Dynamic list of vectors
  dynat <- lapply(1990:2001, function(x) attrs[,1])
  new_diffnet(graph, toa, t0=1990, t1=2001, vertex.dyn.attrs = dynat)

  # Static attributes ----------------------------------------------------------
  expect_error(
    new_diffnet(graph, toa, t0=1990, t1=2001, vertex.static.attrs = attrs[-1,]),
    "incorrect number of rows")
})

# Summary ----------------------------------------------------------------------
test_that("Summary and subsetting slices", {
  suppressWarnings(RNGversion("3.5.0"))
  set.seed(13131)
  diffnet <- rdiffnet(100, 20)

  sum1 <- summary(diffnet, no.print = TRUE)
  sum2 <- summary(diffnet[,,7:13], no.print = TRUE)

  # Number of adopters should hold (adoption rate)
  expect_equal(sum1[nrow(sum1),c("cum_adopt")],sum2[nrow(sum2),c("cum_adopt")])
})

# diffnet.attrs errors ---------------------------------------------------------
test_that("Error messages", {
  suppressWarnings(RNGversion("3.5.0"))
  set.seed(009)
  diffnet <- rdiffnet(80, 20, seed.nodes = "random", seed.p.adopt = .1)

  # Invalid attr.class
  expect_error(diffnet.attrs(diffnet, "vertex", attr.class = "opa"), "should only have")
  expect_error(diffnet.attrs(diffnet, "svertex", attr.class = "dyn"), "should only have")

  # Already a diffnet
  expect_message(new_diffnet(diffnet), "already.+diffnet")

})

test_that("Passing id.and.per.vars gives the right sorting", {
  # Right sort
  data(fakesurveyDyn)

  # Creating a diffnet object
  fs_diffnet <- survey_to_diffnet(
    fakesurveyDyn, "id", c("net1", "net2", "net3"), "toa", "group",
    timevar = "time", keep.isolates=TRUE, warn.coercion=FALSE)

  # Now, we extract the graph data and create a diffnet object from scratch
  graph <- fs_diffnet$graph
  ids <- fs_diffnet$meta$ids
  graph <- Map(function(g) {
    dimnames(g) <- list(ids,ids)
    g
  }, g=graph)
  attrs <- diffnet.attrs(fs_diffnet, as.df=TRUE)
  toa   <- diffnet.toa(fs_diffnet)

  # Lets apply a different sorting to the data to see if it works
  n <- nrow(attrs)
  attrs <- attrs[order(runif(n)),]

  # Now, recreating the old diffnet object (notice -id.and.per.vars- arg)
  fs_diffnet_new <- new_diffnet(graph, toa=toa, vertex.dyn.attrs=attrs,
                               id.and.per.vars = c("id", "per"))

  # Now, retrieving attributes. The 'new one' will have more (repeated)
  attrs_new <- diffnet.attrs(fs_diffnet_new, as.df=TRUE)
  attrs_old <- diffnet.attrs(fs_diffnet, as.df=TRUE)

  # Comparing elements!
  tocompare <- intersect(colnames(attrs_new), colnames(attrs_old))
  expect_true(all(attrs_new[,tocompare] == attrs_old[,tocompare], na.rm = TRUE)) # TRUE!

})

# test_that("Setting attributes", {
#   set.seed(909)
#   diffnet <- rdiffnet(80, 20, seed.nodes = "random", seed.p.adopt = .1)
#
#   expect_error(diffnet.attrs(diffnet) <- as.matrix(sample(1:4, 20, TRUE)), "different lengths")
# })

test_that("Changing toa", {
  suppressWarnings(RNGversion("3.5.0"))
  set.seed(182321)
  diffnet <- rdiffnet(100, 10)

  # All to the first time period
  diffnet.toa(diffnet) <- 1L
  expect_output(print(diffnet), "Final prevalence\\s+[:] 1\\.0")

  # No adopters... what!?
  diffnet.toa(diffnet) <- NA
  expect_output(print(diffnet), "Final prevalence\\s+[:] 0\\.0")
})

# Checking different input classes ---------------------------------------------
test_that("new_diffnet with different graph classes", {
  # Random diffnet
  suppressWarnings(RNGversion("3.5.0"))
  set.seed(881)
  graph0 <- rdiffnet(100, 10)

  # Getting the bits
  g_array <- as.array(graph0)
  g_dgcMa <- graph0$graph
  toa     <- diffnet.toa(graph0)
  s_attrb <- data.frame(x=graph0[["real_threshold"]])

  # Using different inputs
  dn_arr <- new_diffnet(g_array, toa=toa, vertex.static.attrs = s_attrb, t0=1, t1=10)
  dn_dgc <- new_diffnet(g_dgcMa, toa=toa, vertex.static.attrs = s_attrb, t0=1, t1=10)

  # Comparing adjmats
  test <- sapply(seq_len(10), function(x) identical(as.matrix(dn_arr$graph[[x]]), as.matrix(dn_dgc$graph[[x]])))
  expect_true(all(test))

  # Comparing the rest
  dn_arr$graph      <- dn_dgc$graph      <- NULL
  dn_arr$meta$class <- dn_dgc$meta$class <- NULL
  expect_equal(dn_arr, dn_dgc)

  # # Defunct
  # expect_error(diffnet.attrs(dn_arr, "hola") <- NULL, class = "defunctError")

})

# ------------------------------------------------------------------------------
test_that("Warnings and errors", {
  suppressWarnings(RNGversion("3.5.0"))
  set.seed(11222344)
  g <- rdiffnet(100,5)
  g[["dynamic"]] <- lapply(1:5, function(x) runif(100))

  # Messages
  expect_warning(with(g, new_diffnet(graph, as.numeric(toa))), "into integer")

  attrs <- as.matrix(g$vertex.static.attrs)
  dimnames(attrs) <- NULL

  dynattrs <- lapply(g$vertex.dyn.attrs, function(x) {
    ans <- as.matrix(x)
    dimnames(ans) <- NULL
    ans
    })
  ans <- with(g, new_diffnet(graph, toa, vertex.static.attrs = attrs,
                            vertex.dyn.attrs = dynattrs))

  # Making variables
  expect_output(print(ans), "V1 \\(1\\)")
  expect_output(print(ans), "v\\.dyn\\.1 \\(1\\)")
  expect_s3_class(ans$vertex.static.attrs, "data.frame")

  expect_error(
    with(g, new_diffnet(graph, toa, vertex.static.attrs = 1:99))
  )
  expect_error(
    with(g, new_diffnet(graph, toa, graph.attrs = vector("list",5)))
  )

  # Different method of dynamic attributes
  ans0 <- with(g, new_diffnet(graph, toa, vertex.static.attrs = attrs,
                            vertex.dyn.attrs = do.call(rbind, dynattrs)))

  ans1 <- with(g, new_diffnet(graph, toa, vertex.static.attrs = attrs,
                             vertex.dyn.attrs = do.call(rbind, dynattrs)[,1]))
  expect_equal(ans,ans0)
  expect_equal(ans,ans1)
})

# ------------------------------------------------------------------------------
test_that("graph attributes", {
  suppressWarnings(RNGversion("3.5.0"))
  set.seed(131)
  g <- lapply(1:4, function(x) rgraph_ba(t=9))
  toa <- sample(c(NA, 1:4), 10, TRUE)

  # Less than expected
  expect_error(new_diffnet(g, toa, graph.attrs = runif(3)), "3 .+ 4")
  expect_error(new_diffnet(g, toa, graph.attrs = data.frame(runif(3))), "3 .+ 4")
  expect_output(print(
    new_diffnet(g, toa, graph.attrs = runif(4))$graph.attrs
  ), "1 .+\\n2 .+\\n3 .+\\n4")

})