tests/reachable_tests.R

In tsna: Tools for Temporal Social Network Analysis

# test the forward and backward componetnt functions
require(tsna)
require(testthat)
require(networkDynamicData)
linegraph<-network.initialize(10)
add.edges(linegraph,tail=1:9,head=2:10)

# ---- forward.reachable tests -----
# test non timed version error
test<-linegraph
expect_error(forward.reachable(test,v=1),'must be a networkDynamic')

activate.edges(test,onset=0,terminus=3)

expect_equal(forward.reachable(test,v=1,per.step.depth=Inf),1:10)

# reverse-ordered edge spells
test<-linegraph
activate.edges(test,onset=10:0,terminus=11:1)
expect_equal(forward.reachable(test,v=5,per.step.depth=Inf),5:6)
expect_equal(forward.reachable(test,v=10,per.step.depth=Inf),10)

# forward-ordred edge spells
test<-linegraph
activate.edges(test,onset=0:10,terminus=1:11)
expect_equal(forward.reachable(test,v=5,per.step.depth=Inf),5:10)
expect_equal(forward.reachable(test,v=10,per.step.depth=Inf),10)



# test with two seeds
expect_equal(forward.reachable(test,v=c(1,5)),c(1,5,2,3,4,6,7,8,9,10))

# test on undirected case
test<-linegraph
set.network.attribute(test,'directed',FALSE)
activate.edges(test,onset=0,terminus=3)
expect_equal(forward.reachable(test,v=5,per.step.depth=Inf),c(5,4,6,3,7,2,8,1,9,10))

# test on network with bounded time
test<-linegraph
activate.edges(test,onset=0:10,terminus=1:11)
expect_equal(forward.reachable(test,v=5,start=4,end=6),c(5,6,7))
expect_equal(forward.reachable(test,v=1,end=6,per.step.depth=1),c(1,2,3,4,5,6,7))


# test with finite depthtest<-linegraph
test<-linegraph
activate.edges(test,onset=0,terminus=10)
expect_equal(forward.reachable(test,v=1,per.step.depth=2,end=3),1:7)
expect_equal(forward.reachable(test,v=1,per.step.depth=1.5,end=3),1:5)

test_that("test on network with two components",{
  test<-network.initialize(10)
  activate.vertices(test)
  test[1:5,5:1]<-1
  test[6:10,10:6]<-1
  expect_equal(forward.reachable(test,v=1),1:5)
  expect_equal(forward.reachable(test,v=6),6:10)
})


test_that("network with at spell durations",{
  test<-linegraph
  activate.edges(test,onset=0:10,terminus=0:10)
  expect_equal(forward.reachable(test,v=5,per.step.depth=Inf),5:10)
  expect_equal(forward.reachable(test,v=10,per.step.depth=Inf),10)
  
})



# test on network with net.obs.period set

# test on network with way too many time steps
data(hospital_contact)
#forward.reachable(hospital,v=1,start=120, end=347640,interval=300,per.step.depth=1)


# test that it matches infction in example network

data(concurrencyComparisonNets)
which(get.vertex.attribute.active(base,'status',at=1)==1)
# size of forward component in base from v 24
sum(get.vertex.attribute.active(base,'status',at=102)==1)

epiFound<-which(get.vertex.attribute.active(base,'status',at=102)==1)
fwdFound<-forward.reachable(base,v=24,per.step.depth=1,end=100)
expect_equal(length(setdiff(fwdFound,epiFound)),0)

# --- profiling -----#
# fiveRuns1<-function(){
#   forward.reachable1(base,v=1,per.step.depth=1)
#   forward.reachable1(base,v=2,per.step.depth=1)
#   forward.reachable1(base,v=3,per.step.depth=1)
#   forward.reachable1(base,v=4,per.step.depth=1)
#   forward.reachable1(base,v=5,per.step.depth=1)
# }
# fiveRuns2<-function(){
#   forward.reachable2(base,v=1,per.step.depth=1)
#   forward.reachable2(base,v=2,per.step.depth=1)
#   forward.reachable2(base,v=3,per.step.depth=1)
#   forward.reachable2(base,v=4,per.step.depth=1)
#   forward.reachable2(base,v=5,per.step.depth=1)
# }
# 
# # memory profiling
# Rprof(filename='fwdReachable.before')
# fiveRuns2()
# Rprof(NULL)
# summaryRprof(filename='fwdReachable.before')

# # time profiling
# library(microbenchmark)
# timing<-microbenchmark(fiveRuns1(),fiveRuns2(),times=1)

# ------ tests for the reachable set sizes ----

data(moodyContactSim)
expect_equal(sort(tReach(moodyContactSim)),c(2,  2,  3,  3,  3,  3,  5,  5,  6,  8, 10, 10, 14, 15, 16, 16))

expect_equal(sort(tReach(moodyContactSim,direction='bkwd')),c(3, 4, 5, 7, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9))