tests/testthat/test-mixingmatrix.R

In network: Classes for Relational Data

# Directed networks -------------------------------------------------------

test_that("mixingmatrix() just works on a directed network", {
  net <- network.initialize(4, directed=TRUE)
  net[1,2] <- net[3,4] <- 1
  net %v% "a" <- c(1,1,2,2)
  mm <- mixingmatrix(net, "a")
  expect_type(mm, "integer")
  expect_s3_class(mm, c("mixingmatrix", "table"), exact=TRUE)
  expect_true(is.directed(mm))
  expect_false(is.bipartite(mm))
})

test_that("mixingmatrix() works on emon$Texas (directed)", {
  data(emon, package="network")
  a <- get.vertex.attribute(emon$Texas, "Location")
  el <- as.matrix(emon$Texas, matrix.type="edgelist")
  emm <- table(From=a[el[,1]], To=a[el[,2]])
  expect_equivalent(
    as.integer(mixingmatrix(emon$Texas, "Location")),
    as.integer(emm)
  )
})

test_that("NA rows & cols are present for emon$MtSi unless useNA='no'", {
  mm.no <- mixingmatrix(emon$MtSi, "Formalization", useNA="no")
  expect_type(mm.no, "integer")
  expect_identical(dim(mm.no), c(2L,2L))
  
  mm.default <- mixingmatrix(emon$MtSi, "Formalization")
  mm.ifany <- mixingmatrix(emon$MtSi, "Formalization", useNA="ifany")
  mm.always <- mixingmatrix(emon$MtSi, "Formalization", useNA="always")
  expect_identical(mm.ifany, mm.default)
  expect_identical(mm.ifany, mm.always)
  expect_identical(dim(mm.ifany), c(3L, 3L))
  expect_identical(
    mm.default,
    structure(
      c(19L, 4L, 1L, 4L, 0L, 0L, 4L, 1L, 0L), 
      .Dim = c(3L,  3L), 
      .Dimnames = list(From = c("1", "2", NA), To = c("1", "2",  NA)), 
      class = c("mixingmatrix", "table"), 
      directed = TRUE, 
      bipartite = FALSE
    )
  )
} )

test_that("mixingmatrix(directed with categories without incident ties)", {
  net <- network.initialize(4, directed = TRUE)
  net %v% "a" <- c(1,1,2,3)
  net[1,2] <- net[1,3] <- 1 # no ties incident on a=3
  mm <- mixingmatrix(net, "a")
  expect_type(mm, "integer")
  expect_equivalent(
    mm,
    structure(
      matrix(as.integer(c(1,0,0, 1,0,0, 0,0,0)), 3, 3),
      dimnames = list(From=1:3, To=1:3),
      class = c("mixingmatrix", "table")
    )
  )
})


test_that("mixingmatrx() warns on exclude=NULL", {
  net <- network.initialize(4, directed=TRUE)
  net[1,2] <- net[3,4] <- 1
  net %v% "a" <- c(1,1,2,2)
  expect_warning(
    r <- mixingmatrix(net, "a", exclude=NULL),
    regexp = "passing `exclude=NULL`"
  )
  expect_identical(r, mixingmatrix(net, "a"))
})



# Undirected networks -----------------------------------------------------

test_that("mixingmatrix() just works on a undirected network", {
  net <- network.initialize(4, directed=FALSE)
  net[1,2] <- net[1,3] <- 1
  net %v% "a" <- c(1,1, 2,2)
  mm <- mixingmatrix(net, "a")
  expect_type(mm, "integer")
  expect_equivalent(
    mm,
    structure(
      matrix(as.integer(c(1,1,1,0)), 2, 2),
      dimnames = list(From = 1:2, To = 1:2),
      class = c("mixingmatrix", "table")
    )
  )
  expect_false(is.directed(mm))
  expect_false(is.bipartite(mm))
})


test_that("NA rows & cols are shown for undirected net unless useNA='no'", {
  net <- network.initialize(2, directed=FALSE)
  net %v% "a" <- c(1, NA)
  net[1,2] <- 1

  mm.default <- mixingmatrix(net, "a")
  mm.ifany <- mixingmatrix(net, "a", useNA="ifany")
  mm.always <- mixingmatrix(net, "a", useNA="always")
  expect_identical(mm.default, mm.ifany)
  expect_identical(mm.default, mm.always)
  expect_identical(
    mm.default,
    structure(
      c(0L, 1L, 1L, 0L),
      .Dim = c(2L, 2L),
      class = c("mixingmatrix",  "table"),
      .Dimnames = list(From = c("1", NA), To = c("1", NA)),
      directed = FALSE, 
      bipartite = FALSE
    )
  )

  mm.no <- mixingmatrix(net, "a", useNA="no")
  expect_type(mm.no, "integer")
  expect_identical(dim(mm.no), c(1L, 1L))
})



# Bipartite networks ------------------------------------------------------

am <- matrix(0, 5, 5)
am[1,3] <- am[1,4] <- am[2,3] <- am[2,5] <-  1
net <- as.network(am, directed=FALSE, bipartite=2)
net %v% "mode" <- c(1,1,2,2,2)
net %v% "a" <- c(1,2,3,4,4)
net %v% "withNA" <- c(1,2,NA, 4,NA)
set.vertex.attribute(net, "p1", value = c(20, 30), v = 1:2)
set.vertex.attribute(net, "p2", value = c(0.1, 0.2, 0.1), v = 3:5)
# plot(net, vertex.col="mode", displaylabels=TRUE)

test_that("mixingmatrix for bipartite net with expand.bipartite=FALSE is correct", {
  # On `mode` so all ties between groups
  expect_silent(
    mm <- mixingmatrix(net, "mode", expand.bipartite = FALSE)
  )
  expect_type(mm, "integer")
  expect_false(is.directed(mm))
  expect_true(is.bipartite(mm))
  expect_equivalent(
    mm,
    structure(
      matrix(4L, 1, 1),
      dimnames = list(From = 1, To = 2),
      class = "mixingmatrix"
    )
  )
  
  # On `a`
  expect_silent(
    mm <- mixingmatrix(net, "a", expand.bipartite = FALSE)
  )
  expect_type(mm, "integer")
  expect_false(is.directed(mm))
  expect_true(is.bipartite(mm))
  expect_equivalent(
    mm,
    structure(
      matrix(as.integer(c(1,1, 1,1)), 2, 2),
      dimnames = list(From = 1:2, To=3:4),
      class = "mixingmatrix"
    )
  )
})


test_that("mixingmatrix for bipartite net with expand.bipartite=TRUE is correct", {
  # On `mode`
  expect_silent(
    mm <- mixingmatrix(net, "mode", expand.bipartite = TRUE)
  )
  expect_type(mm, "integer")
  expect_equivalent(
    mm,
    structure(
      matrix(as.integer(c(0,0, 4,0)), 2, 2),
      dimnames = list(From = 1:2, To=1:2),
      class = "mixingmatrix"
    )
  )
  # On `a`
  expect_silent(
    mm <- mixingmatrix(net, "a", expand.bipartite = TRUE)
  )
  expect_identical(dim(mm), c(4L, 4L))
  expect_identical(
    as.integer(mm),
    as.integer(c(0,0,0,0, 0,0,0,0, 1,1,0,0, 1,1,0,0))
  )
})


test_that("NA rows & cols are shown for bipartite net unless useNA='no'", {
  expect_silent(
    mm.default <- mixingmatrix(net, "withNA")
  )
  expect_silent(
    mm.no <- mixingmatrix(net, "withNA", useNA="no")
  )
  expect_silent(
    mm.always <- mixingmatrix(net, "withNA", useNA="always")
  )
  expect_identical(mm.default, mm.always)
  expect_identical(
    as.integer(mm.default),
    as.integer(c(1,0,0, 1,2,0))
  )
  expect_identical(dim(mm.no), c(2L, 1L))
  expect_identical(
    as.integer(mm.no),
    as.integer(c(1, 0))
  )
})