# 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")