# 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 ###################################################################### #test networkDynamic conversion functionality require(networkDynamic) require(testthat) # ------ get.vertex.activity test ------ net<-network.initialize(5) activate.vertices(net,onset=c(1,2,3,-Inf,100),terminus=c(10,20,Inf,30,Inf)) activate.vertices(net,at=1000) expect_equal(unlist(get.vertex.activity(net)),c(1,1000,10,1000,2,1000,20,1000,3,Inf,-Inf,1000,30,1000,100,Inf),info='check if spell list has correct elements in get.vertex.activity') expect_equivalent(get.vertex.activity(net,as.spellList=TRUE),data.frame(onset=c(1,1000,2,1000,3,-Inf,1000,100),terminus=c(10,1000,20,1000,Inf,30,1000,Inf),vertex.id=c(1,1,2,2,3,4,4,5),onset.censored=c(FALSE,FALSE,FALSE,FALSE,FALSE,TRUE,FALSE,FALSE),terminus.censored=c(FALSE,FALSE,FALSE,FALSE,TRUE,FALSE,FALSE,TRUE),duration=c(9,0,18,0,Inf,Inf,0,Inf)),info="check if get.vertex.activity(spellList) returns correct data") # check sort order expect_equal(get.vertex.activity(net,as.spellList=TRUE)$vertex.id,c(1,1,2,2,3,4,4,5),info="check sort order of get.vertex.activity vertex.id") expect_equal(get.vertex.activity(net,as.spellList=TRUE)$onset,c(1,1000,2,1000,3,-Inf,1000,100),info="check sort order of get.vertex.activity onset") expect_equal(get.vertex.activity(net,as.spellList=TRUE)$terminus,c(10,1000,20,1000,Inf,30,1000,Inf),info="check sort order of get.vertex.activity terminus") expect_equal(get.vertex.activity(network.initialize(0)),list()) # check that net.obs.period triggers censoring nop <- list(observations=list(c(-5,1001)), mode="discrete", time.increment=1,time.unit="step") set.network.attribute(net,'net.obs.period',nop) expect_equivalent(get.vertex.activity(net,as.spellList=TRUE),data.frame(onset=c(1,1000,2,1000,3,-5,1000,100),terminus=c(10,1000,20,1000,1001,30,1000,1001),vertex.id=c(1,1,2,2,3,4,4,5),onset.censored=c(FALSE,FALSE,FALSE,FALSE,FALSE,TRUE,FALSE,FALSE),terminus.censored=c(FALSE,FALSE,FALSE,FALSE,TRUE,FALSE,FALSE,TRUE),duration=c(9,0,18,0,998,35,0,901)),info="check that net.obs.period triggers censoring in get.vertex.activity(spellList)") # check for bug with no activity #192 nd<-network.initialize(2) nd<-add.edges.active(nd,at=1,tail=1,head=2) expect_equivalent(get.vertex.activity(nd,as.spellList=TRUE),data.frame(onset=c(-Inf,-Inf),terminus=c(Inf,Inf),vertex.id=c(1,2),onset.censored=c(TRUE,TRUE),terminus.censored=c(TRUE,TRUE),duration=c(Inf,Inf)),info="checking with no vertex activity") # test if activity is missing for an element activate.vertices(nd,onset=1,terminus=2,v=2) expect_equivalent(get.vertex.activity(nd,as.spellList=TRUE),data.frame(onset=c(-Inf,1),terminus=c(Inf,2),vertex.id=c(1,2),onset.censored=c(TRUE,FALSE),terminus.censored=c(TRUE,FALSE),duration=c(Inf,1)),info="test when only some verticies have activity") # test when default activity set false expect_equivalent( get.vertex.activity(nd,as.spellList=TRUE,active.default=FALSE), data.frame(onset=1,terminus=2,vertex.id=2,onset.censored=FALSE,terminus.censored=FALSE,duration=1),info="test when only some verticies have activity and active.default=FALSE") # test if v specified for spellmatrix nd <- network.initialize(5) activate.vertices(nd,onset=0:4,terminus=1:5) expect_equivalent( get.vertex.activity(nd,as.spellList=TRUE,v=2:4)[,1:3], data.frame(onset=1:3,terminus=2:4,vertex.id=2:4),info="test when when v argument specified with spellmatrix") expect_equivalent( unlist(get.vertex.activity(nd,,v=2:4)),c(1,2,2,3,3,4) ,info="test when when v argument specified") # test if called with ordinary network expect_equal(unlist(get.vertex.activity(network.initialize(3))),c(-Inf,Inf,-Inf,Inf,-Inf,Inf),info="calling with ordinary network") # test when called with something else expect_error(get.vertex.activity(list())) # test with null spell net<- network.initialize(2) deactivate.vertices(net,onset=-Inf,terminus=Inf) expect_equal(sapply(get.vertex.activity(net),is.null),c(TRUE,TRUE),info="testing for null spell") #test for active.default behavior expect_equal(get.vertex.activity(network.initialize(1))[[1]],matrix(c(-Inf,Inf),ncol=2),info='check get.vertex.activity active default behavior') expect_equal(get.vertex.activity(network.initialize(1),active.default=FALSE)[[1]],NA,info='check get.vertex.activity active.default=FALSE behavior') expect_equal(nrow(get.vertex.activity(network.initialize(0),as.spellList=TRUE)),0) # test with deleted spell (was failing in v 0.4) net<-network.initialize(3) delete.vertex.activity(net,v=2) expect_equal(get.vertex.activity(net,as.spellList=TRUE)$onset,c(-Inf,-Inf,-Inf)) # test with deactiviate spell (was failing in v 0.4) net<-network.initialize(3) deactivate.vertices(net,v=2) expect_equal(get.vertex.activity(net,as.spellList=TRUE)$onset,c(-Inf,-Inf)) expect_equal(nrow(get.vertex.activity(net,as.spellList=TRUE,active.default=FALSE)),0) # --------------- networkDynamic() conversion test ----- # ---- networkDynamic() vertex spells ----- vert.spls <-matrix( c(1,2,1, 2,3,2, 3,4,3, 4,5,4),ncol=3,byrow=TRUE) nd <-networkDynamic(vertex.spells=vert.spls) if (network.size(nd)!=4){ stop("networkDynamic did not create network of appropriate size from vertex.spells") } if(!all(get.vertex.activity(nd,as.spellList=TRUE)[1:3]==vert.spls)){ stop("networkDynamic did not create network with appropriate vertex.spells from vertex.spells") } # vertex.spells impute missing vertex? vert.spls <-matrix( c(1,2,1, 2,3,2, 3,4,3, 4,5,9),ncol=3,byrow=TRUE) nd <-networkDynamic(vertex.spells=vert.spls) if (network.size(nd)!=9){ stop("networkDynamic did not create network of appropriate imputed size from vertex.spells") } # vertex.spells bad spell input vert.spls <-matrix( c(1,2,1, 5,3,2, #uh oh, this spell is backwards 3,4,3, 4,5,4),ncol=3,byrow=TRUE) expect_error( networkDynamic(vertex.spells=vert.spls) #throws error, but doesn't say what line ,"Onset times must precede terminus times in activate.vertices") # vertex.spells empty network vert.spls <-matrix(numeric(0),ncol=3,nrow=0) nd<-networkDynamic(vertex.spells=vert.spls) expect_equal(network.size(nd),0,info="checking creating zero vertex network with networkDynamic converter") # ---- networkDynamic() edge spells --------------- edge.spls <-matrix( c(1,2,1,2, 2,3,2,3, 3,4,3,4, 4,5,4,5),ncol=4,byrow=TRUE) nd <-networkDynamic(edge.spells=edge.spls) if(network.edgecount(nd)!=4){ stop("networkDynamic() did not create appropriate number of edges from edge.spells") } if(network.size(nd)!=5){ stop("networkDynamic() did not create appropriate number of vertices from edge.spells") } # edge spells - 0 edges # this generates 'mysterious' warning # https://statnet.csde.washington.edu/trac/ticket/189 net<-network.initialize(5) #will crash if no vertices edge.spls <-matrix(0,ncol=4,nrow=0,byrow=TRUE) nd <-networkDynamic(base.net=net,edge.spells=edge.spls) # edge spells - Loops edge.spls <-matrix( c(1,2,1,1, 1,2,2,2),ncol=4,byrow=TRUE) nd <-networkDynamic(edge.spells=edge.spls) # NA values edge.spls <-matrix( c(1,2,1,NA, 1,2,"a",2),ncol=4,byrow=TRUE) expect_error(networkDynamic(edge.spells=edge.spls),"must be numeric") # edge spells - infer network size edge.spls <-matrix( c(1,2,1,1, 1,2,2,9),ncol=4,byrow=TRUE) nd <-networkDynamic(edge.spells=edge.spls) if(network.size(nd)!=9){ stop("networkDynamic() did not infer network size from edge ids as expected") } # network properties from base net preserved net <-network.initialize(5,directed=FALSE,loops=TRUE) edge.spls <-matrix( c(1,2,1,2, 2,3,2,3, 3,4,3,4, 4,5,4,5),ncol=4,byrow=TRUE) nd <-networkDynamic(base.net=net,edge.spells=edge.spls) if (is.directed(nd) & !has.loops(nd)){ stop("networkDynamic did not preserve basic network settings from base.net argument") } # constsruct with both edges and vertices edge.spls <-matrix( c(1,2,1,2, 2,3,2,3, 3,4,3,4, 4,5,4,5),ncol=4,byrow=TRUE) vert.spls <-matrix( c(1,2,1, 2,3,2, 3,4,3, 4,5,4),ncol=3,byrow=TRUE) nd<-networkDynamic(vertex.spells=vert.spls, edge.spells=edge.spls) # inconsistant edges and vertices # ---- networkDynamic() vertex toggles - no base net --------------- vrt.tog <-matrix( c(1,1, 2,2, 3,2),ncol=2,byrow=TRUE) nd <-networkDynamic(vertex.toggles=vrt.tog) if(!all(get.vertex.activity(nd,as.spellList=TRUE)[,1:3]==matrix(c(-Inf,1,1, -Inf,2,2, 3,Inf,2),ncol=3,byrow=TRUE))){ stop("networkDynamic() did not produduce expected output for vertex.toggles ") } # check the list version with the inf values expect_equal(unlist(get.vertex.activity(nd)),c(-Inf,1,-Inf,3,2,Inf)) # vertex toggles - with base net net <-network.initialize(3) vrt.tog <-matrix( c(1,1, 2,2, 3,2),ncol=2,byrow=TRUE) nd <-networkDynamic(base.net=net,vertex.toggles=vrt.tog) if(!all(get.vertex.activity(nd,as.spellList=TRUE)[,1:3]==matrix(c(-Inf,1,1, -Inf,2,2, 3,Inf,2, -Inf,Inf,3),ncol=3,byrow=TRUE))){ stop("networkDynamic() did not produce expected output for vertex.toggles and base.net") } # check the list version with the inf values expect_equal(unlist(get.vertex.activity(nd)),c(-Inf,1,-Inf,3,2,Inf,-Inf,Inf)) # ---- networkDynamic() edge toggles ------------ edge.tog <- matrix( c(1,1,2, 2,2,3, 3,2,3),ncol=3,byrow=TRUE) nd<-networkDynamic(edge.toggles=edge.tog) if(!all(get.edge.activity(nd,as.spellList=TRUE)[,1:4]==matrix(c(1,Inf,1,2, 2,3,2,3),ncol=4,byrow=TRUE))){ stop("networkDynamic() did not produce expected output for edge.toggles") } expect_equal(unlist(get.edge.activity(nd)),c(1,Inf,2,3)) net<-network.initialize(4) net[3,4]<-1 net[1,4]<-1 edge.tog <- matrix( c(1,1,2, 2,2,3, 3,2,3, 0,1,4),ncol=3,byrow=TRUE) nd<-networkDynamic(base.net=net,edge.toggles=edge.tog) if(!all(get.edge.activity(nd,as.spellList=TRUE)[,1:4]==matrix(c(-Inf,Inf,3,4, -Inf,0,1,4, 1,Inf,1,2, 2,3,2,3),ncol=4,byrow=TRUE))){ stop("networkDynamic() did not produce expected output for edge.toggles with base.net") } expect_equal(unlist(get.edge.activity(nd)),c(-Inf,Inf,-Inf,0,1,Inf,2,3)) # ---- networkDynamic() vertex changes ---------- vrt.cng <-matrix( c(1,1,1, 2,2,1, 3,2,0),ncol=3,byrow=TRUE) nd <-networkDynamic(vertex.changes=vrt.cng) if (!all(get.vertex.activity(nd,as.spellList=TRUE)[,1:3]==matrix(c(1,Inf,1,2, 2,3,2,3),ncol=4,byrow=TRUE) )){ stop("networkDynamic() did not produce expected output for vertex.changes argument") } expect_equal(unlist(get.vertex.activity(nd)),c(1,Inf,2,3)) # ---- networkDynamic() edge changes ----------- edge.cng <-matrix( c(1,1,2,1, 2,2,3,1, 3,2,3,0),ncol=4,byrow=TRUE) nd <-networkDynamic(edge.changes=edge.cng) if (!all(get.edge.activity(nd,as.spellList=TRUE)[,1:4]==matrix(c(1,Inf,1,2, 2,3,2,3),ncol=4,byrow=TRUE))){ stop("networkDynamic() did not produce expected output for edge.changes argument") } expect_equal(unlist(get.edge.activity(nd)),c(1,Inf,2,3)) # check net.obs.period defaults expect_equal((nd%n%'net.obs.period')$'observations'[[1]],c(1,Inf)) # edge changes - activate edge allready active ignored edge.cng <-matrix( c(2,2,3,1, 3,2,3,1),ncol=4,byrow=TRUE) nd <-networkDynamic(edge.changes=edge.cng) expect_equivalent(as.numeric(get.edge.activity(nd,as.spellList=TRUE)[1:4]),c(2,Inf,2,3)) # check net.obs.period defaults expect_equal((nd%n%'net.obs.period')$'observations'[[1]],c(2,Inf)) # ---- networkDynamic() list of networks ---------- #try converting the newcomb panel data (working 9/3) data(newcomb) newDyn <- networkDynamic(network.list=newcomb[1:3]) #does it pass a consistency check? check <- network.dynamic.check(newDyn) if (!all(sapply(check, all))) stop("newcomb network.list conversion did not pass network.dynamic.check") #is the matrix equal to the input matrix for (k in 1:3) { if (!all(as.sociomatrix(newcomb[[k]]) == as.sociomatrix(network.extract(newDyn,onset=k-1,terminus=k)))){ stop("FAIL: networkDynamic conversion: 1st input matrix does not match crosssection from time 0 to 1 for newcomb example") } } # try converting a list that includes different size networks. (working 9/10) # note that beach[[25]] is NA (missing) data(windsurferPanels) beach<-beach[1:7] # should return error dynBeach=NULL expect_error(dynBeach<-networkDynamic(network.list = beach), "vertex.pid must be specified") if (is.network(dynBeach)) stop("did not ask for vertex.pid when network.list have different size networks") dynBeach<-networkDynamic(network.list=beach, vertex.pid="vertex.names") #data level node indicies are stored as the vertex names expect_equal(get.network.attribute(dynBeach,'vertex.pid'),'vertex.names',info='check vertex.pid name set correctly') #check if the neighborhood is the same for both. for (i in 1:length(beach)) { if (!identical(beach[[i]], NA)) { beach[[i]]<-set.network.attribute(beach[[i]],'vertex.pid','vertex.names') for (j in network.vertex.names(beach[[i]])) { ng1 <-get.neighborhood(beach[[i]], v=get.vertex.id(beach[[i]], j)) ng2 <- get.neighborhood.active(dynBeach, onset=i-1, terminus=i, v=get.vertex.id(dynBeach, j)) # the following line is much much slower #ng2 <-get.neighborhood(network.extract(dynBeach,onset=i-1,terminus=i,retain.all.vertices=T),v=get.vertex.id(dynBeach, j)) # need to check the vertex names, not the ids which are changed when converting to a networkDynamic object names1 <- sort(network.vertex.names(beach[[i]])[ng1]) names2 <- sort(network.vertex.names(dynBeach)[ng2]) # print these if necessary # print(paste('============ ', i, '==========')) # print(names1) # print(names2) if (!identical(names1, names2)) { print(paste("FAIL: networkDynamic(): neigborhoods do not match for variable sized network list example (windsurfers)", " at time", i, 'vertex', j)) print(names1) print(names2) } } } } # try a better (but truncated to make test fast) representation that preserves edge times and gaps data(windsurferPanels) beach<-beach[c(24,26)] dynBeach<-networkDynamic(network.list=beach, vertex.pid="vertex.names",onsets=c(24,26),termini=c(25,27)) # make sure day 25 really is missing if (any(is.active(dynBeach, at=25,v=1:network.size(dynBeach)))){ stop("onsets and termini did not correctly omit day 25 in windsurfer example") } # check net.obs.period expect_equal(do.call(rbind,(dynBeach%n%'net.obs.period')$observations),cbind(c(24,26),c(25,27)),info='was net.obs.period created by default by networkDynamic() with onsets and termini did not have expected range') # ---- networkDynamic() network list TEAs ----------- #try a reduced newcomb version that has edge weights newRankDyn <-networkDynamic(network.list=newcomb.rank[1:2],create.TEAs=TRUE) # check that it matches original expect_equal(as.matrix(network.collapse(newRankDyn,at=0),attrname='rank'),as.matrix(newcomb.rank[[1]],attrname='rank')) expect_equal(as.matrix(network.collapse(newRankDyn,at=1),attrname='rank'),as.matrix(newcomb.rank[[2]],attrname='rank')) # test vertex TEA from list of odd-sized networks netlist<-list(network.initialize(3),network.initialize(1),network.initialize(2),network.initialize(2)) netlist[[1]]<-set.vertex.attribute(netlist[[1]],'id',c('a','b','c')) netlist[[2]]<-set.vertex.attribute(netlist[[2]],'id','b') netlist[[3]]<-set.vertex.attribute(netlist[[3]],'id',c('c','d')) netlist[[4]]<-set.vertex.attribute(netlist[[4]],'id',c('c','d')) netlist[[1]]<-set.vertex.attribute(netlist[[1]],'val',c('a1','b1','c1')) netlist[[2]]<-set.vertex.attribute(netlist[[2]],'val','b2') netlist[[3]]<-set.vertex.attribute(netlist[[3]],'val',c('c3','d3')) dyn<-networkDynamic(network.list=netlist,vertex.pid='id',create.TEAs=TRUE) expect_equal(get.vertex.attribute.active(dyn,'val',at=0),c('a1','b1','c1',NA)) expect_equal(get.vertex.attribute.active(dyn,'val',at=1),c(NA,'b2',NA,NA)) expect_equal(get.vertex.attribute.active(dyn,'val',at=2),c(NA,NA,'c3','d3')) expect_true(all(is.na(get.vertex.attribute.active(dyn,'val',at=3)))) # test edge TEA from list of odd-sized networks netlist[[1]]<-add.edges(netlist[[1]],tail=1:2,head=2:3) netlist[[3]]<-add.edges(netlist[[3]],tail=1,head=2) netlist[[4]]<-add.edges(netlist[[4]],tail=1,head=2) netlist[[1]]<-set.edge.attribute(netlist[[1]],'eid','ab1',e=1) netlist[[1]]<-set.edge.attribute(netlist[[1]],'eid','bc1',e=2) netlist[[3]]<-set.edge.attribute(netlist[[3]],'eid','cd3',e=1) netlist[[4]]<-set.edge.attribute(netlist[[4]],'eid','cd4',e=1) dyn<-networkDynamic(network.list=netlist,vertex.pid='id',create.TEAs=TRUE) expect_equal(get.edge.attribute.active(dyn,'eid',at=0),c("ab1","bc1" ,NA )) expect_equal(get.edge.attribute.active(dyn,'eid',at=1),c(NA,NA ,NA)) expect_equal(get.edge.attribute.active(dyn,'eid',at=2),c(NA,NA,"cd3")) expect_equal(get.edge.attribute.active(dyn,'eid',at=3),c(NA,NA,"cd4")) # test network TEA from list of odd-sized networks netlist[[1]]<-set.network.attribute(netlist[[1]],'netname','first') netlist[[2]]<-set.network.attribute(netlist[[2]],'netname','second') netlist[[3]]<-set.network.attribute(netlist[[3]],'netname','third') netlist[[4]]<-set.network.attribute(netlist[[4]],'netname','forth') dyn<-networkDynamic(network.list=netlist,vertex.pid='id',create.TEAs=TRUE) expect_equal(unlist(get.network.attribute.active(dyn,'netname',onset=-Inf,terminus=Inf,return.tea=TRUE)[[1]]),c("first", "second", "third", "forth")) # test TEAs with same size networks, no vertex.pid netlist<-list(network.initialize(4),network.initialize(4),network.initialize(4),network.initialize(4)) template<-netlist[[1]] template<-set.vertex.attribute(template,'id',c('a','b','c','d')) netlist[[1]]<-set.vertex.attribute(netlist[[1]],'val',c('a1','b1','c1'),v=1:3) netlist[[2]]<-set.vertex.attribute(netlist[[2]],'val','b2',v=2) netlist[[3]]<-set.vertex.attribute(netlist[[3]],'val',c('c3','d3'),v=3:4) dyn<-networkDynamic(network.list=netlist,base.net=template,create.TEAs=TRUE) expect_equal(get.vertex.attribute(dyn,'id'),c('a','b','c','d')) expect_equal(get.vertex.attribute.active(dyn,'val',at=0),c('a1','b1','c1',NA)) expect_equal(get.vertex.attribute.active(dyn,'val',at=1),c(NA,'b2',NA,NA)) expect_equal(get.vertex.attribute.active(dyn,'val',at=2),c(NA,NA,'c3','d3')) expect_true(all(is.na(get.vertex.attribute.active(dyn,'val',at=3)))) # test edge TEA from list of same-sized networks netlist[[1]]<-add.edges(netlist[[1]],tail=1:2,head=2:3) netlist[[3]]<-add.edges(netlist[[3]],tail=3,head=4) netlist[[4]]<-add.edges(netlist[[4]],tail=3,head=4) netlist[[1]]<-set.edge.attribute(netlist[[1]],'eid','ab1',e=1) netlist[[1]]<-set.edge.attribute(netlist[[1]],'eid','bc1',e=2) netlist[[3]]<-set.edge.attribute(netlist[[3]],'eid','cd3',e=1) netlist[[4]]<-set.edge.attribute(netlist[[4]],'eid','cd4',e=1) dyn<-networkDynamic(network.list=netlist,create.TEAs=TRUE) expect_equal(get.edge.attribute.active(dyn,'eid',at=0),c("ab1","bc1" ,NA )) expect_equal(get.edge.attribute.active(dyn,'eid',at=1),c(NA,NA ,NA)) expect_equal(get.edge.attribute.active(dyn,'eid',at=2),c(NA,NA,"cd3")) expect_equal(get.edge.attribute.active(dyn,'eid',at=3),c(NA,NA,"cd4")) # test network TEA from list of same-sized networks netlist[[1]]<-set.network.attribute(netlist[[1]],'netname','first') netlist[[2]]<-set.network.attribute(netlist[[2]],'netname','second') netlist[[3]]<-set.network.attribute(netlist[[3]],'netname','third') netlist[[4]]<-set.network.attribute(netlist[[4]],'netname','forth') dyn<-networkDynamic(network.list=netlist,create.TEAs=TRUE) expect_equal(unlist(get.network.attribute.active(dyn,'netname',onset=-Inf,terminus=Inf,return.tea=TRUE)[[1]]),c("first", "second", "third", "forth")) # -------- networkDynamic() edge spell tea tests --------- # test dyad eid lookup test<-network.initialize(6,loops=TRUE) add.edges(test,tail=1:3,head=2:4) add.edges(test,tail=5,head=5) # dyads with no edge should return NA expect_equal(networkDynamic:::get.dyads.eids(test,1,1),NA) # get eids back expect_equal(networkDynamic:::get.dyads.eids(test,1:3,2:4),1:3) # self loops work expect_equal(networkDynamic:::get.dyads.eids(test,5,5),4) # error if lengths of head and tails differ expect_error(networkDynamic:::get.dyads.eids(test,1,1:3),regexp = 'length of the tails and heads parameters must be the same') # test for multiplex throws warning add.edges(test,tail=1,head=2) expect_warning(expect_equal(networkDynamic:::get.dyads.eids(test,1,2),1), regexp = 'only smallest eid returned') # ok, now test edge eids # create an edge spell matrix where the last two columns will be TEA vals testnumbers<-matrix(c(1,2,1,2, 1, 0.5, 3,4,1,2, 2, 0.1, 4,5,1,2, 0, 0.1, 5,7,2,3, 3, -1, 5,7,3,4, 4, 1.5),ncol=6,byrow=TRUE) testnet<-networkDynamic(edge.spells=testnumbers,create.TEAs = TRUE,edge.TEA.names = c('value','weight')) expect_true('value.active'%in%list.edge.attributes(testnet)) expect_true('weight.active'%in%list.edge.attributes(testnet)) expect_equal(get.edge.attribute.active(testnet,'value',at=1),c(1,NA,NA)) expect_equal(get.edge.attribute.active(testnet,'value',at=4),c(0,NA,NA)) expect_equal(get.edge.attribute.active(testnet,'value',at=5),c(NA,3,4)) expect_equal(get.edge.attribute.active(testnet,'weight',at=5),c(NA,-1,1.5)) # test for mismatch between number of cols and number of names expect_error(testnet<-networkDynamic(edge.spells=testnumbers,create.TEAs = TRUE,edge.TEA.names = c('value','weight','foo')),regexp = 'edge.TEA.names must match the number of remaining columns in edge') # now try with a non-numeric value testletters<-data.frame(onset=c(1,2,5,5), terminus=c(2,4,7,7), head=c(1,1,2,3), tail=c(2,2,3,4), value=c('A','B','C','D'),stringsAsFactors=FALSE) testnet<-networkDynamic(edge.spells=testletters,create.TEAs = TRUE,edge.TEA.names = c('value')) # careful, these tests fail if character vector in data frame is converted to a factor expect_equal(get.edge.attribute.active(testnet,'value',at=1),c('A',NA,NA)) expect_equal(get.edge.attribute.active(testnet,'value',at=2),c('B',NA,NA)) expect_equal(get.edge.attribute.active(testnet,'value',at=5),c(NA,'C','D')) # test guessing col names from data.frame testnet<-networkDynamic(edge.spells=testletters,create.TEAs = TRUE,edge.TEA.names = c('value')) expect_true('value.active'%in%list.edge.attributes(testnet)) testnet<-networkDynamic(edge.spells=testletters,create.TEAs = FALSE) expect_false('value.active'%in%list.edge.attributes(testnet)) # run test on a smallish realistic dataset vertexData <-read.table(system.file('extdata/cls33_10_16_96_vertices.tsv', package='networkDynamic'),header=TRUE,stringsAsFactors=FALSE) edgeData <-read.table(system.file('extdata/cls33_10_16_96_edges.tsv', package='networkDynamic'),header=TRUE,stringsAsFactors=FALSE) classDyn <- networkDynamic(vertex.spells=vertexData[,c(3,4,1)], edge.spells=edgeData[,c(3,4,1,2,5,6)], create.TEAs=TRUE,edge.TEA.names=c('weight','type')) expect_equal(c('weight.active','type.active')%in%list.edge.attributes(classDyn),c(TRUE,TRUE)) # check that it actually stored some values expect_equal(get.edge.attribute.active(classDyn,'weight',onset=0,terminus=5,rule='earliest'),c(1, 1, 1, 1, 1, 1, 1, 1, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA)) expect_equal(get.edge.attribute.active(classDyn,'type',onset=0,terminus=5,rule='earliest'),c("social", "social", "sanction", "sanction", "sanction", "sanction", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "task", "social", "social", "social", "social", "social", "social", "social", "social", "social", "social", "social", "social", NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA)) # check a perverse case with unsorted values testnumbers<-matrix(c(3,4,1,2, 2, 0.1, 1,2,1,2, 1, 0.5, 4,5,1,2, 0, 0.1),ncol=6,byrow=TRUE) testnet<-networkDynamic(edge.spells=testnumbers,create.TEAs = TRUE,edge.TEA.names = c('value','weight')) expect_equal(testnet$mel[[1]]$atl$value.active[[2]], structure(c(1, 3, 4, 2, 4, 5), .Dim = c(3L, 2L))) # check a perverse case with intersecting values testnumbers<-matrix(c(3,9,1,2, 2, 0.1, 1,4,1,2, 1, 0.5, 4,6,1,2, 0, 0.1),ncol=6,byrow=TRUE) expect_warning(networkDynamic(edge.spells=testnumbers,create.TEAs = TRUE,edge.TEA.names = c('value','weight')),regexp = 'invalid spell matrix for edge TEA') #-------- networkDynamic() vertex spell tea tests --------- # create an vertex spell matrix where the last two columns will be TEA vals testnumbers<-matrix(c(1,2,1, 1, 0.5, 3,4,1, 2, 0.1, 4,5,1, 0, 0.1, 5,7,2, 3, -1, 5,7,3, 4, 1.5),ncol=5,byrow=TRUE) testnet<-networkDynamic(vertex.spells=testnumbers,create.TEAs = TRUE,vertex.TEA.names = c('value','weight')) expect_true('value.active'%in%list.vertex.attributes(testnet)) expect_true('weight.active'%in%list.vertex.attributes(testnet)) expect_equal(get.vertex.attribute.active(testnet,'value',at=1),c(1,NA,NA)) expect_equal(get.vertex.attribute.active(testnet,'value',at=4),c(0,NA,NA)) expect_equal(get.vertex.attribute.active(testnet,'value',at=5),c(NA,3,4)) expect_equal(get.vertex.attribute.active(testnet,'weight',at=5),c(NA,-1,1.5)) # test for mismatch between number of cols and number of names expect_error(testnet<-networkDynamic(vertex.spells=testnumbers,create.TEAs = TRUE,vertex.TEA.names = c('value','weight','foo')),regexp = 'vertex.TEA.names must match the number of remaining columns in vertex') # now try with a non-numeric value testletters<-data.frame(onset=c(1,2,5,5), terminus=c(2,4,7,7), vid=c(1,1,2,3), value=c('A','B','C','D'),stringsAsFactors=FALSE) testnet<-networkDynamic(vertex.spells=testletters,create.TEAs = TRUE,vertex.TEA.names = c('value')) # careful, these tests fail if character vector in data frame is converted to a factor expect_equal(get.vertex.attribute.active(testnet,'value',at=1),c('A',NA,NA)) expect_equal(get.vertex.attribute.active(testnet,'value',at=2),c('B',NA,NA)) expect_equal(get.vertex.attribute.active(testnet,'value',at=5),c(NA,'C','D')) # test guessing col names from data.frame testnet<-networkDynamic(vertex.spells=testletters,create.TEAs = TRUE,vertex.TEA.names = c('value')) expect_true('value.active'%in%list.vertex.attributes(testnet)) # make sure it doesn't create if instructed not to testnet<-networkDynamic(vertex.spells=testletters,create.TEAs = FALSE) expect_false('value.active'%in%list.vertex.attributes(testnet)) # check a perverse case with unsorted values testnumbers<-matrix(c(3,4,1, 2, 0.1, 1,2,1, 1, 0.5, 4,5,1, 0, 0.1),ncol=5,byrow=TRUE) testnet<-networkDynamic(vertex.spells=testnumbers,create.TEAs = TRUE,vertex.TEA.names = c('value','weight')) expect_equal(testnet$val[[1]]$value.active[[2]], structure(c(1, 3, 4, 2, 4, 5), .Dim = c(3L, 2L))) # check a perverse case with intersecting values testnumbers<-matrix(c(3,9,1, 2, 0.1, 1,4,1, 1, 0.5, 4,6,1, 0, 0.1),ncol=5,byrow=TRUE) expect_warning(networkDynamic(vertex.spells=testnumbers,create.TEAs = TRUE,vertex.TEA.names = c('value','weight')),regexp = 'invalid spell matrix for vertex TEA') # ----------- as.networkDynamic.data.frame tests ------- # check correct spells printed for edges test <- network.initialize(3) test[1,2]<-1 test[2,3]<-1 activate.edges(test,onset=1,terminus=2) ref <- matrix(c(1,2,1,2,0,0,1,1, 1,2,2,3,0,0,1,2),ncol=8,byrow=TRUE) if (!all(as.data.frame(test) == ref)){ stop("unexpected output for edge spells from as.networkDynamic.data.frame") } test <- network.initialize(3) test[1,2]<-1 test[2,3]<-1 activate.edges(test,at=3) ref <- matrix(c(3,3,1,2,0,0,0,1, 3,3,2,3,0,0,0,2),ncol=8,byrow=TRUE) if (!all(as.data.frame(test) == ref)){ stop("unexpected output for edge spells of zero length from as.networkDynamic.data.frame") } # test for missing activity attribute (only set on one edge) test <- network.initialize(3) test[1,2]<-1 test[2,3]<-1 activate.edges(test,at=3,e=1) as.data.frame(test) tryCatch( as.data.frame(test), error = function(e){ warning(paste("error in as.networkDynamic.data.frame for edge with missing activity attribute",e))} ) #check for duration for funny length spells test <- network.initialize(3) test[1,2]<-1 test[2,3]<-1 activate.edges(test,at=1,e=1) activate.edges(test,onset=2.7,terminus=5, e=2) ref <- matrix(c(1.0,1,1,2,0,0,0,1, 2.7,5,2,3,0,0,2.3,2),ncol=8,byrow=TRUE) if (!all(as.data.frame(test) == ref)){ stop("unexpected output for edge spells from as.networkDynamic.data.frame") } # check multiple spells per edge test <- network.initialize(3) test[1,2]<-1 activate.edges(test,onset=1,terminus=2) activate.edges(test,onset=3,terminus=4) ref <- matrix(c(1,2,1,2,0,0,1,1, 3,4,1,2,0,0,1,1),ncol=8,byrow=TRUE) if (!all(as.data.frame(test) == ref)){ stop("unexpected output for multiple spells per edge for as.networkDynamic.data.frame") } # check censoring arguments when passed in test <- network.initialize(3) test[1,2]<-1 activate.edges(test,onset=-Inf,terminus=10) ref <- matrix(c(5,10,1,2,1,0,5,1),ncol=8,byrow=TRUE) if (!all(as.data.frame(test,start=5) == ref)){ stop("unexpected output for 'start' left censoring argument from as.networkDynamic.data.frame") } test <- network.initialize(3) test[1,2]<-1 activate.edges(test,onset=0,terminus=Inf) ref <- matrix(c(0,5,1,2,0,1,5,1),ncol=8,byrow=TRUE) if (!all(as.data.frame(test,end=5) == ref)){ stop("unexpected output for 'end' left censoring argument from as.networkDynamic.data.frame") } test <- network.initialize(3) test[1,2]<-1 activate.edges(test,onset=-Inf,terminus=Inf) ref <- matrix(c(-Inf,Inf,1,2,1,1,Inf, 1),ncol=8,byrow=TRUE) if (!all(as.data.frame(test) == ref)){ warning("unexpected output for as.networkDynamic.data.frame: Inf and -Inf times not treated as censored") } # check censoring arguments when set on input object using attr test <- network.initialize(3) test[1,2]<-1 activate.edges(test,onset=-Inf,terminus=Inf) attr(test,"start")<-5 expect_warning(as.data.frame(test),'has been deprecated',info='specifying start and end using attrs deprecated') #skye: this seems to work, but I want to remove the feature in favor of net.obs.period # test using net.obs.period test <- network.initialize(3) test[1,2]<-1 activate.edges(test,onset=-Inf,terminus=Inf) set.network.attribute(test,'net.obs.period',list(observations=list(c(5,10)),mode='discrete',time.increment=1,time.unit='step')) expect_equivalent(as.numeric(as.data.frame(test)[,1:2]),c(5,10),info='net.obs.list provides censoring info') # =============== TESTING networkDynamic =========================== # working 9/3/2012. Just compare the data frame output with edgetimes # a really crude edgelist example edgetimes <- as.data.frame(matrix( c(1,2,1,2, 1,2,3,4, 2,3,1,3 ),ncol=4,byrow=TRUE)) edgetimetest<-networkDynamic(edge.spells = edgetimes) # do the edges and spells match when spit back out? if (!all(as.data.frame(edgetimetest)[,1:4]==edgetimes)){ stop("output spell matrix does not match input for networkDynamic()") } #does the internal representation match? if( !all(as.vector(edgetimetest$mel[[1]]$atl$active) == c(1,2))){ stop("networkDynamic() gave unexpected internal representation spells") } # combining multiple spells (should combine the spells for edge between v1 and v2) edgetimes <- as.data.frame(matrix( c(1,2,1,2, 2,3,1,2, 1,2,3,4 ),ncol=4,byrow=TRUE)) edgetimetest<-networkDynamic(edge.spells = edgetimes) if (!all(as.data.frame(edgetimetest)[,1:4]==matrix(c(1,3,1,2, 1,2,3,4),ncol=4,byrow=TRUE))){ stop("output spell matrix did not merge input spells as expected for networkDynamic()") } # with censoring # Skye: why does input of Inf mean that it is right censored? edgetimes <- as.data.frame(matrix( c(1,Inf,1,2, 2,3,2,3),ncol=4,byrow=TRUE)) edgetimetest<-networkDynamic(edge.spells = edgetimes) if (!all(as.data.frame(edgetimetest)[,1:4]==edgetimes)){ stop("output spell matrix did not merge input spells as expected for networkDynamic()") } # with missing node (should fill in the missing node) edgetimes <- as.data.frame(matrix( c(1,2,1,2, 2,4,1,2, 1,2,1,4 ),ncol=4,byrow=TRUE)) edgetimetest<-networkDynamic(edge.spells = edgetimes) if (network.size(edgetimetest)!=4){ stop("networkDynamic() did not create network with implied size of 4") } # create with vertex and edge dynamics specified nodetimes <-as.data.frame(matrix( c(1,1,2,1, 2,2,3,2, 3,3,4,3 ),ncol=4,byrow=TRUE)) edgetimes <- as.data.frame(matrix( c(1,2,1,2, 2,4,1,2, 1,2,1,4 ),ncol=4,byrow=TRUE)) nd<-networkDynamic(vertex.spells=nodetimes,edge.spells=edgetimes) # check for net.obs.period expect_equal((nd%n%'net.obs.period')$observations[[1]],c(1,4),info='net.obs.period created by default by networkDynamic(vertex.spells,edge.spells) did not have expected range') # ---- networkDynamic changes conversion ---- #[time,tail,head,direction] echange<-matrix( c(1,1,2,1, 2,1,2,0, 2,2,3,1, 3,1,3,0),ncol=4,byrow=TRUE) nd<-networkDynamic(edge.changes=echange) # the expected output spls<-data.frame(onset=c(1,2,-Inf),terminus=c(2,Inf,3),tail=c(1,2,1),head=c(2,3,3),onset.censored=c(FALSE,FALSE,TRUE),terminus.censored=c(FALSE,TRUE,FALSE),duration=c(1,Inf,Inf),edge.id=c(1,2,3)) # check that spells constructed correctly from edge.changes expect_equivalent(as.data.frame(nd),spls,info='comparing networkDynamic(edge.changes) to resulting spell list') # check net.obs.period construction expect_equal((nd%n%'net.obs.period')$observations[[1]],c(-Inf,Inf),info='net.obs.period created by default by networkDynamic(edge.changes) did not have expected range') expect_equal((nd%n%'net.obs.period')$mode,'discrete',info='net.obs.period created by default by networkDynamic(edge.changes) did not have expected mode') # [time,vertex.id,direction,red_herring] vchange<-matrix( c(1,1,1, 2,1,0, 2,2,1, 3,3,0),ncol=3,byrow=TRUE) nd<-networkDynamic(vertex.changes=vchange) expect_equivalent(get.vertex.activity(nd,as.spellList=TRUE),data.frame(onset=c(1,2,-Inf),terminus=c(2,Inf,3),vertex.id=c(1,2,3),onset.censored=c(FALSE,FALSE,TRUE),terminus.censored=c(FALSE,TRUE,FALSE),duration=c(1,Inf,Inf)),info='networkDynamic(vertex.change) did not give expected spell list result') # [time,vertex.id,direction,red_herring] # checks for internal bug in column name assignments vchange<-matrix( c(1,1,1,5, 2,1,0,6, 2,2,1,7, 3,3,0,8),ncol=4,byrow=TRUE) nd<-networkDynamic(vertex.changes=vchange) expect_equivalent(get.vertex.activity(nd,as.spellList=TRUE),data.frame(onset=c(1,2,-Inf),terminus=c(2,Inf,3),vertex.id=c(1,2,3),onset.censored=c(FALSE,FALSE,TRUE),terminus.censored=c(FALSE,TRUE,FALSE),duration=c(1,Inf,Inf)),info='networkDynamic(vertex.change) did not give expected spell list result') # ----- networkDynamic network.list conversion ---- # does it create a dynamic network d1 <- network.initialize(3) d1[1,2]<-1 d2 <- network.initialize(3) d2[1,2]<-1 d2[2,3]<-1 d3 <- network.initialize(3) d3[3,1]<-1 # default timing ddyn <- networkDynamic(network.list = list(d1,d2,d3)) if(!is.networkDynamic(ddyn)){ stop("as.networkDynamic.list didn't create a dynamic network from ") } # check that correct spells with unit lengths were created ref <- matrix(c(0,2,1,2,0,0,2, 1,2,2,3,0,0,1, 2,3,3,1,0,0,1),ncol=7,byrow=TRUE) if (!all(as.data.frame(ddyn)[,1:7]==ref)){ stop("correct unit length spells were not created for list input networks in networkDynamic()") } # check that default net.obs.period created expect_equal((ddyn%n%'net.obs.period')$observations[[1]],c(0,3),info='was net.obs.period created by default by networkDynamic() did not have expected range') # does it preserve network attributes of passed in network d1 <- network.initialize(2,directed=F,bipartite=T,multiple=T,loops=T) d2 <- network.initialize(2,directed=F,bipartite=T,multiple=T,loops=T) dlist <- list(d1,d2) ddyn <- networkDynamic(network.list = dlist) if (is.directed(ddyn) != FALSE){ stop("'directed' argument if initial network in list not respected in dynamic version") } if (is.bipartite(ddyn) != TRUE){ stop("'bipartite' argument if initial network in list not respected in dynamic version") } if (is.multiplex(ddyn) != TRUE){ stop("'multiple' argument if initial network in list not respected in dynamic version") } if (has.loops(ddyn) != TRUE){ stop("'loops' argument if initial network in list not respected in dynamic version") } # does it warn if network attributes of passed in networks do not match # working 9/10 d1 <- network.initialize(2,directed=F) d2 <- network.initialize(2,directed=T) dlist <- list(d1,d2) expect_warning(networkDynamic(network.list = dlist), "have different network properties",info="different network attributes in network.list did not result in a warning") # are vertex attributes included? d1 <- network.initialize(2) d2 <- network.initialize(2) dbase<-network.initialize(2) set.vertex.attribute(dbase,"test","one") set.network.attribute(dbase,'another',"two") dlist <- list(d1,d2) dnet<-networkDynamic(base.net=dbase,network.list = dlist) expect_true('test'%in%list.vertex.attributes(dnet),info="vertex attributes from base.net network not copied by networkDynamic()") expect_true('another'%in%list.network.attributes(dnet),info="user specified network attributes from base.net network not copied by networkDynamic()") dlist[[1]]<-set.vertex.attribute(dlist[[1]],"test","one") dlist[[1]]<-set.network.attribute(dlist[[1]],'another',"two") dnet<-networkDynamic(network.list = dlist) expect_true('test'%in%list.vertex.attributes(dnet),info="vertex attributes from first item of network list network not copied by networkDynamic()") expect_true('another'%in%list.network.attributes(dnet),info="user specified network attributes from base.net network not copied by networkDynamic()") dnet<-networkDynamic(network.list = dlist,create.TEAs=TRUE) expect_true('test.active'%in%list.vertex.attributes(dnet),info="vertex attributes from first item of network list network not copied as TEA by networkDynamic()") expect_true('another.active'%in%list.network.attributes(dnet),info="user specified network attributes from base.net network not copied as TEA by networkDynamic()") # are edge attributes included # specify net.obs.period d1 <- network.initialize(3) d1[1,2]<-1 d2 <- network.initialize(3) d2[1,2]<-1 d2[2,3]<-1 d3 <- network.initialize(3) d3[3,1]<-1 nop = list(observations=list(c(3,5)), mode="discrete", time.increment=1,time.unit="step") ddyn <- networkDynamic(network.list = list(d1,d2,d3), net.obs.period=nop) expect_false(is.null(ddyn%n%'net.obs.period'),info="net.obs.period argument in input to networkDynamic reproduced in output") # check for error when edge spell list has only one row issue #190 edge.spls <-matrix( c(1,2,1,2),ncol=4,byrow=TRUE) nd <-networkDynamic(edge.spells=edge.spls) expect_equivalent(as.matrix(get.edge.activity(nd,as.spellList=TRUE)[,1:4]),edge.spls,info="check when edge spell list has only one row") # check for char data in input tables edge spells net <-network.initialize(4) edgetimes <- as.data.frame( list(c("1",1,2),c(2,2,3),c(1,3,1),c(2,4,3))) expect_error(edgetimetest<-networkDynamic(base.net=net,edge.spells = edgetimes),"the onset time column of the edge.spells argument to networkDynamic must be numeric",info="testing non-numeric input to networkDynamic edgespells onset") edgetimes <- as.data.frame( list(c(1,1,2),c(2,"2",3),c(1,3,1),c(2,4,3))) expect_error(edgetimetest<-networkDynamic(base.net=net,edge.spells = edgetimes),"the terminus time column of the edge.spells argument to networkDynamic must be numeric",info="testing non-numeric input to networkDynamic edgespells terminus") edgetimes <- as.data.frame( list(c(1,1,2),c(2,2,3),c(1,"3",1),c(2,4,3))) expect_error(edgetimetest<-networkDynamic(base.net=net,edge.spells = edgetimes),"must be a numeric",info="testing non-numeric input to networkDynamic edgespells terminus") edgetimes <- as.data.frame( list(c(1,1,2),c(2,2,3),c(1,3,1),c(2,4,"3"))) expect_error(edgetimetest<-networkDynamic(base.net=net,edge.spells = edgetimes),"must be a numeric",info="testing non-numeric input to networkDynamic edgespells terminus") # check for char data in input tables edge toggles edgetimes <- as.data.frame( list(c(1,1,2),c(2,"2",3),c(1,0,1))) expect_error(edgetimetest<-networkDynamic(base.net=net,edge.toggles = edgetimes),"must be a numeric",info="testing non-numeric input to networkDynamic edge.toggles tail") edgetimes <- as.data.frame( list(c(1,"1",2),c(2,2,3),c(1,0,1))) expect_error(edgetimetest<-networkDynamic(base.net=net,edge.toggles = edgetimes),"must be numeric",info="testing non-numeric input to networkDynamic edge.toggles time") edgetimes <- as.data.frame( list(c(1,1,2),c(2,2,3),c(1,"0",1))) expect_error(edgetimetest<-networkDynamic(base.net=net,edge.toggles = edgetimes),"must be a numeric",info="testing non-numeric input to networkDynamic edge.toggles head") # check for char data in input tables edge changes edgetimes <- as.data.frame( list(c(1,"1",2),c(2,2,3),c(2,4,3),c(1,0,1))) expect_error(edgetimetest<-networkDynamic(base.net=net,edge.changes = edgetimes),"must be numeric",info="testing non-numeric input to networkDynamic edge.changes time") edgetimes <- as.data.frame( list(c(1,1,2),c(2,2,"3"),c(2,4,3),c(1,0,1))) expect_error(edgetimetest<-networkDynamic(base.net=net,edge.changes = edgetimes),"must be a numeric",info="testing non-numeric input to networkDynamic edge.changes tail") edgetimes <- as.data.frame( list(c(1,1,2),c(2,2,3),c(2,4,"3"),c(1,0,1))) expect_error(edgetimetest<-networkDynamic(base.net=net,edge.changes = edgetimes),"must be a numeric",info="testing non-numeric input to networkDynamic edge.changes head") edgetimes <- as.data.frame(list(c(1,1,2),c(2,2,3),c(2,4,3),c(1,0,"1"))) expect_error(edgetimetest<-networkDynamic(base.net=net,edge.changes = edgetimes),"must be numeric",info="testing non-numeric input to networkDynamic edge.changes direction") # check for char data in input tables vertex toggles verttimes <- as.data.frame(list(c(1,"1",2),c(1,2,3))) expect_error(networkDynamic(base.net=net,vertex.toggles = verttimes),"be numeric",info="testing non-numeric input to networkDynamic vertex.toggles time") verttimes <- as.data.frame(list(c(1,1,2),c(1,2,"3"))) expect_error(networkDynamic(base.net=net,vertex.toggles = verttimes),"be numeric",info="testing non-numeric input to networkDynamic vertex.toggles vertex.id") # check for char data in input tables vertex spells verttimes <- as.data.frame(list(c(1,"1",2),c(1,1,2),c(1,2,3))) expect_error(networkDynamic(base.net=net,vertex.spells = verttimes),"be numeric",info="testing non-numeric input to networkDynamic vertex.spells onset") verttimes <- as.data.frame(list(c(1,1,2),c(1,"1",2),c(1,2,3))) expect_error(networkDynamic(base.net=net,vertex.spells = verttimes),"be numeric",info="testing non-numeric input to networkDynamic vertex.spells terminus") verttimes <- as.data.frame(list(c(1,1,2),c(1,1,2),c(1,2,"3"))) expect_error(networkDynamic(base.net=net,vertex.spells = verttimes),"be numeric",info="testing non-numeric input to networkDynamic vertex.spells vertex.id") # check for char data in input tables vertex changes verttimes <- as.data.frame(list(c(1,"1",2),c(1,1,2),c(1,0,1))) expect_error(networkDynamic(base.net=net,vertex.changes = verttimes),"be numeric",info="testing non-numeric input to networkDynamic vertex.changes time") verttimes <- as.data.frame(list(c(1,1,2),c(1,"1",2),c(1,0,1))) expect_error(networkDynamic(base.net=net,vertex.changes = verttimes),"be numeric",info="testing non-numeric input to networkDynamic vertex.changes vertex.id") verttimes <- as.data.frame(list(c(1,1,2),c(1,1,2),c(1,0,"1"))) expect_error(networkDynamic(base.net=net,vertex.changes = verttimes),"be numeric",info="testing non-numeric input to networkDynamic vertex.changes direction") # network list with network size 0 expect_equal(network.size(networkDynamic(network.list=list(network.initialize(0)))),0) # check for edge.spells plus base.net with pre-existing edges bug #556 test<-network.initialize(3) test[1,2]<-1 networkDynamic(base.net=test,edge.spells=matrix(c(0,1,1,2),ncol=4)) # =============== TESTING as.data.frame.networkDynamic ==== message('testing as.data.frame.networkDynamic\n') #lets try passing in a noncensored and duration, see if we get the same things back edgetimes <- as.data.frame(matrix( c(1,2,1,2,0,0, 3,5,1,2,0,0,1,2,3,4,0,0, 3,4,2,4,0,0 ),ncol=6,byrow=TRUE)) colnames(edgetimes)<-c("onset","terminus","tail","head","onset.censored","terminus.censored") testnet <- network.initialize(4) add.edges.active(testnet,onset=1,terminus=2,tail=1,head=2) add.edges.active(testnet,onset=1,terminus=2,tail=3,head=4) activate.edges(testnet,onset=3,terminus=5,e=get.edgeIDs(testnet, v=1,alter=2)) add.edges.active(testnet,onset=3,terminus=4,tail=2,head=4) # these should match if (!all(as.data.frame(testnet)[,1:6] == edgetimes)){ stop("FAIL: output data.frame from as.data.frame.networkDynamic did not match input") } #check column names if(!all(names(as.data.frame(testnet))==c("onset","terminus","tail","head","onset.censored","terminus.censored","duration","edge.id"))){ stop("Unexpected column names returned by as.data.frame.networkDynamic") } # censoring should set the appropriate start or end to Inf # skye: Is this the behavior we want for as.data.frame? edgetimes <- as.data.frame(matrix( c(0,2,1,2,1,0,2, 3,5,1,2,0,0,2, 1,2,3,4,0,0,1, 3,6,2,4,0,1,3 ),ncol=7,byrow=TRUE)) colnames(edgetimes)<-c("onset","terminus","tail","head","onset.censored","terminus.censored","duration") testnet <- network.initialize(4) add.edges.active(testnet,onset=-Inf,terminus=2,tail=1,head=2) add.edges.active(testnet,onset=1,terminus=2,tail=3,head=4) activate.edges(testnet,onset=3,terminus=5,e=get.edgeIDs(testnet, v=1,alter=2)) add.edges.active(testnet,onset=3,terminus=Inf,tail=2,head=4) # these should match if(!all(as.data.frame(testnet,start=0,end=6)[-8]==edgetimes)){ stop("as.data.frame.networkDynamic gave unexpected censored spell matrix output") } # check censoring for non-Inf edges when start and end are set narrower tel<-matrix(c(40, 72, 10, 4, 214, 247, 1, 11, 224, 256, 7,10),ncol=4,byrow=TRUE) test<-networkDynamic(edge.spells=tel) result<-as.data.frame(test,start=50,end=60) expect_equal(nrow(result),1) expect_equal(as.numeric(result[,1:4]),c(50,60,10,4)) expect_equal(as.logical(result[,5:6]),c(TRUE,TRUE)) # properly handle edges with no spell activity test <- network.initialize(3) test[1,2]<-1 test[2,3]<-1 activate.edges(test,at=3,e=1) temp = as.data.frame(test,active.default=FALSE) if (!all(temp == c(3,3,1,2,F,F,0,1))) stop('did not handle edges without spell activity') expect_equivalent(as.data.frame(test,active.default=TRUE), data.frame(onset=c(3,-Inf),terminus=c(3,Inf), tail=c(1,2),head=c(2,3),onset.censored=c(FALSE,TRUE), terminus.censored=c(FALSE,TRUE),duration=c(0,Inf),edge.id=c(1,2)), info="test active.default=TRUE for edge with no spell") # properly handle nD object with no edges at all # active default means it should still return two edges net <-network.initialize(3) activate.vertices(net, onset=1, terminus=Inf) temp<-as.data.frame(net) if (nrow(temp) != 0) { stop("as.data.frame.networkDynamic() did not handle an object without any edge activity") } # check for crash with network size 0 expect_equal(nrow(get.edge.activity(network.initialize(0),as.spellList=TRUE)),0) # check active.default net<-network.initialize(3) add.edges(net,tail=1:3,head=c(2,3,1)) expect_equal(get.edge.activity(net,as.spellList=TRUE)$onset,c(-Inf,-Inf,-Inf)) expect_equal(nrow(get.edge.activity(net,as.spellList=TRUE,active.default=FALSE)),0) # check for 'null' spell net<-network.initialize(3) add.edges(net,tail=1:3,head=c(2,3,1)) deactivate.edges(net,e=2) spls<-as.data.frame(net,as.spellList=TRUE) expect_equal(spls$onset,c(-Inf,-Inf),info='check for null spell and active.default') expect_equal(spls$terminus,c(Inf,Inf),info='check for null spell and active.default') expect_equal(spls$edge.id,c(1,3),info='check for null spell and active.default') expect_equal(nrow(as.data.frame(net,as.spellList=TRUE,active.default=FALSE)),0,info='check for null spell and active.default=FALSE') # check for multiplex case nd <-network.initialize(2,multiple=TRUE) add.edges.active(nd,onset=12,terminus=12.1,tail=1,head=2) add.edges.active(nd,onset=12,terminus=12.5,tail=1,head=2) as.data.frame(nd) expect_equal(nrow(as.data.frame(nd)),2,info="test as.data.frame with multiplex network") # check for correct sort ordering by onset,terminus, edge.id m<-matrix(c(10,11,1,2, 12,13,1,2, 5,6,2,3, 12,13,2,3, 12,12.5,1,3 ),ncol=4,byrow=TRUE) nd<-networkDynamic(network.initialize(3,multiple=TRUE),edge.spells=m) # add in an edge to test multiplex case add.edges.active(nd,onset=12,terminus=12.1,tail=1,head=3) ndmat<-as.data.frame(nd) expect_equal(ndmat$onset,c(5,12,10,12,12,12),info='check as.data.frame.networkDynamic onset sorting') expect_equal(ndmat$terminus,c(6,13,11,13,12.5,12.1),info='check as.data.frame.networkDynamic terminus sorting') expect_equal(ndmat$edge.id,c(1,1,2,2,3,4),info='check as.data.frame.networkDynamic edge.id sorting') # check that e argument removes appropriate edges' spells ndmat<-as.data.frame(nd,e=c(1,4)) expect_equal(ndmat$edge.id,c(1,1,4),info='check that e argument removes edge spells from as.data.frame.networkDynamic') # check for behavior with deleted edges m<-matrix(c(10,11,1,2, 12,13,1,2, 5,6,2,3, 12,13,2,3, 12,12.5,1,3 ),ncol=4,byrow=TRUE) nd<-networkDynamic(network.initialize(3,multiple=TRUE),edge.spells=m) # add in an edge to test multiplex case add.edges.active(nd,onset=12,terminus=12.1,tail=1,head=3) delete.edges(nd,eid=2) ndmat<-as.data.frame(nd) expect_equal(ndmat$edge.id,c(1,1,3,4),info='check that deleted edge doesnt cause problem for as.data.frame.networkDynamic') # check for appropriate exclusion of terminating edges test<-network.initialize(3) add.edges.active(test,tail=c(1,2,3),head=c(2,3,1),onset=c(0,1,2),terminus=c(1,2,3)) # first edge should be excluded because it lies entirly outside query range # second edge could be excluded because it terminates at onset of query range expect_equal(as.data.frame(test,start=2,end=3)$edge.id,3) # also check for appropriate inclusion at other boundry expect_equal(as.data.frame(test,start=1,end=2)$edge.id,2) # and for at spell query test<-network.initialize(3) add.edges.active(test,tail=c(1,2,3,3),head=c(2,3,1,1),onset=c(0,1,2,1),terminus=c(1,2,3,1)) expect_equal(as.data.frame(test,start=1,end=1)$edge.id,c(2,4)) # ----- get.edge.activity ---- # some of this is not tested becaue it actually calls as.data.frame internally # check subsetting with e argument net<-network.initialize(5) add.edges.active(net,tail=1:4,head=2:5,onset=1:4,terminus=2:5) expect_equal(unlist(get.edge.activity(net)),c(1,2,2,3,3,4,4,5)) expect_equivalent( get.edge.activity(net,as.spellList=TRUE,e=2:3), data.frame(onset=2:3,terminus=3:4,tail=2:3,head=3:4, onset.censored=c(FALSE,FALSE),terminus.censored=c(FALSE,FALSE), duration=c(1,1),edge.id=2:3) , info="test edge activity subsetting with e") expect_equal(unlist(get.edge.activity(net,e=2:3)),c(2,3,3,4)) expect_equal(get.edge.activity(network.initialize(0)),list()) # test with ordinary net and default activity net<-network.initialize(3) add.edges(net,c(1,2,3),c(2,3,1)) expect_equal(sapply(get.edge.activity(net,active.default=FALSE),is.null), c(TRUE,TRUE,TRUE),info='check get.edge.activity with ordinary net and active.default=FALSE') expect_equal(unlist(get.edge.activity(net,active.default=TRUE)), c(-Inf,Inf,-Inf,Inf,-Inf,Inf),info='check get.edge.activity with ordinary net and active.default=TRUE') # can it distinguish from deleted edges? delete.edges(net,e=2) spls<-get.edge.activity(net,active.default=TRUE) expect_true(is.null(spls[[2]]),info='check get.edge.activity with ordinary net and active.default=TRUE distinguish deleted edge') expect_equal(spls[[3]],matrix(c(-Inf,Inf),ncol=2),info='check get.edge.activity with ordinary net and active.default=TRUE distinguish deleted edge') # test `null` spell net<-network.initialize(3) add.edges(net,c(1,2,3),c(2,3,1)) deactivate.edges(net,e=2) expect_equal(sapply(get.edge.activity(net,active.default=FALSE),is.null), c(TRUE,TRUE,TRUE),info='check get.edge.activity with ordinary net and null spell active.default=FALSE') spls<-get.edge.activity(net,active.default=TRUE) expect_true(is.null(spls[[2]]),info='check get.edge.activity with ordinary net and active.default=TRUE distinguish deleted edge') expect_equal(spls[[3]],matrix(c(-Inf,Inf),ncol=2),info='check get.edge.activity with ordinary net and active.default=TRUE and null spell') # check that it doesn't censor by default with net.obs.period net<-network.initialize(2) add.edges.active(net,tail=1,head=2,onset=-Inf,terminus=Inf) net%n%'net.obs.period'<-list(observations=list(c(0,100)),mode="discrete", time.increment=1,time.unit="step") expect_equal(as.numeric(get.edge.activity(net,as.spellList=TRUE)[1:2]),c(-Inf,Inf)) # ------- networkDynamic from toggles (function used by TERGM) ------------ test <- network.initialize(3) test[1,3]<-1 tog <- matrix(c(1,1,2, 1,2,3, 2,1,2, 4,1,3, 4,1,2), ncol=3, byrow=TRUE) net<-networkDynamic(base.net=test,edge.toggles=tog) spells <-as.data.frame(net)[1:6] # first spell should be onset censored because edge was in original net # all edges in original net are considered active before toggles if (!all(spells[1,]==c(-Inf,4,1,3,1,0))){ stop("networkDynamic() did not record initial toggle correctly") } # 2nd spell toggles twice if (!all(spells[2,]==c(1,2,1,2,0,0))){ stop("networkDynamic() did not record double toggle correctly") } if (!all(spells[4,]==c(1,Inf,2,3,0,1)) | !all(spells[3,]==c(4,Inf,1,2,0,1))){ stop("networkDynamic() did not record toggles correctly") } # check for net.obs.period expect_equal((net%n%'net.obs.period')$observations[[1]],c(-Inf,Inf),info='net.obs.period created by default by networkDynamic(edge.toggles) did not have expected range') expect_equal((net%n%'net.obs.period')$mode,'discrete',info='net.obs.period created by default by networkDynamic(edge.toggles) did not have expected mode') # ==================== TESTING duration.matrix # this function is used internally by as.networkDynamic.network() and should not be called by user net <-network.initialize(3) net[1,2]<-1; net[2,3]<-1; net[1,3]<-1; # toggle list: time, tail, head tog<-matrix(c(1,1,2, 1,2,3, 2,1,2, 4,1,3, 4,1,2), ncol=3, byrow=TRUE) # we expect this matrix ref <- matrix(c(0,1,1,2,1,0,1, 0,1,2,3,1,0,1, 0,4,1,3,1,0,4, 2,4,1,2,0,0,2),ncol=7,byrow=TRUE) if (!all(networkDynamic:::duration.matrix(net, changes=tog, start=0, end=5)==ref)){ stop("duration.matrix returned an unexpected spell list for its input toggles") } # testing start and end ref1 <- matrix(c(1,1,1,2,1,0,0, 1,1,2,3,1,0,0, 1,4,1,3,1,0,3, 2,4,1,2,0,0,2),ncol=7,byrow=TRUE) if (!all(networkDynamic:::duration.matrix(net, changes=tog, start=1, end=5)==ref1)){ stop("duration.matrix returned an unexpected spell list for its input toggles") } # testing start and end ref2 <- matrix(c(0,1,1,2,1,0,1, 0,1,2,3,1,0,1, 0,4,1,3,1,0,4, 2,4,1,2,0,0,2),ncol=7,byrow=TRUE) if (!all(networkDynamic:::duration.matrix(net, changes=tog, start=0, end=8)==ref2)){ stop("duration.matrix returned an unexpected spell list for its input toggles") } networkDynamic:::duration.matrix(network.initialize(0),changes=tog,start=0,end=1)