R Under development (unstable) (2023-12-02 r85657 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2023 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> #The following battery of tests is intended to verify the functionality of
> #the network library
> 
> #Set to TRUE to run tests
> if(FALSE){
+ 
+ library(network)
+ 
+ # ----- check assigning multiple attribute values in a single call ------
+ test<-network.initialize(3)
+ set.vertex.attribute(test,c('a','b'),c(1,2))
+ if(!all(test%v%'a'==c(1,1,1) & test%v%'b'==c(2,2,2))){
+   stop('setting multiple attribute values with set.vertex.attribute failed')
+ }
+ 
+ test<-network.initialize(3)
+ set.vertex.attribute(test,list('a','b'),c(1,2))
+ if(!all(test%v%'a'==c(1,1,1) & test%v%'b'==c(2,2,2))){
+   stop('setting multiple attribute values with set.vertex.attribute failed')
+ }
+ 
+ test<-network.initialize(3)
+ set.vertex.attribute(test,c('a','b'),list(c(1,2,3),c(4,5,6)))
+ if(!all(test%v%'a'==c(1,2,3) & test%v%'b'==c(4,5,6))){
+   stop('setting multiple attribute values with set.vertex.attribute failed')
+ }
+ 
+ test<-network.initialize(3)
+ set.vertex.attribute(test,c('a','b'),list(list(1,2,3),list(4,5,6)))
+ if(!all(test%v%'a'==c(1,2,3) & test%v%'b'==c(4,5,6))){
+   stop('setting multiple attribute values with set.vertex.attribute failed')
+ }
+ 
+ test<-network.initialize(3)
+ obj<-list(one='a complex object',two=c('with muliple','parts'))
+ set.vertex.attribute(test,c('a','b'),list(list(as.list(obj)),list(as.list(obj))))
+ if(!all(all.equal(get.vertex.attribute(test,'a',unlist=FALSE)[[1]],obj) & all.equal(get.vertex.attribute(test,'b',unlist=FALSE)[[1]],obj))){
+   stop('setting multiple attribute values with list values in set.vertex.attribute failed')
+ }
+ 
+ # check assignment to list of networks
+ net <- network.initialize(2)
+ netlist <- list(net)
+ set.network.attribute(netlist[[1]],"test","a value")
+ if (!"test" %in% list.network.attributes(netlist[[1]]))
+   stop('assignment to list of networks failed')
+ 
+ # test multiple assignment for network
+ 
+ test<-network.initialize(3)
+ set.network.attribute(test,c("a","b"),1:2)
+ if (!all(test%n%'a'==1,test%n%'b'==2)){
+   stop('mulltiple attribute assignment failed for set.network.attribute')
+ }
+ 
+ test<-network.initialize(3)
+ set.network.attribute(test,list("a","b"),as.list(1:2))
+ if (!all(test%n%'a'==1,test%n%'b'==2)){
+   stop('mulltiple attribute assignment failed for set.network.attribute')
+ }
+ 
+ 
+ 
+ #  test multiple assignment for edges 
+ 
+ test<-network.initialize(3)
+ add.edges(test,tail=1:3,head=c(2,3,1))
+ net<-test
+ set.edge.attribute(net,c("a","b"),1:2)
+ if (!all(net%n%'a'==1,net%n%'b'==2)){
+   stop('mulltiple attribute assignment failed for set.edge.attribute')
+ }
+ 
+ net<-test
+ set.edge.attribute(net,c('a','b'),list(c(1,2,3),c(4,5,6)))
+ if(!all(net%e%'a'==c(1,2,3) & net%e%'b'==c(4,5,6))){
+   stop('setting multiple attribute values with set.edge.attribute failed')
+ }
+ 
+ net<-test
+ set.edge.attribute(net,c('a','b'),list(list(1,2,3),list(4,5,6)))
+ if(!all(net%e%'a'==c(1,2,3) & net%e%'b'==c(4,5,6))){
+   stop('setting multiple attribute values with set.edge.attribute failed')
+ }
+ 
+ net<-test
+ obj<-list(one='a complex object',two=c('with muliple','parts'))
+ set.edge.attribute(net,c('a','b'),list(list(as.list(obj)),list(as.list(obj))))
+ if(!all(all.equal(get.edge.attribute(net,'a',unlist=FALSE)[[1]],obj) & all.equal(get.edge.attribute(net,'b',unlist=FALSE)[[1]],obj))){
+   stop('setting multiple attribute values with list values in set.edge.attribute failed')
+ }
+ 
+ 
+ 
+ # ---- checks for  get.edge.attribute overloading and omit args ----
+ net<-network.initialize(3)
+ add.edges(net,c(1,2,3),c(2,3,1))
+ set.edge.attribute(net,'test',"a")
+ if(!all(get.edge.attribute(net,'test')==c("a","a","a"))){stop("overloading of get.edge.attribute to get.edge.value not working correctly ")}
+ 
+ # check list output of get.edge.attribute with deleted.edges.omit
+ delete.edges(net,2)
+ set.edge.attribute(net,'foo','bar',1)
+ if(!identical(list('bar',NULL,NULL),get.edge.attribute(net,'foo',unlist=FALSE,  deleted.edges.omit = FALSE))){
+   stop("deleted.edges.omit argument causing bad return values in get.edge.attribute ")
+ }
+ if(!identical(list('bar',NULL),get.edge.attribute(net,'foo',unlist=FALSE,  deleted.edges.omit = TRUE))){
+   stop("deleted.edges.omit argument causing bad return values in get.edge.attribute ")
+ }
+ 
+ # check unlisted output of get.edge.attribute with na.omit and deleted.edges.omit
+ if(!identical(c('bar'),get.edge.attribute(net,'foo',unlist=TRUE,deleted.edges.omit=TRUE))){
+   stop("omission argument causing bad return values in get.edge.attribute")
+ }
+ if(!identical(c('bar'),get.edge.attribute(net,'foo',unlist=TRUE,deleted.edges.omit=TRUE))){
+   stop("omission  arguments causing bad return values in get.edge.attribute")
+ }
+ 
+ # check for null.na recoding of non-set attributes
+ if(!identical(c('bar'),get.edge.attribute(net,'foo',unlist=TRUE,null.na=FALSE))){
+   stop("null.na  arguments causing bad return values in get.edge.attribute")
+ }
+ if(!identical(c('bar',NA),get.edge.attribute(net,'foo',unlist=TRUE,null.na=TRUE))){
+   stop("null.na  arguments causing bad return values in get.edge.attribute")
+ }
+ if(!identical(list('bar',NULL,NULL),get.edge.attribute(net,'foo',unlist=FALSE,null.na=FALSE))){
+   stop("null.na  arguments causing bad return values in get.edge.attribute")
+ }
+ if(!identical(list('bar',NULL,NA),get.edge.attribute(net,'foo',unlist=FALSE,null.na=TRUE))){
+   stop("null.na  arguments causing bad return values in get.edge.attribute")
+ }
+ 
+ 
+ 
+ #mark an edge as missing to test na.omit
+ set.edge.attribute(net,'na',TRUE,e=1)
+ 
+ # check that values corresponding to missing edges are ommited
+ if(!identical(list('bar',NULL,NULL),get.edge.attribute(net,'foo',unlist=FALSE,na.omit=FALSE))){
+   stop("na.omit argument causing bad return values in get.edge.attribute")
+ }
+ if(!identical(list(NULL,NULL),get.edge.attribute(net,'foo',unlist=FALSE,na.omit=TRUE))){
+   stop("na.omit argument causing bad return values in get.edge.attribute")
+ }
+ 
+ if(!identical(c('bar'),get.edge.attribute(net,'foo',unlist=TRUE,na.omit=FALSE))){
+   stop("na.omit argument causing bad return values in get.edge.attribute")
+ }
+ if(!identical(NULL,get.edge.attribute(net,'foo',unlist=TRUE,na.omit=TRUE))){
+   stop("na.omit argument causing bad return values in get.edge.attribute")
+ }
+ # check for behavior when querying the 'na' attribute
+ if(!identical(c(TRUE,FALSE),get.edge.attribute(net,'na',na.omit=FALSE))){
+   stop("get.edge.attribute did not return correct values for 'na' attribute with na.omit=FALSE")
+ }
+ if(!identical(c(FALSE),get.edge.attribute(net,'na',na.omit=TRUE))){
+   stop("get.edge.attribute did not return correct values for 'na' attribute with na.omit=TRUE")
+ }
+ 
+ # check behavior on a network with no edges
+ if(!identical(list(),get.edge.attribute(network.initialize(3),'foo',unlist=FALSE))){
+   stop("get.edge.attribute did not return correct values network with no edges")
+ }
+ 
+ if(!identical(NULL,get.edge.attribute(network.initialize(3),'foo',unlist=TRUE))){
+   stop("get.edge.attribute did not return correct values network with no edges")
+ }
+ 
+ if(!identical(NULL,get.edge.attribute(net,'bar'))){
+   stop("get.edge.attribute did not return correct values for attribute that does not exist")
+ }
+ 
+ 
+ # check for behavior of attribute values explicitly set to null
+ net<-network.initialize(3)
+ net[1,2]<-1
+ net[1,3]<-1
+ set.edge.attribute(net,'nullval',list(NULL))
+ 
+ # expect NULL,NULL
+ if(!identical(list(NULL,NULL),get.edge.attribute(net,'nullval',unlist=FALSE,null.na=FALSE))){
+   stop("get.edge.attribute not returning NULL values stored as edge attribute correctly")
+ }
+ 
+ # expect that this should return NULL values, which will dissappear on unlisting
+ # do NOT want to see NA,NA
+ if(!identical(NULL,get.edge.attribute(net,'nullval',null.na=FALSE))){
+   stop("get.edge.attribute not returning NULL values stored as edge attribute correctly")
+ }
+ if(!identical(NULL,get.edge.attribute(net,'nullval',null.na=TRUE))){
+   stop("get.edge.attribute not returning NULL values stored as edge attribute correctly")
+ }
+ 
+ #End tests
+ }
> 
> proc.time()
   user  system elapsed 
   0.17    0.04    0.20