tests/pid_tests.R

In networkDynamic: Dynamic Extensions for Network Objects

#  Part of the statnet package, http://statnetproject.org
#
#  This software is distributed under the GPL-3 license.  It is free,
#  open source, and has the attribution requirements (GPL Section 7) in
#    http://statnetproject.org/attribution
#
#  Copyright 2013 the statnet development team
######################################################################

require(networkDynamic)
require(testthat)

#Create a network with three edges
m<-matrix(0,3,3)
m[1,2]<-1; m[2,3]<-1; m[3,1]<-1
g<-network(m)

#Create a matrix of values corresponding to edges
mm<-m
mm[1,2]<-7; mm[2,3]<-4; mm[3,1]<-2

#Assign some attributes
set.edge.attribute(g,"myeval",3:5)
set.edge.value(g,"myeval2",mm)
set.network.attribute(g,"mygval","boo")
set.vertex.attribute(g,"myvval",letters[1:3])
network.vertex.names(g) <- LETTERS[1:10]

set.network.attribute(g, 'vertex.pid', 'vertex.names')


# check if some pid missing

#------ get.vertex.id checks ------

expect_equal(get.vertex.id(g, 'A'),1)
expect_equal(get.vertex.id(g, 'B'),2)
# returns NA if not found
expect_true(is.na(get.vertex.id(g, 'D')))

# check multiple works
expect_equal(get.vertex.id(g, c('B','C','D')),c(2,3,NA))

expect_error(get.vertex.id(network.initialize(5),"does not have a 'vertex.pid' attribute"))

expect_error(get.vertex.id(network.initialize(0),"does not have a 'vertex.pid' attribute"))


#------- get.vertex.pid checks ---

expect_equal(get.vertex.pid(g, 2),'B')
# returns NA if not found
expect_true(is.na(get.vertex.pid(g, 5)))

# multiple works
expect_equal(get.vertex.pid(g,c(2,3,4)),c("B","C",NA))

# check when no vertex pid speced
expect_error(get.vertex.pid(network.initialize(5),"does not have a 'vertex.pid' attribute"))

expect_error(get.vertex.pid(network.initialize(0),"does not have a 'vertex.pid' attribute"))


# ---------- add.vertices  checks -----

# test calling original function, direct assignment
net <- as.networkDynamic(network.initialize(1))
net <-add.vertices(net,nv=3)
expect_equal(network.size(net),4,info='add.vertices direct assignment')

# test calling original function, modify inplace
net <- as.networkDynamic(network.initialize(1))
add.vertices(net,nv=3)
expect_equal(network.size(net),4,info='add.vertices modify in place')


net <- as.networkDynamic(network.initialize(1))
set.network.attribute(net,'vertex.pid','data_id')
set.vertex.attribute(net,'data_id','one')

# adding wrong number of ids gives error
expect_error(add.vertices(net,4,vertex.pid=c('two','three','four')), info='does not match number of new vertices')

# adding duplicate ids gives error

expect_error(add.vertices(net,4,vertex.pid=c('two','three','three','three')), info='vertex.pid values must be unique')

# error did not modify network
expect_equal(network.size(net),1)

# adding correctly 
add.vertices(net,4,vertex.pid=c('two','three','four','five'))
expect_equal(network.size(net),5, info='add.vertices check verts added')
expect_equal(net%v%'data_id',c("one","two","three","four","five" ),info='add.vertices added vertex.pids')

# adding with no specified pid
add.vertices(net,3)
expect_equal(anyDuplicated(get.vertex.attribute(net,'data_id')),0)

# adding with pid disabled
net<-as.networkDynamic(network.initialize(3))
set.network.attribute(net,'vertex.pid',NULL)
expect_equal(network.size(add.vertices(net,3)),6)

# adding to net of size 0

expect_equal(network.size(add.vertices(network.initialize(0),1)),1)

# ------------ add.edges checks ----

# no pid defined, modify in place
nd<-as.networkDynamic(network.initialize(3))
add.edges(nd,tail=1:3,head=c(2,3,1))
expect_equal(network.edgecount(nd),3)

# direct assignement
nd<-as.networkDynamic(network.initialize(3))
nd2<-add.edges(nd,tail=1:3,head=c(2,3,1))
expect_equal(network.edgecount(nd2),3)

# pid defined
nd<-as.networkDynamic(network.initialize(3))
set.network.attribute(nd,'edge.pid','myFavoriteId')
add.edges(nd,tail=1:3,head=c(2,3,1))
expect_true(nd%n%'edge.pid'=='myFavoriteId')
expect_equal(length(get.edge.attribute(nd,'myFavoriteId')),3,info='check add.edges created pids for edges')
expect_true('myFavoriteId'%in%list.edge.attributes(nd),info='check add.edges created edge.pid with correct name')

# adding to net with edges, and passing 
nd<-as.networkDynamic(network.initialize(3))
add.edges(nd,tail=1:3,head=c(2,3,1))
set.network.attribute(nd,'edge.pid','edge.pid')
set.edge.attribute(nd,'edge.pid',c("A","B","C"))
add.edges(nd,tail=3,head=1,edge.pid="D")
add.edges(nd,tail=3,head=2)

expect_equal(length(get.edge.attribute(nd,'edge.pid')),5)
expect_equal(get.edge.attribute(nd,'edge.pid')[1:4],LETTERS[1:4])
             
# ------------ add.edge checks ----
             
# no pid defined, modify in place
nd<-as.networkDynamic(network.initialize(3))
add.edge(nd,tail=1,head=2)
expect_equal(network.edgecount(nd),1)
             
# direct assignement
nd<-as.networkDynamic(network.initialize(3))
nd2<-add.edge(nd,tail=1,head=2)
expect_equal(network.edgecount(nd2),1)
             
# pid defined
nd<-as.networkDynamic(network.initialize(3))
set.network.attribute(nd,'edge.pid','myFavoriteId')
add.edge(nd,tail=1,head=2)
expect_true(nd%n%'edge.pid'=='myFavoriteId')
expect_equal(length(get.edge.attribute(nd,'myFavoriteId')),1,info='check add.edge created pids for edges')
expect_true('myFavoriteId'%in%list.edge.attributes(nd),info='check add.edge created edge.pid with correct name')
             
# adding to net with edges, and passing 
nd<-as.networkDynamic(network.initialize(3))
add.edges(nd,tail=1:3,head=c(2,3,1))
set.network.attribute(nd,'edge.pid','edge.pid')
set.edge.attribute(nd,'edge.pid',c("A","B","C"))
add.edge(nd,tail=3,head=1,edge.pid="D")
add.edge(nd,tail=3,head=2)
             
expect_equal(length(get.edge.attribute(nd,'edge.pid')),5)
expect_equal(get.edge.attribute(nd,'edge.pid')[1:4],LETTERS[1:4])             
             
             
# check error for non-unique
nd<-as.networkDynamic(network.initialize(3))
set.network.attribute(nd,'edge.pid','edge.pid')
expect_error(add.edge(nd,tail=1,head=2,edge.pid=c("A","A","A")), 'Only one edge.pid can be specified')   
             
# check for errror from existign non-unique
nd<-as.networkDynamic(network.initialize(3))
set.network.attribute(nd,'edge.pid','edge.pid')  
add.edges(nd,tail=1:3,head=c(2,3,1))
set.edge.attribute(nd,'edge.pid',"A")             
expect_error(add.edge(nd,tail=3,head=1,edge.pid="B"),"edge.pid attribute must be specified and unique for each edge")
             
             

# ---- intitialize.pids ----

test<-as.networkDynamic(network.initialize(30))
add.edges(test,1:29,2:30)
initialize.pids(test)
expect_equal(anyDuplicated(get.vertex.attribute(test,'vertex.pid')),0)
expect_equal(anyDuplicated(get.edge.attribute(test,'edge.pid')),0)

initialize.pids(network.initialize(0))

# ----- get.edge.id ----------------
net<-as.networkDynamic(network.initialize(5))
add.edges(net,1:4,2:5)
set.edge.attribute(net,'data_id',LETTERS[1:4])
set.network.attribute(net,'edge.pid','data_id')
expect_equal(get.edge.id(net,c("B","D")),c(2,4))

# error if not defined
expect_error(get.edge.id(network.initialize(4)),"does not have an 'edge.pid' attribute")

# NA if not existing

expect_true(is.na(get.edge.id(net,"L")))

# ----- get.edge.pid -----
expect_equal(get.edge.pid(net,c(1,4)),c("A","D"))

# NA if out of range
expect_true(identical(get.edge.pid(net,c(4,5)),c("D",NA)))

# error if not defined
expect_error(get.edge.pid(network.initialize(4)),"does not have an 'edge.pid' attribute")

expect_error(get.edge.pid(network.initialize(0)),"does not have an 'edge.pid' attribute")
             
             


#----- edge.pid.check  checks ---------
nd <-as.networkDynamic(network.initialize(5))
add.edges(nd,1:4,2:5)
set.edge.attribute(nd,"myId",LETTERS[1:4])
set.network.attribute(nd,'edge.pid','myId')

expect_true(edge.pid.check(nd))

# missing
delete.edge.attribute(nd,"myId")
expect_error(edge.pid.check(nd),'Missing edge.pids')

# partially missing
set.edge.attribute(nd,"myId",LETTERS[1:3],e=1:3)
expect_error(edge.pid.check(nd),'must be specified and unique')


# not unique
set.edge.attribute(nd,"myId","a")
expect_error(edge.pid.check(nd),'must be specified and unique')

# not defined
expect_warning(edge.pid.check(network.initialize(2)),"does not have an 'edge.pid' attribute")

expect_warning(edge.pid.check(network.initialize(0)),"does not have an 'edge.pid' attribute")



# ----- vertex.pid.check checks ------
nd <-as.networkDynamic(network.initialize(5))
set.vertex.attribute(nd,"myId",LETTERS[1:5])
set.network.attribute(nd,'vertex.pid','myId')
expect_true(vertex.pid.check(nd),info='checking correctly formatted edge.pid')

nd <-as.networkDynamic(network.initialize(5))
set.vertex.attribute(nd,"myId",LETTERS[1:4],v=1:4)
set.network.attribute(nd,'vertex.pid','myId')
expect_error(vertex.pid.check(nd),info='error for mis-formatted vertex.pid')

expect_warning(vertex.pid.check(network.initialize(3)),"does not have a 'vertex.pid' attribute")

expect_warning(vertex.pid.check(network.initialize(0)),"does not have a 'vertex.pid' attribute")

# ------- extraction check ----
nd <-as.networkDynamic(network.initialize(5))
set.vertex.attribute(nd,"myId",LETTERS[1:5])
set.network.attribute(nd,'vertex.pid','myId')
activate.vertices(nd,onset=c(1,2,3,4,5),terminus=c(3,4,5,6,7))
n3<-network.extract(nd,at=3)
expect_equal(get.vertex.attribute(n3,'myId'),c("B","C"))
expect_equal(get.vertex.id(n3,c("A","B","C")),c(NA,1,2))


# find vertex corresponding to extracted vertex
haystack<-network.initialize(30)
activate.vertices(haystack,v=10:20)
# hide a needle somewhere in the haystack
set.vertex.attribute(haystack,'needle',TRUE,v=10)
initialize.pids(haystack)
# some hay is removed over time ...
newstack<-network.extract(haystack,at=100,active.default=FALSE)
# we find the needle!
needleId <-which(get.vertex.attribute(newstack,'needle'))

# which vertex is the corresponding one in original stack?
oldId<-get.vertex.id(haystack,get.vertex.pid(newstack,needleId))

expect_true(get.vertex.attribute(haystack,'needle')[oldId],info="find vertex corresponding to extracted vertex")