network/0000755000176200001440000000000014725552272011756 5ustar liggesusersnetwork/tests/0000755000176200001440000000000014317471453013116 5ustar liggesusersnetwork/tests/general.tests2.R0000644000176200001440000000645314363704145016107 0ustar liggesusers#Set to TRUE to run tests if(FALSE){ # additional tests of misc network functionality split off from general.tests.R to avoid speed warnings library(network) # ----- check memory saftey with a big assignment --- net<-network.initialize(100000) net<-add.edges(net,1:99999,2:100000) set.edge.attribute(net,'LETTERS',LETTERS) # --- tests for get.induced.subgraph additions -- data(emon) # extract the network of responders in MtStHelens network with interaction Frequency of 4 subG4<-get.inducedSubgraph(emon$MtStHelens,eid=which(emon$MtStHelens%e%'Frequency'==4)) if(network.size(subG4)!=24){ stop('wrong size eid induced subgraph') } if (any(subG4%e%'Frequency'!=4)){ stop('bad edges in eid induced subgraph') } # checks for error conditions # can't specify eid with v or alter # get.inducedSubgraph(v=1:2,emon$MtStHelens,eid=which(emon$MtStHelens%e%'Frequency'==4)) # get.inducedSubgraph(alter=1:2,emon$MtStHelens,eid=which(emon$MtStHelens%e%'Frequency'==4)) # get.inducedSubgraph(emon$MtStHelens,eid=200:300) # ---- tests for specific bugs/edgecases ----- # ticket #180 (used to throw error if no edges exist) set.edge.attribute(network.initialize(3),"test","a") # check for network of zero size --used to give error ticket #255 set.vertex.attribute(network.initialize(0),'foo','bar') # check for is.na.network problems #619 x2<-network.initialize(3) x2[1,2]<-NA if(is.na.network(x2)[1,2]!=1){ stop('problem iwth is.na.netowrk') } # check for na problems in which.matrix.type #926 mat <- matrix(rbinom(200, 1, 0.2), nrow = 20) naIndices <- sample(1:200, 20) mat[naIndices] <- NA nw <- network(mat) # ---- check for undirected loops getID cases #327 #609 ----- net<-network.initialize(2,loops=TRUE,directed=FALSE) net[1,1]<-1 net[1,2]<-1 net[2,2]<-1 if(get.edgeIDs(net,v=1,alter=1)!=1){ stop("problem with get.edgeIDs on undirected network with loops") } if(get.edgeIDs(net,v=2,alter=2)!=3){ stop("problem with get.edgeIDs on undirected network with loops") } net<-network.initialize(2,loops=TRUE,directed=FALSE) net[1,2]<-1 if(length(get.edgeIDs(net,v=2,alter=2))>0){ stop("problem with get.edgeIDs on undirected network with loops") } # check for problem with as.network.edgelist with zero edges #1138 result1 <- as.matrix.network.edgelist(network.initialize(5),as.sna.edgelist = TRUE) if (nrow(result1) != 0){ stop('as.matrix.network.edgelist did not return correct value for net with zero edges') } result1a <- tibble::as_tibble(network.initialize(5)) if (nrow(result1a) != 0){ stop('as_tibble.network did not return correct value for net with zero edges') } result2<-as.matrix.network.adjacency(network.initialize(5)) if(nrow(result2) != 5 & ncol(result2) != 5){ stop('as.matrix.network.adjacency did not return matrix with correct dimensions') } result3<-as.matrix.network.adjacency(network.initialize(0)) if(nrow(result3) != 0 & ncol(result3) != 0){ stop('as.matrix.network.adjacency did not return matrix with correct dimensions') } result4<-as.matrix.network.incidence(network.initialize(5)) if(nrow(result4) != 5 & ncol(result4) != 0){ stop('as.matrix.network.incidence did not return matrix with correct dimensions') } result5<-as.matrix.network.incidence(network.initialize(0)) if(nrow(result5) != 0 & ncol(result5) != 0){ stop('as.matrix.network.incidence did not return matrix with correct dimensions') } #End test } network/tests/plotflo.R0000644000176200001440000000236714363704177014733 0ustar liggesusers#Set to TRUE to run tests if(FALSE){ # # load the library # library(network) # # attach the sociomatrix for the Florentine marriage data # This is not yet a graph object. # data(flo) # # print out the sociomatrix for the Florentine marriage data # flo # # Create a network object out of the adjacency matrix and print it out # nflo <- network(flo,directed=FALSE) nflo # # print out the sociomatrix for the Florentine marriage data # print(nflo,matrix.type="adjacency") # # plot the Florentine marriage data # plot(nflo) # # create a vector indicating the Medici family and add it as a covariate to the # graph object. # nflo <- set.vertex.attribute(nflo,"medici",c(0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0)) nflo # # create a vector indicating the Medici family for the graph # medici <- rep("",nrow(flo)) names(medici) <- dimnames(flo)[[1]] medici[names(medici)=="Medici"] <- "Medici" # # plot the marriage data, highlighting the Medici family # plot(nflo,vertex.col=1+get.vertex.attribute(nflo,"medici")) # plot the emon St. Helens network, with edge widths proportional # to 'Frequency', and edges labeled by their id data(emon) par(mar=c(0,0,0,0)) plot(emon[[5]],edge.label=TRUE,edge.label.cex=0.6, edge.col='gray',edge.lwd=(emon[[5]]%e%'Frequency')*2) #End tests } network/tests/list.attribute.tests.R0000644000176200001440000000410314363704157017356 0ustar liggesusers#Set to TRUE to run tests if(FALSE){ require(network) # --------- test list.vertex.attributes --- net<-network.initialize(3) list.vertex.attributes(net) if(!all(list.vertex.attributes(net)==c('na','vertex.names'))){ stop('list.vertex.attribute did not report default attributes corrrectly') } set.vertex.attribute(net,'letters',c("a","b","c")) if(!all(list.vertex.attributes(net)==c('letters','na','vertex.names'))){ stop('list.vertex.attribute did not report added attributes corrrectly') } # ----- test list.edge.attributes ---- net<-network.initialize(3) if(length(list.edge.attributes(net))!=0){ stop("list.edge.attributes did not return empty list for network with no edges") } add.edges(net,1,2) add.edges(net,2,3) if(list.edge.attributes(net)!='na'){ stop("list.edge.attributes did not return 'na' for network with only edges") } set.edge.attribute(net,'letter',c("a","b")) if(!all(list.edge.attributes(net)==c('letter','na'))){ stop("list.edge.attributes did not return attribute names for network with edges") } delete.edges(net,eid=1) if(!all(list.edge.attributes(net)==c('letter','na'))){ stop("list.edge.attributes did not return attribute names for network deleted edge") } # ---- test list.network.attributes ---- net<-network.initialize(3) if(!all(list.network.attributes(net)==c("bipartite", "directed", "hyper","loops","mnext", "multiple","n" ))){ stop("list.network.attributes returned unexpected values for default attributes of a network") } set.network.attribute(net,'letter',"a") if(!all(list.network.attributes(net)==c("bipartite", "directed", "hyper","letter","loops","mnext", "multiple","n" ))){ stop("list.network.attributes returned unexpected values for network with attribute added") } # ----- tests for printing function for edges cases ------ net<-network.initialize(100) net%n%'a_matrix'<-matrix(1:100,nrow=10,ncol=10) net%n%'a_null'<-NULL net%n%'a_list'<-list(part1=list(c("A","B")),part2=list("c")) net%n%'a_desc_vec'<-numeric(rep(100,1)) net%n%'a_net'<-network.initialize(5) print.network(net) #End tests } network/tests/general.tests.R0000644000176200001440000001710714363704151016020 0ustar liggesusers#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 } network/tests/network.battery.R0000644000176200001440000002407514363704166016414 0ustar liggesusers#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) #These functions are intended to mimic functionality from the sna package. #Said package is not required to use network, but was used in creating this #battery of tests. rgraph<-function(n){ m<-matrix(rbinom(n*n,1,0.5),n,n) diag(m)<-0 m } degree<-function(d,cmode = "freeman") { n <- dim(d)[1] diag(d) <- NA switch(cmode, indegree = apply(d, 2, sum, na.rm = TRUE), outdegree = apply(d, 1, sum, na.rm = TRUE), freeman = apply(d, 2, sum, na.rm = TRUE) + apply(d, 1, sum, na.rm = TRUE)) } #gctorture(TRUE) #Uncomment to perform a more intensive (SLOW) test # ---- Check assignment, deletion, and adjacency for dyadic graphs ---- check<-vector() temp<-network(matrix(0,5,5)) temp[1,2]<-1 #Add edge check[1]<-temp[1,2]==1 #Check adjacency check[2]<-get.network.attribute(temp,"mnext")==2 #Check count temp[1,2]<-1 #Should have no effect check[3]<-get.network.attribute(temp,"mnext")==2 #Check count temp[1,1]<-1 #Should have no effect check[4]<-temp[1,1]==0 #Shouldn't be present check[5]<-get.network.attribute(temp,"mnext")==2 #Check count temp[,2]<-1 #Should add 3 edges check[6]<-get.network.attribute(temp,"mnext")==5 #Check count check[7]<-all(temp[,2]==c(1,0,1,1,1)) #Verify row temp[3:4,3:4]<-1 #Should add 2 edges check[8]<-get.network.attribute(temp,"mnext")==7 #Check count temp[,]<-0 #Delete edges check[9]<-all(temp[,]==matrix(0,5,5)) #Verify that edges were removed temp[1:2,3:5]<-1 #Add new edges check[10]<-sum(temp[,])==6 #Check edge sum temp<-add.vertices(temp,3) #Add vertices check[11]<-network.size(temp)==8 check[12]<-sum(temp[,])==6 #Edges should still be there check[13]<-all(temp[,5]==c(1,1,0,0,0,0,0,0)) temp[8,]<-1 #Add edges to new vertex check[14]<-all(temp[8,]==c(1,1,1,1,1,1,1,0)) #Verify temp<-delete.vertices(temp,c(7,8)) #Remove vertices check[15]<-network.size(temp)==6 #Verify removal check[16]<-sum(temp[,])==6 #Check edge sum check[17]<-!any(c(7,8)%in%c(sapply(temp$mel,"[[","inl"),sapply(temp$mel,"[[","outl"))) #Make sure they're really gone! temp<-network(matrix(0,5,5),directed=FALSE,loops=TRUE) #Create undir graph check[18]<-is.directed(temp)==FALSE #Some simple gal tests check[19]<-has.loops(temp)==TRUE temp[1,]<-1 check[20]<-all(temp[,1]==temp[1,]) #Verify edges temp<-permute.vertexIDs(temp,5:1) #Permute check[21]<-all(temp[1,]==c(0,0,0,0,1)) #Verify permutation check[22]<-all(temp[,5]==rep(1,5)) check[23]<-all(get.neighborhood(temp,1)%in%c(5,1)) #Check neighborhoods check[24]<-all(sort(get.neighborhood(temp,5))==1:5) check[25]<-length(get.edges(temp,5))==5 #Check get.edges check[26]<-length(get.edges(temp,5,2))==1 g<-rgraph(10) temp<-network(g) check[27]<-all(g==temp[,]) #Yet more edge checkage check[28]<-all(g[3:1,-(4:3)]==temp[3:1,-(4:3)]) temp[,,,names.eval="newval"]<-matrix(1:100,10,10) #Edge value assignment check[29]<-all(as.sociomatrix(temp,"newval")==matrix(1:100,10,10)*g) check[30]<-all(apply(as.matrix.network.incidence(temp),1,sum)==(degree(g,cmode="indegree")-degree(g,cmode="outdegree"))) #Check incidence matrix check[31]<-all(dim(as.matrix.network.incidence(temp))==c(10,sum(g))) check[32]<-all(apply(as.matrix.network.incidence(temp,"newval"),1,sum)==(degree(matrix(1:100,10,10)*g,cmode="indegree")-degree(matrix(1:100,10,10)*g,cmode="outdegree"))) check[33]<-all(as.matrix.network.edgelist(temp,"newval")==cbind(row(g)[g>0],col(g)[g>0],matrix(1:100,10,10)[g>0])) temp[1:3,1:5,names.eval="newval"]<-matrix(1:15,3,5) check[34]<-all(as.sociomatrix(temp,"newval")[1:3,1:5]==g[1:3,1:5]*matrix(1:15,3,5)) temp[,,"na"]<-TRUE #Verify NA filtering check[35]<-sum(temp[,,na.omit=TRUE])==0 check[36]<-sum(is.na(temp[,,na.omit=FALSE]))==sum(g) #---- Check assignment, deletion, and adjacency for hypergraphs ---- temp<-network.initialize(10,directed=F,hyper=T,loops=T) check[37]<-sum(temp[,])==0 temp<-add.edge(temp,1:4,1:4,"value",list(5)) temp<-add.edge(temp,3:5,3:5,"value",list(6)) temp<-add.edge(temp,4:7,4:7,"value",list(7)) temp<-add.edge(temp,6:10,6:10,"value",list(8)) check[38]<-all(as.matrix.network.incidence(temp)==cbind(c(1,1,1,1,0,0,0,0,0,0),c(0,0,1,1,1,0,0,0,0,0),c(0,0,0,1,1,1,1,0,0,0),c(0,0,0,0,0,1,1,1,1,1))) check[39]<-all(as.matrix.network.incidence(temp,"value")==cbind(5*c(1,1,1,1,0,0,0,0,0,0),6*c(0,0,1,1,1,0,0,0,0,0),7*c(0,0,0,1,1,1,1,0,0,0),8*c(0,0,0,0,0,1,1,1,1,1))) check[40]<-all(temp[,]==((as.matrix.network.incidence(temp)%*%t(as.matrix.network.incidence(temp)))>0)) #---- Check coercion and construction methods ---- g<-rgraph(10) temp<-network(g) check[41]<-all(temp[,]==g) temp<-as.network(g*matrix(1:100,10,10),names.eval="value",ignore.eval=FALSE) check[42]<-all(as.sociomatrix(temp,"value")==g*matrix(1:100,10,10)) temp<-as.network.matrix(as.matrix.network.edgelist(temp,"value"),matrix.type="edgelist",names.eval="value",ignore.eval=FALSE) check[43]<-all(as.sociomatrix(temp,"value")==g*matrix(1:100,10,10)) temp<-as.network.matrix(as.matrix.network.incidence(temp,"value"),matrix.type="incidence",names.eval="value",ignore.eval=FALSE) check[44]<-all(as.sociomatrix(temp,"value")==g*matrix(1:100,10,10)) # check functioning of na.rm argument #922 plain<-as.network.matrix(matrix(c(0,1,NA,NA),ncol=2),na.rm=TRUE) if (network.naedgecount(plain) != 0){ stop('problem with na values in adjacency matrix coericon') } plain<-as.network.matrix(matrix(c(0,1,NA,NA),ncol=2),na.rm=FALSE) if (network.naedgecount(plain) != 1){ stop('problem with na values in adjacnecy matrix coericon') } # test for as.matrix.network edgelist bug #935 x <- network.initialize(10) add.edge(x,1,2) add.edge(x,2,3) set.edge.attribute(x,'foo','bar',e=2) # i.e. the edge from 2 to 3 if (!identical(as.matrix.network.edgelist(x,'foo'),structure(c("1", "2", "2", "3", NA, "bar"), .Dim = 2:3, n = 10, vnames = 1:10))){ stop("problem with as.matrix.network.edgelist with attribute and deleted edge") } #---- Check attribute assignment/access ---- g<-rgraph(10) temp<-network(g) temp<-set.vertex.attribute(temp,"value",1:10) check[45]<-all(get.vertex.attribute(temp,"value")==1:10) temp<-delete.vertex.attribute(temp,"value") check[46]<-all(is.na(get.vertex.attribute(temp,"value"))) temp<-set.vertex.attribute(temp,"value",1:5,c(2,4,6,8,10)) check[47]<-all(get.vertex.attribute(temp,"value")[c(2,4,6,8,10)]==1:5) temp<-set.network.attribute(temp,"value","pork!") check[48]<-get.network.attribute(temp,"value")=="pork!" temp<-delete.network.attribute(temp,"value") check[49]<-is.null(get.network.attribute(temp,"value")) temp<-set.edge.attribute(temp,"value",5) check[50]<-all(get.edge.attribute(temp$mel,"value")==5) temp<-delete.edge.attribute(temp,"value") check[51]<-all(is.null(get.edge.attribute(temp$mel,"value"))) temp<-set.edge.value(temp,"value",g*matrix(1:100,10,10)) check[52]<-all(get.edge.value(temp,"value")==(g*matrix(1:100,10,10))[g>0]) check[53]<-all(as.sociomatrix(temp,"value")==(g*matrix(1:100,10,10))) #---- Check additional operators ---- g<-rgraph(10) temp<-network(g,names.eval="value",ignore.eval=FALSE) temp2<-network(g*2,names.eval="value",ignore.eval=FALSE) check[54]<-all(g==as.sociomatrix(temp+temp2)) check[55]<-all(g*3==as.sociomatrix(sum(temp,temp2,attrname="value"),"value")) check[56]<-all(g==as.sociomatrix(temp*temp2)) check[57]<-all(g*2==as.sociomatrix(prod(temp,temp2,attrname="value"),"value")) check[58]<-all(0==as.sociomatrix(temp-temp2)) check[59]<-all(-g==as.sociomatrix(sum(temp,-as.sociomatrix(temp2,"value"),attrname="value"),"value")) check[60]<-all(((g%*%g)>0)==as.sociomatrix("%c%.network"(temp,temp2))) check[61]<-all(((g%*%g)>0)==as.sociomatrix(temp%c%temp2)) check[62]<-all(((!temp)[,]==!g)[diag(10)<1]) check[63]<-all((temp|temp2)[,]==g) check[64]<-all((temp&temp2)[,]==g) temp%v%"value"<-1:10 check[65]<-all(temp%v%"value"==1:10) temp%n%"value"<-"pork!" check[66]<-temp%n%"value"=="pork!" # ---- Check to ensure that in-place modification is not producing side effects ---- g<-network.initialize(5); checkg<-g; add.vertices(g,3) check[67]<-(network.size(checkg)==5)&&(network.size(g)==8) g<-network.initialize(5); checkg<-g; delete.vertices(g,2) check[68]<-(network.size(checkg)==5)&&(network.size(g)==4) g<-network.initialize(5); checkg<-g; add.edge(g,2,3) check[69]<-(sum(checkg[,])==0)&&(sum(g[,])==1) g<-network.initialize(5); checkg<-g; add.edges(g,c(2,2,2),c(1,3,4)) check[70]<-(sum(checkg[,])==0)&&(sum(g[,])==3) g<-network.initialize(5); checkg<-g; g%v%"boo"<-1:5 check[71]<-all(is.na(checkg%v%"boo"))&&all(g%v%"boo"==1:5) g<-network.initialize(5); checkg<-g; g%n%"boo"<-1:5 check[72]<-is.null(checkg%n%"boo")&&all(g%n%"boo"==1:5) g<-network.initialize(5); g[1,]<-1; checkg<-g; g%e%"boo"<-col(matrix(0,5,5)) check[73]<-is.null(checkg%e%"boo")&&all(g%e%"boo"==2:5) g<-network.initialize(5); checkg<-g; permute.vertexIDs(g,5:1) check[74]<-all(checkg%v%"vertex.names"==1:5)&&all(g%v%"vertex.names"==5:1) g<-network.initialize(5); temp<-(function(){add.vertices(g,3); network.size(g)})() check[75]<-(network.size(g)==5)&&(temp==8) g<-network.initialize(5); (function(){g<-network.initialize(4); add.vertices(g,3)})() check[76]<-(network.size(g)==5) # check for operators with undirected edge error ticket #279 # nw1 is assigned tailhead nw2<-network.initialize(3,directed=FALSE) nw2[2,1]<-1 # Which, the binary network operators don't take into account: check[77]<-network.edgecount(nw1-nw2)==0 # Should have 0, has 1. check[78]<-network.edgecount(nw1|nw2)==1 # Should have 1, has 2 (1->2 and 2->1). check[79]<-network.edgecount(nw1&nw2)==1 # Should have 1, has 0 (since it treats 1->2 and 2->1 differently). check[80]<-network.edgecount(!nw1)==2 # Should have choose(3,2)-1=2, has 3. check[81]<-network.edgecount(!nw2)==2 # Should have choose(3,2)-1=2, has 2. #If everything worked, check is TRUE if(!all(check)){ #Should be TRUE stop(paste("network package test failed on test(s):",which(!check))) } #End test } network/tests/benchmarks0000644000176200001440000000041213357022000015132 0ustar liggesusers"elapsed" "init" 0.947000000000116 "setv" 0.266000000000076 "getv" 0.346000000000004 "listv" 0.130999999999858 "adde" 1.29500000000007 "sete" 3.89800000000014 "gete" 0.196000000000367 "liste" 0.240999999999985 "addmoree" 2.10499999999956 "addmorev" 1.60500000000002 network/tests/pathological.tests.R0000644000176200001440000000131514363704173017047 0ustar liggesusers#Set to TRUE to run tests if(FALSE){ library(network) if (require(statnet.common,quietly=TRUE)){ opttest({ gctorture(TRUE) n <- 10 test <- network.initialize(n) for (i in 1:(n-1)){ for (j in (i+1):n){ cat(i,j,'\n') get.inducedSubgraph(test,v=i:j) } } gctorture(FALSE) },'Ticket #180 Test 1','NETWORK_pathology_TESTS') opttest({ gctorture(TRUE) test <- network.initialize(10) delete.vertices(test,5) gctorture(FALSE) },'Ticket #180 Test 2','NETWORK_pathology_TESTS') opttest({ x <- network.initialize(10) x[,] <- 1 try(set.edge.value(x,'foo',matrix('bar',5,5))) },'Ticket #827','NETWORK_pathology_TESTS') } #End tests } network/tests/testthat/0000755000176200001440000000000014725552272014760 5ustar liggesusersnetwork/tests/testthat/test-indexing.R0000644000176200001440000000204313740520334017652 0ustar liggesuserstest_that("proper error messages for out of bounds indexing (unipartite)",{ nw <- network.initialize(10) expect_error(nw[1,100], "subscript out of bounds") expect_error(nw[1,100] <- 1, "subscript out of bounds") expect_error(nw[100,1], "subscript out of bounds") expect_error(nw[100,1] <- 1, "subscript out of bounds") }) test_that("proper error messages (or lack thereof) for out of bounds indexing (bipartite)",{ nw <- network.initialize(10, bipartite=3, directed=FALSE) expect_error(nw[1,3], "subscript out of bounds") expect_error(nw[1,3] <- 1, "subscript out of bounds") expect_error(nw[4,5], "subscript out of bounds") expect_error(nw[4,5] <- 1, "subscript out of bounds") expect_error(nw[4,1], NA) expect_error(nw[5,3], NA) }) test_that("wildcard assignment (bipartite)",{ nw <- network.initialize(10, bipartite=3, directed=FALSE) nw[1,] <- 1 expect_equal(network.edgecount(nw), 7) # 7 nw[,4] <- 1 expect_equal(network.edgecount(nw), 9) # 7 + 3 - 1 nw[,] <- 1 expect_equal(network.edgecount(nw), 21) # 3*7 }) network/tests/testthat/test-i22-summary-character.R0000644000176200001440000000112513740520334022066 0ustar liggesuserstd <- data.frame( lettres = letters[1:10], values = 1:10, stringsAsFactors = FALSE ) # Correct output correct <- structure( c( "Length:10 ", "Class :character ", "Mode :character ", NA, NA, NA, "Min. : 1.00 ", "1st Qu.: 3.25 ", "Median : 5.50 ", "Mean : 5.50 ", "3rd Qu.: 7.75 ", "Max. :10.00 " ), .Dim = c(6L, 2L), .Dimnames = list(c("", "", "", "", "", ""), c(" lettres", " values")), class = "table" ) actual <- summary(td) expect_identical(actual, correct) network/tests/testthat/test-dataframe.R0000644000176200001440000006660214317402074020005 0ustar liggesuserstest_that("invalid or conflicting arguments throw", { edge_df <- data.frame(from = 1:3, to = 4:6) expect_error( as.network(edge_df, directed = "should be true or false"), "The following arguments must be either `TRUE` or `FALSE`:\n\t- directed", fixed = TRUE ) expect_error( as.network(edge_df, hyper = NULL), "The following arguments must be either `TRUE` or `FALSE`:\n\t- hyper", fixed = TRUE ) expect_error( as.network(edge_df, loops = NA), "The following arguments must be either `TRUE` or `FALSE`:\n\t- loops", fixed = TRUE ) expect_error( as.network(edge_df, bipartite = 1), "The following arguments must be either `TRUE` or `FALSE`:\n\t- bipartite", fixed = TRUE ) hyper_edge_df <- data.frame(from = c("a,b", "b,c"), to = c("c,d", "e,f"), stringsAsFactors = FALSE) hyper_edge_df[] <- lapply(hyper_edge_df, strsplit, split = ",") expect_warning( as.network(hyper_edge_df, hyper = TRUE, directed = FALSE), "If `hyper` is `TRUE` and `directed` is `FALSE`, `loops` must be `TRUE`.", fixed = TRUE ) expect_error( suppressWarnings( as.network(hyper_edge_df, hyper = TRUE, bipartite = TRUE, loops = TRUE, directed = FALSE) ), "Both `hyper` and `bipartite` are `TRUE`, but bipartite hypergraphs are not supported.", fixed = TRUE ) }) test_that("simple networks are built correctly", { simple_edge_df <- data.frame(.tail = c("b", "c", "c", "d", "d", "e"), .head = c("a", "b", "a", "a", "b", "a"), time = 1:6, stringsAsFactors = FALSE) simple_vertex_df <- data.frame(vertex.names = letters[1:5], type = letters[1:5], stringsAsFactors = FALSE) expect_s3_class( as.network(x = simple_edge_df), "network" ) expect_s3_class( as.network(x = simple_edge_df, vertices = simple_vertex_df), "network" ) expect_true( is.directed(as.network(x = simple_edge_df)) ) expect_false( is.directed(as.network(x = simple_edge_df, directed = FALSE)) ) expect_false( has.loops(as.network(x = simple_edge_df)) ) expect_false( is.multiplex(as.network(x = simple_edge_df)) ) expect_equal( network.edgecount(as.network(x = simple_edge_df)), nrow(simple_edge_df) ) expect_equal( network.size(as.network(x = simple_edge_df)), nrow(simple_vertex_df) ) simple_g <- as.network(x = simple_edge_df, vertices = simple_vertex_df) delete.edges(simple_g, 2) expect_identical( `rownames<-`(simple_edge_df[-2, ], NULL), as.data.frame(simple_g) ) delete.vertices(simple_g, 2) expect_identical( `rownames<-`(simple_vertex_df[-2, , drop = FALSE], NULL), as.data.frame(simple_g, unit = "vertices") ) }) test_that("simple and complex edge/vertex/R-object attributes are safely handled", { vertex_df <- data.frame(name = letters[5:1], lgl_attr = c(TRUE, FALSE, TRUE, FALSE, TRUE), int_attr = as.integer(seq_len(5)), dbl_attr = as.double(seq_len(5)), chr_attr = LETTERS[1:5], date_attr = seq.Date(as.Date("2019-12-22"), as.Date("2019-12-26"), by = 1), dttm_attr = as.POSIXct( seq.Date(as.Date("2019-12-22"), as.Date("2019-12-26"), by = 1) ), stringsAsFactors = FALSE) attr(vertex_df$date_attr, "tzone") <- "PST" attr(vertex_df$dttm_attr, "tzone") <- "EST" vertex_df$list_attr <- replicate(5, LETTERS, simplify = FALSE) vertex_df$mat_list_attr <- replicate(5, as.matrix(mtcars), simplify = FALSE) vertex_df$df_list_attr <- replicate(5, mtcars, simplify = FALSE) vertex_df$sfg_attr <- list( structure(c(1, 2, 3), class = c("XY", "POINT", "sfg")), structure(1:10, .Dim = c(5L, 2L), class = c("XY", "MULTIPOINT", "sfg")), structure(1:10, .Dim = c(5L, 2L), class = c("XY", "LINESTRING", "sfg")), structure(list(structure(c(0, 10, 10, 0, 0, 0, 0, 10, 10, 0), .Dim = c(5L, 2L)), structure(c(1, 1, 2, 2, 1, 1, 2, 2, 1, 1), .Dim = c(5L, 2L)), structure(c(5, 5, 6, 6, 5, 5, 6, 6, 5, 5), .Dim = c(5L, 2L))), class = c("XY", "MULTILINESTRING", "sfg")), structure(list(structure(c(0, 10, 10, 0, 0, 0, 0, 10, 10, 0),.Dim = c(5L, 2L)), structure(c(1, 1, 2, 2, 1, 1, 2, 2, 1, 1), .Dim = c(5L, 2L)), structure(c(5, 5, 6, 6, 5, 5, 6, 6, 5, 5), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg")) ) edge_df <- data.frame(from = c("b", "c", "c", "d", "d", "e"), to = c("a", "b", "a", "a", "b", "a"), lgl_attr = c(TRUE, FALSE, TRUE, FALSE, TRUE, FALSE), int_attr = as.integer(seq_len(6)), dbl_attr = as.double(seq_len(6)), chr_attr = LETTERS[1:6], date_attr = seq.Date(as.Date("2019-12-22"), as.Date("2019-12-27"), by = 1), dttm_attr = as.POSIXct( seq.Date(as.Date("2019-12-22"), as.Date("2019-12-27"), by = 1) ), stringsAsFactors = FALSE) attr(edge_df$date_attr, "tzone") <- "PST" attr(edge_df$dttm_attr, "tzone") <- "EST" edge_df$list_attr <- replicate(6, LETTERS, simplify = FALSE) edge_df$mat_list_attr <- replicate(6, as.matrix(mtcars), simplify = FALSE) edge_df$df_list_attr <- replicate(6, mtcars, simplify = FALSE) edge_df$sfg_attr <- list( structure(c(1, 2, 3), class = c("XY", "POINT", "sfg")), structure(1:10, .Dim = c(5L, 2L), class = c("XY", "MULTIPOINT", "sfg")), structure(1:10, .Dim = c(5L, 2L), class = c("XY", "LINESTRING", "sfg")), structure(list(structure(c(0, 10, 10, 0, 0, 0, 0, 10, 10, 0), .Dim = c(5L, 2L)), structure(c(1, 1, 2, 2, 1, 1, 2, 2, 1, 1), .Dim = c(5L, 2L)), structure(c(5, 5, 6, 6, 5, 5, 6, 6, 5, 5), .Dim = c(5L, 2L))), class = c("XY", "MULTILINESTRING", "sfg")), structure(list(structure(c(0, 10, 10, 0, 0, 0, 0, 10, 10, 0),.Dim = c(5L, 2L)), structure(c(1, 1, 2, 2, 1, 1, 2, 2, 1, 1), .Dim = c(5L, 2L)), structure(c(5, 5, 6, 6, 5, 5, 6, 6, 5, 5), .Dim = c(5L, 2L))), class = c("XY", "POLYGON", "sfg")), structure(list(list(structure(c(0, 10, 10, 0, 0, 0, 0, 10, 10, 0), .Dim = c(5L, 2L)), structure(c(1, 1, 2, 2, 1, 1, 2, 2, 1, 1), .Dim = c(5L, 2L)), structure(c(5, 5, 6, 6, 5, 5, 6, 6, 5, 5), .Dim = c(5L, 2L))), list(structure(c(12, 22, 22, 12, 12, 12, 12, 22, 22, 12), .Dim = c(5L, 2L)), structure(c(13, 13, 14, 14, 13, 13, 14, 14, 13, 13), .Dim = c(5L, 2L))), list(structure(c(24, 34, 34, 24, 24, 24, 24, 34, 34, 24), .Dim = c(5L, 2L)))), class = c("XY", "MULTIPOLYGON", "sfg")) ) g_many_attrs <- as.network(edge_df, vertices = vertex_df) # edge attributes ====================================================================== # bare atomic vectors expect_identical( get.edge.attribute(g_many_attrs, "lgl_attr"), edge_df$lgl_attr ) expect_identical( get.edge.attribute(g_many_attrs, "int_attr"), edge_df$int_attr ) expect_identical( get.edge.attribute(g_many_attrs, "dbl_attr"), edge_df$dbl_attr ) expect_identical( get.edge.attribute(g_many_attrs, "chr_attr"), edge_df$chr_attr ) # atomic vectors w/ attributes # TODO is there a way to get atomic vectors back while preserving attributes? # `c()` `v/sapply()` strip attributes edge_date_attr <- get.edge.attribute(g_many_attrs, "date_attr", unlist = FALSE) edge_date_attr_to_test <- `attributes<-`(unlist(edge_date_attr), attributes(edge_date_attr[[1]])) expect_identical( edge_date_attr_to_test, edge_df$date_attr ) edge_dttm_attr <- get.edge.attribute(g_many_attrs, "dttm_attr", unlist = FALSE) edge_dttm_attr_to_test <- `attributes<-`(unlist(edge_dttm_attr), attributes(edge_dttm_attr[[1]])) expect_identical( edge_dttm_attr_to_test, edge_df$dttm_attr ) # list of bare atomic vectors expect_identical( get.edge.attribute(g_many_attrs, "list_attr", unlist = FALSE), edge_df$list_attr ) # list of vectors with attributes expect_identical( get.edge.attribute(g_many_attrs, "mat_list_attr", unlist = FALSE), edge_df$mat_list_attr ) # recursive lists expect_identical( get.edge.attribute(g_many_attrs, "df_list_attr", unlist = FALSE), edge_df$df_list_attr ) # sf objects expect_identical( get.edge.attribute(g_many_attrs, "sfg_attr", unlist = FALSE), edge_df$sfg_attr ) # vertex attributes ==================================================================== # bare atomic vectors expect_identical( get.vertex.attribute(g_many_attrs, "vertex.names"), vertex_df[[1]] ) expect_identical( get.vertex.attribute(g_many_attrs, "lgl_attr"), vertex_df$lgl_attr ) expect_identical( get.vertex.attribute(g_many_attrs, "int_attr"), vertex_df$int_attr ) expect_identical( get.vertex.attribute(g_many_attrs, "dbl_attr"), vertex_df$dbl_attr ) expect_identical( get.vertex.attribute(g_many_attrs, "chr_attr"), vertex_df$chr_attr ) # atomic vectors w/ attributes # TODO is there a way to get atomic vectors back while preserving attributes? # `c()` `v/sapply()` strip attributes vertex_date_attr <- get.vertex.attribute(g_many_attrs, "date_attr", unlist = FALSE) vertex_date_attr_to_test <- `attributes<-`(unlist(vertex_date_attr), attributes(vertex_date_attr[[1]])) expect_identical( vertex_date_attr_to_test, vertex_df$date_attr ) vertex_dttm_attr <- get.vertex.attribute(g_many_attrs, "dttm_attr", unlist = FALSE) vertex_dttm_attr_to_test <- `attributes<-`(unlist(vertex_dttm_attr), attributes(vertex_dttm_attr[[1]])) expect_identical( vertex_dttm_attr_to_test, vertex_df$dttm_attr ) # list of bare atomic vectors expect_identical( get.vertex.attribute(g_many_attrs, "list_attr", unlist = FALSE), vertex_df$list_attr ) # list of vectors with attributes expect_identical( get.vertex.attribute(g_many_attrs, "mat_list_attr", unlist = FALSE), vertex_df$mat_list_attr ) # recursive lists expect_identical( get.vertex.attribute(g_many_attrs, "df_list_attr", unlist = FALSE), vertex_df$df_list_attr ) # sf objects expect_identical( get.vertex.attribute(g_many_attrs, "sfg_attr", unlist = FALSE), vertex_df$sfg_attr ) # conversion back to data.frame ======================================================== names(edge_df)[[1]] <- ".tail" names(edge_df)[[2]] <- ".head" edge_df$sfc_attr <- NULL names(vertex_df)[[1]] <- "vertex.names" vertex_df$sfc_attr <- NULL g_many_attrs <- delete.vertex.attribute(g_many_attrs, "sfc_attr") g_many_attrs <- delete.edge.attribute(g_many_attrs, "sfc_attr") expect_identical( edge_df, as.data.frame(g_many_attrs) ) expect_identical( vertex_df, as.data.frame(g_many_attrs, unit = "vertices") ) }) test_that("`multiple` arguments work", { dir_parallel_edge_df <- data.frame(from = c("a", "a"), to = c("b", "b"), stringsAsFactors = FALSE) expect_error( as.network(dir_parallel_edge_df), "`multiple` is `FALSE`, but `x` contains parallel edges." ) expect_s3_class( as.network(dir_parallel_edge_df, multiple = TRUE), "network" ) expect_true( is.multiplex(as.network(dir_parallel_edge_df, multiple = TRUE)) ) expect_true( is.directed(as.network(dir_parallel_edge_df, multiple = TRUE)) ) undir_parallel_edge_df <- data.frame(from = c("a", "b"), to = c("b", "a"), stringsAsFactors = FALSE) expect_s3_class( as.network(undir_parallel_edge_df), "network" ) expect_error( as.network(undir_parallel_edge_df, directed = FALSE), "`multiple` is `FALSE`, but `x` contains parallel edges." ) expect_s3_class( as.network(undir_parallel_edge_df, directed = FALSE, multiple = TRUE), "network" ) expect_true( is.multiplex(as.network(undir_parallel_edge_df, directed = FALSE, multiple = TRUE)) ) expect_false( is.directed(as.network(undir_parallel_edge_df, directed = FALSE, multiple = TRUE)) ) }) test_that("`loops` works", { df_with_loops <- data.frame(from = c("b", "c", "c", "d", "d", "e", "f"), to = c("a", "b", "a", "a", "b", "a", "f"), stringsAsFactors = FALSE) expect_error( as.network(df_with_loops), "`loops` is `FALSE`" ) expect_s3_class( as.network(df_with_loops, loops = TRUE), "network" ) }) test_that("missing vertex names are caught", { missing_vertex_df <- data.frame(name = letters[1:5], stringsAsFactors = FALSE) missing_edge_df <- data.frame(from = c("b", "c", "c", "d", "d", "e", "f"), to = c("a", "b", "a", "a", "b", "a", "g"), stringsAsFactors = FALSE) expect_error( as.network(missing_edge_df, vertices = missing_vertex_df), "The following vertices are in `x`, but not in `vertices`:\n\t- f\n\t- g", fixed = TRUE ) }) test_that("duplicate vertex names are caught", { dup_vertex_df <- data.frame(name = c("a", "a", "b", "c", "d", "e"), stringsAsFactors = FALSE) dup_edge_df <- data.frame(from = c("b", "c", "c", "d", "d", "e"), to = c("a", "b", "a", "a", "b", "a"), stringsAsFactors = FALSE) expect_error( as.network(dup_edge_df, vertices = dup_vertex_df), "The following vertex names are duplicated in `vertices`:\n\t- a", fixed = TRUE ) }) test_that("bad data frames are caught", { edge_df_with_NAs1 <- data.frame(from = c(letters, NA), to = c("a", letters), stringsAsFactors = FALSE) edge_df_with_NAs2 <- data.frame(from = c(letters, "a"), to = c(NA, letters), stringsAsFactors = FALSE) empty_vertex_df <- data.frame() expect_error( as.network(edge_df_with_NAs2), "The first two columns of `x` cannot contain `NA` values.", fixed = TRUE ) expect_error( as.network(edge_df_with_NAs2), "The first two columns of `x` cannot contain `NA` values.", fixed = TRUE ) expect_error( as.network(edge_df_with_NAs1[0, 0]), "`x` should be a data frame with at least two columns and one row.", fixed = TRUE ) expect_error( as.network(na.omit(edge_df_with_NAs1), vertices = empty_vertex_df, loops = TRUE), "`vertices` should contain at least one column and row.", fixed = TRUE ) incompat_edge_types <- data.frame( from = c("a", "b"), to = c(1, 2), stringsAsFactors = FALSE ) expect_error( as.network(incompat_edge_types), "The first two columns of `x` must be of the same type.", fixed = TRUE ) non_df_vertices_edge_df <- data.frame(from = 1, to = 2) non_df_vertices <- list(name = 1:2) expect_error( as.network(non_df_vertices_edge_df, vertices = non_df_vertices), "If provided, `vertices` should be a data frame.", fixed = TRUE ) bad_vertex_names_col <- data.frame(name = I(list(1))) expect_error( as.network(non_df_vertices_edge_df, vertices = bad_vertex_names_col), "The first column of `vertices` must be an atomic vector.", fixed = TRUE ) incompat_types_edge_df <- data.frame(from = 1:3, to = 4:6) incompat_types_vertex_df <- data.frame(name = paste(1:6), stringsAsFactors = FALSE) expect_error( as.network(incompat_types_edge_df, vertices = incompat_types_vertex_df), "The first column of `vertices` must be the same type as the value with which they are referenced in `x`'s first two columns.", fixed = TRUE ) recursive_edge_df <- data.frame(from = I(list(1:2)), to = 3) expect_error( as.network(recursive_edge_df), "If `hyper` is `FALSE`, the first two columns of `x` should be atomic vectors.", fixed = TRUE ) }) test_that("bipartite networks work", { bip_edge_df <- data.frame(.tail = c("a", "a", "b", "b", "c", "d", "d", "e"), .head = c("e1", "e2", "e1", "e3", "e3", "e2", "e3", "e1"), an_edge_attr = letters[1:8], stringsAsFactors = FALSE) bip_node_df <- data.frame(vertex.names = c("a", "e1", "b", "e2", "c", "e3", "d", "e"), node_type = c("person", "event", "person", "event", "person", "event", "person", "person"), color = c("red", "blue", "red", "blue", "red", "blue", "red", "red"), stringsAsFactors = FALSE) expect_silent( # vertices already in correct order as.network(bip_edge_df, directed = FALSE, vertices = data.frame(name = unique(unlist(bip_edge_df[1:2])))) ) expect_warning( # warn that vertices are reordered once as.network(bip_edge_df, directed = FALSE, vertices = bip_node_df, bipartite = TRUE) ) expect_silent( # do not warn again in the same session as.network(bip_edge_df, directed = FALSE, vertices = bip_node_df, bipartite = TRUE) ) expect_warning( as.network(bip_edge_df, vertices = bip_node_df, bipartite = TRUE), "If `bipartite` is `TRUE`, edges are interpreted as undirected.", fixed = TRUE ) expect_warning( as.network(bip_edge_df, directed = FALSE, vertices = bip_node_df, bipartite = TRUE, loops = TRUE), "If `bipartite` is `TRUE`, `loops` must be `FALSE`.", fixed = TRUE ) bip_g <- as.network(bip_edge_df, directed = FALSE, vertices = bip_node_df, loops = FALSE, bipartite = TRUE) expect_identical( bip_edge_df, as.data.frame(bip_g) ) expect_identical( # tracking modes by vertex order means we have to reorder the data frame # and reset row.names to test `rownames<-`( bip_node_df[order(bip_node_df$node_type == "person", decreasing = TRUE), ], NULL ), as.data.frame(bip_g, unit = "vertices") ) expect_s3_class( bip_g, "network" ) expect_true( is.bipartite(bip_g) ) expect_false( has.loops(bip_g) ) expect_false( is.directed(bip_g) ) expect_identical( get.network.attribute(bip_g, "bipartite"), 5L ) expect_identical( get.vertex.attribute(bip_g, attrname = "node_type"), c(rep("person", 5), rep("event", 3)) ) expect_identical( get.vertex.attribute(bip_g, attrname = "vertex.names"), c("a", "b", "c", "d", "e", "e1", "e2", "e3") ) expect_identical( get.edge.attribute(bip_g, attrname = "an_edge_attr"), letters[1:8] ) # check if bipartite networks with isolates are caught bip_isolates_node_df <- data.frame( vertex.names = c("a", "e1", "b", "e2", "c", "e3", "d", "e", "f", "g"), stringsAsFactors = FALSE ) expect_error( as.network(x = bip_edge_df, directed = FALSE, vertices = bip_isolates_node_df, bipartite = TRUE), "`bipartite` is `TRUE`, but the `vertices` you provided contain names that are not present in `x`" ) bip_isolates_node_df$is_actor <- !grepl("^e\\d$", bip_isolates_node_df$vertex.names) bip_isoaltes_g <- as.network(x = bip_edge_df, directed = FALSE, vertices = bip_isolates_node_df, bipartite = TRUE) expect_s3_class( bip_isoaltes_g, "network" ) expect_identical( bip_edge_df, as.data.frame(bip_isoaltes_g) ) expect_identical( `rownames<-`( bip_isolates_node_df[order(bip_isolates_node_df$is_actor, decreasing = TRUE), ], NULL ), as.data.frame(bip_isoaltes_g, unit = "vertices") ) # use custom `bipartite_col` name bip_isolates_node_df$my_bipartite_col <- bip_isolates_node_df$is_actor expect_identical( as.network(x = bip_edge_df, directed = FALSE, vertices = bip_isolates_node_df, bipartite = TRUE), as.network(x = bip_edge_df, directed = FALSE, vertices = bip_isolates_node_df, bipartite = TRUE, bipartite_col = "my_bipartite_col") ) # throw errors on invalid `bipartite_col`s expect_error( as.network(x = bip_edge_df, directed = FALSE, vertices = bip_isolates_node_df, bipartite = TRUE, bipartite_col = NA_character_) ) expect_error( as.network(x = bip_edge_df, directed = FALSE, vertices = bip_isolates_node_df, bipartite = TRUE, bipartite_col = list()) ) expect_error( as.network(x = bip_edge_df, directed = FALSE, vertices = bip_isolates_node_df, bipartite = TRUE, bipartite_col = c("bad", "arg")) ) bip_isolates_node_df$is_actor <- as.integer(bip_isolates_node_df$is_actor) expect_error( as.network(x = bip_edge_df, directed = FALSE, vertices = bip_isolates_node_df, bipartite = TRUE), "`bipartite` is `TRUE` and vertex types are specified via a column in `vertices` named `\"is_actor\"`.\n\t- If provided, all values in `vertices[[\"is_actor\"]]` must be `TRUE` or `FALSE`.", fixed = TRUE ) # check if nodes that appear in both of the first 2 `edge` columns are caught bip_confused_edge_df <- data.frame( actor = c("a", "a", "b", "b", "c", "d", "d", "e", "e1"), event = c("e1", "e2", "e1", "e3", "e3", "e2", "e3", "e1", "e2"), stringsAsFactors = FALSE ) expect_error( as.network(x = bip_confused_edge_df, directed = FALSE, bipartite = TRUE), "`bipartite` is `TRUE`, but there are vertices that appear in both of the first two columns of `x`." ) }) test_that("hyper-edges work", { hyper_edge_df <- structure( list(.tail = list(1:4, 3:5, 4:7, 6:10), .head = list(1:4, 3:5, 4:7, 6:10), value = as.double(5:8)), row.names = 1:4, class = "data.frame" ) hyper_target_net <- network.initialize(10, directed = FALSE, hyper = TRUE, loops = TRUE) hyper_target_net <- add.edge(hyper_target_net, 1:4, 1:4, "value", list(5)) hyper_target_net <- add.edge(hyper_target_net, 3:5, 3:5, "value", list(6)) hyper_target_net <- add.edge(hyper_target_net, 4:7, 4:7, "value", list(7)) hyper_target_net <- add.edge(hyper_target_net, 6:10, 6:10, "value", list(8)) expect_identical( as.network(hyper_edge_df, directed = FALSE, hyper = TRUE, loops = TRUE), hyper_target_net ) expect_identical( hyper_edge_df, as.data.frame(hyper_target_net) ) MtSHbyloc_edge_df <- structure( list( .tail = list( as.integer(c(1, 14, 15, 16, 17, 18, 19, 21, 22, 23, 24, 25, 26, 27)), as.integer(c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 20, 26, 27)) ), .head = list( as.integer(c(1, 14, 15, 16, 17, 18, 19, 21, 22, 23, 24, 25, 26, 27)), as.integer(c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 20, 26, 27)) ) ), row.names = 1:2, class = "data.frame" ) MtSHbyloc_vertex_df <- data.frame( vertex.names = 1:27 ) data("emon") MtSHloc <- emon$MtStHelens %v% "Location" MtSHimat <- cbind(MtSHloc %in% c("L", "B"), MtSHloc %in% c("NL", "B")) MtSHbyloc <- network(MtSHimat, matrix.type = "incidence", hyper = TRUE, directed = FALSE, loops = TRUE) expect_identical( as.network(MtSHbyloc_edge_df, directed = FALSE, vertices = MtSHbyloc_vertex_df, loops = TRUE, hyper = TRUE), MtSHbyloc ) expect_identical( MtSHbyloc_edge_df, as.data.frame(MtSHbyloc) ) expect_identical( MtSHbyloc_vertex_df, as.data.frame(MtSHbyloc, unit = "vertices") ) delete.edges(MtSHbyloc, 2) expect_identical( `rownames<-`(MtSHbyloc_edge_df[-2, ], NULL), as.data.frame(MtSHbyloc) ) delete.vertices(MtSHbyloc, 2) expect_identical( `rownames<-`(MtSHbyloc_vertex_df[-2, , drop = FALSE], NULL), as.data.frame(MtSHbyloc, unit = "vertices") ) hyper_edges_with_NA <- data.frame( from = I(list(c(NA, "a", "b"))), to = I(list(c("c", "d"))) ) expect_error( as.network(hyper_edges_with_NA, hyper = TRUE), "`x`'s first two columns contain invalid values." ) non_hyper_edges <- data.frame( from = 1:3, to = 4:6 ) expect_error( as.network(non_hyper_edges, hyper = TRUE), "If `hyper` is `TRUE`, the first two columns of `x` should be list columns." ) incompat_type_hyper_edges <- data.frame( from = I(list(letters[1:5], 1:5)), to = I(list(letters[6:10], letters[11:15])) ) expect_error( as.network(incompat_type_hyper_edges, hyper = T), "The values in the first two columns of `x` must be of the same type and cannot be `NULL`, `NA`, or recursive values." ) loop_hyper_edges <- data.frame( from = I(list(c("a", "b"))), to = I(list(c("a", "b"))) ) expect_error( as.network(loop_hyper_edges, hyper = TRUE), "`loops` is `FALSE`, but `x` contains loops." ) }) test_that("edge/vertex-less networks return empty data frames", { empty_g <- network.initialize(0) expect_identical( nrow(as.data.frame(empty_g)), 0L ) expect_identical( ncol(as.data.frame(empty_g)), 2L ) expect_identical( ncol(as.data.frame(empty_g, attrs_to_ignore = NULL)), 3L ) expect_identical( nrow(as.data.frame(empty_g, unit = "vertices")), 0L ) expect_identical( ncol(as.data.frame(empty_g, unit = "vertices")), 1L ) expect_identical( ncol(as.data.frame(empty_g, unit = "vertices", attrs_to_ignore = NULL)), 2L ) }) test_that("deleted edges/vertices and na attributes are handled correctly", { na_edge_df <- data.frame(.tail = c("b", "c", "c", "d", "d", "e"), .head = c("a", "b", "a", "a", "b", "a"), na = c(rep(FALSE, 5), TRUE), stringsAsFactors = FALSE) na_vertex_df <- data.frame(vertex.names = letters[1:5], na = c(rep(FALSE, 4), TRUE), stringsAsFactors = FALSE) na_g <- as.network(na_edge_df, vertices = na_vertex_df) expect_identical( as.data.frame(na_g, na.rm = FALSE, attrs_to_ignore = NULL), na_edge_df ) expect_identical( as.data.frame(na_g, unit = "vertices", na.rm = FALSE, attrs_to_ignore = NULL), na_vertex_df ) delete.edges(na_g, 1) expect_identical( `rownames<-`(na_edge_df[-c(1, which(na_edge_df$na)), ], NULL), as.data.frame(na_g, attrs_to_ignore = NULL) ) delete.vertices(na_g, 1) expect_identical( `rownames<-`(na_vertex_df[-c(1, which(na_vertex_df$na)), ], NULL), as.data.frame(na_g, unit = "vertices", attrs_to_ignore = NULL) ) }) test_that("as.data.frame.network() handles missing vertex.names ", { # addresses https://github.com/statnet/network/issues/43 nw_no_vertex.names <- network.initialize(5) delete.vertex.attribute(nw_no_vertex.names, "vertex.names") expect_identical( as.data.frame(nw_no_vertex.names, unit = "vertices"), data.frame(vertex.names = as.character(1:5)) ) }) network/tests/testthat/test-plot.R0000644000176200001440000000704413740520334017031 0ustar liggesusers# various tests for network plotting functions # mostly recent functionality added by skyebend # Open null device pdf(file = NULL, onefile = TRUE) dev_id <- dev.cur() # ----- test edge labels ------ ymat<-matrix(c(0,1,2,3, 0,0,0,0, 1,0,0,0, 0,0,0,0),ncol=4) ynet<-network(ymat,ignore.eval=FALSE,names.eval='weight') # don't do anything if no value given plot(ynet,edge.label.col='blue',edge.label.cex='weight') # use edge ids is if edge.label=TRUE plot(ynet,edge.label=TRUE) plot(ynet,edge.label='weight',edge.label.col='blue',edge.label.cex='weight') # labels for curved edges plot(ynet,edge.label='weight',edge.label.col='blue',edge.label.cex='weight',usecurve=TRUE) plot(ynet,edge.label='weight',edge.label.col='blue',edge.label.cex='weight',usecurve=TRUE,edge.curve=0.5) data(emon) par(mar=c(0,0,0,0)) plot(emon[[5]],edge.label=TRUE,edge.label.cex=0.6,edge.col='gray',edge.lwd=(emon[[5]]%e%'Frequency')*2) # test for labeling network with no edges #521 plot(network.initialize(1),edge.label=TRUE) # test color stuff col.list<-c('red','#800000','#80000505',NA) # test is.color for vector NA processing bug #491 if(!all(is.color(col.list)[1:3] & is.na(is.color(col.list)[4]))){ stop('is.color did not correctly recognize colors and NA values in a character vector') } col.list<-list('red','#800000','#80000505',NA) # test is.color for list NA processing bug #491 if(!all(is.color(col.list)[1:3] & is.na(is.color(col.list)[4]))){ stop('is.color did not correctly recognize colors and NA values in a list') } # ------------ as.color -------- expect_equal(as.color(c('a','b','c')),1:3) # character expect_equal(as.color(1:3),1:3) # numeric expect_equal(as.color(as.factor(c('a','b','c'))),1:3) # factor expect_equal(as.color(c('red','green','blue')),c('red','green','blue')) # color name expect_equal(as.color(c(1,0.5,0)),c("#FFFFFF", "#808080", "#000000"))# real valued (gray) # transparency/ opacity expect_equal(as.color(c('red','green','blue'),0.5),c("#FF000080", "#00FF0080", "#0000FF80")) if(R.Version()$major <= 3) expect_equal(as.color(1:3,0.5),c("#00000080", "#FF000080", "#00CD0080")) else expect_equal(as.color(1:3,0.5),c("#00000080", "#DF536B80", "#61D04F80")) expect_error(as.color(c('red','green','blue'),1.5),regexp = 'opacity parameter must be a numeric value in the range 0 to 1') # ----- plot fixes ---- plot(network.initialize(5),vertex.lwd=c(1,2,3,5,10)) # test for expansion of label attribute name bug #785 # this should produce a plot with vertices labeled A to E, instead # used to plot single vertex is labeled with "Label' test<-network.initialize(5) set.vertex.attribute(test,'Label',LETTERS[1:5]) plot(test,label='Label') # replicates non-matching label name plot(test,label='A') plot(test,label=1) # should error if all values are missing #set.vertex.attribute(test,'bad',NA,v=1:3) #plot(test,label='bad') # tests for #673 plot.network.default gives error when rendering labels if two connected vertices have the same position test<-network.initialize(2) test[1,2]<-1 plot(test,coord=cbind(c(1,1),c(1,1)),jitter=FALSE,displaylabels=TRUE) test<-network.initialize(3) test[1,2:3]<-1 plot(test,coord=cbind(c(1,1,2),c(1,1,2)),jitter=FALSE,displaylabels=TRUE) # tests for polygon sizes/sides plot(network.initialize(7),vertex.sides=c(50,4,3,2,1,0,NA),vertex.cex=40,coord=matrix(0,ncol=7,nrow=7),jitter=F,vertex.col='#CCCCCC00',vertex.border =c('red','green','blue','orange')) plot(network.initialize(7),vertex.sides=c(50,4,3,2,1,0,NA),vertex.cex=0) plot(network.initialize(7),vertex.sides=c(50,4,3,2,1,0,NA),vertex.cex=NA) # close the device dev.off(which = dev_id) network/tests/testthat/test-read.paj.R0000644000176200001440000002417014723241675017550 0ustar liggesusers# test for reading pajek formatted files # test for case of verticse, but no edges/arcs tmptest<-tempfile() cat("*Vertices 2 1 1231062 2 1231095 *Arcs *Edges ",file=tmptest) noEdges<-read.paj(tmptest) expect_equal(network.size(noEdges),2) expect_equal(network.edgecount(noEdges),0) # check arcs vs edges parsing # arcs only tmptest<-tempfile() cat("*Vertices 3 1 'A' 2 'B' 3 'C' *Arcs 1 2 1 1 3 1 ",file=tmptest) arcsOnly<-read.paj(tmptest) expect_true(is.directed(arcsOnly)) expect_equal(network.edgecount(arcsOnly),2) # edges only tmptest<-tempfile() cat('*Vertices 9 1 "1" 0.3034 0.7561 2 "2" 0.4565 0.6039 3 "3" 0.4887 0.8188 4 "4" 0.5687 0.4184 5 "5" 0.3574 0.4180 6 "6" 0.7347 0.2678 7 "7" 0.9589 0.3105 8 "8" 0.8833 0.1269 9 "9" 0.7034 0.0411 *Arcs *Edges 1 2 1 1 3 1 2 3 1 2 4 1 2 5 1 4 5 1 4 6 1 6 7 1 6 8 1 6 9 1 7 8 1 8 9 1 ',file=tmptest) edgesOnly<-read.paj(tmptest) expect_false(is.directed(edgesOnly)) expect_equal(network.edgecount(edgesOnly),12) # both arcs and edges # network will be directed, each *edges record will create one arc in each direction tmptest<-tempfile() cat("*Vertices 4 1 'A' 2 'B' 3 'C' 4 'D' *Arcs 1 2 1 1 3 1 *Edges 3 4 1 ",file=tmptest) arcsNEdges<-read.paj(tmptest) expect_true(is.directed(arcsNEdges)) expect_equal(network.edgecount(arcsNEdges),4) as.matrix(arcsNEdges) # ----- error testing tmptest<-tempfile() cat("*Vertices 2 1 'A' 2 'B' *Arcs 1 ",file=tmptest) expect_error(read.paj(tmptest),regexp = 'does not appear to have the required') tmptest<-tempfile() cat("*Vertices 2 1 'A' 2 'B' *Arcs 1 A 1 ",file=tmptest) expect_error(suppressWarnings(read.paj(tmptest)),regexp = 'contains non-numeric or NA values') tmptest<-tempfile() cat("*Vertices 2 1 'A' 2 'B' *Arcs 1 2.5 1 ",file=tmptest) expect_error(read.paj(tmptest),regexp = 'contains non-integer values') # check vertex graphic attribute fill-in tmptest<-tempfile() cat("*Vertices 4 1 'A' 0 0 0 box 2 'B' 0 0 0 3 'C' 0 0 0 4 'D' 0 0 0 ellipse *Arcs 1 2 1 1 3 1 ",file=tmptest) fillIn<-read.paj(tmptest) expect_equal(fillIn%v%'shape',c('box','box','box','ellipse')) # test stuff in file comments ########## but multirelational ############ only ~200 nodes #GulfLDays.net #GulfLMonths.net #GulfLDow.net #gulfAllDays.net #GulfADays.zip #gulfAllMonths.net #GulfAMonths.zip #LevantDays.net #LevantMonths.net #BalkanDays.net #BalkanMonths.net #arcs and edges both present search for " #these have both arc and edge lines " or "URL has a net file" #Graph drawing competition page (GD) #C95,C95,B98,A99,C99,A99m #things to do: #handle ragged array .net files like "CSphd.net" DONE!! #handel two mode networks DONE!! #handle mix of edges and arcs DONE!! #handle multirelational pajek files #issue with read.table and number.cols and fill...SanJuanSur_deathmessage.net has one row with 8 all the rest (including the first 5 have 5) ## # this file has character encoding issues ## scotland<-tempfile('scotland',fileext='.zip') ## download.file( ## 'http://vlado.fmf.uni-lj.si/pub/networks/data/esna/scotland.zip', ## scotland, ## quiet = TRUE) ## scotpaj<-tempfile('Scotland',fileext='.paj') ## con <- unz(scotland,'Scotland.paj') ## cat( ## readLines(con, encoding = "UTF-8"), ## sep='\n', ## file = scotpaj ## ) ## close(con) ## scotproj<-read.paj(scotpaj) ## # produces two element list, containing networks and partitions ## expect_equal(names(scotproj),c("networks","partitions")) ## expect_equal(network.size(scotproj[[1]][[1]]),244) ## expect_equal(names(scotproj$partitions),c("Affiliation.partition.of.N1.[108,136]","Industrial_categories.clu")) ## A95net<-read.paj("http://vlado.fmf.uni-lj.si/pub/networks/data/GD/gd95/A95.net") ## expect_equal(network.size(A95net),36) ## expect_equal(network.vertex.names(A95net)[1:5],c("MUX","INSTRUCTION BUFFER (4 x 16)", "RCV","DRV","ROM REG")) ## # test reading a .paj project file ## bkfratProj<-read.paj('http://vlado.fmf.uni-lj.si/pub/networks/data/ucinet/bkfrat.paj') ## # should have two networks ## expect_equal(sapply(bkfratProj,class),c('network','network'),check.attributes=FALSE) ## # .. with wierd names ## expect_equal(names(bkfratProj),c('UciNet\\BKFRAT.DAT : BKFRAB','UciNet\\BKFRAT.DAT : BKFRAC')) ## # and 58 vertices ## expect_equal(sapply(bkfratProj,network.size),c(58,58),check.attributes=FALSE) ## expect_equal(sapply(bkfratProj,network.edgecount),c(1934,3306),check.attributes=FALSE) ## #check edge values and attribute naming ## expect_equal((bkfratProj[[1]]%e%"UciNet\\BKFRAT.DAT : BKFRAB")[1900:1934],c(1, 1, 1, 5, 2, 4, 2, 1, 3, 1, 3, 1, 2, 5, 1, 1, 1, 2, 1, 2, 2, 1, 6, 2, 1, 2, 2, 1, 1, 1, 1, 3, 3, 1, 1)) ## # check vert attrs ## expect_equal(list.vertex.attributes(bkfratProj[[1]]),c('na','vertex.names','x','y','z')) ## # check network attrs ## expect_equal(bkfratProj[[1]]%n%'title',"UciNet\\BKFRAT.DAT : BKFRAB") ## expect_equal(bkfratProj[[2]]%n%'title',"UciNet\\BKFRAT.DAT : BKFRAC") ## # check loop flagging ## tmptest<-tempfile() ## cat("*Vertices 2 ## 1 'A' ## 2 'B' ## *Arcs ## 1 1 1 ## ",file=tmptest) ## loopTest<-read.paj(tmptest,verbose=FALSE) ## expect_true(has.loops(loopTest)) ## # check edge.name argument ## tmptest<-tempfile() ## cat("*Vertices 2 ## 1 'A' ## 2 'B' ## *Arcs ## 1 1 1 ## ",file=tmptest) ## loopTest<-read.paj(tmptest,verbose=FALSE,edge.name='weight') ## expect_equal(list.edge.attributes(loopTest),c('na','weight')) ## # the rest of these will take longer, so including in opttest block so won't run on CRAN ## require(statnet.common) ## opttest(testvar = "ENABLE_statnet_TESTS",{ ## # ----- examples from http://vlado.fmf.uni-lj.si/pub/networks/doc/ECPR/08/ECPR01.pdf --- ## GraphSet<-read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/GraphSet.net') ## expect_true(is.directed(GraphSet)) ## expect_equal(network.edgecount(GraphSet),27) ## # network contains some repeated edges ## expect_true(is.multiplex(GraphSet)) ## expect_equal(network.vertex.names(GraphSet),letters[1:12]) ## Tina<-read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/TinaSet.net') ## # arcslist ## GraphList<-read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/GraphList.net') ## # http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/TinaList.net # arcslist ## # matrix ## GraphMat <-read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/GraphMat.net') ## expect_equal(network.vertex.names(GraphMat),letters[1:12]) ## # check that edge attribute created and parsed correctly ## expect_equal(as.matrix(GraphMat,attrname='GraphMat')[3,7],2) ## # partition ## TinaPaj<-read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Tina.paj') ## expect_equal(class(TinaPaj$partitions),'data.frame') ## expect_equal( TinaPaj$partitions[,1],c(2,1,2,2,2,2,2,2,3,3,3),use.names=FALSE) ## expect_true(is.network(TinaPaj$networks$Tina)) ## # --- crude timing info -- ## # by default timing info should be added as attribute ## timetest<-read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Time.net') ## expect_equal(timetest%e%'pajekTiming',c("[7]","[6-8]")) ## expect_equal(timetest%v%'pajekTiming',c("[5-10,12-14]", "[1-3,7]", "[4-*]")) ## expect_true(setequal(list.vertex.attributes(timetest),c('na','pajekTiming','vertex.names'))) # no x or y ## expect_true(setequal(list.edge.attributes(timetest),c('na','pajekTiming','Time'))) ## # test converting to networkDynamic format ## timetestNd<-read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Time.net',time.format='networkDynamic') ## expect_equal(class(timetestNd),c('networkDynamic','network')) ## # check that activiy matrices are built as expected ## expect_equal(get.vertex.attribute(timetestNd,'active',unlist=FALSE),list(structure(c(5, 12, 11, 15), .Dim = c(2L, 2L)), structure(c(1, 7, 4, 8), .Dim = c(2L, 2L)), structure(c(4, Inf), .Dim = 1:2))) ## expect_equal(get.edge.attribute(timetestNd,'active',unlist=FALSE),list(structure(c(7, 8), .Dim = 1:2), structure(c(6, 9), .Dim = 1:2))) ## # read a *big* one http://vlado.fmf.uni-lj.si/pub/networks/data/CRA/Days.zip ## # 1.3 Mb, 13k vertices, 256K lines. ## # days<-tempfile('days',fileext='.zip') ## # download.file('http://vlado.fmf.uni-lj.si/pub/networks/data/CRA/Days.zip',days) ## # terrorTerms<-read.paj(unz(days,'Days.net'),verbose=TRUE,time.format='networkDynamic',edge.name='count') ## # multiple networks ## sampson<-read.paj('http://vlado.fmf.uni-lj.si/pub/networks/pajek/data/Sampson.net') ## lapply(sampson,class) # for some reason it is a formula? ## expect_equal(names(sampson$networks),c("SAMPLK1", "SAMPLK2", "SAMPLK3", "SAMPDLK", "SAMPES","SAMPDES","SAMPIN","SAMPNIN","SAMPPR","SAMNPR")) ## # multiple networks in arcslist format ## # sampsonL<-read.paj('http://vlado.fmf.uni-lj.si/pub/networks/pajek/data/SampsonL.net') ## # two-mode ## sandi<-read.paj('http://vlado.fmf.uni-lj.si/pub/networks/data/2mode/sandi/sandi.net') ## expect_true(is.bipartite(sandi)) ## expect_equal(sandi%n%'bipartite',314) ## Davis<-read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Davis.paj') # two-mode ## expect_equal(Davis$networks[[1]]%n%'bipartite',18) ## # lots of edge and vertex attributes ## A96<-read.paj('http://vlado.fmf.uni-lj.si/pub/networks/data/GD/gd96/A96.net') ## expect_equal(network.size(A96),1096) ## expect_equal(list.vertex.attributes(A96),c("bw","fos","na","shape","vertex.names", "x","x_fact","y","y_fact")) # note no z attribute ## expect_equal(head(A96%v%'shape'),c("box","ellipse", "ellipse", "ellipse", "ellipse", "ellipse")) ## # check edge attribute parsing ## expect_equal(list.edge.attributes(A96),c("A96", "fos", "l" , "lr", "na", "s", "w" )) ## # l is the only one with unique values ## expect_equal(head(A96%e%'l'),c("a", "s","n","r","s","t")) ## }) # end of non-cran tests # temporal versions http://vlado.fmf.uni-lj.si/pub/networks/data/KEDS/KEDS.htm # temporal events data (not supported) # http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Time.tim # http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Friends.tim network/tests/testthat/test-as.edgelist.R0000644000176200001440000001155014317402074020253 0ustar liggesuserstest<-network.initialize(5) add.edges(test,5,1) add.edges(test,1,5) set.edge.attribute(test,'value',c('a','b')) set.edge.attribute(test,'weight',10:11) expect_equal( as.matrix.network.edgelist(test), structure(c(5L, 1L, 1L, 5L), .Dim = c(2L, 2L), n = 5, vnames = 1:5) ) # sort order should be different if(Sys.getenv("_R_CLASS_MATRIX_ARRAY_") == "" & getRversion() < "4.0.0"){ expect_equal( as.edgelist(test), structure(c(1L, 5L, 5L, 1L), .Dim = c(2L, 2L), n = 5, vnames = 1:5, directed = TRUE, bipartite = FALSE, loops = FALSE, class = c("matrix_edgelist", "edgelist","matrix")) ) }else{ expect_equal( as.edgelist(test), structure(c(1L, 5L, 5L, 1L), .Dim = c(2L, 2L), n = 5, vnames = 1:5, directed = TRUE, bipartite = FALSE, loops = FALSE, class = c("matrix_edgelist", "edgelist","matrix","array")) ) } expect_true(is.edgelist(as.edgelist(test))) # numeric attribute expect_equal(as.matrix.network.edgelist(test,attrname='weight'),structure(c(5L, 1L, 1L, 5L, 10L, 11L), .Dim = 2:3, n = 5, vnames = 1:5)) # character attribute NOTE makes the matrix character as well expect_equal(as.matrix.network.edgelist(test,attrname='value'),structure(c('5', '1', '1', '5', 'a', 'b'), .Dim = 2:3, n = 5, vnames = 1:5)) # character attribute with tibble output: does not make matrix character expect_equal(as.edgelist(test,attrname='value', output="tibble"), structure(list(.tail = c(1L, 5L), .head = c(5L, 1L), value = c("b", "a")), row.names = c(NA, -2L), class = c("tibble_edgelist", "edgelist", "tbl_df", "tbl", "data.frame"), n = 5, vnames = 1:5, directed = TRUE, bipartite = FALSE, loops = FALSE) ) undir<-network.initialize(5,directed=FALSE) add.edges(undir,5,1) # direction will be swapped to tail < head expect_equal(as.edgelist(undir)[,], c(1,5)) # empty network as.edgelist(network.initialize(0)) # deleted edges deledge<-network.initialize(5) add.edges(deledge,1:3,2:4) delete.edges(deledge,2) if(Sys.getenv("_R_CLASS_MATRIX_ARRAY_")=="" & getRversion() < "4.0.0"){ expect_equal( as.edgelist(deledge), structure(c(1L, 3L, 2L, 4L), .Dim = c(2L, 2L), n = 5, vnames = 1:5, directed = TRUE, bipartite = FALSE, loops = FALSE, class = c("matrix_edgelist", "edgelist", "matrix")) ) }else{ expect_equal( as.edgelist(deledge), structure(c(1L, 3L, 2L, 4L), .Dim = c(2L, 2L), n = 5, vnames = 1:5, directed = TRUE, bipartite = FALSE, loops = FALSE, class = c("matrix_edgelist", "edgelist", "matrix", "array")) ) } nw <- network.initialize(10L, directed = FALSE) nw[1L,5L] <- 1L nw[1L,10L] <- 1L nw %e% "attr" <- c("a","b") expect_identical(as.edgelist(nw), structure(matrix(c(1L,1L,5L,10L), nrow = 2L), n = 10L, vnames = seq_len(10L), directed = FALSE, bipartite = FALSE, loops = FALSE, class = c("matrix_edgelist", "edgelist", "matrix", "array"))) expect_identical(as.edgelist(nw, attrname = "attr"), structure(matrix(c("1","1","5","10","a","b"), nrow = 2L), n = 10L, vnames = seq_len(10L), directed = FALSE, bipartite = FALSE, loops = FALSE, class = c("matrix_edgelist", "edgelist", "matrix", "array"))) nw %n% "bipartite" <- 4L expect_identical(as.edgelist(nw), structure(matrix(c(1L,1L,5L,10L), nrow = 2L), n = 10L, vnames = seq_len(10L), directed = FALSE, bipartite = 4L, loops = FALSE, class = c("matrix_edgelist", "edgelist", "matrix", "array"))) expect_identical(as.edgelist(nw, attrname = "attr"), structure(matrix(c("1","1","5","10","a","b"), nrow = 2L), n = 10L, vnames = seq_len(10L), directed = FALSE, bipartite = 4L, loops = FALSE, class = c("matrix_edgelist", "edgelist", "matrix", "array"))) network/tests/testthat/test-misc_tests.R0000644000176200001440000000050113740520334020217 0ustar liggesusers# tests for misc R functions test<-network.initialize(5) test[1,2]<-1 expect_equal(has.edges(test), c(TRUE,TRUE,FALSE,FALSE,FALSE)) expect_equal(has.edges(test,v=2:3),c(TRUE,FALSE)) expect_error(has.edges(test,v=10),regexp = 'argument must be a valid vertex id') expect_equal(length(has.edges(network.initialize(0))),0) network/tests/testthat/test-mixingmatrix.R0000644000176200001440000001404014057014734020571 0ustar liggesusers# Directed networks ------------------------------------------------------- test_that("mixingmatrix() just works on a directed network", { net <- network.initialize(4, directed=TRUE) net[1,2] <- net[3,4] <- 1 net %v% "a" <- c(1,1,2,2) mm <- mixingmatrix(net, "a") expect_type(mm, "integer") expect_s3_class(mm, c("mixingmatrix", "table"), exact=TRUE) expect_true(is.directed(mm)) expect_false(is.bipartite(mm)) }) test_that("mixingmatrix() works on emon$Texas (directed)", { data(emon, package="network") a <- get.vertex.attribute(emon$Texas, "Location") el <- as.matrix(emon$Texas, matrix.type="edgelist") emm <- table(From=a[el[,1]], To=a[el[,2]]) expect_equivalent( as.integer(mixingmatrix(emon$Texas, "Location")), as.integer(emm) ) }) test_that("NA rows & cols are present for emon$MtSi unless useNA='no'", { mm.no <- mixingmatrix(emon$MtSi, "Formalization", useNA="no") expect_type(mm.no, "integer") expect_identical(dim(mm.no), c(2L,2L)) mm.default <- mixingmatrix(emon$MtSi, "Formalization") mm.ifany <- mixingmatrix(emon$MtSi, "Formalization", useNA="ifany") mm.always <- mixingmatrix(emon$MtSi, "Formalization", useNA="always") expect_identical(mm.ifany, mm.default) expect_identical(mm.ifany, mm.always) expect_identical(dim(mm.ifany), c(3L, 3L)) expect_identical( mm.default, structure( c(19L, 4L, 1L, 4L, 0L, 0L, 4L, 1L, 0L), .Dim = c(3L, 3L), .Dimnames = list(From = c("1", "2", NA), To = c("1", "2", NA)), class = c("mixingmatrix", "table"), directed = TRUE, bipartite = FALSE ) ) } ) test_that("mixingmatrix(directed with categories without incident ties)", { net <- network.initialize(4, directed = TRUE) net %v% "a" <- c(1,1,2,3) net[1,2] <- net[1,3] <- 1 # no ties incident on a=3 mm <- mixingmatrix(net, "a") expect_type(mm, "integer") expect_equivalent( mm, structure( matrix(as.integer(c(1,0,0, 1,0,0, 0,0,0)), 3, 3), dimnames = list(From=1:3, To=1:3), class = c("mixingmatrix", "table") ) ) }) test_that("mixingmatrx() warns on exclude=NULL", { net <- network.initialize(4, directed=TRUE) net[1,2] <- net[3,4] <- 1 net %v% "a" <- c(1,1,2,2) expect_warning( r <- mixingmatrix(net, "a", exclude=NULL), regexp = "passing `exclude=NULL`" ) expect_identical(r, mixingmatrix(net, "a")) }) # Undirected networks ----------------------------------------------------- test_that("mixingmatrix() just works on a undirected network", { net <- network.initialize(4, directed=FALSE) net[1,2] <- net[1,3] <- 1 net %v% "a" <- c(1,1, 2,2) mm <- mixingmatrix(net, "a") expect_type(mm, "integer") expect_equivalent( mm, structure( matrix(as.integer(c(1,1,1,0)), 2, 2), dimnames = list(From = 1:2, To = 1:2), class = c("mixingmatrix", "table") ) ) expect_false(is.directed(mm)) expect_false(is.bipartite(mm)) }) test_that("NA rows & cols are shown for undirected net unless useNA='no'", { net <- network.initialize(2, directed=FALSE) net %v% "a" <- c(1, NA) net[1,2] <- 1 mm.default <- mixingmatrix(net, "a") mm.ifany <- mixingmatrix(net, "a", useNA="ifany") mm.always <- mixingmatrix(net, "a", useNA="always") expect_identical(mm.default, mm.ifany) expect_identical(mm.default, mm.always) expect_identical( mm.default, structure( c(0L, 1L, 1L, 0L), .Dim = c(2L, 2L), class = c("mixingmatrix", "table"), .Dimnames = list(From = c("1", NA), To = c("1", NA)), directed = FALSE, bipartite = FALSE ) ) mm.no <- mixingmatrix(net, "a", useNA="no") expect_type(mm.no, "integer") expect_identical(dim(mm.no), c(1L, 1L)) }) # Bipartite networks ------------------------------------------------------ am <- matrix(0, 5, 5) am[1,3] <- am[1,4] <- am[2,3] <- am[2,5] <- 1 net <- as.network(am, directed=FALSE, bipartite=2) net %v% "mode" <- c(1,1,2,2,2) net %v% "a" <- c(1,2,3,4,4) net %v% "withNA" <- c(1,2,NA, 4,NA) set.vertex.attribute(net, "p1", value = c(20, 30), v = 1:2) set.vertex.attribute(net, "p2", value = c(0.1, 0.2, 0.1), v = 3:5) # plot(net, vertex.col="mode", displaylabels=TRUE) test_that("mixingmatrix for bipartite net with expand.bipartite=FALSE is correct", { # On `mode` so all ties between groups expect_silent( mm <- mixingmatrix(net, "mode", expand.bipartite = FALSE) ) expect_type(mm, "integer") expect_false(is.directed(mm)) expect_true(is.bipartite(mm)) expect_equivalent( mm, structure( matrix(4L, 1, 1), dimnames = list(From = 1, To = 2), class = "mixingmatrix" ) ) # On `a` expect_silent( mm <- mixingmatrix(net, "a", expand.bipartite = FALSE) ) expect_type(mm, "integer") expect_false(is.directed(mm)) expect_true(is.bipartite(mm)) expect_equivalent( mm, structure( matrix(as.integer(c(1,1, 1,1)), 2, 2), dimnames = list(From = 1:2, To=3:4), class = "mixingmatrix" ) ) }) test_that("mixingmatrix for bipartite net with expand.bipartite=TRUE is correct", { # On `mode` expect_silent( mm <- mixingmatrix(net, "mode", expand.bipartite = TRUE) ) expect_type(mm, "integer") expect_equivalent( mm, structure( matrix(as.integer(c(0,0, 4,0)), 2, 2), dimnames = list(From = 1:2, To=1:2), class = "mixingmatrix" ) ) # On `a` expect_silent( mm <- mixingmatrix(net, "a", expand.bipartite = TRUE) ) expect_identical(dim(mm), c(4L, 4L)) expect_identical( as.integer(mm), as.integer(c(0,0,0,0, 0,0,0,0, 1,1,0,0, 1,1,0,0)) ) }) test_that("NA rows & cols are shown for bipartite net unless useNA='no'", { expect_silent( mm.default <- mixingmatrix(net, "withNA") ) expect_silent( mm.no <- mixingmatrix(net, "withNA", useNA="no") ) expect_silent( mm.always <- mixingmatrix(net, "withNA", useNA="always") ) expect_identical(mm.default, mm.always) expect_identical( as.integer(mm.default), as.integer(c(1,0,0, 1,2,0)) ) expect_identical(dim(mm.no), c(2L, 1L)) expect_identical( as.integer(mm.no), as.integer(c(1, 0)) ) }) network/tests/testthat/test-networks.R0000644000176200001440000000566614317402074017740 0ustar liggesusers# ----- checks for network edgecount ------ test<-network.initialize(4) # directed expect_equal(network.dyadcount(test),12) # undirected test%n%'directed'<-FALSE expect_equal(network.dyadcount(test),6) # loops allowed test%n%'loops'<-TRUE #undirected expect_equal(network.dyadcount(test),10) # directed test%n%'directed'<-TRUE expect_equal(network.dyadcount(test),16) # directed bipartite test%n%'loops'<-FALSE test%n%'bipartite'<-1 expect_equal(network.dyadcount(test),6) # undirected bipartite test%n%'directed'<-FALSE expect_equal(network.dyadcount(test),3) # NA values test[1,2]<-NA expect_equal(network.dyadcount(test,na.omit = TRUE),2) # ----- checks for dyads eids ----- data(emon) el<-as.matrix.network.edgelist(emon[[1]]) expect_equal(get.dyads.eids(emon[[1]],el[,1],el[,2]),as.list(1:83)) expect_equal(get.dyads.eids(emon[[1]],el[5:10,1],el[5:10,2]),as.list(5:10)) expect_error(get.dyads.eids(emon[[1]],1,2:3),regexp = 'heads and tails vectors must be the same length') expect_error(get.dyads.eids(network.initialize(0),1,2),regexp = 'invalid vertex id in heads or tails vector') mult<-network.initialize(5,multiple=TRUE) add.edges(mult,1,2) add.edges(mult,1,2) expect_warning(expect_true(is.na(get.dyads.eids(mult,1,2)[[1]])),regexp = 'multiple edge ids for dyad') expect_equal(get.dyads.eids(network.initialize(0),numeric(0),numeric(0)), list()) expect_equal(get.dyads.eids(network.initialize(5),tails=1:2,heads=3:4),list(numeric(0),numeric(0))) # check oposite matching for undirected nets undir<-network.initialize(3,directed=FALSE) undir[1,2]<-1 expect_equal(get.dyads.eids(undir,2,1),list(1)) expect_equal(get.dyads.eids(undir,1,2),list(1)) undir%n%'directed'<-TRUE expect_equal(get.dyads.eids(undir,2,1),list(integer(0))) expect_equal(get.dyads.eids(undir,1,2),list(1)) expect_equal(get.dyads.eids(undir,2,1,neighborhood='in'),list(1)) expect_equal(get.dyads.eids(undir,1,2,neighborhood='in'),list(integer(0))) nw <- network.initialize(10, directed = FALSE) el <- matrix(c(1,2,3,5,2,9,9,10,6,7),ncol=2,byrow=TRUE) nw[el]<-1 expect_identical(get.dyads.eids(nw, el[,1], el[,2], na.omit = FALSE), as.list(seq_len(NROW(el)))) expect_identical(get.dyads.eids(nw, el[,1], el[,2], na.omit = TRUE), as.list(seq_len(NROW(el)))) nw[el[2,1],el[2,2]] <- NA nw[el[5,1],el[5,2]] <- NA expect_identical(get.dyads.eids(nw, el[,1], el[,2], na.omit = FALSE), as.list(seq_len(NROW(el)))) expect_identical(get.dyads.eids(nw, el[,1], el[,2], na.omit = TRUE), list(1L, integer(0), 3L, 4L, integer(0))) delete.edges(nw, 2) expect_identical(get.dyads.eids(nw, el[,1], el[,2], na.omit = FALSE), list(1L, integer(0), 3L, 4L, 5L)) expect_identical(get.dyads.eids(nw, el[,1], el[,2], na.omit = TRUE), list(1L, integer(0), 3L, 4L, integer(0))) delete.edges(nw, 3) expect_identical(get.dyads.eids(nw, el[,1], el[,2], na.omit = FALSE), list(1L, integer(0), integer(0), 4L, 5L)) expect_identical(get.dyads.eids(nw, el[,1], el[,2], na.omit = TRUE), list(1L, integer(0), integer(0), 4L, integer(0))) network/tests/testthat.R0000644000176200001440000000007213737227152015100 0ustar liggesuserslibrary(testthat) library(network) test_check("network") network/tests/speedTests.R0000644000176200001440000000424314363704204015361 0ustar liggesusers#Set to TRUE to run tests if(FALSE){ # some really basic speed checks to help us know if we make changes that massively degrade performance require(network) init<-system.time(net<-network.initialize(100000))[3] setv<-system.time(set.vertex.attribute(net,"foo","bar"))[3] getv<-system.time(get.vertex.attribute(net,"foo"))[3] listv<-system.time(list.vertex.attributes(net))[3] adde<-system.time(add.edges(net,tail=1:99999,head=2:100000))[3] sete<-system.time(set.edge.attribute(net,"foo","bar"))[3] gete<-system.time(get.edge.attribute(net,"foo"))[3] liste<-system.time(list.edge.attributes(net))[3] addmoree<-system.time(add.edge(net,100000,1))[3] addmorev<-system.time(add.vertices(net,1))[3] # optionally compare to benchmarks saved in test folder to see if things have changed # benchmarks<-rbind(init,setv,getv,listv,adde,sete,gete,liste,addmoree,addmorev) # oldmarks<-read.table(file.choose(),header=TRUE,colClasses=c('character','numeric')) # all.equal(oldmarks[,1],benchmarks[,1],check.attributes=FALSE) # optionally save out benchmarks to test directory # write.table(benchmarks,file=file.choose()) # some absolute thresholds if(init>5){ stop("initializing network for large number of vertices took much longer than expected") } if(setv>5){ stop("set.vertex.attribute for large number of vertices took much longer than expected") } if(getv>5){ stop("get.vertex.attribute for large number of vertices took much longer than expected") } if(listv>1){ stop("list.vertex.attributes for large number of vertices took much longer than expected") } if(adde>5){ stop("add.edges for a large number of edges took much longer than expected") } if(sete>10){ stop("set.edge.attribute for a large number of edges took much longer than expected") } if(gete>1){ stop("get.edge.attribute for a large number of edges took much longer than expected") } if(liste>1){ stop("list.edge.attribute for a large number of edges took much longer than expected") } if(addmoree>5){ stop("add.edge for a network with a large number of edges took much longer than expected") } if(addmorev>5){ stop("add.vertices for a network with large number of vertices took longer than expected") } #End tests } network/tests/network.access.test.R0000644000176200001440000000555314363704162017155 0ustar liggesusers#Set to TRUE to run tests if(FALSE){ library(network) binet = network.initialize(10, bipartite = 6) set.vertex.attribute(binet, 'myval', paste('b1', 1:6), v=1:6) set.vertex.attribute(binet, 'myval', paste('b2', 1:4), v=7:10) check <- vector() check[1] <- all(get.vertex.attribute(binet, 'myval') == c("b1 1", "b1 2", "b1 3", "b1 4", "b1 5", "b1 6", "b2 1", "b2 2", "b2 3" ,"b2 4")) # check for distinction between bipartite=FALSE and bipartite=0 testA<-network.initialize(3,bipartite=0) if(!is.bipartite(testA)){ stop('failed test of is.bipartite for bipartite=0') } testB<-network.initialize(3,bipartite=FALSE) if(is.bipartite(testB)){ stop('failed test of is.bipartite for bipartite=FALSE') } testC<-network.initialize(3,bipartite=TRUE) if(!is.bipartite(testC)){ stop('failed test of is.bipartite for bipartite=TRUE') } if(!is.bipartite(binet)){ stop('failed test of is.bipartite for bipartite=6') } # add vertices to bipartite graphs g = binet; add.vertices(g, 5, last.mode=F) check[2] <- network.size(g) == 15 check[3] <- get.network.attribute(g, 'bipartite') == 11 check[4] <- identical(get.vertex.attribute(g, 'myval'), c("b1 1", "b1 2", "b1 3", "b1 4", "b1 5", "b1 6", NA,NA,NA,NA,NA,"b2 1","b2 2","b2 3","b2 4")) test<-network.initialize(3,bipartite=0) test%v%'letters'<-LETTERS[1:3] add.vertices(test,nv=1,last.mode=FALSE) if(!identical(test%v%'letters',c(NA,"A","B","C"))){ stop("Error adding vertices to first mode of network with biparite=0") } test<-network.initialize(3,bipartite=0) test%v%'letters'<-LETTERS[1:3] add.vertices(test,nv=1,last.mode=TRUE) if(!identical(test%v%'letters',c("A","B","C",NA))){ stop("Error adding vertices to last mode of network with biparite=0") } g = binet add.vertices(g, 5, last.mode=T) check[5] <- network.size(g) == 15 check[6] <- get.network.attribute(g, 'bipartite') == 6 check[7] <- identical(get.vertex.attribute(g, 'myval'), c("b1 1", "b1 2", "b1 3", "b1 4", "b1 5", "b1 6","b2 1","b2 2","b2 3","b2 4", NA,NA,NA,NA,NA)) # replacement operators should always replace y <- network.initialize(4,dir=FALSE) # This network can have at most 1 edge. y[1,2] <- NA # Assign NA to (1,2) y[1,2] <- NA check[8] <- network.edgecount(y) == 0 check[9] <- network.edgecount(y, na.omit=F) == 1 y[,] <- 1 check[10] <- network.edgecount(y) == 6 y[,] <- NA check[11] <- network.edgecount(y) == 0 check[12] <- network.edgecount(y, na.omit=F) == 6 y[,] <- 0 check[13] <- network.edgecount(y, na.omit=F) == 0 # ------ test valid.eids function net<-network.initialize(4) net[,]<-1 delete.edges(net,eid=4:6) if(!all(valid.eids(net)==c(1,2,3,7,8,9,10,11,12))){ stop('valid.eids did not return correct ids for non-null elements of network') } #If everything worked, check is TRUE if(!all(check)){ #Should be TRUE stop(paste("network package test failed on test(s):",which(!check))) } #End tests } network/tests/vignette.R0000644000176200001440000001045013357022000015045 0ustar liggesusersrequire("network") set.seed(1702) results = NULL data("flo") data("emon") net <- network.initialize(5) net nmat <- matrix(rbinom(25, 1, 0.5), nr = 5, nc = 5) net <- network(nmat, loops = TRUE) net summary(net) results[1] = all(nmat == net[,]) net <- as.network(nmat, loops = TRUE) results[2] = all(nmat == net[,]) nflo <- network(flo, directed = FALSE) nflo results[3] = all(nflo[9,] == c(1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1)) results[4] = nflo[9,1] == 1 results[5] = nflo[9,4] == 0 results[6] = is.adjacent(nflo, 9, 1) == TRUE results[7] = is.adjacent(nflo, 9, 4) == FALSE results[8] = network.size(nflo) == 16 results[9] = network.edgecount(nflo) == 20 results[10] = network.density(nflo) == 1/6 results[11] = has.loops(nflo) == FALSE results[12] = is.bipartite(nflo) == FALSE results[13] = is.directed(nflo) == FALSE results[14] = is.hyper(nflo) == FALSE results[15] = is.multiplex(nflo) == FALSE as.sociomatrix(nflo) results[16] = all(nflo[,] == as.sociomatrix(nflo)) results[17] = all(as.matrix(nflo) == as.sociomatrix(nflo)) as.matrix(nflo,matrix.type = "edgelist") net <- network.initialize(5, loops = TRUE) net[nmat>0] <- 1 results[18] = all(nmat == net[,]) net[,] <- 0 net[,] <- nmat results[19] = all(nmat == net[,]) net[,] <- 0 for(i in 1:5) for(j in 1:5) if(nmat[i,j]) net[i,j] <- 1 results[20] = all(nmat == net[,]) net[,] <- 0 add.edges(net, row(nmat)[nmat>0], col(nmat)[nmat>0]) results[21] = all(nmat == net[,]) net[,] <- as.numeric(nmat[,]) results[22] = all(nmat == net[,]) net <- network.initialize(5) add.edge(net, 2, 3) net[,] results[23] = net[2,3] == 1 add.edges(net, c(3, 5), c(4, 4)) net[,] results[24] = (net[3,4] == 1 && net[5,4] == 1) net[,2] <- 1 net[,] results[25] = net[2,2] == 0 delete.vertices(net, 4) results[26] = all(net[,] == matrix(c(0,1,0,0,0,0,1,0,0,1,0,0,0,1,0,0), byrow=T, nrow=4)) add.vertices(net, 2) net[,] get.edges(net, 1) get.edges(net, 2, neighborhood = "in") get.edges(net, 1, alter = 2) results[27] = get.edgeIDs(net, 1) == 4 results[28] = all(get.edgeIDs(net, 2, neighborhood = "in") == c(7, 5, 4)) results[29] = get.edgeIDs(net, 1, alter = 2) == 4 results[30] = get.neighborhood(net, 1) == 2 results[31] = all(get.neighborhood(net, 2, type = "in") == c(4, 3, 1)) net[2,3] <- 0 results[32] = net[2,3] == 0 delete.edges(net, get.edgeIDs(net, 2, neighborhood = "in")) results[33] = all(net[,] == matrix(0, 6,6)) net <- network.initialize(5) set.network.attribute(net, "boo", 1:10) net %n% "hoo" <- letters[1:7] results[34] = 'boo' %in% list.network.attributes(net) results[35] = 'hoo' %in% list.network.attributes(net) results[36] = all(get.network.attribute(net, "boo") == c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)) results[37] = all(net %n% "hoo" == c("a", "b", "c", "d", "e", "f", "g")) delete.network.attribute(net, "boo") results[38] = 'boo' %in% list.network.attributes(net) == FALSE set.vertex.attribute(net, "boo", 1:5) net %v% "hoo" <- letters[1:5] results[39] = 'boo' %in% list.vertex.attributes(net) results[40] = 'hoo' %in% list.vertex.attributes(net) results[41] = all(get.vertex.attribute(net, "boo") == 1:5) results[42] = all(net %v% "hoo" == letters[1:5]) delete.vertex.attribute(net, "boo") results[43] = 'boo' %in% list.vertex.attributes(net) == FALSE net <- network(nmat) set.edge.attribute(net, "boo", sum(nmat):1) set.edge.value(net, "hoo", matrix(1:25, 5, 5)) net %e% "woo" <- matrix(rnorm(25), 5, 5) net[,, names.eval = "zoo"] <- nmat * 6 results[44] = 'boo' %in% list.edge.attributes(net) results[45] = 'hoo' %in% list.edge.attributes(net) results[46] = all(get.edge.attribute(get.edges(net, 1), "boo") == c(3,7)) results[47] = all(get.edge.value(net, "hoo") == c(2, 3, 11, 14, 17, 18, 21)) net %e% "woo" as.sociomatrix(net, "zoo") delete.edge.attribute(net, "boo") results[48] = 'boo' %in% list.edge.attributes(net) == FALSE MtSHloc <- emon$MtStHelens %v% "Location" MtSHimat <- cbind(MtSHloc %in% c("L", "B"), MtSHloc %in% c("NL", "B")) MtSHbyloc <- network(MtSHimat, matrix = "incidence", hyper = TRUE, directed = FALSE, loops = TRUE) MtSHbyloc %v% "vertex.names" <- emon$MtStHelens %v% "vertex.names" MtSHbyloc plot(nflo, displaylabels = TRUE, boxed.labels = FALSE) plot(nflo, displaylabels = TRUE, mode = "circle") plot(emon$MtSi) if (!all(results)) { stop(paste('The following tests in vignette.R failed:', which(results==FALSE))) } network/MD50000644000176200001440000001316514725552272012274 0ustar liggesusers9b699d8131bbe4e391b88e47beef1f74 *COPYING 7ee6d13e044da36fca54c2667e7ba68e *ChangeLog c8e1da4dfc7e7a33ee760f81062877b7 *DESCRIPTION 42874c30088916fe52b52bde58004616 *NAMESPACE c35534074c68d3e8532eff68bac3fbb8 *R/access.R ab7d8f7ebc9e05f36453547778f15bf5 *R/as.edgelist.R 1589770cd6defbc3704ee0d2f9b1cfe4 *R/assignment.R 49f964e7fa56f199ec5613a346582748 *R/coercion.R 5dd6d1de5eb0aed5ad74aee242fcf343 *R/constructors.R 6cf83e2a1248ff367885588a3dd30ad0 *R/dataframe.R bb6c33aa4d09e59807e7e086444fc2a2 *R/fileio.R 1eed18aeadf7aba09cf6ccee6b91c74b *R/layout.R 988141d57785384812c92452357549eb *R/misc.R 2dd2a513cd133a048885abcb71711c95 *R/network-package.R f0a9dafcc8594f8b12cae79b46231dbf *R/operators.R a8bf80a257042a755961ba7691316a55 *R/plot.R c32f1c0c9fcaa343a872dd12ee309c8c *R/printsum.R 263822ebe70c081f9b90a05790829538 *R/zzz.R d30fb62438e3e6c40920c2d12cebb683 *build/partial.rdb 2bce853f8f2923f9e2b005959d2bdba4 *build/vignette.rds 4e1fd0dcead8991dc32c05e2d7301c40 *data/emon.RData bb3e0d4d549b892aa8701af630adb78a *data/flo.RData 32bcc50a43d7a2258b65404072039bbd *inst/CITATION 3e06997d5f02a81dfdccf3d00ff43d0f *inst/doc/networkVignette.R e426433ac42ea149a73be4923359cf0d *inst/doc/networkVignette.Rnw 1ba1e108053322695a598c35f4d7fc51 *inst/doc/networkVignette.pdf 2fce00a65f9969063ffe26e50ccbd87c *inst/include/netregistration.h 4b9aa09dd1d9f3ff6e9cd5236188d653 *inst/include/network.h c78b6af71f6256929251472b1d75fbe1 *inst/network.api/networkapi.c 1c85daf92af86106d5fb3e0797eda213 *inst/network.api/networkapi.h 46a54d46bce4e3a330ec6891fb65fe4e *man/add.edges.Rd a9c706fec81a7986064c9eadecb36766 *man/add.vertices.Rd 050041ed9630847918d1f5aef7bb559a *man/as.color.Rd c60986b288e28d7992293d62c363c936 *man/as.data.frame.network.Rd b8b8958545e188d91a0557955097fa38 *man/as.edgelist.Rd d3d729d0346adf0132e581d5f7a14783 *man/as.matrix.network.Rd 50405c74fa075fe651209f00d4ab1c33 *man/as.network.matrix.Rd 59bc37e0c19b9f826a0433804d63e26a *man/as.sociomatrix.Rd 6c497d2ad362ffd4e91f582ca384b7f5 *man/attribute.methods.Rd 41ff8acb100b8f4f545b9f92937c1e04 *man/deletion.methods.Rd f2aa48b10ad6172c2df9549551a25cce *man/edgeset.constructors.Rd 49bf9f0e4d8ab192a342caa561136a80 *man/emon.Rd ceec9dfc3b6392adf7a859e7fae9bdec *man/flo.Rd 1f89ec3a0d6a8832f7cca034512abf70 *man/get.edges.Rd d3c06b6dc056630f833877378d3c71b4 *man/get.inducedSubgraph.Rd 8bc3e34cdcf75858c83fde19e21c8f52 *man/get.neighborhood.Rd 531bf734d867ce44efcf534a16416d31 *man/has.edges.Rd 6e9ce9c60e54ac57ad5c95a6c50b3869 *man/is.adjacent.Rd d5d0b66c338fb9be202e09a901bcf6d5 *man/loading.attributes.Rd f777f59c54627809aa77690959b60252 *man/mixingmatrix.Rd 10f5aea0ed5403e0703bbdd87dc876ae *man/network-internal.Rd 34b8d7dcd350d858f40d0b7fe0329ef0 *man/network-operators.Rd 4d77d220b874d59945a90d78f9a26afc *man/network-package.Rd 86624c1a0ca4d45d129325f571ece024 *man/network.Rd e58c2e14f66d2707c4e472bad5cc0908 *man/network.arrow.Rd d6a10ac1493144969691c10cfd25106d *man/network.density.Rd b753f4fdcb96c4457997d4526f65f386 *man/network.dyadcount.Rd 582c047604d9ebe9f9ca237cebbd4150 *man/network.edgecount.Rd 436db36c5955e9f78d3aa2a94bc85b39 *man/network.edgelabel.Rd 72968b207881146c28a3655b9172c45a *man/network.extraction.Rd bb29d45ecd04d4aef2bc8ed2c428bce2 *man/network.indicators.Rd e50b00cc5cb5490f34cb1cae2a97658c *man/network.initialize.Rd c0cf0381c4499d4284f5ae5dbdb6fae8 *man/network.layout.Rd eca169ee58fa0c8719bc057641d0d21c *man/network.loop.Rd b1553bbcab4eafcf90a03ecf5f13565a *man/network.naedgecount.Rd 5785845e981b649f14cc5e876eb35a92 *man/network.size.Rd fcfa2816525915c11ae1c70b2ab19e30 *man/network.vertex.Rd 73586605bcd4528bead84bdb7c9a9243 *man/permute.vertexIDs.Rd ddf6e098b0e233fbca298b57b47de713 *man/plot.network.Rd 0a6ddb702f25ad304107148b72b7ddd1 *man/preparePlotArgs.Rd acc67a3bf7f6b5dfed930571a3bdea43 *man/prod.network.Rd 60e96d3792c7beb88145f6ec81c5bc24 *man/read.paj.Rd e0a1a69a99e16a00e9e55abc35fb0634 *man/sum.network.Rd b1dd30b318f7fb788bcd4704bc49f9b4 *man/valid.eids.Rd 824796c13b47e234d6f981e17642f30c *man/which.matrix.type.Rd 1c5cf8036602f903a2699b928fc0ca93 *src/Rinit.c 5b5e94035b4b085f46ea24586924b6bb *src/access.c 96fc95a8ae2941d6e411b38c80cee9af *src/access.h 739756cc9b67f775864fa7f6aa19745e *src/constructors.c 58ac8ab29e39950e95390b86a5de4c83 *src/constructors.h 99ad146ab20fdd5dd38725385c7f2dda *src/layout.c c929fe23f5a09c76c8c11aa83dbb2ed1 *src/layout.h c624cbb55190d144a79c1fea041fab68 *src/utils.c b5ed5be00b1bddd126b1bd7e4937ee3f *src/utils.h 59fde81bf25fff109743e99b70fbdc4f *tests/benchmarks 9f3d1462baf551cdb0e760358e7fbce8 *tests/general.tests.R 7182bab37ffc7577c4508076ca86fa40 *tests/general.tests2.R a7f96e9a09fc13489cb4c5760a5f9f7a *tests/list.attribute.tests.R 5a176c0519643a156eee9e1a31fe3c18 *tests/network.access.test.R fda3f32b65c3ac83b367338be7b190e6 *tests/network.battery.R 36275927d8cc11b77b18c9ca8bcb0e27 *tests/pathological.tests.R 563df50e729d2995ea313959f39a61ab *tests/plotflo.R 790025d02a15dd4d9c8061bf37975f6d *tests/speedTests.R b2c97b33a2d412dc5d5e11f14b3c4e6f *tests/testthat.R c2b0eaea326f8b60cca4011ee0cd5eb6 *tests/testthat/test-as.edgelist.R 5bd10799a112f9a02df4f94ca0d94a7d *tests/testthat/test-dataframe.R 87cfdbb310dad8da648dc6433d58b2a1 *tests/testthat/test-i22-summary-character.R 52da4d470df06df454cbc61ac1842807 *tests/testthat/test-indexing.R 93c5263fc884f28035b4a626f25cadf3 *tests/testthat/test-misc_tests.R 0e4bed5f2503c875e914efb4bb1b702a *tests/testthat/test-mixingmatrix.R c62d074345596fbaaed03aee9c82f220 *tests/testthat/test-networks.R 8514de6d9548451f179969d8e8f29c82 *tests/testthat/test-plot.R 3cc36bdc9454722288b4eca4bf505960 *tests/testthat/test-read.paj.R ada28de34c8d472fc95aa852611895b6 *tests/vignette.R e426433ac42ea149a73be4923359cf0d *vignettes/networkVignette.Rnw network/R/0000755000176200001440000000000014725233503012150 5ustar liggesusersnetwork/R/plot.R0000644000176200001440000017401114723241675013264 0ustar liggesusers###################################################################### # # plot.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 06/06/21 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various routines related to network visualization. # # Contents: # # network.arrow # network.loop # network.vertex # plot.network # plot.network.default # ###################################################################### #Introduce a function to make coordinates for a single polygon make.arrow.poly.coords<-function(x0,y0,x1,y1,ahangle,ahlen,swid,toff,hoff,ahead, curve,csteps){ slen<-sqrt((x0-x1)^2+(y0-y1)^2) #Find the total length if(curve==0){ #Straight edges if(ahead){ coord<-rbind( #Produce a "generic" version w/head c(-swid/2,toff), c(-swid/2,slen-0.5*ahlen-hoff), c(-ahlen*sin(ahangle),slen-ahlen*cos(ahangle)-hoff), c(0,slen-hoff), c(ahlen*sin(ahangle),slen-ahlen*cos(ahangle)-hoff), c(swid/2,slen-0.5*ahlen-hoff), c(swid/2,toff), c(NA,NA) ) }else{ coord<-rbind( #Produce a "generic" version w/out head c(-swid/2,toff), c(-swid/2,slen-hoff), c(swid/2,slen-hoff), c(swid/2,toff), c(NA,NA) ) } }else{ #Curved edges if(ahead){ inc<-(0:csteps)/csteps coord<-rbind( cbind(-curve*(1-(2*(inc-0.5))^2)-swid/2-sqrt(2)/2*(toff+inc*(hoff-toff)), inc*(slen-sqrt(2)/2*(hoff+toff)-ahlen*0.5)+sqrt(2)/2*toff), c(ahlen*sin(-ahangle-pi/16)-sqrt(2)/2*hoff, slen-ahlen*cos(-ahangle-pi/16)-sqrt(2)/2*hoff), c(-sqrt(2)/2*hoff,slen-sqrt(2)/2*hoff), c(ahlen*sin(ahangle-pi/16)-sqrt(2)/2*hoff, slen-ahlen*cos(ahangle-pi/16)-sqrt(2)/2*hoff), cbind(-curve*(1-(2*(rev(inc)-0.5))^2)+swid/2-sqrt(2)/2*(toff+rev(inc)*(hoff-toff)), rev(inc)*(slen-sqrt(2)/2*(hoff+toff)-ahlen*0.5)+sqrt(2)/2*toff), c(NA,NA) ) }else{ inc<-(0:csteps)/csteps coord<-rbind( cbind(-curve*(1-(2*(inc-0.5))^2)-swid/2-sqrt(2)/2*(toff+inc*(hoff-toff)), inc*(slen-sqrt(2)/2*(hoff+toff))+sqrt(2)/2*toff), cbind(-curve*(1-(2*(rev(inc)-0.5))^2)+swid/2-sqrt(2)/2*(toff+rev(inc)*(hoff-toff)), rev(inc)*(slen-sqrt(2)/2*(hoff+toff))+sqrt(2)/2*toff), c(NA,NA) ) } } theta<-atan2(y1-y0,x1-x0)-pi/2 #Rotate about origin rmat<-rbind(c(cos(theta),sin(theta)),c(-sin(theta),cos(theta))) coord<-coord%*%rmat coord[,1]<-coord[,1]+x0 #Translate to (x0,y0) coord[,2]<-coord[,2]+y0 coord } #Custom arrow-drawing method for plot.network #' Add Arrows or Segments to a Plot #' #' \code{network.arrow} draws a segment or arrow between two pairs of points; #' unlike \code{\link{arrows}} or \code{\link{segments}}, the new plot element #' is drawn as a polygon. #' #' \code{network.arrow} provides a useful extension of \code{\link{segments}} #' and \code{\link{arrows}} when fine control is needed over the resulting #' display. (The results also look better.) Note that edge curvature is #' quadratic, with \code{curve} providing the maximum horizontal deviation of #' the edge (left-handed). Head/tail offsets are used to adjust the end/start #' points of an edge, relative to the baseline coordinates; these are useful #' for functions like \code{\link{plot.network}}, which need to draw edges #' incident to vertices of varying radii. #' #' @param x0 A vector of x coordinates for points of origin #' @param y0 A vector of y coordinates for points of origin #' @param x1 A vector of x coordinates for destination points #' @param y1 A vector of y coordinates for destination points #' @param length Arrowhead length, in current plotting units #' @param angle Arrowhead angle (in degrees) #' @param width Width for arrow body, in current plotting units (can be a #' vector) #' @param col Arrow body color (can be a vector) #' @param border Arrow border color (can be a vector) #' @param lty Arrow border line type (can be a vector) #' @param offset.head Offset for destination point (can be a vector) #' @param offset.tail Offset for origin point (can be a vector) #' @param arrowhead Boolean; should arrowheads be used? (Can be a vector)) #' @param curve Degree of edge curvature (if any), in current plotting units #' (can be a vector) #' @param edge.steps For curved edges, the number of steps to use in #' approximating the curve (can be a vector) #' @param \dots Additional arguments to \code{\link{polygon}} #' @return None. #' @note \code{network.arrow} is a direct adaptation of #' \code{\link[sna]{gplot.arrow}} from the \code{sna} package. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{plot.network}}, \code{\link{network.loop}}, #' \code{\link{polygon}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords aplot graphs #' @examples #' #' #Plot two points #' plot(1:2,1:2) #' #' #Add an edge #' network.arrow(1,1,2,2,width=0.01,col="red",border="black") #' #' @export network.arrow network.arrow<-function(x0,y0,x1,y1,length=0.1,angle=20,width=0.01,col=1,border=1,lty=1,offset.head=0,offset.tail=0,arrowhead=TRUE,curve=0,edge.steps=50,...){ if(length(x0)==0) #Leave if there's nothing to do return() #"Stretch" the arguments n<-length(x0) angle<-rep(angle,length.out=n)/360*2*pi length<-rep(length,length.out=n) width<-rep(width,length.out=n) col<-rep(col,length.out=n) border<-rep(border,length.out=n) lty<-rep(lty,length.out=n) arrowhead<-rep(arrowhead,length.out=n) offset.head<-rep(offset.head,length.out=n) offset.tail<-rep(offset.tail,length.out=n) curve<-rep(curve,length.out=n) edge.steps<-rep(edge.steps,length.out=n) #Obtain coordinates coord<-vector() for(i in 1:n) coord<-rbind(coord,make.arrow.poly.coords(x0[i],y0[i],x1[i],y1[i],angle[i],length[i], width[i],offset.tail[i],offset.head[i],arrowhead[i],curve[i],edge.steps[i])) coord<-coord[-NROW(coord),] #Draw polygons. # the coord matrix has some NA rows, which will break it into multiple polygons polygon(coord,col=col,border=border,lty=lty,...) } #Introduce a function to make coordinates for a single polygon make.loop.poly.coords<-function(x0,y0,xctr,yctr,ahangle,ahlen,swid,off,rad,ahead,edge.steps){ #Determine the center of the plot xoff <- x0-xctr yoff <- y0-yctr roff <- sqrt(xoff^2+yoff^2) x0hat <- xoff/roff y0hat <- yoff/roff r0.vertex <- off r0.loop <- rad x0.loop <- x0hat*r0.loop y0.loop <- y0hat*r0.loop ang <- (((0:edge.steps)/edge.steps)*(1-(2*r0.vertex+0.5*ahlen*ahead)/ (2*pi*r0.loop))+r0.vertex/(2*pi*r0.loop))*2*pi+atan2(-yoff,-xoff) ang2 <- ((1-(2*r0.vertex)/(2*pi*r0.loop))+r0.vertex/(2*pi*r0.loop))*2*pi+ atan2(-yoff,-xoff) if(ahead){ x0.arrow <- x0.loop+(r0.loop+swid/2)*cos(ang2) y0.arrow <- y0.loop+(r0.loop+swid/2)*sin(ang2) coord<-rbind( cbind(x0.loop+(r0.loop+swid/2)*cos(ang), y0.loop+(r0.loop+swid/2)*sin(ang)), cbind(x0.arrow+ahlen*cos(ang2-pi/2), y0.arrow+ahlen*sin(ang2-pi/2)), cbind(x0.arrow,y0.arrow), cbind(x0.arrow+ahlen*cos(-2*ahangle+ang2-pi/2), y0.arrow+ahlen*sin(-2*ahangle+ang2-pi/2)), cbind(x0.loop+(r0.loop-swid/2)*cos(rev(ang)), y0.loop+(r0.loop-swid/2)*sin(rev(ang))), c(NA,NA) ) }else{ coord<-rbind( cbind(x0.loop+(r0.loop+swid/2)*cos(ang), y0.loop+(r0.loop+swid/2)*sin(ang)), cbind(x0.loop+(r0.loop-swid/2)*cos(rev(ang)), y0.loop+(r0.loop-swid/2)*sin(rev(ang))), c(NA,NA) ) } coord[,1]<-coord[,1]+x0 #Translate to (x0,y0) coord[,2]<-coord[,2]+y0 coord } #Custom loop-drawing method for plot.network #' Add Loops to a Plot #' #' \code{network.loop} draws a "loop" at a specified location; this is used to #' designate self-ties in \code{\link{plot.network}}. #' #' \code{network.loop} is the companion to \code{\link{network.arrow}}; like #' the latter, plot elements produced by \code{network.loop} are drawn using #' \code{\link{polygon}}, and as such are scaled based on the current plotting #' device. By default, loops are drawn so as to encompass a circular region of #' radius \code{radius}, whose center is \code{offset} units from \code{x0,y0} #' and at maximum distance from \code{xctr,yctr}. This is useful for functions #' like \code{\link{plot.network}}, which need to draw loops incident to #' vertices of varying radii. #' #' @param x0 a vector of x coordinates for points of origin. #' @param y0 a vector of y coordinates for points of origin. #' @param length arrowhead length, in current plotting units. #' @param angle arrowhead angle (in degrees). #' @param width width for loop body, in current plotting units (can be a #' vector). #' @param col loop body color (can be a vector). #' @param border loop border color (can be a vector). #' @param lty loop border line type (can be a vector). #' @param offset offset for origin point (can be a vector). #' @param edge.steps number of steps to use in approximating curves. #' @param radius loop radius (can be a vector). #' @param arrowhead boolean; should arrowheads be used? (Can be a vector.) #' @param xctr x coordinate for the central location away from which loops #' should be oriented. #' @param yctr y coordinate for the central location away from which loops #' should be oriented. #' @param \dots additional arguments to \code{\link{polygon}}. #' @return None. #' @note \code{network.loop} is a direct adaptation of #' \code{\link[sna]{gplot.loop}}, from the \code{sna} package. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network.arrow}}, \code{\link{plot.network}}, #' \code{\link{polygon}} #' @keywords aplot graphs #' @examples #' #' #Plot a few polygons with loops #' plot(0,0,type="n",xlim=c(-2,2),ylim=c(-2,2),asp=1) #' network.loop(c(0,0),c(1,-1),col=c(3,2),width=0.05,length=0.4, #' offset=sqrt(2)/4,angle=20,radius=0.5,edge.steps=50,arrowhead=TRUE) #' polygon(c(0.25,-0.25,-0.25,0.25,NA,0.25,-0.25,-0.25,0.25), #' c(1.25,1.25,0.75,0.75,NA,-1.25,-1.25,-0.75,-0.75),col=c(2,3)) #' #' #' @export network.loop network.loop<-function(x0,y0,length=0.1,angle=10,width=0.01,col=1,border=1,lty=1,offset=0,edge.steps=10,radius=1,arrowhead=TRUE,xctr=0,yctr=0,...){ if(length(x0)==0) #Leave if there's nothing to do return() #"Stretch" the arguments n<-length(x0) angle<-rep(angle,length.out=n)/360*2*pi length<-rep(length,length.out=n) width<-rep(width,length.out=n) col<-rep(col,length.out=n) border<-rep(border,length.out=n) lty<-rep(lty,length.out=n) rad<-rep(radius,length.out=n) arrowhead<-rep(arrowhead,length.out=n) offset<-rep(offset,length.out=n) #Obtain coordinates coord<-vector() for(i in 1:n) coord<-rbind(coord,make.loop.poly.coords(x0[i],y0[i],xctr,yctr,angle[i],length[i], width[i],offset[i],rad[i],arrowhead[i],edge.steps)) coord<-coord[-NROW(coord),] #Draw polygons polygon(coord,col=col,border=border,lty=lty,...) } #Introduce a function to make coordinates for a single vertex polygon # this version just uses the raw radius, so triangles appear half the size of circles old.make.vertex.poly.coords<-function(x,y,r,s,rot){ ang<-(1:s)/s*2*pi+rot*2*pi/360 rbind(cbind(x+r*cos(ang),y+r*sin(ang)),c(NA,NA)) } #Introduce a function to make coordinates for a single vertex polygon # all polygons produced will have equal area make.vertex.poly.coords<-function(x,y,r,s,rot){ # trap some edge cases if(is.na(s) || s<2){ return(rbind(c(x,y),c(NA,NA))) # return a single point } else { #scale r (circumradius) to make area equal area<-pi*r^2 # target area based desired r as radius of circle # solve for new r as polygon radius that would match the area of the circle r<-sqrt(2*area / (s*sin(2*pi/s))) ang<-(1:s)/s*2*pi+rot*2*pi/360 return(rbind(cbind(x+r*cos(ang),y+r*sin(ang)),c(NA,NA))) } } #Routine to plot vertices, using polygons #' Add Vertices to a Plot #' #' \code{network.vertex} adds one or more vertices (drawn using #' \code{\link{polygon}}) to a plot. #' #' \code{network.vertex} draws regular polygons of specified radius and number #' of sides, at the given coordinates. This is useful for routines such as #' \code{\link{plot.network}}, which use such shapes to depict vertices. #' #' @param x a vector of x coordinates. #' @param y a vector of y coordinates. #' @param radius a vector of vertex radii. #' @param sides a vector containing the number of sides to draw for each #' vertex. #' @param border a vector of vertex border colors. #' @param col a vector of vertex interior colors. #' @param lty a vector of vertex border line types. #' @param rot a vector of vertex rotation angles (in degrees). #' @param lwd a vector of vertex border line widths. #' @param \dots Additional arguments to \code{\link{polygon}} #' @return None #' @note \code{network.vertex} is a direct adaptation of #' \code{\link[sna]{gplot.vertex}} from the \code{sna} package. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{plot.network}}, \code{\link{polygon}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords aplot graphs #' @examples #' #' #' #Open a plot window, and place some vertices #' plot(0,0,type="n",xlim=c(-1.5,1.5),ylim=c(-1.5,1.5),asp=1) #' network.vertex(cos((1:10)/10*2*pi),sin((1:10)/10*2*pi),col=1:10, #' sides=3:12,radius=0.1) #' #' #' @export network.vertex network.vertex<-function(x,y,radius=1,sides=4,border=1,col=2,lty=NULL,rot=0,lwd=1,...){ #Prep the vars n<-length(x) radius<-rep(radius,length.out=n) sides<-rep(sides,length.out=n) border<-rep(border,length.out=n) col<-rep(col,length.out=n) lty<-rep(lty,length.out=n) rot<-rep(rot,length.out=n) lwd<-rep(lwd,length.out=n) #Obtain the coordinates coord<-vector() for(i in 1:length(x)) { coord<-make.vertex.poly.coords(x[i],y[i],radius[i],sides[i],rot[i]) polygon(coord,border=border[i],col=col[i],lty=lty[i],lwd=lwd[i], ...) } #Plot the polygons } # draw a label for a network edge #' Plots a label corresponding to an edge in a network plot. #' #' Draws a text labels on (or adjacent to) the line segments connecting #' vertices on a network plot. #' #' Called internally by \code{\link{plot.network}} when \code{edge.label} #' parameter is used. For directed, non-curved edges, the labels are shifted #' towards the tail of the edge. Labels for curved edges are not shifted #' because opposite-direction edges curve the opposite way. Makes a crude #' attempt to shift labels to either side of line, and to draw the edge labels #' for self-loops near the vertex. No attempt is made to avoid overlap between #' vertex and edge labels. #' #' @param px0 vector of x coordinates of tail vertex of the edge #' @param py0 vector of y coordinates of tail vertex of the edge #' @param px1 vector of x coordinates of head vertex of the edge #' @param py1 vector of y coordinate of head vertex of the edge #' @param label vector strings giving labels to be drawn for edge edge #' @param directed logical: is the underlying network directed? If FALSE, #' labels will be drawn in the middle of the line segment, otherwise in the #' first 3rd so that the labels for edges pointing in the opposite direction #' will not overlap. #' @param loops logical: if true, assuming the labels to be drawn belong to #' loop-type edges and render appropriately #' @param cex numeric vector giving the text expansion factor for each label #' @param curve numeric vector controling the extent of edge curvature (0 = #' straight line edges) #' @param \dots additional arguments to be passed to \code{\link{text}} #' @return no value is returned but text will be rendered on the active plot #' @author skyebend #' @export network.edgelabel network.edgelabel<-function(px0,py0,px1,py1,label,directed,loops=FALSE,cex,curve=0,...){ curve<-rep(curve,length(label)) posl<-rep(0,length(label)) offsets<-rep(0.1,length(label)) if (loops){ # loops version # assume coordinates are the first pair # math is hard. For now just draw label near the vertex lpx<-px0 lpy<-py0 # compute crude offset so that label doesn't land on vertex # todo, this doesn't work well on all edge orientations posl<-rep(0,length(label)) posl[(px0>px1) & (py0>py1)]<-4 posl[(px0<=px1) & (py0<=py1)]<-2 posl[(px0>px1) & (py0<=py1)]<-1 posl[(px0<=px1) & (py0>py1)]<-3 offsets<-rep(0.5,length(label)) } else { # either curved or straight line if (all(curve==0)){ # straight line non-curved version if (directed){ # draw labels off center of line so won't overlap lpx<-px0+((px1-px0)/3) lpy<-py0+((py1-py0)/3) } else { # draw labels on center of line lpx<-px0+((px1-px0)/2) lpy<-py0+((py1-py0)/2) # assumes that line is straight } } else { # curved edge case coords<-sapply(seq_len(length(label)),function(p){ make.arrow.poly.coords(px0[p],py0[p],px1[p],py1[p],ahangle = 0,ahlen=0,swid = 0,toff = 0,hoff=0,ahead = 0,curve=curve[p],csteps=2)[2,] # pick a point returned from the middle of the curve }) lpx<-coords[1,] lpy<-coords[2,] # this should } # compute crude offset so that label doesn't land on line # todo, this doesn't work well on all edge orientations posl[(px0>px1) & (py0>py1)]<-1 posl[(px0<=px1) & (py0<=py1)]<-3 posl[(px0>px1) & (py0<=py1)]<-2 posl[(px0<=px1) & (py0>py1)]<-4 } # debug coord location text(lpx,lpy,labels=label,cex=cex,pos=posl,offset=offsets,...) } #Generic plot.network method. #' Two-Dimensional Visualization for Network Objects #' #' \code{plot.network} produces a simple two-dimensional plot of network #' \code{x}, using optional attribute \code{attrname} to set edge values. A #' variety of options are available to control vertex placement, display #' details, color, etc. #' #' \code{plot.network} is the standard visualization tool for the #' \code{network} class. By means of clever selection of display parameters, a #' fair amount of display flexibility can be obtained. Vertex layout -- if not #' specified directly using \code{coord} -- is determined via one of the #' various available algorithms. These should be specified via the \code{mode} #' argument; see \code{\link{network.layout}} for a full list. User-supplied #' layout functions are also possible -- see the aforementioned man page for #' details. #' #' Note that where \code{is.hyper(x)==TRUE}, the network is converted to #' bipartite adjacency form prior to computing coordinates. If #' \code{interactive==TRUE}, then the user may modify the initial network #' layout by selecting an individual vertex and then clicking on the location #' to which this vertex is to be moved; this process may be repeated until the #' layout is satisfactory. #' #' @rdname plot.network #' @name plot.network.default #' #' @param x an object of class \code{network}. #' @param attrname an optional edge attribute, to be used to set edge values. #' @param label a vector of vertex labels, if desired; defaults to the vertex #' labels returned by \code{\link{network.vertex.names}}. If \code{label} has #' one element and it matches with a vertex attribute name, the value of the #' attribute will be used. Note that labels may be set but hidden by the #' \code{displaylabels} argument. #' @param coord user-specified vertex coordinates, in an network.size(x)x2 #' matrix. Where this is specified, it will override the \code{mode} setting. #' @param jitter boolean; should the output be jittered? #' @param thresh real number indicating the lower threshold for tie values. #' Only ties of value >\code{thresh} are displayed. By default, #' \code{thresh}=0. #' @param usearrows boolean; should arrows (rather than line segments) be used #' to indicate edges? #' @param mode the vertex placement algorithm; this must correspond to a #' \code{\link{network.layout}} function. #' @param displayisolates boolean; should isolates be displayed? #' @param interactive boolean; should interactive adjustment of vertex #' placement be attempted? #' @param xlab x axis label. #' @param ylab y axis label. #' @param xlim the x limits (min, max) of the plot. #' @param ylim the y limits of the plot. #' @param pad amount to pad the plotting range; useful if labels are being #' clipped. #' @param label.pad amount to pad label boxes (if \code{boxed.labels==TRUE}), #' in character size units. #' @param displaylabels boolean; should vertex labels be displayed? #' @param boxed.labels boolean; place vertex labels within boxes? #' @param label.pos position at which labels should be placed, relative to #' vertices. \code{0} results in labels which are placed away from the center #' of the plotting region; \code{1}, \code{2}, \code{3}, and \code{4} result in #' labels being placed below, to the left of, above, and to the right of #' vertices (respectively); and \code{label.pos>=5} results in labels which are #' plotted with no offset (i.e., at the vertex positions). #' @param label.bg background color for label boxes (if #' \code{boxed.labels==TRUE}); may be a vector, if boxes are to be of different #' colors. #' @param vertex.sides number of polygon sides for vertices; may be given as a #' vector or a vertex attribute name, if vertices are to be of different types. #' As of v1.12, radius of polygons are scaled so that all shapes have equal #' area #' @param vertex.rot angle of rotation for vertices (in degrees); may be given #' as a vector or a vertex attribute name, if vertices are to be rotated #' differently. #' @param vertex.lwd line width of vertex borders; may be given as a vector or #' a vertex attribute name, if vertex borders are to have different line #' widths. #' @param arrowhead.cex expansion factor for edge arrowheads. #' @param label.cex character expansion factor for label text. #' @param loop.cex expansion factor for loops; may be given as a vector or a #' vertex attribute name, if loops are to be of different sizes. #' @param vertex.cex expansion factor for vertices; may be given as a vector or #' a vertex attribute name, if vertices are to be of different sizes. #' @param edge.col color for edges; may be given as a vector, adjacency matrix, #' or edge attribute name, if edges are to be of different colors. #' @param label.col color for vertex labels; may be given as a vector or a #' vertex attribute name, if labels are to be of different colors. #' @param vertex.col color for vertices; may be given as a vector or a vertex #' attribute name, if vertices are to be of different colors. #' @param label.border label border colors (if \code{boxed.labels==TRUE}); may #' be given as a vector, if label boxes are to have different colors. #' @param vertex.border border color for vertices; may be given as a vector or #' a vertex attribute name, if vertex borders are to be of different colors. #' @param edge.lty line type for edge borders; may be given as a vector, #' adjacency matrix, or edge attribute name, if edge borders are to have #' different line types. #' @param label.lty line type for label boxes (if \code{boxed.labels==TRUE}); #' may be given as a vector, if label boxes are to have different line types. #' @param vertex.lty line type for vertex borders; may be given as a vector or #' a vertex attribute name, if vertex borders are to have different line types. #' @param edge.lwd line width scale for edges; if set greater than 0, edge #' widths are scaled by \code{edge.lwd*dat}. May be given as a vector, #' adjacency matrix, or edge attribute name, if edges are to have different #' line widths. #' @param edge.label if non-\code{NULL}, labels for edges will be drawn. May be #' given as a vector, adjacency matrix, or edge attribute name, if edges are to #' have different labels. A single value of \code{TRUE} will use edge ids as #' labels. NOTE: currently doesn't work for curved edges. #' @param edge.label.cex character expansion factor for edge label text; may be #' given as a vector or a edge attribute name, if edge labels are to have #' different sizes. #' @param edge.label.col color for edge labels; may be given as a vector or a #' edge attribute name, if labels are to be of different colors. #' @param label.lwd line width for label boxes (if \code{boxed.labels==TRUE}); #' may be given as a vector, if label boxes are to have different line widths. #' @param edge.len if \code{uselen==TRUE}, curved edge lengths are scaled by #' \code{edge.len}. #' @param edge.curve if \code{usecurve==TRUE}, the extent of edge curvature is #' controlled by \code{edge.curv}. May be given as a fixed value, vector, #' adjacency matrix, or edge attribute name, if edges are to have different #' levels of curvature. #' @param edge.steps for curved edges (excluding loops), the number of line #' segments to use for the curve approximation. #' @param loop.steps for loops, the number of line segments to use for the #' curve approximation. #' @param object.scale base length for plotting objects, as a fraction of the #' linear scale of the plotting region. Defaults to 0.01. #' @param uselen boolean; should we use \code{edge.len} to rescale edge #' lengths? #' @param usecurve boolean; should we use \code{edge.curve}? #' @param suppress.axes boolean; suppress plotting of axes? #' @param vertices.last boolean; plot vertices after plotting edges? #' @param new boolean; create a new plot? If \code{new==FALSE}, vertices and #' edges will be added to the existing plot. #' @param layout.par parameters to the \code{\link{network.layout}} function #' specified in \code{mode}. #' @param \dots additional arguments to \code{\link{plot}}. #' @return A two-column matrix containing the vertex positions as x,y #' coordinates #' @note \code{plot.network} is adapted (with minor modifications) from the #' \code{\link[sna]{gplot}} function of the \code{sna} library (authors: Carter #' T. Butts and Alex Montgomery); eventually, these two packages will be #' integrated. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network}}, \code{\link{network.arrow}}, #' \code{\link{network.loop}}, \code{\link{network.vertex}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' #' Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: #' Methods and Applications.} Cambridge: Cambridge University Press. #' @keywords hplot graphs #' @examples #' #' #Construct a sparse graph #' m<-matrix(rbinom(100,1,1.5/9),10) #' diag(m)<-0 #' g<-network(m) #' #' #Plot the graph #' plot(g) #' #' #Load Padgett's marriage data #' data(flo) #' nflo<-network(flo) #' #Display the network, indicating degree and flagging the Medicis #' plot(nflo, vertex.cex=apply(flo,2,sum)+1, usearrows=FALSE, #' vertex.sides=3+apply(flo,2,sum), #' vertex.col=2+(network.vertex.names(nflo)=="Medici")) #' @export plot.network #' @export plot.network <- function(x, ...){ plot.network.default(x, ...) } #Two-dimensional network visualization; this was originally a direct port of the gplot #routine from sna (Carter T. Butts ) #' @rdname plot.network #' @usage \method{plot.network}{default}(x, attrname = NULL, #' label = network.vertex.names(x), coord = NULL, jitter = TRUE, #' thresh = 0, usearrows = TRUE, mode = "fruchtermanreingold", #' displayisolates = TRUE, interactive = FALSE, xlab = NULL, #' ylab = NULL, xlim = NULL, ylim = NULL, pad = 0.2, label.pad = 0.5, #' displaylabels = !missing(label), boxed.labels = FALSE, label.pos = 0, #' label.bg = "white", vertex.sides = 50, vertex.rot = 0, vertex.lwd=1, #' arrowhead.cex = 1, label.cex = 1, loop.cex = 1, vertex.cex = 1, #' edge.col = 1, label.col = 1, vertex.col = 2, label.border = 1, #' vertex.border = 1, edge.lty = 1, label.lty = NULL, vertex.lty = 1, #' edge.lwd = 0, edge.label = NULL, edge.label.cex = 1, #' edge.label.col = 1, label.lwd = par("lwd"), edge.len = 0.5, #' edge.curve = 0.1, edge.steps = 50, loop.steps = 20, #' object.scale = 0.01, uselen = FALSE, usecurve = FALSE, #' suppress.axes = TRUE, vertices.last = TRUE, new = TRUE, #' layout.par = NULL, \dots) #' @export plot.network.default #' @rawNamespace S3method(plot.network,default) plot.network.default<-function(x, attrname=NULL, label=network.vertex.names(x), coord=NULL, jitter=TRUE, thresh=0, usearrows=TRUE, mode="fruchtermanreingold", displayisolates=TRUE, interactive=FALSE, xlab=NULL, ylab=NULL, xlim=NULL, ylim=NULL, pad=0.2, label.pad=0.5, displaylabels=!missing(label), boxed.labels=FALSE, label.pos=0, label.bg="white", vertex.sides=50, vertex.rot=0, vertex.lwd=1, arrowhead.cex=1, label.cex=1, loop.cex=1, vertex.cex=1, edge.col=1, label.col=1, vertex.col=2, label.border=1, vertex.border=1, edge.lty=1, label.lty=NULL, vertex.lty=1, edge.lwd=0, edge.label=NULL, edge.label.cex=1, edge.label.col=1, label.lwd=par("lwd"), edge.len=0.5, edge.curve=0.1, edge.steps=50, loop.steps=20, object.scale=0.01, uselen=FALSE, usecurve=FALSE, suppress.axes=TRUE, vertices.last=TRUE, new=TRUE, layout.par=NULL, ...){ #Check to see that things make sense if(!is.network(x)) stop("plot.network requires a network object.") if(network.size(x)==0) stop("plot.network called on a network of order zero - nothing to plot.") #Turn the annoying locator bell off, and remove recursion limit old.opts <- options(locatorBell=FALSE,expressions=500000) on.exit(options(old.opts)) #Create a useful interval inclusion operator "%iin%"<-function(x,int) (x>=int[1])&(x<=int[2]) #Extract the network to be displayed if(is.hyper(x)){ #Is this a hypergraph? If so, use two-mode form. #Create a new graph to store the two-mode structure xh<-network.initialize(network.size(x)+sum(!sapply(x$mel, is.null)), directed=is.directed(x)) #Port attributes, in case we need them for(i in list.vertex.attributes(x)){ set.vertex.attribute(xh,attrname=i, value=get.vertex.attribute(x,attrname=i,null.na=FALSE,unlist=FALSE), v=1:network.size(x)) } for(i in list.network.attributes(x)){ if(!(i%in%c("bipartite","directed","hyper","loops","mnext","multiple", "n"))) set.network.attribute(xh,attrname=i, value=get.network.attribute(x,attrname=i,unlist=FALSE)) } #Now, import the edges cnt<-1 for(i in 1:length(x$mel)){ #Not a safe way to do this, long-term if(!is.null(x$mel[[i]])){ for(j in x$mel[[i]]$outl){ if(!is.adjacent(xh,j,network.size(x)+cnt)) add.edge(xh,j,network.size(x)+cnt,names.eval=names(x$mel[[i]]$atl), vals.eval=x$mel[[i]]$atl) } for(j in x$mel[[i]]$inl){ if(!is.adjacent(xh,network.size(x)+cnt,j)){ add.edge(xh,network.size(x)+cnt,j,names.eval=names(x$mel[[i]]$atl), vals.eval=x$mel[[i]]$atl) } } cnt<-cnt+1 #Increment the edge counter } } cnt<-cnt-1 if(length(label)==network.size(x)) #Fix labels, if needed label<-c(label,paste("e",1:cnt,sep="")) xh%v%"vertex.names"<-c(x%v%"vertex.names",paste("e",1:cnt,sep="")) x<-xh n<-network.size(x) d<-as.matrix.network(x,matrix.type="edgelist",attrname=attrname) if(!is.directed(x)) usearrows<-FALSE }else if(is.bipartite(x)){ n<-network.size(x) d<-as.matrix.network(x,matrix.type="edgelist",attrname=attrname) usearrows<-FALSE }else{ n<-network.size(x) d<-as.matrix.network(x,matrix.type="edgelist",attrname=attrname) if(!is.directed(x)) usearrows<-FALSE } #Make sure that edge values are in place, matrix has right shape, etc. if(NCOL(d)==2){ if(NROW(d)==0) d<-matrix(nrow=0,ncol=3) else d<-cbind(d,rep(1,NROW(d))) } diag<-has.loops(x) #Check for existence of loops #Replace NAs with 0s d[is.na(d)]<-0 #Determine which edges should be used when plotting edgetouse<-d[,3]>thresh d<-d[edgetouse,,drop=FALSE] #Save original matrix, which we may use below d.raw<-d #Determine coordinate placement if(!is.null(coord)){ #If the user has specified coords, override all other considerations cx<-coord[,1] cy<-coord[,2] }else{ #Otherwise, use the specified layout function layout.fun<-try(match.fun(paste("network.layout.",mode,sep="")), silent=TRUE) if(inherits(layout.fun,"try-error")) stop("Error in plot.network.default: no layout function for mode ",mode) temp<-layout.fun(x,layout.par) cx<-temp[,1] cy<-temp[,2] } #Jitter the coordinates if need be if(jitter){ cx<-jitter(cx) cy<-jitter(cy) } #Which nodes should we use? use<-displayisolates|(((sapply(x$iel,length)+sapply(x$oel,length))>0)) #Deal with axis labels if(is.null(xlab)) xlab="" if(is.null(ylab)) ylab="" #Set limits for plotting region if(is.null(xlim)) xlim<-c(min(cx[use])-pad,max(cx[use])+pad) #Save x, y limits if(is.null(ylim)) ylim<-c(min(cy[use])-pad,max(cy[use])+pad) xrng<-diff(xlim) #Force scale to be symmetric yrng<-diff(ylim) xctr<-(xlim[2]+xlim[1])/2 #Get center of plotting region yctr<-(ylim[2]+ylim[1])/2 if(xrng0){ #Edge color edge.col<-plotArgs.network(x,'edge.col',edge.col,d=d) #Edge line type edge.lty<-plotArgs.network(x,'edge.lty',edge.lty,d=d) #Edge line width edge.lwd<-plotArgs.network(x,'edge.lwd',edge.lwd,d=d) #Edge curve # TODO: can't move this into prepare plot args becaue it also sets the e.curve.as.mult # but I think it could be refactored to use the d[] array as the other edge functions do if(!is.null(edge.curve)){ if(length(dim(edge.curve))==2){ edge.curve<-edge.curve[d[,1:2]] e.curv.as.mult<-FALSE }else{ if(length(edge.curve)==1) e.curv.as.mult<-TRUE else e.curv.as.mult<-FALSE edge.curve<-rep(edge.curve,length.out=NROW(d)) } }else if(is.character(edge.curve)&&(length(edge.curve)==1)){ temp<-edge.curve edge.curve<-(x%e%edge.curve)[edgetouse] if(all(is.na(edge.curve))) stop("Attribute '",temp,"' had illegal missing values for edge.curve or was not present in plot.network.default.") e.curv.as.mult<-FALSE }else{ edge.curve<-rep(0,length.out=NROW(d)) e.curv.as.mult<-FALSE } # only evaluate edge label stuff if we will draw label if(!is.null(edge.label)){ #Edge label edge.label<-plotArgs.network(x,'edge.label',edge.label,d=d) #Edge label color edge.label.col<-plotArgs.network(x,'edge.label.col',edge.label.col,d=d) #Edge label cex edge.label.cex<-plotArgs.network(x,'edge.label.cex',edge.label.cex,d=d) } # end edge label setup block #Proceed with edge setup dist<-((cx[d[,1]]-cx[d[,2]])^2+(cy[d[,1]]-cy[d[,2]])^2)^0.5 #Get the inter-point distances for curves tl<-d.raw*dist #Get rescaled edge lengths tl.max<-max(tl) #Get maximum edge length for(i in 1:NROW(d)){ if(use[d[i,1]]&&use[d[i,2]]){ #Plot edges for displayed vertices (wait,doesn't 'use' track isolates, which don't have edges anyway?) px0[i]<-as.double(cx[d[i,1]]) #Store endpoint coordinates py0[i]<-as.double(cy[d[i,1]]) px1[i]<-as.double(cx[d[i,2]]) py1[i]<-as.double(cy[d[i,2]]) e.toff[i]<-vertex.radius[d[i,1]] #Store endpoint offsets e.hoff[i]<-vertex.radius[d[i,2]] e.col[i]<-edge.col[i] #Store other edge attributes e.type[i]<-edge.lty[i] e.lwd[i]<-edge.lwd[i] e.diag[i]<-d[i,1]==d[i,2] #Is this a loop? e.rad[i]<-vertex.radius[d[i,1]]*loop.cex[d[i,1]] if(uselen){ #Should we base curvature on interpoint distances? if(tl[i]>0){ e.len<-dist[i]*tl.max/tl[i] e.curv[i]<-edge.len*sqrt((e.len/2)^2-(dist[i]/2)^2) }else{ e.curv[i]<-0 } }else{ #Otherwise, use prespecified edge.curve if(e.curv.as.mult) #If it's a scalar, multiply by edge str e.curv[i]<-edge.curve[i]*d.raw[i] else e.curv[i]<-edge.curve[i] } } } }# end edges block #Plot loops for the diagonals, if diag==TRUE, rotating wrt center of mass if(diag&&(length(px0)>0)&&sum(e.diag>0)){ #Are there any loops present? network.loop(as.vector(px0)[e.diag],as.vector(py0)[e.diag], length=1.5*baserad*arrowhead.cex,angle=25,width=e.lwd[e.diag]*baserad/10,col=e.col[e.diag],border=e.col[e.diag],lty=e.type[e.diag],offset=e.hoff[e.diag],edge.steps=loop.steps,radius=e.rad[e.diag],arrowhead=usearrows,xctr=mean(cx[use]),yctr=mean(cy[use])) if(!is.null(edge.label)){ network.edgelabel(px0,py0,0,0,edge.label[e.diag],directed=is.directed(x),cex=edge.label.cex[e.diag],col=edge.label.col[e.diag],loops=TRUE) } } #Plot standard (i.e., non-loop) edges if(length(px0)>0){ #If edges are present, remove loops from consideration px0<-px0[!e.diag] py0<-py0[!e.diag] px1<-px1[!e.diag] py1<-py1[!e.diag] e.curv<-e.curv[!e.diag] e.lwd<-e.lwd[!e.diag] e.type<-e.type[!e.diag] e.col<-e.col[!e.diag] e.hoff<-e.hoff[!e.diag] e.toff<-e.toff[!e.diag] e.rad<-e.rad[!e.diag] } if(!usecurve&!uselen){ #Straight-line edge case if(length(px0)>0){ network.arrow(as.vector(px0),as.vector(py0),as.vector(px1), as.vector(py1),length=2*baserad*arrowhead.cex,angle=20,col=e.col,border=e.col,lty=e.type,width=e.lwd*baserad/10,offset.head=e.hoff,offset.tail=e.toff,arrowhead=usearrows) if(!is.null(edge.label)){ network.edgelabel(px0,py0,px1,py1,edge.label[!e.diag],directed=is.directed(x),cex=edge.label.cex[!e.diag],col=edge.label.col[!e.diag]) } } }else{ #Curved edge case if(length(px0)>0){ network.arrow(as.vector(px0),as.vector(py0),as.vector(px1), as.vector(py1),length=2*baserad*arrowhead.cex,angle=20,col=e.col,border=e.col,lty=e.type,width=e.lwd*baserad/10,offset.head=e.hoff,offset.tail=e.toff,arrowhead=usearrows,curve=e.curv,edge.steps=edge.steps) if(!is.null(edge.label)){ network.edgelabel(px0,py0,px1,py1,edge.label[!e.diag],directed=is.directed(x),cex=edge.label.cex[!e.diag],col=edge.label.col[!e.diag],curve=e.curv) } } } #Plot vertices now, if we haven't already done so if(vertices.last) network.vertex(cx[use],cy[use],radius=vertex.radius[use], sides=vertex.sides[use],col=vertex.col[use],border=vertex.border[use],lty=vertex.lty[use],rot=vertex.rot[use], lwd=vertex.lwd[use]) #Plot vertex labels, if needed if(displaylabels&(!all(label==""))&(!all(use==FALSE))){ if (label.pos==0){ xhat <- yhat <- rhat <- rep(0,n) #Set up xoff yoff and roff when we get odd vertices xoff <- cx[use]-mean(cx[use]) yoff <- cy[use]-mean(cy[use]) roff <- sqrt(xoff^2+yoff^2) #Loop through vertices for (i in (1:n)[use]){ #Find all in and out ties that aren't loops ij <- unique(c(d[d[,2]==i&d[,1]!=i,1],d[d[,1]==i&d[,2]!=i,2])) ij.n <- length(ij) if (ij.n>0) { #Loop through all ties and add each vector to label direction for (j in ij){ dx <- cx[i]-cx[j] dy <- cy[i]-cy[j] dr <- sqrt(dx^2+dy^2) xhat[i] <- xhat[i]+dx/dr yhat[i] <- yhat[i]+dy/dr } #Take the average of all the ties xhat[i] <- xhat[i]/ij.n yhat[i] <- yhat[i]/ij.n rhat[i] <- sqrt(xhat[i]^2+yhat[i]^2) if (!is.nan(rhat[i]) && rhat[i]!=0) { # watch out for NaN when vertices have same position # normalize direction vector xhat[i] <- xhat[i]/rhat[i] yhat[i] <- yhat[i]/rhat[i] } else { #if no direction, make xhat and yhat away from center xhat[i] <- xoff[i]/roff[i] yhat[i] <- yoff[i]/roff[i] } } else { #if no ties, make xhat and yhat away from center xhat[i] <- xoff[i]/roff[i] yhat[i] <- yoff[i]/roff[i] } if ( is.nan(xhat[i]) || xhat[i]==0 ) xhat[i] <- .01 #jitter to avoid labels on points if (is.nan(yhat[i]) || yhat[i]==0 ) yhat[i] <- .01 } xhat <- xhat[use] yhat <- yhat[use] } else if (label.pos<5) { xhat <- switch(label.pos,0,-1,0,1) yhat <- switch(label.pos,-1,0,1,0) } else if (label.pos==6) { xoff <- cx[use]-mean(cx[use]) yoff <- cy[use]-mean(cy[use]) roff <- sqrt(xoff^2+yoff^2) xhat <- xoff/roff yhat <- yoff/roff } else { xhat <- 0 yhat <- 0 } os<-par()$cxy*mean(label.cex,na.rm = TRUE) # don't think this is actually used? lw<-strwidth(label[use],cex=label.cex)/2 lh<-strheight(label[use],cex=label.cex)/2 if(boxed.labels){ rect(cx[use]+xhat*vertex.radius[use]-(lh*label.pad+lw)*((xhat<0)*2+ (xhat==0)*1), cy[use]+yhat*vertex.radius[use]-(lh*label.pad+lh)*((yhat<0)*2+ (yhat==0)*1), cx[use]+xhat*vertex.radius[use]+(lh*label.pad+lw)*((xhat>0)*2+ (xhat==0)*1), cy[use]+yhat*vertex.radius[use]+(lh*label.pad+lh)*((yhat>0)*2+ (yhat==0)*1), col=label.bg,border=label.border,lty=label.lty,lwd=label.lwd) } text(cx[use]+xhat*vertex.radius[use]+(lh*label.pad+lw)*((xhat>0)-(xhat<0)), cy[use]+yhat*vertex.radius[use]+(lh*label.pad+lh)*((yhat>0)-(yhat<0)), label[use],cex=label.cex,col=label.col,offset=0) } #If interactive, allow the user to mess with things if(interactive&&((length(cx)>0)&&(!all(use==FALSE)))){ #Set up the text offset increment os<-c(0.2,0.4)*par()$cxy #Get the location for text messages, and write to the screen textloc<-c(min(cx[use])-pad,max(cy[use])+pad) tm<-"Select a vertex to move, or click \"Finished\" to end." tmh<-strheight(tm) tmw<-strwidth(tm) text(textloc[1],textloc[2],tm,adj=c(0,0.5)) #Print the initial instruction fm<-"Finished" finx<-c(textloc[1],textloc[1]+strwidth(fm)) finy<-c(textloc[2]-3*tmh-strheight(fm)/2,textloc[2]-3*tmh+strheight(fm)/2) finbx<-finx+c(-os[1],os[1]) finby<-finy+c(-os[2],os[2]) rect(finbx[1],finby[1],finbx[2],finby[2],col="white") text(finx[1],mean(finy),fm,adj=c(0,0.5)) #Get the click location clickpos<-unlist(locator(1)) #If the click is in the "finished" box, end our little game. Otherwise, #relocate a vertex and redraw. if((clickpos[1]%iin%finbx)&&(clickpos[2]%iin%finby)){ cl<-match.call() #Get the args of the current function cl$interactive<-FALSE #Turn off interactivity cl$coord<-cbind(cx,cy) #Set the coordinates cl$x<-x #"Fix" the data array return(eval.parent(cl)) #Execute the function and return }else{ #Figure out which vertex was selected clickdis<-sqrt((clickpos[1]-cx[use])^2+(clickpos[2]-cy[use])^2) selvert<-match(min(clickdis),clickdis) #Create usable labels, if the current ones aren't if(all(label=="")) label<-1:n #Clear out the old message, and write a new one rect(textloc[1],textloc[2]-tmh/2,textloc[1]+tmw,textloc[2]+tmh/2, border="white",col="white") tm<-"Where should I move this vertex?" tmh<-strheight(tm) tmw<-strwidth(tm) text(textloc[1],textloc[2],tm,adj=c(0,0.5)) fm<-paste("Vertex",label[use][selvert],"selected") finx<-c(textloc[1],textloc[1]+strwidth(fm)) finy<-c(textloc[2]-3*tmh-strheight(fm)/2,textloc[2]-3*tmh+ strheight(fm)/2) finbx<-finx+c(-os[1],os[1]) finby<-finy+c(-os[2],os[2]) rect(finbx[1],finby[1],finbx[2],finby[2],col="white") text(finx[1],mean(finy),fm,adj=c(0,0.5)) #Get the destination for the new vertex clickpos<-unlist(locator(1)) #Set the coordinates accordingly cx[use][selvert]<-clickpos[1] cy[use][selvert]<-clickpos[2] #Iterate (leaving interactivity on) cl<-match.call() #Get the args of the current function cl$coord<-cbind(cx,cy) #Set the coordinates cl$x<-x #"Fix" the data array return(eval.parent(cl)) #Execute the function and return } } #Return the vertex positions, should they be needed invisible(cbind(cx,cy)) } # moving all of the plot argument checking and expansion into a single function # so that it will be acessible from other plot-related tools (like ndtv) # argName = character named of argument to be checked/expaneded # argValue = value passed in by user, to be processed/expanded # d is an edgelist matrix of edge values optionally used by some edge attribute functions # edgetouse the set of edge ids to be used (in case some edges are not being shown) #' Expand and transform attributes of networks to values appropriate for #' aguments to plot.network #' #' This is primairly an internal function called by \code{plot.network} or by #' external packages such as \code{ndtv} that want to prepare #' \code{plot.network} graphic arguments in a standardized way. #' #' Given a network object, the name of graphic parameter argument to #' \code{plot.network} and value, it will if necessary transform the value, or #' extract it from the network, according to the description in #' \code{\link{plot.network}}. For some attributes, if the value is the name of #' a vertex or edge attribute, the appropriate values will be extracted from #' the network before transformation. #' #' @rdname preparePlotArgs #' @name plotArgs.network #' #' @param x a \code{network} object which is going to be plotted #' @param argName character, the name of \code{plot.network} graphic parameter #' @param argValue value for the graphic paramter named in \code{argName} which #' to be transformed/prepared. For many attributes, if this is a single #' character vector it will be assumed to be the name of a vertex or edge #' attribute to be extracted and transformed #' @param d is an edgelist matrix of edge values optionally used by some edge #' attribute functions #' @param edgetouse numeric vector giving set of edge ids to be used (in case #' some edges are not being shown) required by some attributes #' @return returns a vector with length corresponding to the number of vertices #' or edges (depending on the paramter type) giving the appropriately prepared #' values for the parameter type. If the values or specified attribute can not #' be processed correctly, and Error may occur. #' @author skyebend@@uw.edu #' @seealso See also \code{\link{plot.network}} #' @examples #' #' net<-network.initialize(3) #' set.vertex.attribute(net,'color',c('red','green','blue')) #' set.vertex.attribute(net,'charm',1:3) #' # replicate a single colorname value #' plotArgs.network(net,'vertex.col','purple') #' # map the 'color' attribute to color #' plotArgs.network(net,'vertex.col','color') #' # similarly for a numeric attribute ... #' plotArgs.network(net,'vertex.cex',12) #' plotArgs.network(net,'vertex.cex','charm') #' #' @export plotArgs.network plotArgs.network<-function(x,argName, argValue,d=NULL,edgetouse=NULL){ n<-network.size(x) # count the number of edges # not sure if nrow d is every differnt, than network edgecount, but just being safe if(!is.null(d)){ nE<-NROW(d) } else { nE<-network.edgecount(x) } if(is.null(edgetouse)){ edgetouse<-seq_len(nE) # use all the edges } # if d exists, it may need to be subset to the number of edges if (!is.null(d)){ d<-d[edgetouse,,drop=FALSE] } # assign the value to a local variable with the appropriate name assign(argName,argValue) #Fill out vertex vectors; assume we're using attributes if chars used # TODO: only one of the code blocks below should execute, set up as a switch? switch(argName, # ----- vertex labels --------------------------- label=if(is.character(label)&(length(label)==1)){ temp<-label if(temp%in%list.vertex.attributes(x)){ label <- rep(get.vertex.attribute(x,temp),length.out=n) if(all(is.na(label))){ stop("Attribute '",temp,"' had illegal missing values for label or was not present in plot.network.default.") } } else { # didn't match with a vertex attribute, assume we are supposed to replicate it label <- rep(label,length.out=n) } }else{ label <- rep(as.character(label),length.out=n) } , # ------ vertex sizes (vertex.cex) -------------------- vertex.cex=if(is.character(vertex.cex)&(length(vertex.cex)==1)){ temp<-vertex.cex vertex.cex <- rep(get.vertex.attribute(x,vertex.cex),length.out=n) if(all(is.na(vertex.cex))) stop("Attribute '",temp,"' had illegal missing values for vertex.cex or was not present in plot.network.default.") }else vertex.cex <- rep(vertex.cex,length.out=n) , # ------ vertex sides (number of sides for polygon) --------- vertex.sides=if(is.character(vertex.sides)&&(length(vertex.sides==1))){ temp<-vertex.sides vertex.sides <- rep(get.vertex.attribute(x,vertex.sides),length.out=n) if(all(is.na(vertex.sides))) stop("Attribute '",temp,"' had illegal missing values for vertex.sides or was not present in plot.network.default.") }else vertex.sides <- rep(vertex.sides,length.out=n) , # --------- vertex border -------------------- vertex.border=if(is.character(vertex.border)&&(length(vertex.border)==1)){ temp<-vertex.border vertex.border <- rep(get.vertex.attribute(x,vertex.border),length.out=n) if(all(is.na(vertex.border))) vertex.border <- rep(temp,length.out=n) #Assume it was a color word else{ if(!all(is.color(vertex.border),na.rm=TRUE)) vertex.border<-as.color(vertex.border) } }else vertex.border <- rep(vertex.border,length.out=n) , # -------- vertex color ------------------------ vertex.col=if(is.character(vertex.col)&&(length(vertex.col)==1)){ temp<-vertex.col vertex.col <- rep(get.vertex.attribute(x,vertex.col),length.out=n) if(all(is.na(vertex.col))) vertex.col <- rep(temp,length.out=n) #Assume it was a color word else{ if(!all(is.color(vertex.col),na.rm=TRUE)) vertex.col<-as.color(vertex.col) } }else vertex.col <- rep(vertex.col,length.out=n) , # ------- vertex line type (vertex.lty) -------------------- vertex.lty=if(is.character(vertex.lty)&&(length(vertex.lty)==1)){ temp<-vertex.lty vertex.lty <- rep(get.vertex.attribute(x,vertex.lty),length.out=n) if(all(is.na(vertex.lty))) stop("Attribute '",temp,"' had illegal missing values for vertex.col or was not present in plot.network.default.") }else vertex.lty <- rep(vertex.lty,length.out=n) , # ------- vertex rotation -------------------------------------- vertex.rot=if(is.character(vertex.rot)&&(length(vertex.rot)==1)){ temp<-vertex.rot vertex.rot <- rep(get.vertex.attribute(x,vertex.rot),length.out=n) if(all(is.na(vertex.rot))) stop("Attribute '",temp,"' had illegal missing values for vertex.rot or was not present in plot.network.default.") }else vertex.rot <- rep(vertex.rot,length.out=n) , # -------- vertex line width -------------------------- vertex.lwd=if(is.character(vertex.lwd)&&(length(vertex.lwd)==1)){ temp<-vertex.lwd vertex.lwd <- rep(get.vertex.attribute(x,vertex.lwd),length.out=n) if(all(is.na(vertex.lwd))) stop("Attribute '",temp,"' had illegal missing values for vertex.lwd or was not present in plot.network.default.") }else vertex.lwd <- rep(vertex.lwd,length.out=n) , # -------- vertex self-loop size ----------------------- loop.cex=if(is.character(loop.cex)&&(length(loop.cex)==1)){ temp<-loop.cex loop.cex <- rep(get.vertex.attribute(x,loop.cex),length.out=n) if(all(is.na(loop.cex))) stop("Attribute ",temp," had illegal missing values for loop.cex or was not present in plot.network.default.") }else loop.cex <- rep(loop.cex,length.out=n) , # --------- vertex label color ----------------------------- label.col=if(is.character(label.col)&&(length(label.col)==1)){ temp<-label.col label.col <- rep(get.vertex.attribute(x,label.col),length.out=n) if(all(is.na(label.col))) label.col <- rep(temp,length.out=n) #Assume it was a color word else{ if(!all(is.color(label.col),na.rm=TRUE)) label.col<-as.color(label.col) } }else label.col <- rep(label.col,length.out=n) , # -------- vertex label border ------------------------------ label.border=if(is.character(label.border)&&(length(label.border)==1)){ temp<-label.border label.border <- rep(get.vertex.attribute(x,label.border),length.out=n) if(all(is.na(label.border))) label.border <- rep(temp,length.out=n) #Assume it was a color word else{ if(!all(is.color(label.border),na.rm=TRUE)) label.border<-as.color(label.border) } }else{ label.border <- rep(label.border,length.out=n) } , # ------- vertex label border background color ---------------- label.bg=if(is.character(label.bg)&&(length(label.bg)==1)){ temp<-label.bg label.bg <- rep(get.vertex.attribute(x,label.bg),length.out=n) if(all(is.na(label.bg))) label.bg <- rep(temp,length.out=n) #Assume it was a color word else{ if(!all(is.color(label.bg),na.rm=TRUE)) label.bg<-as.color(label.bg) } }else{ label.bg <- rep(label.bg,length.out=n) } , # ------ Edge color--------- edge.col=if(length(dim(edge.col))==2) #Coerce edge.col/edge.lty to vector form edge.col<-edge.col[d[,1:2]] else if(is.character(edge.col)&&(length(edge.col)==1)){ temp<-edge.col edge.col<-x%e%edge.col if(!is.null(edge.col)){ edge.col<-edge.col[edgetouse] if(!all(is.color(edge.col),na.rm=TRUE)) edge.col<-as.color(edge.col) }else{ edge.col<-rep(temp,length.out=nE) #Assume it was a color word } }else{ edge.col<-rep(edge.col,length.out=nE) } , # ----------- Edge line type ------------------ edge.lty=if(length(dim(edge.lty))==2){ edge.lty<-edge.lty[d[,1:2]] }else if(is.character(edge.lty)&&(length(edge.lty)==1)){ temp<-edge.lty edge.lty<-(x%e%edge.lty)[edgetouse] if(all(is.na(edge.lty))) stop("Attribute '",temp,"' had illegal missing values for edge.lty or was not present in plot.network.default.") }else{ edge.lty<-rep(edge.lty,length.out=nE) } , # ----------- Edge line width ------ edge.lwd=if(length(dim(edge.lwd))==2){ edge.lwd<-edge.lwd[d[,1:2]] # what is going on here? aren't these the incident vertices? # for later matrix lookup? }else if(is.character(edge.lwd)&&(length(edge.lwd)==1)){ temp<-edge.lwd edge.lwd<-(x%e%edge.lwd)[edgetouse] if(all(is.na(edge.lwd))){ stop("Attribute '",temp,"' had illegal missing values for edge.lwd or was not present in plot.network.default.") } }else{ if(length(edge.lwd)==1){ # if lwd has only one element.. if(edge.lwd>0){ # ... and that element > 0 ,use it as a scale factor for the edge values in d # .. unless d is missing if (!is.null(d)){ edge.lwd<-edge.lwd*d[,3] } else { # d is missing, so just replicate } edge.lwd<-rep(edge.lwd,length.out=nE) }else{ # edge is zero or less, so set it to 1 edge.lwd<-rep(1,length.out=nE) } } else { # just replacte for the number of edges edge.lwd<-rep(edge.lwd,length.out=nE) } } , # ----------- Edge curve--------------- edge.curve=if(!is.null(edge.curve)){ if(length(dim(edge.curve))==2){ edge.curve<-edge.curve[d[,1:2]] e.curv.as.mult<-FALSE }else{ if(length(edge.curve)==1){ e.curv.as.mult<-TRUE }else{ e.curv.as.mult<-FALSE } edge.curve<-rep(edge.curve,length.out=nE) } }else if(is.character(edge.curve)&&(length(edge.curve)==1)){ temp<-edge.curve edge.curve<-(x%e%edge.curve)[edgetouse] if(all(is.na(edge.curve))){ stop("Attribute '",temp,"' had illegal missing values for edge.curve or was not present in plot.network.default.") } e.curv.as.mult<-FALSE }else{ edge.curve<-rep(0,length.out=nE) e.curv.as.mult<-FALSE } , # -------- edge label ---------------------- edge.label=if(length(dim(edge.label))==2){ #Coerce edge.label to vector form edge.label<-edge.label[d[,1:2]] }else if(is.character(edge.label)&&(length(edge.label)==1)){ temp<-edge.label edge.label<-x%e%edge.label if(!is.null(edge.label)){ edge.label<-edge.label[edgetouse] }else edge.label<-rep(temp,length.out=nE) #Assume it was a value to replicate }else if(is.logical(edge.label)&&(length(edge.label)==1)) { if (edge.label){ # default to edge ids. edge.label<-valid.eids(x)[edgetouse] } else { # don't draw edge labels if set to FALSE edge.label<-NULL } }else{ # do nothing and hope for the best! edge.label<-rep(edge.label,length.out=nE) } , # ------ edge label color -------------------- #Edge label color edge.label.col=if(length(dim(edge.label.col))==2){ #Coerce edge.label.col edge.label.col<-edge.label.col[d[,1:2]] } else if(is.character(edge.label.col)&&(length(edge.label.col)==1)){ temp<-edge.label.col edge.label.col<-x%e%edge.label.col if(!is.null(edge.label.col)){ edge.label.col<-edge.label.col[edgetouse] if(!all(is.color(edge.label.col),na.rm=TRUE)) edge.label.col<-as.color(edge.label.col) }else edge.label.col<-rep(temp,length.out=nE) #Assume it was a color word }else{ edge.label.col<-rep(edge.label.col,length.out=nE) } , # ------- edge.label.cex -------------------- #Edge label cex edge.label.cex=if(length(dim(edge.label.cex))==2) edge.label.cex<-edge.label.cex[d[,1:2]] else if(is.character(edge.label.cex)&&(length(edge.label.cex)==1)){ temp<-edge.label.cex edge.label.cex<-(x%e%edge.label.cex)[edgetouse] if(all(is.na(edge.label.cex))) stop("Attribute '",temp,"' had illegal missing values for edge.label.cex or was not present in plot.network.default.") }else{ edge.label.cex<-rep(edge.label.cex,length.out=nE) } # case in which none of the argument names match up # stop('argument "',argName,'"" does not match with any of the plot.network arguments') # can't error out, because this function will be called with non-network args, so just # return the value passed in ) # end switch block # now return the checked / expanded value return(get(argName)) } network/R/printsum.R0000644000176200001440000002745713737227152014200 0ustar liggesusers###################################################################### # # printsum.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 11/26/19 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various routines for printing/summarizing # network class objects. # # Contents: # # print.network # print.summary.network # summary.character # summary.network # ###################################################################### # Printing for network class objects. # #' @rdname network #' @export print.network #' @export print.network<-function(x, matrix.type=which.matrix.type(x), mixingmatrices=FALSE, na.omit=TRUE, print.adj=FALSE, ...) { cat(" Network attributes:\n") for(i in 1:length(x$gal)){ if (names(x$gal)[i]=="n"){ attributeName<-"vertices" attributeValue<-x$gal[[i]] } else { attributeName<-names(x$gal)[i] attributeValue<-x$gal[[i]] } if(is.network(attributeValue)){ if(attributeName=="design"){ cat(" ",attributeName,"=\n") cat(" total missing =",network.edgecount(attributeValue),"\n") cat(" percent missing =",network.density(attributeValue),"\n") }else{ cat(" ",attributeName,":\n",sep="") if(is.discrete(attributeValue)){ assign(paste(" ",attributeName),attributeValue) print(table(get(paste(" ",attributeName)))) if(mixingmatrices){ cat("\n","mixing matrix for ",attributeName,":\n",sep="") print(mixingmatrix(x,attributeName)) } }else{ print(summary(attributeValue)) } } }else{ if(attributeName!="mnext"){ if(is.discrete(attributeValue)){ #assign(paste(" ",attributeName),attributeValue) #print(table(get(paste(" ",attributeName)))) print(table(attributeValue,dnn=paste(' ',attributeName,':',sep=''))) }else{ # for short attributes, just print out the values if(inherits(attributeValue,c("factor","character","numeric", "logical","integer","double","NULL","call","formula"))&&(length(attributeValue) < 10)){ # handle NULL case because cat won't print NULL if (is.null(attributeValue)){ cat(" ",attributeName,"= NULL\n") } else { if(is.call(attributeValue)) attributeValue <- deparse(attributeValue) cat(" ",attributeName,"=",attributeValue,"\n") } } else{ # special handling for classes where summary would give messy or non-useful output # don't print summary for net obs period or active attributes if (attributeName=='net.obs.period' || grepl('.active$',attributeName) ){ cat(" ",attributeName,": (not shown)\n", sep="") } else if (inherits(attributeValue,c("matrix"))){ cat(" ",attributeName,": ",nrow(attributeValue),"x",ncol(attributeValue)," matrix\n", sep="") } else { # default to printing out the summary for the attribute cat(" ",attributeName,":\n", sep="") if(is.call(attributeValue)){ # (unless it's a call like a formula) print(attributeValue) }else{ print(summary(attributeValue)) } } } } } } } cat(" total edges=",network.edgecount(x,na.omit=FALSE),"\n") cat(" missing edges=",network.naedgecount(x),"\n") cat(" non-missing edges=",network.edgecount(x,na.omit=TRUE),"\n") vna<-list.vertex.attributes(x) if(na.omit){ vna<-vna[vna!="na"] } if(length(vna)==0){ cat("\n","No vertex attributes","\n",sep="") }else{ cat("\n","Vertex attribute names:","\n") cat(" ",vna,"\n") } # Print list of edge attributes, but only if there are not very many edges # because list.edge.attributes is expensive on large nets if(length(x$mel)<=1000){ ena<-list.edge.attributes(x) if(na.omit){ ena<-ena[ena!='na'] } if(length(ena)==0){ cat("\n","No edge attributes","\n",sep="") }else{ cat("\n","Edge attribute names:","\n") cat(" ",ena,"\n") } } else { cat("\n","Edge attribute names not shown","\n") } #Print the adjacency structure, if desired if(print.adj){ if(is.multiplex(x)&&(matrix.type=="adjacency")) matrix.type<-"edgelist" if(is.hyper(x)) matrix.type<-"incidence" cat("\n",matrix.type,"matrix:\n") if(network.edgecount(x)>0){ mat<-as.matrix.network(x,matrix.type=matrix.type) attr(mat,"n")<-NULL #Get rid of any extra attributes attr(mat,"vnames")<-NULL attr(mat,"bipartite")<-NULL print(mat) }else cat("Empty Graph\n") } invisible(x) } #Print method for summary.character print.summary.character <- function(x, max.print=10, ...){ x<-table(x) nam<-names(x) x<-as.vector(x) names(x)<-nam if(length(x) <= max.print){ print(x) }else{ ord<-order(as.vector(x),decreasing=TRUE) cat(paste(" the ",max.print," most common values are:\n",sep="")) print(x[ord][1:max.print]) } invisible(x) } #Print method for summary.network #' @export print.summary.network #' @export print.summary.network<-function(x, ...){ #Pull any extra goodies from summary.network (stored in gal) na.omit<-x%n%"summary.na.omit" mixingmatrices<-x%n%"summary.mixingmatrices" print.adj<-x%n%"summary.print.adj" #Print the network-level attributes class(x)<-"network" cat("Network attributes:\n") for(i in 1:length(x$gal)){ if (names(x$gal)[i]=="n"){ attributeName<-"vertices" attributeValue<-x$gal[[i]] } else { attributeName<-names(x$gal)[i] attributeValue<-x$gal[[i]] } if(!(attributeName%in%c("mnext","summary.na.omit", "summary.mixingmatrices","summary.print.adj"))){ if(is.network(attributeValue)){ if(attributeName=="design"){ cat(" ",attributeName,"=\n") cat(" total missing = ",network.edgecount(attributeValue),"\n", sep="") cat(" percent missing =",network.density(attributeValue),"\n", sep="") }else{ cat(" ",attributeName,"=\n") print(attributeValue) } }else{ if(is.discrete(attributeValue)){ assign(paste(" ",attributeName),attributeValue) print(table(get(paste(" ",attributeName)))) if(mixingmatrices){ cat("\n","mixing matrix for ",attributeName,":\n",sep="") print(mixingmatrix(x,attributeName)) } }else{ if(inherits(attributeValue,c("factor","character","numeric", "logical","integer","double","call","formula"))&& (length(attributeValue) < 10)){ if(is.call(attributeValue)) attributeValue <- deparse(attributeValue) cat(" ",attributeName," = ",attributeValue,"\n",sep="") }else{ cat(" ",attributeName,":\n", sep="") if(is.call(attributeValue)){ print(attributeValue) }else{ print(summary(attributeValue)) } } } } } } cat(" total edges =",network.edgecount(x,na.omit=FALSE),"\n") cat(" missing edges =",network.naedgecount(x),"\n") cat(" non-missing edges =",network.edgecount(x,na.omit=TRUE),"\n") cat(" density =",network.density(x),"\n") #Print the network-level attributes van<-list.vertex.attributes(x) if(na.omit){ van<-van[van!="na"] } if(length(van)==0){ cat("\n","No vertex attributes","\n",sep="") }else{ cat("\nVertex attributes:\n") for (i in (1:length(van))){ if(van[i]=="vertex.names"){ cat(" vertex.names:\n") cat(" character valued attribute\n") cat(" ",sum(!is.na(network.vertex.names(x)))," valid vertex names\n",sep="") }else{ cat("\n ",van[i],":\n",sep="") aaval<-get.vertex.attribute(x,van[i],unlist=FALSE) aaclass<-unique(sapply(aaval,class)) aaclass<-aaclass[aaclass!="NULL"] if(length(aaclass)>1){ cat(" mixed class attribute\n") cat(" ",sum(!sapply(aaval,is.null)),"values\n") }else if(aaclass%in%c("logical","numeric","character","list")){ cat(" ",aaclass," valued attribute\n",sep="") aalen<-sapply(aaval,length) if(all(aalen<=1)&&(aaclass!="list")){ cat(" attribute summary:\n") print(summary(unlist(aaval))) if(is.discrete(unlist(aaval))&&mixingmatrices){ cat(" mixing matrix:\n") print(mixingmatrix(x,van[i])) } }else{ cat(" uneven attribute lengths; length distribution is\n") print(table(aalen)) } }else{ cat(" ",aaclass," valued attribute\n",sep="") cat(" ",length(aaval)," values\n",sep="") } } } } #Print the edge-level attributes ean <- list.edge.attributes(x) if(na.omit){ ean<-ean[ean!="na"] } if(length(ean)==0){ cat("\n","No edge attributes","\n",sep="") }else{ cat("\nEdge attributes:\n") for (i in (1:length(ean))){ cat("\n ",ean[i],":\n",sep="") eaval<-get.edge.attribute(x$mel,ean[i],unlist=FALSE) eaclass<-unique(sapply(eaval,class)) eaclass<-eaclass[eaclass!="NULL"] if(length(eaclass)>1){ cat(" mixed class attribute\n") cat(" ",sum(!sapply(eaval,is.null)),"values\n") }else if(eaclass%in%c("logical","numeric","character","list")){ cat(" ",eaclass," valued attribute\n",sep="") ealen<-sapply(eaval,length) if(all(ealen<=1)&&(eaclass!="list")){ cat(" attribute summary:\n") print(summary(unlist(eaval))) }else{ cat(" uneven attribute lengths; length distribution is\n") print(table(ealen)) } }else{ cat(" ",eaclass," valued attribute\n",sep="") cat(" ",length(eaval),"values\n",sep="") } } } #Print the adjacency structure if(print.adj){ matrix.type=which.matrix.type(x) if(is.multiplex(x)&&(matrix.type=="adjacency")) matrix.type<-"edgelist" if(is.hyper(x)) matrix.type<-"incidence" cat("\nNetwork ",matrix.type," matrix:\n",sep="") if(network.edgecount(x)>0){ mat<-as.matrix.network(x,matrix.type=matrix.type) attr(mat,"n")<-NULL #Get rid of any extra attributes attr(mat,"vnames")<-NULL attr(mat,"bipartite")<-NULL print(mat) }else cat("Empty Graph\n") } invisible(x) } #An internal routine to handle summaries of characters summary.character <- function(object, ...){ class(object)<-c("summary.character",class(object)) object } # Summaries of network objects # #' @rdname network #' @export summary.network #' @export summary.network<-function(object, na.omit=TRUE, mixingmatrices=FALSE, print.adj=TRUE, ...){ #Add printing parameters as network objects, and change the class object%n%"summary.na.omit"<-na.omit object%n%"summary.mixingmatrices"<-mixingmatrices object%n%"summary.print.adj"<-print.adj class(object)<-c("summary.network", class(object)) #Return the object object } network/R/fileio.R0000644000176200001440000015214614724032651013553 0ustar liggesusers###################################################################### # # fileio.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 11/26/19 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various routines related to reading/writing network # objects from external files. # # Contents: # # read.paj # read.paj.simplify # readAndVectorizeLine # switchArcDirection # ###################################################################### #Read an input file in Pajek format # some details at http://vlado.fmf.uni-lj.si/pub/networks/pajek/doc/pajekman.pdf p. 73 # generally this steps through the file until it finds markers for specific sub sections # when it sees one ('*Vertices*') it drops into a sub-loop that keeps advancing the file read # however, note that the overall loop may run multiple times in order to correctly detect all of the pieces in the file # things are made more complicated becaue there can be multiple *Edges or *Arcs definitions in a network # when it is a "mutliple network" (multiplex) http://vlado.fmf.uni-lj.si/pub/networks/doc/ECPR/08/ECPR01.pdf slide 21 # TODO: not sure if multiplex is set appropriately for this case # Also, attributes can be have 'default' values (the previous record) if not explicitly set on each row # TODO: need an argument to indicate if multiple sets of relations on the same vertex set should be returned # as a multiplex network or a list of networks. #' Read a Pajek Project or Network File and Convert to an R 'Network' Object #' #' Return a (list of) \code{\link{network}} object(s) after reading a #' corresponding .net or .paj file. The code accepts ragged array edgelists, #' but cannot currently handle 2-mode, multirelational (e.g. KEDS), or networks #' with entries for both edges and arcs (e.g. GD-a99m). See \code{network}, #' \code{statnet}, or \code{sna} for more information. #' #' #' If the \code{*Vertices} block includes the optional graphic attributes #' (coordinates, shape, size, etc.) they will be read attached to the network #' as vertex attributes but values will not be interperted (i.e. Pajek's color #' names will not be translated to R color names). Vertex attributes included #' in a \code{*Vector} block will be attached as vertex attributes. #' #' Edges or Arc weights in the \code{*Arcs} or \code{*Edges} block are include #' in the network as an attribute with the same name as the network. If no #' weight is included, a default weight of 1 is used. Optional graphic #' attributes or labels will be attached as edge attributes. #' #' If the file contains an empty \code{Arcs} block, an undirected network will #' be returned. Otherwise the network will be directed, with two edges (one in #' each direction) added for every row in the \code{*Edges} block. #' #' If the \code{*Vertices}, \code{*Arcs} or \code{*Edges} blocks having timing #' information included in the rows (indicated by `...` tokens), it will be #' attached to the vertices with behavior determined by the \code{time.format} #' option. If the \code{'networkDynamic'} format is used, times will be #' translated to \code{networkDynamic}'s spell model with the assumtion that #' the original Pajek representation was indicating discrete time chunks. For #' example \code{"[5-10]"} will become the spell \code{[5,11]}, \code{"[2-*]"} #' will become \code{[2,Inf]} and \code{"[7]"} will become \code{[7,8]}. See #' documentation for \code{networkDynamic}'s \code{?activity.attribute} for #' details. #' #' The \code{*Arcslist}, \code{*Edgelist} and \code{*Events} blocks are not yet #' supported. #' #' As there is no known single complete specification for the file format, #' parsing behavior has been infered from references and examples below. #' #' @aliases read.paj.simplify switchArcDirection readAndVectorizeLine #' @param file the name of the file whence the data are to be read. If it does #' not contain an absolute path, the file name is relative to the current #' working directory (as returned by \code{\link{getwd}}). \code{file} can #' also be a complete URL. #' @param verbose logical: Should longer descriptions of the reading and #' coercion process be printed out? #' @param debug logical: Should very detailed descriptions of the reading and #' coercion process be printed out? This is typically used to debug the reading #' of files that are corrupted on coercion. #' @param edge.name optional name for the edge variable read from the file. The #' default is to use the value in the project file if found. #' @param simplify Should the returned network be simplified as much as #' possible and saved? The values specifies the name of the file which the data #' are to be stored. If it does not contain an absolute path, the file name is #' relative to the current working directory (see \code{\link{getwd}}). If #' \code{specify} is TRUE the file name is the name \code{file}. #' @param time.format if the network has timing information attached to #' edges/vertices, how should it be processed? \code{'pajekTiming'} will #' attach the timing information unchanged in an attribute named #' \code{pajek.timing}. \code{'networkDynamic'} will translate it to a spell #' matrix format, attach it as an \code{'activity'} attribute and add the class #' \code{'networkDynamic'} -- formating it for use by the \code{networkDynamic} #' package. #' @return The structure of the object returned by \code{read.paj} depends on #' the contents of the file it parses. \itemize{ \item if input file contains #' information about a single 'network' object (i.e .net input file) a single #' network object is returned with attribute data set appropriately if #' possible. or a list of networks (for .paj input). \item if input file #' contains multiple sets of relations for a single network, a list of network #' objects ('network.series') is returned, along with a formula object?. \item #' if input .paj file contains additional information (like partition #' information), or multiple \code{*Network} definitions a two element list is #' returned. The first element is a list of all the network objects created, #' and the second is a list of partitions, etc. (how are these matched up) } #' @author Dave Schruth \email{dschruth@@u.washington.edu}, Mark S. Handcock #' \email{handcock@@stat.washington.edu} (with additional input from Alex #' Montgomery \email{ahm@@reed.edu}), Skye Bender-deMoll #' \email{skyebend@@uw.edu} #' @seealso \code{\link{network}} #' @references Batagelj, Vladimir and Mrvar, Andrej (2011) Pajek Reference #' Manual version 2.05 #' \url{http://web.archive.org/web/20240906013709/http://vlado.fmf.uni-lj.si/pub/networks/pajek/doc/pajekman.pdf} Section #' 5.3 pp 73-79 #' #' Batageli, Vladimir (2008) "Network Analysis Description of Networks" #' \url{http://web.archive.org/web/20240511173536/http://vlado.fmf.uni-lj.si/pub/networks/doc/ECPR/08/ECPR01.pdf} #' #' Pajek Datasets \url{http://web.archive.org/web/20240411203537/http://vlado.fmf.uni-lj.si/pub/networks/data/esna} #' @keywords datasets #' @examples #' #' \dontrun{ #' require(network) #' #' par(mfrow=c(2,2)) #' #' test.net.1 <- read.paj("http://vlado.fmf.uni-lj.si/pub/networks/data/GD/gd98/A98.net") #' plot(test.net.1,main=test.net.1%n%'title') #' #' test.net.2 <- read.paj("http://vlado.fmf.uni-lj.si/pub/networks/data/mix/USAir97.net") #' # plot using coordinates from the file in the file #' plot(test.net.2,main=test.net.2%n%'title', #' coord=cbind(test.net.2%v%'x', #' test.net.2%v%'y'), #' jitter=FALSE) #' #' # read .paj project file #' # notice output has $networks and $partitions #' read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Tina.paj') #' } #' #' @export read.paj read.paj <- function(file,verbose=FALSE,debug=FALSE, edge.name=NULL, simplify=FALSE,time.format=c('pajekTiming','networkDynamic')) { time.format<-match.arg(time.format) # process filename if(inherits(file, "connection")){ fileNameParts0 <- strsplit(summary(file)$'description',"/")[[1]] } else { fileNameParts0<-strsplit(file,"/")[[1]] } # split again to try to get file extension fileNameParts1 <- strsplit(fileNameParts0[length(fileNameParts0)],"\\.")[[1]] # filename may not have extension if(length(fileNameParts1)>1){ fileName <- paste(fileNameParts1[1:length(fileNameParts1)-1],collapse=".") fileExt <- fileNameParts1[length(fileNameParts1)] #should be "net" or "paj" (but never used ?) } else { fileName<-fileNameParts1 fileExt<-"" } # open connection (if it is not one already) if (is.character(file)) { file <- file(file, "rt") on.exit(close(file)) } if (!inherits(file, "connection")) stop("argument 'file' must be a character string or connection") if (!isOpen(file)) { open(file, "rt") on.exit(close(file)) } isSeekable <- regexpr("http",file)>0 # also disable seeking if a gz connection, as it will break if(summary(file)$'class'=='unz'){ isSeekable<-FALSE } # initialize state tracking variables lineNumber<-0 # input line number parsed for debugging nnetworks <- 0 # number of networks (edge types) in current *Network block network.names <- NULL # names of networks (edge types) in current *Network block vertex <- NULL # has the vertex block been found? nvertex <- 0 # number of vertices in currently processing network network.title <- fileName # default name for network is filename partition <- NULL # partitions, if found names.partition <- NULL # names of partitions, if found vector <- NULL # vectors, if found colnames.vector <- NULL # names of vectors if found projects <- list() # projects if found (each set of related networks is a 'project') nprojects <- 0 # number of projects found names.projects <- NULL # names of projects if found. nextline <- TRUE # control flag to indicate if should proceede to next line line <- " " # usually tokens corresponding to line being red previousArcs<-NULL previousEdges<-NULL edgeData<-NULL is2mode <- FALSE # flag indicating if currently processing biparite network nevents <- 0 # for two-mode data, size of first mode nactors <- 0 # for two-mode data, size of second mode multiplex<-FALSE # flag indicating if currently processing multiplex network loops<-FALSE # begin file parsing while(!inherits(line,"try-error")){ while(any(grep("^%", line)) | nextline){ if(debug) print(paste("new parsing loop started at line",lineNumber)) options(show.error.messages=FALSE) # read the next line with error messages disabled line <- try(readLines(file, 1, ok = FALSE)) options(show.error.messages=TRUE) # If the line was not an error, tokenize using space as seperator if(!inherits(line,"try-error") & length(line)>0){ line <- strsplit(line, " ")[[1]] line <- line[line!=""] lineNumber<-lineNumber+1 } nextline <- FALSE # there was an error (probably end of file) so don't parse anymore } nextline <- TRUE # if(verbose) warning(paste("afterbeingWhileLoop",line)) # # ---- Network parsing ------- # Search for lines begining with *Network within the .paj file # not all files will include a *Network heading (usually only .paj) # it indicates that all the following sections (vertices, partitions, etc) belong to that network if(any(grep("\\*Network", line, ignore.case = TRUE))){ if (verbose) print(paste('parsing *Network block at line',lineNumber)) if(debug){ print(paste(" nnetworks=",nnetworks)) print(paste(" network.names=",network.names)) print(paste(" vertex null?",is.null(vertex))) print(paste(" network.title=",network.title)) print(paste(" vector null?",is.null(vector))) print(paste(" colnames.vector=",colnames.vector)) print(paste(" names.projects=",names(projects))) } if(verbose) print(paste("number of networks",nnetworks)) #dschruth added # we are about to start a new network, so need to run the post-processing # code on the previously parsed network (if there is one) if(nnetworks > 0 ){ if(debug) print("assembleing networks into 'project'") # grab all the named networks from the environment # and put 'em in a list networksData<-lapply(network.names,function(netName){get(netName)}) # TODO: delete networks from environment to clear up space? # take the various objects that have been parsed from the .paj file and assemble # them into a network object (or list of network objects, a 'project'), doing some appropriate conversion projects <- postProcessProject( network.title, vector, colnames.vector, vertex, # data for building vertices, edgeData, nnetworks, # number of networks found, network.names, # names of networks found networksData, projects, time.format, verbose ) } else { # networks have not been created, but need to check if only vertices have been found and empty network needed if(!is.null(vertex)){ # need to initialize a network here to deal with the case where no arcs/edge in the file # Note that without the arcs/edge, we have no way to know if network was supposed to be directed or multiplex networksData<-list( network.initialize(n=nvertex, bipartite=nactors)) projects <- postProcessProject( network.title, vector, colnames.vector, vertex, # data for building vertices, edgeData, nnetworks, # number of networks found, network.names=network.title, # names of networks found networksData, projects, time.format, verbose) } } # since we are starting a new network, reset all of the network level info, directed, 2mode, etc network.title <-NULL network.names <- NULL vertex<-NULL nvertex<-0 nnetworks <- 0 vector <- NULL colnames.vector <- NULL nextline <- TRUE arcsLinePresent<-FALSE edgesLinePresent<-FALSE previousArcs<-NULL previousEdges<-NULL is2mode <- FALSE #for two-mode data nevents <- 0 #for two-mode data nactors <- 0 #for two-mode data multiplex<-FALSE loops<-FALSE # now parse the new network title network.title <- paste(line[-1],collapse=" ") if(is.null(network.title)){ network.title <- network.name # this seems wrong, should be file name? warning('no name found for network, using "',network.name,'"') } } # END NETWORK PARSING BLOCK # # vertices specification # search for lines beignning with *Vertices # and then read in the number of lines equal to the expected number of vertices if(any(grep("\\*Vertices", line, ignore.case = TRUE))){ if (verbose) print(paste('parsing *Vertices block at line',lineNumber)) previousArcs <- NULL #used for arc+edge specified networks.... reset to null for every new network.. might be sufficient here previousEdges<-NULL nvertex <- as.numeric(line[2]) # parse the number of vertices #nnetworks <- nnetworks + 1 # if we found vertices, we must have a network # give the network a default name (may be overwritten later) network.name <- paste(network.title,sep="") if(!is.na(line[3])){ #dschruth added for two-mode is2mode <- TRUE #used in matrix below #dschruth added for two-mode nactors <- as.numeric(line[3]) #used for error check #dschruth added for two-mode nevents <- nvertex-nactors #used for error check #dschruth added for two-mode } #dschruth added for two-mode if(isSeekable){ # cache the table position in the input file in case we need to jump pack here later preReadTablePosition <- seek(file,where=NA) } # if(network.title =="SanJuanSur_deathmessage.net") #read.third paragraph in details of documentation of read table about how it determines the number of columns in the first 5 lines... # vertex <- read.table(file,skip=-1,nrows=nvertex,col.names=1:8,comment.char="%",fill=TRUE,as.is=FALSE) #dschruth added 'comment.char="%"' and 'fill=TRUE' # else # read it as table # NOTE: rows may omit values () vertex <- read.table(file,skip=-1,nrows=nvertex, comment.char="%",fill=TRUE,as.is=FALSE,row.names=NULL) if(ncol(vertex)==1){ vertex <- cbind(1:nrow(vertex),vertex)} #need to check to see if we are reading in more vertex rows than there actually are (some edges are implied) edgelistPosition <- grep("\\*(arcs|edges|matrix)",as.matrix(vertex),ignore.case=TRUE, useBytes = TRUE) if(any(edgelistPosition)){ if(verbose){ print("vertex list has missing entries or n was mis-specified, re-reading it...") } else { warning('vertex list has missing entries or n was mis-specified, re-reading it...') } if(!isSeekable) stop("Resize of abbreviated vertex list via seek is not possible with URLs. Try downloading file and loading locally") nVertexRows <- edgelistPosition-1 dummyNotUsed <- seek(file,where=preReadTablePosition) #reset the file position back to before the table was read vertex <- read.table(file,skip=-1,nrows=nVertexRows,comment.char="%",fill=TRUE,as.is=FALSE,) #dschruth added 'comment.char="%"' and 'fill=TRUE' if(ncol(vertex)==1){ vertex <- cbind(1:nrow(vertex),vertex)} } if(nvertex!=nrow(vertex)){ if(verbose){ print(paste("vertex list (length=",nrow(vertex),") is being re-sized to conform with specified network size (n=",nvertex,")",sep="")) } colnames(vertex)[1:2] <- c("vn","name") vertex <- merge(data.frame(vn=1:nvertex),vertex,all.x=TRUE,all.y=FALSE,by.y="vn") #fill in the holes with NA names } # increment the debugging line counter lineNumber<-lineNumber+nvertex if(verbose) print(paste(" found",nvertex,'vertices')) } # end vertices parsing block # # partition specification (vertex level attribute) # if(any(grep("\\*Partition", line, ignore.case = TRUE))){ if (verbose) print(paste('parsing *Partition block at line',lineNumber)) partition.name <- as.character(paste(line[-1],collapse=".")) names.partition <- c(names.partition,partition.name) line <- readAndVectorizeLine(file) lineNumber<-lineNumber+1 # update debugging line number # skip comments while(any(grep("^%", line))){ line <- readAndVectorizeLine(file) lineNumber<-lineNumber+1 # update debugging line number } nvertex <- as.numeric(line[2]) if(is.null(partition)){ partition <- read.table(file,skip=0,nrows=nvertex) lineNumber<-lineNumber+nvertex # update debugging line number }else{ partition <- c(partition, read.table(file,skip=0,nrows=nvertex)) lineNumber<-lineNumber+nvertex # update debugging line number } if(verbose) print("partition found and set") # TODO: why is partition not attached as vertex attribute? } # # ----- Vector specification (vetex-level attribute) ----- # if(any(grep("\\*Vector", line, ignore.case = TRUE))){ if (verbose) print(paste('parsing *Vector block at line',lineNumber)) vector.name <- as.character(paste(line[-1],collapse=".")) colnames.vector <- c(colnames.vector,vector.name) line <- readAndVectorizeLine(file) lineNumber<-lineNumber+1 # update debugging line number # skip comments while(any(grep("^%", line))){ line <- readAndVectorizeLine(file) lineNumber<-lineNumber+1 # update debugging line number } nvertex <- as.numeric(line[2]) if(is.null(vector)){ vector <- read.table(file,skip=0,nrows=nvertex) lineNumber<-lineNumber+nvertex # update debugging line number }else{ vector <- data.frame(vector, read.table(file,skip=0,nrows=nvertex)) lineNumber<-lineNumber+nvertex # update debugging line number } if(verbose) print("vector found and set") } # # ----- arcs / edges specification -------- # arcsLinePresent<-any(grep("\\*Arcs$", line, ignore.case = TRUE)) edgesLinePresent<-any(grep("\\*Edges$", line, ignore.case = TRUE)) if(arcsLinePresent | edgesLinePresent){ if(arcsLinePresent){ if(verbose) print(paste("parsing *Arcs block at line",lineNumber)) # if we had already parsed an arcs block, and we just found another one, better clear the old if(!is.null(previousArcs)){ previousArcs<-NULL } } else { if(verbose) print(paste("parsing *Edges block at line",lineNumber)) # if we had already parsed an edges block, and we just found another one, better clear the old if(!is.null(previousEdges)){ previousEdges<-NULL } } if(missing(edge.name)){ if(length(line)>1){ # this *Arcs / *Edges block is definding a named 'network' of relationships network.name <- strsplit(paste(line[3:length(line)],collapse="."),'\"')[[1]][2] #dschruth added collapse to allow for multi work network names #Note: don't increment the number of networks found until later, because this is executed for both arcs and edges block }else{ # append an index to the network name (to be used as edge attribute) only if we've seen multiple networks network.name <- paste(network.title,ifelse(nnetworks>0,nnetworks,''),sep="") #network.name <- network.title #old way } }else{ # define the network name as the edge name passed in by user # TODO: seems like if user passes in edge.name, multirelational edges will not be parsed correctly # because they will be given the same name network.name <- edge.name } dyadList <- list() #dschruth changed (was NULL) listIndex <- 1 #dschruth added line <- readAndVectorizeLine(file) lineNumber<-lineNumber+1 # update debugging line number # skip comments / blank lines while(any(grep("^%", line))){ line <- readAndVectorizeLine(file) lineNumber<-lineNumber+1 # update debugging line number } # keep reading lines until reaching the end of the block while(!any(grep("\\*[a-zA-Z]", line)) & length(line)>0){ #dschruth changed \\* to \\*[a-zA-Z] to allow for time asterisks # check line length for parse problems # should be fromId,toId, weight # if there are not 3, matrix reform will go bad later on if(length(line)<2){ stop("Arc/Edge record on line ",lineNumber," does not appear to have the required 2 elements:'",paste(line,collapse=' '),"'") } dyadList[[listIndex]] <- gsub("Newline","",line) # replace any newlines line <- readAndVectorizeLine(file) lineNumber<-lineNumber+1 # update debugging line number listIndex <- listIndex+1 } if(verbose) print(paste(" length of dyad list",length(dyadList))) nextline <- FALSE # check if we found any dyads if(length(dyadList)>0){ ### deal with the possible Ragged Array [RA] dyad list .. see Lederberg.net ### #TODO: I think this was for dealing with *arcslist / *edgelist, move to seperate section or do detection directly RAlengths <- unlist(lapply(dyadList,length)) maxRAwidth <- max(RAlengths) # TODO: this is an ugly error-prone way to check if there are attributes, need to fix # dyadsHaveAttributes <- any(is.na(as.numeric(unlist(dyadList)))) # handling edge attributes (NAs introduced by coersion) # if(dyadsHaveAttributes){ # warning(paste("don't worry about these",length(dyadList),"warnings,the dyads have attributes and were NA'ed during as.numeric() call. \n the actual dyad matrix width is only 2 ")) # } # # if(maxRAwidth > 4 & !dyadsHaveAttributes){# #needs to be 4 because of normal edgelist can have sender reciever weight and time # if(verbose)print(" stacking ragged dyad array ") # dyads0 <- unlist(lapply(dyadList, function(x) c(x, rep(NA, maxRAwidth - length(x))))) # dyads1 <- data.frame(matrix(dyads0,nrow=length(dyadList),ncol=maxRAwidth,byrow=TRUE)) # # colnames(dyads1) <- c("sender","receiver",paste("r",seq(3,maxRAwidth),sep="")) # # dyads2 <- reshape(dyads1,idvar="senderNo",ids=row.names(dyads1),direction="long", # times=names(dyads1)[-1],timevar="receiverNo", # varying=list(names(dyads1)[-1])) # # dyads <- as.matrix(dyads2[!is.na(dyads2$receiver),c("sender","receiver")]) # # if(verbose)print("finished stacking ragged dyad array") # }else{ # not a ragged array ### done dealing with RA possiblity ### all written by dschruth if(debug) print(" unlisting dyad list to matrix") # check if weight was ommited if (all(RAlengths==2)){ # assume default weight of 1 # convert to data.frame by first unlisting and dumping into 3 col matrix edgeData <- as.data.frame(stringsAsFactors=TRUE,matrix(unlist(lapply(dyadList,function(x){ c(as.numeric(x[1:2]),1)})), nrow=length(dyadList),ncol=3,byrow=TRUE)) if(verbose) print('weights ommited from arcs/edges lines, assuming weight of 1') } else { # create a data frame from the (possibly ragged) rows of the dyadList edgeData<-as.data.frame(stringsAsFactors=TRUE,fillMatrixFromListRows(dyadList)) # convert to appropriate class, have to convert to character first because it is a factor and NA will be recoded wrong edgeData[,1]<-as.numeric(as.character(edgeData[,1])) edgeData[,2]<-as.numeric(as.character(edgeData[,2])) edgeData[,3]<-as.numeric(as.character(edgeData[,3])) } # } # version with just first two columns to make checking easier dyads<-cbind(edgeData[,1:2]) # check for non-numeric ids (bad coercion) if(any(is.na(dyads))){ badRows<-lineNumber-(which(is.na(dyads),arr.ind=TRUE)[,1]) stop('vertex id columns in arcs/edges definition contains non-numeric or NA values on line(s) ',paste(badRows,collapse=' ')) } # check for non-integer vertex ids if(any(round(dyads)!=dyads)){ badRows<-lineNumber-(which(round(dyads)!=dyads,arr.ind=TRUE)[,1]) stop('vertex id columns in arcs/edges definition contains non-integer values on line(s) ',paste(badRows,collapse=' ')) } # check for out of range vertex ids if((max(dyads) > nvertex)){ # nrow(dyads)==1 is for C95.net # figure out which rows are bad badRows<-1+lineNumber-(which(dyads > nvertex,arr.ind=TRUE)[,1]) stop("vertex id(s) in arcs/edge definition is out of range on line(s) ",paste(badRows,collapse=' ')) #if(verbose) print("first dyad list (arcs?), is too short to be a full network, skipping to next dyad list (edges?)") } if(is.null(previousArcs) & is.null(previousEdges)){ #first time through (always an arc list?) # definitly creating a network, so increment the counter and names nnetworks <- nnetworks + 1 network.names <- c(network.names, network.name) if(arcsLinePresent){ directed <- TRUE previousArcs <- edgeData } else { previousEdges <- edgeData # there must not be an arcs block, so assume undirected directed <-FALSE } }else{ #second time through (always an edge list?) if(verbose) print(paste("previous dyads exist!! symmetrizing edges and combining with arcs")) if(edgesLinePresent){ # should only be edges edgeData.flipped <- switchArcDirection(edgeData) edgeData <- rbind(previousArcs,edgeData,edgeData.flipped) # TODO: what if arcs and edges don't have same number of cols }else{ stop('reached sequence of multiple *Arcs blocks, parsing code must have bad logic') } previousArcs <- NULL # we've used 'em, so null it out } # check for multiple ties repeatLines<-anyDuplicated(dyads) if(repeatLines>0){ multiplex<-TRUE if(verbose) print('network contains duplicated dyads so will be marked as multiplex') } # check for self-loops loopLines<-which(dyads[,1]==dyads[,2]) if (length(loopLines)>0){ loops<-TRUE if(verbose) print('network contains self-loop edges so will be marked as such') } ## initialize the appropriate type of network # NOTE: network creation occurs TWICE for networks with both arcs and edges, but the first network # is overwritten by the second. Needlessly slow on large nets, but difficult to avoid, since # we don't know if there is a 2nd block on the first pass if(is2mode){ temp <- network.initialize(n=nvertex, directed=directed, bipartite=nactors,multiple=multiplex,loops=loops) }else{ temp <- network.initialize(n=nvertex, directed=directed,multiple=multiplex,loops=loops) } # add in the edges add.edges(temp,tail=edgeData[,1],head=edgeData[,2]) # temp <- network(x=dyads[,1:2],directed=directed)#arcsLinePresent)#dschruth added if(ncol(edgeData)>2){ #only try to set the edge value if there is a third column (there always is?) temp <- set.edge.attribute(temp,network.names[nnetworks], edgeData[,3]) if(verbose) print(paste(" edge weight attribute named",network.names[nnetworks],"created from edge/arc list")) } assign(network.names[nnetworks], temp) rm(temp) if(verbose) print("network created from edge/arc list") # if(arcsLinePresent) nextline <- TRUE #{ print(" 'arcs' line followed by dyads present... skip past the current 'edges' line");} # end of edge/arc adding } } # # ----- matrix parsing ------- # if(any(grep("\\*Matrix", line, ignore.case = TRUE))){ if(verbose) print(paste('parsing *Matrix block at line',lineNumber)) if(length(line)>1){ # if a network name is given, use that network.name <- strsplit(line[3],'\"')[[1]][2] }else{ # otherwise name it acoding to the file name, adding a digit if we've seen multiple nets #network.name <- paste("network",nnetworks+1,sep="") network.name <- paste(network.title,ifelse(nnetworks>0,nnetworks,''),sep="") } nnetworks <- nnetworks + 1 network.names <- c(network.names, network.name) temp0 <- as.matrix(read.table(file,skip=0,nrows=nvertex,as.is=TRUE)) lineNumber<-lineNumber+nvertex lastColNum <- ncol(temp0) if(all(apply(temp0[,-lastColNum],1,sum)==temp0[,lastColNum])){ if(verbose) print("removing final marginal sum column of matrix") temp0 <- temp0[,-lastColNum] } if(verbose) print(paste(" matrix dimensions: dim1",dim(temp0)[1],"na",nactors,"dim2",dim(temp0)[2],"ne",nevents)) #checking if(is2mode & (dim(temp0)[1]!=nactors | dim(temp0)[2]!=nevents)){ stop("dimensions do not match bipartite specifications") }else{ # check for self-loops loops<- # convert the adjacency matrix to a network, using values as an edge attribute temp <- as.network.matrix(x=temp0, matrix.type='adjacency', bipartite=is2mode, #dschruth added "bipartate=is2mode" for two-mode ignore.eval=FALSE, names.eval=network.name, loops=any(diag(temp0)>0) # check for self-looops ) if(verbose) print("network created from matrix") } assign(network.names[nnetworks], temp) rm(temp) } # detect and report some formats that we cannot yet parse if(any(grep("\\*Arcslist", line, ignore.case = TRUE))){ warning(paste('skipped *Arcslist block at line',lineNumber, ' read.paj does not yet know how to parse it ')) #TODO: see http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/TinaList.net } if(any(grep("\\*Edgeslist", line, ignore.case = TRUE))){ warning(paste('skipped *Edgeslist block at line',lineNumber, ' read.paj does not yet know how to parse it ')) # TODO: see http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/TinaList.net } if(any(grep("\\*Events", line, ignore.case = TRUE))){ stop(paste('found *Events block at line',lineNumber, ' read.paj does not yet know how to parse Event timing format ')) # TODO: see http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Friends.tim } } # end file-parsing while loop if(verbose){ print(paste('End of file reached at line',lineNumber)) } #if(is.null(network.title)) network.title <- network.name if(debug){ print(paste("nnetworks=",nnetworks)) print(paste("network.names=",network.names)) print(paste("vertex null?",is.null(vertex))) print(paste("network.title=",network.title)) print(paste("vector null?",is.null(vector))) print(paste("colnames.vector=",colnames.vector)) print(paste("nprojects=",length(projects))) print(paste("names.projects=",names(projects))) } if(verbose) print(paste("number of networks found:",nnetworks)) #dschruth added # ------------ post-processing -------------------- if(nnetworks > 0){ if(debug) print("assembling networks into 'project' before returning") # grab all the named networks from the environment # and put 'em in a list networksData<-lapply(network.names,function(netName){get(netName)}) # TODO: delete networks from environment to clear up space? # this code takes the various objects that have been parsed from the .paj file and assembles # them into a network object (or list of network objects, a 'project'), doing some appropriate conversion projects <- postProcessProject( network.title, vector, colnames.vector, vertex, # data for building vertices, edgeData, nnetworks, # number of networks found, network.names, # names of networks found networksData, projects, time.format, verbose ) } else { # networks have not been created, but need to check if only vertices have been found if(!is.null(vertex)){ # need to initialize a network here to deal with the case where no arcs/edge in the file # Note that without the arcs/edge, we have no way to know if network was supposed to be directed or multiplex networksData<-list( network.initialize(n=nvertex, bipartite=nactors)) projects <- postProcessProject( network.title, vector, colnames.vector, vertex, # data for building vertices, edgeData=NULL, nnetworks, # number of networks found, network.names = network.title, # names of networks found networksData, projects, time.format, verbose) } } if(is.null(partition)){ if(verbose) print(paste("number of projects",length(projects))) #dschruth added # if there is only one 'project' (network) remove it from the list and return it that way. if(length(projects)==1){ projects <- projects[[1]] } if(nnetworks>1){ if (verbose){ print('appending network objects into a network.series') } class(projects) <- "network.series" } }else{ names(partition) <- names.partition if (verbose){ print('returning projects and partitions as seperate list elements') } projects <- list(networks=projects, partitions=partition) } #end ifelse # # Simplify # if(is.logical(simplify)){ if(simplify){ simplify <- fileName }else{ return(projects) } } read.paj.simplify(x=projects,file=simplify,verbose=verbose) } #end read.paj # this code takes the various objects that have been parsed from the .paj file and assembles # them into a network object (or list of network objects, a 'project'), doing some appropriate conversion # this is called whenever the main parsing loop believes that it has finished with a section of # the .paj file describing a group of networks. # this code is extracted here because it can be called from two different places and must remain identical postProcessProject<-function( network.title, vector, colnames.vector, vertex, # data for building vertices, edgeData, # data for building edges nnetworks, # number of networks found, network.names, # names of networks found networksData, # list of basic networks created projects, time.format, verbose ){ colnames(vector) <- colnames.vector colnames(vertex) <- c("vertex.numbers","vertex.names","cen1","cen2")[1:ncol(vertex)] networks <- vector("list",length=nnetworks) if(verbose) print(paste("processing networks:",paste(network.names,collapse=', '))) for(i in seq(along.with=network.names)){ temp <- networksData[[i]] isDynamic<-FALSE if(!is.null(vertex)){ if (nrow(as.data.frame(stringsAsFactors=TRUE,vertex)) == network.size(temp)) { # set the vertex names to match names in file temp <- set.vertex.attribute(temp, "vertex.names", as.character(vertex[as.numeric(vertex[,1]),2])) if (ncol(vertex)>2) { # number of columns > 2 -> vertex has attributes #vert.attr.nam <- c("na","vertex.names","x","y") #assume first three are coords (true?) vert.attr.nam <- c("na","vertex.names",seq_len(ncol(vertex))) #temp names for rest # verify that coordinates are numeric if(ncol(vertex)>=3 && all(is.numeric(vertex[,3]))){ vert.attr.nam[3] <- 'x' } if(ncol(vertex)>=4 && all(is.numeric(vertex[,4]))){ vert.attr.nam[4] <- 'y' } # check if z coordinate exists and add it if it does if(ncol(vertex)>=5 && all(is.numeric(vertex[,5]))){ vert.attr.nam[5] <- 'z' } # loop over each column of vertex attributes for (vert.attr.i in 3:ncol(vertex)){ v <- vertex[,vert.attr.i] if (is.factor(v)){ # if it's a factor (non-numeric), then vert.attr.nam.tmp <- levels(v)[1] # see if the first factor is an attribute name if (vert.attr.nam.tmp=="") vert.attr.nam.tmp <- levels(v)[2] # in case of missing data if (nlevels(v)<=2&!is.na(match(vert.attr.nam.tmp, # check for match if # factors <=2 c("s_size","x_fact","y_fact","phi","r","q", "ic","bc","bw","lc","la","lr", "lphi","fos","font")))) { #from pajekman.pdf v1.2.3 p.69-70 vert.attr.nam[vert.attr.i+1] <- vert.attr.nam.tmp #if match, name the next column } else { #if not, set the attribute, converting to character (networks incompat w/factors) # if this is the 6th column, assume it is a shape name # but it could be the 5th column if z is missing (ugg, I hate this format!) if('z'%in%vert.attr.nam){ if(vert.attr.i==6 ){ vert.attr.nam[6]<-'shape' } } else { if(vert.attr.i==5 ){ vert.attr.nam[5]<-'shape' } } # spec says missing values should be filled in by row above values<-as.character(vertex[as.numeric(vertex[,1]),vert.attr.i]) missingVals<-which(values=='') while(length(missingVals)>0){ values[min(missingVals)]<-values[min(missingVals)-1] missingVals<-which(values=='') } # special processing: # check if it has brackets for time info, if so added if (length(grep('^\\[.+\\]$',values))>0) { isDynamic<-TRUE # if using pajeck time structure, just assign it if(time.format=='pajekTiming'){ vert.attr.nam[vert.attr.i]<-'pajekTiming' } else if (time.format =='networkDynamic'){ # if using nd, convert to spell matrix and assign as 'active' attribute vert.attr.nam[vert.attr.i]<-'active' values<-lapply(values,as.spells.pajek) } } temp <- set.vertex.attribute(temp,vert.attr.nam[vert.attr.i], values) } } else { #not a factor, set the attribute and don't convert to character temp <- set.vertex.attribute(temp,vert.attr.nam[vert.attr.i], vertex[as.numeric(vertex[,1]),vert.attr.i]) } if (verbose) print(paste(' set vertex attribute',vert.attr.nam[vert.attr.i])) } } } else { stop('number of rows in vertex data does not match number of vertices') } } # end vertex data processing # process edge data if(!is.null(edgeData)){ if (ncol(edgeData)>3) { # number of columns > 3 means dyads have attributes edge.attr.nam <- c("from","to","weight",4:ncol(edgeData)) #temp names for rest # loop over each column of edge attributes for (edge.attr.i in 4:ncol(edgeData)){ e <- edgeData[,edge.attr.i] if (is.factor(e)){ # if it's a factor (non-numeric), then edge.attr.nam.tmp <- levels(e)[1] # see if the first factor is an attribute name if (edge.attr.nam.tmp=="") edge.attr.nam.tmp <- levels(e)[2] # in case of missing data if (nlevels(e)<=2&!is.na(match(edge.attr.nam.tmp, # check for match if # factors <=2 c("w","c","p","s","a","ap","l","lp","lr","lphi","lc","la","fos","font",'h1','h2','a1','k1','k2','a2')))) { edge.attr.nam[edge.attr.i+1] <- edge.attr.nam.tmp #if match, name the next column } else { #if not, set the attribute, converting to character (networks incompat w/factors) # spec says missing values should be filled in by row above values<-as.character(edgeData[,edge.attr.i]) missingVals<-which(values=='') while(length(missingVals)>0){ values[min(missingVals)]<-values[min(missingVals)-1] missingVals<-which(values=='') } # special processing: # if name is 'l' (line label) it needs to have possible enclosing quotes removed # check if it has brackets for time info, if so added if (length(grep('^\\[.+\\]$',values))>0) { isDynamic<-TRUE # if using pajeck time structure, just assign it if(time.format=='pajekTiming'){ edge.attr.nam[edge.attr.i]<-'pajekTiming' } else if (time.format =='networkDynamic'){ # if using nd, convert to spell matrix and assign as 'active' attribute edge.attr.nam[edge.attr.i]<-'active' values<-lapply(values,as.spells.pajek) } } if(edge.attr.nam[edge.attr.i] == 'l'){ values<-gsub('"','',values) } temp <- set.edge.attribute(temp,edge.attr.nam[edge.attr.i], values) } } else { #not a factor, set the attribute and don't convert to character temp <- set.edge.attribute(temp,edge.attr.nam[vert.attr.i], edgeData[,edge.attr.i]) } if (verbose) print(paste(' set edge attribute',edge.attr.nam[edge.attr.i])) } } } # end arc/edge data processing if(!is.null(network.title)){ temp <- set.network.attribute(temp, "title", network.title) # not sure if this should also be the edges relation? }else{ warning("null network title") } if(nrow(as.data.frame(stringsAsFactors=TRUE,vertex))== network.size(temp)){ #should i be doing this? why don't these numbers match all time temp <- set.vertex.attribute(temp,"vertex.names",as.character(vertex[as.numeric(vertex[,1]),2])) } # if it is a dynamic network and we are doing nD format, secretly give it the networkDynamic class if(isDynamic){ if(time.format=='networkDynamic'){ if(verbose) print(" network has dynamics and is assigned 'networkDynamic' class") # using this instead of the safer as.networkDynamic() to avoid adding Suggests dependency on networkDynamic class(temp)<-c('networkDynamic',class(temp)) } else { if(verbose) print(' network has dynamic info which was saved without interpretation. see argument "time.format" for details') } } networks[[i]] <- temp if (verbose) print(paste("processed and added",network.names[i],"to list of networks")) } names(networks) <- network.names if(nnetworks > 1){ networks <- list(formula = ~1, networks = networks, stats = numeric(0),coef=0) class(networks) <- "network.series" } else{ networks <- networks[[1]] } projNames<-names(projects) projects <- c(projects,list(networks)) names(projects) <-c(projNames, network.title) return(projects) } # reads a single line of a file, splits it into tokens on ' ' and returns as string vector readAndVectorizeLine <- function(file){ line <- readLines(file, 1, ok = TRUE) if(!inherits(line,"try-error") & length(line)>0){ line <- strsplit(line," ")[[1]] line <- line[line!=""] } line } read.paj.simplify <- function(x,file,verbose=FALSE) { classx <- class(x) if(inherits(x,"network")){ cat(paste(file," is a single network object.\n",sep="")) assign(file,x) save(list=file, file=paste(file,".RData",sep="")) cat(paste("network saved as a 'network' object in ",file,".RData.\n",sep="")) return(x) } if(inherits(x,"network.series")){ nnets <- length(x$networks) cat(paste(file," is a set of ",nnets," networks on the same set of nodes.\n",sep="")) cat(paste("The network names are:\n ", paste(names(x$networks),collapse="\n "),"\n",sep="")) cnames <- names(x$networks) if(length(cnames) == 1){ assign(cnames,x$networks[[1]]) save(list=cnames, file=paste(file,".RData",sep="")) cat(paste("network simplified to a network object.\n",sep="")) cat(paste("network saved as a 'network' object in ",file,".RData.\n",sep="")) return(x$networks[[1]]) }else{ assign(file,x) save(list=file, file=paste(file,".RData",sep="")) cat(paste("network saved as a 'network.series' object in ",file,".RData.\n",sep="")) return(x) } } if(classx=="list"){ ncollects <- length(x$networks) nnets <- length(x$networks) npart <- length(x$partitions) cnames <- names(x$networks) if(length(cnames) > 1){ cat(paste(file," is a set of ",ncollects," collections of networks\n", "as well as Pajek 'partiton' information.\n",sep="")) cat(paste("The collection names are:\n ", paste(cnames,collapse="\n "),"\n",sep="")) for(i in seq(along.with=cnames)){ thisnet <- x$networks[[i]] classthisnet <- class(thisnet) if(inherits(thisnet,"network.series") & length(thisnet$networks)==1){ thisnet <- thisnet$networks[[1]] classthisnet <- class(thisnet) } if(inherits(thisnet,"network")){ cat(paste("The collection ",cnames[i]," is a single network object.\n", sep="")) }else{ cat(paste("The collection ",cnames[i], " is a set of networks on the same nodes.\n",sep="")) cat(paste("The network names are:\n ", paste(names(thisnet$networks),collapse="\n "),"\n",sep="")) } } cat(paste("There are ",npart," partitions on the networks.\n",sep="")) cat(paste("The partition names are:\n ", paste(names(x$partitions),collapse="\n "),"\n",sep="")) cat(paste(".RData file unchanged.\n",sep="")) }else{ thisnet <- x$networks[[1]] classthisnet <- class(thisnet) if(inherits(thisnet,"network")){ cat(paste(file," is a single network object called ", cnames,"\n", "as well as Pajek 'partiton' information.\n",sep="")) cat(paste("There are ",npart," partitions on the networks.\n",sep="")) cat(paste("The partition names are:\n ", paste(names(x$partitions),collapse="\n "),"\n",sep="")) }else{ cat(paste(file," is a collection of networks called ", cnames,"\n", "as well as Pajek 'partiton' information.\n",sep="")) cat(paste("The network names are:\n ", paste(names(thisnet$networks),collapse="\n "),"\n",sep="")) cat(paste("There are ",npart," partitions on the networks.\n",sep="")) cat(paste("The partition names are:\n ", paste(names(x$partitions),collapse="\n "),"\n",sep="")) } assign(cnames,x$networks[[1]]) assign(paste(cnames,"partitions",sep="."),x$partitions) save(list=c(cnames, paste(cnames,"partitions",sep=".")), file=paste(file,".RData",sep="")) if(inherits(x$networks[[1]],"network")){ cat(paste("network simplified to a 'network' object plus partition.\n",sep="")) cat(paste("network saved as a 'network' object and a separate partition list in ",file,".RData.\n",sep="")) }else{ cat(paste("network simplified to a 'network.series' object plus partition.\n",sep="")) cat(paste("network saved as a 'network.series' object and a separate partition list in ",file,".RData.\n",sep="")) } } } return(x) } # swaps the first two columns (tail, heads) in a matrix switchArcDirection <- function(edgelist){ edgelist[,1:2] <- edgelist[,2:1] edgelist } # return a character matrix with number of rows equal to length of list x # and ncol = longest element in x # assumes that list elements may not be all the same length # each row is filled in fro fillMatrixFromListRows<-function(x){ maxLen<-max(sapply(x,length)) paddedRows<-lapply(x,function(r){ row<-rep('',maxLen) row[1:length(r)]<-unlist(r) row }) return(do.call(rbind,paddedRows)) } # convert strings in pajek's timing notation into a spell matrix # example "[5-10,12-14]", "[1-3,7]", "[4-*]" # does not check spells for correctness of spell definitions as.spells.pajek <-function(pajekTiming,assume.discrete=TRUE){ # strip off brackets p<-gsub('\\[','',pajekTiming) p<-gsub('\\]','',p) # split on comma splStrings<-strsplit(p,',') spls<-sapply(splStrings[[1]],function(s){ # default always active spl<-c(-Inf,Inf) elements<-strsplit(s,'-')[[1]] if(length(elements)==2){ # replace Infs if (elements[1]=='*'){ elements[1]<-'-Inf' } if (elements[2]=='*'){ elements[2]<-'Inf' } # convert to numeric and form spell spl<-c(as.numeric(elements[1]),as.numeric(elements[2])) } else if (length(elements)==1){ # only one element, so duplicate spl[1:2]<-as.numeric(elements[1]) } else { stop('unable to parse token: ',s) } if (assume.discrete){ # add one time unit to the ending value to conform with networkDynamic's 'until' spell definition spl[2]<-spl[2]+1 } return(spl) }) # reshape vector of spell data into a 2-column matrix return(matrix(spls,ncol=2,byrow=TRUE)) } network/R/access.R0000644000176200001440000023660014724557111013546 0ustar liggesusers###################################################################### # # access.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 12/04/24 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various routines for accessing network class objects. # # Contents: # # add.edge # add.edges # add.vertices # delete.edge.attribute # delete.edges # delete.network.attribute # delete.vertex.attribute # delete.vertices # get.edge.attribute # get.edge.value # get.edgeIDs # get.edges # get.inducedSubgraph # get.network.attribute # get.neighborhood # get.vertex.attribute # has.loops # is.adjacent # is.bipartite # is.directed # is.hyper # is.multiplex # is.network # list.edge.attributes # list.network.attributes # list.vertex.attributes # network.dyadcount # network.edgecount # network.naedgecount # network.size # network.vertex.names # network.vertex.names<- # permute.vertexIDs # set.edge.attribute # set.edge.value # set.network.attribute # set.vertex.attribute # valid.eids # ###################################################################### #Add a single edge to a network object. # S3 method dispatch for add edge #' @name add.edges #' #' @title Add Edges to a Network Object #' #' @description Add one or more edges to an existing network object. #' #' @details The edge checking procedure is very slow, but should always be employed when #' debugging; without it, one cannot guarantee that the network state is #' consistent with network level variables (see #' \code{\link{network.indicators}}). For example, by default it is possible to #' add multiple edges to a pair of vertices. #' #' Edges can also be added/removed via the extraction/replacement operators. #' See the associated man page for details. #' #' @aliases add.edges.network add.edge.network #' @param x an object of class \code{network} #' @param tail for \code{add.edge}, a vector of vertex IDs reflecting the tail #' set for the edge to be added; for \code{add.edges}, a list of such vectors #' @param head for \code{add.edge}, a vector of vertex IDs reflecting the head #' set for the edge to be added; for \code{add.edges}, a list of such vectors #' @param names.eval for \code{add.edge}, an optional list of names for edge #' attributes; for \code{add.edges}, a list of length equal to the number of #' edges, with each element containing a list of names for the attributes of #' the corresponding edge #' @param vals.eval for \code{add.edge}, an optional list of edge attribute #' values (matching \code{names.eval}); for \code{add.edges}, a list of such #' lists #' @param edge.check logical; should we perform (computationally expensive) #' tests to check for the legality of submitted edges? #' @param ... additional arguments #' @return Invisibly, \code{add.edge} and \code{add.edges} return pointers to #' their modified arguments; both functions modify their arguments in place.. #' @note \code{add.edges} and \code{add.edge} were converted to an S3 generic #' funtions in version 1.9, so they actually call \code{add.edges.network} and #' \code{add.edge.network} by default, and may call other versions depending on #' context (i.e. when called with a \code{networkDynamic} object). #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network}}, \code{\link{add.vertices}}, #' \code{\link{network.extraction}}, \code{\link{delete.edges}}, #' \code{\link{network.edgelist}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords classes graphs #' @examples #' #' #Initialize a small, empty network #' g<-network.initialize(3) #' #' #Add an edge #' add.edge(g,1,2) #' g #' #' #Can also add edges using the extraction/replacement operators #' #note that replacement operators are much slower than add.edges() #' g[,3]<-1 #' g[,] #' #' #Add multiple edges with attributes to a network #' #' # pretend we just loaded in this data.frame from a file #' # Note: network.edgelist() may be simpler for this case #' elData<-data.frame( #' from_id=c("1","2","3","1","3","1","2"), #' to_id=c("1", "1", "1", "2", "2", "3", "3"), #' myEdgeWeight=c(1, 2, 1, 2, 5, 3, 9.5), #' someLetters=c("B", "W", "L", "Z", "P", "Q", "E"), #' edgeCols=c("red","green","blue","orange","pink","brown","gray"), #' stringsAsFactors=FALSE #' ) #' #' valueNet<-network.initialize(3,loops=TRUE) #' #' add.edges(valueNet,elData[,1],elData[,2], #' names.eval=rep(list(list("myEdgeWeight","someLetters","edgeCols")),nrow(elData)), #' vals.eval=lapply(1:nrow(elData),function(r){as.list(elData[r,3:5])})) #' #' list.edge.attributes(valueNet) #' #' #' @export add.edge <- function(x, tail, head, names.eval=NULL, vals.eval=NULL, edge.check=FALSE, ...) UseMethod("add.edge") #' @export add.edge.network #' @export add.edge.network<-function(x, tail, head, names.eval=NULL, vals.eval=NULL, edge.check=FALSE, ...){ xn<-substitute(x) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } if(is.null(edge.check)||(length(edge.check)<1)||is.na(edge.check[1])) edge.check<-FALSE x<-.Call(addEdge_R,x,tail,head,names.eval,vals.eval,edge.check) invisible(x) } # S3 method dispatch for add.edges #' @rdname add.edges #' @export add.edges add.edges <- function(x, tail, head, names.eval=NULL, vals.eval=NULL, ...) UseMethod("add.edges") # Add multiple edges to network x. Tail must be a list, each element of # which is the tail set for a given edge (ditto for head). If edge values # are provided, they must be given similarly as lists of lists. #' @export add.edges.network #' @export add.edges.network<-function(x, tail, head, names.eval=NULL, vals.eval=NULL, ...){ #Ensure that the inputs are set up appropriately if(!is.list(tail)) tail<-as.list(tail) if(!is.list(head)) head<-as.list(rep(head,length.out=length(tail))) if(is.null(names.eval)) names.eval<-replicate(length(tail),NULL) else if(!is.list(names.eval)) names.eval<-as.list(rep(names.eval,length.out=length(tail))) if(is.null(vals.eval)) vals.eval<-replicate(length(tail),NULL) else if(!is.list(vals.eval)) vals.eval<-as.list(rep(vals.eval,length.out=length(names.eval))) if(length(unique(c(length(tail),length(head),length(names.eval), length(vals.eval))))>1) stop("head, tail, names.eval and vals.eval lists passed to add.edges must be of the same length!\n") edge.check<-list(...)$edge.check if(is.null(edge.check)||(length(edge.check)<1)||is.na(edge.check[1])) edge.check<-FALSE #Pass the inputs to the C side xn<-substitute(x) x<-.Call(addEdges_R,x,tail,head,names.eval,vals.eval,edge.check) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } invisible(x) } # S3 method dispatch for add.vertices #' Add Vertices to an Existing Network #' #' \code{add.vertices} adds a specified number of vertices to an existing #' network; if desired, attributes for the new vertices may be specified as #' well. #' #' New vertices are generally appended to the end of the network (i.e., their #' vertex IDs begin with \code{network.size(x)} an count upward). The one #' exception to this rule is when \code{x} is bipartite and #' \code{last.mode==FALSE}. In this case, new vertices are added to the end of #' the first mode, with existing second-mode vertices being permuted upward in #' ID. (\code{x}'s \code{bipartite} attribute is adjusted accordingly.) #' #' Note that the attribute format used here is based on the internal #' (vertex-wise) storage method, as opposed to the attribute-wise format used #' by \code{\link{network}}. Specifically, \code{vattr} should be a list with #' one entry per new vertex, the ith element of which should be a list with an #' element for every attribute of the ith vertex. (If the required \code{na} #' attribute is not given, it will be automatically created.) #' #' @aliases add.vertices.network #' @param x an object of class \code{network} #' @param nv the number of vertices to add #' @param vattr optionally, a list of attributes with one entry per new vertex #' @param last.mode logical; should the new vertices be added to the last #' (rather than the first) mode of a bipartite network? #' @param ... possible additional arguments to add.vertices #' @return Invisibly, a pointer to the updated \code{network} object; #' \code{add.vertices} modifies its argument in place. #' @note \code{add.vertices} was converted to an S3 generic funtion in version #' 1.9, so it actually calls \code{add.vertices.network} by default and may #' call other versions depending on context (i.e. when called with a #' \code{networkDynamic} object). #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network}}, \code{\link{get.vertex.attribute}}, #' \code{\link{set.vertex.attribute}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords classes graphs #' @examples #' #' #Initialize a network object #' g<-network.initialize(5) #' g #' #' #Add five more vertices #' add.vertices(g,5) #' g #' #' #Create two more, with attributes #' vat<-replicate(2,list(is.added=TRUE,num.added=2),simplify=FALSE) #' add.vertices(g,2,vattr=vat) #' g%v%"is.added" #Values are only present for the new cases #' g%v%"num.added" #' #' #Add to a bipartite network #' bip <-network.initialize(5,bipartite=3) #' get.network.attribute(bip,'bipartite') # how many vertices in first mode? #' add.vertices(bip,3,last.mode=FALSE) #' get.network.attribute(bip,'bipartite') #' #' @export add.vertices add.vertices <- function(x, nv, vattr=NULL, last.mode=TRUE, ...) UseMethod("add.vertices") # Add nv vertices to network x. Vertex attributes (in addition to those which # are required) are to be provided in vattr; vattr must be a list containing # nv elements, each of which is equal to the desired val[i] entry. #' @export add.vertices.network #' @export add.vertices.network<-function(x, nv, vattr=NULL, last.mode=TRUE, ...){ #Check to be sure we were called with a network if(!is.network(x)) stop("add.vertices requires an argument of class network.\n") #Check the vertex attributes, to be sure that they are legal if(!is.null(vattr)){ if(is.list(vattr)) vattr<-rep(vattr,length.out=nv) else vattr<-as.list(rep(vattr,length.out=nv)) } #Perform the addition xn<-substitute(x) if(nv>0){ if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } if(last.mode||(!is.bipartite(x))){ x<-.Call(addVertices_R,x,nv,vattr) }else{ nr<-nv nc<-0 nnew<-nr+nc nold<-network.size(x) bip<-x%n%"bipartite" x<-.Call(addVertices_R, x, nv, vattr) if(nr>0){ if(bip>0) orow<-1:bip else orow<-NULL if(nold-bip>0) ocol<-(bip+1):nold else ocol<-NULL ncol<-NULL nrow<-(nold+nnew-nr+1):(nold+nnew) permute.vertexIDs(x,c(orow,nrow,ocol,ncol)) set.network.attribute(x,"bipartite",bip+nr) } } } invisible(x) } # Remove all instances of the specified attribute(s) from the edge set # #' @name attribute.methods #' #' @title Attribute Interface Methods for the Network Class #' #' @description These methods get, set, list, and delete attributes at the #' network, edge, and vertex level. #' #' @details The \code{list.attributes} functions return the names of all edge, #' network, or vertex attributes (respectively) in the network. All #' attributes need not be defined for all elements; the union of all extant #' attributes for the respective element type is returned. #' #' The \code{get.attribute} functions look for an edge, network, or vertex #' attribute (respectively) with the name \code{attrname}, returning its #' values. Note that, to retrieve an edge attribute from all edges within #' a network \code{x}, \code{x$mel} should be used as the first argument to #' \code{get.edge.attribute}; \code{get.edge.value} is a convenience function #' which does this automatically. As of v1.7.2, if a \code{network} object is #' passed to \code{get.edge.attribute} it will automatically call #' \code{get.edge.value} instead of returning NULL. When the parameters #' \code{na.omit}, or \code{deleted.edges.omit} are used, the position index #' of the attribute values returned will not correspond to the vertex/edge #' id. To preserved backward compatibility, if the edge attribute #' \code{attrname} does not exist for any edge, \code{get.edge.attribute} #' will still return \code{NULL} even if \code{null.na=TRUE} #' #' \code{network.vertex.names} is a convenience function to extract the #' \code{"vertex.names"} attribute from all vertices. #' #' The \code{set.attribute} functions allow one to set the values of edge, #' network, or vertex attributes. \code{set.edge.value} is a convenience #' function which allows edge attributes to be given in adjacency matrix #' form, and the assignment form of \code{network.vertex.names} is likewise #' a convenient front-end to \code{set.vertex.attribute} for vertex names. #' The \code{delete.attribute} functions, by contrast, remove the named #' attribute from the network, from all edges, or from all vertices (as #' appropriate). If \code{attrname} is a vector of attribute names, each #' will be removed in turn. These functions modify their arguments in place, #' although a pointer to the modified object is also (invisibly) returned. #' #' Additional practical example of how to load and attach attributes are on the #' \code{\link{loading.attributes}} page. #' #' Some attribute assignment/extraction can be performed conveniently through #' the various extraction/replacement operators, although they may be less #' efficient. See the associated man page for details. #' #' #' @param x an object of class \code{network}, or a list of edges #' (possibly \code{network$mel}) in \code{get.edge.attribute}. #' @param el Deprecated; use \code{x} instead. #' @param attrname the name of the attribute to get or set. #' @param unlist logical; should retrieved attribute values be #' \code{\link{unlist}}ed prior to being returned? #' @param na.omit logical; should retrieved attribute values corresponding to #' vertices/edges marked as 'missing' be removed? #' @param deleted.edges.omit logical: should the elements corresponding to #' deleted edges be removed? #' @param null.na logical; should \code{NULL} values (corresponding to vertices #' or edges with no values set for the attribute) be replaced with \code{NA}s #' in output? #' @param value values of the attribute to be set; these should be in #' \code{vector} or \code{list} form for the \code{edge} and \code{vertex} #' cases, or \code{matrix} form for \code{set.edge.value}. #' @param e IDs for the edges whose attributes are to be altered. #' @param v IDs for the vertices whose attributes are to be altered. #' @param ... additional arguments #' #' @return For the \code{list.attributes} methods, a vector containing #' attribute names. For the \code{get.attribute} methods, a list containing #' the values of the attribute in question (or simply the value itself, for #' \code{get.network.attribute}). For the \code{set.attribute} and #' \code{delete.attribute} methods, a pointer to the updated \code{network} #' object. #' @note As of version 1.9 the \code{set.vertex.attribute} function can accept #' and modify multiple attributes in a single call to improve efficiency. #' For this case \code{attrname} can be a list or vector of attribute names #' and \code{value} is a list of values corresponding to the elements of #' \code{attrname} (can also be a list of lists of values if elements in v #' should have different values). #' @seealso \code{\link{loading.attributes}},\code{\link{network}}, #' \code{\link{as.network.matrix}}, \code{\link{as.sociomatrix}}, #' \code{\link{as.matrix.network}}, \code{\link{network.extraction}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @author Carter T. Butts \email{buttsc@uci.edu} #' @examples #' #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] #' #' #List the attributes #' list.edge.attributes(g) #' list.network.attributes(g) #' list.vertex.attributes(g) #' #' #Retrieve the attributes #' get.edge.attribute(g$mel,"myeval") #Note the first argument! #' get.edge.value(g,"myeval") #Another way to do this #' get.edge.attribute(g$mel,"myeval2") #' get.network.attribute(g,"mygval") #' get.vertex.attribute(g,"myvval") #' network.vertex.names(g) #' #' #Purge the attributes #' delete.edge.attribute(g,"myeval") #' delete.edge.attribute(g,"myeval2") #' delete.network.attribute(g,"mygval") #' delete.vertex.attribute(g,"myvval") #' #' #Verify that the attributes are gone #' list.edge.attributes(g) #' list.network.attributes(g) #' list.vertex.attributes(g) #' #' #Note that we can do similar things using operators #' g %n% "mygval" <- "boo" #Set attributes, as above #' g %v% "myvval" <- letters[1:3] #' g %e% "myeval" <- mm #' g[,,names.eval="myeval"] <- mm #Another way to do this #' g %n% "mygval" #Retrieve the attributes #' g %v% "myvval" #' g %e% "mevval" #' as.sociomatrix(g,"myeval") # Or like this #' #' @keywords classes graphs #' @export delete.edge.attribute delete.edge.attribute <- function(x, attrname, ...) UseMethod("delete.edge.attribute") #' @rdname attribute.methods #' @export delete.edge.attribute.network <- function(x, attrname, ...) { #Remove the edges xn<-substitute(x) x<-.Call(deleteEdgeAttribute_R,x,attrname) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } invisible(x) } # Remove specified edges from the network. # #' @name deletion.methods #' #' @title Remove Elements from a Network Object #' #' @description \code{delete.edges} removes one or more edges (specified by #' their internal ID numbers) from a network; \code{delete.vertices} #' performs the same task for vertices (removing all associated edges in #' the process). #' #' @details Note that an edge's ID number corresponds to its order within #' \code{x$mel}. To determine edge IDs, see \code{\link{get.edgeIDs}}. #' Likewise, vertex ID numbers reflect the order with which vertices are #' listed internally (e.g., the order of \code{x$oel} and \code{x$iel}, or #' that used by \code{as.matrix.network.adjacency}). When vertices are #' removed from a network, all edges having those vertices as endpoints are #' removed as well. When edges are removed, the remaining edge ids are NOT #' permuted and \code{NULL} elements will be left on the list of edges, which #' may complicate some functions that require eids (such as #' \code{\link{set.edge.attribute}}). The function \code{\link{valid.eids}} #' provides a means to determine the set of valid (non-NULL) edge ids. #' #' Edges can also be added/removed via the extraction/replacement operators. #' See the associated man page for details. #' #' @param x an object of class \code{network}. #' @param eid a vector of edge IDs. #' @param vid a vector of vertex IDs. #' @param ... additional arguments to methods. #' #' @return Invisibly, a pointer to the updated network; these functions modify #' their arguments in place. #' #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @author Carter T. Butts \email{buttsc@uci.edu} #' #' @seealso \code{\link{get.edgeIDs}}, \code{\link{network.extraction}}, #' \code{\link{valid.eids}} #' @examples #' #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) #' #' as.matrix.network(g) #' delete.edges(g,2) #Remove an edge #' as.matrix.network(g) #' delete.vertices(g,2) #Remove a vertex #' as.matrix.network(g) #' #' #Can also remove edges using extraction/replacement operators #' g<-network(m) #' g[1,2]<-0 #Remove an edge #' g[,] #' g[,]<-0 #Remove all edges #' g[,] #' #' @keywords classes graphs #' @export delete.edges <- function(x, eid, ...) UseMethod("delete.edges") #' @rdname deletion.methods #' @export delete.edges.network <- function(x, eid, ...) { xn<-substitute(x) if(length(eid)>0){ #Perform a sanity check if((min(eid)<1)|(max(eid)>length(x$mel))) stop("Illegal edge in delete.edges.\n") #Remove the edges x<-.Call(deleteEdges_R,x,eid) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } } invisible(x) } # Remove the specified network-level attribute(s) # #' @rdname attribute.methods #' @export delete.network.attribute <- function(x, attrname, ...) UseMethod("delete.network.attribute") #' @rdname attribute.methods #' @export delete.network.attribute.network <- function(x, attrname, ...){ #Remove the edges xn<-substitute(x) x<-.Call(deleteNetworkAttribute_R,x,attrname) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } invisible(x) } # Remove all instances of the specified attribute(s) from the vertex set # #' @rdname attribute.methods #' @export delete.vertex.attribute <- function(x, attrname, ...) UseMethod("delete.vertex.attribute") #' @rdname attribute.methods #' @export delete.vertex.attribute.network <- function(x, attrname, ...) { #Remove the attribute (or do nothing, if there are no vertices) if(network.size(x)>0){ xn<-substitute(x) x<-.Call(deleteVertexAttribute_R,x,attrname) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } } invisible(x) } # Remove specified vertices (and associated edges) from the network. # #' @rdname deletion.methods #' @export delete.vertices <- function(x, vid, ...) UseMethod("delete.vertices") #' @rdname deletion.methods #' @export delete.vertices.network <- function(x, vid, ...) { #Remove any vids which are out of bounds vid<-vid[(vid>0)&(vid<=network.size(x))] #Do the deed, if still needed xn<-substitute(x) if(length(vid)>0){ if(is.bipartite(x)){ #If bipartite, might need to adjust mode 1 count m1v<-get.network.attribute(x,"bipartite") #How many mode 1 verts? set.network.attribute(x,"bipartite",m1v-sum(vid<=m1v)) } x<-.Call(deleteVertices_R,x,vid) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } } invisible(x) } # Retrieve a specified edge attribute from edge list or network x. The attribute # is returned as a list, unless unlist is TRUE. # if deleted.edges.omit is TRUE, then only attribute values on existing (non-null) edges will be returned. # if na.omit is TRUE, than values corresponding to 'missing' edges (edges with attribute 'na' set to TRUE) should be ommited. (NULL edgs count as not-missing) # If null.na is TRUE, then values corresponding to edges for which the attribute name was never set will be set to NA. Otherwise, they will be NULL, which means they will be included when unlist=TRUE # #' @rdname attribute.methods #' @export get.edge.attribute <- function(x, ..., el) { if(!missing(el)) { warning("Argument ", sQuote("el"), " to ", sQuote("get.edge.attribute"), " is deprecated and will be removed in a future version. Use ", sQuote("x"), " instead.") UseMethod("get.edge.attribute", object = el) } else { UseMethod("get.edge.attribute", object = x) } } #' @rdname attribute.methods #' @export get.edge.attribute.network <- function(x, attrname, unlist=TRUE, na.omit=FALSE, null.na=FALSE, deleted.edges.omit=FALSE, ..., el) { if(!missing(el)) x <- el if (is.network(x)) x <- x$mel if (!is.list(x)) stop("x must be a network object or a list.") if (!is.character(attrname) || (length(attrname)==0)) stop("attrname must be a character vector.") if (!is.logical(unlist) || !is.logical(na.omit) || !is.logical(null.na) || !is.logical(deleted.edges.omit) || (length(unlist)*length(na.omit)*length(null.na)*length(deleted.edges.omit)==0)) stop("na.omit, null.na, deleted.edges.omit must be a logical vector.") edges <- .Call(getEdgeAttribute_R,x,attrname,na.omit,null.na,deleted.edges.omit) if(unlist) unlist(edges) else edges } #' @rdname attribute.methods #' @export get.edge.attribute.list <- get.edge.attribute.network # Retrieve a specified edge attribute from all edges in x. # #' @rdname attribute.methods #' @export get.edge.value <- function(x, ...) UseMethod("get.edge.value") #' @rdname attribute.methods #' @export get.edge.value.network <- function(x, attrname, unlist=TRUE, na.omit=FALSE, null.na=FALSE, deleted.edges.omit=FALSE, ...){ get.edge.attribute(x,attrname,unlist,na.omit,null.na,deleted.edges.omit) } #' @rdname attribute.methods #' @export get.edge.value.list <- get.edge.value.network # Retrieve the ID numbers for all edges incident on v, in network x. # Outgoing or incoming edges are specified by neighborhood, while na.omit # indicates whether or not missing edges should be omitted. The return value # is a vector of edge IDs. # #' @name get.edges #' #' @title Retrieve Edges or Edge IDs Associated with a Given Vertex #' #' @description \code{get.edges} retrieves a list of edges incident on a given vertex; #' \code{get.edgeIDs} returns the internal identifiers for those edges, #' instead. Both allow edges to be selected based on vertex neighborhood and #' (optionally) an additional endpoint. #' #' @details By default, \code{get.edges} returns all out-, in-, or out- and in-edges #' containing \code{v}. \code{get.edgeIDs} is identical, save in its return #' value, as it returns only the ids of the edges. Specifying a vertex in #' \code{alter} causes these edges to be further selected such that alter must #' also belong to the edge -- this can be used to extract edges between two #' particular vertices. Omission of missing edges is accomplished via #' \code{na.omit}. Note that for multiplex networks, multiple edges or edge #' ids can be returned. #' #' The function \code{get.dyads.eids} simplifies the process of looking up the #' edge ids associated with a set of 'dyads' (tail and head vertex ids) for #' edges. It only is intended for working with non-multiplex networks and will #' return a warning and \code{NA} value for any dyads that correspond to #' multiple edges. The value \code{numeric(0)} will be returned for any dyads #' that do not have a corresponding edge. #' #' @param x an object of class \code{network} #' @param v a vertex ID #' @param alter optionally, the ID of another vertex #' @param neighborhood an indicator for whether we are interested in in-edges, #' out-edges, or both (relative to \code{v}). defaults to \code{'combined'} for #' undirected networks #' @param na.omit logical; should we omit missing edges? #' @param tails a vector of vertex ID for the 'tails' (v) side of the dyad #' @param heads a vector of vertex ID for the 'heads' (alter) side of the dyad #' @return For \code{get.edges}, a list of edges. For \code{get.edgeIDs}, a #' vector of edge ID numbers. For \code{get.dyads.eids}, a list of edge IDs #' corresponding to the dyads defined by the vertex ids in \code{tails} and #' \code{heads} #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{get.neighborhood}}, \code{\link{valid.eids}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords classes graphs #' @examples #' #' #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) #' #' get.edges(g,1,neighborhood="out") #' get.edgeIDs(g,1,neighborhood="in") #' #' @export get.edgeIDs get.edgeIDs<-function(x, v, alter=NULL, neighborhood=c("out","in","combined"), na.omit=TRUE){ #Check to be sure we were called with a network if(!is.network(x)) stop("get.edgeIDs requires an argument of class network.") #Do some reality checking n<-network.size(x) if((v<1)||(v>n)) return(numeric(0)) if((!is.null(alter))&&((alter<1)||(alter>n))) return(numeric(0)) #Retrieve the edges if(!is.directed(x)) neighborhood="combined" #If undirected, out==in==combined else neighborhood=match.arg(neighborhood) #Do the deed .Call(getEdgeIDs_R,x,v,alter,neighborhood,na.omit) } # Retrieve all edges incident on v, in network x. Outgoing or incoming # edges are specified by neighborhood, while na.omit indicates whether # or not missing edges should be omitted. The return value is a list of # edges. # #' @rdname get.edges #' @export get.edges get.edges<-function(x, v, alter=NULL, neighborhood=c("out","in","combined"), na.omit=TRUE){ #Check to be sure we were called with a network if(!is.network(x)) stop("get.edges requires an argument of class network.") #Do some reality checking n<-network.size(x) if((v<1)||(v>n)) return(list()) if((!is.null(alter))&&((alter<1)||(alter>n))) return(list()) #Retrieve the edges if(!is.directed(x)) neighborhood="combined" #If undirected, out==in==combined else neighborhood=match.arg(neighborhood) #Do the deed .Call(getEdges_R,x,v,alter,neighborhood,na.omit) } # get the the edge ids associated with a set of dayds # as defined by a vector of tails and heads vertex ids #' @rdname get.edges #' @export get.dyads.eids get.dyads.eids<-function(x,tails,heads,neighborhood = c("out", "in", "combined"),na.omit = TRUE){ if(length(tails)!=length(heads)){ stop('heads and tails vectors must be the same length for get.dyads.eids') } if (any(heads>network.size(x) | heads<1) | any(tails>network.size(x) | tails<1)){ stop('invalid vertex id in heads or tails vector') } neighborhood<-match.arg(neighborhood) if (!is.directed(x)){ neighborhood = "combined" } lapply(seq_along(tails),function(e){ eid<-get.edgeIDs(x,v = tails[e],alter=heads[e],neighborhood=neighborhood,na.omit=na.omit) if(length(eid)>1){ eid<-NA warning('get.dyads.eids found multiple edge ids for dyad ',tails[e],',',heads[e],' NA will be returned') } eid }) } # Given a network and a set of vertices, return the subgraph induced by those # vertices (preserving all associated metadata); if given two such sets, # return the edge cut (along with the associated vertices and meta-data) as # a bipartite network. # #' Retrieve Induced Subgraphs and Cuts #' #' Given a set of vertex IDs, \code{get.inducedSubgraph} returns the subgraph #' induced by the specified vertices (i.e., the vertices and all associated #' edges). Optionally, passing a second set of alters returns the cut from the #' first to the second set (i.e., all edges passing between the sets), along #' with the associated endpoints. Alternatively, passing in a vector of edge #' ids will induce a subgraph containing the specified edges and their incident #' vertices. In all cases, the result is returned as a network object, with #' all attributes of the selected edges and/or vertices (and any network #' attributes) preserved. #' #' For \code{get.inducedSubgraph}, \code{v} can be a vector of vertex IDs. If #' \code{alter=NULL}, the subgraph induced by these vertices is returned. #' Calling \code{\%s\%} with a single vector of vertices has an identical effect. #' #' Where \code{alters} is specified, it must be a vector of IDs disjoint with #' \code{v}. Where both are given, the edges spanning \code{v} and #' \code{alters} are returned, along with the vertices in question. #' (Technically, only the edges really constitute the \dQuote{cut,} but the #' vertices are included as well.) The same result can be obtained with the #' \code{\%s\%} operator by passing a two-element list on the right hand side; #' the first element is then interpreted as \code{v}, and the second as #' \code{alters}. #' #' When \code{eid} is specified, the \code{v} and \code{alters} argument will #' be ignored and the subgraph induced by the specified edges and their #' incident vertices will be returned. #' #' Any network, vertex, or edge attributes for the selected network elements #' are retained (although features such as vertex IDs and the network size will #' typically change). These are copies of the elements in the original #' network, which is not altered by this function. #' #' @param x an object of class \code{network}. #' @param v a vector of vertex IDs, or, for \code{\%s\%}, optionally a list containing two disjoint vectors of vertex IDs (see below). #' #' @param alters optionally, a second vector of vertex IDs. Must be disjoint #' with \code{v}. #' #' @param eid optionally, a numeric vector of valid edge ids in \code{x} that #' should be retained (cannot be used with \code{v} or \code{alter}) #' #' @param ... additional arguments for methods. #' #' @return A \code{\link{network}} object containing the induced subgraph. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network}}, \code{\link{network.extraction}} #' @keywords graphs manip #' @examples #' #' #Load the Drabek et al. EMON data #' data(emon) #' #' #For the Mt. St. Helens, EMON, several types of organizations are present: #' type<-emon$MtStHelens %v% "Sponsorship" #' #' #Plot interactions among the state organizations #' plot(emon$MtStHelens %s% which(type=="State"), displaylabels=TRUE) #' #' #Plot state/federal interactions #' plot(emon$MtStHelens %s% list(which(type=="State"), #' which(type=="Federal")), displaylabels=TRUE) #' #' #Plot state interactions with everyone else #' plot(emon$MtStHelens %s% list(which(type=="State"), #' which(type!="State")), displaylabels=TRUE) #' #' # plot only interactions with frequency of 2 #' subG2<-get.inducedSubgraph(emon$MtStHelens, #' eid=which(emon$MtStHelens%e%'Frequency'==2)) #' plot(subG2,edge.label='Frequency') #' #' #' @export get.inducedSubgraph get.inducedSubgraph <- function(x, ...) UseMethod("get.inducedSubgraph") #' @rdname get.inducedSubgraph #' @export get.inducedSubgraph.network <- function(x, v, alters=NULL, eid=NULL, ...){ #Check to be sure we were called with a network if(!is.network(x)) stop("get.inducedSubgraph requires an argument of class network.") #Do some reality checking n<-network.size(x) # are we doing this via eids, or v and alters if (is.null(eid)){ # do checks for v and alters if((length(v)<1)||any(is.na(v))||any(v<1)||any(v>n)) stop("Illegal vertex selection in get.inducedSubgraph") if(!is.null(alters)){ if((length(alters)<1)||any(is.na(alters))||any(alters<1)||any(alters>n)|| any(alters%in%v)) stop("Illegal vertex selection (alters) in get.inducedSubgraph") } if (!is.null(eid)){ warning('eid argument to get.inducedSubgraph ignored when using v or alter argument') } } else { # do checks for eids if (!is.numeric(eid)){ stop('eid must be a numeric vector of edge ids') } if (!missing(v)){ warning('v argument to get.inducedSubgraph ignored when using eid argument') } if (!is.null(alters)){ warning('alters argument to get.inducedSubgraph ignored when using eid argument') } # check that eids are valid if (any(!eid%in%valid.eids(x))){ stop('eid argument contains non-valid edge ids') } } #Start by making a copy of our target network (yes, this can be wasteful) #TODO: in most cases, probably faster to create a new network and only copy over what is needed newNet<-network.copy(x) if (is.null(eid)){ # using v and alter #Now, strip out what is needed, and/or permute in the two-mode case if(is.null(alters)){ #Simple case delete.vertices(newNet,(1:n)[-v]) #Get rid of everyone else }else{ #Really an edge cut, but w/vertices nv<-length(v) na<-length(alters) newids<-sort(c(v,alters)) newv<-match(v,newids) newalt<-match(alters,newids) delete.vertices(newNet,(1:n)[-c(v,alters)]) #Get rid of everyone else permute.vertexIDs(newNet,c(newv,newalt)) #Put the new vertices first #Remove within-group edges for(i in 1:nv) for(j in (i:nv)[-1]){ torem<-get.edgeIDs(newNet,i,alter=j,neighborhood="combined",na.omit=FALSE) if(length(torem)>0) delete.edges(newNet,torem) } for(i in (nv+1):(nv+na)) for(j in (i:(nv+na))[-1]){ torem<-get.edgeIDs(newNet,i,alter=j,neighborhood="combined",na.omit=FALSE) if(length(torem)>0) delete.edges(newNet,torem) } newNet%n%"bipartite"<-nv #Set bipartite attribute } } else { # using eids instead of v and alters # delete all the edges not in eid removeEid<-setdiff(valid.eids(newNet),eid) delete.edges(newNet,removeEid) # find the set of vertices incident on the remaining edges v<-unique(c(unlist(sapply(newNet$mel, "[[", "outl")),unlist(sapply(newNet$mel, "[[", "inl")))) removeV<-setdiff(seq_len(network.size(newNet)),v) delete.vertices(newNet,removeV) } #Return the updated object newNet } # Retrieve a specified network-level attribute from network x. The attribute # type depends on the underlying storage mode, and cannot be guaranteed. # #' @rdname attribute.methods #' @export get.network.attribute <- function(x, ...) UseMethod("get.network.attribute") #' @rdname attribute.methods #' @export get.network.attribute.network <- function(x, attrname, unlist=FALSE, ...) { x <- x$gal[[attrname]] if(unlist){unlist(x)}else{x} } # Retrieve the neighborhood of v in network x. Depending on the value of # type, the neighborhood in question may be in, out, or the union of the two. # The return value for the function is a vector containing vertex IDs. # #' Obtain the Neighborhood of a Given Vertex #' #' \code{get.neighborhood} returns the IDs of all vertices belonging to the in, #' out, or combined neighborhoods of \code{v} within network \code{x}. #' #' Note that the combined neighborhood is the union of the in and out #' neighborhoods -- as such, no vertex will appear twice. #' #' @param x an object of class \code{network} #' @param v a vertex ID #' @param type the neighborhood to be computed #' @param na.omit logical; should missing edges be ignored when obtaining #' vertex neighborhoods? #' @return A vector containing the vertex IDs for the chosen neighborhood. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{get.edges}}, \code{\link{is.adjacent}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' #' Wasserman, S. and Faust, K. 1994. \emph{Social Network Analysis: Methods #' and Applications.} Cambridge: Cambridge University Press. #' @keywords graphs #' @examples #' #' #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) #' #' #Examine the neighborhood of vertex 1 #' get.neighborhood(g,1,"out") #' get.neighborhood(g,1,"in") #' get.neighborhood(g,1,"combined") #' #' @export get.neighborhood get.neighborhood<-function(x, v, type=c("out","in","combined"), na.omit=TRUE){ #Check to be sure we were called with a network if(!is.network(x)) stop("get.neighborhood requires an argument of class network.") #Do some reality checking n<-network.size(x) if((v<1)||(v>n)) return(numeric(0)) #Retrieve the edges if(!is.directed(x)) type="combined" #If undirected, out==in==combined else type=match.arg(type) #Do the deed .Call(getNeighborhood_R,x,v,type,na.omit) } # Retrieve a specified vertex attribute (indicated by attrname) from network x. # Where na.omit==TRUE, values for missing vertices are removed; where # null.na==TRUE, NULL values are converted to NAs. The return value of this # function is a list. # #' @rdname attribute.methods #' @export get.vertex.attribute <- function(x, ...) UseMethod("get.vertex.attribute") #' @rdname attribute.methods #' @export get.vertex.attribute.network <- function(x, attrname, na.omit=FALSE, null.na=TRUE, unlist=TRUE, ...) { #Check to see if there's anything to be done if(network.size(x)==0){ return(NULL) } # MB: Showing warnings if attribute not present is infeasible and causes an # avalanche of problems downstream. Hence, it is commented-out here as a # warning to future generations of Statnet developers before they decide to # revisit the problem. C.f. https://github.com/statnet/network/issues/41 # #if(!(attrname %in% list.vertex.attributes(x))) # warning(paste('attribute', attrname,'is not specified for these vertices')) #Get the list of attribute values va<-lapply(x$val,"[[",attrname) #If needed, figure out who's missing if(na.omit) vna<-unlist(lapply(x$val,"[[","na")) else vna<-rep(FALSE,length(va)) #Replace NULL values with NAs, if requested if(null.na) va[sapply(va,is.null)]<-NA #Return the result if (na.omit){ x <- va[!vna] } else { x<-va } if(unlist){unlist(x)}else{x} } # Return TRUE iff network x has loops. # #' Indicator Functions for Network Properties #' #' Various indicators for properties of \code{network} class objects. #' #' These methods are the standard means of assessing the state of a #' \code{network} object; other methods can (and should) use these routines in #' governing their own behavior. As such, improper setting of the associated #' attributes may result in unpleasantly creative results. (See the #' \code{edge.check} argument to \code{\link{add.edges}} for an example of code #' which makes use of these network properties.) #' #' The functions themselves behave has follows: #' #' \code{has.loops} returns \code{TRUE} iff \code{x} is allowed to contain #' loops (or loop-like edges, in the hypergraphic case). #' #' \code{is.bipartite} returns \code{TRUE} iff the \code{x} has been explicitly #' bipartite-coded. Values of \code{bipartite=NULL}, and \code{bipartite=FALSE} #' will evaluate to \code{FALSE}, numeric values of \code{bipartite>=0} will #' evaluate to \code{TRUE}. (The value \code{bipartite==0} indicates that it is #' a bipartite network with a zero-sized first partition.) Note that #' \code{is.bipartite} refers only to the storage properties of \code{x} and #' how it should be treated by some algorithms; \code{is.bipartite(x)==FALSE} #' it does \emph{not} mean that \code{x} cannot admit a bipartition! #' #' \code{is.directed} returns \code{TRUE} iff the edges of \code{x} are to be #' interpreted as directed. #' #' \code{is.hyper} returns \code{TRUE} iff \code{x} is allowed to contain #' hypergraphic edges. #' #' \code{is.multiplex} returns \code{TRUE} iff \code{x} is allowed to contain #' multiplex edges. #' #' @name network.indicators #' #' @param x an object of class \code{network} #' @return \code{TRUE} or \code{FALSE} #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network}}, \code{\link{get.network.attribute}}, #' \code{set.network.attribute}, \code{\link{add.edges}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords classes graphs #' @examples #' #' g<-network.initialize(5) #Initialize the network #' is.bipartite(g) #' is.directed(g) #' is.hyper(g) #' is.multiplex(g) #' has.loops(g) #' #' @export has.loops<-function(x){ if(!is.network(x)) stop("has.loops requires an argument of class network.") else get.network.attribute(x,"loops") } # Return TRUE iff (vi,vj) in network x. Where na.omit==TRUE, edges flagged # as missing are ignored. # #' Determine Whether Two Vertices Are Adjacent #' #' \code{is.adjacent} returns \code{TRUE} iff \code{vi} is adjacent to #' \code{vj} in \code{x}. Missing edges may be omitted or not, as per #' \code{na.omit}. #' #' Vertex \eqn{v} is said to be adjacent to vertex \eqn{v'} within directed #' network \eqn{G} iff there exists some edge whose tail set contains \eqn{v} #' and whose head set contains \eqn{v'}. In the undirected case, head and tail #' sets are exchangeable, and thus \eqn{v} is adjacent to \eqn{v'} if there #' exists an edge such that \eqn{v} belongs to one endpoint set and \eqn{v'} #' belongs to the other. (In dyadic graphs, these sets are of cardinality 1, #' but this may not be the case where hyperedges are admitted.) #' #' If an edge which would make \eqn{v} and \eqn{v'} adjacent is marked as #' missing (via its \code{na} attribute), then the behavior of #' \code{is.adjacent} depends upon \code{na.omit}. If \code{na.omit==FALSE} #' (the default), then the return value is considered to be \code{NA} unless #' there is also \emph{another} edge from \eqn{v} to \eqn{v'} which is #' \emph{not} missing (in which case the two are clearly adjacent). If #' \code{na.omit==TRUE}, on the other hand the missing edge is simply #' disregarded in assessing adjacency (i.e., it effectively treated as not #' present). It is important not to confuse \dQuote{not present} with #' \dQuote{missing} in this context: the former indicates that the edge in #' question does not belong to the network, while the latter indicates that the #' state of the corresponding edge is regarded as unknown. By default, all #' edge states are assumed \dQuote{known} unless otherwise indicated (by #' setting the edge's \code{na} attribute to \code{TRUE}; see #' \code{\link{attribute.methods}}). #' #' Adjacency can also be determined via the extraction/replacement operators. #' See the associated man page for details. #' #' @param x an object of class \code{network} #' @param vi a vertex ID #' @param vj a second vertex ID #' @param na.omit logical; should missing edges be ignored when assessing #' adjacency? #' @return A logical, giving the status of the (i,j) edge #' @note Prior to version 1.4, \code{na.omit} was set to \code{TRUE} by #' default. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{get.neighborhood}}, \code{\link{network.extraction}}, #' \code{\link{attribute.methods}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' #' Wasserman, S. and Faust, K. 1994. \emph{Social Network Analysis: Methods #' and Applications}. Cambridge: Cambridge University Press. #' @keywords graphs #' @examples #' #' #Create a very simple graph #' g<-network.initialize(3) #' add.edge(g,1,2) #' is.adjacent(g,1,2) #TRUE #' is.adjacent(g,2,1) #FALSE #' g[1,2]==1 #TRUE #' g[2,1]==1 #FALSE #' #' @export is.adjacent is.adjacent<-function(x,vi,vj,na.omit=FALSE){ if(!is.network(x)) stop("is.adjacent requires an argument of class network.\n") if(length(vi)!=length(vj)){ vi<-rep(vi,length.out=max(length(vi),length(vj))) vj<-rep(vj,length.out=max(length(vi),length(vj))) } #Do the deed .Call(isAdjacent_R,x,vi,vj,na.omit) } # Return TRUE iff network x is bipartite # #' @rdname network.indicators #' @param ... other arguments passed to/from other methods #' @export is.bipartite <- function(x, ...) UseMethod("is.bipartite") #' @rdname network.indicators #' @export is.bipartite.network<-function(x, ...){ bip <- get.network.attribute(x,"bipartite") if(is.null(bip)){ return(FALSE) } else if (is.logical(bip)){ return(bip) }else{ return(bip>=0) } } # Return TRUE iff network x is directed. # #' @rdname network.indicators #' @export is.directed <- function(x, ...) UseMethod("is.directed") #' @rdname network.indicators #' @export is.directed.network<-function(x, ...){ get.network.attribute(x,"directed") } # Return TRUE iff network x is hypergraphic. # #' @rdname network.indicators #' @export is.hyper<-function(x){ if(!is.network(x)) stop("is.hyper requires an argument of class network.\n") else get.network.attribute(x,"hyper") } # Return TRUE iff network x is multiplex. # #' @rdname network.indicators #' @export is.multiplex<-function(x){ if(!is.network(x)) stop("is.multiplex requires an argument of class network.\n") else get.network.attribute(x,"multiple") } # Return a network whose edges are the missing edges of x # #' @rdname network.naedgecount #' @name missing.edges #' @title Identifying and Counting Missing Edges in a Network Object #' #' @description \code{network.naedgecount} returns the number of edges within a #' \code{network} object which are flagged as missing. The \code{is.na} #' network method returns a new network containing the missing edges. #' #' @details The missingness of an edge is controlled by its \code{na} attribute (which #' is mandatory for all edges); \code{network.naedgecount} returns the number #' of edges for which \code{na==TRUE}. The \code{is.na} network method #' produces a new network object whose edges correspond to the missing #' (\code{na==TRUE}) edges of the original object, and is thus a covenient #' method of extracting detailed missingness information on the entire network. #' The network returned by \code{is.na} is guaranteed to have the same base #' network attributes (directedness, loopness, hypergraphicity, multiplexity, #' and bipartite constraint) as the original network object, but no other #' information is copied; note too that edge IDs are \emph{not} preserved by #' this process (although adjacency obviously is). Since the resulting object #' is a \code{\link{network}}, standard coercion, print/summary, and other #' methods can be applied to it in the usual fashion. #' #' It should be borne in mind that \dQuote{missingness} in the sense used here #' reflects the assertion that an edge's presence or absence is unknown, #' \emph{not} that said edge is known not to be present. Thus, the \code{na} #' count for an empty graph is properly 0, since all edges are known to be #' absent. Edges can be flagged as missing by setting their \code{na} #' attribute to \code{TRUE} using \code{\link{set.edge.attribute}}, or by #' appropriate use of the network assignment operators; see below for an #' example of the latter. #' #' @param x an object of class \code{network} #' @param \dots additional arguments, not used #' @return \code{is.na(x)} returns a network object, and #' \code{network.naedgecount(x)} returns the number of missing edges. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network.edgecount}}, #' \code{\link{get.network.attribute}}, \code{is.adjacent}, \code{\link{is.na}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords classes graphs #' @examples #' #' #Create an empty network with no missing data #' g<-network.initialize(5) #' g[,] #No edges present.... #' network.naedgecount(g)==0 #Edges not present are not "missing"! #' #' #Now, add some missing edges #' g[1,,add.edges=TRUE]<-NA #Establish that 1's ties are unknown #' g[,] #Observe the missing elements #' is.na(g) #Observe in network form #' network.naedgecount(g)==4 #These elements do count! #' network.edgecount(is.na(g)) #Same as above #' #' #' @export is.na.network #' @export is.na.network<-function(x){ #Create an empty network with the same properties as x y<-network.initialize(network.size(x),directed=is.directed(x), hyper=is.hyper(x),loops=has.loops(x),multiple=is.multiplex(x), bipartite=x%n%"bipartite") #Add the missing edges of x to y y<-.Call(isNANetwork_R,x,y) #Return the updated network y } # Return TRUE iff x is a network. # #' Network Objects #' #' Construct, coerce to, test for and print \code{network} objects. #' #' \code{network} constructs a \code{network} class object from a matrix #' representation. If the \code{matrix.type} parameter is not specified, it #' will make a guess as to the intended \code{edgeset.constructors} function to #' call based on the format of these input matrices. If the class of \code{x} #' is not a matrix, network construction can be dispatched to other methods. #' For example, If the \code{ergm} package is loaded, \code{network()} can #' function as a shorthand for \code{as.network.numeric} with #' \code{x} as an integer specifying the number of nodes to be created in the #' random graph. #' #' If the \code{ergm} package is loaded, \code{network} can function as a #' shorthand for \code{as.network.numeric} if \code{x} is an integer specifying #' the number of nodes. See the help page for #' \code{as.network.numeric} in \code{ergm} package for details. #' #' \code{network.copy} creates a new \code{network} object which duplicates its #' supplied argument. (Direct assignment with \code{<-} should be used rather #' than \code{network.copy} in most cases.) #' #' \code{as.network} tries to coerce its argument to a network, using the #' \code{as.network.matrix} functions if \code{x} is a matrix. (If the argument #' is already a network object, it is returned as-is and all other arguments #' are ignored.) #' #' \code{is.network} tests whether its argument is a network (in the sense that #' it has class \code{network}). #' #' \code{print.network} prints a network object in one of several possible #' formats. It also prints the list of global attributes of the network. #' #' \code{summary.network} provides similar information. #' #' @name network #' #' @aliases as.network.network print.summary.network $<-.network <-.network #' @param x for \code{network}, a matrix giving the network structure in #' adjacency, incidence, or edgelist form; otherwise, an object of class #' \code{network}. #' @param vertex.attr optionally, a list containing vertex attributes. #' @param vertex.attrnames optionally, a list containing vertex attribute #' names. #' @param directed logical; should edges be interpreted as directed? #' @param hyper logical; are hyperedges allowed? #' @param loops logical; should loops be allowed? #' @param multiple logical; are multiplex edges allowed? #' @param bipartite count; should the network be interpreted as bipartite? If #' present (i.e., non-NULL, non-FALSE) it is the count of the number of actors #' in the bipartite network. In this case, the number of nodes is equal to the #' number of actors plus the number of events (with all actors preceeding all #' events). The edges are then interpreted as nondirected. Values of #' bipartite==0 are permited, indicating a bipartite network with zero-sized #' first partition. #' @param matrix.type one of \code{"adjacency"}, \code{"edgelist"}, #' \code{"incidence"}. See \code{\link{edgeset.constructors}} for details and #' optional additional arguments #' @param object an object of class \code{network}. #' @param na.omit logical; omit summarization of missing attributes in #' \code{network}? #' @param mixingmatrices logical; print the mixing matrices for the discrete #' attributes? #' @param print.adj logical; print the network adjacency structure? #' @param ... additional arguments. #' @return \code{network}, \code{as.network}, and \code{print.network} all #' return a network class object; \code{is.network} returns TRUE or FALSE. #' @note Between versions 0.5 and 1.2, direct assignment of a network object #' created a pointer to the original object, rather than a copy. As of version #' 1.2, direct assignment behaves in the same manner as \code{network.copy}. #' Direct use of the latter is thus superfluous in most situations, and is #' discouraged. #' #' Many of the network package functions modify their network object arguments #' in-place. For example, \code{set.network.attribute(net,"myVal",5)} will have #' the same effect as \code{net<-set.network.attribute(net,"myVal",5)}. #' Unfortunately, the current implementation of in-place assignment breaks when #' the network argument is an element of a list or a named part of another #' object. So \code{set.network.attribute(myListOfNetworks[[1]],"myVal",5)} #' will silently fail to modify its network argument, likely leading to #' incorrect output. #' @author Carter T. Butts \email{buttsc@@uci.edu} and David Hunter #' \email{dhunter@@stat.psu.edu} #' @seealso \code{\link{network.initialize}}, \code{\link{attribute.methods}}, #' \code{\link{as.network.matrix}}, \code{\link{as.matrix.network}}, #' \code{\link{deletion.methods}}, \code{\link{edgeset.constructors}}, #' \code{\link{network.indicators}}, \code{\link{plot.network}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords classes graphs #' @examples #' #' m <- matrix(rbinom(25,1,.4),5,5) #' diag(m) <- 0 #' g <- network(m, directed=FALSE) #' summary(g) #' #' h <- network.copy(g) #Note: same as h<-g #' summary(h) #' #' @export is.network<-function(x){ inherits(x, "network") } # List attributes present on any edge # #' @rdname attribute.methods #' @export list.edge.attributes <- function(x, ...) UseMethod("list.edge.attributes") #' @rdname attribute.methods #' @export list.edge.attributes.network <- function(x, ...) { # no edges in the network if (network.edgecount(x, na.omit=F) == 0) return(character(0)) #Accumulate names allnam<-sapply(lapply(x$mel[!is.null(x$mel)],"[[","atl"),names) #Return the sorted, unique attribute names sort(unique(as.vector(unlist(allnam)))) } # List network-level attributes # #' @rdname attribute.methods #' @export list.network.attributes <- function(x, ...) UseMethod("list.network.attributes") #' @rdname attribute.methods #' @export list.network.attributes.network <- function(x, ...) { #Return the attribute names sort(names(x$gal)) } # List attributes present on any vertex # #' @rdname attribute.methods #' @export list.vertex.attributes <- function(x, ...) UseMethod("list.vertex.attributes") #' @rdname attribute.methods #' @export list.vertex.attributes.network <- function(x, ...) { if(network.size(x)==0){ return(NULL) } #Accumulate names allnam<-unlist(sapply(x$val,names)) #Return the sorted, unique attribute names sort(unique(as.vector(allnam))) } # Retrieve the number of free dyads (i.e., number of non-missing) of network x. # #' @export network.dyadcount<-function(x, ...) UseMethod("network.dyadcount") #' Return the Number of (Possibly Directed) Dyads in a Network Object #' #' \code{network.dyadcount} returns the number of possible dyads within a #' \code{network}, removing those flagged as missing if desired. If the #' network is directed, directed dyads are counted accordingly. #' #' The return value \code{network.dyadcount} is equal to the number of dyads, #' minus the number of \code{NULL} edges (and missing edges, if #' \code{na.omit==TRUE}). If \code{x} is directed, the number of directed #' dyads is returned. If the network allows loops, the number of possible #' entries on the diagnonal is added. Allthough the function does not give an #' error on multiplex networks or hypergraphs, the results probably don't make #' sense. #' #' @name network.dyadcount #' #' @param x an object of class \code{network} #' @param na.omit logical; omit edges with \code{na==TRUE} from the count? #' @param \dots possible additional arguments, used by other implementations #' @return The number of dyads in the network #' @author Mark S. Handcock \email{handcock@@stat.washington.edu}, skyebend #' @seealso \code{\link{get.network.attribute}}, #' \code{\link{network.edgecount}}, \code{\link{is.directed}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords classes graphs #' @examples #' #' #Create a directed network with three edges #' m<-matrix(0,3,3) #' m[1,2]<-1; m[2,3]<-1; m[3,1]<-1 #' g<-network(m) #' network.dyadcount(g)==6 #Verify the directed dyad count #' g<-network(m|t(m),directed=FALSE) #' network.dyadcount(g)==3 #nC2 in undirected case #' #' @export network.dyadcount.network<-function(x,na.omit=TRUE,...){ nodes <- network.size(x) if(is.directed(x)){ if(is.bipartite(x)){ # directed bipartite nactor <- get.network.attribute(x,"bipartite") nevent <- nodes - nactor dyads <- nactor * nevent *2 }else{ # directed unipartite dyads <- nodes * (nodes-1) if(has.loops(x)){ # add in the diagonal dyads<-dyads+nodes } } }else{ # undirected if(is.bipartite(x)){ # undirected bipartite nactor <- get.network.attribute(x,"bipartite") nevent <- nodes - nactor dyads <- nactor * nevent }else{ # undirected unipartite dyads <- nodes * (nodes-1)/2 if(has.loops(x)){ # add in the diagonal dyads<-dyads+nodes } } } if(na.omit){ # # Adjust for missing # design <- get.network.attribute(x,"design") if(!is.null(design)){ dyads <- dyads - network.edgecount(design) }else{ design <- get.network.attribute(x,"mClist.design") if(!is.null(design)){ dyads <- dyads - design$nedges }else{ dyads <- dyads - network.naedgecount(x) } } } dyads } #Retrieve the number of edges in network x. # #' @export network.edgecount<-function(x, ...) UseMethod("network.edgecount") #' Return the Number of Edges in a Network Object #' #' \code{network.edgecount} returns the number of edges within a #' \code{network}, removing those flagged as missing if desired. #' #' The return value is the number of distinct edges within the network object, #' including multiplex edges as appropriate. (So if there are 3 edges from #' vertex i to vertex j, each contributes to the total edge count.) #' #' The return value \code{network.edgecount} is in the present implementation #' related to the (required) \code{mnext} network attribute. \code{mnext} is #' an internal legacy attribute that currently indicates the index number of #' the next edge to be added to a network object. (Do not modify it unless you #' enjoy unfortunate surprises.) The number of edges returned by #' \code{network.edgecount} is equal to \code{x\%n\%"mnext"-1}, minus the number #' of \code{NULL} edges (and missing edges, if \code{na.omit==TRUE}). Note #' that \code{g\%n\%"mnext"-1} cannot, by itself, be counted upon to be an #' accurate count of the number of edges! As \code{mnext} is not part of the #' API (and is not guaranteed to remain), users and developers are urged to use #' \code{network.edgecount} instead. #' #' @name network.edgecount #' #' @param x an object of class \code{network} #' @param na.omit logical; omit edges with \code{na==TRUE} from the count? #' @param \dots additional arguments, used by extending functio #' @return The number of edges #' @section Warning : \code{network.edgecount} uses the real state of the #' network object to count edges, not the state it hypothetically should have. #' Thus, if you add extra edges to a non-multiplex network, directed edges to #' an undirected network, etc., the actual number of edges in the object will #' be returned (and not the number you would expect if you relied only on the #' putative number of possible edges as reflected by the #' \link{network.indicators}). Don't create \code{network} objects with #' contradictory attributes unless you know what you are doing. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{get.network.attribute}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords classes graphs #' @examples #' #' #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) #' network.edgecount(g)==3 #Verify the edgecount #' #' @export network.edgecount.network<-function(x,na.omit=TRUE,...){ .Call(networkEdgecount_R,x,na.omit) } #Retrieve the number of missing edges in network x # #' @rdname network.naedgecount #' @export network.naedgecount<-function(x, ...) UseMethod("network.naedgecount") #' @export network.naedgecount.network<-function(x, ...){ na<-get.edge.attribute(x$mel,"na") if(is.null(na)) 0 else sum(na) } # Retrieve the size (i.e., number of vertices) of network x. # #' Return the Size of a Network #' #' \code{network.size} returns the order of its argument (i.e., number of #' vertices). #' #' \code{network.size(x)} is equivalent to \code{get.network.attribute(x,"n")}; #' the function exists as a convenience. #' #' @param x an object of class \code{network} #' @param \dots additional arguments, not used #' @return The network size #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{get.network.attribute}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords classes graphs #' @examples #' #' #Initialize a network #' g<-network.initialize(7) #' network.size(g) #' #' @export network.size network.size<-function(x, ...) UseMethod("network.size") #' @export network.size.network<-function(x, ...){ get.network.attribute(x,"n") } # Retrieve the vertex names of network x (if present). # #' @rdname attribute.methods #' @export network.vertex.names<-function(x){ if(!is.network(x)){ stop("network.vertex.names requires an argument of class network.") }else{ if(network.size(x)==0) return(NULL) vnames <- get.vertex.attribute(x,"vertex.names") if(is.null(vnames) | all(is.na(vnames)) ){ as.character(1:network.size(x)) }else{ vnames } } } # Set the vertex names of network x # #' @rdname attribute.methods #' @export "network.vertex.names<-"<-function(x,value){ set.vertex.attribute(x,attrname="vertex.names",value=value) } # Permute the internal IDs (ordering) of the vertex set #' Permute (Relabel) the Vertices Within a Network #' #' \code{permute.vertexIDs} permutes the vertices within a given network in the #' specified fashion. Since this occurs internally (at the level of vertex #' IDs), it is rarely of interest to end-users. #' #' \code{permute.vertexIDs} alters the internal ordering of vertices within a #' \code{\link{network}}. For most practical applications, this should not be #' necessary -- de facto permutation can be accomplished by altering the #' appropriate vertex attributes. \code{permute.vertexIDs} is needed for #' certain other routines (such as \code{\link{delete.vertices}}), where it is #' used in various arcane and ineffable ways. #' #' @param x an object of class \code{\link{network}}. #' @param vids a vector of vertex IDs, in the order to which they are to be #' permuted. #' @param ... additional arguments to methods. #' @return Invisibly, a pointer to the permuted network. #' \code{permute.vertexIDs} modifies its argument in place. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords manip graphs #' @examples #' #' data(flo) #Load the Florentine Families data #' nflo<-network(flo) #Create a network object #' n<-network.size(nflo) #Get the number of vertices #' permute.vertexIDs(nflo,n:1) #Reverse the vertices #' all(flo[n:1,n:1]==as.sociomatrix(nflo)) #Should be TRUE #' #' @export permute.vertexIDs permute.vertexIDs <- function(x, vids, ...) UseMethod("permute.vertexIDs") #' @rdname permute.vertexIDs #' @export permute.vertexIDs.network <- function(x, vids, ...) { #First, check to see that this is a graph object if(!is.network(x)) stop("permute.vertexIDs requires an argument of class network.\n") #Sanity check: is this a permutation vector? n<-network.size(x) if((length(unique(vids))!=n)||any(range(vids)!=c(1,n))) stop("Invalid permutation vector in permute.vertexIDs.") if(is.bipartite(x)){ #If bipartite, enforce partitioning bpc<-get.network.attribute(x,"bipartite") if(any(vids[0:bpc]>bpc)||any(vids[(bpc+1):n]<=bpc)) warning("Performing a cross-mode permutation in permute.vertexIDs. I hope you know what you're doing....") } #Return the permuted graph xn<-substitute(x) x<-.Call(permuteVertexIDs_R,x,vids) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } invisible(x) } # Set an edge attribute for network x. # # set.edge.attribute<-function(x,attrname,value,e=seq_along(x$mel)){ # #Check to be sure we were called with a network # if(!is.network(x)) # stop("set.edge.attribute requires an argument of class network.") # #Make sure that value is appropriate, coercing if needed # if(!is.list(value)){ # if(!is.vector(value)) # stop("Inappropriate edge value given in set.edge.attribute.\n") # else # value<-as.list(rep(value,length.out=length(e))) # }else # if(length(value)!=length(e)) # value<-rep(value,length.out=length(e)) # xn<-deparse(substitute(x)) # ev<-parent.frame() # if(length(e)>0){ # if((min(e)<1)|(max(e)>length(x$mel))) # stop("Illegal edge in set.edge.attribute.\n") # #Do the deed # x<-.Call("setEdgeAttribute_R",x,attrname,value,e, PACKAGE="network") # if(exists(xn,envir=ev)) #If x not anonymous, set in calling env # on.exit(assign(xn,x,pos=ev)) # invisible(x) # }else # invisible(x) # } #' @rdname attribute.methods #' @export set.edge.attribute <- function(x, attrname, value, e, ...) UseMethod("set.edge.attribute") #' @rdname attribute.methods #' @export set.edge.attribute.network <- function(x, attrname, value, e=seq_along(x$mel), ...) { # determine if we have to do anything at all if(length(e)>0){ if((min(e)<1)|(max(e)>length(x$mel))){ stop("Illegal edge in set.edge.attribute.\n") } xn<-substitute(x) # determine if we will be setting single or multiple values if(length(attrname)==1){ #Make sure that value is appropriate, coercing if needed if(!is.list(value)){ if(!is.vector(value)){ stop("Inappropriate edge value given in set.edge.attribute.\n") } else { value<-as.list(rep(value,length.out=length(e))) } } else { if(length(value)!=length(e)) { value<-rep(value,length.out=length(e)) } } #Do the deed, call the set single value version x<-.Call(setEdgeAttribute_R,x,attrname,value,e) } else { # we will be setting multiple values if (length(attrname)!=length(value)){ stop("the 'value' attribute must have an element corresponding to each attribute name in 'attrname' in set.edge.attribute") } #Make sure that value is appropriate, coercing if needed if(!is.list(value)){ if(!is.vector(value)){ stop("Inappropriate edge value given in set.edge.attribute.\n") } else { # value must be a vector # replicate each element of value e times if needed value<-lapply(1:length(value),function(n){ if (length(value[n])length(x$mel))) stop("Illegal edge in set.edge.value.\n") #Make sure that value is appropriate, coercing if needed n<-network.size(x) if(!is.matrix(value)){ if(is.vector(value)) value<-matrix(rep(value,length.out=n*n),n,n) else value<-matrix(value,n,n) } else if (min(dim(value)) < n) { stop("set.edge.value requires a matrix whose dimension is equal to or larger than the network size") } #Ensure that the attribute name is legit attrname<-as.character(attrname) if(length(attrname)==0) stop("Attribute name required in set.edge.value.network.") #Do the deed xn<-substitute(x) x<-.Call(setEdgeValue_R,x,attrname,value,e) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } invisible(x) } # Set a network-level attribute for network x. # #' @rdname attribute.methods #' @export set.network.attribute <- function(x, attrname, value, ...) UseMethod("set.network.attribute") #' @rdname attribute.methods #' @export set.network.attribute.network <- function(x, attrname, value, ...) { #Make sure the values are consistent if(length(attrname)==1){ value<-list(value) }else{ if(is.list(value)){ value<-rep(value,length.out=length(attrname)) }else if(is.vector(value)){ value<-as.list(rep(value,length.out=length(attrname))) }else stop("Non-replicable value with multiple attribute names in set.network.attribute.\n") } #Do the deed xn<-substitute(x) x<-.Call(setNetworkAttribute_R,x,attrname,value) if(.validLHS(xn,parent.frame())){ #If x not anonymous, set in calling env on.exit(eval.parent(call('<-',xn,x))) } invisible(x) } # Set a vertex attribute for network x. # This version has been removed so we can test one that can set multiple values at once # set.vertex.attribute<-function(x,attrname,value,v=seq_len(network.size(x))){ # #Check to be sure we were called with a network # if(!is.network(x)) # stop("set.vertex.attribute requires an argument of class network.") # #Perform some sanity checks # if(any((v>network.size(x))|(v<1))) # stop("Vertex ID does not correspond to actual vertex in set.vertex.attribute.\n") # #Make sure that value is appropriate, coercing if needed # if(!is.list(value)){ # if(!is.vector(value)) # stop("Inappropriate value given in set.vertex.attribute.\n") # else # value<-as.list(rep(value,length.out=length(v))) # }else # if(length(value)!=length(v)) # value<-rep(value,length.out=length(v)) # #Do the deed # xn<-deparse(substitute(x)) # ev<-parent.frame() # x<-.Call("setVertexAttribute_R",x,attrname,value,v, PACKAGE="network") # if(exists(xn,envir=ev)) #If x not anonymous, set in calling env # on.exit(assign(xn,x,pos=ev)) # invisible(x) # } # valid.eids returns a list of non-null edge ids for a given network #' Get the ids of all the edges that are valid in a network #' #' Returns a vector of valid edge ids (corresponding to non-NULL edges) for a #' network that may have some deleted edges. #' #' The edge ids used in the network package are positional indices on the #' internal "mel" list. When edges are removed using \code{\link{delete.edges}} #' \code{NULL} elements are left on the list. The function \code{valid.eids} #' returns the ids of all the valid (non-null) edge ids for its \code{network} #' argument. #' #' @param x a network object, possibly with some deleted edges. #' @param ... additional arguments to methods. #' @return a vector of integer ids corresponding to the non-null edges in x #' @note If it is known that x has no deleted edges, \code{seq_along(x$mel)} is #' a faster way to generate the sequence of possible edge ids. #' @author skyebend #' @seealso See also \code{\link{delete.edges}} #' @examples #' #' net<-network.initialize(100) #' add.edges(net,1:99,2:100) #' delete.edges(net,eid=5:95) #' # get the ids of the non-deleted edges #' valid.eids(net) #' #' @export valid.eids <- function(x, ...) UseMethod("valid.eids") #' @rdname valid.eids #' @export valid.eids.network <- function(x, ...) { # get the ids of all the non-null elements on the edgelist of x return(which(!sapply(x$mel,is.null))) } #' @rdname attribute.methods #' @export set.vertex.attribute <- function(x, attrname, value, v = seq_len(network.size(x)), ...) UseMethod("set.vertex.attribute") #' @rdname attribute.methods #' @export set.vertex.attribute.network <- function(x, attrname, value, v = seq_len(network.size(x)), ...) { #Perform some sanity checks if(any((v>network.size(x))|(v<1))) stop("Vertex ID does not correspond to actual vertex in set.vertex.attribute.\n") xn<-substitute(x) #Make sure that value is appropriate, coercing if needed if (length(attrname)==1){ # if we are only setting a single attribute use old version if(!is.list(value)){ if(!is.vector(value)){ stop("Inappropriate value given in set.vertex.attribute.\n") } else { value<-as.list(rep(value,length.out=length(v))) } } else { if(length(value)!=length(v)){ value<-rep(value,length.out=length(v)) } } # call older singular value version x<-.Call(setVertexAttribute_R,x,attrname,value,v) } else { # setting multiple values if (length(value)!=length(attrname)){ stop("the 'value' attribute must have an element corresponding to each attribute name in 'attrnames' in set.vertex.attribute") } if(!is.list(value)){ if(!is.vector(value)){ stop("Inappropriate value given in set.vertex.attribute.\n") } else { # value is a vector # replicate each element of value v times if needed value<-lapply(1:length(value),function(n){ if (length(value[n]); portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 06/08/21 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various network routines which don't fit anywhere # else (generally, utilities and the like). # # Contents: # # is.discrete # is.discrete.character # is.discrete.numeric # which.matrix.type # ###################################################################### #' Transform vector of values into color specification #' #' Convenience function to convert a vector of values into a color #' specification. #' #' @param x vector of numeric, character or factor values to be transformed #' @param opacity optional numeric value in the range 0.0 to 1.0 used to specify #' the opacity/transparency (alpha) of the colors to be returned. 0 means #' fully opaque, 1 means fully transparent. #' #' Behavior of \code{as.color} is as follows: \itemize{ \item integer numeric #' values: unchanged, (assumed to corespond to values of R's active #' \code{\link{palette}}) \item integer real values: will be translated to into #' grayscale values ranging between the max and min \item factor: integer #' values corresponding to factor levels will be used \item character: if #' values are valid colors (as determined by \code{is.color}) they will be #' returned as is. Otherwise converted to factor and numeric value of factor #' returned. } #' #' The optional \code{opacity} parameter can be used to make colors partially #' transparent (as a shortcut for \code{\link{adjustcolor}}. If used, colors #' will be returned as hex rgb color string (i.e. \code{"#00FF0080"}) #' #' The \code{is.color} function checks if each character element of \code{x} #' appears to be a color name by comparing it to \code{\link{colors}} and #' checking if it is an HTML-style hex color code. Note that it will return #' FALSE for integer values. #' #' These functions are used for the color parameters of #' \code{\link{plot.network}}. #' #' @return For \code{as.color}, a vector integer values (corresponding to color #' palette values) or character color name. For \code{is.color}, a logical #' vector indicating if each element of x appears to be a color #' #' @rdname as.color #' @export #' #' @examples #' #' #' as.color(1:3) #' as.color(c('a','b','c')) #' #' # add some transparency #' as.color(c('red','green','blue'),0.5) # gives "#FF000080", "#00FF0080", "#0000FF80" #' #' is.color(c('red',1,'foo',NA,'#FFFFFF55')) as.color<-function(x,opacity=1.0){ if(opacity > 1 | opacity < 0){ stop('opacity parameter must be a numeric value in the range 0 to 1') } colors<-x #Numeric rule: if integer leave as-is, otherwise convert to grayscale if(is.numeric(x)){ if(any(x!=round(x),na.rm=TRUE)){ colors<-gray((x-min(x))/(max(x)-min(x))) }else colors<-x } #Factor rule: categorical colorings if(is.factor(x)){ colors<-match(levels(x)[x],levels(x)) } #Character rule: if colors, retain as colors; else categorical if(is.character(x)){ if(all(is.color(x))) colors<-x else{ colors<-match(x,sort(unique(x))) } } # add transparency if not 1 if(opacity < 1){ colors<-grDevices::adjustcolor(colors,alpha.f=opacity) } return(colors) } # Mixing matrix ----------------------------------------------------------- #' Mixing matrix #' #' Return the mixing matrix for a network, on a given attribute. #' #' @param object a network or some other data structure for which a mixing #' matrix is meaningful. #' @param ... further arguments passed to or used by methods. #' #' @rdname mixingmatrix #' @export mixingmatrix <- function(object, ...) UseMethod("mixingmatrix") # Return the mixing matrix for a network object, on a given attribute. This is # a relocated function from the ergm package; it probably belongs elsewhere, but # is needed for the summary.network method (and in that sense is basic enough to # include. #' @rdname mixingmatrix #' #' @param attrname a vertex attribute name. #' @param expand.bipartite logical; if `object` is bipartite, should we return #' the *square* mixing matrix representing every level of `attrname` against #' every other level, or a *rectangular* matrix considering only levels #' present in each bipartition? #' @param useNA one of "ifany", "no" or "always". Argument passed to #' \code{\link{table}}. By default (\code{useNA = "ifany"}) if there are any #' \code{NA}s on the attribute corresponding row \emph{and} column will be #' contained in the result. See Details. #' @param ... arguments passed to \code{\link{table}}. #' #' @details Handling of missing values on the attribute \code{attrname} almost #' follows similar logic to \code{\link{table}}. If there are \code{NA}s on #' the attribute and \code{useNA="ifany"} (default) the result will contain #' both row and column for the missing values to ensure the resulting matrix #' is square (essentially calling \code{\link{table}} with #' \code{useNA="always"}). Also for that reason passing \code{exclude} #' parameter with \code{NULL}, \code{NA} or \code{NaN} is ignored with a #' warning as it may break the symmetry. #' #' @return Function `mixingmatrix()` returns an object of class `mixingmatrix` #' extending `table` with a cross-tabulation of edges in the `object` #' according to the values of attribute `attrname` for the two incident #' vertices. If `object` is a *directed* network rows correspond to the "tie #' sender" and columns to the "tie receiver". If `object` is an *undirected* #' network there is no such distinction and the matrix is symmetrized. In both #' cases the matrix is square and all the observed values of the attribute #' `attrname` are represented in rows and columns. If `object` is a #' *bipartite* network and `expand.bipartite` is `FALSE` the resulting matrix #' does not have to be square as only the actually observed values of the #' attribute are shown for each partition, if `expand.bipartite` is `TRUE` the #' matrix will be square. #' #' @export #' @examples #' # Interaction ties between Lake Pomona SAR organizations by sponsorship type #' # of tie sender and receiver (data from Drabek et al. 1981) #' data(emon) #' mixingmatrix(emon$LakePomona, "Sponsorship") mixingmatrix.network <- function(object, attrname, useNA = "ifany", expand.bipartite=FALSE, ...) { nw <- object if(missing(attrname)){ stop("attrname argument is missing. mixingmatrix() requires an an attribute name") } if(!(attrname %in% list.vertex.attributes(object))) stop("vertex attribute ", sQuote(attrname), " not found in network ", sQuote(deparse(substitute(object)))) if(network.size(nw)==0L){ warning("mixing matrices not well-defined for graphs with no vertices.") return(as.mixingmatrix( matrix(nrow=0L, ncol=0L), directed = is.directed(object), bipartite = is.bipartite(object) )) } nodecov <- unlist(get.vertex.attribute(nw, attrname)) u<-sort(unique(nodecov)) # nodecovnum <- match(nodecov, u) el <- as.matrix.network.edgelist(nw) type <- "directed" if (is.bipartite(nw)) { # must have heads < tails now if (is.directed(nw)) cat("Warning: Bipartite networks are currently\n", "automatically treated as undirected\n") type <- "bipartite" rowswitch <- apply(el, 1L, function(x) x[1L]>x[2L]) el[rowswitch, 1L:2L] <- el[rowswitch, 2L:1L] nb1 <- get.network.attribute(nw,"bipartite") if(!expand.bipartite) u <- sort(unique(nodecov[1L:nb1])) From <- factor(nodecov[el[,1L]], levels=u) if(!expand.bipartite) u <- sort(unique(nodecov[(nb1+1L):network.size(nw)])) To <- factor(nodecov[el[,2L]], levels=u) }else{ From <- factor(nodecov[el[,1L]], levels=u) To <- factor(nodecov[el[,2L]], levels=u) } if(any(is.na(nodecov)) && useNA == "ifany") useNA <- "always" dots <- list(...) if("exclude" %in% names(dots) && (is.null(dots$exclude) | any(is.na(dots$exclude)) | any(is.nan(dots$exclude)))) { warning("passing `exclude=NULL` to table() is not supported, ignoring") dots$exclude <- NULL } tabu <- do.call(table, c(list(From=From, To=To, useNA=useNA), dots)) if(!is.directed(nw) && !is.bipartite(nw)){ type <- "undirected" tabu <- tabu + t(tabu) diag(tabu) <- diag(tabu)%/%2L } as.mixingmatrix( tabu, directed = is.directed(object), bipartite = is.bipartite(object) ) } #' @rdname mixingmatrix #' #' @note The `$` and `[[` methods are included only for backward-compatiblity #' reason and will become defunct in future releases of the package. #' #' @export "[[.mixingmatrix" <- function(x, ...) { .Deprecated( new = "mixingmatrix", msg = "Mixing matrix objects now extend class \"table\". The `[[` method is deprecated and will be removed from future releases of the package. See ?mixingmatrix for details." ) x <- .to_oldmm(x) NextMethod() } #' @rdname mixingmatrix #' #' @param name name of the element to extract, one of "matrix" or "type" #' #' @export "$.mixingmatrix" <- function(x, name) { .Deprecated( new = "mixingmatrix", msg = "Mixing matrix objects now extend class \"table\". The `$` method is deprecated and will be removed from future releases of the package. See ?mixingmatrix for details." ) x <- .to_oldmm(x) NextMethod() } .to_oldmm <- function(x) { directed <- attr(x, "directed") bipartite <- attr(x, "bipartite") list( matrix = structure(as.integer(x), dimnames=dimnames(x), dim=dim(x)), type = if(bipartite) "bipartite" else if(directed) "directed" else "undirected" ) } # A non-exported constructor of mixingmatrix objects # # @param mat matrix with the actual cross-tabulation # @param directed logical if the network is directed # @param bipartite logical if the netwoek is bipartite # @param ... other arguments currently ignored # # @return The matrix with attributes `directed` and `bipartite` of class # `mixingmatrix` inheriting from `table`. as.mixingmatrix <- function(mat, directed, bipartite, ...) { # Test/check/symmetrize here? structure( mat, directed = directed, bipartite = bipartite, class = c("mixingmatrix", "table") ) } #' @rdname mixingmatrix #' #' @return Functions `is.directed()` and `is.bipartite()` return `TRUE` or #' `FALSE`. The values will be identical for the input network `object`. #' #' @export is.directed.mixingmatrix <- function(x, ...) attr(x, "directed") #' @rdname mixingmatrix #' @export is.bipartite.mixingmatrix <- function(x, ...) attr(x, "bipartite") #' @rdname mixingmatrix #' #' @param x mixingmatrix object #' #' @export print.mixingmatrix <- function(x, ...) { m <- x rn <- rownames(x) cn <- colnames(x) if (!attr(x, "directed")) { dimnames(m) <- list(rn, cn) on.exit( message("Note: Marginal totals can be misleading for undirected mixing matrices.") ) } else { dimnames(m) <- if(attr(x, "bipartite")) list(B1 = rn, B2 = cn) else list(From = rn, To = cn) m <- stats::addmargins(m) } m <- structure( m, directed = attr(x, "directed"), bipartite = attr(x, "bipartite"), class = "table" ) print(m) } # network.density --------------------------------------------------------- #' Compute the Density of a Network #' #' \code{network.density} computes the density of its argument. #' #' The density of a network is defined as the ratio of extant edges to #' potential edges. We do not currently consider edge values; missing edges are #' omitted from extent (but not potential) edge count when #' \code{na.omit==TRUE}. #' #' @param x an object of class \code{network} #' @param na.omit logical; omit missing edges from extant edges when assessing #' density? #' @param discount.bipartite logical; if \code{x} is bipartite, should #' \dQuote{forbidden} edges be excluded from the count of potential edges? #' @return The network density. #' @section Warning : \code{network.density} relies on network attributes (see #' \link{network.indicators}) to determine the properties of the underlying #' network object. If these are set incorrectly (e.g., multiple edges in a #' non-multiplex network, network coded with directed edges but set to #' \dQuote{undirected}, etc.), surprising results may ensue. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network.edgecount}}, \code{\link{network.size}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' #' Wasserman, S. and Faust, K. (1994). \emph{Social Network Analysis: Methods #' and Applications.} Cambridge: Cambridge University Press. #' @keywords graphs #' @examples #' #' #Create an arbitrary adjacency matrix #' m<-matrix(rbinom(25,1,0.5),5,5) #' diag(m)<-0 #' #' g<-network.initialize(5) #Initialize the network #' network.density(g) #Calculate the density #' #' @rdname network.density #' @export network.density network.density<-function(x,na.omit=TRUE,discount.bipartite=FALSE){ if(!is.network(x)) stop("network.density requires a network object.") if(network.size(x)==0){ warning("Density is not well-defined for networks of order 0.") return(NaN) } if(is.multiplex(x)) warning("Network is multiplex - no general way to define density. Returning value for a non-multiplex network (hope that's what you wanted).\n") ec<-network.edgecount(x,na.omit=na.omit) n<-network.size(x) bip<-x%n%"bipartite" if(is.hyper(x)){ if((bip>=0)&&(discount.bipartite)){ pe<-choose(bip,1:bip)*choose(n-bip,1:(n-bip))*(1+is.directed(x)) }else{ if(has.loops(x)) pe<-sum(choose(n,1:n))^(1+is.directed(x)) else pe<-sum(choose(n,1:n))/(1+!is.directed(x)) } }else{ if((bip>=0)&&(discount.bipartite)){ pe<-bip*(n-bip)*(1+is.directed(x)) }else{ pe<-n*(n-1)/(1+!is.directed(x))+(has.loops(x)*network.size(x)) } } ec/pe } # has.edges --------------------------------------------------------------- #' Determine if specified vertices of a network have any edges (are not #' isolates) #' #' Returns a logical value for each specified vertex, indicating if it has any #' incident (in or out) edges. Checks all vertices by default #' #' #' @aliases is.isolate #' @param net a \code{\link{network}} object to be queried #' @param v integer vector of vertex ids to check #' @return returns a logical vector with the same length as v, with TRUE if the #' vertex is involved in any edges, FALSE if it is an isolate. #' @author skyebend #' @examples #' #' test<-network.initialize(5) #' test[1,2]<-1 #' has.edges(test) #' has.edges(test,v=5) #' #' @rdname has.edges #' @export has.edges has.edges<-function(net,v=seq_len(network.size(net))){ if(network.size(net)==0){ return(logical(0)) } if(any(v < 1) | any(v > network.size(net))){ stop("'v' argument must be a valid vertex id in is.isolate") } ins<-sapply(net$iel[v],length) outs<-sapply(net$oel[v],length) return(ins+outs != 0) } # is.color ---------------------------------------------------------------- #' @rdname as.color #' #' @return \code{as.color()} returns TRUE if x is a character in a known color format. #' #' @export is.color<-function(x){ xic<-rep(FALSE,length(x)) #Assume not a color by default xc<-sapply(x,is.character) #Must be a character string #For characters, must be a named color or a #RRGGBB/#RRGGBBAA sequence xic[xc]<-(x[xc]%in%colors())| ((nchar(x[xc])%in%c(7,9))&(substr(x[xc],1,1)=="#")) xic[is.na(x)]<-NA #Missing counts as missing #Return the result xic } #' Internal Network Package Functions #' #' Internal network functions. #' #' Most of these are not to be called by the user. #' #' @name network-internal #' #' @param x an object to be designated either discrete or continuous, or a #' network. #' @param y a network or something coercible to one. #' #' @seealso network #' #' @keywords internal #' @rdname network-internal #' @export is.discrete.numeric<-function(x){ (is.numeric(x)|is.logical(x)) && mean(duplicated(x)) > 0.8 } #' @rdname network-internal #' @export is.discrete.character<-function(x){ (is.character(x)|is.logical(x)) && mean(duplicated(x)) > 0.8 } #' @rdname network-internal #' @export is.discrete<-function(x){ (is.numeric(x)|is.logical(x)|is.character(x)) && mean(duplicated(x)) > 0.8 } # which.matrix.type ------------------------------------------------------- #' Heuristic Determination of Matrix Types for Network Storage #' #' \code{which.matrix.type} attempts to choose an appropriate matrix expression #' for a \code{network} object, or (if its argument is a matrix) attempts to #' determine whether the matrix is of type adjacency, incidence, or edgelist. #' #' The heuristics used to determine matrix types are fairly arbitrary, and #' should be avoided where possible. This function is intended to provide a #' modestly intelligent fallback option when explicit identification by the #' user is not possible. #' #' @param x a matrix, or an object of class \code{network} #' @return One of \code{"adjacency"}, \code{"incidence"}, or \code{"edgelist"} #' @author David Hunter \email{dhunter@@stat.psu.edu} #' @seealso \code{\link{as.matrix.network}}, \code{\link{as.network.matrix}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords graphs #' @examples #' #' #Create an arbitrary adjacency matrix #' m<-matrix(rbinom(25,1,0.5),5,5) #' diag(m)<-0 #' #' #Can we guess the type? #' which.matrix.type(m) #' #' #Try the same thing with a network #' g<-network(m) #' which.matrix.type(g) #' which.matrix.type(as.matrix.network(g,matrix.type="incidence")) #' which.matrix.type(as.matrix.network(g,matrix.type="edgelist")) #' #' @rdname which.matrix.type #' @export which.matrix.type which.matrix.type<-function(x) { if (!is.network(x)) { if (is.character(x<-as.matrix(x))){ if (diff(dim(x))==0) out<-"adjacency" else if (dim(x)[2]==2) out<-"edgelist" else out<-"bipartite" }else if (!is.numeric(x)) out<-NA else if (diff(dim(x))==0) out<-"adjacency" else if (NROW(x)==0) #For a 0-row matrix, an empty edgelist is the best bet... out<-"edgelist" else if (max(abs(x),na.rm=TRUE)==1 && max(abs(x-as.integer(x)),na.rm=TRUE)==0) out<-"bipartite" else if (max(abs(x-as.integer(x))[,1:2],na.rm=TRUE)==0 && min(x[,1:2],na.rm=TRUE)>0) out<-"edgelist" else out<-NA } else { # Very ad-hoc criteria for choosing; choice can be overridden. if (is.hyper(x)) out<-"incidence" else if ((n<-x$gal$n)<14 || x$gal$mnext>n*n/2) out<-"adjacency" else out<-"edgelist" } out } network/R/assignment.R0000644000176200001440000000405513650470664014456 0ustar liggesusers###################################################################### # # assignment.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 11/26/19 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various routines for the assignment of network objects # into calling environments. These are internal functions and not to be used # by the package users. # # Contents: # # .findNameInSubsetExpr # .validLHS # ###################################################################### # Recursively traverse the parse tree of the expression x, ensuring that it is # a valid subset expresssion, and return the name associated with the expression. # .findNameInSubsetExpr <- function(x){ if (inherits(x,'call')){ # Ensure call is a subset function, one of $, [, or [[ if(!(deparse(x[[1]]) %in% c('$','[','[['))) return(NA) # Make sure arguments are clean xns <- lapply(x[2:length(x)],.findNameInSubsetExpr) if (any(is.na(xns))) return(NA) # Possible name found return(xns[[1]]) } else if (inherits(x,'name')) return(deparse(x)) NULL } # Return TRUE if x is a valid left-hand-side object that can take a value .validLHS <- function(x,ev){ xn <- .findNameInSubsetExpr(x) # There are valid expressions for which we don't want to assign into the caller's env. # For instance, when a user executes z<-add.edges(x+y), then the user obviously # doesn't want x+y to be assigned. Rather he's using them as temporaries to obtain # z. OTOH we don't want someone doing something obtuse like add.edges(x[sample(...)]) # In the first case, it's not wrong to end up here, but in the second case we would # like to warn the user. But we're not going to at this point. #warning('Cannot make assignment into ',deparse(x)) if (!is.null(xn) && !is.na(xn) && exists(xn,envir=ev)) return(TRUE) else return(FALSE) } network/R/zzz.R0000644000176200001440000000110414057014734013125 0ustar liggesusers###################################################################### # # zzz.R # # Written by Carter T. Butts . # # Last Modified 11/30/19 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # ###################################################################### .onAttach <- function(libname, pkgname){ #' @importFrom statnet.common statnetStartupMessage sm <- statnetStartupMessage("network", c("statnet","ergm","ergm.count","tergm"), TRUE) if(!is.null(sm)) packageStartupMessage(sm) } network/R/operators.R0000644000176200001440000015071614723241675014332 0ustar liggesusers###################################################################### # # operators.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 06/06/21 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various operators which take networks as inputs. # # Contents: # # "$<-.network" # "[.network" # "[<-.network" # "%e%" # "%e%<-" # "%eattr%" # "%eattr%<-" # "%n%" # "%n%<-" # "%nattr%" # "%nattr%<-" # "%s%" # "%v%" # "%v%<-" # "%vattr%" # "%vattr%<-" # "+" # "+.default" # "+.network" # "-" # "-.default" # "-.network" # "*" # "*.default" # "*.network" # "!.network" # "|.network" # "&.network" # "%*%.network" # "%c%" # "%c%.network" # networkOperatorSetup # prod.network # sum.network # ###################################################################### # removed this function because it appears that '<-' is no longer a generic in R, so it was never getting called and the copy was not being made. See ticket #550 #' @export "<-.network" "<-.network"<-function(x,value){ .Deprecated("network.copy or '<-' works just fine",msg="The network assignment S3 method '<-.network' has been deprecated because the operator '<-' is no longer an S3 generic in R so the .network version does not appear to be called. If you see this warning, please contact the maintainers to let us know you use this function") x<-network.copy(value) return(x) } # A helper function to check that a particular edgelist can be validly queried or assigned to. #' @importFrom statnet.common NVL out_of_bounds <- function(x, el){ n <- network.size(x) bip <- NVL(x%n%"bipartite", FALSE) anyNA(el) || any(el<1L) || any(el>n) || (bip && (any((el[,1]<=bip) == (el[,2]<=bip)))) } # removed so that will dispatch to internal primitive method #642 #"$<-.network"<-function(x,i,value){ # cl<-oldClass(x) # class(x)<-NULL # x[[i]]<-value # class(x)<-cl # return(x) #} #' Extraction and Replacement Operators for Network Objects #' #' Various operators which allow extraction or replacement of various #' components of a \code{network} object. #' #' Indexing for edge extraction operates in a manner analogous to \code{matrix} #' objects. Thus, \code{x[,]} selects all vertex pairs, \code{x[1,-5]} selects #' the pairing of vertex 1 with all vertices except for 5, etc. Following #' this, it is acceptable for \code{i} and/or \code{j} to be logical vectors #' indicating which vertices are to be included. During assignment, an attempt #' is made to match the elements of \code{value} to the extracted pairs in an #' intelligent way; in particular, elements of \code{value} will be replicated #' if too few are supplied (allowing expressions like \code{x[1,]<-1}). Where #' \code{names.eval==NULL}, zero and non-zero values are taken to indicate the #' presence of absence of edges. \code{x[2,4]<-6} thus adds a single (2,4) #' edge to \code{x}, and \code{x[2,4]<-0} removes such an edge (if present). #' If \code{x} is multiplex, assigning 0 to a vertex pair will eliminate #' \emph{all} edges on that pair. Pairs are taken to be directed where #' \code{is.directed(x)==TRUE}, and undirected where #' \code{is.directed(x)==FALSE}. #' #' If an edge attribute is specified using \code{names.eval}, then the provided #' values will be assigned to that attribute. When assigning values, only #' extant edges are employed (unless \code{add.edges==TRUE}); in the latter #' case, any non-zero assignment results in the addition of an edge where #' currently absent. If the attribute specified is not present on a given #' edge, it is added. Otherwise, any existing value is overwritten. The #' \code{\%e\%} operator can also be used to extract/assign edge values; in those #' roles, it is respectively equivalent to \code{get.edge.value(x,attrname)} #' and \code{set.edge.value(x,attrname=attrname,value=value)} (if \code{value} #' is a matrix) and \code{set.edge.attribute(x,attrname=attrname,value=value)} #' (if \code{value} is anything else). That is, if \code{value} is a matrix, #' the assignment operator treats it as an adjacency matrix; and if not, it #' treats it as a vector (recycled as needed) in the internal ordering of edges #' (i.e., edge IDs), skipping over deleted edges. In no case will attributes be #' assigned to nonexisted edges. #' #' The \code{\%n\%} and \code{\%v\%} operators serve as front-ends to the network #' and vertex extraction/assignment functions (respectively). In the #' extraction case, \code{x \%n\% attrname} is equivalent to #' \code{get.network.attribute(x,attrname)}, with \code{x \%v\% attrname} #' corresponding to \code{get.vertex.attribute(x,attrname)}. In assignment, #' the respective equivalences are to #' \code{set.network.attribute(x,attrname,value)} and #' \code{set.vertex.attribute(x,attrname,value)}. Note that the `%%` #' assignment forms are generally slower than the named versions of the #' functions beause they will trigger an additional internal copy of the #' network object. #' #' The \code{\%eattr\%}, \code{\%nattr\%}, and \code{\%vattr\%} operators are #' equivalent to \code{\%e\%}, \code{\%n\%}, and \code{\%v\%} (respectively). The #' short forms are more succinct, but may produce less readable code. #' #' @name network.extraction #' #' @param x an object of class \code{network}. #' @param i,j indices of the vertices with respect to which adjacency is to be #' tested. Empty values indicate that all vertices should be employed (see #' below). #' @param na.omit logical; should missing edges be omitted (treated as #' no-adjacency), or should \code{NA}s be returned? (Default: return \code{NA} #' on missing.) #' @param names.eval optionally, the name of an edge attribute to use for #' assigning edge values. #' @param add.edges logical; should new edges be added to \code{x} where edges #' are absent and the appropriate element of \code{value} is non-zero? #' @param value the value (or set thereof) to be assigned to the selected #' element of \code{x}. #' @param attrname the name of a network or vertex attribute (as appropriate). #' @return The extracted data, or none. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{is.adjacent}}, \code{\link{as.sociomatrix}}, #' \code{\link{attribute.methods}}, \code{\link{add.edges}}, #' \code{\link{network.operators}}, and \code{\link{get.inducedSubgraph}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords graphs manip #' @examples #' #' #Create a random graph (inefficiently) #' g<-network.initialize(10) #' g[,]<-matrix(rbinom(100,1,0.1),10,10) #' plot(g) #' #' #Demonstrate edge addition/deletion #' g[,]<-0 #' g[1,]<-1 #' g[2:3,6:7]<-1 #' g[,] #' #' #Set edge values #' g[,,names.eval="boo"]<-5 #' as.sociomatrix(g,"boo") #' #Assign edge values from a vector #' g %e% "hoo" <- "wah" #' g %e% "hoo" #' g %e% "om" <- c("wow","whee") #' g %e% "om" #' #Assign edge values as a sociomatrix #' g %e% "age" <- matrix(1:100, 10, 10) #' g %e% "age" #' as.sociomatrix(g,"age") #' #' #Set/retrieve network and vertex attributes #' g %n% "blah" <- "Pork!" #The other white meat? #' g %n% "blah" == "Pork!" #TRUE! #' g %v% "foo" <- letters[10:1] #Letter the vertices #' g %v% "foo" == letters[10:1] #All TRUE #' #' @export "[.network" #' @export "[.network"<-function(x,i,j,na.omit=FALSE){ narg<-nargs()+missing(na.omit) n<-network.size(x) bip <- x%n%"bipartite" xnames <- network.vertex.names(x) if(missing(i)){ #If missing, use 1:n i <- if(is.bipartite(x)) 1:bip else 1:n } if((narg>3)&&missing(j)){ j <- if(is.bipartite(x)) (bip+1L):n else 1:n } if(is.matrix(i)&&(NCOL(i)==1)) #Vectorize if degenerate matrix i<-as.vector(i) if(is.matrix(i)){ #Still a matrix? if(is.logical(i)){ #Subset w/T/F? j<-col(i)[i] i<-row(i)[i] if(out_of_bounds(x, cbind(i,j))) stop("subscript out of bounds") out<-is.adjacent(x,i,j,na.omit=na.omit) }else{ #Were we passed a pair list? if(is.character(i)) i<-apply(i,c(1,2),match,xnames) if(out_of_bounds(x, i)) stop("subscript out of bounds") out<-is.adjacent(x,i[,1],i[,2], na.omit=na.omit) } }else if((narg<3)&&missing(j)){ #Here, assume a list of cell numbers ir<-1+((i-1)%%n) ic<-1+((i-1)%/%n) if(out_of_bounds(x, cbind(ir,ic))) stop("subscript out of bounds") out<-is.adjacent(x,ir,ic,na.omit=na.omit) }else{ #Otherwise, assume a vector or submatrix if(is.character(i)) i<-match(i,xnames) if(is.character(j)) j<-match(j,xnames) i<-(1:n)[i] #Piggyback on R's internal tricks j<-(1:n)[j] if(length(i)==1){ if(out_of_bounds(x, cbind(i,j))) stop("subscript out of bounds") out<-is.adjacent(x,i,j,na.omit=na.omit) }else{ if(length(j)==1){ if(out_of_bounds(x, cbind(i,j))) stop("subscript out of bounds") out<-is.adjacent(x,i,j,na.omit=na.omit) }else{ jrep<-rep(j,rep.int(length(i),length(j))) if(length(i)>0) irep<-rep(i,times=ceiling(length(jrep)/length(i))) if(out_of_bounds(x, cbind(irep,jrep))) stop("subscript out of bounds") out<-matrix(is.adjacent(x,irep,jrep,na.omit=na.omit), length(i),length(j)) } } if((!is.null(xnames))&&is.matrix(out)) dimnames(out) <- list(xnames[i],xnames[j]) } out+0 #Coerce to numeric } #' @rdname network.extraction #' @export "[<-.network" #' @export "[<-.network"<-function(x,i,j,names.eval=NULL,add.edges=FALSE,value){ #For the common special case of x[,] <- 0, delete edges quickly by #reconstructing new outedgelists, inedgelists, and edgelists, #leaving the old ones to the garbage collector. if(missing(i) && missing(j) && is.null(names.eval) && isTRUE(all(value==FALSE))){ if(length(x$mel)==0 || network.edgecount(x,na.omit=FALSE)==0) return(x) # Nothing to do; note that missing edges are still edges for the purposes of this. x$oel <- rep(list(integer(0)), length(x$oel)) x$iel <- rep(list(integer(0)), length(x$iel)) x$mel <- list() x$gal$mnext <- 1 return(x) } #Check for hypergraphicity if(is.hyper(x)) stop("Assignment operator overloading does not currently support hypergraphic networks."); #Set up the edge list to change narg<-nargs()+missing(names.eval)+missing(add.edges) n<-network.size(x) xnames <- network.vertex.names(x) bip <- x%n%"bipartite" if(missing(i)){ #If missing, use 1:n i <- if(is.bipartite(x)) 1:bip else 1:n } if((narg>5)&&missing(j)){ j <- if(is.bipartite(x)) (bip+1L):n else 1:n } if(is.matrix(i)&&(NCOL(i)==1)) #Vectorize if degenerate matrix i<-as.vector(i) if(is.matrix(i)){ #Still a matrix? if(is.logical(i)){ #Subset w/T/F? j<-col(i)[i] i<-row(i)[i] el<-cbind(i,j) }else{ #Were we passed a pair list? if(is.character(i)) i<-apply(i,c(1,2),match,xnames) el<-i } }else if((narg<6)&&missing(j)){ #Here, assume a list of cell numbers el<-1+cbind((i-1)%%n,(i-1)%/%n) }else{ #Otherwise, assume a vector or submatrix if(is.character(i)) i<-match(i,xnames) if(is.character(j)) j<-match(j,xnames) i<-(1:n)[i] #Piggyback on R's internal tricks j<-(1:n)[j] if(length(i)==1){ el<-cbind(rep(i,length(j)),j) }else{ if(length(j)==1) el<-cbind(i,rep(j,length(i))) else{ jrep<-rep(j,rep.int(length(i),length(j))) if(length(i)>0) irep<-rep(i,times=ceiling(length(jrep)/length(i))) el<-cbind(irep,jrep) } } } # Check bounds if(out_of_bounds(x, el)) stop("subscript out of bounds") #Set up values if(is.matrix(value)) val<-value[cbind(match(el[,1],sort(unique(el[,1]))), match(el[,2],sort(unique(el[,2]))))] else val<-rep(as.vector(value),length.out=NROW(el)) #Perform the changes if(is.null(names.eval)){ #If no names given, don't store values for (k in seq_along(val)) { eid <- get.edgeIDs(x,el[k,1],el[k,2],neighborhood="out", na.omit=FALSE) if (!is.na(val[k]) & val[k] == 0) { # delete edge if (length(eid) > 0) x<-delete.edges(x,eid) } else { if (length(eid) == 0 & (has.loops(x)|(el[k,1]!=el[k,2]))) { # add edge if needed x<-add.edges(x,as.list(el[k,1]),as.list(el[k,2])) eid <- get.edgeIDs(x,el[k,1],el[k,2],neighborhood="out", na.omit=FALSE) } if (is.na(val[k])) { set.edge.attribute(x,"na",TRUE,eid) # set to NA } else if (val[k] == 1) { set.edge.attribute(x,"na",FALSE,eid) # set to 1 } } } }else{ #An attribute name was given, so store values epresent<-vector() eid<-vector() valsl<-list() for(k in 1:NROW(el)){ if(is.adjacent(x,el[k,1],el[k,2],na.omit=FALSE)){ #Collect extant edges loceid<-get.edgeIDs(x,el[k,1],el[k,2],neighborhood="out",na.omit=FALSE) if(add.edges){ #Need to know if we're adding/removing edges if(val[k]==0){ #If 0 and adding/removing, eliminate present edges x<-delete.edges(x,loceid) }else{ #Otherwise, add as normal valsl<-c(valsl,as.list(rep(val[k],length(loceid)))) eid<-c(eid,loceid) } }else{ valsl<-c(valsl,as.list(rep(val[k],length(loceid)))) eid<-c(eid,loceid) } epresent[k]<-TRUE }else epresent[k]<-!is.na(val[k]) && (val[k]==0) #If zero, skip it; otherwise (including NA), add } if(sum(epresent)>0) #Adjust attributes for extant edges x<-set.edge.attribute(x,names.eval,valsl,eid) if(add.edges&&(sum(!epresent)>0)) #Add new edges, if needed x<-add.edges(x,as.list(el[!epresent,1]),as.list(el[!epresent,2]), names.eval=as.list(rep(names.eval,sum(!epresent))),vals.eval=as.list(val[!epresent])) } #Return the modified graph x } #' @rdname network.extraction #' @export "%e%"<-function(x,attrname){ get.edge.value(x,attrname=attrname) } #' @rdname network.extraction #' @usage x \%e\% attrname <- value #' @export "%e%<-"<-function(x,attrname,value){ if(is.matrix(value)) set.edge.value(x,attrname=attrname,value=value) else set.edge.attribute(x,attrname=attrname,value=value,e=valid.eids(x)) } #' @rdname network.extraction #' @export "%eattr%"<-function(x,attrname){ x %e% attrname } #' @rdname network.extraction #' @usage x \%eattr\% attrname <- value #' @export "%eattr%<-"<-function(x,attrname,value){ x %e% attrname <- value } #' @rdname network.extraction #' @export "%n%"<-function(x,attrname){ get.network.attribute(x,attrname=attrname) } #' @rdname network.extraction #' @usage x \%n\% attrname <- value #' @export "%n%<-"<-function(x,attrname,value){ set.network.attribute(x,attrname=attrname,value=value) } #' @rdname network.extraction #' @export "%nattr%"<-function(x,attrname){ x %n% attrname } #' @rdname network.extraction #' @usage x \%nattr\% attrname <- value #' @export "%nattr%<-"<-function(x,attrname,value){ x %n% attrname <- value } #' @rdname get.inducedSubgraph #' @usage x \%s\% v #' @export "%s%"<-function(x,v){ if(is.list(v)) get.inducedSubgraph(x,v=v[[1]],alters=v[[2]]) else get.inducedSubgraph(x,v=v) } #' @rdname network.extraction #' @export "%v%"<-function(x,attrname){ get.vertex.attribute(x,attrname=attrname) } #' @rdname network.extraction #' @usage x \%v\% attrname <- value #' @export "%v%<-"<-function(x,attrname,value){ set.vertex.attribute(x,attrname=attrname,value=value) } #' @rdname network.extraction #' @export "%vattr%"<-function(x,attrname){ x %v% attrname } #' @rdname network.extraction #' @usage x \%vattr\% attrname <- value #' @export "%vattr%<-"<-function(x,attrname,value){ x %v% attrname <- value } #"+"<-function(e1, e2, ...) UseMethod("+") # #"+.default"<-function(e1,e2,...) { (base::"+")(e1,e2) } # #"+.network"<-function(e1,e2,attrname=NULL,...){ # e1<-as.sociomatrix(e1,attrname=attrname) # e2<-as.sociomatrix(e2,attrname=attrname) # network(e1+e2,ignore.eval=is.null(attrname),names.eval=attrname) #} #' Network Operators #' #' These operators allow for algebraic manipulation of relational structures. #' #' In general, the binary network operators function by producing a new network #' object whose edge structure is based on that of the input networks. The #' properties of the new structure depend upon the inputs as follows: \itemize{ #' \item The size of the new network is equal to the size of the input networks #' (for all operators save \code{\%c\%}), which must themselves be of equal size. #' Likewise, the \code{bipartite} attributes of the inputs must match, and this #' is preserved in the output. \item If either input network allows loops, #' multiplex edges, or hyperedges, the output acquires this property. (If both #' input networks do not allow these features, then the features are disallowed #' in the output network.) \item If either input network is directed, the #' output is directed; if exactly one input network is directed, the undirected #' input is treated as if it were a directed network in which all edges are #' reciprocated. \item Supplemental attributes (including vertex names, but #' not edgwise missingness) are not transferred to the output. } The unary #' operator acts per the above, but with a single input. Thus, the output #' network has the same properties as the input, with the exception of #' supplemental attributes. #' #' The behavior of the composition operator, \code{\%c\%}, is somewhat more #' complex than the others. In particular, it will return a bipartite network #' whenever either input network is bipartite \emph{or} the vertex names of the #' two input networks do not match (or are missing). If both inputs are #' non-bipartite and have identical vertex names, the return value will have #' the same structure (but with loops). This behavior corresponds to the #' interpretation of the composition operator as counting walks on labeled sets #' of vertices. #' #' Hypergraphs are not yet supported by these routines, but ultimately will be #' (as suggested by the above). #' #' The specific operations carried out by these operators are generally #' self-explanatory in the non-multiplex case, but semantics in the latter #' circumstance bear elaboration. The following summarizes the behavior of #' each operator: #' \describe{ #' \item{\code{+}}{An \eqn{(i,j)} edge is created in #' the return graph for every \eqn{(i,j)} edge in each of the input graphs.} #' \item{\code{-}}{An \eqn{(i,j)} edge is created in the return graph for #' every \eqn{(i,j)} edge in the first input that is not matched by an #' \eqn{(i,j)} edge in the second input; if the second input has more #' \eqn{(i,j)} edges than the first, no \eqn{(i,j)} edges are created in the #' return graph.} #' \item{\code{*}}{An \eqn{(i,j)} edge is created for every #' pairing of \eqn{(i,j)} edges in the respective input graphs.} #' \item{\code{\%c\%}}{An \eqn{(i,j)} edge is created in the return graph for #' every edge pair \eqn{(i,k),(k,j)} with the first edge in the first input and #' the second edge in the second input.} #' \item{\code{!}}{An \eqn{(i,j)} edge #' is created in the return graph for every \eqn{(i,j)} in the input not having #' an edge.} #' \item{\code{|}}{An \eqn{(i,j)} edge is created in the return #' graph if either input contains an \eqn{(i,j)} edge.} #' \item{\code{&}}{An #' \eqn{(i,j)} edge is created in the return graph if both inputs contain an #' \eqn{(i,j)} edge.} #' } #' Semantics for missing-edge cases follow from the above, #' under the interpretation that edges with \code{na==TRUE} are viewed as #' having an unknown state. Thus, for instance, \code{x*y} with \code{x} #' having 2 \eqn{(i,j)} non-missing and 1 missing edge and \code{y} having 3 #' respective non-missing and 2 missing edges will yield an output network with #' 6 non-missing and 9 missing \eqn{(i,j)} edges. #' #' @rdname network-operators #' @name network.operators #' #' @aliases %c% #' @param e1 an object of class \code{network}. #' @param e2 another \code{network}. #' @return The resulting network. #' @note Currently, there is a naming conflict between the composition operator #' and the \code{\%c\%} operator in the \code{\link[sna]{sna}} package. This #' will be resolved in future releases; for the time being, one can determine #' which version of \code{\%c\%} is in use by varying which package is loaded #' first. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network.extraction}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' #' Wasserman, S. and Faust, K. (1994). \emph{Social Network Analysis: Methods #' and Applications.} Cambridge: University of Cambridge Press. #' @keywords math graphs #' @examples #' #' #Create an in-star #' m<-matrix(0,6,6) #' m[2:6,1]<-1 #' g<-network(m) #' plot(g) #' #' #Compose g with its transpose #' gcgt<-g %c% (network(t(m))) #' plot(gcgt) #' gcgt #' #' #Show the complement of g #' !g #' #' #Perform various arithmatic and logical operations #' (g+gcgt)[,] == (g|gcgt)[,] #All TRUE #' (g-gcgt)[,] == (g&(!(gcgt)))[,] #' (g*gcgt)[,] == (g&gcgt)[,] #' @export "+.network" #' @export "+.network"<-function(e1,e2){ #Set things up outinf<-networkOperatorSetup(x=e1,y=e2) #Select edges to add; semantics are "adding" edges, which is like union #in the non-multigraph case, but actually results in accumulating edge copies #in for multiplex graphs. out<-outinf$net if(is.hyper(out)){ #Hypergraph; for now, return an apology stop("Elementwise operations on hypergraphs not yet supported.") }else{ #Dyadic network out<-outinf$net #For boolean addition, take the union of edge sets el<-rbind(outinf$elx,outinf$ely) elna<-rbind(outinf$elnax,outinf$elnay) if(!is.multiplex(out)){ #If not multiplex, remove duplicates el<-unique(el) elna<-unique(elna) if(NROW(el)>0&&NROW(elna)>0){ n<-network.size(out) elnum<-(el[,1]-1)+n*(el[,2]-1) elnanum<-(elna[,1]-1)+n*(elna[,2]-1) elna<-elna[!(elnanum%in%elnum),,drop=FALSE] #For union, NA loses } } if(NROW(el)>0) #Add non-missing edges add.edges(out,tail=el[,1],head=el[,2]) if(NROW(elna)>0) #Add missing edges add.edges(out,tail=elna[,1],head=elna[,2], names.eval=replicate(NROW(elna),list("na")), vals.eval=replicate(NROW(elna),list(list(na=TRUE)))) } #Return the resulting network out } #"-"<-function(e1, e2, ...) UseMethod("-") # #"-.default"<-function(e1,e2,...) { (base::"-")(e1,e2) } # #' @rdname network-operators #' @export "-.network" #' @export "-.network"<-function(e1,e2){ #Set things up outinf<-networkOperatorSetup(x=e1,y=e2) #Semantics here are "edge subtraction"; this is like "and not" for the #non-multiplex case, but in the latter we can think of it as subtracting #copies of edges (so if there were 5 copies of (i,j) in e1 and 2 copies in #e2, we would be left with 3 copies). Note that this means that NAs are #asymmetric: an edge in e2 will first cancel a "sure" edge, and then an #NA edge when the sure ones are exhausted. NA edges in e2 don't cancel #sure edges in e1, but they render them unsure (i.e., NA). NAs in e2 #have no effect on remaining NAs in e1 (unsure vs unsure), nor on 0s. out<-outinf$net if(is.hyper(out)){ #Hypergraph; for now, return an apology stop("Elementwise operations on hypergraphs not yet supported.") }else{ #Dyadic network out<-outinf$net #For boolean subtraction, want edges in e1 that are not in e2 el<-outinf$elx elna<-outinf$elnax if(!is.multiplex(out)){ #If not multiplex, cancellation is absolute n<-network.size(out) elnum<-(el[,1]-1)+n*(el[,2]-1) elnanum<-(elna[,1]-1)+n*(elna[,2]-1) elynum<-(outinf$ely[,1]-1)+n*(outinf$ely[,2]-1) elynanum<-(outinf$elnay[,1]-1)+n*(outinf$elnay[,2]-1) #For every edge or NA edge in x, kill it if in ely sel<-!(elnum%in%elynum) el<-el[sel,,drop=FALSE] elnum<-elnum[sel] sel<-!(elnanum%in%elynum) elna<-elna[sel,,drop=FALSE] elnanum<-elnanum[sel] #Now, for the remaining edges from x, set to NA if in elyna sel<-!(elnum%in%elynanum) elna<-rbind(elna,el[!sel,,drop=FALSE]) el<-el[sel,,drop=FALSE] #Clean up any non-uniqueness (recall that el, elna started unique) elna<-unique(elna) }else{ #If multiplex, cancellation is 1:1 n<-network.size(out) elnum<-(el[,1]-1)+n*(el[,2]-1) elnanum<-(elna[,1]-1)+n*(elna[,2]-1) elynum<-(outinf$ely[,1]-1)+n*(outinf$ely[,2]-1) elynanum<-(outinf$elnay[,1]-1)+n*(outinf$elnay[,2]-1) #Every edge in ely kills one copy of the corresponding edge in el i<-1 while((NROW(el)>0)&&(i<=length(elynum))){ j<-match(elynum[i],elnum) if(is.na(j)){ #No match; increment i i<-i+1 }else{ #Match! Cancel both and don't increment el<-el[-j,,drop=FALSE] elnum<-elnum[-j] elynum<-elynum[-i] } } #Every remaining ely kills one copy of the corresponding edge in elna i<-1 while((NROW(elna)>0)&&(i<=length(elynum))){ j<-match(elynum[i],elnanum) if(is.na(j)){ #No match; increment i i<-i+1 }else{ #Match! Cancel both and don't increment elna<-elna[-j,,drop=FALSE] elnanum<-elnanum[-j] elynum<-elynum[-i] } } #Every elnay converts one corresponding el to elna i<-1 while((NROW(el)>0)&&(i<=length(elynanum))){ j<-match(elynanum[i],elnum) if(is.na(j)){ #No match; increment i i<-i+1 }else{ #Match! Cancel both and don't increment elna<-rbind(elna,el[j,,drop=FALSE]) el<-el[-j,,drop=FALSE] elnum<-elnum[-j] elynanum<-elynanum[-i] } } } if(NROW(el)>0) #Add non-missing edges add.edges(out,tail=el[,1],head=el[,2]) if(NROW(elna)>0) #Add missing edges add.edges(out,tail=elna[,1],head=elna[,2], names.eval=replicate(NROW(elna),list("na")), vals.eval=replicate(NROW(elna),list(list(na=TRUE)))) } #Return the resulting network out } #"*"<-function(e1, e2, ...) UseMethod("*") # #"*.default"<-function(e1,e2,...) { (base::"*")(e1,e2) } # #' @rdname network-operators #' @export "*.network" #' @export "*.network"<-function(e1,e2){ #Set things up outinf<-networkOperatorSetup(x=e1,y=e2) #Multiplication semantics here are like "and" in the non-multiplex case, #but in the multiplex case we assume that the number of edges is itself #multplied. Multiplication is treated by pairing, so the number of sure #edges is sure(e1)*sure(e2), and the number of NA edges is #sure(e1)*NA(e2) + NA(e1)*sure(e2) + NA(e1)*NA(e2), where sure and NA are #here counts of the (i,j) edge that are non-missing or missing #(respectively). out<-outinf$net if(is.hyper(out)){ #Hypergraph; for now, return an apology stop("Elementwise operations on hypergraphs not yet supported.") }else{ #Dyadic network out<-outinf$net n<-network.size(out) el<-matrix(nrow=0,ncol=2) elna<-matrix(nrow=0,ncol=2) if(is.multiplex(out)){ #Multiplex case: add edge for every pair allpairs<-unique(rbind(outinf$elx,outinf$elnax,outinf$ely,outinf$elnay)) allnum<-(allpairs[,1]-1)+n*(allpairs[,2]-1) elxnum<-(outinf$elx[,1]-1)+n*(outinf$elx[,2]-1) elxnanum<-(outinf$elnax[,1]-1)+n*(outinf$elnax[,2]-1) elynum<-(outinf$ely[,1]-1)+n*(outinf$ely[,2]-1) elynanum<-(outinf$elnay[,1]-1)+n*(outinf$elnay[,2]-1) allxcnt<-sapply(allnum,function(z,w){sum(z==w)},w=elxnum) allxnacnt<-sapply(allnum,function(z,w){sum(z==w)},w=elxnanum) allycnt<-sapply(allnum,function(z,w){sum(z==w)},w=elynum) allynacnt<-sapply(allnum,function(z,w){sum(z==w)},w=elynanum) el<-allpairs[rep(1:length(allnum),times=allxcnt*allycnt),,drop=FALSE] elna<-allpairs[rep(1:length(allnum),times=allxcnt*allynacnt+ allxnacnt*allycnt+allxnacnt*allynacnt),,drop=FALSE] }else{ #Non-multiplex case: "and" elx<-unique(outinf$elx) elnax<-unique(outinf$elnax) ely<-unique(outinf$ely) elnay<-unique(outinf$elnay) elxnum<-(elx[,1]-1)+n*(elx[,2]-1) elxnanum<-(elnax[,1]-1)+n*(elnax[,2]-1) sel<-elxnanum%in%elxnum #Override NA with edges w/in x if(sum(sel)>0){ elnax<-elnax[!sel,,drop=FALSE] elxnanum<-elxnanum[!sel,,drop=FALSE] } elynum<-(ely[,1]-1)+n*(ely[,2]-1) elynanum<-(elnay[,1]-1)+n*(elnay[,2]-1) sel<-elynanum%in%elynum #Override NA with edges w/in y if(sum(sel)>0){ elnay<-elnay[!sel,,drop=FALSE] elynanum<-elynanum[!sel,,drop=FALSE] } #Check for matches across the "sure" edges ematch<-match(elxnum,elynum) el<-rbind(el,elx[!is.na(ematch),,drop=FALSE]) elx<-elx[is.na(ematch),,drop=FALSE] #Remove the matched cases elxnum<-elxnum[is.na(ematch)] if(length(ematch[!is.na(ematch)])>0){ ely<-ely[-ematch[!is.na(ematch)],,drop=FALSE] elynum<-elynum[-ematch[!is.na(ematch)]] } #Match sure xs with unsure ys if(length(elxnum)*length(elynanum)>0){ ematch<-match(elxnum,elynanum) elna<-rbind(elna,elx[!is.na(ematch),,drop=FALSE]) elx<-elx[is.na(ematch),,drop=FALSE] #Remove the matched cases elxnum<-elxnum[is.na(ematch)] if(length(ematch[!is.na(ematch)])>0){ elnay<-elnay[-ematch[!is.na(ematch)],,drop=FALSE] elynanum<-elynanum[-ematch[!is.na(ematch)]] } } #Match sure ys with unsure xs if(length(elynum)*length(elxnanum)>0){ ematch<-match(elynum,elxnanum) elna<-rbind(elna,ely[!is.na(ematch),,drop=FALSE]) ely<-ely[is.na(ematch),,drop=FALSE] #Remove the matched cases elynum<-elynum[is.na(ematch)] if(length(ematch[!is.na(ematch)])>0){ elnax<-elnax[-ematch[!is.na(ematch)],,drop=FALSE] elxnanum<-elxnanum[-ematch[!is.na(ematch)]] } } #Match unsure xs with unsure ys if(length(elxnanum)*length(elynanum)>0){ ematch<-match(elxnanum,elynanum) elna<-rbind(elna,elnax[!is.na(ematch),,drop=FALSE]) } } if(NROW(el)>0) #Add non-missing edges add.edges(out,tail=el[,1],head=el[,2]) if(NROW(elna)>0) #Add missing edges add.edges(out,tail=elna[,1],head=elna[,2], names.eval=replicate(NROW(elna),list("na")), vals.eval=replicate(NROW(elna),list(list(na=TRUE)))) } #Return the resulting network out } #' @rdname network-operators #' @export "!.network" #' @export "!.network"<-function(e1){ #Set things up outinf<-networkOperatorSetup(x=e1) #Select edges to add; semantics are "not" which means that one takes the #non-multiplex complement of edges. Any sure edge implies 0, an NA edge #without a sure edge implies NA, no sure or NA edge implies 1. out<-outinf$net if(is.hyper(out)){ #Hypergraph; for now, return an apology stop("Elementwise operations on hypergraphs not yet supported.") }else{ #Dyadic network out<-outinf$net n<-network.size(out) #Start with the complete graph, and cut things away el<-cbind(rep(1:n,each=n),rep(1:n,n)) if(!is.directed(out)) #Needs to match order in networkOperatorSetup el<-el[el[,1]<=el[,2],] if(!has.loops(out)) el<-el[el[,1]!=el[,2],] elnum<-(el[,1]-1)+n*(el[,2]-1) elna<-matrix(nrow=0,ncol=2) #Remove all sure edges elx<-unique(outinf$elx) elxnum<-(elx[,1]-1)+n*(elx[,2]-1) ematch<-match(elxnum,elnum) if(length(ematch[!is.na(ematch)])>0){ el<-el[-ematch[!is.na(ematch)],,drop=FALSE] elnum<-elnum[-ematch[!is.na(ematch)]] } #Convert all unsure edges to NAs elnax<-unique(outinf$elnax) elxnanum<-(elnax[,1]-1)+n*(elnax[,2]-1) ematch<-match(elxnanum,elnum) if(length(ematch[!is.na(ematch)])>0){ elna<-el[ematch[!is.na(ematch)],,drop=FALSE] el<-el[-ematch[!is.na(ematch)],,drop=FALSE] } if(NROW(el)>0) #Add non-missing edges add.edges(out,tail=el[,1],head=el[,2]) if(NROW(elna)>0) #Add missing edges add.edges(out,tail=elna[,1],head=elna[,2], names.eval=replicate(NROW(elna),list("na")), vals.eval=replicate(NROW(elna),list(list(na=TRUE)))) } #Return the resulting network out } #' @rdname network-operators #' @export "|.network" #' @export "|.network"<-function(e1,e2){ #Set things up outinf<-networkOperatorSetup(x=e1,y=e2) #Select edges to add; semantics are "or," which means that one takes the #non-multiplex union of edges (like the non-multiplex case of the + #operator). Here, a sure edge in either input graph will override an NA, #and an NA will override a zero. out<-outinf$net if(is.hyper(out)){ #Hypergraph; for now, return an apology stop("Elementwise operations on hypergraphs not yet supported.") }else{ #Dyadic network out<-outinf$net #For boolean addition, take the union of edge sets el<-rbind(outinf$elx,outinf$ely) elna<-rbind(outinf$elnax,outinf$elnay) el<-unique(el) elna<-unique(elna) if(NROW(el)>0&&NROW(elna)>0){ n<-network.size(out) elnum<-(el[,1]-1)+n*(el[,2]-1) elnanum<-(elna[,1]-1)+n*(elna[,2]-1) elna<-elna[!(elnanum%in%elnum),,drop=FALSE] #For union, NA loses } if(NROW(el)>0) #Add non-missing edges add.edges(out,tail=el[,1],head=el[,2]) if(NROW(elna)>0) #Add missing edges add.edges(out,tail=elna[,1],head=elna[,2], names.eval=replicate(NROW(elna),list("na")), vals.eval=replicate(NROW(elna),list(list(na=TRUE)))) } #Return the resulting network out } #' @rdname network-operators #' @export "&.network" #' @export "&.network"<-function(e1,e2){ #Set things up outinf<-networkOperatorSetup(x=e1,y=e2) #Select edges to add; semantics are "and," which means that one places an #(i,j) edge if there exists a sure (i,j) edge in both e1 and e2. If there #is not a sure edge in each but there is at least an unsure edge in each, #then we place an NA in the (i,j) slot. Otherwise, we leave it empty. This #is just like boolean "and" for non-multiplex graphs, but is not quite the #same in the multiplex case. out<-outinf$net if(is.hyper(out)){ #Hypergraph; for now, return an apology stop("Elementwise operations on hypergraphs not yet supported.") }else{ #Dyadic network out<-outinf$net n<-network.size(out) el<-matrix(nrow=0,ncol=2) elna<-matrix(nrow=0,ncol=2) elx<-unique(outinf$elx) elnax<-unique(outinf$elnax) ely<-unique(outinf$ely) elnay<-unique(outinf$elnay) elxnum<-(elx[,1]-1)+n*(elx[,2]-1) elxnanum<-(elnax[,1]-1)+n*(elnax[,2]-1) sel<-elxnanum%in%elxnum #Override NA with edges w/in x if(sum(sel)>0){ elnax<-elnax[!sel,,drop=FALSE] elxnanum<-elxnanum[!sel,,drop=FALSE] } elynum<-(ely[,1]-1)+n*(ely[,2]-1) elynanum<-(elnay[,1]-1)+n*(elnay[,2]-1) sel<-elynanum%in%elynum #Override NA with edges w/in y if(sum(sel)>0){ elnay<-elnay[!sel,,drop=FALSE] elynanum<-elynanum[!sel,,drop=FALSE] } #Check for matches across the "sure" edges ematch<-match(elxnum,elynum) el<-rbind(el,elx[!is.na(ematch),,drop=FALSE]) elx<-elx[is.na(ematch),,drop=FALSE] #Remove the matched cases elxnum<-elxnum[is.na(ematch)] if(length(ematch[!is.na(ematch)])>0){ ely<-ely[-ematch[!is.na(ematch)],,drop=FALSE] elynum<-elynum[-ematch[!is.na(ematch)]] } #Match sure xs with unsure ys if(length(elxnum)*length(elynanum)>0){ ematch<-match(elxnum,elynanum) elna<-rbind(elna,elx[!is.na(ematch),,drop=FALSE]) elx<-elx[is.na(ematch),,drop=FALSE] #Remove the matched cases elxnum<-elxnum[is.na(ematch)] if(length(ematch[!is.na(ematch)])>0){ elnay<-elnay[-ematch[!is.na(ematch)],,drop=FALSE] elynanum<-elynanum[-ematch[!is.na(ematch)]] } } #Match sure ys with unsure xs if(length(elynum)*length(elxnanum)>0){ ematch<-match(elynum,elxnanum) elna<-rbind(elna,ely[!is.na(ematch),,drop=FALSE]) ely<-ely[is.na(ematch),,drop=FALSE] #Remove the matched cases elynum<-elynum[is.na(ematch)] if(length(ematch[!is.na(ematch)])>0){ elnax<-elnax[-ematch[!is.na(ematch)],,drop=FALSE] elxnanum<-elxnanum[-ematch[!is.na(ematch)]] } } #Match unsure xs with unsure ys if(length(elxnanum)*length(elynanum)>0){ ematch<-match(elxnanum,elynanum) elna<-rbind(elna,elnax[!is.na(ematch),,drop=FALSE]) } if(NROW(el)>0) #Add non-missing edges add.edges(out,tail=el[,1],head=el[,2]) if(NROW(elna)>0) #Add missing edges add.edges(out,tail=elna[,1],head=elna[,2], names.eval=replicate(NROW(elna),list("na")), vals.eval=replicate(NROW(elna),list(list(na=TRUE)))) } #Return the resulting network out } # --------------------------- %c% ------------------------------- # conditionally create this method, as it may allready have # been created and loaded by sna package if (!exists('%c%')){ #' @export "%c%" "%c%"<-function(e1,e2){ UseMethod("%c%",e1) } } #' @rdname network-operators #' @export "%c%.network" #' @export "%c%.network"<-function(e1,e2){ #Set things up net1<-networkOperatorSetup(x=e1) net2<-networkOperatorSetup(x=e2) if(is.bipartite(net1$net)){ #Find in/out set sizes for e1 insz1<-net1$net%n%"bipartite" outsz1<-net1$net%n%"n"-net1$net%n%"bipartite" }else{ insz1<-net1$net%n%"n" outsz1<-net1$net%n%"n" } if(is.bipartite(net2$net)){ #Find in/out set sizes for e2 insz2<-net2$net%n%"bipartite" outsz2<-net2$net%n%"n"-net2$net%n%"bipartite" }else{ insz2<-net2$net%n%"n" outsz2<-net2$net%n%"n" } if(outsz1!=insz2) stop("Non-conformable relations in %c%. Cannot compose.") if(is.hyper(net1$net)||is.hyper(net2$net)) #Hypergraph; for now, stop stop("Elementwise operations on hypergraphs not yet supported.") #Test for vertex name matching (governs whether we treat as bipartite) if(is.network(e1)) vnam1<-network.vertex.names(e1) else if(!is.null(attr(e1,"vnames"))) vnam1<-attr(e1,"vnames") else if(is.matrix(e1)||is.data.frame(e1)||is.array(e1)) vnam1<-row.names(e1) else vnam1<-NULL if(is.network(e2)) vnam2<-network.vertex.names(e2) else if(!is.null(attr(e2,"vnames"))) vnam2<-attr(e2,"vnames") else if(is.matrix(e2)||is.data.frame(e2)||is.array(e2)) vnam2<-row.names(e2) else vnam2<-NULL if((!is.null(vnam1))&&(!is.null(vnam2))&&(length(vnam1)==length(vnam2)) &&all(vnam1==vnam2)) vnammatch<-TRUE else vnammatch<-FALSE #Decide on bipartite representation and create graph if((!is.bipartite(net1$net))&&(!is.bipartite(net2$net))&&vnammatch) out<-network.initialize(insz1, directed=is.directed(net1$net)|is.directed(net2$net), loops=TRUE,multiple=is.multiplex(net1$net)|is.multiplex(net2$net)) else out<-network.initialize(insz1+outsz2,bipartite=insz1, directed=is.directed(net1$net)|is.directed(net2$net),multiple=is.multiplex(net1$net)|is.multiplex(net2$net)) #Accumulate edges (yeah, could be made more efficient -- cope with it) el<-matrix(nrow=0,ncol=2) elna<-matrix(nrow=0,ncol=2) bip1<-net1$net%n%"bipartite" bip2<-net2$net%n%"bipartite" if(!is.directed(net1$net)){ #Double the edges if undirected net1$elx<-rbind(net1$elx,net1$elx[net1$elx[,1]!=net1$elx[,2],2:1]) net1$elnax<-rbind(net1$elnax,net1$elnax[net1$elnax[,1]!=net1$elnax[,2],2:1]) } if(!is.directed(net2$net)){ #Double the edges if undirected net2$elx<-rbind(net2$elx,net2$elx[net2$elx[,1]!=net2$elx[,2],2:1]) net2$elnax<-rbind(net2$elnax,net2$elnax[net2$elnax[,1]!=net2$elnax[,2],2:1]) } if(NROW(net1$elx)>0){ for(i in 1:NROW(net1$elx)){ sel<-net2$elx[net2$elx[,1]==(net1$elx[i,2]-bip1),2]-bip2 if(length(sel)>0) el<-rbind(el,cbind(rep(net1$elx[i,1],length(sel)),sel+insz1)) } } if(NROW(net1$elnax)>0){ for(i in 1:NROW(net1$elnax)){ sel<-net2$elnax[net2$elnax[,1]==(net1$elnax[i,2]-bip1),2]-bip2 if(length(sel)>0) elna<-rbind(elna,cbind(rep(net1$elnax[i,1],length(sel)),sel+insz1)) } } if(!is.bipartite(out)){ #If not bipartite, remove the insz1 offset if(NROW(el)>0) el[,2]<-el[,2]-insz1 if(NROW(elna)>0) elna[,2]<-elna[,2]-insz1 } if(!is.multiplex(out)){ #If necessary, consolidate edges if(NROW(el)>1) el<-unique(el) if(NROW(elna)>1){ elna<-unique(elna) } if(NROW(elna)>0&&NROW(el)>0){ sel<-rep(TRUE,NROW(elna)) for(i in 1:NROW(elna)){ if(any((el[,1]==elna[i,1])&(el[,2]==elna[i,2]))) sel[i]<-FALSE } elna<-elna[sel,] } } #Add the edges if(NROW(el)>0) #Add non-missing edges add.edges(out,tail=el[,1],head=el[,2]) if(NROW(elna)>0) #Add missing edges add.edges(out,tail=elna[,1],head=elna[,2], names.eval=replicate(NROW(elna),list("na")), vals.eval=replicate(NROW(elna),list(list(na=TRUE)))) #Return the resulting network out } #Given one or two input networks, return the information needed to generate #output for binary or unary operations. The return value for this function is #a list with elements: # net: the output network (empty, but with attributes set) # elx: the edgelist for the first network (non-missing) # elnax: the list of missing edges for the first network # ely: in the binary case, the edgelist for the second network (non-missing) # elnay: in the binary case, the list of missing edges for the second network #' @rdname network-internal networkOperatorSetup<-function(x,y=NULL){ #Determine what attributes the output should have if(is.network(x)){ nx<-network.size(x) #Get size, directedness, multiplexity, bipartition dx<-is.directed(x) mx<-is.multiplex(x) hx<-is.hyper(x) lx<-has.loops(x) bx<-x%n%"bipartite" if(is.null(bx)) bx<-FALSE }else{ #If not a network object, resort to adj form x<-as.sociomatrix(x) if(NROW(x)!=NCOL(x)){ #Bipartite matrix nx<-NROW(x)+NCOL(x) dx<-FALSE mx<-FALSE hx<-FALSE lx<-FALSE bx<-NROW(x) }else{ nx<-NROW(x) dx<-TRUE mx<-FALSE hx<-FALSE lx<-any(diag(x)!=0,na.rm=TRUE) bx<-FALSE } } if(is.null(y)){ #If y is null, setup for unary operator n<-nx d<-dx m<-mx h<-hx b<-bx l<-lx x<-x }else{ #Binary case if(is.network(y)){ ny<-network.size(y) #Get size, directedness, multiplexity, bipartition dy<-is.directed(y) my<-is.multiplex(y) hy<-is.hyper(y) ly<-has.loops(y) by<-y%n%"bipartite" if(is.null(by)) by<-FALSE }else{ #If not a network object, resort to adj form y<-as.sociomatrix(y) if(NROW(y)!=NCOL(y)){ #Bipartite matrix ny<-NROW(y)+NCOL(y) dy<-FALSE my<-FALSE hy<-FALSE ly<-FALSE by<-NROW(y) }else{ ny<-NROW(y) dy<-TRUE my<-FALSE hy<-FALSE ly<-any(diag(y)!=0,na.rm=TRUE) by<-FALSE } } if(nx!=ny) #Make sure that our networks are conformable stop("Non-conformable networks (must have same numbers of vertices for elementwise operations).") if(bx!=by) stop("Non-conformable networks (must have same bipartite status for elementwise operations).") n<-nx #Output size=input size b<-bx #Output bipartition=input bipartition d<-dx|dy #Output directed if either input directed l<-lx|ly #Output has loops if either input does h<-hx|hy #Output hypergraphic if either input is m<-mx|my #Output multiplex if either input is } #Create the empty network object that will ultimately receive the edges net<-network.initialize(n=n,directed=d,hyper=h,loops=l,multiple=m,bipartite=b) #Create the edge lists; what the operator does with 'em isn't our problem if(h){ #Hypergraph stop("Elementwise operations not yet supported on hypergraphs.") }else{ #Dyadic network #Get the raw edge information if(is.network(x)){ elx<-as.matrix(x,matrix.type="edgelist") elnax<-as.matrix(is.na(x),matrix.type="edgelist") if(d&(!dx)){ #Need to add two-way edges; BTW, can't have (!d)&dx... elx<-rbind(elx,elx[elx[,2]!=elx[,1],2:1,drop=FALSE]) elnax<-rbind(elnax,elnax[,2:1]) } else if (!dx){ # need to enforce edge ordering ielx[,2],]<-elx[elx[,1]>elx[,2],c(2,1)] } }else{ elx<-which(x!=0,arr.ind=TRUE) elnax<-which(is.na(x),arr.ind=TRUE) if(!d){ #Sociomatrix already has two-way edges, so might need to remove elx<-elx[elx[,1]>=elx[,2],,drop=FALSE] elnax<-elnax[elnax[,1]>=elnax[,2],,drop=FALSE] } } if(!is.null(y)){ if(is.network(y)){ ely<-as.matrix(y,matrix.type="edgelist") elnay<-as.matrix(is.na(y),matrix.type="edgelist") if(d&(!dy)){ #Need to add two-way edges; BTW, can't have (!d)&dy... ely<-rbind(ely,ely[ely[,2]!=ely[,1],2:1,drop=FALSE]) elnay<-rbind(elnay,elnay[,2:1]) } else if (!dy){ # need to enforce edge ordering iely[,2],]<-ely[ely[,1]>ely[,2],c(2,1)] } }else{ ely<-which(y!=0,arr.ind=TRUE) elnay<-which(is.na(y),arr.ind=TRUE) if(!d){ #Sociomatrix already has two-way edges, so might need to remove ely<-ely[ely[,1]>=ely[,2],,drop=FALSE] elnay<-elnay[elnay[,1]>=elnay[,2],d,rop=FALSE] } } } if(!l){ #Pre-emptively remove loops, as needed elx<-elx[elx[,1]!=elx[,2],,drop=FALSE] elnax<-elnax[elnax[,1]!=elnax[,2],,drop=FALSE] if(!is.null(y)){ ely<-ely[ely[,1]!=ely[,2],,drop=FALSE] elnay<-elnay[elnay[,1]!=elnay[,2],,drop=FALSE] } } if(!m){ #Pre-emptively remove multiplex edges, as needed elx<-unique(elx) elnax<-unique(elnax) if(!is.null(y)){ ely<-unique(ely) elnay<-unique(elnay) } } } #Return everything if(is.null(y)) list(net=net,elx=elx,elnax=elnax) else list(net=net,elx=elx,elnax=elnax,ely=ely,elnay=elnay) } #' Combine Networks by Edge Value Multiplication #' #' Given a series of networks, \code{prod.network} attempts to form a new #' network by multiplication of edges. If a non-null \code{attrname} is given, #' the corresponding edge attribute is used to determine and store edge values. #' #' The network product method attempts to combine its arguments by edgewise #' multiplication (\emph{not} composition) of their respective adjacency #' matrices; thus, this method is only applicable for networks whose adjacency #' coercion is well-behaved. Multiplication is effectively boolean unless #' \code{attrname} is specified, in which case this is used to assess edge #' values -- net values of 0 will result in removal of the underlying edge. #' #' Other network attributes in the return value are carried over from the first #' element in the list, so some persistence is possible (unlike the #' multiplication operator). Note that it is sometimes possible to #' \dQuote{multiply} networks and raw adjacency matrices using this routine (if #' all dimensions are correct), but more exotic combinations may result in #' regrettably exciting behavior. #' #' @param \dots one or more \code{network} objects. #' @param attrname the name of an edge attribute to use when assessing edge #' values, if desired. #' @param na.rm logical; should edges with missing data be ignored? #' @return A \code{\link{network}} object. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network.operators}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords arith graphs #' @examples #' #' #Create some networks #' g<-network.initialize(5) #' h<-network.initialize(5) #' i<-network.initialize(5) #' g[1:3,,names.eval="marsupial",add.edges=TRUE]<-1 #' h[1:2,,names.eval="marsupial",add.edges=TRUE]<-2 #' i[1,,names.eval="marsupial",add.edges=TRUE]<-3 #' #' #Combine by addition #' pouch<-prod(g,h,i,attrname="marsupial") #' pouch[,] #Edge values in the pouch? #' as.sociomatrix(pouch,attrname="marsupial") #Recover the marsupial #' #' @export prod.network #' @export prod.network<-function(..., attrname=NULL, na.rm=FALSE){ inargs<-list(...) y<-inargs[[1]] for(i in (1:length(inargs))[-1]){ x<-as.sociomatrix(inargs[[i]],attrname=attrname) if(na.rm) x[is.na(x)]<-0 ym<-as.sociomatrix(y,attrname=attrname) if(na.rm) ym[is.na(ym)]<-0 y[,,names.eval=attrname,add.edges=TRUE]<-x*ym } y } #' Combine Networks by Edge Value Addition #' #' Given a series of networks, \code{sum.network} attempts to form a new #' network by accumulation of edges. If a non-null \code{attrname} is given, #' the corresponding edge attribute is used to determine and store edge values. #' #' The network summation method attempts to combine its arguments by addition #' of their respective adjacency matrices; thus, this method is only applicable #' for networks whose adjacency coercion is well-behaved. Addition is #' effectively boolean unless \code{attrname} is specified, in which case this #' is used to assess edge values -- net values of 0 will result in removal of #' the underlying edge. #' #' Other network attributes in the return value are carried over from the first #' element in the list, so some persistence is possible (unlike the addition #' operator). Note that it is sometimes possible to \dQuote{add} networks and #' raw adjacency matrices using this routine (if all dimensions are correct), #' but more exotic combinations may result in regrettably exciting behavior. #' #' @param \dots one or more \code{network} objects. #' @param attrname the name of an edge attribute to use when assessing edge #' values, if desired. #' @param na.rm logical; should edges with missing data be ignored? #' @return A \code{\link{network}} object. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network.operators}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords arith graphs #' @examples #' #' #Create some networks #' g<-network.initialize(5) #' h<-network.initialize(5) #' i<-network.initialize(5) #' g[1,,names.eval="marsupial",add.edges=TRUE]<-1 #' h[1:2,,names.eval="marsupial",add.edges=TRUE]<-2 #' i[1:3,,names.eval="marsupial",add.edges=TRUE]<-3 #' #' #Combine by addition #' pouch<-sum(g,h,i,attrname="marsupial") #' pouch[,] #Edge values in the pouch? #' as.sociomatrix(pouch,attrname="marsupial") #Recover the marsupial #' #' @export sum.network #' @export sum.network<-function(..., attrname=NULL, na.rm=FALSE){ inargs<-list(...) y<-inargs[[1]] for(i in (1:length(inargs))[-1]){ x<-as.sociomatrix(inargs[[i]],attrname=attrname) if(na.rm) x[is.na(x)]<-0 ym<-as.sociomatrix(y,attrname=attrname) if(na.rm) ym[is.na(ym)]<-0 y[,,names.eval=attrname,add.edges=TRUE]<-x+ym } y } network/R/network-package.R0000644000176200001440000004430614723241675015373 0ustar liggesusers#' @useDynLib network, .registration = TRUE #' @import utils #' @importFrom grDevices colors gray #' @importFrom graphics locator par plot polygon rect strheight strwidth text #' @importFrom stats rnorm na.omit #' @importFrom tibble tibble as.tibble as_tibble #' @importFrom magrittr %>% set_names NULL #' Interorganizational Search and Rescue Networks (Drabek et al.) #' #' Drabek et al. (1981) provide seven case studies of emergent #' multi-organizational networks (EMONs) in the context of search and rescue #' (SAR) activities. Networks of interaction frequency are reported, along #' with several organizational attributes. #' #' All networks collected by Drabek et al. reflect reported frequency of #' organizational interaction during the search and rescue effort; the (i,j) #' edge constitutes i's report regarding interaction with j, with non-adjacent #' vertices reporting no contact. Frequency is rated on a four-point scale, #' with 1 indicating the highest frequency of interaction. (Response options: #' 1=\dQuote{continuously}, 2=\dQuote{about once an hour}, 3=\dQuote{every few #' hours}, 4=\dQuote{about once a day or less}) This is stored within the #' \code{"Frequency"} edge attribute. #' #' For each network, several covariates are recorded as vertex attributes: #' #' \describe{ #' \item{Command.Rank.Score}{ Mean (reversed) rank for the #' prominence of each organization in the command structure of the response, as #' judged by organizational informants.} #' \item{Decision.Rank.Score}{ Mean (reversed) rank for the #' prominence of each organization in decision making #' processes during the response, as judged by organizational informants.} #' \item{Formalization}{ An index of organizational formalization, ranging from #' 0 (least formalized) to 4 (most formalized).} \item{Localization}{ For each #' organization, \code{"L"} if the organization was sited locally to the impact #' area, \code{"NL"} if the organization was not sited near the impact area, #' \code{"B"} if the organization was sited at both local and non-local #' locations.} #' \item{Paid.Staff}{ Number of paid staff employed by each #' organization at the time of the response.} #' \item{Sponsorship}{ The level at which each organization #' was sponsored (e.g., \code{"City"}, \code{"County"}, #' \code{"State"}, \code{"Federal"}, and \code{"Private"}).} #' \item{vertex.names}{ The identity of each organization.} #' \item{Volunteer.Staff}{ Number of volunteer staff employed by each #' organization at the time of the response.} #' } #' #' Note that where intervals were given by the original source, midpoints have #' been substituted. For detailed information regarding data coding and #' procedures, see Drabek et al. (1981). #' #' @name emon #' @docType data #' @usage data(emon) #' @format A list of 7 \code{\link{network}} objects: #' #' \tabular{rlll}{ #' `[[1]]` \tab Cheyenne \tab network \tab Cheyenne SAR EMON\cr #' `[[2]]` \tab HurrFrederic \tab network \tab Hurricane Frederic SAR EMON\cr #' `[[3]]` \tab LakePomona \tab network \tab Lake Pomona SAR EMON\cr #' `[[4]]` \tab MtSi \tab network \tab Mt. Si SAR EMON\cr #' `[[5]]` \tab MtStHelens \tab network \tab Mt. St. Helens SAR EMON\cr #' `[[6]]` \tab Texas \tab network \tab Texas Hill Country SAR EMON\cr #' `[[7]]` \tab Wichita \tab network \tab Wichita Falls SAR EMON #' } #' #' Each network has one edge attribute: #' #' \tabular{lll}{ Frequency \tab numeric \tab Interaction frequency (1-4; #' 1=most frequent) } #' #' Each network also has 8 vertex attributes: #' #' \tabular{lll}{ #' Command.Rank.Score \tab numeric \tab Mean rank in the command structure\cr #' Decision.Rank.Score \tab numeric \tab Mean rank in the decision process\cr #' Formalization \tab numeric \tab Degree of formalization\cr #' Location \tab character \tab Location code\cr #' Paid.Staff \tab numeric \tab Number of paid staff\cr #' Sponsorship \tab character \tab Sponsorship type\cr #' vertex.names \tab character \tab Organization name\cr #' Volunteer.Staff \tab numeric \tab Number of volunteer staff #' } #' #' @seealso \code{\link{network}} #' @source Drabek, T.E.; Tamminga, H.L.; Kilijanek, T.S.; and Adams, C.R. #' (1981). \emph{Data from Managing Multiorganizational Emergency Responses: #' Emergent Search and Rescue Networks in Natural Disaster and Remote Area #' Settings.} Program on Technology, Environment, and Man Monograph 33. #' Institute for Behavioral Science, University of Colorado. #' @keywords datasets #' @examples #' #' data(emon) #Load the emon data set #' #' #Plot the EMONs #' par(mfrow=c(3,3)) #' for(i in 1:length(emon)) #' plot(emon[[i]],main=names(emon)[i],edge.lwd="Frequency") #' NULL #' Florentine Wedding Data (Padgett) #' #' This is a data set of Padgett (1994), consisting of weddings among leading #' Florentine families. This data is stored in symmetric adjacency matrix #' form. #' #' @name flo #' @usage data(flo) #' @seealso \code{\link{network}} #' @references Wasserman, S. and Faust, K. (1994) \emph{Social Network #' Analysis: Methods and Applications}, Cambridge: Cambridge University Press. #' @source Padgett, John F. (1994). \dQuote{Marriage and Elite Structure in #' Renaissance Florence, 1282-1500.} Paper delivered to the Social Science #' History Association. #' @keywords datasets #' @examples #' #' data(flo) #' nflo<-network(flo,directed=FALSE) #Convert to network object form #' all(nflo[,]==flo) #Trust, but verify #' #A fancy display: #' plot(nflo,displaylabels=TRUE,boxed.labels=FALSE,label.cex=0.75) #' NULL #' Examples of how to load vertex and edge attributes into networks #' #' Additional examples of how to manipulate network attributes using the #' functions documented in \code{\link{attribute.methods}} #' #' The \code{\link{attribute.methods}} documentation gives details about the #' use of the specific network attribute methods such as #' \code{get.vertex.attribute} and \code{set.edge.attribute}. This document #' gives examples of how to load in and attach attribute data, drawing heavily #' on material from the Sunbelt statnet workshops #' \url{https://statnet.org/workshops/}. #' #' The examples section below give a quick overview of: #' \itemize{ #' \item Loading in a matrix #' #' \item Attaching vertex attributes #' #' \item Attaching edge atributes from a matrix #' #' \item Loading in an edgelist #' #' \item Attaching edge atributes from an edgelist #' } #' #' The \code{\link{read.table}} documentation provides more information about #' reading data in from various tabular file formats prior to loading into a #' network. Note that the output is usually a \code{\link{data.frame}} object #' in which each columns is represented as a \code{\link{factor}}. This means #' that in some cases when the output is directly loaded into a network the #' variable values will appear as factor level numbers instead of text values. #' The \code{stringsAsFactors=FALSE} flag may help with this, but some columns #' may need to be converted using \code{as.numeric} or \code{as.character} #' where appropriate. #' #' @name loading.attributes #' #' @seealso \code{\link{attribute.methods}}, \code{\link{as.network.matrix}}, #' \code{\link{as.sociomatrix}}, \code{\link{as.matrix.network}}, #' \code{\link{network.extraction}} #' @references Acton, R. M., Jasny, L (2012) \emph{An Introduction to Network #' Analysis with R and statnet} Sunbelt XXXII Workshop Series, March 13, 2012. #' #' Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational #' Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords classes graphs #' @examples #' #' #' # read in a relational data adjacency matrix #' #' # LOADING IN A MATRIX #' \dontrun{ #' # can download matrix file from #' # https://statnet.csde.washington.edu/trac/raw-attachment/wiki/Resources/relationalData.csv #' # and download vertex attribute file from #' # https://statnet.csde.washington.edu/trac/raw-attachment/wiki/Resources/vertexAttributes.csv #' #' # load in relation matrix from file #' relations <- read.csv("relationalData.csv",header=FALSE,stringsAsFactors=FALSE) #' #' # convert to matrix format from data frame #' relations <- as.matrix(relations) #' #' # load in vertex attributes #' nodeInfo <- read.csv("vertexAttributes.csv",header=TRUE,stringsAsFactors=FALSE) #' } #' \dontshow{ #' # since no access to file, creating it here #' relations <- matrix( #' c(0,0,0,1,1,1,0,0,0, #' 0,0,0,0,0,1,0,0,0, #' 0,0,0,0,0,0,1,0,1, #' 1,0,0,0,1,0,0,0,0, #' 1,0,0,1,0,0,0,0,0, #' 1,1,0,0,0,0,0,0,1, #' 0,0,1,0,0,0,0,0,1, #' 0,0,0,0,0,0,0,0,0, #' 0,0,1,0,0,1,1,0,0),ncol=9,byrow=TRUE) #' #' nodeInfo <- data.frame( #' name=c("Danielle","Josh","Mark","Emma","Sarah","Dave","Theresa","Carolyn","Gil"), #' age=c(44,44,40,32,33,36,38,42,30), #' sex=c("F","M","M","F","F","M","F","F","M"), #' handed=c("R","R","R","L","R","L","L","R","L"), #' lastDocVisit=c(2012,2008,2010,2012,2011,2007,2009,2009,2010), #' stringsAsFactors=FALSE #' ) #' } #' #' print(relations) # peek at matrix #' print(nodeInfo) # peek at attribute data #' #' # Since our relational data has no row/column names, let's set them now #' rownames(relations) <- nodeInfo$name #' colnames(relations) <- nodeInfo$name #' #' # create undirected network object from matrix #' nrelations<-network(relations,directed=FALSE) #' #' # it read in vertex names from matrix col names ... #' network.vertex.names(nrelations) #' #' # ATTACHING VERTEX ATTRIBUTES #' #' # ... but could also set vertex.names with #' nrelations%v%'vertex.names'<- nodeInfo$name #' #' # load in other attributes #' nrelations%v%"age" <- nodeInfo$age #' nrelations%v%"sex" <- nodeInfo$sex #' nrelations%v%"handed" <- nodeInfo$handed #' nrelations%v%"lastDocVisit" <- nodeInfo$lastDocVisit #' #' # Note: order of attributes in the data frame MUST match vertex ids #' # otherwise the attribute will get assigned to the wrong vertex #' #' # check that they got loaded #' list.vertex.attributes(nrelations) #' #' #' # what if we had an adjaceny matrix like: #' valuedMat<-matrix(c(1,2,3, 2,0,9.5,1,5,0),ncol=3,byrow=TRUE) #' valuedMat #' #' # make a network from it #' valuedNet<-network(valuedMat,loops=TRUE,directed=TRUE) #' #' # print it back out ... #' as.matrix(valuedNet) #' #' # wait, where did the values go!!? #' #' # LOADING A MATRIX WITH VALUES #' #' # to construct net from matrix with values: #' valuedNet<-network(valuedMat,loops=TRUE,directed=TRUE, #' ignore.eval=FALSE,names.eval='myEdgeWeight') #' #' # also have to specify the name of the attribute when converting to matrix #' as.matrix(valuedNet,attrname='myEdgeWeight') #' #' # ATTACHING EDGE ATTRIBUTES FROM A MATRIX #' #' # maybe we have edge attributes of a different sort in another matrix like: #' edgeAttrs<-matrix(c("B","Z","Q","W","A","E","L","P","A"),ncol=3,byrow=TRUE) #' edgeAttrs #' #' # we can still attach them #' valuedNet<-set.edge.value(valuedNet,'someLetters',edgeAttrs) #' #' # and extract them #' as.matrix(valuedNet,attrname='someLetters') #' valuedNet%e%'someLetters' #' #' # but notice that some of the values didn't get used #' # the ("A"s are missing) because there were no corresponding edges (loops) #' # for the attribute to be attached to #' #' #' # ATTACHING EDGE ATTRIBUTES FROM A LIST #' #' # it is also possible to attach edge attributes directly from a list #' edgeCols<-c("red","green","blue","orange","pink","brown","gray") #' valuedNet<-set.edge.attribute(valuedNet,"edgeColors",edgeCols) #' #' # but this can be risky, because we may not know the ordering of the edges, #' # (especially if some have been deleted). Does "green" go with the edge from #' # 1 to 2, or from 3 to 1? #' #' # Usually if the edge data is only availible in list form, it is safer to construct #' # the network from an edgelist in the first place #' #' # LOADING IN AN EDGELIST #' #' # pretend we just loaded in this data.frame from a file #' elData<-data.frame( #' from_id=c("1","2","3","1","3","1","2"), #' to_id=c("1", "1", "1", "2", "2", "3", "3"), #' myEdgeWeight=c(1, 2, 1, 2, 5, 3, 9.5), #' someLetters=c("B", "W", "L", "Z", "P", "Q", "E"), #' edgeCols=c("red","green","blue","orange","pink","brown","gray"), #' stringsAsFactors=FALSE #' ) #' #' # peek at data #' # each row corresponds to a relationship (edge) in the network #' elData #' #' # to make a network we just use the first two id columns #' valuedNet2<-network(elData[,1:2],loops=TRUE) #' #' # print it out #' as.matrix(valuedNet2) #' #' # has right edges, but no values #' #' # to include values (with names from the columns) #' #' valuedNet2<-network(elData,loops=TRUE) #' list.edge.attributes(valuedNet2) #' as.matrix(valuedNet2,attrname='someLetters') #' #' NULL #' Classes for Relational Data #' #' Tools to create and modify network objects. The network class can represent #' a range of relational data types, and supports arbitrary vertex/edge/graph #' attributes. #' #' The \code{network} package provides tools for creation, access, and #' modification of \code{network} class objects. These objects allow for the #' representation of more complex structures than can be readily handled by #' other means (e.g., adjacency matrices), and are substantially more efficient #' in handling large, sparse networks. While the full capabilities of the #' \code{network} class can only be exploited by means of the various custom #' interface methods (see below), many simple tasks are streamlined through the #' use of operator overloading; in particular, network objects can often be #' treated as if they were adjacency matrices (a representation which will be #' familiar to users of the \code{sna} package). \code{network} objects are #' compatible with the \code{sna} package, and are required for many packages #' in the \code{statnet} bundle. #' #' Basic information on the creation of \code{network} objects can be found by #' typing \code{help(network)}. To learn about setting, modifying, or deleting #' network, vertex, or edge attributes, see \code{help(attribute.methods)}. #' For information on custom network operators, type #' \code{help(network.operators)}; information on overloaded operators can be #' found via \code{help(network.extraction)}. Additional help topics are #' listed below. #' #' \tabular{ll}{ #' Package: \tab network\cr #' Version: \tab 1.14\cr #' Date: \tab May 7, 2016\cr #' Depends: \tab R (>= 2.10), utils\cr #' Suggests: \tab sna, statnet.common (>= 3.1-0)\cr #' License: \tab GPL (>=2)\cr #' } #' #' Index of documentation pages: #' \preformatted{ #' add.edges Add Edges to a Network Object #' add.vertices Add Vertices to an Existing Network #' as.matrix.network Coerce a Network Object to Matrix Form #' as.network.matrix Coercion from Matrices to Network Objects #' as.sociomatrix Coerce One or More Networks to Sociomatrix Form #' attribute.methods Attribute Interface Methods for the Network #' Class #' deletion.methods Remove Elements from a Network Object #' edgeset.constructors Edgeset Constructors for Network Objects #' emon Interorganizational Search and Rescue Networks #' (Drabek et al.) #' flo Florentine Wedding Data (Padgett) #' get.edges Retrieve Edges or Edge IDs Associated with a #' Given Vertex #' get.inducedSubgraph Retrieve Induced Subgraphs and Cuts #' get.neighborhood Obtain the Neighborhood of a Given Vertex #' is.adjacent Determine Whether Two Vertices Are Adjacent #' loading.attributes Examples of how to load vertex and edge #' attributes into networks #' missing.edges Identifying and Counting Missing Edges in a #' Network Object #' network Network Objects #' network.arrow Add Arrows or Segments to a Plot #' network.density Compute the Density of a Network #' network.dyadcount Return the Number of (Possibly Directed) Dyads #' in a Network Object #' network.edgecount Return the Number of Edges in a Network Object #' network.edgelabel Plots a label corresponding to an edge in a #' network plot. #' network.extraction Extraction and Replacement Operators for #' Network Objects #' network.indicators Indicator Functions for Network Properties #' network.initialize Initialize a Network Class Object #' network.layout Vertex Layout Functions for plot.network #' network.loop Add Loops to a Plot #' network.operators Network Operators #' network-package Classes for Relational Data #' network.size Return the Size of a Network #' network.vertex Add Vertices to a Plot #' permute.vertexIDs Permute (Relabel) the Vertices Within a Network #' plotArgs.network Expand and transform attributes of networks to #' values appropriate for aguments to plot.network #' plot.network.default Two-Dimensional Visualization for Network #' Objects #' prod.network Combine Networks by Edge Value Multiplication #' read.paj Read a Pajek Project or Network File and #' Convert to an R 'Network' Object #' sum.network Combine Networks by Edge Value Addition #' valid.eids Get the valid edge which are valid in a network #' which.matrix.type Heuristic Determination of Matrix Types for #' Network Storage #' } #' #' #' @author Carter T. Butts , with help from Mark S. Handcock #' , David Hunter , Martina #' Morris , Skye Bender-deMoll #' , and Jeffrey Horner #' . #' #' Maintainer: Carter T. Butts #' @keywords package "_PACKAGE" network/R/dataframe.R0000644000176200001440000005746714363701063014241 0ustar liggesusers#' @importFrom statnet.common once .warn_bipartite_vertex_reorder <- once( function() { warning( "`vertices` were not provided in the order required for bipartite networks. Reordering.", "\n\nThis is the first and last time you will be warned during this session.", call. = FALSE ) } ) .head <- function(x, n = 6) { n <- min(length(x), n) x[seq_len(n)] } .validate_edge_df <- function(edges, directed, hyper, loops, multiple, bipartite, ...) { # confirm edge data frame has valid dimensions if (ncol(edges) < 2L || nrow(edges) == 0L) { stop( "`x` should be a data frame with at least two columns and one row.", call. = FALSE ) } el <- edges[, 1:2] sources <- edges[[1L]] targets <- edges[[2L]] # validate edge column types if (hyper) { # confirm that hyper-edges are list columns if (!is.list(sources) || !is.list(targets)) { stop( "If `hyper` is `TRUE`, the first two columns of `x` should be list columns.", call. = FALSE ) } # first edge type is the `target_type`, against which all other values are tested target_type <- typeof(sources[[1L]]) # confirm that target_type is itself valid if (any(is.na(sources[[1L]])) || target_type %in% c("NULL", "list")) { stop( "`x`'s first two columns contain invalid values.", "\n\t- `x[[1]][[1]]` is `NULL`, recursive, or it contains `NA` values.", call. = FALSE ) } # Iterate through edge columns, testing that they're not `NA` and are of the same type # as `target_type`. `incompat_types` is a logical matrix of the test results. incompat_types <- vapply( el, function(.x) { vapply(.x, function(.y) any(is.na(.y)) || typeof(.y) != target_type, logical(1L)) }, logical(nrow(el)) ) # if any values are incompatible, throw error pointing user to the problem values if (any(incompat_types)) { incompat_rows <- row(incompat_types)[incompat_types] incompat_cols <- col(incompat_types)[incompat_types] stop( "The values in the first two columns of `x` must be of the same type and cannot be `NULL`, `NA`, or recursive values.", "\nThe following values are incompatible:", paste( "\n\t-", sprintf("`x[%d, %d]`", .head(incompat_rows), .head(incompat_cols)) ), call. = FALSE ) } } else { # for non-hyper edges... # ... confirm edge columns are atomic vectors if (!is.atomic(sources) || !is.atomic(targets)) { stop( "If `hyper` is `FALSE`, the first two columns of `x` should be atomic vectors.", call. = FALSE ) } # confirm that edge columns are of the same type if (typeof(sources) != typeof(targets)) { stop( "The first two columns of `x` must be of the same type.", call. = FALSE ) } # confirm edge columns don't contain `NA`s if (any(is.na(el))) { stop( "The first two columns of `x` cannot contain `NA` values.", call. = FALSE ) } } # if `loops` is `FALSE`, confirm that edge columns don't contain loops if (!loops) { # if hyper, test if each intersection's length is not 0 if (hyper) { loop_rows <- which( mapply( function(.x, .y) length(intersect(.x, .y)) != 0L, sources, targets, USE.NAMES = FALSE ) ) } else { # if not hyper... # ... test via simple vector comparison loop_rows <- which(sources == targets) } # if loops are found, throw error pointing user to the edge rows that contain them if (length(loop_rows) > 0L) { stop( "`loops` is `FALSE`, but `x` contains loops.", "\nThe following values are affected:", paste("\n\t-", sprintf("`x[%d, 1:2]`", .head(loop_rows))), call. = FALSE ) } } # TODO does network support bipartite hypergraphs? if (!hyper && bipartite) { # check for intersection between edge columns confused_nodes <- intersect(sources, targets) # if there's an intersection, throw error informing users which nodes are in both columns if (length(confused_nodes) > 0L) { stop( "`bipartite` is `TRUE`, but there are vertices that appear in both of the", " first two columns of `x`.\n", "The following vertices appear in both columns:", paste("\n\t-", .head(confused_nodes)), call. = FALSE ) } } # TODO does network support multiplex hypergraphs? if (!hyper && !multiple) { if (directed) { test_el <- el } else { test_el <- t(apply(el, 1L, sort)) } if (anyDuplicated(test_el) != 0L) { parallel_edges <- which(duplicated(test_el)) stop( "`multiple` is `FALSE`, but `x` contains parallel edges.\n", "The following rows in `x` are duplicated:", paste("\n\t-", sprintf("`x[%d, ]`", .head(parallel_edges))), call. = FALSE ) } } } .validate_vertex_df <- function(vertices, el_vert_ids) { # confirm `vertices` is a data frame if (!is.data.frame(vertices)) { stop( "If provided, `vertices` should be a data frame.", call. = FALSE ) } # confirm `vertices` has valid dimensions if (nrow(vertices) == 0L || ncol(vertices) == 0L) { stop( "`vertices` should contain at least one column and row.", call. = FALSE ) } vertex_ids <- vertices[[1L]] if (!is.atomic(vertex_ids)) { stop( "The first column of `vertices` must be an atomic vector.", call. = FALSE ) } # confirm vertex IDs match type used in edges if (typeof(vertex_ids) != typeof(el_vert_ids)) { stop( "The first column of `vertices` must be the same type as the value with which", " they are referenced in `x`'s first two columns.", call. = FALSE ) } # check for vertex names that are in the edges, but are missing from `vertices` missing_vertex_names <- setdiff(el_vert_ids, vertex_ids) if (length(missing_vertex_names) != 0L) { stop( "The following vertices are in `x`, but not in `vertices`:", paste("\n\t-", .head(missing_vertex_names)), call. = FALSE ) } # check if any of the `vertices` have duplicate names if (anyDuplicated(vertex_ids) != 0L) { stop( "The following vertex names are duplicated in `vertices`:", paste("\n\t-", .head(vertex_ids[duplicated(vertex_ids)])), call. = FALSE ) } } .prep_bipartite_vertices <- function(vertices, el_vert_ids, bipartite_col) { # use "is_actor" column if provided if (bipartite_col %in% names(vertices)) { # check if `"is_actor"` column is valid if (!is.logical(vertices[[bipartite_col]]) || any(is.na(vertices[[bipartite_col]]))) { stop( sprintf( paste0( '`bipartite` is `TRUE` and vertex types are specified via a column in `vertices` named `"%s"`.', '\n\t- If provided, all values in `vertices[["%s"]]` must be `TRUE` or `FALSE`.' ), bipartite_col, bipartite_col ) ) } # actors (`TRUE`) go before non-actors (`FALSE`) vertex_order <- order(vertices[[bipartite_col]], decreasing = TRUE) } else { # if no "is_actor" column is provided... vertex_ids <- vertices[[1L]] # ... check for isolates... isolates <- setdiff(vertex_ids, el_vert_ids) # ... and throw error informing user of which vertices are isolates if (length(isolates) > 0L) { stop( sprintf( "`bipartite` is `TRUE`, but the `vertices` you provided contain names that are not present in `x` (i.e. you have isolates).", "\nIf you have isolates, `vertices` must have a `logical` column named \"%s\" indicating each vertex's type.", "\nThe following vertex names are in `vertices`, but not in `x`:", bipartite_col ), paste("\n\t-", .head(isolates)) ) } # if there are no isolates, follow order of vertices as they appear in the edges vertex_order <- match(el_vert_ids, vertex_ids) } if (!identical(vertices[[1L]], vertices[[1L]][vertex_order])) { .warn_bipartite_vertex_reorder() } # reorder the vertex rows to match the actor/non-actor order of the final network vertices[vertex_order, ] } .distribute_vec_attrs <- function(x) { lapply(x, function(.x) { if (is.atomic(.x)) { lapply(.x, `attributes<-`, attributes(.x)) } else { .x } }) } .prep_edge_attrs <- function(edges) { edge_attr_names <- names(edges)[-(1:2)] init_vals_eval <- .distribute_vec_attrs(edges[, edge_attr_names, drop = FALSE]) list( names_eval = rep(list(as.list(edge_attr_names)), times = nrow(edges)), vals_eval = .mapply(list, init_vals_eval, NULL) ) } .prep_vertex_attrs <- function(vertices) { vertices[-1L] <- .distribute_vec_attrs(vertices[-1L]) vertices } #' @rdname network #' #' @param vertices If \code{x} is a \code{data.frame}, \code{vertices} is an optional #' \code{data.frame} containing the vertex attributes. The first column is assigned #' to the \code{"vertex.names"} and additional columns are used to set vertex attributes #' using their column names. If \code{bipartite} is \code{TRUE}, a \code{logical} column #' named \code{"is_actor"} (or the name of a column specified using the #' \code{bipartite_col} parameter) can be provided indicating which vertices #' should be considered as actors. If not provided, vertices referenced in the #' first column of \code{x} are assumed to be the network's actors. If your #' network has isolates (i.e. there are vertices referenced in \code{vertices} #' that are not referenced in \code{x}), the \code{"is_actor"} column is required. #' #' @param bipartite_col \code{character(1L)}, default: \code{"is_actor"}. #' The name of the \code{logical} column indicating which vertices should be #' considered as actors in bipartite networks. #' #' @examples #' # networks from data frames =========================================================== #' #* simple networks ==================================================================== #' simple_edge_df <- data.frame( #' from = c("b", "c", "c", "d", "a"), #' to = c("a", "b", "a", "a", "b"), #' weight = c(1, 1, 2, 2, 3), #' stringsAsFactors = FALSE #' ) #' simple_edge_df #' #' as.network(simple_edge_df) #' #' # simple networks with vertices ======================================================= #' simple_vertex_df <- data.frame( #' name = letters[1:5], #' residence = c("urban", "rural", "suburban", "suburban", "rural"), #' stringsAsFactors = FALSE #' ) #' simple_vertex_df #' #' as.network(simple_edge_df, vertices = simple_vertex_df) #' #' as.network(simple_edge_df, #' directed = FALSE, vertices = simple_vertex_df, #' multiple = TRUE #' ) #' #' #* splitting multiplex data frames into multiple networks ============================= #' simple_edge_df$relationship <- c(rep("friends", 3), rep("colleagues", 2)) #' simple_edge_df #' #' lapply(split(simple_edge_df, f = simple_edge_df$relationship), #' as.network, #' vertices = simple_vertex_df #' ) #' #' #* bipartite networks without isolates ================================================ #' bip_edge_df <- data.frame( #' actor = c("a", "a", "b", "b", "c", "d", "d", "e"), #' event = c("e1", "e2", "e1", "e3", "e3", "e2", "e3", "e1"), #' actor_enjoyed_event = rep(c(TRUE, FALSE), 4), #' stringsAsFactors = FALSE #' ) #' bip_edge_df #' #' bip_node_df <- data.frame( #' node_id = c("a", "e1", "b", "e2", "c", "e3", "d", "e"), #' node_type = c( #' "person", "event", "person", "event", "person", #' "event", "person", "person" #' ), #' color = c( #' "red", "blue", "red", "blue", "red", "blue", #' "red", "red" #' ), #' stringsAsFactors = FALSE #' ) #' bip_node_df #' #' as.network(bip_edge_df, directed = FALSE, bipartite = TRUE) #' as.network(bip_edge_df, directed = FALSE, vertices = bip_node_df, bipartite = TRUE) #' #' #* bipartite networks with isolates =================================================== #' bip_nodes_with_isolates <- rbind( #' bip_node_df, #' data.frame( #' node_id = c("f", "e4"), #' node_type = c("person", "event"), #' color = c("red", "blue"), #' stringsAsFactors = FALSE #' ) #' ) #' # indicate which vertices are actors via a column named `"is_actor"` #' bip_nodes_with_isolates$is_actor <- bip_nodes_with_isolates$node_type == "person" #' bip_nodes_with_isolates #' #' as.network(bip_edge_df, #' directed = FALSE, vertices = bip_nodes_with_isolates, #' bipartite = TRUE #' ) #' #' #* hyper networks from data frames ==================================================== #' hyper_edge_df <- data.frame( #' from = c("a/b", "b/c", "c/d/e", "d/e"), #' to = c("c/d", "a/b/e/d", "a/b", "d/e"), #' time = 1:4, #' stringsAsFactors = FALSE #' ) #' tibble::as_tibble(hyper_edge_df) #' #' # split "from" and "to" at `"/"`, coercing them to list columns #' hyper_edge_df$from <- strsplit(hyper_edge_df$from, split = "/") #' hyper_edge_df$to <- strsplit(hyper_edge_df$to, split = "/") #' tibble::as_tibble(hyper_edge_df) #' #' as.network(hyper_edge_df, #' directed = FALSE, vertices = simple_vertex_df, #' hyper = TRUE, loops = TRUE #' ) #' #' # convert network objects back to data frames ========================================= #' simple_g <- as.network(simple_edge_df, vertices = simple_vertex_df) #' as.data.frame(simple_g) #' as.data.frame(simple_g, unit = "vertices") #' #' bip_g <- as.network(bip_edge_df, #' directed = FALSE, vertices = bip_node_df, #' bipartite = TRUE #' ) #' as.data.frame(bip_g) #' as.data.frame(bip_g, unit = "vertices") #' #' hyper_g <- as.network(hyper_edge_df, #' directed = FALSE, vertices = simple_vertex_df, #' hyper = TRUE, loops = TRUE #' ) #' as.data.frame(hyper_g) #' as.data.frame(hyper_g, unit = "vertices") #' @export as.network.data.frame #' @export as.network.data.frame <- function(x, directed = TRUE, vertices = NULL, hyper = FALSE, loops = FALSE, multiple = FALSE, bipartite = FALSE, bipartite_col = "is_actor", ...) { # validate network type args invalid_network_args <- vapply( list( directed = directed, hyper = hyper, loops = loops, multiple = multiple, bipartite = bipartite ), function(.x) is.na(.x) || !is.logical(.x), logical(1L) ) if (any(invalid_network_args)) { stop( "The following arguments must be either `TRUE` or `FALSE`:", paste("\n\t-", names(invalid_network_args)[invalid_network_args]) ) } if (length(bipartite_col) != 1L || !is.character(bipartite_col) || is.na(bipartite_col)) { stop("`bipartite_col` must be a single, non-`NA` `character` value.") } # handle incompatible network type args if (bipartite && directed) { warning("If `bipartite` is `TRUE`, edges are interpreted as undirected.") directed <- FALSE } if (bipartite && loops) { warning("If `bipartite` is `TRUE`, `loops` must be `FALSE`.") loops <- FALSE } if (hyper && !directed && !loops) { warning("If `hyper` is `TRUE` and `directed` is `FALSE`, `loops` must be `TRUE`.") loops <- TRUE } if (hyper && bipartite) { stop("Both `hyper` and `bipartite` are `TRUE`, but bipartite hypergraphs are not supported.") } # validate edges .validate_edge_df( edges = x, directed = directed, hyper = hyper, loops = loops, multiple = multiple, bipartite = bipartite ) # create variable containing vertex IDs in the order they appear in the edges vertex_ids_in_el <- unique(unlist(x[, 1:2], use.names = FALSE)) # create reference variables to minimize bracket spam sources <- x[[1L]] targets <- x[[2L]] # validate vertices if (!is.null(vertices)) { .validate_vertex_df(vertices, el_vert_ids = vertex_ids_in_el) } # if vertices aren't provided, use the order in which they appear in the edges if (is.null(vertices)) { vertex_names <- vertex_ids_in_el } else { # if vertices are provided, use that order if (bipartite) { # if bipartite, first reorder vertices so actors come before non-actors vertices <- .prep_bipartite_vertices(vertices, el_vert_ids = vertex_ids_in_el, bipartite_col = bipartite_col) } vertex_names <- vertices[[1L]] } # out_sources/out_targets consist of the numerical indices to add to the final network out_sources <- lapply(sources, match, vertex_names) out_targets <- lapply(targets, match, vertex_names) # prep edge attributes if (ncol(x) == 2L) { edge_attrs <- list(names_eval = NULL, vals_eval = NULL) } else { edge_attrs <- .prep_edge_attrs(x) } # start building the network to return out <- network.initialize( n = length(vertex_names), directed = directed, hyper = hyper, loops = loops, multiple = multiple, bipartite = if (bipartite) length(unique(sources)) else FALSE ) # add edges (and any edge attributes) out <- add.edges.network( x = out, tail = out_sources, head = out_targets, names.eval = edge_attrs[["names_eval"]], vals.eval = edge_attrs[["vals_eval"]], ... ) # set vertex attributes if (is.null(vertices)) { # if vertices aren't provided, set "vertex.names" as the values used in edges out <- set.vertex.attribute(out, attrname = "vertex.names", value = vertex_names) } else if (ncol(vertices) == 1L) { out <- set.vertex.attribute(out, attrname = "vertex.names", value = vertices[[1L]]) } else { out <- set.vertex.attribute( x = out, attrname = c( "vertex.names", # first column is always "vertex.names" names(vertices)[-1L] ), value = .prep_vertex_attrs(vertices) ) } out } .is_atomic_scalar <- function(x) { is.atomic(x) && length(x) == 1L } .all_are_atomic_scalars <- function(x) { all(vapply(x, .is_atomic_scalar, logical(1L), USE.NAMES = FALSE)) } .is_vectorizable <- function(x) { vapply(x, .all_are_atomic_scalars, logical(1L), USE.NAMES = FALSE) } .vectorize_safely <- function(x) { to_vectorize <- .is_vectorizable(x) x[to_vectorize] <- lapply(x[to_vectorize], function(.x) { `attributes<-`(unlist(.x, use.names = FALSE), attributes(.x[[1L]])) }) x } .as_edge_df <- function(x, attrs_to_ignore, na.rm, name_vertices, sort_attrs, store_eid, ...) { if (network.edgecount(x, na.omit = FALSE) == 0L) { empty_edge_df <- structure( list(.tail = logical(), .head = logical(), .na = logical()), row.names = integer(), class = "data.frame" ) if ("na" %in% attrs_to_ignore) { empty_edge_df <- empty_edge_df[, c(".tail", ".head")] } return(empty_edge_df) } vertex_names <- network.vertex.names(x) deleted <- vapply(x[["mel"]], is.null, logical(1)) if (name_vertices) { el_list <- list( .tail = lapply(x[["mel"]], function(.x) vertex_names[.x[["outl"]]]), .head = lapply(x[["mel"]], function(.x) vertex_names[.x[["inl"]]]) ) } else { el_list <- list( .tail = lapply(lapply(x[["mel"]], `[[`, "outl"), as.integer), .head = lapply(lapply(x[["mel"]], `[[`, "inl"), as.integer) ) } # list.edge.attributes() sorts, meaning we can't test round-trips edge_attr_names <- if (sort_attrs) list.edge.attributes(x) else unique( unlist(lapply(x[["mel"]], function(.x) names(.x[["atl"]])), use.names = FALSE ) ) names(edge_attr_names) <- edge_attr_names # extract attributes as-is (lists) edge_attrs <- lapply( edge_attr_names, function(.x) get.edge.attribute(x, .x, unlist = FALSE, null.na = TRUE) ) # if not `TRUE`, "na" is assumed `FALSE` (in the event of `NULL`s or corrupted data) edge_attrs[["na"]] <- !vapply( edge_attrs[["na"]], isFALSE, logical(1L), USE.NAMES = FALSE ) if (store_eid) edge_attrs <- c(list(.eid = seq_along(x[["mel"]])), edge_attrs) # skip `base::as.data.frame()`'s auto-unlisting behavior out <- structure( c(el_list, edge_attrs), row.names = seq_along(el_list[[1L]]), class = "data.frame" ) out <- out[!deleted, ] if (na.rm) { # drop NA edge rows out <- out[!out[["na"]], ] } # reset `rownames()` so they're sequential in returned object rownames(out) <- NULL cols_to_keep <- c(".tail", ".head", setdiff(names(edge_attrs), attrs_to_ignore)) out <- out[cols_to_keep] # if not hyper, `unlist()` ".tail" and ".head" if (!is.hyper(x)) { out[1:2] <- lapply(out[1:2], unlist, use.names = FALSE) } # safely vectorize non-edgelist columns cols_to_vectorize <- setdiff(names(out), c(".tail", ".head")) if (length(cols_to_vectorize)) { out[cols_to_vectorize] <- .vectorize_safely(out[cols_to_vectorize]) } out } .as_vertex_df <- function(x, attrs_to_ignore, na.rm, name_vertices, sort_attrs, ...) { if (network.size(x) == 0L) { empty_vertex_df <- structure( list(vertex.names = logical(), na = logical()), class = "data.frame", row.names = integer() ) if ("na" %in% attrs_to_ignore) { empty_vertex_df <- empty_vertex_df[, "vertex.names", drop = FALSE] } return(empty_vertex_df) } # list.vertex.attributes() sorts the result, meaning we can't test round-trips vertex_attr_names <- if (sort_attrs) list.vertex.attributes(x) else unique(unlist(lapply(x[["val"]], names), use.names = FALSE)) vertex_attrs <- lapply( `names<-`(vertex_attr_names, vertex_attr_names), function(.x) get.vertex.attribute(x, .x, unlist = FALSE) ) vertex_attrs[["na"]] <- lapply( vertex_attrs[["na"]], function(.x) if (is.null(.x)) TRUE else .x ) out <- structure( vertex_attrs, row.names = seq_len(network.size(x)), class = "data.frame" ) if (!"vertex.names" %in% names(out)) { out[["vertex.names"]] <- network.vertex.names(x) } if (na.rm) { out <- out[!vapply(out[["na"]], isTRUE, logical(1L), USE.NAMES = FALSE), ] rownames(out) <- NULL } out_cols <- c( "vertex.names", setdiff(names(out), c("vertex.names", attrs_to_ignore)) ) .vectorize_safely(out[, out_cols, drop = FALSE]) } #' Coerce a Network Object to a \code{data.frame} #' #' The \code{as.data.frame} method coerces its input to a \code{data.frame} containing #' \code{x}'s edges or vertices. #' #' @param x an object of class \code{network} #' @param ... additional arguments #' @param unit whether a \code{data.frame} of edge or vertex #' attributes should be returned. #' @param na.rm logical; ignore missing edges/vertices when constructing the #' data frame? #' @param attrs_to_ignore character; a vector of attribute names to #' exclude from the returned \code{data.frame} (Default: #' \code{"na"}) #' @param name_vertices logical; for `unit="edges"`, should the #' `.tail` and the `.head` columns contain vertex names as opposed #' to vertex indices? #' @param sort_attrs logical; should the attribute columns in the #' returned data frame be sorted alphabetically? #' @param store_eid logical; for `unit="edges"`, should the edge ID in #' the network's internal representation be stored in a column #' `.eid`? #' #' @export as.data.frame.network #' @export as.data.frame.network <- function(x, ..., unit = c("edges", "vertices"), na.rm = TRUE, attrs_to_ignore = "na", name_vertices = TRUE, sort_attrs = FALSE, store_eid = FALSE) { helper <- switch(match.arg(unit, c("edges", "vertices")), edges = .as_edge_df, vertices = .as_vertex_df, # `match.arg()` used, so this should never be reached... stop('`unit` must be one of `"edges"` or `"vertices".') # nocov ) helper(x, attrs_to_ignore = attrs_to_ignore, sort_attrs = sort_attrs, na.rm = na.rm, name_vertices = name_vertices, store_eid = store_eid, ... ) } network/R/layout.R0000644000176200001440000002615714723241675013632 0ustar liggesusers###################################################################### # # layout.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 06/06/21 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various routines related to vertex layouts (for # graph drawing). These are currently ported directly from the sna # package for R (Carter T. Butts ). # # Contents: # # network.layout.circle # network.layout.fruchtermanreingold # network.layout.kamadakawaii # ###################################################################### #Place vertices in a circular layout (for plot.network) #' Vertex Layout Functions for plot.network #' #' Various functions which generate vertex layouts for the #' \code{\link{plot.network}} visualization routine. #' #' Vertex layouts for network visualization pose a difficult problem -- there #' is no single, ``good'' layout algorithm, and many different approaches may #' be valuable under different circumstances. With this in mind, #' \code{\link{plot.network}} allows for the use of arbitrary vertex layout #' algorithms via the \code{network.layout.*} family of routines. When called, #' \code{\link{plot.network}} searches for a \code{network.layout} function #' whose fourth name matches its \code{mode} argument (see #' \code{\link{plot.network}} help for more information); this function is then #' used to generate the layout for the resulting plot. In addition to the #' routines documented here, users may add their own layout functions as #' needed. The requirements for a \code{network.layout} function are as #' follows: #' \enumerate{ #' \item the first argument, \code{nw}, must be a network object; #' \item the second argument, \code{layout.par}, must be a list of parameters #' (or \code{NULL}, if no parameters are specified); and #' \item the return value must be a real matrix of dimension \code{c(2,network.size(nw))}, #' whose rows contain the vertex coordinates. #' } #' Other than this, anything goes. (In particular, note that \code{layout.par} #' could be used to pass additional matrices or other information, if needed. #' Alternately, it is possible to make layout methods that respond to #' covariates on the network object, which are maintained intact by #' plot.network.) #' #' The \code{network.layout} functions currently supplied by default are as #' follows (with \code{n==network.size(nw)}): #' \describe{ #' \item{circle}{ This function places vertices uniformly in a circle; it takes no arguments.} #' \item{fruchtermanreingold}{ This function generates a layout using a variant of Fruchterman and Reingold's force-directed placement algorithm. It takes the following arguments: #' \describe{ #' \item{layout.par$niter}{ This argument controls the number of iterations to be employed. Larger values take longer, but will provide a more refined layout. (Defaults to 500.) } #' \item{layout.par$max.delta}{ Sets the maximum change in position for any given iteration. (Defaults to \code{n}.)} #' \item{layout.par$area}{ Sets the "area" parameter for the F-R algorithm. (Defaults to \code{n^2}.)} #' \item{layout.par$cool.exp}{ Sets the cooling exponent for the annealer. (Defaults to 3.)} #' \item{layout.par$repulse.rad}{ Determines the radius at which vertex-vertex repulsion cancels out attraction of adjacent vertices. (Defaults to \code{area*log(n)}.)} #' \item{layout.par$ncell}{ To speed calculations on large graphs, the plot region is divided at each iteration into \code{ncell} by \code{ncell} \dQuote{cells}, which are used to define neighborhoods for force calculation. Moderate numbers of cells result in fastest performance; too few cells (down to 1, which produces \dQuote{pure} F-R results) can yield odd layouts, while too many will result in long layout times. (Defaults to \code{n^0.4}.)} #' \item{layout.par$cell.jitter}{ Jitter factor (in units of cell width) used in assigning vertices to cells. Small values may generate \dQuote{grid-like} anomalies for graphs with many isolates. (Defaults to \code{0.5}.)} #' \item{layout.par$cell.pointpointrad}{ Squared \dQuote{radius} (in units of cells) such that exact point interaction calculations are used for all vertices belonging to any two cells less than or equal to this distance apart. Higher values approximate the true F-R solution, but increase computational cost. (Defaults to \code{0}.)} #' \item{layout.par$cell.pointcellrad}{ Squared \dQuote{radius} (in units of cells) such that approximate point/cell interaction calculations are used for all vertices belonging to any two cells less than or equal to this distance apart (and not within the point/point radius). Higher values provide somewhat better approximations to the true F-R solution at slightly increased computational cost. (Defaults to \code{18}.)} #' \item{layout.par$cell.cellcellrad}{ Squared \dQuote{radius} (in units of cells) such that approximate cell/cell interaction calculations are used for all vertices belonging to any two cells less than or equal to this distance apart (and not within the point/point or point/cell radii). Higher values provide somewhat better approximations to the true F-R solution at slightly increased computational cost. Note that cells beyond this radius (if any) do not interact, save through edge attraction. (Defaults to \code{ncell^2}.)} #' \item{layout.par$seed.coord}{ A two-column matrix of initial vertex coordinates. (Defaults to a random circular layout.) } #' } #' } #' \item{kamadakawai}{ This function generates a vertex layout using a version of the Kamada-Kawai force-directed placement algorithm. It takes the following arguments: #' \describe{ #' \item{layout.par$niter}{ This argument controls the number of iterations to be employed. (Defaults to 1000.) } #' \item{layout.par$sigma}{ Sets the base standard deviation of position change proposals. (Defaults to \code{n/4}.)} #' \item{layout.par$initemp}{ Sets the initial "temperature" for the annealing algorithm. (Defaults to 10.)} #' \item{layout.par$cool.exp}{ Sets the cooling exponent for the annealer. (Defaults to 0.99.)} #' \item{layout.par$kkconst}{ Sets the Kamada-Kawai vertex attraction constant. (Defaults to \code{n)^2}.)} #' \item{layout.par$elen}{ Provides the matrix of interpoint distances to be approximated. (Defaults to the geodesic distances of \code{nw} after symmetrizing, capped at \code{sqrt(n)}.)} #' \item{layout.par$seed.coord}{ A two-column matrix of initial vertex coordinates. (Defaults to a gaussian layout.) } #' } #' } #' } #' #' @name network.layout #' #' @param nw a network object, as passed by \code{\link{plot.network}}. #' @param layout.par a list of parameters. #' @return A matrix whose rows contain the x,y coordinates of the vertices of #' \code{d}. #' @note The \code{network.layout} routines shown here are adapted directly #' from the \code{\link[sna]{gplot.layout}} routines of the \code{sna} package. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{plot.network}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' #' Fruchterman, T.M.J. and Reingold, E.M. (1991). \dQuote{Graph Drawing by #' Force-directed Placement.} \emph{Software - Practice and Experience,} #' 21(11):1129-1164. #' #' Kamada, T. and Kawai, S. (1989). \dQuote{An Algorithm for Drawing General #' Undirected Graphs.} \emph{Information Processing Letters,} 31(1):7-15. #' @keywords graphs dplot #' @export network.layout.circle<-function(nw,layout.par){ n<-network.size(nw) cbind(sin(2*pi*((0:(n-1))/n)),cos(2*pi*((0:(n-1))/n))) } #Fruchterman-Reingold layout routine for plot.network #' @rdname network.layout #' @export network.layout.fruchtermanreingold<-function(nw,layout.par){ #Provide default settings n<-network.size(nw) d<-as.matrix.network(nw,matrix.type="edgelist")[,1:2,drop=FALSE] if(is.null(layout.par$niter)) niter<-500 else niter<-layout.par$niter if(is.null(layout.par$max.delta)) max.delta<-n else max.delta<-layout.par$max.delta if(is.null(layout.par$area)) area<-n^2 else area<-layout.par$area if(is.null(layout.par$cool.exp)) cool.exp<-3 else cool.exp<-layout.par$cool.exp if(is.null(layout.par$repulse.rad)) repulse.rad<-area*log(n) else repulse.rad<-layout.par$repulse.rad if(is.null(layout.par$ncell)) ncell<-ceiling(n^0.4) else ncell<-layout.par$ncell if(is.null(layout.par$cell.jitter)) cell.jitter<-0.5 else cell.jitter<-layout.par$cell.jitter if(is.null(layout.par$cell.pointpointrad)) cell.pointpointrad<-0 else cell.pointpointrad<-layout.par$cell.pointpointrad if(is.null(layout.par$cell.pointcellrad)) cell.pointcellrad<-18 else cell.pointcellrad<-layout.par$cell.pointcellrad if(is.null(layout.par$cellcellcellrad)) cell.cellcellrad<-ncell^2 else cell.cellcellrad<-layout.par$cell.cellcellrad if(is.null(layout.par$seed.coord)){ tempa<-sample((0:(n-1))/n) #Set initial positions randomly on the circle x<-n/(2*pi)*sin(2*pi*tempa) y<-n/(2*pi)*cos(2*pi*tempa) }else{ x<-layout.par$seed.coord[,1] y<-layout.par$seed.coord[,2] } #Symmetrize the network, just in case d<-unique(rbind(d,d[,2:1])) #Perform the layout calculation layout<-.C("network_layout_fruchtermanreingold_R", as.double(d), as.double(n), as.double(NROW(d)), as.integer(niter), as.double(max.delta), as.double(area), as.double(cool.exp), as.double(repulse.rad), as.integer(ncell), as.double(cell.jitter), as.double(cell.pointpointrad), as.double(cell.pointcellrad), as.double(cell.cellcellrad), x=as.double(x), y=as.double(y), PACKAGE="network") #Return the result cbind(layout$x,layout$y) } #Kamada-Kawai layout function for plot.network #' @rdname network.layout #' @export network.layout.kamadakawai<-function(nw,layout.par){ n<-network.size(nw) d<-as.sociomatrix(nw) if(is.null(layout.par$niter)){ niter<-1000 }else niter<-layout.par$niter if(is.null(layout.par$sigma)){ sigma<-n/4 }else sigma<-layout.par$sigma if(is.null(layout.par$initemp)){ initemp<-10 }else initemp<-layout.par$initemp if(is.null(layout.par$coolexp)){ coolexp<-0.99 }else coolexp<-layout.par$coolexp if(is.null(layout.par$kkconst)){ kkconst<-n^2 }else kkconst<-layout.par$kkconst if(is.null(layout.par$elen)){ # these functions require that the SNA package be installed elen<-sna::geodist(sna::symmetrize(d),inf.replace=sqrt(n),count.paths = FALSE,predecessors = FALSE)$gdist }else elen<-layout.par$elen if(is.null(layout.par$seed.coord)){ x<-rnorm(n,0,n/4) y<-rnorm(n,0,n/4) }else{ x<-layout.par$seed.coord[,1] y<-layout.par$seed.coord[,2] } #Obtain locations pos<-.C("network_layout_kamadakawai_R",as.integer(d),as.double(n), as.integer(niter),as.double(elen),as.double(initemp),as.double(coolexp), as.double(kkconst),as.double(sigma),x=as.double(x),y=as.double(y), PACKAGE="network") #Return to x,y coords cbind(pos$x,pos$y) } network/R/as.edgelist.R0000644000176200001440000001473514724264602014512 0ustar liggesusers# File R/edgelist.R in package network, part of the Statnet suite # of packages for network analysis, http://statnet.org . # # This software is distributed under the GPL-3 license. It is free, # open source, and has the attribution requirements (GPL Section 7) at # http://statnet.org/attribution # # Copyright 2003-2015 Statnet Commons ####################################################################### # the edgelist functions have been copied in from ergm #' @export as.edgelist <- function(x, ...){ UseMethod("as.edgelist") } # convert a network into an ergm-style sorted edgelist using # as.edgelist.matrix and as.matrix.network.edgelist #' @name as.edgelist #' #' @title Convert a network object into a numeric edgelist matrix #' #' @description Constructs an edgelist in a sorted format with defined attributes. #' #' @details Constructs a edgelist matrix or tibble from a network, sorted tails-major #' order, with tails first, and, for undirected networks, tail < head. This #' format is required by some reverse-depending packages (e.g. \code{ergm}) #' #' The \code{\link{as.matrix.network.edgelist}} provides similar functionality #' but it does not enforce ordering or set the \code{edgelist} class and so #' should be slightly faster. #' #' \code{is.edgelist} tests if an object has the class \code{'edgelist'} #' #' #' @aliases edgelist #' @param x a \code{network} object with additional class added indicating how #' it should be dispatched. #' @param output return type: a \code{\link{matrix}} or a \code{\link[tibble]{tibble}}; #' see \code{\link{as.matrix.network}} for the difference. #' @param attrname optionally, the name of an edge attribute to use for edge #' values; may be a vector of names if \code{output="tibble"} #' @param as.sna.edgelist logical; should the edgelist be returned in edgelist #' form expected by the sna package? Ignored if \code{output="tibble"} #' @param n integer number of vertices in network, value passed to the 'n' flag #' on edgelist returned #' @param vnames vertex names (defaults to vertex ids) to be attached to #' edgelist for sna package compatibility #' @param directed logical; is network directed, value passed to the 'directed' #' flag on edgelist returned #' @param bipartite logical or integer; is network bipartite, value passed to #' the 'bipartite' flag on edgelist returned #' @param loops logical; are self-loops allowed in network?, value passed to #' the 'loops' flag on edgelist returned #' @param \dots additional arguments to other methods #' @return A matrix in which the first two columns are integers giving the tail #' (source) and head (target) vertex ids of each edge. The matrix will be given #' the class \code{edgelist}. #' #' The edgelist has additional attributes attached to it: \itemize{ \item #' \code{attr(,"n")} the number of vertices in the original network #' #' \item \code{attr(,"vnames")} the names of vertices in the original network #' #' \item \code{attr(,"directed")} logical, was the original network directed #' #' \item \code{attr(,"bipartite")} was the original network bipartite #' #' \item \code{attr(,"loops")} does the original network contain self-loops } #' #' Note that if the \code{attrname} attribute is used the resulting edgelist #' matrix will have three columns. And if \code{attrname} refers to a #' character attribute, the resulting edgelist matrix will be character rather #' than numeric unless \code{output="tibble"}. #' #' @note NOTE: this function was moved to network from the ergm package in #' network version 1.13 #' @seealso See also \code{\link{as.matrix.network.edgelist}} #' @examples #' #' data(emon) #' as.edgelist(emon[[1]]) #' as.edgelist(emon[[1]],output="tibble") #' # contrast with unsorted columns of #' as.matrix.network.edgelist(emon[[1]]) #' #' @export as.edgelist.network <- function(x, attrname = NULL, as.sna.edgelist = FALSE, output=c("matrix","tibble"), ...){ output <- match.arg(output) switch(output, matrix = as.edgelist(as.matrix.network.edgelist(x, attrname=attrname, as.sna.edgelist=as.sna.edgelist,...), n=network.size(x), directed=is.directed(x), bipartite=ifelse(is.bipartite(x),x%n%"bipartite",FALSE), loops=has.loops(x), vnames=network.vertex.names(x)), tibble = as.edgelist(as_tibble(x, attrnames=attrname,...), n=network.size(x), directed=is.directed(x), bipartite=ifelse(is.bipartite(x),x%n%"bipartite",FALSE), loops=has.loops(x), vnames=network.vertex.names(x)) ) } #' @rdname as.edgelist #' @export as.edgelist.matrix #' @export as.edgelist.matrix <- function(x, n, directed=TRUE, bipartite=FALSE, loops=FALSE, vnames=seq_len(n),...){ tails <- as.integer(x[,1]) heads <- as.integer(x[,2]) if(!directed) { tails <- pmin(t <- tails, heads) heads <- pmax(t, heads) } keep <- rep(TRUE, length(tails)) if(!loops) { keep <- keep & (tails != heads) } if(bipartite) { keep <- keep & ((tails <= bipartite) != (heads <= bipartite)) } x <- x[keep,,drop=FALSE] tails <- tails[keep] heads <- heads[keep] x[,1:2] <- cbind(tails, heads) x <- unique(x[order(tails, heads),,drop=FALSE]) attr(x,"n") <- as.integer(n) attr(x,"vnames")<- vnames attr(x,"directed") <- as.logical(directed) attr(x,"bipartite") <- if(is.numeric(bipartite)) as.integer(bipartite) else bipartite attr(x,"loops") <- as.logical(loops) class(x)<-c('matrix_edgelist','edgelist',class(x)) x } #' @rdname as.edgelist #' @export as.edgelist.tbl_df <- function(x, n, directed=TRUE, bipartite=FALSE, loops=FALSE, vnames=seq_len(n),...){ if(!directed){ x$.tail <- pmin(t <- x$.tail, x$.head) x$.head <- pmax(t, x$.head) # .tail has been clobbered. } if(!loops) x <- x[x$.tail!=x$.head,] if(bipartite) x <- x[(x$.tail<=bipartite)!=(x$.head<=bipartite),] x <- unique(x[order(x$.tail, x$.head),]) attr(x,"n") <- as.integer(n) attr(x,"vnames")<- vnames attr(x,"directed") <- as.logical(directed) attr(x,"bipartite") <- if(is.numeric(bipartite)) as.integer(bipartite) else bipartite attr(x,"loops") <- as.logical(loops) class(x)<-c('tibble_edgelist','edgelist',class(x)) x } #' @rdname as.edgelist #' @export is.edgelist is.edgelist<-function(x){ inherits(x,"edgelist") } network/R/coercion.R0000644000176200001440000006201714724264524014110 0ustar liggesusers###################################################################### # # coercion.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 06/08/21 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various routines for coercion to/from network # class objects. # # Contents: # # as.matrix.network # as.matrix.network.adjacency # as.matrix.network.edgelist # as.matrix.network.incidence # as.network # as.network.default # as.network.network # as.network.matrix # as.sociomatrix # ###################################################################### # Method for general coercion of network class objects into matrices. # Matrix type is indicated by the eponymous argument; note that some # types may not be supported for certain networks. Where # attrname!=NULL, an edge attribute of name attrname is used to supply # edge values. Otherwise, edges are assumed to be unvalued. # #' Coerce a Network Object to Matrix or Table Form #' #' The \code{as.matrix} methods attempt to coerce their input to a matrix in #' adjacency, incidence, or edgelist form. Edge values (from a stored #' attribute) may be used if present. \code{\link[tibble:as_tibble]{as_tibble}} #' coerces into an edgelist in \code{\link[tibble]{tibble}} (a type of #' \code{\link{data.frame}}) form; this can be especially useful if extrecting #' a character-type edge attribute. #' #' If no matrix type is specified, \code{\link{which.matrix.type}} will be used #' to make an educated guess based on the shape of \code{x}. Where edge values #' are not specified, a dichotomous matrix will be assumed. #' #' Edgelists returned by the \code{as.matrix} methods are by default in a #' slightly different form from the \code{sna} edgelist standard, but do #' contain the \code{sna} extended matrix attributes (see #' \code{\link{as.network.matrix}}). They should typically be compatible with #' \code{sna} library functions. To ensure compatibility, the #' \code{as.sna.edgelist} argument can be set (which returns an exact #' \code{sna} edgelist). The \code{\link{as.edgelist}} function also returns a #' similar edgelist matrix but with an enforced sorting. #' #' For the \code{as.matrix} methods, if the \code{attrname} attribute is used #' to include a charcter attribute, the resulting edgelist matrix will be #' character rather than numeric. The \code{as_tibble} methods never coerce. #' #' Note that adjacency matrices may also be obtained using the extraction #' operator. See the relevant man page for details. Also note that which #' attributes get returned by the \code{as_tibble} method by default depends on #' \code{unit}: by default no edge attributes are returned but all vertex #' attributes are. #' #' @param x an object of class \code{network} #' @param matrix.type one of \code{"adjacency"}, \code{"incidence"}, #' \code{"edgelist"}, or \code{NULL} #' @param attrname optionally, the name of an edge attribute to use for edge #' values #' @param attrnames optionally, either a character vector of the names of edge #' attributes to use for edge values, or a numerical or logical vector to use #' as indices for selecting them from \code{\link{list.edge.attributes}(x)} or #' \code{\link{list.vertex.attributes}(x)} (depending on \code{unit}); passing #' \code{TRUE} therefore returns all edge attributes as columns #' @param expand.bipartite logical; if \code{x} is bipartite, should we return #' the full adjacency matrix (rather than the abbreviated, two-mode form)? #' @param as.sna.edgelist logical; should the edgelist be returned in sna #' edglist form? #' @param na.rm logical; should missing edges/vertices be included in the #' edgelist formats? Ignored if \code{as.sna.edgelist=TRUE}. #' @param unit whether a \code{\link[tibble]{tibble}} of edge or vertex attributes #' should be returned. #' @param ... additional arguments. #' @return For \code{as.matrix} methods, an adjacency, incidence, or edgelist #' matrix. For the \code{as_tibble} method, a \code{tibble} whose first two #' columns are \code{.head} and \code{.tail}, whose third column \code{.eid} is #' the edge ID, and whose subsequent columns are the requested edge attributes. #' @author Carter T. Butts \email{buttsc@@uci.edu} and David Hunter #' \email{dhunter@@stat.psu.edu} #' @seealso \code{\link{which.matrix.type}}, \code{\link{network}}, #' \code{\link{network.extraction}},\code{\link{as.edgelist}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords classes graphs #' @examples #' #' # Create a random network #' m <- matrix(rbinom(25,4,0.159),5,5) # 50% density #' diag(m) <- 0 #' g <- network(m, ignore.eval=FALSE, names.eval="a") # With values #' g %e% "ac" <- letters[g %e% "a"] #' #' # Coerce to matrix form #' # No attributes: #' as.matrix(g,matrix.type="adjacency") #' as.matrix(g,matrix.type="incidence") #' as.matrix(g,matrix.type="edgelist") #' # Attributes: #' as.matrix(g,matrix.type="adjacency",attrname="a") #' as.matrix(g,matrix.type="incidence",attrname="a") #' as.matrix(g,matrix.type="edgelist",attrname="a") #' as.matrix(g,matrix.type="edgelist",attrname="ac") #' #' # Coerce to a tibble: #' library(tibble) #' as_tibble(g) #' as_tibble(g, attrnames=c("a","ac")) #' as_tibble(g, attrnames=TRUE) #' # Get vertex attributes instead: #' as_tibble(g, unit = "vertices") #' #' # Missing data handling: #' g[1,2] <- NA #' as.matrix(g,matrix.type="adjacency") # NA in the corresponding cell #' as.matrix(g,matrix.type="edgelist", na.rm=TRUE) # (1,2) excluded #' as.matrix(g,matrix.type="edgelist", na.rm=FALSE) # (1,2) included #' as_tibble(g, attrnames="na", na.rm=FALSE) # Which edges are marked missing? #' #' # Can also use the extraction operator #' g[,] # Get entire adjacency matrix #' g[1:2,3:5] # Obtain a submatrix #' #' @export as.matrix.network #' @export as.matrix.network<-function(x,matrix.type=NULL,attrname=NULL,...){ #Get the matrix type if(is.null(matrix.type)) matrix.type<-"adjacency" else matrix.type<-match.arg(matrix.type,c("adjacency","incidence","edgelist")) #Dispatch as needed switch(matrix.type, adjacency=as.matrix.network.adjacency(x=x,attrname=attrname,...), incidence=as.matrix.network.incidence(x=x,attrname=attrname,...), edgelist=as.matrix.network.edgelist(x=x,attrname=attrname,...) ) } # Coerce a network object to an adjacency matrix (where possible). If # provided, attrname is used to identify an attribute to use for edge # values. # #' @rdname as.matrix.network #' @usage \method{as.matrix.network}{adjacency}(x, attrname=NULL, #' expand.bipartite = FALSE, ...) #' @export as.matrix.network.adjacency #' @rawNamespace S3method(as.matrix.network,adjacency) as.matrix.network.adjacency<-function(x,attrname=NULL,expand.bipartite=FALSE,...){ #Check to make sure this is a supported network type if(is.hyper(x)) stop("Hypergraphs not currently supported in as.matrix.network.adjacency. Exiting.\n") if(is.multiplex(x)) stop("Multigraphs not currently supported in as.matrix.network.adjacency. Exiting.\n") #Generate the adjacency matrix m<-matrix(0,nrow=network.size(x),ncol=network.size(x)) if(network.size(x)==0) return(m) tl<-unlist(sapply(x$mel,"[[","outl")) #Can unlist b/c no hyperedges hl<-unlist(sapply(x$mel,"[[","inl")) nal<-as.logical(get.edge.attribute(x$mel,"na",unlist=TRUE)) if(!is.null(attrname)){ val<-unlist(get.edge.attribute(x$mel,attrname,unlist=FALSE)) if(is.null(val)){ warning(paste("There is no edge attribute named", attrname)) val<-rep(1,length(tl)) } }else{ val<-rep(1,length(tl)) } if(length(hl[!nal])>0){ m[tl[!nal]+(hl[!nal]-1)*network.size(x)]<-val[!nal] } if(length(hl[ nal])>0){ m[tl[ nal]+(hl[ nal]-1)*network.size(x)]<-NA } #If undirected, symmetrize if(!is.directed(x)){ # changed by MSH to allow non binary values # m<-pmax(m,t(m)) sel<-m sel[is.na(m)]<-1 m[sel==0] <- t(m)[sel==0] } #Set row/colnames to vertex names xnames <- network.vertex.names(x) dimnames(m) <- list(xnames, xnames) #If bipartite and !expand.bipartite, return in two-mode form if(is.bipartite(x)&(!expand.bipartite)){ nactors <- get.network.attribute(x, "bipartite") nevents <- network.size(x) - nactors m <- m[1:nactors, nactors+(1:nevents), drop=FALSE] } #Return the result m } # Coerce a network object to an edgelist matrix. If provided, attrname is # used to identify an attribute to use for edge values. Setting as.sna.edgelist # results in output in the sna edgelist format (including missing edge handling) # and is used by the sna package for coercion. # #' @rdname as.matrix.network #' @usage \method{as.matrix.network}{edgelist}(x, attrname=NULL, #' as.sna.edgelist = FALSE, na.rm = TRUE, ...) #' @export as.matrix.network.edgelist #' @rawNamespace S3method(as.matrix.network,edgelist) as.matrix.network.edgelist<-function(x,attrname=NULL,as.sna.edgelist=FALSE,na.rm=TRUE,...){ #Check to make sure this is a supported network type if(is.hyper(x)) stop("Hypergraphs not currently supported in as.matrix.network.edgelist. Exiting.\n") #Find the missing edges nal<-as.logical(get.edge.attribute(x$mel,"na")) #Generate the edgelist matrix m<-cbind(unlist(sapply(x$mel,"[[","outl")), unlist(sapply(x$mel,"[[","inl"))) #Add edge values, if needed if(!is.null(attrname)) m<-cbind(m,get.edge.attribute(x$mel,attrname,na.omit=FALSE,null.na=TRUE,deleted.edges.omit=TRUE)) else if(as.sna.edgelist) m<-cbind(m,rep(1,NROW(m))) #Set additional attributes and return the result if(as.sna.edgelist && nrow(m) > 0) # check that there are actually edges m[nal,3]<-NA else if(na.rm) m<-m[!nal,,drop=FALSE] if(length(m)==0) m<-matrix(numeric(0),ncol=2+as.sna.edgelist+!is.null(attrname)) else if((!is.directed(x))&&as.sna.edgelist){ #sna uses directed form m<-rbind(m,m[m[,2]!=m[,1],c(2:1,3)]) } attr(m,"n")<-network.size(x) attr(m,"vnames")<-network.vertex.names(x) if(is.bipartite(x)) attr(m,"bipartite")<-x%n%"bipartite" m } # Coerce a network object to an edgelist tibble. If provided, attrnames is # used to identify a list of attributes to use for edge values. # #' @rdname as.matrix.network #' @param store.eid whether the edge ID should be stored in the third column (`.eid`). #' @export as_tibble.network<-function(x,attrnames=(match.arg(unit)=="vertices"),na.rm=TRUE,..., unit=c("edges", "vertices"), store.eid=FALSE){ df <- as.data.frame(x, unit = unit, store_eid = store.eid, na.rm = na.rm, attrs_to_ignore = c(), name_vertices = FALSE, sort_attrs=TRUE, ...) unit <- match.arg(unit) if(is.logical(attrnames) || is.numeric(attrnames)) attrnames <- na.omit(setdiff(names(df), c(".tail", ".head", ".eid"))[attrnames]) # Keep only requested columns, but make sure all named columns are present. df <- df[intersect(c(".tail", ".head", ".eid", attrnames), names(df))] for(a in setdiff(attrnames, names(df))) df[[a]] <- rep(list(), nrow(df)) structure(as_tibble(df), n = network.size(x), vnames = network.vertex.names(x), bipartite = x %n% "bipartite") } #' @rdname as.matrix.network #' @rawNamespace S3method(as.tibble,network) as.tibble.network <- as_tibble.network # Coerce a network object to an incidence matrix (where possible). If # provided, attrname is used to identify an attribute to use for edge # values. # #' @rdname as.matrix.network #' @usage \method{as.matrix.network}{incidence}(x, attrname=NULL, ...) #' @export as.matrix.network.incidence #' @rawNamespace S3method(as.matrix.network,incidence) as.matrix.network.incidence<-function(x,attrname=NULL,...){ #Perform preprocessing n<-network.size(x) nulledge<-sapply(x$mel,is.null) inl<-lapply(x$mel,"[[","inl")[!nulledge] outl<-lapply(x$mel,"[[","outl")[!nulledge] if(!is.null(attrname)) evals<-unlist(get.edge.attribute(x$mel,attrname))[!nulledge] else evals<-rep(1,length(x$mel))[!nulledge] ena<-as.logical(get.edge.attribute(x$mel,"na"))[!nulledge] #If called with an empty graph, return a degenerate matrix if(length(ena)==0) return(matrix(numeric(0),nrow=n)) #Generate the incidence matrix dir<-is.directed(x) f<-function(a,m,k){y<-rep(0,m); y[a]<-k; y} im<-sapply(inl,f,n,1)+sapply(outl,f,n,ifelse(dir,-1,1)) if(!dir) im<-pmin(im,1) im<-sweep(im,2,evals,"*") #Fill in edge values im[(sapply(ena,rep,n)*(im!=0))>0]<-NA #Add NAs, if needed #Return the result im } #' @rdname network #' @export as.network<-function(x,...) UseMethod("as.network") #' @name as.network.matrix #' #' @title Coercion from Matrices to Network Objects #' #' @description \code{as.network.matrix} attempts to coerce its first argument to an object #' of class \code{network}. #' #' @details Depending on \code{matrix.type}, one of three edgeset constructor methods #' will be employed to read the input matrix (see #' \code{\link{edgeset.constructors}}). If \code{matrix.type==NULL}, #' \code{\link{which.matrix.type}} will be used to guess the appropriate matrix #' type. #' #' The coercion methods will recognize and attempt to utilize the \code{sna} #' extended matrix attributes where feasible. These are as follows: \itemize{ #' \item\code{"n"}: taken to indicate number of vertices in the network. #' \item\code{"bipartite"}: taken to indicate the network's \code{bipartite} #' attribute, where present. \item\code{"vnames"}: taken to contain vertex #' names, where present. } These attributes are generally used with edgelists, #' and indeed data in \code{sna} edgelist format should be transparently #' converted in most cases. Where the extended matrix attributes are in #' conflict with the actual contents of \code{x}, results are no guaranteed #' (but the latter will usually override the former). For an edge list, the #' number of nodes in a network is determined by the number of unique nodes #' specified. If there are isolate nodes not in the edge list, the "n" #' attribute needs to be set. See example below. #' #' @param x a matrix containing an adjacency structure #' @param matrix.type one of \code{"adjacency"}, \code{"edgelist"}, #' \code{"incidence"}, or \code{NULL} #' @param directed logical; should edges be interpreted as directed? #' @param hyper logical; are hyperedges allowed? #' @param loops logical; should loops be allowed? #' @param multiple logical; are multiplex edges allowed? #' @param bipartite count; should the network be interpreted as bipartite? If #' present (i.e., non-NULL) it is the count of the number of actors in the #' bipartite network. In this case, the number of nodes is equal to the number #' of actors plus the number of events (with all actors preceding all events). #' The edges are then interpreted as nondirected. #' @param ignore.eval logical; ignore edge values? #' @param names.eval optionally, the name of the attribute in which edge values #' should be stored #' @param na.rm logical; ignore missing entries when constructing the network? #' @param edge.check logical; perform consistency checks on new edges? #' @param ... additional arguments #' @return An object of class \code{network} #' @author Carter T. Butts \email{buttsc@@uci.edu} and David Hunter #' \email{dhunter@@stat.psu.edu} #' @seealso \code{\link{edgeset.constructors}}, \code{\link{network}}, #' \code{\link{which.matrix.type}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords classes graphs #' @examples #' #' #Draw a random matrix #' m<-matrix(rbinom(25,1,0.5),5) #' diag(m)<-0 #' #' #Coerce to network form #' g<-as.network.matrix(m,matrix.type="adjacency") #' #' # edge list example. Only 4 nodes in the edge list. #' m = matrix(c(1,2, 2,3, 3,4), byrow = TRUE, nrow=3) #' attr(m, 'n') = 7 #' as.network(m, matrix.type='edgelist') #' #' @export as.network.default #' @export as.network.default<-function(x,...) as.network.matrix(x,...) #' @export as.network.network #' @export as.network.network<-function(x,...) x # # MSH modified for bipartite # #' @rdname as.network.matrix #' @export as.network.matrix #' @export as.network.matrix<-function(x, matrix.type=NULL, directed=TRUE, hyper=FALSE, loops=FALSE, multiple=FALSE, bipartite=FALSE, ignore.eval=TRUE, names.eval=NULL, na.rm=FALSE, edge.check=FALSE, ...){ #Before doing anything else, pull any attributes from the matrix that we #might need.... nattr<-attr(x,"n") #Currently, only using sna edgelist attributes battr<-attr(x,"bipartite") vattr<-attr(x,"vnames") #Convert logicals to numeric form if(is.logical(x)){x <- 1*x} #Get the matrix type if(is.null(matrix.type)) matrix.type<-which.matrix.type(x) else matrix.type<-match.arg(matrix.type,c("adjacency","incidence","edgelist", "bipartite")) if(is.logical(bipartite)&&bipartite) matrix.type<-"bipartite" #Patch adj->bipartite case if((bipartite>0)&&(matrix.type=="adjacency")&&(NROW(x)==bipartite)) matrix.type<-"bipartite" # Add names if available unames <- NULL if(matrix.type=="edgelist"){ if(dim(x)[2]>2) vals<-x[,-(1:2),drop=FALSE] else vals<-NULL if(is.character(x<-as.matrix(x[,1:2,drop=FALSE]))){ unames <- sort(unique(as.vector(x))) x <- cbind(match(x[,1],unames),match(x[,2],unames)) } if(!is.null(vals)){ x<-cbind(x,vals) if (is.null(colnames(vals))){ colnames(x)<-NULL #R creates these, and they are annoying later } else { # leave colnames for vals intact so they can be used for edge attributes colnames(x)<-c(NA,NA,colnames(vals)) } } } if(matrix.type=="adjacency" && !is.null(colnames(x))){ unames <- colnames(x) } if(matrix.type=="bipartite"){ directed <- FALSE bipartite <- dim(x)[1] unames <- 1:sum(dim(x)) if(!is.null(rownames(x))){ unames[1:(dim(x)[1])] <- rownames(x) } if(!is.null(colnames(x))){ unames[(dim(x)[1])+(1:(dim(x)[2]))] <- colnames(x) } } if(!is.null(vattr)) #If given names, use 'em unames<-vattr #Initialize the network object if(is.numeric(nattr)){ #If given n, use it n<-nattr }else{ if((matrix.type=="edgelist")&&(NROW(x)==0)) stop("Cannot determine network size from zero-length edgelist; assign an n attribute to use data of this type.\n") n<-switch(matrix.type, #Extract n based on matrix type adjacency=dim(x)[1], incidence=dim(x)[1], bipartite=sum(dim(x)), edgelist=max(x[,1:2]), ) } if(is.numeric(battr)) #If given bipartite info, use it bipartite<-battr # if we are going to build an adjacency matrix and it doesn't match the nattr, give an error, because otherwise will crash # this may happen if a square edgelist with attribute information is passed in if (is.numeric(nattr) & matrix.type=='adjacency'){ if (nattr != ncol(x)){ stop('the dimensions of the matrix argument (',nrow(x),' by ', ncol(x),') do not match the network size indicated by the attached n attribute (',nattr,'), perhaps matrix.type argument is not correct') } } g<-network.initialize(n,directed=directed, hyper=hyper, loops=loops, multiple=multiple,bipartite=bipartite) #Call the specific coercion routine, depending on matrix type g<-switch(matrix.type, adjacency=network.adjacency(x,g, ignore.eval,names.eval,na.rm,edge.check), incidence=network.incidence(x,g, ignore.eval,names.eval,na.rm,edge.check), bipartite=network.bipartite(x,g, ignore.eval,names.eval,na.rm,edge.check), edgelist=network.edgelist(x,g, ignore.eval,names.eval,na.rm,edge.check) ) if(!is.null(unames)){ g <- set.vertex.attribute(g,"vertex.names", unames) } #Return the result g } #Force the input into sociomatrix form. This is a shortcut to #as.matrix.network.adjacency, which ensures that a raw matrix is #passed through as-is. #' Coerce One or More Networks to Sociomatrix Form #' #' \code{as.sociomatrix} takes adjacency matrices, adjacency arrays, #' \code{\link{network}} objects, or lists thereof, and returns one or more #' sociomatrices (adjacency matrices) as appropriate. This routine provides a #' useful input-agnostic front-end to functions which process adjacency #' matrices. #' #' \code{as.sociomatrix} provides a more general means of coercing input into #' adjacency matrix form than \code{\link{as.matrix.network}}. In particular, #' \code{as.sociomatrix} will attempt to coerce all input networks into the #' appropriate form, and return the resulting matrices in a regularized manner. #' If \code{simplify==TRUE}, \code{as.sociomatrix} attempts to return the #' matrices as a single adjacency array. If the input networks are of variable #' size, or if \code{simplify==FALSE}, the networks in question are returned as #' a list of matrices. In any event, a single input network is always returned #' as a lone matrix. #' #' If \code{attrname} is given, the specified edge attribute is used to extract #' edge values from any \code{\link{network}} objects contained in \code{x}. #' Note that the same attribute will be used for all networks; if no attribute #' is specified, the standard dichotomous default will be used instead. #' #' @param x an adjacency matrix, array, \code{\link{network}} object, or list #' thereof. #' @param attrname optionally, the name of a network attribute to use for #' extracting edge values (if \code{x} is a \code{\link{network}} object). #' @param simplify logical; should \code{as.sociomatrix} attempt to combine its #' inputs into an adjacency array (\code{TRUE}), or return them as separate #' list elements (\code{FALSE})? #' @param expand.bipartite logical; if \code{x} is bipartite, should we return #' the full adjacency matrix (rather than the abbreviated, two-mode form)? #' @param ... additional arguments for the coercion routine. #' @return One or more adjacency matrices. If all matrices are of the same #' dimension and \code{simplify==TRUE}, the matrices are joined into a single #' array; otherwise, the return value is a list of single adjacency matrices. #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{as.matrix.network}}, \code{\link{network}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords graphs manip #' @examples #' #' #Generate an adjacency array #' g<-array(rbinom(100,1,0.5),dim=c(4,5,5)) #' #' #Generate a network object #' net<-network(matrix(rbinom(36,1,0.5),6,6)) #' #' #Coerce to adjacency matrix form using as.sociomatrix #' as.sociomatrix(g,simplify=TRUE) #Returns as-is #' as.sociomatrix(g,simplify=FALSE) #Returns as list #' as.sociomatrix(net) #Coerces to matrix #' as.sociomatrix(list(net,g)) #Returns as list of matrices #' #' @export as.sociomatrix as.sociomatrix<-function(x, attrname=NULL, simplify=TRUE, expand.bipartite=FALSE, ...){ if(is.network(x)){ #If network, coerce to adjacency matrix g<-as.matrix.network.adjacency(x,attrname=attrname, expand.bipartite=expand.bipartite,...) }else if(is.matrix(x)||is.array(x)){ #If an array/matrix, use as-is g<-x }else if(is.list(x)){ #If a list, recurse on list elements g<-lapply(x,as.sociomatrix,attrname=attrname,simplify=simplify, expand.bipartite=expand.bipartite,...) }else{ stop("as.sociomatrix input must be an adjacency matrix/array, network, or list.") } #Convert into the appropriate return format if(is.list(g)){ #Collapse if needed if(length(g)==1){ g<-g[[1]] if((!simplify)&&(length(dim(g))==3)){ #Coerce to a list of matrices? out<-list() for(i in 1:dim(g)[1]) out[[i]]<-g[i,,] }else{ out<-g } }else{ #Coerce to array form? if(simplify){ dims<-sapply(g,dim) if(is.list(dims)){ #Dims must not be of equal length mats<-sapply(dims,length) mats[mats==1]<-0 mats[mats==2]<-1 mats[mats==3]<-sapply(dims[mats==3],"[[",1) mats<-cumsum(mats) dims<-sapply(dims,"[",2) }else{ #Dims are of equal length if(NROW(dims)==3) #Determine number of matrices per entry mats<-cumsum(dims[1,]) else mats<-1:NCOL(dims) dims<-dims[2,] #Get ncols } if((!any(is.null(dims)))&&(length(unique(dims))==1)&&(all(mats>0))){ out<-array(dim=c(mats[length(mats)],dims[1],dims[1])) for(i in 1:length(mats)) out[(c(0,mats)[i]+1):(mats[i]),,]<-g[[i]] }else out<-g }else out<-g } }else{ if((!simplify)&&(length(dim(g))==3)){ #Coerce to a list of matrices? out<-list() for(i in 1:dim(g)[1]) out[[i]]<-g[i,,] }else out<-g } #Return the result out } network/R/constructors.R0000644000176200001440000003754714725233503015063 0ustar liggesusers###################################################################### # # constructors.R # # Written by Carter T. Butts ; portions contributed by # David Hunter and Mark S. Handcock # . # # Last Modified 12/07/24 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains various routines for the construction of network # and edge objects. # # Contents: # # network # network.adjacency # network.copy # network.edgelist # network.incidence # network.initialize # ###################################################################### # Basic network constructor. Converts a single matrix to a network class # object. The matrix must be in one of three formats: adjacency, # incidence, or edgelist. # # MSH added bipartite # #' @rdname network #' @export network network<-function(x, vertex.attr=NULL, vertex.attrnames=NULL, directed=TRUE, hyper=FALSE, loops=FALSE, multiple=FALSE, bipartite=FALSE, ...) { #Initialize the network object g<-as.network(x,directed=directed,hyper=hyper,loops=loops, multiple=multiple,bipartite=bipartite,...) #Add vertex attributes, if needed if(!is.null(vertex.attr)){ #Create vertex attribute names, if needed if(is.null(vertex.attrnames)){ if(!is.null(names(vertex.attr))) vertex.attrnames<-names(vertex.attr) else{ vertex.attrnames<-1:length(vertex.attr) warning("Vertex attribute names not given; making some up.") } } #Add the attributes for(i in 1:length(vertex.attr)) g<-set.vertex.attribute(g,vertex.attrnames[[i]],vertex.attr[[i]]) } # xnames <- get.vertex.attribute(g,"vertex.names") # if(!is.null(xnames) & any(!is.na(xnames))){ g <- xnames } #Return the result g } # Construct a network's edge set, using an a bipartite adjacency matrix as input. # #' @name edgeset.constructors #' #' @title Edgeset Constructors for Network Objects #' #' @description These functions convert relational data in matrix form to #' network edge sets. #' #' @details Each of the above functions takes a \code{network} and a matrix #' as input, and modifies the supplied \code{network} object by adding the #' appropriate edges. \code{network.adjacency} takes \code{x} to be an #' adjacency matrix; \code{network.edgelist} takes \code{x} to be an edgelist #' matrix; and \code{network.incidence} takes \code{x} to be an incidence #' matrix. \code{network.bipartite} takes \code{x} to be a two-mode #' adjacency matrix where rows and columns reflect each respective mode #' (conventionally, actors and events); If \code{ignore.eval==FALSE}, #' (non-zero) edge values are stored as edgewise attributes with name #' \code{names.eval}. The \code{edge.check} argument can be added via #' \code{\dots} and will be passed to \code{\link{add.edges}}. #' #' Edgelist matrices to be used with \code{network.edgelist} should have one #' row per edge, with the first two columns indicating the sender and #' receiver of each edge (respectively). Edge values may be provided in #' additional columns. The edge attributes will be created with names #' corresponding to the column names unless alternate names are provided via #' \code{names.eval}. The vertices specified in the first two columns, which #' can be characters, are added to the network in default sort order. The #' edges are added in the order specified by the edgelist matrix. #' #' Incidence matrices should contain one row per vertex, with one column per #' edge. A non-zero entry in the matrix means that the edge with the id #' corresponding to the column index will have an incident vertex with an #' id corresponding to the row index. In the directed case, negative cell #' values are taken to indicate tail vertices, while positive values #' indicate head vertices. #' #' Results similar to \code{network.adjacency} can also be obtained by means #' of extraction/replacement operators. See the associated man page for #' details. #' #' @param x a matrix containing edge information #' @param g an object of class \code{network} #' @param ignore.eval logical; ignore edge value information in x? #' @param names.eval a name for the edge attribute under which to store edge #' values, if any #' @param \dots possible additional arguments (such as \code{edge.check}) #' #' @return Invisibly, an object of class \code{network}; these functions modify #' their argument in place. #' #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' #' @author Carter T. Butts \email{buttsc@uci.edu} and David Hunter #' \email{dhunter@stat.psu.edu} #' #' #' @seealso \code{\link{loading.attributes}}, \code{\link{network}}, #' \code{\link{network.initialize}}, \code{\link{add.edges}}, #' \code{\link{network.extraction}} #' @examples #' #Create an arbitrary adjacency matrix #' m<-matrix(rbinom(25,1,0.5),5,5) #' diag(m)<-0 #' #' g<-network.initialize(5) #Initialize the network #' network.adjacency(m,g) #Import the edge data #' #' #Do the same thing, using replacement operators #' g<-network.initialize(5) #' g[,]<-m #' #' # load edges from a data.frame via network.edgelist #' edata <-data.frame( #' tails=c(1,2,3), #' heads=c(2,3,1), #' love=c('yes','no','maybe'), #' hate=c(3,-5,2), #' stringsAsFactors=FALSE #' ) #' #' g<-network.edgelist(edata,network.initialize(4),ignore.eval=FALSE) #' as.sociomatrix(g,attrname='hate') #' g%e%'love' #' #' # load edges from an incidence matrix #' inci<-matrix(c(1,1,0,0, 0,1,1,0, 1,0,1,0),ncol=3,byrow=FALSE) #' inci #' g<-network.incidence(inci,network.initialize(4,directed=FALSE)) #' as.matrix(g) #' #' #' #' #' @keywords classes graphs #' @export network.bipartite<-function(x, g, ignore.eval=TRUE, names.eval=NULL, ...){ #Set things up to edit g in place gn<-substitute(g) #Build head/tail lists; note that these cannot be hypergraphic or #multiplex, since our data is drawn from an adjacency matrix nactors <- dim(x)[1] nevents <- dim(x)[2] n <- nactors + nevents #Add names if available if(!is.null(colnames(x)) & !is.null(rownames(x))){ g <- set.vertex.attribute(g,"vertex.names",c(rownames(x),colnames(x))) } # convert x into a matrix x<-as.matrix(x) X <- matrix(0,ncol=n,nrow=n) # diag(X) <- 0 X[1:nactors, nactors+(1:nevents)] <- x X[nactors+(1:nevents), 1:nactors] <- t(x) X[row(X)0) add.edges(g, as.list(1+e%%n), as.list(1+e%/%n), names.eval=en, vals.eval=ev, ...) #Patch up g on exit for in-place modification if(.validLHS(gn,parent.frame())){ on.exit(eval.parent(call('<-',gn,g))) } invisible(g) } # Construct a network's edge set, using an adjacency matrix as input. # #' @rdname edgeset.constructors #' @export network.adjacency<-function(x, g, ignore.eval=TRUE, names.eval=NULL, ...){ # check that dimension of g is appropriate for x if (nrow(x)!=ncol(x)){ stop('the network.adjacency constructor expects its matrix argument to be square (same number of rows and columns)') } if (network.size(g) != nrow(x)){ stop('the network.adjacency constructor requires that the size of its network argument (',network.size(g),') matches the dimensions of the matrix argument (',nrow(x),' by ',ncol(x),')') } #Set things up to edit g in place gn<-substitute(g) #Build head/tail lists; note that these cannot be hypergraphic or #multiplex, since our data is drawn from an adjacency matrix if(!is.directed(g)){ missingE <- is.na(x) | is.na(t(x)) x[missingE] <- 1 #Be sure to pick up nonzero entries for which x[i,j]=-x[j,i]. x[x==-t(x)]<-abs(x)[x==-t(x)] x<-(x+t(x))/2 #Symmetrize matrix. x[row(x)0) add.edges(g, as.list(1+e%%n), as.list(1+e%/%n), names.eval=en, vals.eval=ev, ...) #Patch up g on exit for in-place modification if(.validLHS(gn,parent.frame())){ on.exit(eval.parent(call('<-',gn,g))) } invisible(g) } # Construct and a return a network object which is a copy of x # #' @rdname network #' @export network.copy<-function(x){ #Verify that this is a network object if(!is.network(x)) stop("network.copy requires an argument of class network.\n") #Duplicate and return y<-.Call(copyNetwork_R,x) y } # Construct a network's edge set, using an edgelist matrix as input. # #' @rdname edgeset.constructors #' @export network.edgelist<-function(x, g, ignore.eval=TRUE, names.eval=NULL, ...){ #Set things up to edit g in place gn<-substitute(g) l<-dim(x)[2] #Remove loops if has.loops==FALSE if((NROW(x)>0)&&(!has.loops(g))){ cn<-colnames(x) x<-x[x[,1]!=x[,2],,drop=FALSE] #Remove loops colnames(x)<-cn } #Remove redundant edges if is.multiplex==FALSE if((NROW(x)>0)&&(!is.multiplex(g))){ cn<-colnames(x) if(is.directed(g)){ x<-x[!duplicated(x[,1:2,drop=FALSE]),,drop=FALSE] }else{ x[,1:2]<-t(apply(x[,1:2,drop=FALSE],1,sort)) x<-x[!duplicated(x[,1:2,drop=FALSE]),,drop=FALSE] } colnames(x)<-cn } #Traverse the edgelist matrix, adding edges as we go. if((l>2)&&(!ignore.eval)){ #Use values if present... #if names not given, try to use the names from data frame if (is.null(names.eval)){ names.eval<-names(x)[3:l] } #if it is still null, its going to crash, so throw an informative error if (is.null(names.eval)){ stop("unable to add attribute values to edges because names are not provided for each attribute (names.eval=NULL)") } edge.check<-list(...)$edge.check eattrnames <-lapply(seq_len(NROW(x)),function(r){as.list(names.eval)}) # eattrvals <-apply(x[,3:l,drop=FALSE] eattrvals <-lapply(seq_len(NROW(x)),function(r){as.list(x[r,3:l,drop=FALSE])}) g<-add.edges(g,as.list(x[,1]),as.list(x[,2]),eattrnames,eattrvals,edge.check=edge.check) }else{ #...otherwise, don't. edge.check<-list(...)$edge.check g<-add.edges(g,as.list(x[,1]),as.list(x[,2]),edge.check=edge.check) } #Patch up g on exit for in-place modification if(.validLHS(gn,parent.frame())){ on.exit(eval.parent(call('<-',gn,g))) } invisible(g) } # Construct a network's edge set, using an incidence matrix as input. # #' @rdname edgeset.constructors #' @export network.incidence<-function(x, g, ignore.eval=TRUE, names.eval=NULL, ...){ #Set things up to edit g in place gn<-substitute(g) n<-network.size(g) edge.check<-list(...)$edge.check #Traverse the incidence matrix, adding edges as we go. for(i in 1:dim(x)[2]){ #Construct the head and tail sets if(is.directed(g)){ if(any(is.na(x[,i]))) stop("Missing data not allowed for directed incidence matrices.\n") head<-(1:n)[x[,i]>0] tail<-(1:n)[x[,i]<0] missing<-FALSE }else{ missing<-any(is.na(x[,i])) x[,i][is.na(x[,i])]<-1 head<-(1:n)[x[,i]!=0] if(is.hyper(g)) tail<-head else{ #If dyadic, use only the first two nonzero entries tail<-head[1] head<-head[2] } } if(length(head)*length(tail)==0) stop("Supplied incidence matrix has empty head/tail lists. (Did you get the directedness right?)") #Get edge values, if needed if(ignore.eval){ en<-"na" ev<-missing }else{ if(!is.directed(g)) ev<-list(missing,x[x[,i]!=0,i][1]) else ev<-list(missing,abs(x[x[,i]!=0,i][1])) if(is.null(names.eval)) en<-list("na",NULL) else en<-list("na",names.eval) } #Add the edge to the graph g<-add.edge(g,tail,head,names.eval=en,vals.eval=ev,edge.check=edge.check) } #Patch up g on exit for in-place modification if(.validLHS(gn,parent.frame())){ on.exit(eval.parent(call('<-',gn,g))) } invisible(g) } # Initialize a new network object. # MSH added bipartite # #' Initialize a Network Class Object #' #' Create and initialize a \code{network} object with \code{n} vertices. #' #' Generally, \code{network.initialize} is called by other constructor #' functions as part of the process of creating a network. #' #' @param n the number of vertices to initialize #' @param directed logical; should edges be interpreted as directed? #' @param hyper logical; are hyperedges allowed? #' @param loops logical; should loops be allowed? #' @param multiple logical; are multiplex edges allowed? #' @param bipartite count; should the network be interpreted as bipartite? If #' present (i.e., non-NULL) it is the count of the number of actors in the #' first mode of the bipartite network. In this case, the overall number of #' vertices is equal to the number of 'actors' (first mode) plus the number of #' `events' (second mode), with the vertex.ids of all actors preceeding all #' events. The edges are then interpreted as nondirected. #' @return An object of class \code{network} #' @author Carter T. Butts \email{buttsc@@uci.edu} #' @seealso \code{\link{network}}, \code{\link{as.network.matrix}} #' @references Butts, C. T. (2008). \dQuote{network: a Package for Managing #' Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). #' \doi{10.18637/jss.v024.i02} #' @keywords classes graphs #' @examples #' #' g<-network.initialize(5) #Create an empty graph on 5 vertices #' #' @export network.initialize network.initialize<-function(n,directed=TRUE,hyper=FALSE,loops=FALSE,multiple=FALSE,bipartite=FALSE){ #If we have a negative number of vertices, we have a problem... n<-round(n) if(n<0) stop("Network objects cannot be of negative order.") #Create the base-level lists g<-list() g$mel<-list() g$gal<-list() #Create the required network attributes g$gal$n<-n g$gal$mnext<-1 g$gal$directed<-directed g$gal$hyper<-hyper g$gal$loops<-loops g$gal$multiple<-multiple g$gal$bipartite<-bipartite #Populate the vertex attribute lists, endpoint lists, etc. if(n>0){ g$val<-rep(list(list()), n) g$iel<-rep(list(integer()), n) g$oel<-rep(list(integer()), n) }else{ g$val<-vector(length=0,mode="list") g$iel<-vector(length=0,mode="list") g$oel<-vector(length=0,mode="list") } #Set the class class(g)<-"network" #Set the required vertex attribute if(n>0) g<-set.vertex.attribute(g,"na",rep(FALSE,n),1:n) #Create default vertex names if(n>0) network.vertex.names(g)<-1:n #Return g } network/COPYING0000644000176200001440000000162214057014734013004 0ustar liggesusers network Package for R - Classes for Relational Data Copyright (C) 2005-2021 Carter T. Butts, Mark S. Handcock, David R. Hunter, Martina Morris, and others (see DESCRIPTION). This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA network/vignettes/0000755000176200001440000000000014725415437013767 5ustar liggesusersnetwork/vignettes/networkVignette.Rnw0000644000176200001440000023443013357022000017640 0ustar liggesusers\documentclass[article,shortnames,nojss]{jss} %\documentclass{article} \usepackage{amsfonts,amssymb,amsthm,amsmath,rotating} %\usepackage{natbib} %for easy biblo %\usepackage{hyperref} %for url links %\usepackage{comment} %\usepackage{color} %\VignetteIndexEntry{network Vignette} \author{Carter T.\ Butts\\ University of California, Irvine} \Plainauthor{Carter T. Butts} \title{\pkg{network}: A Package for Managing Relational Data in \proglang{R}} \Plaintitle{network: A Package for Managing Relational Data in R} \Shorttitle{\pkg{network}: Managing Relational Data in \proglang{R}} \Abstract{ Effective memory structures for relational data within \proglang{R} must be capable of representing a wide range of data while keeping overhead to a minimum. The \pkg{network} package provides an class which may be used for encoding complex relational structures composed a vertex set together with any combination of undirected/directed, valued/unvalued, dyadic/hyper, and single/multiple edges; storage requirements are on the order of the number of edges involved. Some simple constructor, interface, and visualization functions are provided, as well as a set of operators to facilitate employment by end users. The package also supports a \proglang{C}-language API, which allows developers to work directly with \pkg{network} objects within backend code.} \Keywords{relational data, data structures, graphs, \pkg{network}, \pkg{statnet}, \proglang{R}} \Plainkeywords{relational data, data structures, graphs, network, statnet, R} \Volume{24} \Issue{2} \Month{February} \Year{2008} \Submitdate{2007-06-01} \Acceptdate{2007-12-25} \Address{ Carter T.\ Butts\\ Department of Sociology and Institute for Mathematical Behavioral Sciences\\ University of California, Irvine\\ Irvine, CA 92697-5100, United States of America\\ E-mail: \email{buttsc@uci.edu}\\ URL: \url{http://www.faculty.uci.edu/profile.cfm?faculty_id=5057} } \begin{document} \definecolor{Sinput}{rgb}{0.19,0.19,0.75} \definecolor{Soutput}{rgb}{0.2,0.3,0.2} \definecolor{Scode}{rgb}{0.75,0.19,0.19} \DefineVerbatimEnvironment{Sinput}{Verbatim}{formatcom = {\color{Sinput}}} \DefineVerbatimEnvironment{Soutput}{Verbatim}{formatcom = {\color{Soutput}}} \DefineVerbatimEnvironment{Scode}{Verbatim}{formatcom = {\color{Scode}}} \renewenvironment{Schunk}{}{} \SweaveOpts{concordance=TRUE} PLEASE NOTE: This document has been modified from the original paper to form a package vignette. It has been compiled with the version of the network package it is bundled with, and has been partially updated to reflect some changes in the package. The original paper is:\\ \pkg{network}: A Package for Managing Relational Data in \proglang{R}. \emph{Journal of Statistical Software} 24:2, 2008. \url{http://www.jstatsoft.org/v24/i02/paper} \section{Background and introduction} In early 2002, the author and several other members of what would ultimately become the \pkg{statnet} project \citep{statnet} came to the conclusion that the simple, matrix-based approach to representation of relational data utilized by early versions of packages such as \pkg{sna} were inadequate for the next generation of relational analysis tools in \proglang{R}. Rather, what was required was a customized class structure to support relational data. This class structure would be used for all \pkg{statnet} packages, thus insuring interoperability; ideally, it would also be possible to port this structure to other languages, thereby further enhancing compatibility. The requirements which were posed for a network data class were as follows, in descending order of priority: \begin{enumerate} \item The class had to be sufficiently general to encode all major types of network data collected presently or in the foreseeable future; \item Class storage needed to be of sufficient efficiency to permit representation of large networks (in particular, storage which was sub-quadratic in graph order for sparse networks); and \item It had to be possible to develop interface methods to the class which were of reasonable computational efficiency. \end{enumerate} Clearly, there are multiple approaches which could be taken to construct such a class structure. Here we describe the result of one particular effort, specifically the \pkg{network} package \citep{network} for the \proglang{R} system for statistical computing \citep{R}. \subsection{Historical note} The \pkg{network} package as described here evolved from a specification originally written as an unpublished working paper, ``Memory Structures for Relational Data in \proglang{R}: Classes and Interfaces'' \citep{butts:tr:2002}. At this time, the class in question was tentatively entitled ``graph.'' It subsequently emerged that a similar package was being developed by Robert Gentleman under the \pkg{graph} title (as part of the BioConductor project) \citep{gentleman.et.al:sw:2007}, and the name of the present project was hence changed to ``network'' in early 2005. A somewhat later version of the above relational data specification was also shared with Gabor Csardi in mid-2004, portions of which were incorporated in the development by Gabor of the \pkg{igraph} package \citep{gabor:sw:2007}. As a result, there are currently three commonly available class systems for relational data in \proglang{R}, two of which (\pkg{network} and \pkg{igraph}) share some common syntax and interface concepts. It should also be noted that (as mentioned above) both standard and sparse matrix \citep[e.g., \pkg{sparseM}][]{koenker.ng:sw:2007} classes have been and continue to be used to represent relational data in \proglang{R}. This article does not attempt to address the relative benefits and drawbacks of these different tools, but readers should be aware that multiple alternatives are available. \subsection{A very quick note on notation} Throughout this paper we will use ``graph'' or ``network'' ($G$) generically to refer to any relational structure on a given vertex set ($V$), and ``edge'' to refer to a generalized edge (i.e., an ordered pair $(T,H)$ where $T$ is the ``tail set'' of the edge and $H$ is the corresponding ``head set,'' and where $T,H \subseteq V(G)$). The cardinality of the vertex set we denote $|V(G)|=n$, and the cardinality of the corresponding edge set we likewise denote $|E(G)|=m$. When discussing storage/computational complexity we will often use a loose order notation, where $\mathcal{O}\bigl(f\left(x\right)\bigr)$ is intended to indicate that the quantity in question grows more slowly than $f(x)$ as $x \to \infty$. A general familiarity with the \proglang{R} statistical computing system (and related syntax/terminology) is assumed. Those unfamiliar with \proglang{R} may wish to peruse a text such as those of \citet{venables.ripley:bk:2000,venables.ripley:bk:2002} or \citet{chambers:bk:1998}. \section[The network class]{The \code{network} class} The \code{network} class is a (reasonably) simple object structure designed to store a single relation on a vertex set of arbitrary size. The relation stored by a \code{network} class object is based on a generalized edge model; thus, edges may be directed, arbitrarily valued (with multiple values per edge), multiplex (i.e., multiple edges per directed dyad), hyper (i.e., multiple head/tail vertices per edge), etc. Storage requirements for the \code{network} class are on the order of the number of nodes plus the total number of edges (which is substantially sub-$n^2$ for sparse graphs), and retrieval of edge values has a time complexity which is no worse than $\mathcal{O}(n)$.\footnote{Edge retrieval actually scales with degree, and average retrieval time is hence approximately constant for many data sources. For an argument regarding constraints on the growth of mean degree in interpersonal networks, see e.g., \citet{mayhew.levinger:ajs:1976}.} For example, a network with 100,000 vertices and 100,000 edges currently consumes approximately 74MB of RAM (\proglang{R} 2.6.1), versus approximately 40GB for a full sociomatrix (a savings of approximately 99.8\%). When dealing with extremely large, sparse graphs it therefore follows that \code{network} objects are substantially more efficient than simpler representations such as adjacency matrices. The class also provides for the storage of arbitrary metadata at the edge, vertex, and network level. Thus, \code{network} objects may be preferred to matrix representations for reasons of generality, performance, or integrative capability; while alternative means exist of obtaining these goals separately, \pkg{network} provides a single toolkit which is designed to be effective across a wide range of applications. In this section, we provide a basic introduction to the \code{network} class, from a user's point of view. We describe the conditions which are necessary for \pkg{network} to be employed, and the properties of \code{network} objects (and their components). This serves as background for a discussion of the use of \pkg{network} methods in practical settings, which is given in the section which follows. \subsection{Identification of vertices and edges} For purposes of storage, we presume that each vertex and each edge can be uniquely identified. \citep[For partially labeled or unlabeled graphs, observe that this internal labeling is essentially arbitrary. See][for a discussion.]{butts.carley:cmot:2005} Vertices are labeled by positive integers in the order of entry, with edges likewise; it is further assumed that this is maintained for vertices (e.g., removing a vertex requires relabeling) but not for edges. (This last has to do with how edges are handled internally, but has the desirable side effect of making edge changes less expensive.) Vertices and edges are always stored by label. In the text that follows, any reference to a vertex or edge ``ID'' refers to these labeling numbers, and not to any other (external) identification that a vertex or edge may have. \subsection{Basic class structure} Functionally, a \code{network} object can be thought as a collection of vertices and edges, together with metadata regarding those vertices and edges (as well as the network itself). As noted above, each vertex is assumed to be identifiable, and the number of vertices is fixed. Here, we discuss the way in which edges are defined within \pkg{network}, as well as the manner in which associated metadata is stored. \subsubsection{Edge structure} Edges within a \code{network} object consist of three essential components. First, each edge contains two vectors of vertex IDs, known respectively as the \emph{head} and \emph{tail} lists of the edge. In addition to these lists, each edge also contains a list of attribute information. This is discussed in more detail below. The content and interpretation of the head and tail lists are dependent on the type of network in which they reside. In a directed network, an edge connects the elements of its tail list with those of its head list, but not vice versa: $i$ is adjacent to $j$ iff there exists some edge, $e=(T,H)$, such that $i\in T, j\in H$. In an undirected network, by contrast, the head and tail sets of an edge are regarded as exchangeable. Thus, $i$ is adjacent to $j$ in an undirected network iff there exists an edge such that $i\in T, j\in H$ or $i\in H, j\in T$. \pkg{network} methods which deal with adjacency and incidence make this distinction transparently, based on the network object's directedness attribute (see below). Note that in the familiar case of dyadic networks (the focus of packages such as \pkg{sna} \citep{sna}), the head and tail lists of any given edge must have exactly one element. This need not be true in general, however. An edge with a head or tail list containing more than one element is said to be \emph{hypergraphic}, reflecting a one-to-many, many-to-one, or many-to-many relationship. Hyperedges are permitted natively within \pkg{network}, although some methods may not support them -- a corresponding network attribute is used by \pkg{network} methods to determine whether these edges are present, as explained below. Finally, another fundamental distinction is made between edges in which $H$ and $T$ are disjoint, versus those in which these endpoint lists have one or more elements in common. Edges of the latter type are said to be \emph{loop-like}, generalizing the familiar notion of ``loop'' (self-tie) from the theory of dyadic graphs. Loop-like edges allow vertices to relate to themselves, and are disallowed in many applications. Applicable methods are expected to interpret such edges intelligently, where present. \subsubsection[network attributes]{\code{network} attributes} \label{sec_net_attr} As we have already seen, each \code{network} object contains a range of metadata in addition to relational information. This metadata -- in the form of attributes -- is divided into information stored at the network, vertex, and edge levels. In all three cases, attributes are stored in \code{list}s, and are expected to be named. While there is no limit to the user-defined attributes which may be stored in this manner, certain attributes are required of all \code{network} objects. At the network level, such attributes describe general properties of the network as a whole; specifically, they may be enumerated as follows: \begin{description} \item[\code{bipartite}] This is a \code{logical} or \code{numeric} attribute, which is used to indicate the presence of an intrinsic bipartition in the \code{network} object. Formally, a bipartition is a partition of a network's vertices into two classes, such that no vertex in either class is adjacent to any vertex in the same class. While such partitions occur naturally, they may also be specifically enforced by the nature of the data in question. (This is the case, for instance, with two-mode networks \citep{wass:faus1994}, in which edges represent connections between two distinct classes of entities.) In order to allow for bipartite networks with a partition size of zero, non-bipartite networks are marked as \code{bipartite=FALSE}. Where the value of \code{bipartite} is numeric, \pkg{network} methods will automatically assume that vertices with IDs less than or equal to \code{bipartite} belong to one such class, with those with IDs greater than \code{bipartite} belonging to the other. This information may be used in selecting default modes for data display, calculating numbers of possible edges, etc. When \code{bipartite == FALSE} or {NULL}, by contrast, no such bipartition is assumed. Because of the dual \code{logical}/\code{numeric} nature of the attribute, it is safest to check it using the \code{is.bipartite} method. It should be emphasized that \code{bipartite} is intended to reflect bipartitions which are required \emph{ex ante,} rather than those which happen to arise empirically. There is also no performance advantage to the use of \code{bipartite}, since \pkg{network} only stores edges which are defined; it can make data processing more convenient, however, when working with intrinsically bipartite structures. \item[\code{directed}] This is a \code{logical} attribute, which should be set to \code{TRUE} iff edges are to be interpreted as directed. As explained earlier, \pkg{network} methods will regard edge endpoint lists as exchangeable when \code{directed} is \code{FALSE}, allowing for automatic handling of both directed and undirected networks. For obvious reasons, misspecification of this attribute may lead to surprising results; it is generally set when a \code{network} object is created, and considered fixed thereafter. \item[\code{hyper}] This attribute is a \code{logical} variable which is set to \code{TRUE} iff the network is allowed to contain hyperedges. Since the vast majority of network data is dyadic, this attribute defaults to \code{FALSE} for must construction methods. The setting of \code{hyper} to \code{TRUE} has potentially serious implications for edge retrieval, and so methods should not activate this option unless hypergraphic edges are explicitly to be permitted. \item[\code{loops}] As noted, loop-like edges are frequently undefined in practical settings. The \code{loops} attribute is a \code{logical} which should be set to \code{TRUE} iff such edges are permitted within the network. \item[\code{multiple}] In most settings, an edge is uniquely defined by its head and tail lists. In other cases, however, one must represent data in which multiple edges are permitted between the same endpoints. (``Same'' here includes the effect of directedness; an edge from set $H$ to set $T$ is not the same as an edge from set $T$ to set $H$, unless the network is undirected.) The \code{multiple} attribute is a \code{logical} variable which is set to \code{TRUE} iff such multiplex edges are permitted within the network. Where \code{multiple} is \code{FALSE}, \pkg{network} methods will assume all edges to be unique -- like \code{directed}, the possibility of multiplex edges thus can substantially impact both behavior and performance. For this reason, \code{multiple} is generally set to \code{FALSE} by default, and should not be set to \code{TRUE} unless it is specifically necessary to permit multiple edges between the same endpoint sets. \item[\code{n}] Finally, \code{n} is a \code{numeric} attribute containing the number of elements in the vertex set. Applicable methods are expected to adjust this attribute up or down, should vertices be added or deleted from the network. Note that as of \pkg{network} v1.8, networks of size zero are permitted. \end{description} While these attributes are clearly reserved, any number of others may be added. Attributes specifically pertaining to edges and/or vertices can be stored at the network level, but this is generally non-optimal -- such attributes would have to be manually updated to reflect edge or vertex changes, and would require the creation of custom access methods. The preferred approach is to store such information directly at the edge or vertex level, as we discuss below. \subsubsection[Vertex attributes]{Vertex attributes} As with the network as a whole, it is often useful to be able to supply attribute data for individual vertices (e.g., names, attributes, etc.). Each vertex thus has a \code{list} of named attributes, which can be used to store arbitrary information on a per-vertex basis; there is no restriction on the type of information which may be stored in this fashion, nor are all vertices constrained to carry information regarding the same attributes. Each vertex does carry two special attributes, however, which are assumed to be available to all class methods. These are \code{vertex.names}, which must be a \code{character} containing the name of the vertex, and the \code{logical} attribute \code{na}. Where \code{TRUE}, \code{na} indicates that the associated vertex is unobserved; this is useful in cases for which individual entities are known to belong to a given network, but where data regarding those entities is unavailable. By default, \code{na} is set to \code{FALSE} and \code{vertex.names} is set equal to the corresponding vertex ID. \subsubsection[Edge attributes]{Edge attributes} Just as vertices can carry attributes, so too can edges. Each edge is endowed with a \code{list} of named attributes, which can be used to carry arbitrary information (e.g., tie strength, onset and termination times, etc.). As with vertex attributes, any information type may be employed and there is no requirement that all edges carry the same attributes. The one attribute required to be carried by each edge is \code{na}, a \code{logical} which (like the vertex case) is used to indicate the missingness of a given edge. Many \pkg{network} methods provide the option of filtering out missing edges when retrieving information, and/or returning the associated information (e.g., adjacency) as missing. \section[Using the network class]{Using the \code{network} class} In addition to the class itself, \pkg{network} provides a range of tools for creating, manipulating, and visualizing \code{network} objects.\footnote{These tools are currently implemented via S3 methods.} Here, we provide an overview of some of these tools, with a focus on the basic tasks most frequently encountered by end users. Additional information on these functions is also provided within the package manual. For the examples below, we begin by loading the network package into memory; we also set the random seed, to ensure that examples using random data match the output shown here. Within \proglang{R}, this may be accomplished via the following: <<>>= library(network) set.seed(1702) @ Throughout, we will represent \proglang{R} code in the above format. Readers may wish to try the demonstrations listed here for themselves, to get a better feel for how the package operates. \subsection{Importing data} It almost goes without saying that an important aspect of \pkg{network} functionality is the ability to import data from external sources. \pkg{network} includes functionality for the importation of \pkg{Pajek} project files \citep{pajek}, a popular and versatile network data format, via the \code{read.paj} routine. Other formats supported by \pkg{sna} can be used as well, by importing to adjacency matrix form (using the relevant \pkg{sna} routines) and then coercing the result into a \code{network} object as described below. The \pkg{foreign} package can be used to import adjacency, edgelist, or incidence matrices from other computing environments in much the same way. Future package versions may include support for converting to and from other related classes, e.g., those of \pkg{RBGL} \citep{carey.et.al:sw:2007} and \pkg{Rgraphviz} \citep{gentry.et.al:sw:2007}. In addition to these methods, \code{network} objects can be loaded into \proglang{R} using native tools such as \code{load} (for saved objects) or \code{data} (for packaged data sets). With respect to the latter, \pkg{network} contains two sample data sets: \code{flo}, John Padgett's Florentine wedding data \citep[from][]{wass:faus1994}; and \code{emon}, a set of interorganizational networks from search and rescue operations collected by \citet{drabek.et.al:bk:1981}. \code{flo} consists of a single adjacency matrix, and is useful for illustrating the process of converting data from adjacency matrix to \code{network} form. \code{emon}, on the other hand, consists of a list of seven \code{network} objects with vertex and edge metadata. \code{emon} is thus especially useful for illustrating the use of \code{network} objects for rich data storage (in addition to being an interesting data set in its own right). Loading these data sets is as simple as invoking the \code{data} command, like so: <<>>= data("flo") data("emon") @ Further information on each of these data sets is given in the \pkg{network} manual. We shall also use these data sets as illustrative examples at various points within this paper. \subsection[Creating and viewing network objects]{Creating and viewing \code{network} objects} While importation is sometimes possible, in other cases we must create our own \code{network} objects. \pkg{network} supports two basic approaches to this task: create the object from scratch, or build it from existing relational data via coercion. Both methods are useful, and we illustrate each here. In the most minimal case, we begin by creating an empty network to which edges may be added. This task is performed by the \code{network.initialize} routine, which serves as a constructor for the \code{network} class. \code{network.initialize} takes the order of the desired graph (i.e., $n$) as a required argument, and the required network attributes discussed in Section~\ref{sec_net_attr} may be passed as well. In the event that these are unspecified, it is assumed that a simple digraph (directed, no loops, hyperedges, multiplexity, or bipartitions) is desired. For example, one may create and print an empty digraph like so: <<>>= net <- network.initialize(5) net @ \pkg{network} has default \code{print} and \code{summary} methods, as well as low-level operators for assignment and related operations. These do not show much in the above case, since the network in question caries little information. To create a \code{network} along with a specified set of edges, the preferred high-level constructor is the eponymous \code{network}. Like \code{network.initialize}, this function returns a newly allocated \code{network} object having specified properties. Unlike the former, however, \code{network} may be called with adjacency and/or attribute information. Adjacency information may be passed by using a full or bipartite adjacency matrix, incidence matrix, or edgelist as the function's first argument. These input types are defined as follows: \begin{description} \item[Adjacency matrix:] This must consist of a square \code{matrix} or two-dimensional \code{array}, whose $i,j$th cell contains the value of the edge from $i$ to $j$; as such, adjacency matrices may only be used to specify dyadic networks. By default, edges are assumed to exist for all non-zero matrix values, and are constructed accordingly. Edge values may be retained by passing \code{ignore.eval = FALSE}, as described in the manual page for the \code{network.adjacency} constructor. The \code{matrix.type} for an adjacency matrix is \code{"adjacency"}. \item[Bipartite adjacency matrix:] This must consist of a rectangular \code{matrix} or two-dimensional \code{array} whose row and column elements reflect vertices belonging to the lower and upper sets of a bipartition (respectively). Otherwise, the matrix is interpreted as per a standard adjacency matrix. (Thus, a bipartite adjacency matrix is simply the upper off-diagonal block of the full adjacency matrix for a bipartite graph, where vertices have been ordered by partition membership. See also \citet{doreian.et.al:bk:2005}.) The \code{matrix.type} for a bipartite adjacency matrix is \code{"bipartite"}. \item[Incidence matrix:] This must consist of a rectangular \code{matrix} or two-dimensional \code{array} whose row elements represent vertices, and whose column elements represent edges. A non-zero value is placed in the $i,j$th cell if vertex $i$ is an endpoint of edge $j$. In the directed case, negative values signify membership in the tail set of the corresponding edge, while positive values signify membership in the edge's head set. Unlike adjacency matrices, incidence matrices can thus be used to describe hypergraphic edges (directed or otherwise). Note, however, that an undirected hypergraph composed of two-endpoint edges is not the same as a simple graph, since the edges of the former are necessarily loop-like. When \code{loops}, \code{hyper}, and \code{directed} are all \code{FALSE}, therefore, the two positive row-elements of an incidence matrix for each column are taken to signify the head and tail elements of a dyadic edge. (This is without loss of generality, since such an incidence matrix would otherwise be inadmissible.) When specifying that an incidence matrix is to be used, \code{matrix.type} should be set to \code{"incidence"}. \item[Edge list:] This must consist of a rectangular \code{matrix} or two-dimensional \code{array} whose row elements represent edges. The $i,1$st cell of this structure is taken to be the ID of the tail vertex for the edge with ID $i$, with the $i,2$st cell containing the ID of the edge's head vertex. (Only dyadic networks may be input in this fashion.) Additional columns, if present, are taken to contain edge attribute values. The \code{matrix.type} for an edge list is \code{"edgelist"}. \end{description} As one might suspect, the \code{network} function actually operates by first calling \break\code{network.initialize} to create the required object, and then calling an appropriate edge set constructor based on the input type. This fairly modular design allows for the eventual inclusion of a wider range of input formats (although the above covers the formats currently in widest use within the social network community). Although \code{network} attempts to infer the matrix type from context, is wise to fix the function's behavior via the \code{matrix.type} argument when passing information which is not in the default, adjacency matrix form. As a simple example of the \code{network} constructor in action, consider the following: %\begin{Code} %#Create a less empty network %nmat <- matrix(rbinom(25,1,0.5),nr=5,nc=5) #Generate a random adjacency % #matrix %net <- network(nmat,loops=TRUE) #Use it to create a digraph % #w/loops %net #Display using print method %summary(net) #Display using summary method %all(nmat==net[,]) #Should be TRUE %\end{Code} <<>>= nmat <- matrix(rbinom(25, 1, 0.5), nr = 5, nc = 5) net <- network(nmat, loops = TRUE) net @ <<>>= summary(net) @ <<>>= all(nmat == net[,]) @ Here, we have generated a random adjacency matrix (permitting diagonal elements) and used this to construct a digraph (with loops) in \code{network} object form. Since we employed an adjacency matrix, there was no need to set the matrix type explicitly; had we failed to set \code{loops = TRUE}, however, the diagonal entries of \code{nmat} would have been ignored. The above example also demonstrates the use of an important form of operator overloading which can be used with dyadic network objects: specifically, dyadic network objects respond to the use of the subset and subset assignment operators \code{[} and \code{[<-} as if they were conventional adjacency matrices. Thus, in the above case, \code{net[,]} returns \code{net}'s adjacency matrix (a fact we verify by comparing it with \code{nmat}). This is an extremely useful ``shorthand'' which can be used to simplify otherwise cumbersome network operations, especially on small networks. The use of \code{network} function to create objects from input matrices has a functional parallel in the use of coercion methods to transform other objects into \code{network} form. These operate in the same manner as the above, but follow the standard \proglang{R} syntax for coercion, e.g.: %\begin{Code} %#Can also use coercion %net <- as.network(nmat, loops = TRUE) %all(nmat==net[,]) #Should still be TRUE %\end{Code} <<>>= net <- as.network(nmat, loops = TRUE) all(nmat == net[,]) @ By default, \code{as.network} assumes that square input matrices should be treated as adjacency matrices, and that diagonal entries should be ignored; here we have overridden the latter behavior by invoking the additional argument \code{loops = TRUE}. Matrix-based input can also be given in edgelist or incidence matrix form, as selected by the \code{matrix.type} argument. This and other options are described in greater detail within the package documentation. The above methods can be used in conjunction with \code{data}, \code{load}, or \code{read} functions to convert imported relational data into \code{network} form. For example, we may apply this to the Florentine data mentioned in the previous section: <<>>= nflo <- network(flo, directed = FALSE) nflo @ Although the network's adjacency structure is summarized here in edgelist form, it may be queried in other ways. For instance, the following example demonstrates three simple methods for examining the neighborhood of a particular vertex: <<>>= nflo[9,] nflo[9,1] nflo[9,4] is.adjacent(nflo, 9, 1) is.adjacent(nflo, 9, 4) @ As the example shows, overloading can be used to extract partial as well as complete adjacency information from a \code{network} object. A more cumbersome (but slightly faster) method is to use a direct call to \code{is.adjacent}, the general indicator method for network adjacency. Calling the indicator method avoids the call parsing required by the extraction operator, which is the source of the performance difference. In practice, however, the impact of call parsing is quite minimal, and users are unlikely to detect a difference between the two approaches. (Where such overhead is an issue, it will generally be more efficacious to conduct adjacency queries directly from the backend code; this will be discussed below, in the context of the \proglang{C}-language API.) In addition to adjacency, \pkg{network} supplies methods to query many basic properties of \code{network} objects. Although complex structural descriptives \citep[e.g., centrality scores][]{wass:faus1994} are the province of other packages, \pkg{network}'s built-in functionality is sufficient to determine the types of edges allowed within a \code{network} object and constraints such as enforced bipartitions, as well as essential quantities such as size (number of vertices), edge count, and density (the ratio of observed to potential edges). Use of these indicator methods is straightforward, as illustrated by the following examples. <<>>= network.size(nflo) #Number of vertices network.edgecount(nflo) #Number of edges network.density(nflo) #Network density has.loops(nflo) #Can nflo have loops? is.bipartite(nflo) #Is nflo coded as bipartite? is.directed(nflo) #Is nflo directed? is.hyper(nflo) #Is nflo hypergraphic? is.multiplex(nflo) #Are multiplex edges allowed? @ \subsection[Coercing network objects to other forms]{Coercing \code{network} objects to other forms} Just as one may often seek to coerce data from other forms into \code{network} object, so to does one sometimes need to coerce \code{network} objects into other data types. \pkg{network} currently supports several such coercion functions, all of which take network objects as input and produce matrices of one type or another. The class method for \code{as.matrix} performs this task, converting network objects to adjacency, incidence, or edgelist matrices as desired (adjacency being the default). Scalar-valued edge attributes, where present, may be used to set edge values using the appropriate functional arguments. Similar functionality is provided by \code{as.sociomatrix} and the extraction operator, although these are constrained to produce adjacency matrices. These equivalent approaches may be illustrated with application to the Florentine data as follows: <<>>= as.sociomatrix(nflo) all(nflo[,]==as.sociomatrix(nflo)) all(as.matrix(nflo)==as.sociomatrix(nflo)) as.matrix(nflo,matrix.type="edgelist") @ Note that vertex names (per the \code{vertex.names} attribute) are used by \code{as.sociomatrix} to set adjacency matrix row/column names where present. The less-flexible \code{as.sociomatrix} function also plays an important role with respect to coercion in the \pkg{sna} package; the latter's \code{as.sociomatrix.sna} dispatches to \pkg{network}'s \code{as.sociomatrix} routine when \pkg{network} is loaded and a \code{network} object is given. The intent in both packages is to maintain an interoperable and uniform mechanism for guaranteeing adjacency matrix representations of input data (which are necessary for backward compatibility with some legacy functions). \subsection{Creating and modifying edges and vertices} In addition to coercion of data to \code{network} form, the \pkg{network} package contains many mechanisms for creating, modifying, and removing edges and vertices from \code{network} objects. The simplest means of manipulating edges for most users is the use of the overloaded extraction and assignment operators, which (as noted previously) simulate the effects of working with an adjacency matrix. Thus, a statement such as \code{g[i,j] <- 1} adds an edge between \code{i} and \code{j} (if one is not already present), \code{g[i,j] <- 0} removes an existing edge, and \code{g[i,j]} itself is a dichotomous indicator of adjacency. Subset selection and assignment otherwise works in the same fashion as for \proglang{R} matrices, including the role of \code{logical}s and element lists. (One minor exception involves the effects of assignment on undirected and/or loopless graphs: \pkg{network} will enforce symmetry and/or empty diagonal entries, and will ignore any assignments which are contrary to this.) The uses of assignment by overloading are hence legion, as partially illustrated by the following: <<>>= #Add edges to an empty network net <- network.initialize(5,loops=TRUE) net[nmat>0] <- 1 #One way to add edges all(nmat==net[,]) #Should be TRUE net[,] <- 0 #Remove the edges net[,] <- nmat #Not quite kosher, but _will_ work.... all(nmat==net[,]) #Should still be TRUE net[,] <- 0 #Remove the edges for(i in 1:5) #Add the hard way! for(j in 1:5) if(nmat[i,j]) net[i,j] <- 1 all(nmat==net[,]) #Should STILL be TRUE net[,] <- 0 #Remove the edges add.edges(net,row(nmat)[nmat>0],col(nmat)[nmat>0]) all(nmat==net[,]) #When will it all end?? net[,] <- as.numeric(nmat[,]) all(nmat==net[,]) #When will it all end?? @ The above example also introduces \code{add.edges}, to which the overloaded assignment operator is a front end. \code{add.edges} is more cumbersome to employ than the assignment operators, but is substantially more powerful. In particular, it can be used to add edges of arbitrary type, with arbitrary attribute data. A comparison of usage is instructive; we begin by creating an empty digraph, and adding a single edge: <<>>= #Add edges (redux) net<-network.initialize(5) #Create empty graph add.edge(net,2,3) #Create 2->3 edge net[,] #Trust, but verify add.edges(net,c(3,5),c(4,4)) #3 and 5 send ties to 4 net[,] #Again, verify edges net[,2]<-1 #Everyone sends ties to 2 net[,] #Note that loops are not created! @ Observe that the (2,2) loop is not created, since \code{loops} is \code{FALSE} for this network. This automatic behavior is \emph{not} true of \code{add.edges}, unless optional edge checking is turned on (by means of the \code{edge.check} argument). For this reason, explicit use of \code{add.edges} is discouraged for novice users. In addition to edge addition/removal, vertices can be added or removed via \code{add.vertices} and \code{delete.vertices}. The former adds the specified number of vertices to a \code{network} object (along with any supplied attribute information), while the latter deletes a specified list of vertices from its argument. Usage is straightforward: <<>>= #Deleting vertices delete.vertices(net,4) #Remove vertex 4 net[,] #It's gone! add.vertices(net,2) #Add two new vertices net[,] #Both are isolates @ As the above illustrates, vertex names are not automatically created for newly added vertices\footnote{See the ``Persistent ID'' functionality in the the networkDynamic package for maintainable ids} (but can be subsequently assigned). New vertices are always added as isolates (i.e., without existing ties), and any edges having a deleted vertex as an endpoint are removed along with the deleted vertex. The use of \code{is.adjacent} (and friends) to perform adjacency testing has been shown above. While this is adequate for many purposes, it is sometimes necessary to examine an edge's contents in detail. As we have seen, each edge can be thought of as a list made up of a vector of tail vertex IDs, a vector of head vertex IDs, and a vector of attributes. The utility function \code{get.edges} retrieves edges in this form, returning them as lists with elements \code{inl} (tail), \code{outl} (head), and \code{atl} (attributes). \code{get.edges} allows for edges to be retrieved by endpoint(s), and is usable even on multiplex networks. Incoming or outgoing edges (or both) can be selected, as per the following example: <<>>= #Retrieving edges get.edges(net,1) #Out-edges sent by vertex 1 get.edges(net,2,neighborhood="in") #In-edges to vertex 2 get.edges(net,1,alter=2) #Out-edges from 1 to 2 @ The \code{alter} argument in the last case tells \code{get.edges} to supply only edges from vertex 1 to vertex 2. As with other applications of \code{get.edges}, this will return all applicable edges in the multiplex case. Retrieving edges themselves is useful, but does not provide the edges' ID information -- particularly in multiplex networks, such information is needed to delete or modify edges. For that purpose, we employ a parallel routine called \code{get.edgeIDs}: <<>>= #Retrieving edge IDs get.edgeIDs(net,1) #Same as above, but gets ID numbers get.edgeIDs(net,2,neighborhood="in") get.edgeIDs(net,1,alter=2) @ By the same token, it is sometimes the vertex neighborhood (rather than edge neighborhood) which is of interest. The \code{get.neighborhood} function can be used in these cases to obtain vertex neighborhoods directly, without having to first query edges. (Since this operation is implemented in the underlying compiled code, it is considerably faster than an \proglang{R}-level front end would be.) <<>>= #Vertex neighborhoods get.neighborhood(net,1) #1's out-neighbors get.neighborhood(net,2,type="in") #2's in-neighbors @ Finally, we note that edge deletion can be performed either by assignment operators (as noted above) or by the \code{delete.edges} function. \code{delete.edges} removes edges by ID, and hence is not primarily employed by end users. In conjunction with tools such as \code{get.edgeIDs}, however, it can be seen to be quite versatile. A typical example is as follows: <<>>= #Deleting edges net[2,3]<-0 #This deletes the 2->3 #edge net[2,3]==0 #Should be TRUE delete.edges(net,get.edgeIDs(net,2,neighborhood="in")) #Remove all->2 net[,] @ Since it works by IDs, it should be noted that \code{delete.edges} can be used to selectively remove edges from multiplex networks. The operator-based approach automatically removes any edges connecting the selected pair, and is not recommended for use with multiplex networks. \subsection{Working with attributes} A major advantage of \code{network} objects over simple matrix or list based data representations is the ability to store meta-information regarding vertices, edges, or the network as a whole. For each such attribute type, \pkg{network} contains access functions to manage the creation, modification, and extraction of such information. Here, we briefly introduce the primary functions used for these tasks, by attribute type. \subsubsection{Network attributes} As indicated previously, network-level attributes are those attached to the \code{network} object as a whole. Such attributes are created via the \code{set.network.attribute} function, which takes as arguments the object to which the attribute should be attached, the name of the attribute, and the value of the attribute in question. Network attributes may contain arbitrary data, as they are stored internally via generalized vectors (\code{list}s). To streamline the creation of such attributes, the network attribute operator, \code{\%n\%}, has also been provided. Assignment using the operator is performed via the syntax \code{network \%n\% "attrname" <- value}, as in the second portion of the example below (which assigns the first seven lowercase letters to an attribute called ``hoo'' in \code{net}). <<>>= net <- network.initialize(5) set.network.attribute(net, "boo", 1:10) net %n% "hoo" <- letters[1:7] @ After network attributes have been created, they may be listed using the \break\code{list.network.attributes} command. Attribute extraction may then be performed by a call to \code{get.network.attribute}, or via the network attribute operator. In the latter case, a call of the form \code{network \%n\% "attrname"} returns the value of attribute ``attrname'' in the object ``network.'' In our current example, for instance, we have created the attributes ``boo'' and ``hoo,'' each of which may be accessed using either method: <<>>= #List attributes list.network.attributes(net) #Retrieve attributes get.network.attribute(net,"boo") net %n% "hoo" @ Finally, it is sometimes desirable to remove network attributes which have been created. This is accomplished using \code{delete.network.attributes}, which removes the indicated attribute from the network object (freeing the associated memory). One can verify that the attribute has been removed by checking the list of network attributes, e.g: <<>>= #Delete attributes delete.network.attribute(net,"boo") list.network.attributes(net) @ \subsubsection{Vertex attributes} Vertex attributes are manipulated in the same general manner as network attributes, with the caveat that each vertex can have its own attributes. There is no requirement that all vertices have the same attributes, or that all attributes of a given name contain the same data type; however, not all extraction methods work well in the latter case. Complete functionality for arbitrary vertex creation, listing, retrieval, and deletion is provided by the \code{set.vertex.attribute}, \code{list.vertex.attributes}, \code{get.vertex.attribute}, and \break\code{delete.vertex.attribute} methods (respectively). These allow attribute data to be passed in list form (permitting arbitrary contents) and to be assigned to specific vertices. While the generality of these functions is helpful, they are cumbersome to use for simple tasks such as assigning scalar or character values to each vertex (or retrieving the same). To facilitate such routine tasks, \pkg{network} provides a vertex attribute operator, \code{\%v\%}. The operator may be used either for extraction or assignment, treating the right-hand value as a vector of attribute values (with the $i$th element corresponding to the $i$th vertex). By passing a \code{list} with a \code{list} for each element, one may assign arbitrary vertex values in this manner; however, the vertex operator will vectorize these values upon retrieval (and hence one must use \code{get.vertex.attribute} with \code{unlist = FALSE} to recover the full list structure). If a requested attribute is unavailable for a particular vertex, an \code{NA} is returned. Typical use of the vertex attribute methods is illustrated via the following example. Note that more complex usage is also possible, as detailed in the package manual. <<>>= #Add vertex attributes set.vertex.attribute(net,"boo",1:5) #Create a numeric attribute net %v% "hoo" <- letters[1:5] #Now, a character attribute #Listing attributes list.vertex.attributes(net) #List all vertex attributes #Retrieving attributes get.vertex.attribute(net,"boo") #Retrieve 'em net %v% "hoo" #Deleting attributes delete.vertex.attribute(net,"boo") #Remove one list.vertex.attributes(net) #Check to see that it's gone @ \subsubsection{Edge attributes} Finally, we come to edge attributes. The operations involved here are much like those for the network and vertex cases. List, set, get, and delete methods exist for edge attributes (\code{list.edge.attributes}, \code{set.edge.attribute}, \code{get.edge.attribute}, and \break\code{delete.edge.attribute}), as does an edge attribute operator (\code{\%e\%}). Operations with edges are rendered somewhat more complex, however, because of the need to employ edge IDs in referencing the edges themselves. These can be obtained via the \code{get.edgeIDs} function (as described above), but this adds complexity which is unnecessary in the case of simple attribute assignment on non-multiplex, dyadic graphs (where edges are uniquely identifiable by a pair of endpoints). For such cases, the convenience function \code{set.edge.value} allows edge values to be specified in adjacency matrix form. Also useful is the bracket operator, which can be used to assign values as well as to create edges. For network \code{net}, \code{net[sel, names.eval = "attrname"] <- value} will set the attribute named by ``attrname'' on the edges selected by \code{sel} (which follows standard \proglang{R} syntax for selection of cells from square matrices) to the values in \code{value}. By default, values for non-existent edges are ignored (although new edges can be created by adding \code{add.edges = TRUE} to the included arguments). Reasonable behavior for non-scalar values using this method is not guaranteed. In addition to the above, methods such as \code{as.sociomatrix} allow for edge attributes to be employed in some settings. These provide a more convenient (if less flexible) interface for the common case of scalar attributes on the edges of non-multiplex, dyadic networks. The following is a typical example of these routines in action, although much more exotic scenarios are certainly possible. <<>>= #Create a network with some edges net <- network(nmat) #Add attributes set.edge.attribute(net,"boo",sum(nmat):1) set.edge.value(net,"hoo",matrix(1:25,5,5)) #Note: only sets for extant edges! net %e% "woo" <- matrix(rnorm(25),5,5) #Ditto net[,,names.eval="zoo"] <- nmat*6 #Ditto if add.edges!=TRUE #List attributes list.edge.attributes(net) #Retrieving attributes get.edge.attribute(get.edges(net,1),"boo") #Get the attribute for 1's out-edges get.edge.value(net,"hoo") net %e% "woo" as.sociomatrix(net,"zoo") #Deleting attributes delete.edge.attribute(net,"boo") list.edge.attributes(net) @ As this example illustrates, edge attributes are only set for actually existing edges (although the optional \code{add.edges} argument to the network assignment operator can be used to force addition of edges with non-zero attribute values). Also illustrated is the difference between attribute setting using \code{set.edge.attribute} (which is edge ID based) and function such as the assignment operator. The relative ease of the latter recommends itself for everyday use, although more complex settings may call for the former approach. \subsubsection{From attributes to networks} In addition to simply storing covariate information, it should be noted that one can actively use attributes to construct new networks. For instance, consider the \code{emon} data set used above. Among other variables, each vertex carries an attribute called \code{"Location"} which contains information on whether the corresponding organization had headquarters or command post installations which were local, non-local, or both with respect to the operation from which the network was drawn. We may thus use this information to construct a very simple hypergraph, in which locations constitute edges and edge membership is defined as having an installation at the respective location. For the Mt.\ St.\ Helens network, such a network may be constructed as follows. First, we extract the location information from the relevant network object, and use this to build an incidence matrix based on location. Then we convert this incidence matrix to a hypergraphic network object (setting vertex names from the original network object for convenience). <<>>= #Extract location information MtSHloc<-emon$MtStHelens%v%"Location" #Build an incidence matrix based on Local/Non-local/Both placement MtSHimat<-cbind(MtSHloc%in%c("L","B"),MtSHloc%in%c("NL","B")) #Convert incidence matrix to a hypergraph MtSHbyloc<-network(MtSHimat,matrix="incidence",hyper=TRUE,directed=FALSE, loops=TRUE) #Set vertex names, for convenience MtSHbyloc%v%"vertex.names"<-emon$MtStHelens%v%"vertex.names" #Examine the result MtSHbyloc @ Obviously, the simple location coding used here cannot lead to a very complex structure. Nevertheless, this case serves to illustrate the flexibility of the \pkg{network} tools in allowing attribute information to be used in creative ways. In addition to constructing networks from attributes, one can use attributes to store networks \citep[useful for joint representation of cognitive and behavioral structures such as those of][]{krackhardt:sn:1988,killworth.bernard:ho:1976}, edge timing information (for dynamic structures, as in the package \pkg{networkDynamic} \citep{networkDynamic}), etc. Appropriate use of network, edge, and vertex attributes allows a wide range of complex relational data structures to be supported without the need for a cumbersome array of of custom data classes. \subsection[Visualizing network objects]{Visualizing \code{network} objects} In addition to manipulating \code{network} objects, the \pkg{network} package provides built-in support for network visualization. This capability is supplied by the package \code{plot} method (ported from \pkg{sna}'s \code{gplot}), which is dispatched transparently when \code{plot} is called with a \code{network} object. The plot method supports a range of layout and display options, which are specified through additional arguments. For instance, to visualize the Florentine marriage data we might use commands such as the following: <<>>= plot(nflo, displaylabels = TRUE, boxed.labels = FALSE) plot(nflo, displaylabels = TRUE, mode = "circle") @ Typical results of these commands are shown in Figure~\ref{f_nflo_layout}. Note that the plot method automatically determines whether the network being visualized is directed, and adds or suppresses arrowheads accordingly. For instance, compare the above with the Mt.\ Si communication network (Figure~\ref{f_mtsi}): \begin{figure} \begin{center} %\rotatebox{270}{\resizebox{3in}{6in}{\includegraphics{nflo.layouts.ps}}} %\rotatebox{270}{\resizebox{3in}{6in}{\includegraphics{Figures/nflo_layouts.pdf}}} <>= op<-par(no.readonly=TRUE) # cache the plot params par(mfcol=c(1,2),mar=c(1,1,1,1),cex=0.5) # adjust margins and text size to fit two panels plot(nflo, displaylabels = TRUE,boxed.labels = TRUE) plot(nflo, displaylabels = TRUE, mode = "circle") par(op) # reset the plot params @ \caption{\label{f_nflo_layout} Sample displays of the Florentine marriage data; the left panel depicts the default Fruchterman-Reingold layout, while the right panel depicts a circular layout.} \end{center} \end{figure} <<>>= plot(emon$MtSi) @ \begin{figure} \begin{center} %\rotatebox{270}{\resizebox{4in}{4in}{\includegraphics{mtsi.layout.ps}}} %\rotatebox{0}{\resizebox{4in}{4in}{\includegraphics{Figures/mtsi_layout.pdf}}} <>= plot(emon$MtSi) @ \caption{\label{f_mtsi} Sample display of the Mt.\ Si EMON data, using the default Fruchterman-Reingold layout.} \end{center} \end{figure} The default layout algorithm for the plot method is that of \citet{fruchterman.reingold:spae:1991}, a force-directed display with good overall performance. Other layout methods are available \citep[including the well-known energy-minimization algorithm of][]{kamada.kawai:ipl:1989}, and support is included for user-added functions. To create a custom layout method, one need only create a function with the prefix \code{network.layout} which supplies the appropriate formal arguments (see the \pkg{network} manual for details). The \code{plot} method can then be directed to utilize the custom layout function, as in this simple example (shown in Figure~\ref{f_mtsthelens_custom}): <<>>= library(sna) network.layout.degree <- function(d, layout.par){ id <- degree(d, cmode = "indegree") od <- degree(d, cmode = "outdegree") cbind(id, od) } plot(emon$MtStHelens, mode = "degree", displaylabels = TRUE, boxed.labels = FALSE, suppress.axes = FALSE, label.cex = 0.5, xlab = "Indegree", ylab = "Outdegree", label.col = 3) @ \begin{figure} \begin{center} %\rotatebox{270}{\resizebox{6in}{6in}{\includegraphics{mtsthelens.custom.layout.ps}}} %\rotatebox{270}{\resizebox{6in}{6in}{\includegraphics{Figures/mtsthelens_custom_layout.pdf}}} <>= plot(emon$MtStHelens, mode = "degree", displaylabels = TRUE, boxed.labels = FALSE, suppress.axes = FALSE, label.cex = 0.5, xlab = "Indegree", ylab = "Outdegree", label.col = 3) @ \caption{\label{f_mtsthelens_custom} Sample display of the Mt.\ St.\ Helens EMON data, using a custom indegree/outdegree layout.} \end{center} \end{figure} As this example illustrates, most properties of the visualization can be adjusted where necessary. This is especially helpful when visualizing structures such as hypergraphs: <<>>= plot(MtSHbyloc, displaylabels = TRUE, label = c(network.vertex.names(MtSHbyloc), "Local", "Non-Local"), boxed.labels = FALSE, label.cex = rep(c(0.5, 1), times = c(27, 2)), label.col = rep(c(3, 4), times = c(27, 2)), vertex.col = rep(c(2, 5), times = c(27, 2))) @ Note that the \code{plot} method automatically recognizes that the network being passed is hypergraphic, an employs a two-mode representation for visualization purposes (see Figure~\ref{f_mtsthelens_twomode}). Supplying custom labeling and vertex coloring helps clarify the interpretation. For instance, here we can immediately see the division between organizations who maintained headquarters exclusively at local or remote locations during the Mount St. Helens search and rescue operation, as well as those organizations (e.g. the Salvation Army and Red Cross) which bridged the two. Though simple, examples such as this demonstrate how the default \emph{plot} settings can be adjusted to produce effective visualizations of even complex relational data. \begin{figure} \begin{center} %\rotatebox{270}{\resizebox{4.5in}{6in}{\includegraphics{mtsthelens.twomode.ps}}} %\rotatebox{270}{\resizebox{4.5in}{6in}{\includegraphics{Figures/mtsthelens_twomode.pdf}}} <>= plot(MtSHbyloc, displaylabels = TRUE, label = c(network.vertex.names(MtSHbyloc), "Local", "Non-Local"), boxed.labels = FALSE, label.cex = rep(c(0.5, 1), times = c(27, 2)), label.col = rep(c(3, 4), times = c(27, 2)), vertex.col = rep(c(2, 5), times = c(27, 2))) @ \caption{\label{f_mtsthelens_twomode} Sample display of the Mt.\ St.\ Helens location hypergraph, showing division between locally, non-locally, and dual headquartered organizations.} \end{center} \end{figure} \section[C-language API]{\proglang{C}-language API} While the functionality described thus far has been aimed at users working within an interpreted \proglang{R} environment, many \pkg{network} package features can also be accessed through a \proglang{C}-language application programming interface (API). Although this API still makes use of \proglang{R} data structures, it provides mechanisms for direct manipulation of those structures via compiled code. While invisible to most end users, the API has a number of attractions for developers. Chief among these is performance: in the author's experience, a reasonably well-designed \proglang{C} function can run as much as one to two orders of magnitude faster than an equivalent \proglang{R} implementation. For many day-to-day applications, such gains are unlikely to be worth the considerable increase in implementation and maintenance costs associated with choosing \proglang{C} over \proglang{R}; however, they may prove vital when performing computationally demanding tasks such as Markov chain Monte Carlo simulation, large-graph computations, and small-N solutions for non-polynomial time problems (e.g., cycle counting). Another useful feature of the \proglang{C} API is its ability to make the complex data storage capabilities of \code{network} objects accessible to developers whose projects involve existing backend code, or developing packages such as \pkg{networkDynamic} which extend \pkg{network}'s functionality at the \proglang{C} level. Instead of performing data extraction on a \code{network} object and passing the result to the compiled routine, the \pkg{network} API allows for such routines to work with such objects directly. Finally, a third useful asset of the \pkg{network} API is the capacity it provides for generating user-transparent functionality which transcends what is feasible with \proglang{R}'s pass-by-value semantics. The use of compiled code to directly modify objects without copying has been fundamental to the functionality of the package since version 1.0, as can be gleaned from an examination of the package source code\footnote{The pass-by-value semantics are somewhat contrary to R's design philosophy and have been somewhat blocked in recent R versions. While the pass-by-value semantics functionality described is still operational, it must be implemented in less than optimal ways and my not offer the original speed gains.}. The mechanism by which the API is currently implemented is fairly simple. A shared header file (which must be included in the user's application) defines a series of macros which point to the package's internal routines. During program execution, a global registration function is used to map these macros to their internal symbols; following this, the macros may be called normally. Other then ensuring that the \pkg{network} library is loaded prior to invoking the registration function, no other measures are necessary. In particular, the calling routine does not have to be linked against the \pkg{network} library, although the aforementioned header/registration routines must be included at compile time.\footnote{Required files for the \pkg{network} API are available from \url{http://www.statnetproject.org/}.} In addition, \pkg{network} versions 1.11.1 and higher implement \proglang{R}'s template for registering native \proglang{C} routines \footnote{See the `Registering-native-routines' section of \url{http://cran.r-project.org/doc/manuals/r-release/R-exts.html }} so that packages may compile against \pkg{network}'s code by declaring a \code{LinkingTo: network} in the DESCRIPTION file. The listing of exported functions are in the file \code{src/Rinit.c}. \subsection[Using the network API]{Using the \pkg{network} API} To use the \pkg{network} API within one's own code, the following steps are necessary: \begin{enumerate} \item The required \pkg{network} header and function registration files must be added to the developer's source tree. \item The \pkg{network} header file must be included during compilation. \item The \code{netRegisterFunctions} function must be invoked at the entry point to any \proglang{C} program using the API. \item The \pkg{network} API functions must be used as required. \end{enumerate} The command \code{netRegisterFunctions} takes and returns no arguments, being invoked solely for its side effect. Although it must be called at each entry to the \proglang{C} backend (i.e., each invocation of \code{.Call} or \code{.External} from \proglang{R}), its effects persist until the calling routine exits. The API is designed for use with the \code{.Call} interface, although wrappers for conversion to \code{.External} are in principle possible. Object references are maintained through \code{SEXP} pointers, as is standard for \proglang{R}'s \proglang{C} language interface. Because references (rather than copies of the objects themselves) are passed to \proglang{C} via the interface, \proglang{C} routines may directly alter the objects with which they are called. \pkg{network} has many routines for creating and modifying \code{networks}, as well as for accessing object contents within compiled code. To illustrate the use of the network API in practical settings, we here provide a walk-through for a relatively simple (but non-trivial) example. Consider a \proglang{C} function which generates an undirected network from a homogeneous Bernoulli graph distribution, tagging each edge with random ``onset'' and ``termination'' times based on a piecewise-exponential process with fixed onset/termination hazards. Such a function might also keep track of the first and last edge times for each vertex (and for the network as a whole), storing these within the network object via appropriately named attributes. To implement our sample function, we begin with the standard header for a \code{.Call} function, which both takes and receives arguments of type \code{SEXP} (S-expression pointers). In this case, the parameters to be passed consist of an initialized \code{network} object, the probability of an edge between any two vertices, and the hazards for edge onset and termination (respectively). Note that we do not need to tell the function about properties such as network size, since it can determine these itself using the API's interface methods. \begin{Code} SEXP rnbernexp_R(SEXP g, SEXP ep, SEXP oh, SEXP th) /* C-Language code for a simple random dynamic network generator. Arguments are as follows: g - a pre-initialized network object ep - the edge probability parameter oh - the edge onset hazard parameter th - the edge termination hazard parameter */ { int n, i, w; double u, fet, let, *vfet, *vlet, ot, tt; SEXP tail, head, atl, atlnam, sot, stt, ec; /*Verify that we were called properly, and set things up*/ netRegisterFunctions(); if(!netIsNetwork(g)) error("rnbernexp_R must be called with a network object.\n"); if(netIsDir(g)) error("Network passed to rnbernexp_R should be undirected.\n"); n = netNetSize(g); PROTECT(ep = coerceVector(ep, REALSXP)); PROTECT(oh = coerceVector(oh, REALSXP)); PROTECT(th = coerceVector(th, REALSXP)); PROTECT(ec = allocVector(LGLSXP, 1)); LOGICAL(ec)[0] = 0; GetRNGstate(); /*Allocate memory for first/last edge time trackers*/ vfet = (double *)R_alloc(n, sizeof(double)); vlet = (double *)R_alloc(n, sizeof(double)); for(i = 0; i < n; i++) vfet[i] = vlet[i] = NA_REAL; fet = let = NA_REAL; \end{Code} In order to assure that all arguments are of the appropriate type, we employ a combination of verification and coercion. After registering the \pkg{network} API functions using \code{netRegisterFunctions}, we use the indicators \code{netIsNetwork} and \code{netIsDir} to verify that the \code{g} argument is indeed a \code{network} object, and that it is undirected. After verifying these conditions, we can use \code{netNetSize} to obtain the number of vertices in the network. This quantity is saved for further use. With the preliminaries out of the way, we are now in a position to draw edges. The algorithm used to generate the underlying graph is that of \cite{batagelj.brandes:pre:2005}, which scales well for sparse graphs (complexity is $\mathcal{O}(n+m)$). Edges themselves are added via the \code{netAddEdge} API function, which is analogous to \code{add.edge} in the \proglang{R} interface. Because we are operating directly on the network object, we must handle memory allocation ourselves: the \code{allocVector} calls in the following section are used to allocate memory for the head, tail, and attribute lists, and for the vector of attribute names. These are set accordingly, with the ``OnsetTime'' and ``TerminationTime'' attributes being created to store edge onsets and terminations, respectively. Once the edge elements are created, \code{netAddEdge} assures that they are placed within the \code{network} object; since \proglang{R}'s garbage collection mechanism protects these elements once they are linked to \code{g} (which is a protected object), we can subsequently remove them from the memory protection stack using \code{UNPROTECT}. \begin{Code} /*Draw the network information*/ w = -1; i = 1; while(i < n){ u = runif(0.0, 1.0); w += 1+ (int)floor(log(1.0 - u) / log(1.0 - REAL(ep)[0])); while((w >= i) && (i < n)){ w -= i; i++; } if(i < n){ /*Generate an edge*/ /*Draw and track timing information*/ ot = rexp(REAL(oh)[0]); tt = ot + rexp(REAL(th)[0]); fet = ((ISNA(fet)) || (ot < fet)) ? ot : fet; let = ((ISNA(let)) || (tt > let)) ? tt : let; vfet[i] = ((ISNA(vfet[i])) || (ot < vfet[i])) ? ot : vfet[i]; vlet[i] = ((ISNA(vlet[i])) || (tt > vlet[i])) ? tt : vlet[i]; /*Allocate memory for the new edge*/ PROTECT(tail = allocVector(INTSXP, 1)); /*Allocate head/tail*/ PROTECT(head = allocVector(INTSXP, 1)); INTEGER(tail)[0] = i + 1; INTEGER(head)[0] = w + 1; PROTECT(atl = allocVector(VECSXP, 2)); /*Allocate attributes*/ PROTECT(sot = allocVector(REALSXP, 1)); PROTECT(stt = allocVector(REALSXP, 1)); PROTECT(atlnam = allocVector(STRSXP, 2)); SET_STRING_ELT(atlnam, 0, mkChar("OnsetTime")); SET_STRING_ELT(atlnam, 1, mkChar("TerminationTime")); REAL(sot)[0] = ot; REAL(stt)[0] = tt; SET_VECTOR_ELT(atl, 0, sot); SET_VECTOR_ELT(atl, 1, stt); g = netAddEdge(g, tail, head, atlnam, atl, ec); /*Add the edge*/ UNPROTECT(6); } } \end{Code} At this point, all edges have been placed within the network. While we could stop here, it seems useful to first tabulate some basic meta-data regarding the network being produced. In particular, a function to analyze a network of this type would doubtless need to know the total time interval over which each vertex (and the network as a whole) is active. Via the \pkg{network} API, we can easily store this information in \code{g}'s network and vertex attribute lists before returning. To do this, we employ \code{netSetVertexAttrib} and \code{netSetNetAttrib}, API functions which are analogous to \code{set.vertex.attribute} and \code{set.network.attribute}. As with the case of edge addition, we must allocate memory for the attribute entry prior to installing it -- the \code{netSet*} routines pass references to their arguments, rather than copying them -- but these functions do handle the creation of attribute names from raw strings. After writing our metadata into the graph, we clear the protection stack and return the \proglang{R} object pointer. \begin{Code} /*Add network and vertex attributes*/ for(i = 0; i < n; i++){ PROTECT(sot = allocVector(REALSXP, 1)); PROTECT(stt = allocVector(REALSXP, 1)); REAL(sot)[0] = vfet[i]; REAL(stt)[0] = vlet[i]; g = netSetVertexAttrib(g, "FirstOnsetTime", sot, i + 1); g = netSetVertexAttrib(g, "LastTerminationTime", stt, i + 1); UNPROTECT(2); } PROTECT(sot = allocVector(REALSXP, 1)); PROTECT(stt = allocVector(REALSXP, 1)); REAL(sot)[0] = fet; REAL(stt)[0] = let; g = netSetNetAttrib(g, "FirstOnsetTime", sot); g = netSetNetAttrib(g, "LastTerminationTime", stt); /*Clear protection stack and return*/ PutRNGstate(); UNPROTECT(6); return g; } \end{Code} To use the \code{rnbernexp_R} function, it must be invoked from \proglang{R} using the \code{.Call} interface. A simple wrapper function (whose behavior is similar to \proglang{R}'s built-in random number generation routines) might look like the following: <<>>= rnbernexp <- function(n, nv, p = 0.5, onset.hazard = 1, termination.hazard = 1){ nets <- list() for(i in 1:n) nets[[i]] <- .Call("rnbernexp_R", network.initialize(nv, directed = FALSE), p, onset.hazard, termination.hazard, PACKAGE = "networkapi.example") if(i > 1) nets else nets[[1]] } @ In actual use, the \code{PACKAGE} setting would be changed to the name of the shared object file in which the \code{rnbernexp_R} symbol resides. (This file would need to be linked against the \code{networkapi} file, and dynamically loaded after \pkg{network} is in memory. Linking against the entire \pkg{network} library is not required, however.) Although the specific distribution simulated is too simplistic to serve as a very good model of social dynamics, it nevertheless illustrates how the \pkg{network} API can be used to efficiently simulate and store the results of non-trivial processes within compiled code. \section{Final comments} For several decades, tools for social network analysis were essentially isolated from those supporting conventional statistical analyses. A major reason for this isolation was the difficulty in manipulating -- or even representing -- relational data within standard statistical packages. In recent years, the emergence of flexible statistical computing environments such as \proglang{R} have helped to change this situation. Platforms like \proglang{R} allow for the creation of the complex data structures needed to represent rich relational data, while also facilitating the development of tools to make such structures accessible to the end user. The \pkg{network} package represents one attempt to leverage these capabilities in order to create a low-level infrastructure for the analysis of relational data. Together with packages like \pkg{sna}, \pkg{ergm}, and the rest of the \pkg{statnet} suite, it is hoped that \pkg{network} will provide a useful resource for scientists both inside and outside of the social network community. \section*{Acknowledgments} The author gratefully acknowledges the input of present and past \pkg{statnet} collaborators, including Mark Handcock, David Hunter, Daniel Westreich, Martina Morris, Steve Goodreau, Pavel Krivitsky, and Krista Gile. This paper is based upon work supported by National Institutes of Health award 5 R01 DA012831-05, subaward 918197, and by NSF award IIS-0331707. \begin{thebibliography}{} \bibitem[Batagelj \& Brandes(2005)]{batagelj.brandes:pre:2005} Batagelj V, Brandes U (2005). ``Efficient Generation of Large Random Networks.'' \emph{Physical Review E}, 71(3), 036113, 1-5. doi:10.1103/PhysRevE.71.036113. \bibitem[Batagelj(2007)]{pajek} Batagelj V, Mrvar A (2007). \emph{Pajek: Package for Large Network Analysis.} University of Ljubljana, Slovenia. URL \url{http://vlado.fmf.uni-lj.si/pub/networks/pajek/}. \bibitem[Butts(2002)]{butts:tr:2002} Butts CT (2002). ``Memory Structures for Relational Data in R: Classes and Interfaces.'' \emph{Unpublished manuscript}, University of California, Irvine. \bibitem[Butts(2007)]{sna} Butts CT (2007). \emph{sna: Tools for Social Network Analysis}. Statnet Project \url{http://statnetproject.org/}, Seattle, WA. R package version 1.5, URL \url{http://CRAN.R-project.org/package=sna}. \bibitem[Butts \& Carley(2005)]{butts.carley:cmot:2005} Butts CT, Carley KM (2005). ``Some Simple Algorithms for Structural Comparison.' \emph{Computational and Mathematical Organization Theory}, 11(4), 291-305. \bibitem[Butts, et al.(2007)]{network} Butts CT, Handcock MS, Hunter DR (2007). \emph{network: Classes for Relational Data}. Statnet Project \url{http://statnetproject.org/}, Seattle, WA. R package version 1.3, URL \url{http://CRAN.R-project.org/package=network}. \bibitem[Butts, et all.(2014)]{networkDynamic} Butts CT, Leslie-Cook A, Krivitsky P and Bender-deMoll S (2014). \emph{networkDynamic: Dynamic Extensions for Network Objects.} R package version 0.6.3. http://statnet.org URL \url{http://CRAN.R-project.org/package=networkDynamic} \bibitem[Carey, et al.(2007)]{carey.et.al:sw:2007} Carey VJ, Long L, Gentleman R (2007). \emph{RBGL: R Interface to Boost C++ Graph Library}. R package version 1.14.0, URL \url{http://www.bioconductor.org/}. \bibitem[Chambers(1998)]{chambers:bk:1998} Chambers JM (1998). \emph{Programming with Data}. Springer-Verlag, New York. ISBN 0-387- 98503-4. \bibitem[Csardi \& Nepusz(2006)]{gabor:sw:2007} Csardi G, Nepusz T (2006). ``The igraph Software Package for Complex Network Re- search.'' \emph{InterJournal, Complex Systems}, 1695. URL \url{http://www.interjournal.org/manuscript_abstract.php?361100992.} \bibitem[Doreian, et al.(2005)]{doreian.et.al:bk:2005} Doreian P, Batagelj V, Ferlioj A (2005). \emph{Generalized Blockmodeling}. Cambridge University Press, Cambridge. \bibitem[Drabek, et al.(1981)]{drabek.et.al:bk:1981} Drabek TE, Tamminga HL, Kilijanek TS, Adams CR (1981). \emph{Managing Multiorganizational Emergency Responses: Emergent Search and Rescue Networks in Natural Disaster and Remote Area Settings}. Number Monograph 33 in Program on Technology, Environment, and Man. Institute of Behavioral Sciences, University of Colorado, Boulder, CO. \bibitem[Fruchterman \& Reingold(1991)]{fruchterman.reingold:spae:1991} Fruchterman TMJ, Reingold EM (1991). ``Graph Drawing by Force-directed Placement.' \emph{Software -- Practice and Experience}, 21(11), 1129-1164. \bibitem[Gentleman, et al.(2007)]{gentleman.et.al:sw:2007} Gentleman R, Whalen E, Huber W, Falcon S (2007). \emph{graph: A Package to Handle Graph Data Structures}. R package version 1.14.2, URL \url{http://CRAN.R-project.org/package=graph.} \bibitem[Gentry, et al.(2007)]{gentry.et.al:sw:2007} Gentry J, Long L, Gentleman R, Falcon S (2007). \emph{Rgraphviz: Plotting Capabilities for R Graph Objects}. R package version 1.16.0, URL \url{http://CRAN.R-project.org/package=Rgraphviz}. \bibitem[Handcock, et al.(2003)]{statnet} Handcock MS, Hunter DR, Butts CT, Goodreau SM, Morris M (2003). \emph{statnet: Software Tools for the Statistical Modeling of Network Data}. Statnet Project \url{http://statnetproject.org/}, Seattle, WA. R package version 2.0, URL \url{http://CRAN. R-project.org/package=statnet}. \bibitem[Kamada\& Kawai(1989)]{kamada.kawai:ipl:1989} Kamada T, Kawai S (1989). ``An Algorithm for Drawing General Undirected Graphs.'' \emph{Information Processing Letters}, 31(1), 7-15. \bibitem[Killworth \& Bernard(1976)]{killworth.bernard:ho:1976} Killworth PD, Bernard HR (1976). ``Informant Accuracy in Social Network Data.'' \emph{Human Organization}, 35(8), 269-286. \bibitem[Koenker \& Ng(2007)]{koenker.ng:sw:2007} Koenker R, Ng P (2007). \emph{SparseM: Sparse Linear Algebra}. R package version 0.73, URL \url{http://CRAN.R-project.org/package=SparseM}. \bibitem[Krackhardt(1988)]{krackhardt:sn:1988} Krackhardt D (1988). ``Predicting with Networks: Nonparametric Multiple Regression Anal- yses of Dyadic Data.'' \emph{Social Networks}, 10, 359-382. \bibitem[Mayhew \& Levinger(1976)]{mayhew.levinger:ajs:1976} Mayhew BH, Levinger RL (1976). ``Size and Density of Interaction in Human Aggregates.'' \emph{American Journal of Sociology}, 82, 86-110. \bibitem[R Development Core Team(2007)]{R} R Development Core Team (2007). \emph{R: A Language and Environment for Statistical Computing}. R Foundation for Statistical Computing, Vienna, Austria. ISBN 3-900051-07-0, Version 2.6.1, URL \url{http://www.R-project.org/}. \bibitem[Venables \& Ripley(2000)]{venables.ripley:bk:2000} Venables WN, Ripley BD (2000). \emph{S Programming}. Springer-Verlag, New York. ISBN 0-387-98966-8. \bibitem[Venables \& Ripley(2002)]{venables.ripley:bk:2002} Venables WN, Ripley BD (2002). \emph{Modern Applied Statistics with S}. Springer-Verlag, New York, fourth edition. ISBN 0-387-95457-0. \bibitem[Wasserman \& Faust(1994)]{wass:faus1994} Wasserman SS, Faust K (1994). \emph{Social Network Analysis: Methods and Applications}. Structural Analysis in the Social Sciences. Cambridge University Press, Cambridge. \end{thebibliography} \end{document} network/data/0000755000176200001440000000000013357022000012644 5ustar liggesusersnetwork/data/emon.RData0000644000176200001440000001601113357022000014516 0ustar liggesusersBZh91AY&SY( C14f0 @HAii%=Ԟwp#Tm(lw;̀P4:ǟ8>X24wɷphBMdzOSO =HSA@%444h&a @ iJjh44 2 P i4!)!H@DR&SLOT5'ꟊ{TfFmF4hyAz$&LSA<1&2CO)LzFP=@@2 I?FS 'i$&H jΪM(2cj,` 2b`ѧRhUE1e j6+X+qC5dثZv%暿@`ER\n-IPd4BHdRE5s40].bؽlR K(#ȋΕKN\10Iki4( |T3=ԃ}#TU_XZĜ=0$ (LT]< Fτ%,YPes(Vt?Ve09 ":LuVCBM63>N^R]n~cX;? SKjFזLT:;:x2pXjrZ'LgX,r1(\w \p9_(;<_ކ)Ի{{9V%^;#$!9|0'"/T0@\i ٹΆCϾ灵vGw2G2ӞQ\z^Ǵ%h}^O>H|qLnpn?oyoot'"Ai^{J(=;.VDHdI0X Zž2Zo6;vXqcddfUF!ZUV(T)TQɤp[i-ڋcxسzP4ii4 fQ-ݮT 92ĜRd@Ql)xI5e2mg9R9Z劢DLR2+R [V+om+J|ϧ8GbB[oЯ$>gZ ȕ+\!62_wG֩R|Q§)7P<&bZV{ïE4m0;%S1Z&x4]kp%N'906,մa>CjqYۭ:RiLA շv(}Ӓ4YJYCHXŽV^j !&]z [AQ+ֽ㱋q3gj]@ObJw]RСNK(P, I R@$@")BJ HwD!T[7>؊- *yxA{R-P BPJB((ҥR% #"DEW  C>@.a[6\]n*%n^ R-TjGub@P4A#-֔`/~y^E-m[.(@ D| @ႁS8P" `P"r`aP!!P6"x0{;xܾ׸t$dZ KY-*LӁl{h-fgB$V᠊-alf"vM%aL+ I,4XBF2Y T.RaǎFha Z*,/8=;@<ʽY Dg(el2,WA4TP*()Ud*αtfP'֊9D1&]Mef-) lKjCYP ZZD@Rn([Fs Ul۷yz>RnPM 2׿r8Xu^N9\dD~^Dj47J O.1=5nC bX@IcTaʂr$#]hh1'軽x匰NI,-Ĭ)D\d5hT |TP:>0yr2av+ t&*E^AD썀ATb#""(oz :M&\ ܊iLDQX(:B9 H'A@@Аmd#l( 77w @!(@G*>J*#I7@TTqHF-$G A - H#BP%RP!@%(҅Rҥ"!@ R(R%RЫQGUEDA4HcQEMw#UETT%-b"*K룗 AVA t tK@D%PQJD JPPAIDTDR@д% D2QPҍ ERT5TTHIB+MP4!2(P%M MŲ.Q72 Hfe{t\؋m3!MBnGZA"w;1DsaeR B `) *4"7{Q,hB<:9.mftJvDЙF.(eR1 c@(n"``ЉN(RlJ +D.AjaTvazB2Jl8&cÓ3pnhn=tp먇Mnܵ\7#3ّ 44m߆j67!A+Ftskl\Æ)jĚ96uQsVjyspTW̢Dpv;5 H@dQ-3.)"r{x띀PCmꦊ)P&fG=qJJ@e&Y?1>-AwoCQw਀%&PW(iPȥ\8"STS>$gۓڠ?hAh+NʼWK9tFGўf !JԶJXqXZXŐiHT+mQ /`.@s"= WHd9:Rr:B @iją`^kZ5&X% /Bma)h$Gh5EfZ o 'D3PSܮ1ܝE%Lx%fZ*e ! "dz󆣼ez9D7@EC!ߙJQ#텂Gnk(=TL *Ӫ}' n{ߤ `PP(N /hcz_ 2U bX| _o2xR :Mʪ@5?vf[ "I BFy;uy< xvF򦋥+ſ1^p~>A &vu@~DF~`UfBH +zR (w)OSp ߂N$=j;z:{.3E?7^]_7^Ĝ@$G P)ҭ6|]~<׹n_@=hOI|C R mFJO>f dr? _[x:. ߷ʚk߷܊}ސt1(Ga ҟBhX;PbߗD"DOvN!`P;Tɀp?ërExAvy׈B;K8C( %YPP()s\K :_A2!QU(T!1klKd  =TU:֢*Djc X7Kٮ B0Lqj pp ^W WVkm)Iðr/GF6iMh'&Gz\Ԅ/(rNo9ƣowCvn `CZ<ޡ/~8g>T<]KuTXݻqp!Fp[22RycP:`_&'o0 @r `GLlr(KQ,qy80 c[/9/wi^o6mD6xzE@NLͥ`I=@c P4w׌FP |_ǩci˹|2* CA>o'8(astCl<@`iԹBUpBR%7hCx8 ,@ eAAҨ6S{nȬ]4ST 0|ֆ9 BӧǎO::Ba stէE|+}:tre UVv!\ Cx(l @cjb5!ֺ(+nʓi| :-z7@E3ʋuD/Rip  w>p!-Ar ϯ ӏǾeJ""aPV A1^&jTB(iR#y%(G yǠή>!= 4#kX#"cоD0*X"׶hۋ :5i VLǒ8dzEeO:ʖƼYUOXc y'H莗`4m'7 I)0NY;hdwUœYTnokeU| LG{£s.[y5;] hX- Tˤ[xg6f)2Cƶn;i*{BPEbUGZ~U9.}thp =.nƛ)!m&kb֞CO,vJ +' ZOjPv%@U%<`5jV H@(@r$&d+x[<;p_.:c; xݚx;^),IM@ ;V2Z(&B =aH network/data/flo.RData0000644000176200001440000000051013357022000014335 0ustar liggesusers7zXZi"6!X  ])TW"nRʟXN7#&'ƯNJaad 7YU5z_^,+V:x<:Yunsvؿ͍CT]ՠX]$D>/EdǼbq6{5H6##^)*s.;Q'haj繏>Oho8/I/ 7jEZ3u5.͎@&@3>nΜaY\^5Ui"2%)fYOܗ,@>0 YZnetwork/src/0000755000176200001440000000000014725415437012546 5ustar liggesusersnetwork/src/utils.c0000644000176200001440000005711713650470733014061 0ustar liggesusers/* ###################################################################### # # utils.c # # Written by Carter T. Butts # Last Modified 03/04/19 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains basic utility routines. # ###################################################################### */ #include #include #include #include #include #include #include #include #include "utils.h" /*LIST ACCESS/MODIFICATION ROUTINES-----------------------------------------*/ SEXP deleteListElement(SEXP list, const char *str) /*Given a list and a character string, return a new list with the element whose name matches said string removed. If this is the only element of list, NULL is returned; if the element is not found, list is returned unmodified.*/ { int pc=0,i,flag; SEXP newlist, names, newnames; /*If this is obviously pointless, return the original pointer*/ if(length(list)==0) return list; /*Evidently, we should try searching for the element...*/ PROTECT(names=getAttrib(list, R_NamesSymbol)); pc++; PROTECT(newlist=allocVector(VECSXP,length(list)-1)); pc++; PROTECT(newnames=allocVector(STRSXP,length(list)-1)); pc++; flag=0; for(i=0;(i0){ switch(TYPEOF(list)){ case VECSXP: PROTECT(newlist = allocVector(VECSXP, length(list)+n)); pc++; PROTECT(newnames = allocVector(STRSXP, length(list)+n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case STRSXP: PROTECT(newlist = allocVector(STRSXP, length(list)+n)); pc++; PROTECT(newnames = allocVector(STRSXP, length(list)+n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case INTSXP: PROTECT(newlist = allocVector(INTSXP, length(list)+n)); pc++; PROTECT(newnames = allocVector(STRSXP, length(list)+n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case REALSXP: PROTECT(newlist = allocVector(REALSXP, length(list)+n)); pc++; PROTECT(newnames = allocVector(STRSXP, length(list)+n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case RAWSXP: PROTECT(newlist = allocVector(RAWSXP, length(list)+n)); pc++; PROTECT(newnames = allocVector(STRSXP, length(list)+n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case LGLSXP: PROTECT(newlist = allocVector(LGLSXP, length(list)+n)); pc++; PROTECT(newnames = allocVector(STRSXP, length(list)+n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; default: error("unimplemented type in enlargeList\n"); } UNPROTECT(pc); return newlist; }else{ return list; } } SEXP contractList(SEXP list, int n) /*Return a pointer to a contracted version of list, where only the first n items are selected. If n>=length(list), then list is returned.*/ { int i,pc=0; SEXP newlist=R_NilValue, names, newnames; /*Rprintf("\t\tcontractList entered, changing length from %d to %d\n",length(list),n);*/ if(ni) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case STRSXP: PROTECT(newlist = allocVector(STRSXP, n)); pc++; PROTECT(newnames = allocVector(STRSXP, n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case INTSXP: PROTECT(newlist = allocVector(INTSXP, n)); pc++; PROTECT(newnames = allocVector(STRSXP, n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case LGLSXP: PROTECT(newlist = allocVector(LGLSXP, n)); pc++; PROTECT(newnames = allocVector(STRSXP, n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case REALSXP: PROTECT(newlist = allocVector(REALSXP, n)); pc++; PROTECT(newnames = allocVector(STRSXP, n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; case RAWSXP: PROTECT(newlist = allocVector(RAWSXP, n)); pc++; PROTECT(newnames = allocVector(STRSXP, n)); pc++; names = getAttrib(list, R_NamesSymbol); for(i=0;ii) SET_STRING_ELT(newnames,i,STRING_ELT(names,i)); } if(length(names)>0) setAttrib(newlist,R_NamesSymbol,newnames); break; default: error("unimplemented type in contractList\n"); } UNPROTECT(pc); return newlist; }else{ return list; } } SEXP concatList(int nel, int names, ...) /*This is a highly experimental function to build a list object by concatenating the specified arguments. nel must give the number of list elements included, and names=1 iff names are supplied. In the latter case, these must be strings, and must be given as arguments in order following the list elements.*/ { int i,pc=0; SEXP list,lnam; va_list ap; error("concatList doesn't work yet! Sorry....\n"); /*Rprintf("\t\tEntered concatList w/%d arguments; names=%d\n",nel,names);*/ va_start(ap, names); /*Initialize the argument list*/ PROTECT(list = allocVector(VECSXP,nel)); pc++; /*Allocate list memory*/ for(i=0;i0)) Rprintf("\t\t\tFirst element of a=%d\n",INTEGER(a)[0]); if(IS_INTEGER(b)&&(length(b)>0)) Rprintf("\t\t\tFirst element of b=%d\n",INTEGER(b)[0]);*/ PROTECT(merged=vecAppend(a,b)); /*Rprintf("\t\tAppended list is length %d\n",length(merged)); if(IS_INTEGER(merged)&&(length(merged)>0)) Rprintf("\t\t\tFirst list element=%d\n",INTEGER(merged)[0]);*/ PROTECT(merged=vecUnique(merged)); UNPROTECT(2); return merged; } SEXP vecUnique(SEXP a) { int pc=0,*dup,dcount=0,i,j; SEXP newv=R_NilValue; /*Proceed by type*/ switch(TYPEOF(a)){ case INTSXP: /*Identify duplicates*/ dup=(int *)R_alloc(length(a),sizeof(int)); for(i=0;i # Last Modified 4/7/06 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains headers for constructors.c. # ###################################################################### */ #ifndef CONSTRUCTORS_H #define CONSTRUCTORS_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include #include /*INTERNAL ROUTINES---------------------------------------------------------*/ /*R-CALLABLE ROUTINES-------------------------------------------------------*/ SEXP copyEdges_R(SEXP x, SEXP y); SEXP copyNetwork_R(SEXP x); SEXP copyNetworkAttributes_R(SEXP x, SEXP y); SEXP copyVertexAttributes_R(SEXP x, SEXP y); #endif network/src/access.c0000644000176200001440000020060614724702426014153 0ustar liggesusers/* ###################################################################### # # access.c # # Written by Carter T. Butts # Last Modified 12/06/24 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains routines related to access methods for network # objects. # ###################################################################### */ #include #include #include #include #include #include #include #include "utils.h" #include "access.h" /*INTERNAL ROUTINES----------------------------------------------------*/ SEXP deleteEdgeAttribute(SEXP x, int e, const char *attrname) /*Deletes the attribute named by attrname from edge with ID e.*/ { int pc=0; SEXP edge,atl; edge=VECTOR_ELT(getListElement(x,"mel"),e-1); PROTECT(atl=deleteListElement(getListElement(edge,"atl"),attrname)); pc++; PROTECT(edge=setListElement(edge,"atl",atl)); pc++; UNPROTECT(pc); return x; } SEXP deleteNetworkAttribute(SEXP x, const char *attrname) /*Deletes the network attribute named by attrname.*/ { int pc=0; SEXP gal; PROTECT(gal=deleteListElement(getListElement(x,"gal"),attrname)); pc++; setListElement(x,"gal",gal); UNPROTECT(pc); return x; } SEXP deleteVertexAttribute(SEXP x, int v, const char *attrname) /*Deletes the attribute named by attrname from vertex with ID v.*/ { int pc=0; SEXP val,atts; val=getListElement(x,"val"); PROTECT(atts=deleteListElement(VECTOR_ELT(val,v-1),attrname)); pc++; SET_VECTOR_ELT(val,v-1,atts); UNPROTECT(pc); return x; } SEXP getEdgeAttribute(SEXP x, int e, const char *str) /*Returns a pointer to the attribute of edge e named by str, or else R_NilValue (if the edge and/or attribute is missing).*/ { SEXP el; /*Retrieve the edge, and sound a warning if not present.*/ el=VECTOR_ELT(getListElement(x,"mel"),e-1); if(el==R_NilValue){ warning("Attempt to get attribute %s for edge %e failed in getEdgeAttribute: no such edge.\n",str,(double)e); return R_NilValue; } return getListElement(getListElement(el,"atl"),str); } SEXP getEdgeIDs(SEXP x, int v, int alter, const char *neighborhood, int naOmit) /*Retrieve the IDs of all edges incident on v, in network x. Outgoing or incoming edges are specified by neighborhood, while na.omit indicates whether or not missing edges should be omitted. If alter>0, only edges whose alternate endpoints contain alter are returned. The return value is a vector of edge IDs.*/ { SEXP eids,newids,mel,ilist,olist,eplist; int i,j,k,pc=0,ecount,*keep,dir; /* set ilist and olist to null to avoid compiler uninitialization warning in the cases that they are needed, code will set them */ ilist=NULL; olist=NULL; /*Enforce "combined" behavior unless x is directed*/ dir=isDirected(x); /*Rprintf("getEdgeIDs: v=%d, a=%d, neighborhood=%s\n",v,alter,neighborhood);*/ /*Begin by getting all edge IDs for the neighborhood in question*/ if(dir&&(strcmp(neighborhood,"out")==0)){ PROTECT(eids=coerceVector(VECTOR_ELT(getListElement(x,"oel"),v-1),INTSXP)); pc++; }else if(dir&&(strcmp(neighborhood,"in")==0)){ PROTECT(eids=coerceVector(VECTOR_ELT(getListElement(x,"iel"),v-1),INTSXP)); pc++; }else{ PROTECT(ilist=coerceVector(VECTOR_ELT(getListElement(x,"oel"),v-1), INTSXP)); pc++; PROTECT(olist=coerceVector(VECTOR_ELT(getListElement(x,"iel"),v-1), INTSXP)); pc++; /*Rprintf("\tAbout to enter union with list lengths %d and %d\n", length(ilist),length(olist));*/ PROTECT(eids=vecUnion(ilist,olist)); pc++; /*Rprintf("\t\tEscaped vecUnion, new list is length %d\n",length(eids));*/ /* PROTECT(eids=vecUnion(coerceVector(VECTOR_ELT(getListElement(x,"oel"),v-1), INTSXP), coerceVector(VECTOR_ELT(getListElement(x,"iel"),v-1),INTSXP))); pc++;*/ } /*Rprintf("\tIdentified %d candidate edges\n",length(eids)); if(length(eids)>0) Rprintf("\t\tFirst edge is ID %d\n",INTEGER(eids)[0]);*/ /*Remove any edges not containing alter (if given) and/or missing (if naOmit is TRUE).*/ ecount=0; keep=(int *)R_alloc(length(eids),sizeof(int)); mel=getListElement(x,"mel"); for(i=0;i0){ /*Remove edges not containing alter?*/ /*Get the relevant endpoints of the edge in question*/ if(dir&&(strcmp(neighborhood,"out")==0)){ PROTECT(eplist=coerceVector(getListElement(VECTOR_ELT(mel, INTEGER(eids)[i]-1),"inl"),INTSXP)); pc++; }else if(dir&&(strcmp(neighborhood,"in")==0)){ PROTECT(eplist=coerceVector(getListElement(VECTOR_ELT(mel, INTEGER(eids)[i]-1),"outl"),INTSXP)); pc++; }else{ PROTECT(ilist=coerceVector(getListElement(VECTOR_ELT(mel, INTEGER(eids)[i]-1),"inl"),INTSXP)); pc++; PROTECT(olist=coerceVector(getListElement(VECTOR_ELT(mel, INTEGER(eids)[i]-1),"outl"),INTSXP)); pc++; PROTECT(eplist=vecAppend(ilist,olist)); pc++; } /*Check to see if any endpoint matches alter*/ /*Rprintf("\t\tchecking endpoints of EID %d\n",INTEGER(eids)[i]);*/ keep[i]=0; if (dir | (v!=alter)){ /* does this still work in hypergraphic case?*/ for(j=0;(j0) Rprintf("\t\tFirst ID is %d\n",INTEGER(newids)[0]);*/ /*Unprotect and return*/ UNPROTECT(pc); return newids; } SEXP getEdges(SEXP x, int v, int alter, const char *neighborhood, int naOmit) /*Retrieve all edges incident on v, in network x. Outgoing or incoming edges are specified by neighborhood, while na.omit indicates whether or not missing edges should be omitted. If alter>0, only edges whose alternate endpoints contain alter are returned. The return value is a list of edges.*/ { SEXP eids,el,mel,eplist,aptr,bptr; int i,j,pc=0,ecount,*keep,dir; /*If x is undirected, enforce "combined" behavior*/ dir=isDirected(x); /*Rprintf("getEdges: v=%d, a=%d, neighborhood=%s\n",v,alter,neighborhood);*/ /*Begin by getting all edge IDs for the neighborhood in question*/ if(dir&&(strcmp(neighborhood,"out")==0)){ PROTECT(eids=coerceVector(VECTOR_ELT(getListElement(x,"oel"),v-1),INTSXP)); pc++; }else if(dir&&(strcmp(neighborhood,"in")==0)){ PROTECT(eids=coerceVector(VECTOR_ELT(getListElement(x,"iel"),v-1),INTSXP)); pc++; }else{ PROTECT(aptr=coerceVector(VECTOR_ELT(getListElement(x,"oel"),v-1), INTSXP)); pc++; PROTECT(bptr=coerceVector(VECTOR_ELT(getListElement(x,"iel"),v-1),INTSXP)); pc++; PROTECT(eids=vecUnion(aptr,bptr)); pc++; } /*Extract the edges associated with the eid list, removing any edges not containing alter (if given) and/or missing (if naOmit is TRUE).*/ ecount=0; keep=(int *)R_alloc(length(eids),sizeof(int)); mel=getListElement(x,"mel"); for(i=0;i0){ /*Remove edges not containing alter?*/ /*Get the relevant endpoints of the edge in question*/ if(dir&&(strcmp(neighborhood,"out")==0)){ PROTECT(eplist=coerceVector(getListElement(VECTOR_ELT(mel, INTEGER(eids)[i]-1),"inl"),INTSXP)); pc++; }else if(dir&&(strcmp(neighborhood,"in")==0)){ PROTECT(eplist=coerceVector(getListElement(VECTOR_ELT(mel, INTEGER(eids)[i]-1),"outl"),INTSXP)); pc++; }else{ PROTECT(aptr=coerceVector(getListElement(VECTOR_ELT(mel, INTEGER(eids)[i]-1),"inl"),INTSXP)); pc++; PROTECT(bptr=coerceVector(getListElement(VECTOR_ELT(mel, INTEGER(eids)[i]-1),"outl"),INTSXP)); pc++; PROTECT(eplist=vecAppend(aptr,bptr)); pc++; } /*Check to see if any endpoint matches alter*/ keep[i]=0; for(j=0;(j0, missing edges are discarded; otherwise, they are employed as well.*/ { int pc=0,i,dir; SEXP el,eps,val=R_NilValue,z; PROTECT_INDEX idx; /*Check for directedness of x*/ dir=isDirected(x); /*Accumulate endpoints from the edge list*/ PROTECT_WITH_INDEX(eps=allocVector(INTSXP,0), &idx); pc++; if(dir&&(strcmp(type,"in")==0)){ /*In => get tail list*/ PROTECT(el = getEdges(x,v,0,"in",naOmit)); pc++; for(i=0;i get head list*/ PROTECT(el = getEdges(x,v,0,"out",naOmit)); pc++; for(i=0;i get both lists*/ if(!dir){ /*Annoying kludge to deal with getEdges loop issue, part 1*/ /*The issue here is that getEdges (reasonably?) enforces "combined" behavior for undirected graphs, returning any edge with v as an endpoint. This clashes with what we need to do here; as a workaround, we temporarily make x "directed" to change the behavior of getEdges (afterwards changing it back). This works fine, but involves two unneeded write operations for what should be a read-only function. As such, it should eventually be patched (probably by creating an option to force the behavior of getEdges).*/ PROTECT(val=allocVector(LGLSXP,1)); pc++; LOGICAL(val)[0]=1; setNetworkAttribute(x,"directed",val); /*Temporarily make directed*/ } PROTECT(el = getEdges(x,v,0,"in",naOmit)); pc++; for(i=0;i0, then missing edges are not counted; otherwise, all edges are included. (Note: this is the internal version.)*/ { int i,ecount=0,pc=0; SEXP mel,na; mel=getListElement(x,"mel"); if(naOmit){ /*Omit missing edges*/ for(i=0;i(double)networkSize(x)) ||(vecMax(outl)>(double)networkSize(x))) error("(edge check) Illegal vertex reference in addEdges_R. Exiting."); if(length(inl)*length(outl)==0) error("(edge check) Empty head/tail list in addEdges_R. Exiting."); if(echeck){ if(!isHyper(x)) if(MAX(length(inl),length(outl))>1) error("(edge check) Attempted to add hyperedge where hyper==FALSE in addEdges_R. Exiting."); if(!hasLoops(x)) if(isLoop(outl,inl)) error("(edge check) Attempted to add loop-like edge where loops==FALSE in addEdges_R. Exiting."); if((!isMultiplex(x))&&(length(getListElement(x,"mel"))>0)){ mel=getListElement(x,"mel"); if(isDirected(x)){ for(i=0;i0){ /*Deal with attribute names*/ /*Rprintf("\tDealting with atl names\n");*/ PROTECT(atlnam = coerceVector(VECTOR_ELT(namesEval,z),STRSXP)); pc++; /*Coerce to str*/ /*Rprintf("\t\tSurvived coerce -- now checking length\n");*/ if(length(atlnam)>length(atl)){ warning("Too many labels in addEdges: wanted %d, got %d. Truncating name list.\n",length(atl),length(atlnam)); PROTECT(atlnam = contractList(atlnam,length(atl))); pc++; }else if(length(atlnam)0){ PROTECT(elem = allocVector(INTSXP,length(ptr)+1)); pc++; // for(j=0;(j=INTEGER(outl)[0])) break; INTEGER(elem)[j]=INTEGER(ptr)[j]; } INTEGER(elem)[j++]=mnext; for(;(j-10){ PROTECT(elem = allocVector(INTSXP,length(ptr)+1)); pc++; // for(j=0;(j=INTEGER(inl)[0])) break; INTEGER(elem)[j]=INTEGER(ptr)[j]; } INTEGER(elem)[j++]=mnext; for(;(j-1opc){ UNPROTECT(pc-opc); pc=opc; } } } /*Rprintf("\tdone!\n");*/ /*Unprotect and return*/ UNPROTECT(pc); return x; } SEXP permuteVertexIDs(SEXP x, SEXP vids) { int i,j,k,pc=0,ccount=0,flag=0; char neigh[] = "combined"; SEXP eids,cvids,cpos,val,iel,oel,epl,mel,idlist,edge,z; PROTECT_INDEX ipx,ipx2,ipx3; /*Set up the initial variables*/ PROTECT(vids=coerceVector(vids,INTSXP)); pc++; PROTECT(cpos=allocVector(INTSXP,length(vids))); pc++; PROTECT(cvids=allocVector(INTSXP,length(vids))); pc++; PROTECT_WITH_INDEX(eids=allocVector(INTSXP,0),&ipx); pc++; PROTECT_WITH_INDEX(x,&ipx2); pc++; /*This shouldn't be needed, but rchk is conservative*/ /*Determine which vertices have moved, and accumulate affected edges*/ for(i=0;i(double)networkSize(x)) ||(vecMax(outl)>(double)networkSize(x))) error("(edge check) Illegal vertex reference in addEdge_R. Exiting."); if(length(inl)*length(outl)==0) error("(edge check) Empty head/tail list in addEdge_R. Exiting."); /*If necessary, verify that new edge satisfies existing graph requirements*/ PROTECT(edgeCheck = coerceVector(edgeCheck, LGLSXP)); pc++; if(length(edgeCheck)==0) echeck=0; else echeck=INTEGER(edgeCheck)[0]; if(echeck){ if(!isHyper(x)) if(MAX(length(inl),length(outl))>1) error("(edge check) Attempted to add hyperedge where hyper==FALSE in addEdge_R. Exiting."); if(!hasLoops(x)) if(isLoop(outl,inl)) error("(edge check) Attempted to add loop-like edge where loops==FALSE in addEdge_R. Exiting."); if((!isMultiplex(x))&&(length(getListElement(x,"mel"))>0)){ mel=getListElement(x,"mel"); if(isDirected(x)){ for(i=0;i0){ /*Deal with attribute names*/ /*Rprintf("\tDealting with atl names\n");*/ PROTECT(atlnam = coerceVector(namesEval,STRSXP)); pc++; /*Coerce to str*/ /*Rprintf("\t\tSurvived coerce -- now checking length\n");*/ if(length(atlnam)>length(atl)){ warning("Too many labels in addEdge: wanted %d, got %d. Truncating name list.\n",length(atl),length(atlnam)); PROTECT(atlnam = contractList(atlnam,length(atl))); pc++; }else if(length(atlnam)0){ PROTECT(elem = allocVector(INTSXP,length(ptr)+1)); pc++; // for(j=0;(j=INTEGER(outl)[0])) break; INTEGER(elem)[j]=INTEGER(ptr)[j]; } INTEGER(elem)[j++]=mnext; for(;(j-10){ PROTECT(elem = allocVector(INTSXP,length(ptr)+1)); pc++; // for(j=0;(j=INTEGER(inl)[0])) break; INTEGER(elem)[j]=INTEGER(ptr)[j]; } INTEGER(elem)[j++]=mnext; for(;(j-10) Rprintf("\tFirst ID is %d\n",INTEGER(eids)[0]);*/ REPROTECT(x=deleteEdges(x,eids),ipx); UNPROTECT(1); } /*Permute the vertices in vid to the end of the graph*/ /*Rprintf("\tPreparing to permute\n");*/ PROTECT(nord=allocVector(INTSXP,networkSize(x))); pc++; count=0; for(i=0;in)|| (INTEGER(vj)[i]>n)) INTEGER(ans)[i]=NA_INTEGER; /*Return NA on a bad query*/ else INTEGER(ans)[i]=isAdjacent(x,INTEGER(vi)[i],INTEGER(vj)[i], omitna); /*Return the result*/ UNPROTECT(pc); return ans; } SEXP isNANetwork_R(SEXP x, SEXP y) /*Given input network x, create an edge in y for every edge of x having edge attribute na==TRUE. It is assumed that y is preallocated to be the same size and type as x -- this function just writes the edges into place.*/ { SEXP hl,tl,nel,vel,mel,edgeCheck; int i,pc=0,count=0; /*Get the master edge list of x*/ mel=getListElement(x,"mel"); /*Pre-allocate head/tail lists -- we'll shorten later*/ PROTECT(hl=allocVector(VECSXP,length(mel))); pc++; PROTECT(tl=allocVector(VECSXP,length(mel))); pc++; /*Move through the edges, copying head/tail lists only when missing*/ for(i=0;i # Last Modified 5/07/2016 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains the R/C initialization code # ###################################################################### */ #include #include #include #include "access.h" #include "constructors.h" #include "layout.h" #include "utils.h" #define CALLDEF(name, n) {#name,(DL_FUNC) &name, n} static R_CallMethodDef CallEntries[] = { CALLDEF(addEdge_R,6), CALLDEF(addEdges_R,6), CALLDEF(addVertices_R,3), CALLDEF(copyNetwork_R,1), CALLDEF(deleteEdgeAttribute_R,2), CALLDEF(deleteEdges_R,2), CALLDEF(getEdgeAttribute_R,5), CALLDEF(deleteNetworkAttribute_R,2), CALLDEF(deleteVertexAttribute_R,2), CALLDEF(deleteVertices_R,2), CALLDEF(getEdgeIDs_R,5), CALLDEF(getEdges_R,5), CALLDEF(getNeighborhood_R,4), CALLDEF(isAdjacent_R,4), CALLDEF(isNANetwork_R,2), CALLDEF(networkEdgecount_R,2), CALLDEF(permuteVertexIDs_R,2), CALLDEF(setEdgeAttribute_R,4), CALLDEF(setEdgeAttributes_R,4), CALLDEF(setEdgeValue_R,4), CALLDEF(setNetworkAttribute_R,3), CALLDEF(setVertexAttribute_R,4), CALLDEF(setVertexAttributes_R,4), CALLDEF(nonEmptyEdges_R,1), {NULL,NULL,0} }; static R_CMethodDef CEntries[] = { CALLDEF(network_layout_fruchtermanreingold_R,15), CALLDEF(network_layout_kamadakawai_R,10), {NULL,NULL,0} }; void R_init_network(DllInfo *dll) { R_registerRoutines(dll,CEntries,CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); /*Add back the various things required by the API.*/ /*Register access routines*/ R_RegisterCCallable("network", "getEdgeAttribute", (DL_FUNC) getEdgeAttribute); R_RegisterCCallable("network", "getEdgeIDs", (DL_FUNC) getEdgeIDs); R_RegisterCCallable("network", "getEdges", (DL_FUNC) getEdges); R_RegisterCCallable("network", "getNeighborhood", (DL_FUNC) getNeighborhood); R_RegisterCCallable("network", "getNetworkAttribute", (DL_FUNC) getNetworkAttribute); R_RegisterCCallable("network", "hasLoops", (DL_FUNC) hasLoops); R_RegisterCCallable("network", "isAdjacent", (DL_FUNC) isAdjacent); R_RegisterCCallable("network", "isDirected", (DL_FUNC) isDirected); R_RegisterCCallable("network", "isHyper", (DL_FUNC) isHyper); R_RegisterCCallable("network", "isLoop", (DL_FUNC) isLoop); R_RegisterCCallable("network", "isMultiplex", (DL_FUNC) isMultiplex); R_RegisterCCallable("network", "isNetwork", (DL_FUNC) isNetwork); R_RegisterCCallable("network", "networkEdgecount", (DL_FUNC) networkEdgecount); R_RegisterCCallable("network", "networkSize", (DL_FUNC) networkSize); /*Register modification routines*/ R_RegisterCCallable("network", "addEdge_R", (DL_FUNC) addEdge_R); R_RegisterCCallable("network", "addEdges_R", (DL_FUNC) addEdges_R); R_RegisterCCallable("network", "deleteEdgeAttribute", (DL_FUNC) deleteEdgeAttribute); R_RegisterCCallable("network", "deleteNetworkAttribute", (DL_FUNC) deleteNetworkAttribute); R_RegisterCCallable("network", "deleteVertexAttribute", (DL_FUNC) deleteVertexAttribute); R_RegisterCCallable("network", "setNetworkAttribute", (DL_FUNC) setNetworkAttribute); R_RegisterCCallable("network", "setVertexAttribute", (DL_FUNC) setVertexAttribute); /* Callable functions from other packages' C code */ #define RREGDEF(name) R_RegisterCCallable("network", #name, (DL_FUNC) name) RREGDEF(setListElement); RREGDEF(getListElement); } network/src/constructors.c0000644000176200001440000000406313650470772015464 0ustar liggesusers/* ###################################################################### # # constructors.c # # Written by Carter T. Butts # Last Modified 03/04/19 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains routines related to constructor methods for # network objects. # ###################################################################### */ #include #include #include #include #include #include "utils.h" #include "constructors.h" /*INTERNAL ROUTINES----------------------------------------------------*/ /*R-CALLABLE ROUTINES--------------------------------------------------*/ SEXP copyEdges_R(SEXP x, SEXP y) /*Copy all edges from network x into network y. Note that y is assumed to have been initialized so as to have the same size as x.*/ { int pc=0; SEXP mel,mel2,iel,iel2,oel,oel2; mel=getListElement(x,"mel"); PROTECT(mel2=duplicate(mel)); pc++; PROTECT(y=setListElement(y,"mel",mel2)); pc++; iel=getListElement(x,"iel"); PROTECT(iel2=duplicate(iel)); pc++; PROTECT(y=setListElement(y,"iel",iel2)); pc++; oel=getListElement(x,"oel"); PROTECT(oel2=duplicate(oel)); pc++; y=setListElement(y,"oel",oel2); UNPROTECT(pc); return y; } SEXP copyNetwork_R(SEXP x) { int pc=0; SEXP y; PROTECT(y=duplicate(x)); pc++; UNPROTECT(pc); return y; } SEXP copyNetworkAttributes_R(SEXP x, SEXP y) /*Copy all network attributes from network x into network y.*/ { int pc=0; SEXP gal,gal2; gal=getListElement(x,"gal"); PROTECT(gal2=duplicate(gal)); pc++; y=setListElement(y,"gal",gal2); UNPROTECT(pc); return y; } SEXP copyVertexAttributes_R(SEXP x, SEXP y) /*Copy all vertex attributes from network x into network y. Note that y is assumed to have been initialized so as to have the same size as x.*/ { int pc=0; SEXP val,val2; val=getListElement(x,"val"); PROTECT(val2=duplicate(val)); pc++; y=setListElement(y,"val",val2); UNPROTECT(pc); return y; } network/src/layout.h0000644000176200001440000000262013650470751014230 0ustar liggesusers/* ###################################################################### # # layout.h # # Written by Carter T. Butts # Last Modified 9/6/10 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains headers for layout.c. # ###################################################################### */ #ifndef LAYOUT_H #define LAYOUT_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include #include #include "utils.h" /*Simple list structures to be used for temporary storage of vertex sets.*/ typedef struct vlisttype{ long int v; struct vlisttype *next; } vlist; typedef struct vcelltype{ int id; double count,xm,ym; struct vlisttype *memb; struct vcelltype *next; } vcell; /*R-CALLABLE ROUTINES-------------------------------------------------------*/ void network_layout_fruchtermanreingold_R(double *d, double *pn, double *pm, int *pniter, double *pmaxdelta, double *pvolume, double *pcoolexp, double *prepulserad, int *pncell, double *pcjit, double *pcppr, double *pcpcr, double *pcccr, double *x, double *y); void network_layout_kamadakawai_R(int *d, double *pn, int *pniter, double *elen, double *pinitemp, double *pcoolexp, double *pkkconst, double *psigma, double *x, double *y); #endif network/src/utils.h0000644000176200001440000000307313650470724014056 0ustar liggesusers/* ###################################################################### # # utils.h # # Written by Carter T. Butts # Last Modified 08/20/13 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains headers for utils.c. # ###################################################################### */ #ifndef UTILS_H #define UTILS_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include #include #include #include #include #include #define MIN(a,b) ((a)<(b) ? (a) : (b)) #define MAX(a,b) ((a)<(b) ? (b) : (a)) /*LIST ACCESS/MODIFICATION ROUTINES-----------------------------------------*/ SEXP deleteListElement(SEXP list, const char *str); SEXP getListElement(SEXP list, const char *str); SEXP setListElement(SEXP list, const char *str, SEXP elem); SEXP enlargeList(SEXP list, int n); SEXP contractList(SEXP list, int n); SEXP concatList(int nel, int names, ...); SEXP permuteList(SEXP list, SEXP ord); /*VECTOR COMPARISON/TEST ROUTINES-------------------------------------------*/ int vecAnyNA(SEXP a); int vecEq(SEXP a, SEXP b); int vecIsIn(double a, SEXP b); double vecMax(SEXP a); double vecMin(SEXP a); /*VECTOR MODIFICATION ROUTINES----------------------------------------------*/ SEXP vecAppend(SEXP a, SEXP b); SEXP vecRemove(SEXP v, double e); SEXP vecUnion(SEXP a, SEXP b); SEXP vecUnique(SEXP a); #endif network/src/access.h0000644000176200001440000000650013650471001014142 0ustar liggesusers/* ###################################################################### # # access.h # # Written by Carter T. Butts # Last Modified 7/07/16 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains headers for access.c. # ###################################################################### */ #ifndef ACCESS_H #define ACCESS_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include #include #include #include #include /*INTERNAL ROUTINES---------------------------------------------------------*/ SEXP deleteEdgeAttribute(SEXP x, int e, const char *attrname); SEXP deleteNetworkAttribute(SEXP x, const char *attrname); SEXP deleteVertexAttribute(SEXP x, int v, const char *attrname); SEXP getEdgeAttribute(SEXP x, int e, const char *str); SEXP getEdgeIDs(SEXP x, int v, int alter, const char *neighborhood, int naOmit); SEXP getEdges(SEXP x, int v, int alter, const char *neighborhood, int naOmit); SEXP getNeighborhood(SEXP x, int v, const char *type, int naOmit); SEXP getNetworkAttribute(SEXP x, const char *str); int hasLoops(SEXP x); int isAdjacent(SEXP x, int vi, int vj, int naOmit); int isDirected(SEXP x); int isHyper(SEXP x); int isLoop(SEXP outl, SEXP inl); int isMultiplex(SEXP x); int isNetwork(SEXP x); int networkEdgecount(SEXP x, int naOmit); int networkSize(SEXP x); SEXP setNetworkAttribute(SEXP x, const char *attrname, SEXP value); SEXP setVertexAttribute(SEXP x, const char *attrname, SEXP value, int v); SEXP deleteEdges(SEXP x, SEXP eid); SEXP permuteVertexIDs(SEXP x, SEXP vids); SEXP addEdges(SEXP x, SEXP tail, SEXP head, SEXP namesEval, SEXP valsEval, SEXP edgeCheck); /*R-CALLABLE ROUTINES-------------------------------------------------------*/ SEXP addEdge_R(SEXP x, SEXP tail, SEXP head, SEXP namesEval, SEXP valsEval, SEXP edgeCheck); SEXP addEdges_R(SEXP x, SEXP tail, SEXP head, SEXP namesEval, SEXP valsEval, SEXP edgeCheck); SEXP addVertices_R(SEXP x, SEXP nv, SEXP vattr); SEXP deleteEdgeAttribute_R(SEXP x, SEXP attrname); SEXP getEdgeAttribute_R(SEXP el,SEXP attrname, SEXP naomit,SEXP nullna,SEXP deletededgesomit); SEXP deleteEdges_R(SEXP x, SEXP eid); SEXP deleteNetworkAttribute_R(SEXP x, SEXP attrname); SEXP deleteVertexAttribute_R(SEXP x, SEXP attrname); SEXP deleteVertices_R(SEXP x, SEXP vid); SEXP getEdgeIDs_R(SEXP x, SEXP v, SEXP alter, SEXP neighborhood, SEXP naOmit); SEXP getEdges_R(SEXP x, SEXP v, SEXP alter, SEXP neighborhood, SEXP naOmit); SEXP getNeighborhood_R(SEXP x, SEXP v, SEXP type, SEXP naOmit); SEXP isAdjacent_R(SEXP x, SEXP vi, SEXP vj, SEXP naOmit); SEXP isNANetwork_R(SEXP x, SEXP y); SEXP networkEdgecount_R(SEXP x, SEXP naOmit); SEXP permuteVertexIDs_R(SEXP x, SEXP vids); SEXP setEdgeAttribute_R(SEXP x, SEXP attrname, SEXP value, SEXP e); SEXP setEdgeAttributes_R(SEXP x, SEXP attrname, SEXP value, SEXP e); SEXP setEdgeValue_R(SEXP x, SEXP attrname, SEXP value, SEXP e); SEXP setNetworkAttribute_R(SEXP x, SEXP attrname, SEXP value); SEXP setVertexAttribute_R(SEXP x, SEXP attrname, SEXP value, SEXP v); SEXP setVertexAttributes_R(SEXP x, SEXP attrname, SEXP value, SEXP v); SEXP nonEmptyEdges_R(SEXP el); #endif network/src/layout.c0000644000176200001440000002273213650470755014235 0ustar liggesusers/* ###################################################################### # # layout.c # # Written by Carter T. Butts # Last Modified 9/6/10 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater # # Part of the R/network package # # This file contains routines related to computation of vertex layouts # for plot.network (i.e., the plot.network.layout.* functions). Note that # this was originally ported directly from the sna package (also by Carter # Butts), although some bits may have evolved. # ###################################################################### */ #include #include #include #include #include "layout.h" /*TWO-DIMENSIONAL LAYOUT ROUTINES--------------------------------------*/ void network_layout_fruchtermanreingold_R(double *d, double *pn, double *pm, int *pniter, double *pmaxdelta, double *pvolume, double *pcoolexp, double *prepulserad, int *pncell, double *pcjit, double *pcppr, double *pcpcr, double *pcccr, double *x, double *y) /* Calculate a two-dimensional Fruchterman-Reingold layout for (symmetrized) edgelist matrix d (2 column). Positions (stored in (x,y)) should be initialized prior to calling this routine. */ { double frk,maxdelta,volume,coolexp,repulserad,t,ded,xd,yd,*dx,*dy; double rf,af,xmax,xmin,ymax,ymin,xwid,ywid,cjit,cppr,cpcr,cccr,celldis; long int n,j,k,l,m; int niter,i,*cellid,ncell,ix,iy,jx,jy; char *vmax; vcell *vcells,*p,*p2; vlist *vlp,*vlp2; /*Define various things*/ n=(long int)*pn; if (n <= 1) return; /* quick return when too few nodes to layout */ m=(long int)*pm; niter=*pniter; maxdelta=*pmaxdelta; volume=*pvolume; coolexp=*pcoolexp; repulserad=*prepulserad; ncell=*pncell; cjit=*pcjit; cppr=*pcppr; cpcr=*pcpcr; cccr=*pcccr; frk=sqrt(volume/(double)n); /*Define the F-R constant*/ xmin=ymin=R_PosInf; xmax=ymax=R_NegInf; /*Allocate memory for transient structures*/ dx=(double *)R_alloc(n,sizeof(double)); dy=(double *)R_alloc(n,sizeof(double)); cellid=(int *)R_alloc(n,sizeof(int)); /*Run the annealing loop*/ for(i=niter;i>=0;i--){ /*Check for interrupts, before messing with temporary storage*/ R_CheckUserInterrupt(); /*Allocate cell structures for this iteration*/ GetRNGstate(); vmax=vmaxget(); xmin=ymin=R_PosInf; xmax=ymax=R_NegInf; for(j=0;jnext!=NULL)&&(p->id!=cellid[j]);p=p->next); if(p==NULL){ /*Head was null; initiate*/ vcells=p=(vcell *)R_alloc(1,sizeof(vcell)); p->id=cellid[j]; p->next=NULL; p->memb=NULL; p->count=0.0; p->xm=0.0; p->ym=0.0; }else if(p->id!=cellid[j]){ /*Got to end, insert new element*/ p->next=(vcell *)R_alloc(1,sizeof(vcell)); p=p->next; p->id=cellid[j]; p->next=NULL; p->memb=NULL; p->count=0.0; p->xm=0.0; p->ym=0.0; } /*Add j to the membership stack for this cell*/ p->count++; vlp=(vlist *)R_alloc(1,sizeof(vlist)); vlp->v=j; vlp->next=p->memb; p->memb=vlp; p->xm=((p->xm)*((p->count)-1.0)+x[j])/(p->count); p->ym=((p->ym)*((p->count)-1.0)+y[j])/(p->count); } PutRNGstate(); /*Set the temperature (maximum move/iteration)*/ t=maxdelta*pow(i/(double)niter,coolexp); /*Clear the deltas*/ for(j=0;jnext) /*Add forces at the cell level*/ for(p2=p;p2!=NULL;p2=p2->next){ /*Get cell identities*/ ix=(p->id)%ncell; jx=(p2->id)%ncell; iy=(int)floor((p->id)/ncell); jy=(int)floor((p2->id)/ncell); celldis=(double)((ix-jx)*(ix-jx)+(iy-jy)*(iy-jy)); /*Sq cell/cell dist*/ if(celldis<=cppr+0.001){ /*Use point/point calculations (exact)*/ for(vlp=p->memb;vlp!=NULL;vlp=vlp->next) for(vlp2=((p==p2)?(vlp->next):(p2->memb));vlp2!=NULL; vlp2=vlp2->next){ /*Obtain difference vector*/ xd=x[vlp->v]-x[vlp2->v]; yd=y[vlp->v]-y[vlp2->v]; ded=sqrt(xd*xd+yd*yd); /*Get dyadic euclidean distance*/ xd/=ded; /*Rescale differences to length 1*/ yd/=ded; /*Calculate repulsive "force"*/ rf=frk*frk*(1.0/ded-ded*ded/repulserad); dx[vlp->v]+=xd*rf; /*Add to the position change vector*/ dx[vlp2->v]-=xd*rf; dy[vlp->v]+=yd*rf; dy[vlp2->v]-=yd*rf; } }else if(celldis<=cpcr+0.001){ /*Use point/cell calculations (approx)*/ /*Add force increments to each member of p and p2*/ for(vlp=p->memb;vlp!=NULL;vlp=vlp->next){ xd=x[vlp->v]-(p2->xm); yd=y[vlp->v]-(p2->ym); ded=sqrt(xd*xd+yd*yd); /*Get dyadic euclidean distance*/ xd/=ded; /*Rescale differences to length 1*/ yd/=ded; /*Calculate repulsive "force"*/ rf=frk*frk*(1.0/ded-ded*ded/repulserad); /*Add to dx and dy*/ dx[vlp->v]+=xd*rf*(p2->count); dy[vlp->v]+=yd*rf*(p2->count); } for(vlp=p2->memb;vlp!=NULL;vlp=vlp->next){ xd=x[vlp->v]-(p->xm); yd=y[vlp->v]-(p->ym); ded=sqrt(xd*xd+yd*yd); /*Get dyadic euclidean distance*/ xd/=ded; /*Rescale differences to length 1*/ yd/=ded; /*Calculate repulsive "force"*/ rf=frk*frk*(1.0/ded-ded*ded/repulserad); /*Add to dx and dy*/ dx[vlp->v]+=xd*rf*(p->count); dy[vlp->v]+=yd*rf*(p->count); } }else if(celldis<=cccr+0.001){ /*Use cell/cell calculations (crude!)*/ xd=(p->xm)-(p2->xm); yd=(p->ym)-(p2->ym); ded=sqrt(xd*xd+yd*yd); /*Get dyadic euclidean distance*/ xd/=ded; /*Rescale differences to length 1*/ yd/=ded; /*Calculate repulsive "force"*/ rf=frk*frk*(1.0/ded-ded*ded/repulserad); /*Add force increment to each member of p and p2*/ for(vlp=p->memb;vlp!=NULL;vlp=vlp->next){ dx[vlp->v]+=xd*rf*(p2->count); dy[vlp->v]+=yd*rf*(p2->count); } for(vlp=p2->memb;vlp!=NULL;vlp=vlp->next){ dx[vlp->v]-=xd*rf*(p->count); dy[vlp->v]-=yd*rf*(p->count); } } } /*Calculate attraction along edges*/ for(j=0;jt){ /*Dampen to t*/ ded=t/ded; dx[j]*=ded; dy[j]*=ded; } x[j]+=dx[j]; /*Update positions*/ y[j]+=dy[j]; } /*Free memory for cell membership (or at least unprotect it)*/ vmaxset(vmax); } } void network_layout_kamadakawai_R(int *d, double *pn, int *pniter, double *elen, double *pinitemp, double *pcoolexp, double *pkkconst, double *psigma, double *x, double *y) { double initemp,coolexp,sigma,temp,candx,candy; double dpot,odis,ndis,osqd,nsqd,kkconst; int niter; long int n,i,j,k; /*Define various things*/ n=(long int)*pn; niter=*pniter; initemp=*pinitemp; coolexp=*pcoolexp; kkconst=*pkkconst; sigma=*psigma; GetRNGstate(); /*Get the RNG state*/ /*Perform the annealing loop*/ temp=initemp; for(i=0;i=2.0). [CTB] Bug Fixes: - The network summary and print methods could in some cases fail if called on a network with non-trivial graph-level attributes. [CTB, submitted by Zack Almquist; closely related bug fixed by MSH] - If called with ignore.eval=T but no specified names.eval, as.network and friends generated an object with mislabeled edge attributes; note that a warning is still given with such a call, since it is unwise not to specify attribute names. [CTB, submitted by DH] v1.6 Changes/Bug Fixes Changes: - In-place modification methods now use draconian measures to force evaluation of their arguments prior to modification, and overwrite non-anonymous arguments in their original frame on exit. This is a kludge to cope with R's lazy evaluation strategy, which does not play well with in-place modification of arguments. Bug Fixes: - Per the above, semantics for in-place modification of objects should now operate correctly (was conflicting with R's lazy evaluation scheme, sometimes resulting in bizarre behavior). [CTB, submitted by Ronggui Huang] - plot.network was failing when edge.col was called with single color terms. [CTB, submitted by Philip Leifeld] - network.layout.fruchtermanreingold failed when called with a network having exactly one edge. [DRH] v1.5-1 Minor Changes/Bug Fixes Changes: - The mixingmatrix function has been moved from ergm to network (currently as an undocumented internal function). [CTB, but original function is due to MSH] Bug fixes: - plot.network generated an error in some cases when edge.curv was set. [CTB, submitted by Brian Ripley] - summary.network generated an error if mixingmatrices=TRUE was set and ergm was not loaded. (The mixingmatrix function has now been moved into the network package.) [CTB, submitted by Ronggui Huang] v1.5 New Functions, New Features, Changes, and Bug Fixes New Functions: - get.inducedSubgraph: return induced subgraphs and edge cuts from a network object. A new operator, %s%, has been introduced to simplify this process. [CTB] New Features: - add.vertices now supports adding vertices to the first mode of a bipartite network (default behavior is unchanged). [CTB] - as.matrix.network.adjacency and as.sociomatrix now support an optional argument to force bipartite graphs to be returned in full one-mode adjacency form (rather than the current, two-mode default). [CTB] - print.network and print.summary.network now support an argument to allow suppression of matrix output (helpful for very large graphs). [CTB] - network.layout.fruchtermanreingold now uses a cell-based acceleration scheme for large graphs, which can be adjusted using layout.par; it also operates entirely on edgelists, and is no longer O(N^2) in typical applications. - Network coercion methods now recognize/use sna edgelist attributes (even if the matrix is not actually an sna edgelist!) automagically. Coercion to edgelist form also sets the sna edgelist attributes. In addition to being useful for interoperability, this now makes it easier to import network data in edgelist form (previously, one had to be careful about setting vertex sizes, which could only be crudely inferred from the edgelist matrix itself). [CTB] Changes: - By very popular demand, network now uses R name spaces. [Credit to Michal Bojanowski for convincing us to make the leap] - Also by popular demand, print.network no longer displays the network itself by default. [CTB] - Elementwise network operators now support multigraphs, and use basic network attributes in a sane way. Operator semantics have been substantially expanded for the muligraph case; hypergraphs are not yet supported, but missingness is. [CTB, submitted by MSH] - Support for bipartite graphs in read.paj has been improved. [MSH] - In addition to changes noted above, network.layout.fruchtermanreingold uses a lightly different repulse radius by default; this seems to work better on large graphs. [CTB] - plot.network has some overdue performance enhancements, including a more scalable Fruchterman-Reingold implementation. Note that plot.network no longer coerces anything to adjacency form, although particular layout methods might. [CTB] Bug Fixes: - add.edge and add.edges would crash when called with NA vertex IDs in the head or tail lists. [CTB, submitted by Skye Bender-deMoll] - is.na.network failed when called on networks with deleted edges. [CTB, submitted by MSH] - network.dyadcount handled NAs improperly in some cases. [MSH] - network.initialize now stops with an error when called with <=0 vertices, rather than producing undefined behavior. [CTB, submitted by Skye Bender-deMoll] - Various minor issues in plot.network have bee fixed. [CTB, mostly based on imports from gplot in sna; some gplot fixes contributed by Alex Montgomery] - print.network and print.summary.network could fail when called on multiplex or hypergraphic networks with the wrong matrix.type settings. [CTB] v1.4-1 Minor Changes/Bug Fixes Changes: - print.summary.character now behaves in a more intuitive way (and always generates at least marginally useful output). [CTB] - print.summary.network has been rewritten -- too much confusion about what it was supposed to do. [CTB] - The na.omit option to print.summary.network and print.network should now be considered deprecated (it does essentially nothing at this point. [CTB] Bug Fixes: - print.summary.network was giving the same information twice (and other information badly. [CTB] v1.4 New Functions, New Features, Changes, and Bug Fixes New Functions: - is.na.network: returns a network whose edges correspond to missing edges in the original network. (Also supported by new backend function isNANetwork_R.) [CTB] - network.naedgecount: returns the number of missing edges in a network object. [CTB] - Internal functions summary.character and print.summary.character have been added for use with network print/summary methods. [MSH] - Internal function is.color has been added to allow heuristic identification of color names (for use with attribute plotting). as.color similarly attempts to coerce its input into some reasonable color value for display purposes. [CTB] New Features: - The network edge assignment operator ([<-.network) now allows NAs to be given as assignment values (resulting in missing edges if no attribute specified, or missing attribute values otherwise). [CTB] - The C-level network API headers are now contained in the "inst" directory; from now on, they will be maintained there. [CTB] - read.paj now imports vertex attributes. [Patch submitted by Alexander Montgomery] Changes: - Many minor documentation updates (including adding references to the recent JSS article). [CTB] - CITATION file has been updated to reflect current R standards. [CTB] - Color support in plot.network.default has been greatly expanded and rationalized. [CTB] - is.adjacent now sets na.omit=FALSE by default; there seems to be a general consensus that this results in the more obvious pattern of behavior (i.e., missing edges from i to j result in a value of NA, unless there are also non-missing (i,j) edges present). The man page has also been updated to describe this behavior in greater detail. [CTB] - Per the above, as.sociomatrix and related coercion methods also now display missing data information by default. [CTB] - summary.network now returns a summary.network object, and printing takes place within print.summary.network (which is standard R behavior). Something approximately like this was being done before, but behavior should now be more conventional; summary.network objects can also carry optional information as network attributes with names of the form "summary.*". [CTB; Submitted by DRH] - plot.network.default now automagically displays labels if manually supplied (following the behavior of sna's gplot). [CTB] - print.network now shows missing edge information. [CTB] - The man page for network.dyadcount now emphasizes the fact that directed dyads are returned when is.directed(x)==TRUE. (This was noted in the example, but was explicitly discussed in the main page.) [CTB; Submitted by DRH] - as.matrix.network.edgelist and as.matrix.network.incidence now return degenerate matrices instead of NULL when called with an empty graph. [Pavel Krivitsky] - Undocumented support for the design matrix and special "respondent" attributes should be considered deprecated, and will be removed in the next version. [CTB] Bug Fixes: - as.matrix.network.edgelist dropped the dimensions of its output when called on a graph with one edge. [CTB] - as.matrix.network.incidence produced an error when called with an empty graph, and generated incorrect matrices when called with graphs containing missing or previously deleted edges. [CTB] - get.neighborhood was incorrectly including ego for loopless undirected graphs. [CTB] - list.vertex.attributes produced an error when called on networks with different attributes on each vertex. [CTB] - plot.network.default was not displaying colors as advertised in some cases [CTB; Submitted by Cori Mar] - print.network and summary.network were giving ugly output. [MSH] - read.paj was reversing arc directions. [CTB; Submitted by Kevin Lewis] - The initial startup message was giving the wrong help command. [CTB; Submitted by Kevin Zembower] - read.paj was failing in some cases. [Pavel Krivitsky] - summary.network didn't call the mixing matrix summary properly. [MSH] v1.3 New Functions, New Features, Changes, and Bug Fixes New Functions: - network.vertex.names<-: simplified assignment for vertex names. [CTB] New Features: - A CITATION file has now been added to the package, to encourage good behavior. The initial on-load announcements have been tweaked accordingly. [CTB] Changes: - add.edges (via the backend routine add_edges_R) now adds edges in a more efficient way; substantial performance gains should be observed when adding multiple edges at one time, versus previous package versions. [CTB] - network print and summary methods now consistently refer to "vertex attributes" instead of "nodal attributes." [CTB] - network constructors now set vertex names by default; this brings the actual behavior of the package in line with its apparent behavior (since network.vertex names and similar routines will "fake" vertex names if none are present, thus producing results which are inconsistent with get.vertex.attribute in the latter case). [CTB] - The DESCRIPTION file has been tweaked to be a bit more professional, and to add the statnet web site. [CTB] Bug Fixes: - Fixed "virtual subsetting" for network objects when a single vector of virtual cell numbers is provided, or when a one-row, two-column matrix is given. In both cases, network was treating the numbers as if they were first-column selectors. [CTB] - Direct assignment to internal components of network objects was failing in certain cases. This has been fixed, although users should note that this behavior is both unsupported and generally a Bad Idea (TM). Please use interface methods instead! [CTB; Submitted by Skye Bender-deMoll] - Fixed bug in read.paj. [MSH] - Fixed display of attribute information in summary.network. [MSH] - plot.network is now compatible with the updated ergm package. [CTB] - Previously implemented functionality in plot.network allowing one-word specification of vertex or edge attributes for display parameters was not working uniformly. [CTB] v1.2 New Functions, Changes, Bug Fixes New Functions: - $<-.network: replacement method for network objects. [CTB] - sum.network, prod.network: sums and products of multiple network objects. [CTB] Changes: - Direct assignments with network objects on the right-hand side now copy their right-hand argument (per standard R semantics). Originally, a pointer to the right-hand argument was copied (and network.copy was required for direct assignment). The direct use of network.copy is now unnecessary for most purposes, and should be avoided. [CTB] - network.density now allows explicit control of missing data behavior, support for ignoring "structural zeros" (per bipartite), and supports a wider range of hypergraphic cases. [CTB] - Some adjustments have been made to the overloading of network arithmetic operators, to ensure compatibility with future versions of R. Most importantly, the passing of an attrname argument to arithmetic operators is now defunct (since it violates the S3 generics). The addition of more general sum and prod methods hopefully make up for this regression. [CTB] - The network extraction and assignment operators now behave more like conventional matrices. In particular, single vectors are assumed to contain lists of cell indices (when given in isolation), and one-row, two-column matrices are treated as other two-column matrices. [CTB] - Various minor documentation and test file updates. [CTB] Bug Fixes: - as.matrix arguments have been modified to harmonize with the new R (2.5) generics definitions. [CTB] - Annoying but harmless tracer messages have been removed. [CTB] - Protection stack could overflow when large numbers of edges were deleted in a single call. [CTB; Submitted by Pavel Krivitsky] v1.1-2 Changes, Bug Fixes Changes: - getNeighborhood, getEdges, and getEdgeIDs (internal) now force type="combined" behavior on undirected networks; this was done at the R level before, but is now enforced in C as well. This is not generally user-level transparent, but affects the experimental network API [CTB] Bug Fixes: - as.network.matrix was not setting the bipartite attribute of the returned network properly, when called with a non-FALSE bipartite argument [MSH] - An error was present in some error return functions, causing errors on errors (which, happily, were only relevant when an error occurred) [CTB; Submitted by Skye Bender-deMoll] v1.1-1 New Functions, Changes New Functions: - The internal function setVertexAttribute has been added. This has no immediate user-level effect, but the new function is supported in the C API [CTB] Changes: - Use of the protection stack has been changed, so as to avoid racking up huge stacks when creating very large networks. This is expected to have a minimal impact on performance, but will avoid protection stack overflow issues in some cases [CTB] - A change in R 2.4.0 has apparently made it impossible for generic two-argument Ops (e.g., +,-,*) to dispatch to functions with more than two arguments. A side effect of this is that "+.network" and friends must be called with the full function name (as opposed to simply "+") when the optional attrname argument is being used. Note that this is not a change in the network package (although the test code has been updated to reflect it), but a regression due to R. Go complain to the R team [CTB] v1.1 New Features, Bug Fixes, Changes New Features: - [.network and [<-.network now allow the use of vertex names (where present) for selection of vertices [CTB] Bug Fixes: - add.vertices did not verify the integrity of vattr, and could generate a segfault if incorrectly called with a non-null, non-list value [CTB; reported by Skye Bender-deMoll] - as.network (and friends) could segfault if matrix.type was forced to adjacency while bipartite>0; new behavior essentially forces the use of the bipartite matrix method in this case [CTB] - delete.edges and set.edge.attribute returned an annoying (but harmless) warning when called with zero-length eid [CTB; reported by David Hunter] - delete.vertices did not adjust bipartite attribute (where present) to account for loss of mode 1 vertices [CTB] - get.vertex.attribute generated an error when called with na.omit=TRUE in some cases [CTB] - network.incidence could not be used to construct undirected dyadic networks [CTB] - set.vertex.attribute generated an error if called with attribute lists of length != network.size [CTB; reported by Skye Bender-deMoll] Changes: - Added a new overview man page (network-package) with information on how to get started with network [CTB] - [<-.network will now remove edges with zero values if both names.eval and add.edges are set, and will not add edges for those cells. Previously, the standard behavior was to add edges for all cells [CTB] - Added delete.edges to the "see also" for add.edges [CTB; suggested by Skye Bender-deMoll] - permute.vertexIDs now throws a warning when called with a cross-mode vertex exchange on a bipartite graph [CTB] - Default matrix type for as.matrix.network is now "adjacency," rather than the output of which.matrix.type(). Coercion methods should not have variable behavior depending on features such as network size, even if it is convenient for some purposes! The old behavior can be easily obtained via setting matrix.type=which.matrix.type(x), for those who want it [CTB] v1.0-1 Minor Bug Fixes, Changes Bug Fixes: - Various warnings were removed (apparently, these only appeared in R<2.1) [CTB] - plot.network was failing on networks where is.bipartite==TRUE [CTB] Changes: - The generic form of %c% was temporarily removed, to avoid namespace issues with sna. (This will be rectified in future releases.) [CTB] v1.0 New Functions, New Features, Changes, and Bug Fixes New Functions: - Operator overloading for +, -, *, |, &, and ! have been added, as has the composition operator, %c% [CTB] - Operator overloading is now supported for "[" and "[<-"; this allows network objects to be treated transparently as if they were adjacency matrices (in some cases, at least). New extraction/replacement operators %n%, %n%<-, %v%, %v%<- have been added for extracting/assigning values to network and vertex attributes (respectively) [CTB] - network.copy: returns a copy of the input network [CTB] - network.dyadcount: return the number of dyads in a network (optionally adjusting for the missing dyads) [MSH] New Features: - add.edges now checks for illegal loop-like edges when edge.check==TRUE [CTB] - get.neighborhood now allows users to specify whether missing edges should be ignored [CTB] - set.edge.value now accepts edge values in vector format [CTB] Changes: - All access access functions now modify their arguments in place; this greatly improves performance, but may produce unexpected behavior. If users wish to generate a modified copy of a network, they must first generate the copy and then modify it. Otherwise, the old object will be modified as well. In accordance with this, modification methods now return their (modified) arguments invisibly. [CTB] - Most access functions have now been backended; this has improved the performance of many operations by as much as two orders of magnitude [CTB] - get.edges and get.edgeIDs now treat all undirected networks as if called with neighborhood=="combined" [CTB] - as.matrix.network.incidence now handles undirected edges in a more conventional way [CTB] - network.adjacency will now ignore diagonal entries if has.loops=FALSE [CTB] Bug Fixes: - as.network.edgelist and as.network.incidence were producing spurious edge attributes [CTB] - list.edge.attributes generated failed under certain conditions (submitted by Matthew Wiener) [CTB] - set.edge.attribute was able to write attributes into non-existent (NULL) edges [CTB] - set.edge.value could exhibit strange behavior when carelessly chosen edge subsets were selected [CTB] v0.5-4 New Facilities for Bipartite, New Features, Changes, and Bug Fixes New Functions: - network.bipartite to store an explicit bipartite network. Modified network.initialize, etc, to accept "bipartite" argument. [MSH] - is.bipartite: logical test for a bipartite network [MSH] - read.paj: read one or more network objects from a Pajek file [MSH, DS] New Features: - summary.network now reports on edge attributes [MSH] Changes: - The composition operator (%c%) has been removed due to a name conflict with the sna package; since sna now supports network objects, its version can be used instead. [CTB] - as.sociomatrix is now properly configured to work in tandem with as.sociomatrix.sna (in the sna package). The functionality of the routine has also been extended slightly. [CTB] Bug Fixes: - .First.lib: Print out correct welcome banner for package [MSH] - Fix displayisolates determination in plot.network.default [MSH] v0.5-3 New Functions, New Data Set, and Changes New Functions: - permute.vertexIDs: Permute vertices in their internal representation [CTB] New Data: - emon: Drabek et al.'s Emergent Multi-organizational Networks [CTB] Changes: - The obsolete examples directory has been removed. [CTB] v0.5-2 New Features, New Functions and Bug Fixes New Functions: - delete.vertices: Remove one or more vertices (and associated edges) from a network object. - delete.edge.attribute, delete.network.attribute, delete.vertex attribute: Remove an edge/network/vertex attribute. - list.edge.attributes, list.network.attributes, list.vertex attributes: List all edge/network/vertex attribute names. New Features: - plot.graph.default now accepts vertex/edge attribute names for most vertex/edge display properties. Bug Fixes: - Edge deletion produced exciting and unexpected behavior in some cases. - network.initialize set vertex na attributes to TRUE by default. network/NAMESPACE0000644000176200001440000001247614723241675013207 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("!",network) S3method("$",mixingmatrix) S3method("%c%",network) S3method("&",network) S3method("*",network) S3method("+",network) S3method("-",network) S3method("[",network) S3method("[<-",network) S3method("[[",mixingmatrix) S3method("|",network) S3method(add.edge,network) S3method(add.edges,network) S3method(add.vertices,network) S3method(as.data.frame,network) S3method(as.edgelist,matrix) S3method(as.edgelist,network) S3method(as.edgelist,tbl_df) S3method(as.matrix,network) S3method(as.matrix.network,adjacency) S3method(as.matrix.network,edgelist) S3method(as.matrix.network,incidence) S3method(as.network,data.frame) S3method(as.network,default) S3method(as.network,matrix) S3method(as.network,network) S3method(as.tibble,network) S3method(as_tibble,network) S3method(delete.edge.attribute,network) S3method(delete.edges,network) S3method(delete.network.attribute,network) S3method(delete.vertex.attribute,network) S3method(delete.vertices,network) S3method(get.edge.attribute,list) S3method(get.edge.attribute,network) S3method(get.edge.value,list) S3method(get.edge.value,network) S3method(get.inducedSubgraph,network) S3method(get.network.attribute,network) S3method(get.vertex.attribute,network) S3method(is.bipartite,mixingmatrix) S3method(is.bipartite,network) S3method(is.directed,mixingmatrix) S3method(is.directed,network) S3method(is.na,network) S3method(list.edge.attributes,network) S3method(list.network.attributes,network) S3method(list.vertex.attributes,network) S3method(mixingmatrix,network) S3method(network.dyadcount,network) S3method(network.edgecount,network) S3method(network.naedgecount,network) S3method(network.size,network) S3method(permute.vertexIDs,network) S3method(plot,network) S3method(plot.network,default) S3method(print,mixingmatrix) S3method(print,network) S3method(print,summary.network) S3method(prod,network) S3method(set.edge.attribute,network) S3method(set.edge.value,network) S3method(set.network.attribute,network) S3method(set.vertex.attribute,network) S3method(sum,network) S3method(summary,network) S3method(valid.eids,network) export("!.network") export("%c%") export("%c%.network") export("%e%") export("%e%<-") export("%eattr%") export("%eattr%<-") export("%n%") export("%n%<-") export("%nattr%") export("%nattr%<-") export("%s%") export("%v%") export("%v%<-") export("%vattr%") export("%vattr%<-") export("&.network") export("*.network") export("+.network") export("-.network") export("<-.network") export("[.network") export("[<-.network") export("network.vertex.names<-") export("|.network") export(add.edge) export(add.edge.network) export(add.edges) export(add.edges.network) export(add.vertices) export(add.vertices.network) export(as.color) export(as.data.frame.network) export(as.edgelist) export(as.edgelist.matrix) export(as.matrix.network) export(as.matrix.network.adjacency) export(as.matrix.network.edgelist) export(as.matrix.network.incidence) export(as.network) export(as.network.data.frame) export(as.network.default) export(as.network.matrix) export(as.network.network) export(as.sociomatrix) export(delete.edge.attribute) export(delete.edges) export(delete.network.attribute) export(delete.vertex.attribute) export(delete.vertices) export(get.dyads.eids) export(get.edge.attribute) export(get.edge.value) export(get.edgeIDs) export(get.edges) export(get.inducedSubgraph) export(get.neighborhood) export(get.network.attribute) export(get.vertex.attribute) export(has.edges) export(has.loops) export(is.adjacent) export(is.bipartite) export(is.color) export(is.directed) export(is.discrete) export(is.discrete.character) export(is.discrete.numeric) export(is.edgelist) export(is.hyper) export(is.multiplex) export(is.na.network) export(is.network) export(list.edge.attributes) export(list.network.attributes) export(list.vertex.attributes) export(mixingmatrix) export(network) export(network.adjacency) export(network.arrow) export(network.bipartite) export(network.copy) export(network.density) export(network.dyadcount) export(network.edgecount) export(network.edgelabel) export(network.edgelist) export(network.incidence) export(network.initialize) export(network.layout.circle) export(network.layout.fruchtermanreingold) export(network.layout.kamadakawai) export(network.loop) export(network.naedgecount) export(network.size) export(network.vertex) export(network.vertex.names) export(permute.vertexIDs) export(plot.network) export(plot.network.default) export(plotArgs.network) export(print.network) export(print.summary.network) export(prod.network) export(read.paj) export(set.edge.attribute) export(set.edge.value) export(set.network.attribute) export(set.vertex.attribute) export(sum.network) export(summary.network) export(valid.eids) export(which.matrix.type) import(utils) importFrom(grDevices,colors) importFrom(grDevices,gray) importFrom(graphics,locator) importFrom(graphics,par) importFrom(graphics,plot) importFrom(graphics,polygon) importFrom(graphics,rect) importFrom(graphics,strheight) importFrom(graphics,strwidth) importFrom(graphics,text) importFrom(magrittr,"%>%") importFrom(magrittr,set_names) importFrom(statnet.common,NVL) importFrom(statnet.common,once) importFrom(statnet.common,statnetStartupMessage) importFrom(stats,na.omit) importFrom(stats,rnorm) importFrom(tibble,as.tibble) importFrom(tibble,as_tibble) importFrom(tibble,tibble) useDynLib(network, .registration = TRUE) network/inst/0000755000176200001440000000000014725415437012734 5ustar liggesusersnetwork/inst/include/0000755000176200001440000000000013357022000014333 5ustar liggesusersnetwork/inst/include/network.h0000644000176200001440000000423013357022000016174 0ustar liggesusers#include #include #ifndef NETWORK_H #define NETWORK_H SEXP (*getListElement)(SEXP list, const char *str); SEXP (*setListElement)(SEXP list, const char *str, SEXP elem); /* Legacy networkapi.h functions */ /* Access functions*/ SEXP (*netGetEdgeAttrib_ptr)(SEXP, int, const char*); SEXP (*netGetEdgeIDs_ptr)(SEXP, int, int, const char*, int); SEXP (*netGetEdges_ptr)(SEXP, int, int, const char*, int); SEXP (*netGetNeighborhood_ptr)(SEXP, int, const char*, int); SEXP (*netGetNetAttrib_ptr)(SEXP, const char*); int (*netHasLoops_ptr)(SEXP); int (*netIsAdj_ptr)(SEXP, int, int, int); int (*netIsDir_ptr)(SEXP); int (*netIsHyper_ptr)(SEXP); int (*netIsLoop_ptr)(SEXP, SEXP); int (*netIsMulti_ptr)(SEXP); int (*netIsNetwork_ptr)(SEXP); int (*netNetEdgecount_ptr)(SEXP, int); int (*netNetSize_ptr)(SEXP); /*Modification functions*/ SEXP (*netAddEdge_ptr)(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); SEXP (*netAddEdges_ptr)(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); SEXP (*netDelEdgeAttrib_ptr)(SEXP, int, const char*); SEXP (*netDelNetAttrib_ptr)(SEXP, const char*); SEXP (*netDelVertexAttrib_ptr)(SEXP, int, const char*); SEXP (*netSetNetAttrib_ptr)(SEXP, const char*, SEXP); SEXP (*netSetVertexAttrib_ptr)(SEXP, const char*, SEXP, int); /*Access functions*/ #define netGetEdgeAttrib (*netGetEdgeAttrib_ptr) #define netGetEdgeIDs (*netGetEdgeIDs_ptr) #define netGetEdges (*netGetEdges_ptr) #define netGetNeighborhood (*netGetNeighborhood_ptr) #define netGetNetAttrib (*netGetNetAttrib_ptr) #define netHasLoops (*netHasLoops_ptr) #define netIsAdj (*netIsAdj_ptr) #define netIsDir (*netIsDir_ptr) #define netIsHyper (*netIsHyper_ptr) #define netIsLoop (*netIsLoop_ptr) #define netIsMulti (*netIsMulti_ptr) #define netIsNetwork (*netIsNetwork_ptr) #define netNetEdgecount (*netNetEdgecount_ptr) #define netNetSize (*netNetSize_ptr) /*Modification functions*/ #define netAddEdge (*netAddEdge_ptr) #define netAddEdges (*netAddEdges_ptr) #define netDelEdgeAttrib (*netDelEdgeAttrib_ptr) #define netDelNetAttrib (*netDelNetAttrib_ptr) #define netDelVertexAttrib (*netDelVertexAttrib_ptr) #define netSetNetAttrib (*netSetNetAttrib_ptr) #define netSetVertexAttrib (*netSetVertexAttrib_ptr) #endif network/inst/include/netregistration.h0000644000176200001440000000470013357022000017726 0ustar liggesusers#include #include #include #include "network.h" #ifndef NETREGISTRATION_H #define NETREGISTRATION_H void netRegisterFunctions(void){ getListElement = (SEXP (*)(SEXP list, const char *str)) R_GetCCallable("network","getListElement"); setListElement = (SEXP (*)(SEXP list, const char *str, SEXP elem)) R_GetCCallable("network","setListElement"); /*Register access routines*/ netGetEdgeAttrib_ptr = (SEXP (*)(SEXP, int, const char*)) R_GetCCallable("network", "getEdgeAttribute"); netGetEdgeIDs_ptr = (SEXP (*)(SEXP, int, int, const char*, int)) R_GetCCallable("network", "getEdgeIDs"); netGetEdges_ptr = (SEXP (*)(SEXP, int, int, const char*, int)) R_GetCCallable("network", "getEdges"); netGetNeighborhood_ptr = (SEXP (*)(SEXP, int, const char*, int)) R_GetCCallable("network", "getNeighborhood"); netGetNetAttrib_ptr = (SEXP (*)(SEXP, const char*)) R_GetCCallable("network", "getNetworkAttribute"); netHasLoops_ptr = (int (*)(SEXP)) R_GetCCallable("network", "hasLoops"); netIsAdj_ptr = (int (*)(SEXP, int, int, int)) R_GetCCallable("network", "isAdjacent"); netIsDir_ptr = (int (*)(SEXP)) R_GetCCallable("network", "isDirected"); netIsHyper_ptr = (int (*)(SEXP)) R_GetCCallable("network", "isHyper"); netIsLoop_ptr = (int (*)(SEXP, SEXP)) R_GetCCallable("network", "isLoop"); netIsMulti_ptr = (int (*)(SEXP)) R_GetCCallable("network", "isMultiplex"); netIsNetwork_ptr = (int (*)(SEXP)) R_GetCCallable("network", "isNetwork"); netNetEdgecount_ptr = (int (*)(SEXP, int)) R_GetCCallable("network", "networkEdgecount"); netNetSize_ptr = (int (*)(SEXP)) R_GetCCallable("network", "networkSize"); /*Register modification routines*/ netAddEdge_ptr = (SEXP (*)(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP)) R_GetCCallable("network", "addEdge_R"); netAddEdges_ptr = (SEXP (*)(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP)) R_GetCCallable("network", "addEdges_R"); netDelEdgeAttrib_ptr = (SEXP (*)(SEXP, int, const char*)) R_GetCCallable("network", "deleteEdgeAttribute"); netDelVertexAttrib_ptr = (SEXP (*)(SEXP, int, const char*)) R_GetCCallable("network", "deleteVertexAttribute"); netDelNetAttrib_ptr = (SEXP (*)(SEXP, const char*)) R_GetCCallable("network", "deleteNetworkAttribute"); netSetNetAttrib_ptr = (SEXP (*)(SEXP, const char*, SEXP)) R_GetCCallable("network", "setNetworkAttribute"); netSetVertexAttrib_ptr = (SEXP (*)(SEXP, const char*, SEXP, int)) R_GetCCallable("network", "setVertexAttribute"); } #endif network/inst/CITATION0000644000176200001440000000452114317402074014061 0ustar liggesusers# use the generic statnet header text #' statnet: statnet.cite.head('network') # ---- BEGIN AUTOGENERATED STATNET CITATION ---- citHeader(paste0(sQuote("network"), " is part of the Statnet suite of packages. ", "If you are using the ", sQuote("network"), " package for research that will be published, ", "we request that you acknowledge this by citing the following.\n", "For BibTeX format, use toBibtex(citation(\"", "network", "\")).")) # ---- END AUTOGENERATED STATNET CITATION ---- # generate the standard statnet-style package software manual citation #' statnet: statnet.cite.pkg('network') # ---- BEGIN AUTOGENERATED STATNET CITATION ---- bibentry("Manual", author = structure(list(list(given = "Carter T.", family = "Butts", role = c("aut", "cre"), email = "buttsc@uci.edu", comment = NULL)), class = "person"), title = paste("network", ": ", "Classes for Relational Data", sep = ""), organization = paste("The Statnet Project (\\url{", "http://www.statnet.org", "})", sep = ""), year = substr("2015-08-31", 1, 4), note = paste("R package version ", "1.13.0.1", sep = ""), url = paste("https://CRAN.R-project.org/package=", "network", sep = "")) # ---- END AUTOGENERATED STATNET CITATION ---- # generate an additional citation for Carter's original paper bibentry("Article", title = "network: a Package for Managing Relational Data in R.", author = person("Carter T.", "Butts", email = "buttsc@uci.edu"), journal = "Journal of Statistical Software", year = 2008, volume = 24, number = 2, doi ="10.18637/jss.v024.i02") # add a network-specific footer citFooter("Some additional information regarding the C-level network API can be found in the README file within the network.api subdirectory under the package \"inst\" directory -- check your installed library tree.") # add the general statnet footer #' statnet: statnet.cite.foot('network') # ---- BEGIN AUTOGENERATED STATNET CITATION ---- citFooter(paste0("We have invested a lot of time and effort in creating the ", "Statnet suite of packages for use by other researchers. ", "Please cite it in all papers where it is used. The package ", sQuote("network"), " is distributed under the terms of the license ", "GPL (>= 2)", ".")) # ---- END AUTOGENERATED STATNET CITATION ---- network/inst/doc/0000755000176200001440000000000014725415437013501 5ustar liggesusersnetwork/inst/doc/networkVignette.pdf0000644000176200001440000070752514725415437017413 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4726 /Filter /FlateDecode /N 89 /First 756 >> stream x\S~v:eIN@CL$qR[2fvOY vR2Z~ݒV4xe ` q@A tPr>j28@Z*@`k` %8!'Q 8H ^HҁWkg@6HP|Bր^ 8-Ai@!e #5((3;PBahDZXYZJ!h (XmvV:P:@Љ` H@TF*4 B0Pw`+LYj|=4.om1/ִ>O :,M2t,0Ф.eF4b&bR-&bR-&ՒnŚ¿>Xqd0=p`l],¬!]>&s|=;/I?8jxvT^LGEjP ?j2y;l&e䈴ɨ $6"gA)m#%Dvd%2~4=.j-DX! |-nXZGցYcA:%IW*RhA *L2&brxqق 8uX;|~ȏx_!+^y'5| jF0 !8h/$=2%4SpT*NUy_h8ت.F%dX]Dq[^MXCYN_u|əN_ie *8TIKZ9Q-p ¿ |.*4 E'6D Q%xkbh{צuUL*3^ۤK :R+❉thǙho|] ??yOQ](C>6Q.?/*(+C]|e3Q3&ÏeSMыbTJ%OpeM }Uĉ *[߿y;khgN1pzbh'7 X;R.ROԇYxVWnZp(_g5X`ML@rK@t =GT=`R(wfE@:]7Mt1=ɯn :WU Kd݂(uuyqd C]t'qMկ,lޖwۃh:Gc/\]fT+&~A@ޥ,nq>E&'zT^K;·հě|T~LO'e+X,PtqUV"w1wOr~lj27,݅ea[cDVg_]^`^/Lb1JoFDM{dW{zۗ[[_ex3h{~b 59<!ʖxI8=YݳX{lߓfUϴXbUlg\YTڹX~+#җwP^R:0bCxJd*xV0o(d,YS̙]x U4Cyhid|V˼0o{ܚU|gbL V;F[PXF{t' cBGBfĭ *) )-2h N;ǂ3@沪}j'ԸʳZFLDS+f=DKG[mS L{IcLEd&HL*uiF2G۞2m2C'u_i5|6z&C>lw{A0:g`[FG4vyTe;nj:w{ܟ`dȡGkYs)~Qyt0Zit C_'G[?gIU<` /:7#~6+'t*@Yf$CLED 1GgKv*Wήc:Љ0~AEFcݠh|ݐ0! (a%tXl:h恢OLK2 f/^*[WaՖͻzT(|UTht6Še)t%HNw5PԺ3U.GA(R)2 >6k 2>]4A Fр;1b{ G޿ J\4`eYЃ,V-Dfq˜CYeWDH˔prckP2/hL3/?Ǥ@`_܃ِczб ‹dAQ|ߨ#hh&_9:|K #{4.R -"kJ2HZS`lpf1)oYMYJo·ӑwkfR) [>=L dzry?N%~,<,\n:o̶8A);-G"B~XܰH̍ /endstream endobj 91 0 obj << /Subtype /XML /Type /Metadata /Length 1516 >> stream GPL Ghostscript 10.02.1 relational data, data structures, graphs, network, statnet, R 2024-12-08T14:18:07-08:00 2024-12-08T14:18:07-08:00 LaTeX with hyperref network: A Package for Managing Relational Data in RCarter T. Butts endstream endobj 92 0 obj << /Type /ObjStm /Length 3101 /Filter /FlateDecode /N 87 /First 790 >> stream xZoF޿b>(ٙ-zˣHڜAi[=Y2$I!"%˶+ Cr,$ 1d! xH"hZ Z(:l 009apȺJ@E D Dh|p{@$h# z 2x  b1[ƨL:%:A@cTĒ:̀. Gđ^$J,3EH$ AA1H'AXD% $BT A @O99@!!Fπ^ &ԑ1|d>Je@H ;HTTu!Y@fHtjDG*3JX PajR{e W-I$*򉒈V^aQEZzPRiaԵAd19e 8*#}U/ǤW*ؠڪ,uQgz 1}א=_ `^NBm7UQjRyntɓً|U/"f6/p IoObyn$?>-f9|}[띵 Y+Z+ڠcVrk[l=}7kYrO2kCaC\Et)C+y&T)I8<ޏ3Adh Ļe]DX}-~BR=5҆}dy5{;yS.M΢{**Z*NyH* ,k&bx©OI:$0z>m+J CbIz oԶdtږ(d@+ Mof޶z׻"ӈr,ؽnGM4mmߡfDߚd8%6M:-F 1A@%#/#8mGjq+P ^.~\{!ɓn|ogm?ov5CF*yStcG-vͧ⟧ŸvV90߇ux^/G)VD sj g ZB-7M 4`$\wUKR+ );t#ywCy1䰯[c9@`zqϨFrKcmѴlxd>}/߼=WhO-fg}3,Φ ~ΟW@i`/KP1E,bY6vWNӛ_'lT}Yq|>D@||*^\6 y6}9J $V5ʠ|LJ,'pMwN_xϦYj:(ӽN{-s[ hby/k (oUɵL&`YLL-_ תœrEÒEm;p EpI^f:o]  `%!6Cs]47\ݝjn4sTK4Si>6v煛(48 .w.SBN.GkHw 9CNca#ƒ߀4m'bMN&U΋K0i.!(b\JFc.pe03)FBX{В6CasWjuECv׿gH_&X@2v=CYڬۺYbCrr9dR:9.buh;ėHƶ뿞\4G16i o~l1 ,l.O6Ё/lH<8@{,p^63^gM$X`a:>jxJ&q#K*b@q:N~w&RVP7]\Ky1[E\))tdNSbNg^yzݔmz``FZCCݸtOܹQyV|bH'f6^X~{,[巶5wWݧY$66Q6&d1[̳,.|Ͳl-:_Ng2[exuM1.h6[uz 'R=eJ8[݅VRuv)Łwk&xZ LuRS7Sm0$2&9wԈ8\Bt+-mS ,zP=w:gMp;SkBA3㩆.iRO!z¤.EqU}Ѭq1ϋ|R"%ɔaQ 2HY]CP̓xn'mgIv5ߌglygxgS2 NKޔ'd]X#F@TGs-=r[`4JG8 לb쮰zHJRӱv9t M .^*N an$龩 g7zZgq>ďs2h s'lwV[ ~|6ҝ9lQ3h$d \σ˶ɟSvWwxC}0"?^p-x!ԮYכXMq3 1uD&_k1,5:OnfF]/Yn&Wgz7AM&X6L& dR:0{*2/22RWJQT]O}a#endstream endobj 180 0 obj << /Type /ObjStm /Length 2736 /Filter /FlateDecode /N 89 /First 820 >> stream xZo7~|C3(m\^u%W? wWH$y]Ðr΋3 &L&1`@;'2xs' AB!f dYo"/#Dbq !8 D $Ga@0@L@!(@ $EBNDDDb&3C H &Cb-(BB݂$ `%yIyT䕢RfaNI2> S(TYO99 !bRb 省+Sbt+:࠭wU>ݤ-@]T  :d T #a.@"($h+; 5B^1+$( +H< yDĺomeI}CTVyRTҳ|=gx6E*WtѬͦrcGْ(MĻޤ̀٧t|;9;G"޻G^}_}'xn*]겂O % jIs 56׆P_՗YoV-Cx? =yOjޓ ]1$v% 3 H HE+ u3Ӫ0(̈́iUַ'^7'ݓW`t h:X  &ً$(_Vf6}k&!!سfVJ/vuBTl(eH3b}-4,=`ʒ in]U۽Mes۞͞p<v`gڎ썝ة/UOϴG<${^  l}4V9w]me7?]+p`O`tYسYu3 e-~hޚE?VdGAdEĄw0(wYsn+NxT]MܜqA$;s8W^a2n+ wdȹ5f?=wؑYa=p;r+m9sRv߻E;92XH@UֵIrٷF[}h[rWyf_]YU)~SEg }χ{PXxUm%ᎬK_70K9kxsaX[XC}N8bFp'w>jݨK0YK!׻#K5{Ĥi}s z`EQdE'/@ʶ%ίRB eۻ:_@RC mr,uwyYұ}cO;{j{M5Fr}+6o}K{eFňNh0ōQgvXgukۛj2_?Yu۰Lh;[׃jjTk\sZXzv%C!ĊU۪LI;\TkyQ:Xw^VSzA$&Ht0u`\@Nrf14GF:%]|3ޢ,G -q4||p DC(' =@fS> F7)[`C۩QpݺB?:üJػ+! %zڶ5zٶ3Aji9OǶeЇ '{1Qi̙ SY'D&!8l&b1c&i -Hvd%}&D95ȏͻl8%˲$[e\=BAiU`iX9r46Q6ˇsЉAW7FSX+dfh6 zMmQl&|6JGG Ew#ƹr8uMƒ3%E&Ѥnm٤B2ѥ(&m༐I`l1&CA(?8l28&=)ƞwͬ>Qѱ\3dB`M}c3hiG"F3AMpl#l1 pG/.%bl2hb΄L;j7b<$*;ˮCMHb Ll$&2G}ul,h[&hklQ`y=Y~A3 7#]@|9Z!sbaECg?$(31!G+4dyKAѸv.Ygx|HvJ!{pKA`M"q`; \su=\γ??=;}ݛhncVYMy*2kIkIFE\6'$Kw+0M4 +3RmwR(uŗ\V"pHkdfȢ`0ӠAE _!V=:QJ6Y놢3V֙Z@[۶?}gl8m=]n3+@ݙr[bO`=RUrWj? [>rJ OvC̷XoW?|:endstream endobj 270 0 obj << /Filter /FlateDecode /Length 4457 >> stream x[Kw6/tϜgsz=52c^Q!))_? vB$z~Uv`opǷxrnZ>\)<ZzWNjC(k]U3ʤFx2UR /p1I?|qw;FvjUkM~$l)$in*)(c|͔7RKޑ+&$5eLUzɭ0yhۇe;\jn'w]3C-sԖ4SRQ&ġzz>TWE~@!Q2#؁s8f;uaK'& i 98瑫s\R=\Rko9>lQxqgv _'U-ᤜৠ^:}ӵp)i9yzE~c߁zs/$rp`js8^h!I7+ډz K8T6Pi*x COas#9.-[ '(3A~x߸'4F_MU+'M)Z)N4d" ܽ/tVvmJ #z\qMoZyKwd.k/8鴰xV(2pNfIt?c ~C1# @`fd5+],oF$7ā䋸Xq3E9-kfJ 1+Z\?XH=(V<,_:q99 =*TDA9 39' E<`wR<g!`X XU۟`D^e3!`O] T3^Ƹ(/d]%۸љ-U;$(%@,{'9 U.q& |*qTK퓈~2l1 OF|L7'%BIW"H -Tib+)PD@tE8\ΰ3-ANZ85^K(J7E?q-eCVf#[ ]ɩ {' vI;%i4,HJ ^b?}JPTaV_ ozk>]BɩB눒 6mqheب(:4_Ŧ;%2Y2ƄPu%rߗ0pn@=!}1 :z"v7T@+6Y Є39r ~rFqJ&!*lVH)]04aY@BFpq#nɟ6RTasێ* Q? C,5Rިqjo* |Ԇ#%Ka&] WP V wT[S4u`-`QHc87rpΨ 66I?N˗85h?_> u2q< gn@[Q(6ufR(LU);hC/57~n#N#x$6HԀRۧԩ^9gɨ\AHQ/e0w9_F?'K6Ӝ4Obtaq %(Sh+sh<`cjC>t4ƒ_{a8۹B /2=~{*7/b0ӹS 2J)Wy)B`^Bu$I >|J%ϐ IwD|L"QBo:@1are;lB@X /2SLVʝZ鵳1J}l2!&چ)NY"w7bq35B ume* >;.B/n~FiwtBS~adiSR@5 T{sIIz;pѦc 󯔏 5=䶛3%T( 6x%ДYM&L?0[bl]cm>Ӻc˱ACsz dx="H }o(#tA-!Pw$DJm{+Ree+%I pyaL3<,v\0ØLڹ{Ox!-퀹}ɪR5ߝ{LZxRmc^/yz*Ilуl<Іbk] fjOl=H@}9`pN$#894XGPv-V' '_W621umhL' Evj&Ƅ&8Z%e+{eeYCt}P\; nI[%2`~vv;3+cX²=e\*P!)w"RX NwͨEpg1ՏjnK+gp.A?2lh.;T'b8bKS2+^`GRqbϑvg&c ']3,g 1.TiY70wȨ f,(] 2Ylm8|4+!nZV/~{qgcnouc3n(^ؘxp^N7|Ipxls,'endstream endobj 271 0 obj << /Filter /FlateDecode /Length 5901 >> stream x\Kq<-}Ѿ(6>VlKaC-Zvwj;TUϐC#D\K<='?>t{yɗϭIrw u wzݜ0ɗϽ*σ;y[~/KiRYڲn7ruBqu0@GvZ,{ dp?WTs!,]7uT/%|D+Hci;h jwЖh&Fba<{[ &6o8%zwЂ(ofp~GDtW$)0uCvѸjǩD<ù{-i?< toS[oй"UnQ!&)}M!5i:Xk^9x7֦fd3~ltS:lPIbϦQF> K:~OSߥE3qKBQH C^gTo0e7AS= 1Laݸ?F3l;cϳѲi*Ƒ[c?M".9VO3']pֳ&y- 0TyKaQ:mqw;h)nzx_RʻMmkFj5e<.l0Ic}Z;.u^HۊWuqTi\Ĺ\#ɪ-ڠh/E%Y\.^V+y%I"$M-Ōt$D3#u^ŝKPA8M^=ʇ;@HƲ0ΡYiU Dڠ/Xz8] h7#4M]JZ_ @%l7IOƦxw?[}tX\>KMJ)1 ԍ(G5n騱bW fl…MNկv4}}iu(%jSag&ֹ͊w*>kd4kf-oSk_ 2Lg`@bB: K@Y1G .-O`8Kv.+v jFOͶk S6}qb !5JǾxED!඿{!)`itlfѣ{Ws2|h wՑ zbɏ?g$Kը{)q!c+\dRL`DO*KO}0,@`H> f8J;D 6`2i%j 5 aÅ~MM@OpC7-*M04a.`S\K+NLgr0~ŬhM* ~]u47? ۭeP,4reۙx +5)Js oY"ܯp,bŃjLBl&.V2uj 0Kx t H^͔0l3wiC#0fʓX٢ ᠡdnBC9Gʠ6n%MmNHZ]m+CsVx/"N\`e `ȳ& zVc;yĭ['p4,VykF-8K|A׊EU*%6 Kctd"Z6uixVLQ߫hkXo K; . T ,ZYv S !16iVQgOԆ8뜗v8@)r@B(1#,,*]E?13i~VZ8m14#;\e<ICS7 /[ \񢦗g 龲KW^3DJ )sk~ڬ[[}!m`iG - z𱱲j)[KjqL`s6:lӠm.,u|nszgR4NjLY,0)쫥zY(%7D%C0jb b=æVj4Vb~zО4@e6n5A 励#{\]k5Ocӡw@ebp1 @ !Us)wS/%hWKjC5(c5yfB83[pR'6+#)|Vp-l+ZZ^4<>8}G)d ""vjL%O^sc ((9S,ۺ(v Y}l(r-wȯ]Ixmj_!@K#q RCB.@KQ^Θgo* + +({:jX]a$fڋ*jޥ6QF!/ ŷYj}Pm\1$TBQE#U^߀'GHTisf랦fBQzL/ӼZs |eT\+7sv[)"4&C[os( ZjlX.]j$[*ExS<^J(yXrSc`lC\"l%)=nHo:FLk@>x)/gpذn8/L%_ W|bjYH/i* /voeE"}\/ Pstߌ1ҳ4ꔓ2ηQb.}!q#g:3Tl`yX1/5 !smp%EXq)@3ÚIɝɷe uo(m w;ni3 c9MlP&cQC9Fea?BX”,<ٱmo2Mse|&0^ 6&sgc~A1ۂgIµJJ#w4tQza5*_f/2e{B>G Zi ->"n|f;羽R(>u״ba{"1y ~]\PBOĽ`ɫ;IBK>sr ěI6Ė~́cedmtSQ8i1HR+,jk46l "ET%PnCqbA01U"@nz XvO@׉pr:hySUVX^Y9b#6uʖoօPk`k~YgQ.Ix"e|A4M:9B@t-7zm}h^ֶ˘y &1A ~.IPVu\cy7a Tp#nlVϳ~8f1m )kajPpx6oVW5:f&]+t嬚5? 1/#LCQV9lW钧S6N& EYnȺV \<re ֩Ruڼ; O ~Z(n| c%Y `3OY>%{0׆xE;"S. lc-nW!+i+|H)nfu"ro7P$VP,`,=1\2]F_€hjaT*h(C>uҺ˴&!y)a| (8Lg|B;dgV\X]h7\GuZE;@|}ιJv6ViwNf{W.U/]jÊלAp6znktwߕ:U,;n`@_Gh%'ҽVR؟ʒLLàp(rQ K' 1oܔy+_r1 SG`>med-V ,1QOt P/eqS.@ N9E 4tXGRZ.;o( 6b&}Axe@W.Ck./\xFaHsC¸Krt1 +"9|U\{ ݙsz X*iImEN˕tq.Em ^)Ol h4Y4E`YR,X7[9~pDuḍD4e_3ֹ],Z0O+Q~ ЄS8HE8a*}Ӡ$0|x%j&~zOwh;vm+kdqWJ?+;-|թhӐk%SͽlSɡvn:|\Wo> stream x\Ks$qdWmca4V^61҇Z,M=[U3{GfU.<@>|~.7 B⯛awnQDzA]F9͝o=n.~di\XMl^jx ]9:4Z4oYSΤl\^0ť1rs-?°{7K#^*ox4 ި l5wjy[|F o`DžPuOΤAؘzHvoo~j~*# Tc=<:4cG͞*p ? ~NL'ty:tL'?p߾ lwBnrͨeÕQѧ6k8nM66502Oš.rAb7il<^T"b.nr\d1jpV8.+Ņ$pmJ ѥQpK5Qd~iܝaWLP5 a; rO͞>}ӞI!!3v‚Pq PuyG6~@2MT`|5s5e4eF؆n4=T̀<W#懷Kcj1c-(nw?\HTq%aAqJnMzBj#Sq׀I6Ⱥr=(n fğTcCn>Ilv5ex"f;D e/fᦂ<:"{w$-$r MVIأp3>E8gMҦ: .ĥсG>ٰ$NIbsxn ͦn~U!(m$ ("zC)v;/cbP(ŷ'USc5eA1`Q = ɮZ1=u{T0)k=sF'H/bKo46I|~Pl3(7A*y(=QHgCخQ { m=dt 7 KZϥ2XkW%)XYMRRLadV(P`Hǣ ֭ WصAzgӡ쾊:o-`d5^m7Z,Ra K]bKEn<8:%bOiM] iWNV౰CW2m:O- ÄJax5YTT6+3Xa5Nd0p9^pϛ HDd*xX*bdAʌ4wKM8Pg?J) ؕ7շJPjYBjPpqQ`DÞf߱vwz'Îu8Bgr2žK7|45Up HJ@d ˻!׫ ~`ÐƀȑK ]Pw7šiPUi!C}:^qh/43\~k~Б.W\ *% .& a5!Ҧ`"wG#tHA`Țj鹒1Ũ<>q'tp(G&arsFk13ڑUVƮXWwN ̹8/-T'{u\ƍq)[\+\h=}dDE imMv=/arߐ \yLnjZћ70K%g5|9#xMZE$JC%51Z|Nk_&9l-+PZGͦ\9 UoA54,`v^DzڱwáTTk`L6 YHSv8װzɮ:PΡjb+Xf t+nm˓5ՒĄoSn۪}:h?2 rQ*SκZzN*=I}?ǧMR 'cҶ.YC&RECK@> ;c}8ah\,@$AiP\r۠G&60DN-er$:QDCB{'\ST- i"Wn SRMM|Pij-X>0Ƨۂ¯% dWX&2?\5~|5q#~``V0(-KuIt0_Hl5MVRC~hr0!!Y ͡O+,RX:[][|@*.P0 O$&hu݆tP4KG)b#H}aNTmZ^Ki9ӱ?PUG; UV)8`7+eZ%ܿ4FG6]ޖpF[Oc>:M NF<4m)^H_@i, z54ɿT9T ++7sʓѕÔ{ꅮe|f+N9U4%ʉRij,! Ɣ/Ԃ@a4yy(_j~2Hˌӊl@Lɴcuh#/к"3su %ot{4)F8oHV\NwI_b 2gy!BP*G(@x(&V †)g;z4GX4|> j+ד?=eGRHa6S1xDjH8D Pbxi8#SK&l 4=ExT 190~2]L M>Idf2KSI50OLtV鞄9;S+f9X4nX)ԁbm:%hf?'8Tӵ/ܒ@-m.Gh+/8#թWiR%#hчSP]<07A4jT$nmWTT'<)&W!6 0;@ tf1h^9`;mRRĻu=Rl|,.\c70$ Rh tXI!97iտPEH"5(ϻcxT] _tQ=L˞Ni`ē(/+|K4 )Δ'&!^N%n3ʤu0Zb ĵ8߄".Y՟$͗uYtp |\ʪͣByXRX!T>؍.ThW\ʺMWTļr{e*+Q pBf[ʖ܏1έA 4\<"D2|e(dKwGt<;%{ïD%Ŝ4J.崁v|.LjXϝAʺkiVj}e8[%"~-Z$][ ̏%MrRJ:s.p#B%2<Щ0s ~asx v?) Bw|Ahep Պr^VS1>3=IlUvp,EݮᾸ,w|o1eaMbrljYu'= z^ ֱJ)2E\ XMhp>uw̍e"c M Y*!Nl1uP:%$f4Aϫ5UQ'p@1BPxQAW-PTIeV9٣THW0+j.Ӑ/p:|m*Ɣ7+PL *K7 ZL^Z+)` C ?5`$ݲ.Vlz/',!!$@ڜ76S[I4ٴްmkM֗L%L RU)=KU )*H'zq&0J39p4}gҤkA_ 3&Arr՛2WJJ Ta!9ྉH|QdP5)imT@U&WƗWb!)L&k9_"P.&8HbLw"g-nTBw:zx 3 Qx0Q@&`XPuoÔϨC纳oY/@n.OAR`7B4Ͽ/z->acyޕjQsHeoI%6* ?HZ.5" W\xP7'*L8t{,v3(,TNrv̳>ZhlH b U#gJPZzzSU?QEsN4o^ $Ѳ)ovfǏr2)-ݼD^'H,J#  8"bk-Fvçf~OwۀK) ;&tݧji@Law <.it |'ߥqgwe}²8;V.њ8R~O(6vW'(Gtơ%#IظK> stream x}W{TegKdX*>0QbI1i51@ ,oAvy]UW 16Ӛ4 F#mjx4Rrp=y4uI|_NI O-Mڲ<'>"7a[d;v&&d%F"*2!k,E֓ eB6p &KRJ^!ydy,'+H WHe.ui,q}bSqI`:Y]s!OXq.mDO)v{ ȨK|%X] q+CG) تhYQ!.BCͥzdE/B9La 70( D=0X$AB_ue7&!)#c!Zi=_~U(eaNaIV 6ڗ 9 P ]ЦmP)%cC+G.%a λG'S_t-"PjhaaaD 7az@U]'OН\Ta^NĩvI&&9o!G?)5NlO&et&hS ;#u='Co5ǗNYnccdzldyo x(]I@E` эxWyt /9__ i AEktIk"À) ++7W*㲮~'W-$P#钫ȎM[td]3՜nå,sÐוuXWCP{H뺾u>jTpiWg~ĊJmuT5 |liL`ɳ54b*(K_OȭNL.l^ԍGhN+t @,^m$]Cel66VXQ_~j͑rC(ށD/b(cb|sT" s iqL}}nD [=CC5gp;>e[ ;, &Md*.Uί>Ρ4f\ꃯ{^s,m 8> kp.%%"BF+6*U}(6j$`zhY )Y%|z̫_PxLi(TȦi| e+4Les4s6 2RWB{icn{jL08߁C!DhDx)٬6?--j({bPWnmmמc f; 3"CeƩ6"1뇰oMsmm5Q⢳WNvb]ֆnKdRz VEk:hpk'UBc{tvJoz襚DN7Ru4qGn m2aW5t2e$ǥ>.Wa1+KRM4q\zLqX.KUiE&8 b B`퇦ֳZtQ5!+ a;P)+6AzfljQnYAJtbQ.d)h7n]ړ1}\.6 XT`q[{HCrȺq\n`+3 Y-D՚s*甹sXc2 {!k:^~?KY^Dw DA2cE_t^0J8IW}+H#"f 15Yoh+,X?`9^oȄ,-/DףQ!fLȴ[l`VNzb-_oyAK@3\顟e!8OM1rjI30FefJ[`lp%rz)a 9Uy$1RgA0q`wQNZnl(5 2っ.iND7:B)t_G5NE3'Jņ은NK(efᑈv}$\ FUg͝Ga*E#=qַ,}f\0nsOv΁]yߚAO2R e/ܦO >6m=wNhE}V^?'44ėƦqE//YKCzIWR5|a䕤o{$>9A?Ŋ-$H :J_qђg5 oj++>cnSH,<xXRb2k(,_E~&dBޠwܥj(7C0NZq6$*|ěS;/ڒ 6%+7o"qF˜FtǠ'w׵)nݶrRQQw!@endstream endobj 274 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4948 >> stream xw\gYvf(2.,AgD5$&V{`)Hݳ ҕ^t,"*c bD&jL1׼ě=~0כ}g}vfy= E 3|ZxFyrmd h{zmzPk԰iӷ}vԜ? vlܴ' pqЖBxI=f8Q I-j ZF SCJj5ZM͠FPLʛEfSs\j:5zZ@ޥ&P.+NRNTwʙ^Z@-D)6)Zlf\RSm mj=>ìb`W}f?p\4ҩ={4|år5^齬 {hqz\@Q.F"cH^Sr~o$E>594;AQi郦p *D&)]4XN_!Tõt~z\T5MW9@DxT8\"zc, pJo@Lޣ2fF|e*M!85o b[Hmz< pI^{+ljx<&開C4h]2N>zh4N{L/37N'v<8|*400}_ a&VXqS A=$%'?ԮJlq6"Ked$QAe8 ++wֽ;yJځ <_= D8vwUU(%WJh+2~0LmV4@4hwMQ4DTH%/|uF˘+R#yD "]?B,m&V{VXSj%A) '⯚̜+%}hx@>;䞅x}ZЏ# 6.tId i w"Ba|v, &V{֞qSK4OIQnխ2K k3ߗggK*Ų,8Wܜ+Io"d1y4Cⱄا3T7&-UP & 2]OM'nfosB +N=||\j˩#U^mbemm/rNQ3[҇X`0?ҢtǀEQ `q50 6]ʚy&w#ttMTTz@>%pS 2{I/ςp2ꕚ;,5-z]LHe5Z"CC"֜'x g\7')=fB{v$4RحGK<lDWt;O^owAW@y x$,aH#q E6wza;3Ԇy]5OhHhl=!$7}j(a[Z>v-]iS| 3[Aa#T#cM(km6A=C EQ+MTJ+qڏ8;d&B,O֑)&:q T-MjL e@wdoetBWno#1 HdUXoXҗ tprTXpSrwV^EP{rV%qr))R) ߶8j#xMB;u.HiHO͝ ,2E/Yp&ӂ_Ӓ}%"Τϣp(=XnjD7G*h5"&I4E{M& ?GZ$?3m׋,&>ߕ uq+ OM^4z(ۗKj}I&a=}O(ķ|/OFDh guN֐oSWD,*S jm+GЁ9u j flobs ?|_ uR8&Oh1G6+t~^ms`@pr.b!oU^NJE}Ӕ(+a[喠E~s? cǟ=PYVoD~*[Xi:UcHEEΗ =7dPU"*}sAOKl< C9"дrҧ."b@gܝO :T{Df>66XesQP'-%M\2@%i{)ʛ`vp ט}%؍pS@:c`7qGu]3쇦޴yT(IRwJQZd'C8 U2f0AUzuQ'CXD4|}^'Ns4C4O Ag^@x0Tf,]L'GRkGu\#xEn+0>*Ez h1t03pRwk5HD:X?6A0 _rcr Ẽr,~d̻ak:07[rx)6# rV< +D' '' 7Pqܕ#QD:E3q Ї44io`7@zZ@޲.&c9#`4qB>VxK!0`` &fȐ jddg4Oӭ~Y;;FKaofv)I?iKLY:,p9N>T8#u Q9$UӄI {<f8[jO 9%U㵥NB%  RyzεuKodS)H!L,LƼ`É/}ߚI_ T˾cB5l3ofсNrH,PijtB\R>!f73hj>z J!*bSp`_dd6BLQgW Q=?/|Nw!-.o*=qz*c%V}|Kƍ[B-!GZjc]침=w Ļ7rF0djF<0Bc SÇ$G6Ys7,*/{ɰ M/gJeg2 󇺕p#E(P?"-#V׵O΄(eWcUJ)E$}{LR>6Ֆ҇%>ZA-M[n能 ~tztϮ=ɓad$/n4nh!!-wU6j )䏝j,щ)'/H(IL=Ĺ&0/:<:~d< EhClNtR>Rوd_>;ӯN΃ՇKOU&֯曎߀,`whh`a[6&}!ƐOIdHcwdAF[<='Ws k=VsSF>Yq" /n2WU]!HCCfDv%պP#& Y P?khD>7_UnP?Խd! X"CZաI!sbKuHyxnq>;%H>,Q. w0fdMƜ;O9kendstream endobj 275 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7830 >> stream xzw\, ;cCe\U3KޢQXbAE좂;"KYݳ^ c,Xsf~? jμ33ysYemED"n=j2wPMA܈w9u]WpOB[7ف 2/t~اls]hK<,g='L4yG?ǐ gt䇣F;/GQ(Gj B RQ˨)'j0B9SP+JjI VSj65ZK}B}H͡FQs5G-S "j"D){JFɩ>T_%hRΔ/Սl);ՃIQ,Ջ:P(eMEP/DVVߊ}-֋LiK~'SNS;eGY]/w ##Ƿ=b~~>}׽~~'ίUE_EwH/0ˀyN:0alP{g<"|Qic%h"!Ԫ(,bg-Cl@ZmӫL]N86d.I$p>t* ) 5޲}i5@/JZ]A+lPݛWBhw2D}} LX+^!6>5 RB(aC- \HU\;ub2Dl-xg~HD%y]қk)+=meF1#!(7 L$bZI> =$ǵV(HtɃ8SNVr\BOFS jIeU^R5Fz%"ғHOO&KC7l[ aCI}pN8pd샽7Rpg_Yċ}9}4n AC7o WT 2x(!"/1%xS=6mҟC2?=2u*$uk p BlP3Y }iumʛGSυbfBZTZ. |w2څGuE }sCcHS&%AL&,غڠh5[S :%+`/OPԛtd{qcU:(f0f{:\uce'[ի~*e/&gV%9z X}`n3zt%acҪס5v`PFVH_"GEW^0&=ƽUFVl|#C3sq+j˗wƭWei&WKal10>et;JH49Zݰn@y c$t0Ҩizw?mﻟħV ^22C[;wĤ8+~Cgoz (~j_*n4mRk*@zU\%aj{dmëʩ\e׷a74W~ >EEBXHIy:D qU mIJRGeU9 /oBHn:_܇ɪDPÓHHD{%(-۬4R h_&xJ$6*ݡک{]w!/i -tR8{9zgYp}T AW@pdz쇺2rW2pel6cx0UK:={Y.!bĘVFhL$CAnm"YВs!ON7B>S-?$<4ץӧ8-L/xToբÁFV]|$bif,4I* 7`V݋qݦ W₝OoPt2اfZ*]TVb^%~-]'}Lh"9Nr2RnEvu2`'+BFXDe< Y5wڮI^Z93tK`zEB':J$qsC:Kfd^N5BX>1Np[XX n;C}A31X-1cғ0"=I_"Q\r)LyInVtwhy"7<7a8|Jdq%p$sScх+%䝉#}\?oyg Grpܽt=]ZQ +ssJx C !I &$?*{3.Nj]soxNւJdȷ48FcW~{X/ai|*B RҘR;{n {V iAL *MK56B3 FwS"zGlw>qFpcf=]jVT.!AC5$CiAq\YYTUR kHVf{NL~fQZ)GfJ ZA1!ng,ҚEn[̏Dr gos?5R j[;lM(zaoSYBoҠ4{k 1P ]Z9+[.$)PsWqx7<~tA!C$ ´[!j#i4 ߴjM#h2`Gב&\ =VFC() Ő{N.'}5:XDl֣%->-џ&6ؚa ȼVl{cX1mI @ZQma2$Uji0{skY~٢qGﲴm)(}JJ. r+>Lb _vY.o_n?'0(mx߃U3b 3ml:^"C\edM֤B|(o\Kl-I=Ȉ́Z6  HNumf!OKB vweI$+<7䶂: kFoenwiX넧(mg{qL~F#xrfUqMBu_~TuJD!Q&|0֕,{H,G*a:sd.+p L#=a5lM=LXv|Y1Ck0hʶ$W%W52?,g+߼B#0U/=㖈TNG%y'ZHP3 )I)Y-_agW\֞Ia@iw{LvMC{MXȎzZΕј=ꎖ5nSØ3܆CH/җHI )Ff $uRX {:O {Nq@!s =`80p~$"2)I[$1A/jc3.dނ`MBɘѤQ{Xp9pgrGi8i8~"4 2,vK It8U uMJ"31hf9=jzu\VL}iRN0_懖߸m^븅#[3i0/7]~i,M*urYZT_ ݧUn; ;0\^E<Ѧݖ<gDžxWFB>fK&~Δr4~vgn_zUy oP>N:t,+#a=\#pN#sjl-paXN^+}/D_q`+ . + *+-9q!}Jkti8$/ uph0>0ڝp \e&{q|4+.CVϝ0>EǶy3}D҉tbʍ[:S\8X_Q>5Y9hH+323Y`0R3Hݕ"׶E"%Y+rN8m['8vƌ?NxlF75쾘bՄMfvKcZ ;LmA ZbPWD> -9,)uVnP,wwo8<_LD=u 8ʣ޻ %: H{J?e\p`{{kAڲ -JfR_;qLa\wQz8 , 7 Kr/9\EO.+<ãbU*Nh-7&W}q"R&-19Q9i:X沷“:>Pw= hKG܍3;yu$*v\.V"0-t;IlΑ?&5ِc16A m98bcQ%%Ԡ)P<rdMz莄R3~Y(Ze1o}GEkf{dy!4Z!h5eMF¶=κؐbUHƫ<4M#IUD?NbP"7q } -UAJA"oRpkpffq7SZHjGDHsoćl>~+Ӟ$r\WP3*v=ᜍ0CJ,WPqqI; T/r( X3p)m+1(!2pKmIk`J{٢bcg&FC2r33 )9hE -"6u)I?N03uiH8}ᖖUɾ܂̤l)̀;/uͰ

s~;_;{wgJ$ bw$χP`<ɋ8 s'%[b#`(n,(+| 02Y^VO],'^2q fZޖ!JOL"#L. o ,[q*f=5ӽ۪bcՑu7x2ttfiڭ m6X-24(Ia㌂[v3u~QF}?Ehw?sY>.,J, kbHS[>sm[m|hr,1h&8>rгy)QKP-t8's_-bYlfݥu[v9-;30+ K?v4O:#C:};S%T[[."N qlEݦˇ+̅ѳYlmV3y;%]# T*"~s_fM\0Chvda"Cz[ȅ~lYmgjf_VQw҅lܿk'Noiiz|׮ZHCendstream endobj 276 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 327 >> stream x<LMSans10-RegularV  CR$3~~߸nwnxikhiJPb]uՋ֋ֹ֡ƴƮ̋|ymlklkk3:cPJMEk0..0FJc㋮vZҋ#J2PwDKP $$PDuPW  To U endstream endobj 277 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5695 >> stream xYyx44 EH#8Eԣ){Y +]ҍ&i4I4|d_iӽiKWvhAʢ ʹzG7qz/I[G<<3}`B03aڍٙYOΟ2/>#-1T6@\(¸QSEQ:>,Y4e9,"h8~$aMA¤uɑ֧nL۔%ܜ9s0lMcbǰ&, mfa['hl6{`˰6l[6V`+*)l54[aSqؽX`lVys+$: 5?x~ _5{֌|axz0~)PC]~5V1m~fs:p/7V4눸ORHA(ǽM)28h'B5nvשRe&# >*#SA"wMC'ک6-.$WP)Mujhح10NVstCbi UNά :G:ރF)(߶gGJ Ѵ8Hq4SXW:6|fzRH)VJ.a4R [Q)Rm ܽ`h*=xcEkwcedqU"|gcʑ/,3v+ oPxnY͇VZfGa o ןg9{'UDn )ie$;e[QE`v('G<4 F#3 cy;h{ZA]sDdطOwM|<Í*ٖk6t(P%VԻJZɎIY8<͸0G7{Db(/0vݩ?':Q!"7 #ylDv۴撌4 DqApPw)d*;N%O|γo ZWGa/+/xGд/:DR`vA-5FN Zؚ h1=Ex@ElO\+B| ΫpURy^i*#ՅfeRT%؅x)tkR bZwGY?j , 6;!bA*j:9$2$5?:V6 F.z..}o&07Q](jd~뺠+oϊ?{NrSq5ldM໡l˨h18Uq:K#^fX xlɁH[ tܼTvfXm2a7N'{2GD^{)DO:qܼ_+;]g4b6:>]*:|0"CM L8:p|\ښ):أJ/Q V{ =d짺K1q#(/;|e8^?+/7/تݴDxĎެ8zFe\n%đ>4!_D]97B v JO Nk.^8R (fwKl\ Z1`VW/vbĉ7Dc kvgow&ȓѲO(V-Lxi>y܇h94Ě,uJGld%ldE-mVnanȁ4[ZT^wsgWwi8z<Ѕq\k;CN+r!,XthGI*!᫄k|t1?S?tuW4d-.:/U%DAnpͭE`38 P[f(<"aPfL*IٿG bk1W{ѣDc[,EJ LR{ D3PMm&O=4]2E?y:&)pqֹF^; \dnWVT6?͖ yCCl&o^]d|* `5uE\QzҾCGZ;+GۋЮ}4u&9@D4jICARJ"fz$ʎJ1sSHtg ef0ov5@9^-u$ͦ螴׾ۿ $|ˤ~7*^TK.9 ?B_8 8Γ8\4:uW<tGxQL97~#7p7"[${?/(P_ ĜtV]MX@X(ks ~-0.t rrQWb*G1Xj`Z̘'c<3wtIvBchJ>9s23~W% bŁV=-7TPڪchzSG;PF5DR)!_7W\b\L|MuP* (*,QHbMQۗW4&`'-{$~:s?26eZ~}x,$ ܥ7ExݔX!2=KS5lԑZM2`8ݧӽ K ZbCWL\o#'@@QJ lE*~wQϸ‘pȠ+L=􇗟?I7pe\= ETˢ[sW㠵5Û-p]]g˟ZWD6Mdl;h*ځv|!Ve*`o=T7?]d h?xޫďW^CgqI 5 rԄ ][p<{yp|2A#ҊS@ Zi6B+pHssũE]VbC?U8FL^ Zdpo uniflJey]]^es| d1-kC~{GP !6A\4+ygjR$pv"o5W.^@pD1ӂ;eYGfF0 %-y*KKȚrgGٙ#G\rg1Qv qG"A1d@檆 ]]!KJ(wxKHQ4_%\Bu841Շɺv~d?7Cudב+RS33v N(Ejw&#]`ljov}G}?)@&O|,R9EnfI5ӵt=Iט@5LݷMkot@Ii**bʏdׯ*Eo_t*m";2z ]kFavAysfVL^3xPfVc x?5}DtïM.'3{* ϣMFx%횛*)P[ y{Yj xLYVbARmBV􄉘pʯ.e rQSK.}2{Q =[rrzNĜa/5y [OlX[zYOIJ7)%D즤7_1Ag9xvto˩B4QYx_(pʜKWcn,\$M֩PYktշ8&".zM̘o^CgcMP&8-۹Bԝ>x1`2=k2{_A)Bc0$MqVajlWxI)yy?9hY`l*7 `blDxi1hp h h0 GaHc5ƫZ+iMb[Ijr!E ̽i% UN%E<)d)ȦKMPtAfox6W#[+r=S Fq#]Io>:S(* xh0j07הUW7Nw:&2^] XY_%.>1ظR*M-3'|؂iAFE;;Jϋ`ԠdBP_v8〯$|e@|`bB2) )d˄ Y#b03~ߎ:{A)`]&!.z43!ÙC09nahL qnK5PJl[I0H鵥b(liuMT-;?3#]C`V._o]PcyΝb7"a[zګUtlE9,] u~}&GOD8']G>iu0=3}wea}ǯVe֧e3ōmHtKn-标P#_%,20&RDGb='X2xkYdz=h219`}2/T6%"{ E\.;o sS5rLzG\)J4݋5 "Or>F.LI<1@[ӔJlPI(@F(dqdb}+Rb(+2sx8ۨoE4}2'c,|K3**{m0*Lq0endstream endobj 278 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7613 >> stream xzwXTrrdP9v5jl FQPQEEJz+bo؂ePFMLbb4M['w{f?f~zߵ2؈d65ͮnA^{u%P6&0TCbG##)g*w[o6p]upȞ* {mmt}w&7xynvX &.d)˦._7,s7g9ϞV\5zZLM6Q)fj*FQS[7({j:@mVQ3;ԛ#EP)+jzZGYS(j>Z@mRFj52eNɩ1152Q4JA@ S j5ZN VPé5EL]K9QQ`D(c*deF0r2#(7~8DnHi ObtfOR4bhްMÎ=n=mć#g6ƴʊxOcœ &O5ᇉ&31}ҘIޓ2'3e<<4\/ZiBߕK M&Ee&AaR2Z>dXwR w?e5nB/&d^5P&LA@6(CةӚ hƞrf1i۩eT<+@^~^uP$!#GA/g\Cx]S潩'wZz%m-іA[35AH X&hREa^P-&SWTjhn7^uP,T8sRjD]  V @9ڛ/ 3fCb߈!{(r VKyLuBP߭>894&7 o z:?p~UPIq6 ӬWMt'h쪈\rC/GzI(~7єfZXZ>|>e3.UEk츈Eeܡ >%.YN7u]K&`ZB@AQޡ1|JD{4 1Clz4&cp42_w=ӝkq@uZ"tg1 ;BƔ"?᩻?Ʌ>Tl 0(;d3جY<_^vk󽨒=LKx p:1KBU:.4=@MGF9?CROI1'}Y-ʥĎkpQBCws6mOIX2htl[u@<z@KZ],ΕFs/]gVX -:L<#I'.aފT`)\ 0T/z~ w: LUtXw}EsB{P4u 4kt(;EM"|eΑ¥!\EEևn+O+#ϲIG->0^PR LUEI}fgljgD)%pCj7KF-8 XK8_W陹@铱1u-}Qkš{AԇC@:>wt0dibٿ=W qE=ǜ[eI~KM[v9yA8O"։r)&]$Cy"Ǝ;Y)o~G7 U*eE9fDM{CN&c5 1!WO6UWAb.STCsO|()Wa|@`VZcqdc.>%;n|~LeODtRj!%umM8wt}[?!1I(~5i),+ gRnj zl[K<>#!?q"gwzj*l}WCVB(6p$5Rh\"խ&Ԁ>B* ke51nKd ɠ~Sh"# 4 pܠ~W5Ѩ / T@%C5B~lQxQ++)M ' :4@ϽB;\4I"F1O aRihn%z+#0=82mSMQz3Ƞ2(6H/ɨ]ʦ^iJ9LKqod)ʻ2!MCFSV)\`>Z kɈ0an֙|g-ΧPYO!x_(9AX[ڿn)wՁ[-5FQ%D;#tiMكҾ%m[c},.Eڐ^#M̘FFlTPyY-'r.p :s'3}uJ\rk n 6 9ENVD[PU'y\lau-~saWF]O};g 7<[lW,`# 'rZX KWOW-?Ωb'я>&>)w_kEuIC٠d}KRd|F< O=q`5~ ~&F^Boo7L"%]3cGRRU[ST~{oXԣX%2*:<6{ F1lHK'X=f5|ίxr<^V-`q qiQE ;1:( @FZQF^zv`K`Z@SlcXCeAMF&`u|0YGfgg{]ۙWOtN{)B8gӦY:]Rז}`^OKӨ/B4c_p-ީ|\0_8{&VQ|r1_|Ld'[=- `3lܳԻ!007k>8*O9;v=?iG_{Z%ZiGOddN2l ;L*_ߠ _ߪf69%yn*t9~0{yْ2V8\l?ŧ'T(JCǻn-p--\wMↄ/BqؽicF^~O}Բ2Ϟ(UUVQK.[~ d>zݠq ֈfdIVt_7iW?^>I4fK|x6vpx5_:ɐ?E8k`ULsͻ*ZI?6D+%cK6c/8&YM&86LޭvP* (??{ClCQ}3Z+%keERh$:-=mN67OY/i2W<Cُ_Pjk׆15i5Pt޸Y ieūzEѣtBI(sTžRc)M,Ɇ #F |&ᛸJ{,- T"Cx[.dƺ$$2 A!h\x.3M]ZӢI{0S UbM\LMhHgj| 8G#nEK?|^GCJxiٗZ=fTUoũwqaLR#Q5]SMЪ{ El ȋs/HI Ô :[@%SMH`B* nc9RG5N%G1]嵿ɯhms3O۳Rյ[hE-]vߗdJ=.K%FA$X\_YSGdpߦW^λ*Q` Ye^ P8eTE\ˁj!4$-iעk+dCsԖG8p!ۜg.;\m6Q|y 1[W7?|VWUD\B:™ҪﯠE8;qR㷎9JWG:v8gؖG=Q+( WE%5I1)o* /.yim~7۷diٶ…x%p*ߨ(UeMe.<==?}p7GDghh]ժX5O q2Ȝx*bSs))/I8Zk fuu6p~ǖfh)2W W{,8hYr3OufY%}Ӵ[*7qqOIU.n;_:r/Qv ? ($9"a?-l8W{(iox_q}Kĥːð'kuuUIønj`bn֟/8wI/( dX#j_flip]&rA͓z?ELVɿ(pwo镗tQ zu cT&kb WE vgxTRLrh"SmWЈ7Y-={ A?&}`4X{Ck B翳,][(vi>(>"2'_a gZVQ]\[ehrgD<&%]l4#FxƟ+6U>G^!/:N_> 2$\\&'43@'N2T@-O);4]Cd„[ pp$$xפ u(KNʐ% K>'ߏ?LYM_7\Cd(ʥ=ֱ*!**w]J O N_ƿ,D|9KF?pCJEXXad.}D36Y:U<ّ/~q}qЩp2xK 06/>{}`kG6%$\g392(?k\S&*84ېL?x' ȧx0d{ ♲bp#SR^'U|^,h40p)>1\_]BGw pW4c} RMG ]ʣV](!/9on{v炛w ?-esR-,潼[6ٻ"L?0(s4":$/!DEa> stream xZKsF=uo J~(bl1a"[ U)x w} Ă_9?]󋃧gF/gx g ,.6|uSEcjWö+=qe>U{cqg0󬪵N|fZ)ٲznu[tƦqnKHLKs g۸48PYd-je6kUt,h .(n<|j ]{{<3j fSI.\|mi Y2#xxnx#cMQW !wXze70_\:F,7m3+˂wpW-bsI  .]LGp͸Å"0.-ݑ {TҲ˂b;~ JUx&-hiPPXQ.䒖jN5M[,]ݣP/ Jx ^Pљ`+vYit1NrPgI<řRdQB1m6‴оO4Lnʼj|>dQ#iP%8&ft=5IngPn)TZ$Fs_kqr&w dޕGG`~SQ!@sٯ/G˒u!A?w3n.B 8*cXzP [m [j!l9sV̐pN[uLj[cI34e'bPŒH!܀$d`6hYL`l pô*yJ{x s(gсY'S]MT*"pGU-=*# oOjY1<@ߦAKd#@NwC#?t9hU#Qyg <ˁ.~=bKsJ8GÂ&DMi#sS[9F`B3IL^Ѣ^\3CFCb>Dɴ +$SޢW;|gOfguUNten& u; i܏JJJ:ST bܞ"Ujh4ju/~ IT gt$4(R`43m)"~X,YFrQs" .ąZr^qѨBqF^N%-s,s[gEfP<Bh MyZ1X͔f`dprf^tX:>ʌ )x8REu:sy%z<'gZ9_K 'dhP}Up|A )hҐSG.(xQW9*800pvz( * zL,;3]v}o=6aXNM1pQ쪠?G,9u 2{P_F$b䆾mT2 4 iӋɘ)cRQ硫J?tQ3W4ݷT17;} #\P%OMlsѥpe6v~ȶ&A,1Bܥ<}Nmt5m[ êTn[?b_2}vučhMgh5/7"1~[#QB)73TcR ǀ. tTs.)fU@! ]Ǹ6)iY,Jy#C:.31xwS49)8ָez̃ 3/),\OA9J[9J &G b4nz &m1=UBaz^u$gvcʁ+hׄKzZo<#<IHzm.IcS*g:+CNˎ 6r+4Μ:jc bVn tLX M 4tFIa2YJF&|죏Qx+n,ͬQiX@'CQo \tݳ^Y8])P+R|N|λ"v Ad7Wvw╇2/h@<3rr5 rCD(T{Du nw>oi$MFLI}r mCx7HP&FKyf:AXhV!ƒUs ٫4}c*x[>-C2}z+8)Zd ! AZ\)CH[t@gTo&70Q[24Req88ZJ&jJUbW66ˎ\diMLv5) {;y' s|n̰m[(y3,&=Y0kWUĦV@Y1E sĴfgb*O9{)Hq]F<ãH~^OAv$|jjXEشpށI+ PdOLI+OykL m,2ӼQfdBKۥ V6qo?O -Za`EMKC]{.ܻ[7X1_2U8F< J!yTJcs(ěKQF$Lw߉D z!=)قDݍ+YoM2&}1@/%mJ'4y7#|b|`dp(\X[A@c=m$9_@cb "B@>ECZxZvys*E77E{Rk,"z#_6s,g֕+ADVf4V)$9ՙk$caY9bkvbdUPNh7]3f)&6{K}Df~+cZܪ)vP +y2<&ZS(cڇG O "\RP`Wq@ح3 NʹEb9lO!ҧ" S20TT5t98.s 9슪TFz@ֻ:2rlg3kD./U`ς"qC q53-xEkgʒ0oH*%T{f$搯迮g{cVh1T7]_ P Qq TEF9)Mx+[vT>U/(rcAXGNT&Y80n)/"'.=ֈ~4}YHg$;1endstream endobj 280 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 953 >> stream xmoLuWz ;H $1Y lo)#Lw m-q- ]wmiX0L* [v_l0.Ġ&( 39-}'O>0 ]z1ǫ{tݻ zGZ|m 0s:k%s)ca#k!%rrbb2I;Yad4TS*TSYÝr1޷ Mq)1,J_eizS# l!'K+7,Ŕl\o}Fh~O1XoM{ViP+N􏻐ϻ1DUֺ֚jqxN '#jWG5s('#rɲL@[Er Ɨj45š@%T:O5,knä_v2|rhh9cM0SxgpKzT,kgUF56Jܹs ' VArNETs ,c%mDNq)qa-eݰ"lğY6Y#3:Aܪ$ =m48{跃=desnZpߤ;yt/8 ݱH};cW/!:̃NN_]SVVe=A }r{o5B37Mp Z1lygẖ.nntxosGUP,"lHl *~`=Aϒﲃ3ϫ⮎, ! xt}RX|ɞ(x8Xt͏}Fj2|ڂ^1vA;Ȓ LlVŪDSpO՛SJ8t2 h2Mendstream endobj 281 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2445 >> stream x{Tw' GjQF2۪U[Gk]]Zl}hKAD@G&GCpx**j[[KuOZP֮[램{vΟs S2,rI $]YOŤI`HdۏX%Q "0"ؾqTcuKӗ-geVƤm.IQk:j 8HRLjM͡^R) 5zDNɨ.{VOS, iUr:ga1#T:ȣ DI)ۏc#Y4%n=8pM[Էqj]zX WAɼY{()._QH h8wW)ƿrpl'y{Z5҂2\,"C8֊|xU~z xrdfDN:ޔ:gNmJ &l6r`7 RſjQC,thU&FKP?Nǃ|q͆|3h&Li_&9qʇ" 2pQ DhCC_2Nӽ ͉cm%eoZOu10xM)Lg)8(CmFS9%d-xL&c4^o9(gYT&f >ab'8%z P-Zp -lհ rA\tΊZCCf?otqY+I ,Wmm[5@j>[\`zpIm>Qp?k.>D\7zqsJ=n4.ّhQݍ'.QI&"R=:b5[H2+cpsO`(.);ŽdƢ#+rYR恳axCf}ӓ'S V]'bՍ6C2*tᆂ&]!szT,?#waZ&v.{̈́QO7H*?SY6`y! `+!}#8olճ#V9(~]` X](vsRNĿ˅|88Kaaxϐ\Аo:#hur*3>\I>">r9PVhӔP# '=}6h? KD6e &|GT^f+r*R@@nhJb;kjjpބ͗Py)z#tJMMa/$1hy6 V/bI|֪ߞܬ]fmIJUM /]f4 sخu]Mv% _Õ ]-CP1ZF> W"2dT {ƌd`X Tr2w7y pMd3'GR>0aŋKNo?&0)C on]W'P?xƏbF]x ns;6n'(ޒͰ9#u4k$iK ܆`I TZ6u@jCNQ^((ەO|aY8/m?I(~2,T?pHpKaӇ"<cr5Ӂҳ:&Ē /ʾR3;Q/-F&lL3g;!3 s[H6endstream endobj 282 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 220 >> stream x.LMSans10-ObliquebJ  ?R3gvuҜ1#(J2 |D>P $$P|DuPW  To Œ Wendstream endobj 283 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2088 >> stream x{lSǯcl~t!fqK@]Ԣn*h/B Gh@ /#1~?}k;v5B*@-i:iC[U244M9HiED"ի+յo+^L={+UnjbY~ P~_/}4=?:ԯ*IYѻjO dTW,>8$W`PLV&֬/v Koɿ&{#vzh/%GQwVDzӀcbAj᱃99;bqLTdZ hKK"M{BYB6#/「swYil&_(&A|K'0u&O*]c@l/^z{C'vAJK,Jt5>Or#0(H@SlZTp2 ^*=`M׈txA~a.\J&ɡ{+@z+h #N2k8#KγVGL-vf-H& i~ZV&疷5<0$qjߟNM!ilvjUІ:Cp vHݺMj1hzQ*X-~iU gǯ 92\3\5QJ$I,/$'?ýW;N ,%`a&D3AE-SOο/x6)?].ïi@2Mu7CX)k7b6!}Dq"n~a#Ж6qZ.2W&)ϼJ@;E)}X^x{^<#\NL/<DO w7$x! q H3adJv/(⑼LףniimE:S$?ԯkGR#߄ f/qtadKY8z/3ytpP4vBZsXP#x>_s0W9.n,=)zԍFm3ɤ3d—phЖ7& .tP$TfWU69CtAhoQ5i>~znxN9qD>׬W/NY29yV]F|vv d|=~Ct::"A<4%>:湠)L? K7t2X0 ZUF`[&AQv{agB_O^4\6fQ|#Jkkm::324`P)MsiYod$ :va=@vS8W^=dn_F0 ` ^RE>ljHO7=Լ_l`l]١vVng^_k\ 'j?7fYj<kҥցr ;sK@~nJQDY\f>sbi ;Ցz%z0$Dz ֳ5 n>g%BP7 rᡱoM\> stream xU]HSqgg;)!}HdlEExGXY[jnmQPȆn2c՝4HB2=/cts<0 cx)V֣tZ@U2(fKS,>G _0׎J4jX R4B+#&ėG愬[3N'q(dƃ@1!r+M1A(D"&pϺPWF] ^*eN()H7ERpPGa^ń&j܈<IH< i Y7.Ӛr+̍ܽ:v84@q~c1Ruஒc ?Įv~P|85>a=컸nvzmk[iH94}C\\iUt9CR$uHN#/:endstream endobj 285 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 815 >> stream xM_hSg/'rLB N9-]ovD62TB:ƥHtkeڤS]YSgڂA= ݘc o֭(c&y:?xJB)]Ѻ};xpW_WS~NρXb§%*p2XXPJZVV8<]{ xQ{6FǢ0^oaxX K'tR͂qnt:NsU-Αwu`i%!G<"ar>b~3dyn "8_ld* KQOl+2e %`B VcM#P]\D)Q&@F -<9.8 rW;:OOOU 7Z*ks;#OfZ'mQX:qՅ¶_G8p2` 'nJ,&| *q9l3em|H+Jg> stream xcd`ab`ddM,p(I+34 JM/I,JvaeB_``bd*H,JIM+IL23@&FvfFFKg< Le}9w ? e~7vwvqݼYӧgؔ)SkBkTz][im֟?{<- sDRm{]hkln~joEST՚T 5S+XG75uwws4O0Љ>~=ݣ{1_*~Oau[%$sI={&j}endstream endobj 287 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 790 >> stream x]{HQocoa$=hj=(R9|VfVk3mZas|eQBOփ ((|G4*q)-=t͘9-#{[ap`PAsDsSOܝd蜮l!+J%"F* n6PPիE$:< )rC.(~xs%{ll8m^c,%4a5 ~~[,﬿E|)rMZހ<2)o YXZ'/LMMmwσd_|LJg9rlo f.عzpUgyz}r>aн DI_^Ple-[ c9Lp0As σ[V~l/ihq@A0צ+irG?t,"W/eȇL`Kk'dK=m{#JʺptYRCQIV[@.{[=XB]z懖T ڎ؟zf_}]ЅEs$=͹%BGJ`xǛ:p>y232|6ޒ>=McQQ"8!#KGı=\ƒEJClc,u֌iyZ)jcX!Fe>|վ` 'ݴVendstream endobj 288 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 253 >> stream x LMRoman8-Regularq-  `2@M_qGlwYx?{F‹ 'P <02ZjYΤ<7#B? rvCo  To \aDendstream endobj 289 0 obj << /Filter /FlateDecode /Length 3888 >> stream xZ[sƱ~8oq" ~QU*%QlGRr*eRrI]0H,Rl ;FO_wϿg.} ,7_^83 N3i͜q,(3;] GM?.3nLC_JIS8((|qppxbt4)f|vzvUWbV+ügn+N{^xYUk)X ڱ57 ϊf+'xcip5 Fxm׌Ip  5Qam+==qe*@KoI7٢}WI kϪQnn44lP<%5<ńˇisu~PLhVZ+I==U-- k`4[;hQT-fBY-3:ȨZ:a|R ti#ِyn_mL+%O4cK4QCn/N1_Mv"$C7f1 G4|N-hyHQ_xi>F3izj,Pn>hǁUBYtVI7Eˇ,2(%F9a',= ݟi6FdCEi?\Y!ԳDQ)}.8L' < 'r#`NYt&G*YS& Y,= o`,@&OH(0Cw8BY7qs~^ZE>n$҅s"8?xC' Nq4n1 4 ۠<2}%$ "U ll`3|!f r_)w uMz|Fwz2`XrL9DI$L Q0eJItK]NMmxoOcWlZ̴ K#XǛ燇wcsvn bG,8A :DYEbm&1žPbr!酄W uzVNW]e3 UM~jձL]F!&gayHPWv4h@<$P831Љ<5˶<e&]d%9c?g2]4cc3PSۢnWrt1ފ]yܒ$bKc7jL4xv.'Q<>Qmb.p*-leX.*򦰸ңꠘzdQ];i,?spY?n1b>8AQB4TWVZJ ~|J8&M2D/XU[)9@Q8cyHG^o&ԣD0C;ݴQL:+enG'/ޥcM$G͗; 3T0,a5 RIQGH CDᣦ_a/og'-4k&7nHPXNO|9^,/- ILĸ}1|Z QWP{"O~`D&O,L xیU3dyrW #.uk$q)o4d V2"_z1#NT6LoObϫ`_yrTALIE FBH"KhcZ,$1Bb4WnZqvJEQ׈BqU)) s8ʱ7"Ov-RЛ`OgN OC`HR0TI\< Cy eS!>_{Fo *KySVmw} u-x}Vk(;c|Ēp|-S{99ɟvؿi{C'S0/Wy}eݬ9B=zQM/L*+4Eo zH}G PjoOlC6O}D{|°`5pfbq:06h= !I¯A|v㨟rW[}dڸaP67].(ohT&ՈW:]!YlB)"VQI6@]`ŮJF&Y?Y־\ЬVpT6§OL Ze4pK#}ya}'cx'ٍrYU(h]VwIBw)bIə2/ouʯdq7<AjkʯgMWɦa}ssEK_&YLySqڶwdZTCPWj7.IQq0u -x#NNTੁ)g7}[Z Lnx nzϏ:m.&nuu_R+Es\<"K%av%uV )5^3.W LE-s'|ƾOںd_^M3!r&f1]:D3~^DTcw@)j3ܟ㍜GtiqO=*f`Jnz(]u1U˱ GtfՖTDƅAԏ# W̾2r:1]"CA^o[9g?n7wendstream endobj 290 0 obj << /Filter /FlateDecode /Length 4329 >> stream x[Yq~  -vnއ|Z{WZAܱ_8~(N7gkYEU9 w#"33k򈌌㋣\oo7߮շ7_ѲfqH_zBX+<&//*pfx령Bg?wTljf4α_o`"OW5c`ѩ-9($V붇ꏇP e?WȘaVR*zxj61$>o,k`;䵐zFLጭo3e`qH,H_N9<k G9[O7X6Bp(fOx|XiTv#T@Tgw9$b{y)v,YDvcbP1ݏ ^/Z;~Zg(b}7݂JŚʁ*8:dm6Ǧ}ƾ.XXƯAVA1H`Kak>NL'G=ܡJ Eyt|plcYD0'j*BzҙRm?PyGsCJ ,1LTt{fJ۟7ꦜeJ.L^hE*Q\>=SLp̻V~( z,6W]Wg$&DLÉ_7w:1-LVW6!D  _&t@eJhYydD7Hf|V^P:*Rm=y :$jܧK^9#DhgyYImr$3}[{ ..XT[rRsiB^? M^ׄ4öp0Cx N`UMi@gkc=t&ߔ#y-$aƆ|kSnZ;JlV!T&Cgεݷ{(37D )7YkާezFQV<%atBYjڈ^7{(uT\p (K-{Å1}w2oNbo{/ 깳I|Ϡ*H\q3ArO4KV6-G#1|VC}o*"n<9>b&P{G~"|Tc2#Jm3_y̅'3 n #{< FO{BCn(HJ΋`XWt4f3 F.w0s!-a~36b+T /s0z|*8Z ,<ɠ=,gv;yY|Ӗ mleB|nsk,N RMRJ?'a^ArCq*\E)HdOYwsL͕N%v-L]3_0f9c<@Qr~$QdQrFda .]K+y;_ofm}ېa#c%+ebT2j XsמYr)m+C:{?o`mZ)qIՔ2 E<5*,8c*ya1sh9 0ZkX+1#WVf )Km /- Uf -L&/ʞCOډ5fiμ$t37 h~nE]2" ]CoBbBK(-+"`wǃП($c[`l>Rb΁U)7OF^.|RYja!i CJڵ7s Jhwq an}@ p1/<>(4x`7KvB8Ҝ"Tޟ1HAO5ʙY-5#ZҩP@Z ӬdIH'{6Ծ_a2%׆_:ɕ+Hkz%Rrd̯\y}2 h03^]v5m(ȳ9K #N{RHnx֡#x /ƅi2PsL5 zʟt,u1_z&;6w-cNbl(ozXVϬ{)Wp_لB[+e>w l~&!M9iŚ6'"ŧ5xI\B~8SIHө "Q\g{ cS3L,ς.uX1XT8na3 Q6SMKԾzѴSPS5`u׻ R ?5/U%=|>Ck>okVAs].V O GEUal >25mX~Kf>+I"ťRk3X rW8$WBnR =y"r r^e^pN&Qm=7g=%/ִn`&yo({JsUƗjR|f2Λ,ڥ4\#լC!-Ԫ6,N"rfNy 1<֕eؚ<5}F dwTIb wvv*o8s:*%>A> stream x}K]޾7ws#ZnYXbbHKZH"[;:2H$8='}{zz?/_|nÛW?o}t9^Sk:ưV7WP_~:'Sm%ͻ-㛿\7Wă w)9~CHn:"?Ɵio4|"[@Ovȱ=ʴ{H|Xt`%r>s eKNj3Џ%w=Ѡ>⥄j[W2W aS[=RY{` mx(>߱f,g~cy4~ E&/{0# |#dI svF 9pN>xuhؠ`FC5gcξhzb$-[ /EH7؊|J˝6z5V厛d,u)x ŧʾ"vGZ!K4CY b0 G֙ X1V<IzCN0mZE䡼oK4al3gZM3wLfc|i90hG172@!&ǧFc틳)c@c2cH2x<[/s$ FiaY5E@,5@STLaΎ1WJrM.{Phw x)Әw÷ּ-\Om YpP#XsNm|p{ @2>} +g 沖)'/فPhF[jc][v Et>R-ռ&b*4Rt1]BAFpJ5CY'}t`p3%bіD xyJx0vYK?%QT|QZޗ Oŗ$Na 6xH'Q.֏i8^̷Jݓm$Ho.+#^RSVhN(,gE"4ej\񼪙DlO1sp<<1Sa*4IVrhl q Hת!x EGgi(ZlY-gv5T BN)ń'j,O+1VzeUs2a+{HEP`b> J-qVODa]QBC]aYKұ).+u'B( L`Q().SCBJ%&]& K@jyږSv0/am%Ho[!#XV, 2xF67yV/B4lWY ۗ 'q*:Vn} 6*/&Įpie6*uNQuN|%V1}iM jCJ5⁃DJGDSGD\GJsjN%aٞswX3aMe59B!soB#5RSȔ%16UϤ=r!RH5<)BɣD C.މ-#1䈡JKzR$چcXrCP=]xPB܆@(0P(>ZueSS7ܾfa1]ybFL1eK@TG]GT ʓZo6E4StH=zYm`yPF5f(5ux=uJ#S<M ࠆ%L' J=IJ=@p&z7oBP}ɑ؆Ŋs8u  5[(?Uq5٤XU jrF7WÜNPc(c XUI^|-;E "tX`cWJ([A3 hi{Qܾ{A>vMHÍz! dl[cQL~%*2-KUن<a[y"x/v-8 &>2*5O8G+ES HE($"xl'Kn5n cUEd/%\T}N|f1VәyMbSN @KGTG} cUDs CLAfKriDwlQlSJ psWʓPdل uacE7{I d%9SKٍO4i(ZlYf52}N9Ն'j/ P/tRC/ ;$ÂPl(AΨ0R )+y-7mR^$JV պI6mjPWE[%=p}% TϴP2oΖT j9,RZ\gY, jZ;<(F9B!|>Sd;yXBn&wd9XT9 19֞> Ԥ\`e?aѕM}|v1[Vۙ}MjSR l t E}TMɊ5SU3=S0=!Zȁ"t@J#!bS]b^&yVNY>&y+S\E׉Y3y%H֘"P?[!Q0eZ2{ 5e`DSX^xy'LT] G)fehd9HFq50DGRguT~AW+>Hihk6dU :7]vtfj^?5)SMyb>!11a3qCk&'*Q,y:G\YEf(zjysywUӰ\Mp8\Ȫ6AsoANv'  <T <Z]3jR"ixĉ-VfO5`^Nq/R Yq1hrGr/Ao8"T #6-IfjllX;=+Rmx!f>ґ0215Ԓ#*Q])Ze|Gsӗ%ɄL\jE(0θ噒9]N:d7'u"O{RiA%5vڂ.J$SIIb Et=R{-ծ&j{C5)B|b#a⩣eb#j%[Ʌ+U$xϔ`9v"$U"SA&ȸͭ7P./tnirW ˡJ,27Sxo5 %RVUrn2eH.1rJ Rٟ+.*PfpF(oz~CBAFakhlW['`?Ǒ|5:Ġ6A0g,lx~nt** =Q:痣T}lӠtu]yO%Ǵ /6Ç9*P?C\tsdNȾ2/,,cl'&q) /P 81r> Z!c?gvL/6<uVJ`qבH)$wy^qY pU%WRkH'ڼ"`1]Qb*@@{c`)db=FG+Ln 4Zk|(RA7Fd^{f, *2{ Z@Ot T wyJ.'K#krS!QZtpYޢdQx0ЭVa -()t2]=5>=9L3#:6p8,kƌ`]#館[jΕd?wɡBmuJR-ծ&j{S5)ZB|#abe>FMsO|ˡv jCɺ?9zj KR".?3U\\BU6CդE Mw߃[BdNyNDaB-e}ikK89$UCRjj%j>|ĉjG(sLNUMq )UJCN<@'F@0ʉrS SQN.LmE5ѺyK,c,lp8pH1,uH:y1,~ 6F:> (r_GW$=dB].%{9QN'f6V+3C ϑJ _a/WI.:z(/z6'xK(hK!9@Δ7N1]O FVqAqV3Q/xhqh't Ӿ^:2$-,B\ :~Ə;>bhyTgES^Om(|F1[VÙmMjSRቆDLDUD~{Mv3/DurE<(HmEdҦcUn1%6 rWg}c7R_= Hh1hrӢd[*|OMI*BFl]Gt.YKC |K| w g߁>`|g:<|@86 ;I \ xSWc ?9yiB+{5M\0':zD0u.2vӢse%-^ 5ѹyKb3{W N)Nj \k'\('\0?~g',MI)r7}$X3Oc5WX0jeVˢr"N[ULk7bMd8o[1^rQSH_@}s6ؖsQa%wFW8SP00\ c/r̀]?ĪЗ֜Wz#|#,$q?_h>-2%9r'R*6kSm'GM=2>êEMCϗ*fj9sɠZBt R41`&U)3Q.Զ+ \%Mׅ,S솠":ʻO¤7@ eǦB u>_R̾ռ&bS5)"1l}5tWbhPtcNڇ\(KHCGnt|޿y:^v^ѣVm#_tey:_Ngzʇk 㻀+4\X=>ۿӻLJ}7Ͻkcr\ןkS{S~_6$Yv95>?cN7D%ooݾ=9~y8k!vO<۽}:n#x}i89JZ!{tOOo?վs}+޽GO+r 5SO94;0~sN8b騃_9G wA՝k 1?>|8?> UUU|p>H-دwCMMчK\#!F8x?Nǻ}߹/Oh".ĀAWw-0T8Yc:\e˛17;z_<=>>o7=c8B_|}n !5V] אmpב?婄qPt{]#nlo?><~z8V~}󞼛uyx.`>Y$ݫ% qOU{BIE?쯞^.K{.}~8 !~RLb<қ=ǻ߿ #h}x |SaJQzyY{$^%nw@^jtz= ?bRVC0bY`|fo;C ׷gaݾ=+X5fc.v6WOYѹj^2oGFߛs09 7Wߞ`(.BDHo _t7~tX񚮔yKr;NH~{gTjt 'KeIwa{|Դ?ay B۝X|'omg髗x ^\cox(-?}x:Y0 Gu{GF"C yr_fLͶڷm(P71ϮNJNww?jGg\mFףTG\Vk!SCq;XXK=3tB]^_M.\'capz}Dm'zO^, TCa@F̿eЄҶ .UzmS{}l;DS{lzg./F ߤcx׵xg3^?MQ.] qVvle:0O۷ǖ6ZMDҷv8.]C2(J#?M>`Ɇ_:'E߻Iރ#t+S ԯ3V3 V(HSb?^"ۿt@%6}~\4]Ob(%|Z8wD_IZ{e(oOMS7b.`Xpl-Ml vbͤ),]ݯnDWv^Cvzrf"P{ov_..b, ,Gʺ"+c9W7 ;93:s%KDr2; q ѱKΗɾe6_..u;=?%bJ`cI)xM1x.pQhF]Š>ӟakoG =v:~DG5-p{ eHN_ s=Yk^HgS2?<_ =G? ޥxZ3K۟W0]}{u'Ú(#쀗eȆ֑^} (n>_\9e/VKEzE[xLe_B N&pd]JDj$>ߞtw5~=]PS(bNJ +ШgŒLpl;RevQ9̿z|]9Og_$) 2yԾUgR_i5#vl:?im^؈rZM8%IB{cQ335<=kAo<^.o?(8 Txa^N*R/LU4"X估+~]*Ci)/WYo5 a'"9=Ke|4wxPendstream endobj 292 0 obj << /Filter /FlateDecode /Length 5646 >> stream x\Ks6/u3jx7󐵱F,[.bjjF&@Yխn&*$22Q7 ._p|7q}qyՆ3wa8R/xA^~qyeeT2aۋ-LK˙'a+e\h1Io`#Նq; !TաN?;),B|34P^1M~*~₤FlEͨa&FrTNj {VYe$imʥL;ׇ@rݖTj`,ֈHkTrN%+=%ܤ GwJ5 K' 'UaVX27[s[rI $ύ'C֥ gr ]\_{7.ɱ:KCJ 1VGFCXc%H '|%ΓJqI"H ,^*)Ya5lt>Ӡda *sʙw d&c1Vܐf*cL e7W̥Cպ nN] K8hzɡlU?ȑj썴ڼl8QI 29e`* >5&1LmZ@52=hSУ ;'Im%ϭ!۠ B18㸘̸6] Yl1! Zۼdk8&K,!{{qorHU~>58Q4r?']z2G-,hmp$A#[d*g/QgxQ(#֔Y 2:l apNMOf)Lz>X$)x${P}1|l´s%\>K)fZ~h0\V8Ѯ[/ՉMKR6ra?ɜ !4E)*x SNA1E̎T oSbs8d,|sfVvm9vdsѳa̖I_PxaPOo@Щ&wӬKCHV,}?N8F*PD;ex 1"xaDw($iT5W"jW$38yg>p"Q &}ƭ$$jhbX-%wPĿ!81g"|G(K-ӅGMamwԂ. S0Lc,QnMY1v r|$\?&kQ&r̡q(q Fq̅Ώ |gHR&FKܺ;3y='p z \b~P4%!`!2t6Wsf=+ FԹS&Nw>'=xMpʪo6u4/*vr™屷~y"JI1aB{^hß̜րIw6Ta&/;,21)L[ pX%"Km \ &LvJ 䅋81@::q=۸竆=ufrsL]xT%^"}~Vp`v?uYˋnrӌ:yT95x0R}s:u֪*q>VBXAA) Iv4=*̹D3wb( lr(tSVZ/*=KLJ{ CD @II)X  s#MF>ѭ=9T!F09 kq&.Lk|W`^_Y>ph1YebK>Y0"Hs0|}е7nRoY֭#ҨZ; }?Kʼh0ߎK츥\SfY4F:Գ=ȟO /qJm`\fl8eDv:W u݊LGkK0eEmETu79N/J;% B vgs%jSb} 'Ҍ @.HSJ'zzpXRgm|:J6-l4rP$f^$h0|qoqgo>3h"1Fb$ذQ}$ KiY"HWA!-a0LסgaGHmIF\`(bǡJɹDX߾&jSv@ ) :[.aeN\EݱKNć}VCC]l7 &'5A` `ˀ]Iu(Cc X7ݪ*LHEZ6rArj%kOPrq^A5ƕ$ϋ*Q#R h\09ɇc]7b@L,N%4Y; ~NK%z.'&; l> 62nhm͒Ti&+vU4CmoN E)P6x onGUhN/{ٍ#3ʾCzs(>JP_ SL# '2&-DU6NZM{=ԝF 8Xx31H!x)M!3TZTrYUM8& psw`iYcڊ:%5eyBUo3+ Hko~:L*}^g rꏰJ1q<`y vs:֭VR+HCҟL|~4 8FP)TVs] nEg`1kw (cz +<@ի-u_99nvH@k~8\# WY8~GPgx+KH]@-Z̐_zv^_ &3 kfFl㊤Y靄@m &$c+t _ǩ{fEbW4KV!&UPfM&`xJM(*BTIp+ oqz@ˆnyZ稰694V@;HӁSZ5fəj)6;1i A>MzYS8i6s=VZRgވ>dŽ);Vyٗ5 bq[vIc܅yN.&  /d^| c>(ƞT"e"}(Aۍ7Q']navuyE~#+ 4j\8Gq~M)g$qwlyRp!,bn9|-T<˴ϙ /J|$leýv?إ sL7uN -?=ZbһNh#}T (\Q@UHrk*m`1™> $t]Q@+Exq(a þv~Z|$_/5"kH~MW=n @y"X=> stream xZ[sܶ~{̎_ZKzQ];Medy:DˌK-+@rW$pp;eC0ܟ/'=݄.NK[bfoC7Zjl'bs͓ŜcNlvW'/ѡ H) f0L;px'Б1nTĎt)B؂]D:r.t^[xaQ5PrLD(2E t"$XYC^ *–S -(8zpQ$d_OPS vKafdKk\>TO}5 CW@ק#U=~WîWW pQs>vUN [1$~Te7mեN.Q?73*3u;|xV1@x7m?CuNqRIn)BJNڿ:Ay1,D€ b xzyZ_NJ{! H-")1WGP}GJcjMĀgFZaLqdqZlUZZR 2b^[X(WYpgQ{i,0] C$*ҤA1IęqWH`=Ŕbz^`!h/l5>8Æ鑍I$P(/WpRy7aMpc85UeNV+WvBEQ;7R*z!"s͌– tP3U ,M7ʂn;TAAκ)EC0L*1Ny/nm})%*1P r˥ǔ\'sX8#]X K׾l9+4ej'ZB8ŕKV!Zwp7^H刺ՂAԁw0%$MӺa(Ewi~ tw h!(Zn'Hf0KPNyQe;ͻnӹO\[(mk]͕+ZNO(b2UꌄIH\j Õ5 XΦvi T M{7tЎ;ի5R[/У&N}v7>C]6ՅSxtZ.jf(RƳ?=(N#r:s#ZTU/Ξۧ+gQq6գƩ-{D>Jy^UWB__:- ,$qC`+X2. TyiTT,TЀLZ)B`T$$C,\-P{Zl/DKt6) JΗ d):̅O5j߄\٫Q%5j4)G-@@=\T@@td?Ě LX[HZQdZ4'Q >a#t-~MR%vceV %B\{Kה<^q8]mRcg> H$(nV`IL*dC??oa:M3(6L]Úy1 T`+uAľNܽl{iԴIfv!5*ch4d(ѫB]ĩ?cNe?ڹcz/E}Yj_nj??0,ً7(^O6I\3zv2]@* aiFuO,g0>! `MI g<;~hqJqυYrtɎ>h&n~XqiL<@3\v,ΤG/ՉC1]: (1:م\EMո7Cc6!x[  J͖Cv+* C$k.3V?rE(Jf6daCf|Q6MC8u؁۱\Hڦ5t62,h|Q=$9rFؔJu ZB,siG0@Ⱦ]\ϒ(wnI<ۏ kvh@m7>b@ԒmO=FD;O¬Bُ[qRPzcо ϙp]i+{@n t6Aoz1nyL}ǻ0hͥ1`I+V֎Gt~}iAq;@`r{6ʔsՏ19 12*2J]Ώ)h "Y/Np^cQ_pr,}&YF2&xE]^SB9Ndyɛ[8${:A V>xK!re/iC[Z,L>8\a5cK$Z )*l6 eބNC|hYSoO$m~heq_4D~ xCnlIJHi[?Ǔg%+Bm*z!>}s1$;~Beat"M_`>:c}ljv>&֊)G%DZ"x.La֟`%C 4RWu yKv l6P062źM=t=8n?29heL%XbMB̃ F\vsj4)Ƅ:~kr*6 >cRwI!",Sl^b@(QM3 ̫g: r' 7?|M4>y8G_HX¬ql/\vJ֨y|W8\,tN2w^[%2,T&*{~=Թc:yt *hvnU,Q^M&Y-^ m d(M>&Mr 8+/y]t<ڇ= Քk > stream xqLMSans10-Bold!V  CR$3'pvnwjjhiMMc^ӋыѕӸɜɋzvkjjiij'$vDFEFu&()&FEwvu$$,!>ʚ걋Ym^gfg8s+fP}Uu]Iu^i   To endstream endobj 295 0 obj << /Filter /FlateDecode /Length 11456 >> stream x}]fGn}'HWY_Ε7.`؀- "v4N}3{j)V!dӣ\Q?o>>?=U>OUG-.>6UkS|鹭w_|51EO]JY~󻶮R[W~3ZWe;}h^<ݻêk~5|çtҟWІ6o"r2th_?xPm}A\wAT0:OOOF_4{V{||jck3oJh7k-)OyzjmQ~⊦uΫ (65;Z3s0ZXY\c> ҪmWmgdTƵ;kwټ5_K(B/hTg`贗ޯF«Ӄ@iq!#~zt͙Fɱ1n0k*`50k=E#kMmƃ&z_u5+.*U絗t`|-VA>l Td\t5iڮA:*B7|h*M[%! ]p8ˀ1*RA19*kS' ]xq1T:h_j+ڇY_A(3kku꠹Њ`mZ3\'L u:GQ;o#)ED^Sl0U`0&mk0&2Ţ$%(U+&v@teiCFa<6L/:O[+^2%;MV9&^\1flqQ{25k^?zљZǬn<{GSXk-=& sM:Zempx|R2Eݧ,X/ 0ddե!M6?L-l.S YfZ,\kGGf?ACVK.(JY+)6:0>fתJʘՖR:f1.%ƌcmkXb~0c4JK^2&PVW]PO ԫ۱eO]Ye+MA& F05Lغ2cU<0 D'kepQV}MۈԵՆ.!wOl]k%CPQTk2QL-"غDnY1<33t + ϖ̨]>W^u9` =o[P:4eD- eE-.ksikmZֹEZ'Ĥ'aBCJ(c_ ݠۡ{_zеmxCDU)7PtWEO=v)ة3ݿ){^ٔm&lNUO%ge3ge3E/Z,^n0=9)vUQ{we?U{C!XѤnͰ@f 3MMM NCgg Q)ޮM=^qP_.|{x&ʏEGZu=( ׸`ӕ簡,iuiscZ=1s.rʽ,YW]FX3`Rj)efol8ؒq9q}k,_D|Cʸ1טJ,(rڨuSN Vwu8=nBt$A{å"x ^dP{3[9r2W:7lw۾cbW#p>~:R? CB׼)XWPhңEuۉݾbxn!iP\>'R7ϭPG}cr\X=Fre3[' 154(]'K/da_'Pgc̦~:[ @(j":RQ .Cq#˽W1<*,EYpeI˄2eǧ@-z5ct72Wۺ#TqDm443(. irCwPT53Z)l=hXbk%^ ր 4x"oXva'uh}2;U?'%5Iz$hql,>X21U}$pg)p HXtY3\}Ҿ.#=m'h;\̓:bw`p1/R|妎!H݊1=5=A`D1VfN#4 !JCP7Í=  ϼ:YK!tEIG L^ڊmʠ|#7]w!_[l:m~ӗ'ڲSV+P73),*FSTTu2 Rv#I#a%X^ohh$d?4䐓 , e<]: ܾ1gSڧZm<.12BKJH]A#k] 1(T?.rn7ѻV/p Iݎ 3@gC 3&P?h&Ew9}aisAiU VP؆ЗƝW&DTm5񺌋,CZBqS(NBzL; <+|;(>H^JxN|<r]z7$@E$IH m ֞>.ej1Q݊7"`o}f3xg޶2P{ƶn< MJ?_mdS !15Ia%>f 7τgK@3*Բe Y&Br}jI } kR fLvY4Xxa)jzcZԌ" ӓ)N7d7 m*TUeJjn/ ) Kݝ3\~|hEa)R4h&)׸0n7E,S` 8wϟ9_9L{Og45|G(#If 7ُGk웲X(4QL #8Dn`1B7 5$m8~pǔr̀FҞ= L U~T KOoOm ;&wP*nk3Z.1N eEIVς+ʽȱԩm>=,65է#"Obfat4kTVfEmOT&.rZs :ZsU:(=ba5 7PsUGq3iT1b oBzyrТ6{vHxYEQ^8x 3I5#ϖ!kbߓx$T Expgzc/ƇdeeJ[P4)I[U5Fo!ddaKĺnxj6KolFFg7L"&R6 6O6V4!'4]2OEiˣ%oKpKɚ܋ч&"ѧzEcH@(zIFN׶zkytM=?n2 bd9]bwhB/N]E mBT= usќ%^P4e8mזj`,.ȡfgS+yC 7Ӑ 9p[l:>c3Jʞ=g).[#/I&?m6:&?mmc`;V>E0-=Mi )ztwB>GMIJlT?j ~NfRWu\e\Py|OGQTpKRmѳiY6^yqۑ⧭mݶ@uiA\kr-z=/*hIY-"8DnXgn{!gHT>M&ͤP !i0?o0BledbH3caDN3"z$@8[0FD/OXp0UJ12}Aы!ȸׇ!WLzje)ys EݟV $)_'Au?nP4ytB2! ۪7>Z?u5GK/w\R/ytGBs$d7^M>ؖ\1[͐NBr Nv])dom EإJDGd"e7i2gE6O3ʼMKuh|Bw% .Yؠi&>5Yĭ[./5պ4e&;Ic7M+BnƁzs!0 Ր"?Ѩ\/MׅKu#zꋄFM "S*Qy_횣NgՑm']UV>7˱`\vx\*I"˗BzDSn ?M(ҼhNOH@muG$p)ryCٛVX.Q"/*U/nH/xG5t.\7۔J7^?2xABtὗ9?|zxlCK yog/ O|}i$u}woo?HXX*ج~_VQԀ%ڵN_}}^/ߴ2׏ϟ%2n*a\\ݷv@X֞_ o0t? ?U^go W-G(=kKU9_^χ~=/XA~ӏhq֘j:Я!xXk?NcA/e1OO(Ak)O1F2k>UY_-q]V+V}%+w4A#<#͓S/}UUWqfvUWlHD+>.\^ԯVe洶DҥM= K^||CM{[QpGHC],%u7}' s=He'x5b͉5?605R@Q m)t\85 fcH \rc< q!x4lkiHPTx񸚌kLLe6pB E 'K@GZ2LֹZaWgIm 0:wSkCH#rj I8 RPkXgobe;#yKreVI{7=ɡJBJ_$^ަmJ%IT-F"n  ~w$cYjKwEal㩸\ +ܖW+!v!geǰ&!˖vϺ?y`{ȣ)KG44 LH.D 14Ek]&\&gԩExo6Բ6׍QʓTgطwK]HC3I% ZKKc08k$APEșwRҕPx'}f<|q7S 2f9Ւj-Q43\1]Н$HS/c49Aވ,}")%[92s =Q9@A:6y2J,fFHk&{ (V HO_PH5)5sJfѹ%"eA'H R7~ .}ÔeԔs[(ENj&`|ma9|P7=nxz3Ltbѹ4a?]]lɼ-}{Is\@=8m]uCҐ-9pk|F>k3f< AߑE7,AQ(X}PB-rd`R ")C] vf<zE}_RxŐ0XŜ5mB3۠pP{&gq"IUN6A6{ y'XMn9+mDPW,&Ů\25ƲњDpJLuJ{$rf miAę{Z?yd:B :YRՁI6cI |Ƹj8~h>~\ H:TZMtunȁ{"I Š+CIXI M9^吕r:4f;!ٳ4CC3 e=4U޼X9X_жcE!1{E?`-~.Zc|,I7 Ԫs ;--#$B jgAIrg0YIF$A4UQ.JXUܫ=5wT{Fϕe@3NMkTCׁZb@\ G i'TUkr[jʣEpvӉݼbn!iH`^>S3WG5C 6,Mܵ{>-F`i I^#)a^F'vrXra@ X a[,HwD=$:_Ck~%0MJH 6o`!xʐ#pC-F(oU:l&(4n1Y=G`[?t8sp?ɹry⇤&&y F'yξ5CxC࣓v]Qv+NpRB%/!i'شwtiY$B<@hQ4j V&)~7ߓE"N\"b8‰Hu\ᶭ~Zq٭p|,aseHJKjllL$6uJ.ILHO\WzrU_"ofߤJYҲh7z*/)rh wj ዿl`qAz{yn2etّ2|(C+ЭdhѸi3QL㩕YEpv9qf![q`l<}6B- 9O^NUV*[gcBU$eo T_Q,֥'lI=U۾:hv/ Vf ˖^OF6)(r6≞=)TVw14B4KP뼡ѵBDB/ڗjB ߵri(ӂGIv9l49])搈!MkK@16thqCAؘ"ʕ+])J #sV; n!=) }jf)F[>֟,V&q0 EHTߗ1/2OhmSV$}3R}yʦVV~n,˂.ERpnqFR;" 5jrJ,}lVm,h9B ZO;ΌyM{PF|Zo]9|Wɪ\}Aqhj ~^Krg7vG1(ȭpu~ͦbdnvg4]ccә&u$(MRKs#vuI_9Rm_#ɡ@J?w Y*]3|o]ch*qnZaW(}cR$Qt1NJpfŲ;WM0!Vn " +%$qe-CYb}m5r>Q6c/2luuwt{yck[Б>/zLur{8do]bnさ7xl}.3yًMq D8w5Ab#jA 8٢Q7Mo`hrVK+LbBѷ:UqAPxShŒb97#ѻ&r_]?B 1Y 6|b78irIc6Dq*~)COom>M"I;ɬY+"/ܿ+InℯP>o,fR\ݚە)h_ܷZV_A 4˩F㆕OӧJ@heL-B,d@`$O"CRUh _1 d浉RWu pz+ZBJa&J!h]/  J Ş* j dW*+kݾCG-jd1r5<'caF :e P5xA[{`!EYqQx(z;Wܖ A~Y NeV!4kf*vF]`a>Va?qҬe?݋q5_ҿ~7?~ҏPw?CBo?{>G 7;Fϟ?exO>w.oC{_޽~Hfzc3>^9`Imo2lBa/~J~aO;~s7>> stream xu\K%mޟ_sLzd` $@{x4B|$Z(ɞ_9+۷G>>(Fo߮?~Mӫ4(Jrܮ- //rʪCz~zyLi|> ΣϿ?>~ʹiO\O/x^Í9~1iN1RDjr}o&]MG(_ixAtHv2R^$CRPT/HS+H-HIz,ٹW1 VjIK%:R#,5RP2DRctI/$mM8`I$@!>22%A444 o)= 8БD:Ĺ5 PI^ x,$S0sPb IR. }Ԕ?#)Ɋ710UjKŶ2]3'uu+%P3fIR.ԧP|M4`Orw+3 M vea?5\2BR8` 4M$;axm #m TLi8ĩŚLK;,4̼]i)) JC`,&}΢c$VMN{Юx@8?:iAQu7:RzbA10`ƀ{[LB₸'؊X0$ݢr(AK\ xD5CFT4k0 HaKy&تf9)=G s/m-,1 N h^3NԒZ3`/2 SDHm\҄"pD QE'J9%p뮋USaK]/nUg%fPF=?~uw==R:GcKUur}p!y!h4+_^uƚ㺶 c*9M*oM+OYOZ-[2,]rN3^P,Kh',4,ė7-b%ݩ9s;Fuʥ57v5=QmkJ]{HuϮ A߫kjxG;ZX'{Q2JiƽIT_ZQFQ\Ϸ*#"+׌}ɡv!SHhZbQꉺS3A\OfZ5;*^XkL2< RK4X62~7= ZqkJ` δ4-4-4 4t򪥗ATlQ" D+3\1ܽLܽu%4Ntxh/ѰZzq VjN [ш%S)oo+Cq={07jKMOIUO02| /tt9'IP nJ"e Q N* tr)Q%M\j+܍ 4ѫ}Dڣ<+SQx22yR{F9: ;dp=t#>;? G8Q_4C[w{"fHŧ 05/[(Q+ّ{4 g3yy#VQ4R'/1o2:=Gi"[&DQV TIq﷦MlӲ6B_Dް1`ڊ0 .׌%ߜ;ES6\j\XQ( tODžf;BŤVc@ЯPM5Tj;-a"XAv[Є2!W]q\s9*C}a-;{slc  2Ԥ)g6q`Q^?g)mKj[ƦJ=#2s~ދO~P*79[.. 6h"H<"jRAsdf^6_\&8eXV\ƾZ]>@_~CV^4| e\O攌gsل0h]SyT RIx{ ysFt꾜R )1r=gkE:z+ǨNWNq˽2:̝3䏻mЂ%'bEÍwdxqCtns[7A1K>mQ^[ebd&˄rHCtBZvFt H?P&%_C'ŵߚWƳw9F%Ƽј[NP]_εʡ=l%zP4X"F(P X{%:k jsgEࠨ7r[Xʱl1`O~ ѾK,E,!JS-AdGx|sJ}';DB>BK$6:٧_ZTsĥʃW=5mêc66|a icxɆ@X} |)j11,[kf65#ܘQ>3 Ecͳ5XU4VkPRVT6NN덛•'wRa&CV>(r[U;bj K[H ߀%鍕Td'䢧Nb6Gl3Efq^2uN1N7S n{偠:3j#: P2zZîS!}q,Vsu0w0sQF ?XXlm} Z:.(zan_vex^Ę'zqōGԵ4)cL/kYj-[" вG0ǏeG7f: Pk]qQ n;]ƽ,W\ϭjlwM4 B0}q"Ev-9$/<'>rY#5{M{Jn$orX[-1nkLnlDO 9 =*$X܄Ҵ𴛽44-DXsbFkFtF}L֞7/7\d/[w*,xҿn#?|<_ OSiBJx~wˋ?))9?"7>|/PW?OoǯSo0d^󇃑EA9V?tķV}JhRԞ>|]_/} mf󯇾>' "Lendstream endobj 297 0 obj << /Filter /FlateDecode /Length 16489 >> stream x}Yo]ɑ;Ņ1qn\{nW?KͥLR.-PTu4\RȈ󯧰Son_"?onOx}bG3$z<5jtz}{pg?ÏssȧpzyخSCL} <ΓN5 |}uNzz پ:?kn.y_^>]b v"*m_ z}{୞=>)xʔYcOߟӿӟiOTJ{۳l6rs_H.yDi)-W9u.YUSc^e#˯ú@x/Q;@ie8^K<8.vT6,u/clS)[{B9)tǟ#(FmF_^+9Ja]~@# ^ɑƞ j ;ZhM@9P{ȧTJS<=\xHe BrNKr<\*w/cL>`ؗkE{?QcD=H{ˌ!42h'aFD sޟ,ǀCq*cd[Sh B''ŝ;۞yr pq#Ӕ$C/ÞOZ{͇EhOD JoA@U$B^ĴӐ|Y.kձ:!HcoT[{ۉx2 {PQ˵=`$䝲 XJ- >+ hB2u/TK8,49xcԽ L &o9Tϼ0MQj$SWæ8haҕ #aBt$$ť1f 8VBqO'"((*Bv$Їׯyw؏ CVIr'ʽx@CX0b(&i's0 {ir!@hAH wuH iD(sWCOqYr Ւh8* aĽ59fy/sC1 l*wW=ʂ>dǼTNX0{*˹RNX'*4u`<4 ' 5 5$*%u9p2{|1Xe EEX!`F{X+9F!" P D g,GX%&+UAALHEx8'#r#IKЉ".֗.)gT`c$a;ⲀX Sn , ~e!- "S(= dݱvcbtڍb!jrD-Hsr݃.#:Sd`CEI`?VX| `6BfM=!%B-˂  hf~%B*:v/^,Y^Յ~702pKȀ mp+^Z (* F]|,-.TmqW)p%h8($I(BBbPGSG3X[2!;d@xf긒Xl誨BKA%dœV~zcyFSy{j%>P0` /3V}0|$m`*^Ul!LRD {MNl [ 7`?1AWfA!h -uMOKYߔ|#* ^TGQ=(شW@!QJJSUGnfޓf>s#0) rp7e=[5V?`LfRDK>՚UC&c-b هPG $T,r: rp`",F\j# mY  ^_Ё3(ЩJC#Tj"RIKGpX KH .BpmT&4-[XE r=@{HtdAˈXWAmY$=>zoWpEY^Js]Ȉ,DuHCPOXa1Mqb>&dy F'j\,0:Ģ7ĦIDXCwUxĭJ2#.p0ɫ]e?atBbT66AAswqlJăk9a$ذ7bn쀀MlMGB E]1^Jkv7LnܫXﴈvdn܊І 8 )@EDfEbbwWX}WTk`w]&vTʃ̢*J.Hxj)_4,3qZpfz~1@|a0|Q֯sUzä@*DVq.HY;kDH mV0;M#>9rK`wSįB:DEm1BbrjcVIl GneCCV5<2/7Cu_ٓͅ9Q=4'J0*,HCVrh8(AﰿIJhŁOl1t) ]<Y|e8J"|%X]~RX\K+(wKHhH"_̋adLN$6[Xގ! nVYeRB##V\A= p:zI-SXDVT AƳZb&D~$aR /!ĿiA8!RAр"MxmCf|Q9SŤY)pұSEꭊZOoP]rC u1xl / DRɌ^S{n%'8Rjbdۅ%7K*ku$|UU-AFdAMԆ\|Y3LNWd&!i2'ՏZňê6D%-~nPXۯ<U+x sN̲U}yi{eUU6UTv@3\A%{x@GbX\6};i Vj?BArZEe86= U[b/ymHu4*xBJ # =jCNZRII1Bs&Ob34y=FMVZ&8Za39s!kj+TinfzmJ\2K/&BIekuDXNψ~Y++uЁ bf5+ zSfaYy5 -\$X*|Ո f7V}²Y>~.,3*‚~/)P֯Q8obԭi*Nߋ%;6OM2bLWѾTTOzG0mО *N^/ V&+r!Q> .`f_֯A~ѫ*WhAda삘*^!nxT+D}f>5 H <yL$X#spC):2oCdQDgI?fB#swJ6ULW$4AXp ZDQ 8 ALPMI_SJ K]#x@^T"hfj5=b8#qFƦ!\a'?`6ŀ*ߊ(vI [X\h0 :`)waSzhP ]0J)jfy!u-dPyf阞V9T$#QW0 mLʘ0![18ފbZ5n<ȓ2/Ҥb (js_+H8DA[oV]9X-g* d#IBFHk UE7 GjVp2趕PQsKCݝ% "M YC kf@CymŸvu$!X|}Hj 7O%"šj r\TUފuuG2M7D<$-& Jͺ:U`(~Q0 F-VfJ٨i:tf#t$@9hE"gȂ\c`)RuI`2 0A|u44ugٔjڠhؽ*Ht)4EDp.1ķpiLC*pF=pafݗ9~TAT3_ $aC,c$?l];g,0p&$4fPR!8! T )Sd X)HZf03z Z隀8GaQ3APKxYC2ES њXr9KKUR @}g.yJ!E&OQ!eu$v@ay&64Hbs M]̽?P!?@u+X5[".+MԷCv9Bb #yvMwUYc~d 31-gJn 1is43s5|lسmzbV*K5I$6L.OIm,Vy#y~Db]{:XL-ϓc12Ps5/E)2; c|!"&.& HXPkT/.l cf5rWPX|%/:MIܶiL$2 !KB 9je >K.Z w&'o%ǏɴΤɣU Nj bmInm\m0U h9abà;ĴgF.~S-OV3WpL=Ԥ#U qcu v%/:0 C.4 jkdynqFqUmYu.W.iXATs5sSAGL0vdoOd5QhhuO&!XL tpBR"o*#~FNk>&2\+| G"6"Ck܊Hb gKg[̣ŏq"AA JY5a ZF/L+Uʐ߄NMޡMk'|9zp.5fsŃeA/Mֱ$iS1R>ZQrBx\P;U7ci5ܓ(rX ^u%D.z2h_Ő,yq@aX&ƅ%(g3| PYDB-rfb Q,%[Zьj$<-IQœCzH+FTxfpRzl2HNr#bRAdXrD;)ad>)LAAԑO8D^m\{q@"&?W'-`S, vivt"W6 ՚iس˩RʑA u?K>}3T"3.Z:&D)t4}1}h,=㳏5ZK§n?5r, cV0wtIyljT:R^`4ݵOSޟ g֦I+ jgcCBZ@`U EjbJ@4DpȺF1 4rxE;8:JT`lohH ͱfI6E* 5%m /,?'>@Tۛ9 !4bU=+Mx|a sVbUqq&xn-0GjbDp*V'-~UF.rY^=xDKɺ^#\G'1|GR{?zS:P l`舁Pjzl6GeU`,\8`RF0J 1B{J8S%e셁\ęlK)$iQ*RJSf,Vj)kY55B,FN8;{ӊg7B?OK\$c7׈B, d$cUCU$?j҉wg*)͝W{0v#5Kܥ&I!˪q$i I UbˏIK% R<@RU<+v {DY7s|];K_V<o@;l3IM䂊)+LR:B%*:hf?i44zsf]S6^-p `-Vj@Ce!yRPsa/)O,*,k+o-=mOT(Ola2ngjRuݍ0ҥ۸=d[#k+ fw+kzmw)>ʻ_\:ɪ4$+bhUSa @b*P\%- ZNZ#Us |dsZ²4icj@+&K#o⡈nU, INpVx_~?:K^+f&[CQMeuwjf`ۊ={ad jƳR杖):SKj2]('8&t<༄..>77{ħ +!4` %'># ^ٱ'  uZ0\GW7[ G}O\(Ota(3ӵhg"5>+5M,Mrf '-%(\ x6*^ԫ7*'sup~K{/#V A(rXHK.] ^im0wYb$ )\.^Ja'DojyR [ Lx8ڦ%cTY T-i8 X+92Ŝg.53{0460>0qʇe"N$ijԶB\J$yJt x}!fkT\7mխ`5X8=F$F 2ݧIWsfc؄pXwX㻚l'iFOo?$" շzղ":W`]ˆz\)h C[&h.UN m,ѭ匹Z>n)A2}8Wpjr@ũq2 a"s$y .((_+>'K[HԬA$Y]ϒuñm0hbD#P7&nBwuE c4:2-hs?2ō&Ɓsƥs_v"&NLIl(}' I5rWٕlq5Uwk4D|xL7ZլV iI먠J}_:ki҄|!ݹ'c|H9wN[`y.]9t d5&s徽 _LLI#9911JC͠ߔf')9B]ss;~;Z6u4 &Hc*@Դ4ɹ(Wsf㜹1pnBytӸx8}NĩWw;U6 i @,ZUfF 35 @yV(-'*ν\wiuѴV!EaH UH@cX!e~~դ2s K aeYEC sTI}fw8Fn>xI'ա}4˗Bt=iDT D*%K=͵/QeT룪4X:QIJÈ)/_ O3 ߬ o Q\)qq>qeI95j4pJ;KK\LRU76JCB\$ RG:E/%HeGb/̚ToRq O!>-_3²vI8u ŷə}E\-ޞ BTkA:Fh Xkɛj$:͢J+K۬m }|lm*-5..KhV lWKx (n+0WZ.իˤ2V pz=&+?O?,y,a oELh"@b]Gx}ui!#-T},׃}E}܎eګfhaz7?}~4&(t~! Q̯zY|Gf#I[ع(F%"C2iVV]Q*]VHRCX DMOV[!k"7UPfrR7 s8Iݚ\CtԦ,$c$J_'2_;̙eVBc cϹQc c0; vX&@9](I<-Y/JyB(0343D\[ EUM[l$KQƤgmDg'6OA$&d4IcI\ұX  01|Xܪc&Tr؃].$ W\PN|?X/}D5:(~nR1hqnŶ-ڡOIe&SEc8SNXAs'sZ㛹onxtxbBY}"]P;1v&]ۤ ) UVgG&2fJܺ73 w_r7H{}\Q[eWu~Y$iYM:`SfFH{eإϫͳc$ (GnsrAsl/=&Q Ct\z6_$UG}H I"v6Yo(Yo:vۢ!&ZG^$G7ZJ`i[h[tDjlW6lW$=jWY%Ixc}K;F,) 3WTժ*T-Bk(mVBId[uw#U)5%䚫g9Bt]dڗfZ`#Kkcb5 u9T/V#5>9'_.: ^1X=lIw{v?%y ];oNENrQz/_)O̙o[B㿹 ѹS uGS;2ӊ(h.UF>-H䮑JYДV햜#w-(?뭓 (i%4lM[rm"t΀ڇqIҚ /+ v5sW]` aK,;^{HMzg}&x_pقԲbPQ1t.:8&sOYw"b@pVcշ)vi;f)rt)sFd%`NduˈP?rq|qg.7LtFv\8;88J8P9e4 ěxV;q?M b˰'uۣ`ںsJƩӆ[`&?E sfN!ҟ0EV. 㬜B;ܭ(tm Q Xg|<%KjhbB$-FI F)Ku+eP7Odu84=XI[J:ݯ4# dxǺ-Fu.zCLUCi0V:yՕrZ_)O,3+Ņجۄ=O<O\a3q⍨t1*:7%SC[}eM\ŬgVaLf/(Z>L#:r{[kc%kkCvm5.$sZq/+[ :tձDF|Zp,tjp4Ynmsn)4h`yMߴ n=%ldi֬ᯘ>/U3:y+{':Bz^Ĝf.n5S[04&0F貣HiOS:XA͒ĕH$MGKQ)E&wHqQ3Kf-%* /WџP6 3R%)ݲ# RYFV)Q:퀞LEahݻ))rSֲI(W>,:.U}Ύ gyǘ ǪǼ.tΤHC[nT#}CX\Q_J7P=GlI畂%h0A+%骦IMZMs1uLk1*i3;6 IXʼnKTWtZ6Q8v(=Z80U"QZZ&Wfw$OKyRЈ'iYկۊ7[^{abQ(Qh\sRsj8A%cNl37M΍3OdOٙH]:ZЬ>'Nf# SXo5PiucfC̞!>,ZA( P4;@-i9 SɻtZԦO7U2/㰶UM =P'"(*W0-xҔ`Lib](yw $w Kt 4-!Zrj)R%̇uDh~|1g6ޙM}6<<`l>qeGaӎĹ%hN3\q>3akEIgbTպmQ'|i#FqWJYÃ׍CG 6Q &Himhü>,^n-d}8sn3gi:9Q:rP:JZ;=4:5%k}&X͓Zٚ:<3`;-OcU$kdL0hHx!E+6Zy鹌(ɗL8:suc ܄ܨ¸}NDv?YN7YOzk0V$ }׬*6EU<~o;I z&nd+믉sC[oJ^Ip1kp/M _̌ލm]\H.rn}I+.o k;@s/8!8I\:DoLB8QF8m͹Xՠr0a8Z&B7Rǝs(>23Ս@c@߃m1`8CedA~(g /<966~]7 e@r;@mo8(<ȓp}!!{{(ȹklzF>yګ#{>L%k5#UW–iebBM&%sSҊ + u( A-xn2XY~зy ] oƒY9w{]ԭ՚hEԴ=VٛH'rJ^:I!Sgn,6!4.0N;5n0S1j'gb~.N;&uyhmqЛvG\D1o-R0[L2w-<$2kV-g䒨۲(ԭNr6z/#9G4T9-V=!UfsI/ZW!Sg~gqغR6:Rh16͓5봵usxRߦ1#x}ħs?WNF;mߍ/ځɚw/>KU~V!̻^H@4n8{]WI|Gxy_5֪Z, WHvkGӸ#$#~KR>7QXsEZ.CMCW0q\Wi?2>~Ry(w88a g_fv9c' DʈNdl8RιJe@i>?2ō&ƃsʦsɎ c-;vh&`MtmfԳR\;Gvj& l-s 34 C Uhp['ӭFi7:2v7M/Mt>^GIU9s\rbF+d&q . VJi:2:HG7 Ct([C9}˭[{iޔQStqXP\1_EIWRU,3i:G+f9q\ڸkg8`\:ieabĺT8 {#G@xH5j6aȵe!gr0za,џ'Rؐcd8 OqӏԊH.],y<#Cv̛L'aDX?'׉cs+xC`ϐw"ȳ BˎR,:"X. $:ż yaB*#d#7,ㅣ+RX+I׏-9\ tG] /PN_Uҡ8N˂r=PNOX&|)~VT{3ePjWĽ 46cKrkZMb=i>?'XG4cm<90=,#>‘ˇ_]^F+MFc(DFTDXAh.pQ'YtR!7Eӱ4/Ti x*i*[oK퀿M'O:xSU+=!ȸbNl37M.:rD2ėS;1v&i(ӶS{父=ܞ~g_'h!oϢ愷J#\w-^ߞqWϡ^ԶǧSoo#Sc]޽sPsԥ?^6[뷲CnqH}oWpn9z\s F!ile-8jk |EFSܞzNWj=PSBsW<#mWWo\쿼z|;^Np~^@ao}P 9_j?1mZ)lů{zwA!E!r2Yˇ7e//o=7V HuԥoTнS_/w.$ÓppFZ!{w!+|wolYĽ AP{/#X`1 }#bG&Լte?0^|{.oqʬ;J\r*__?o:OxAdWh>"VgQ4 눈Ž.q?QPE}Ev/ߟs붒/VI栉,GI.8 fL˻7+buq;[W~ϪbTN1#jb=2.F%>pn1l[EI/۫'-noGvsy3)oo3W2*m_=A=!HJ?__,]cZlwQSN,1~[..z~Qhq[x}QK["oo{ǏouG@:.Ȏj5B~ۻso˂1G5|nHN/js0a…%?4! ϰe&au~AХoӫ{)o{eջO{^?~wsOW7G_Ա]F2| Ozfmΐ_WS?|~|OO?e7ziɿܭJi}xzs9_y`J //`6p`|߿*22@mȄ(x˙g8#mO2ߝJzx>ΧwDqjeT.cj:#󕣴5s$`ָ96vJ?NNV礶}s)}Go^l 3s4E7E)e!o^ce|GNyTQNx#f൷foeE 8~w /Ua29 $@60ف/>,=|¥ ]sÍܷFƿޟs㝱}:/`~vw_]=<]}z\ /7o.oUBFK,ߺ~wfm޷[x~GfKmAT%?O $@%\z~[:-K{wnaC@o_:W2[\/'*Ӄ[8'0C4.v{k"!lj.U<^>]o/,xпܿ[eGnυ/g8ry,kosWHi~x||< ֮yQ >VUZAj(e.DQ<[o#?(vq{/|fבϮO\HTdQ[֩j+ubnYuyQ$tlgv7 FOȋpB$.×ZTF'p Jn϶(aowgѱ> stream xUXL?c3qs>h/gX$eGd;I4̤)%\ʏCrv[t^u>=}~.D$0P|""RڎĊ׋d0X ]a%̓p~jM\|N"&v,$ b3%L$Vjb1 _>b"XJxn;A@H"8+Lrh@Z)+mprN%+$g;a`@aPpV>W<2>)380Q"M`[NFv.UJu}6;#?vmssq2')jP؜z87ѼGWyyUR129ax=&  y~ ?_~%p&q<&7|IS\&X]S5m9>B oE ;^ښ/u-}84A𤧈b*bIBFNw82 YB{\rí%TNWݡ#ȕGlҖeu[9G ckJ. EQ֛̋\E Jؚ ŸhV6$lPTXMŪ&. ;ЖfVfiR."7B=u*B,ֱG 4QI?j!͐aׄ飁V -YUJgL!bTKt;Ђ #;$h,ya׾dr 'Wm1E[e!o)n?GhL8h83ZtMnH}EXJtD<3{Dl*;z}c!8. Ўu|]{3 a9b^r{[*L+abH0HbNfGԢ`M]ǿƣahN 7e^cuh\[K9fR;uiiv] O[X5+u뷫<( (o?~Uynئ-f/ݹ D#ūߣ1x y$}6R!#Y/p~oWX^St[!μ$ش[{ r a aêUZ[ZZ6/ȄMuƖ|"ى$0Et/o,/w(y/%'%Vt1G4M 19Hc<v[T*+}qsxA#X%H (iKN@q,rERUTj.[4qxY4 @e뜡D^< (N?Y/'}CodDPw3Dh#jA lɐc=Mˉ)E{ *Ι34qh5k26]Fi4U:ֳ'E=/AzA*zArߑm]rI7wZQ,&7rm f' d}:+x5C-[QIك84ON7?hW>&7.O\'IELURɖm;X|?ȁ̑ chS &(V$~^>+3 fҽ&Snn,w_Hendstream endobj 299 0 obj << /Filter /FlateDecode /Length 4072 >> stream x[Ko딜ヒ Mo1r78k!0 jD eZ?T?n#i`"9s9pFg?Q<ο<{NsJ%_ޜ))Zjl<<ޔPVb9htóU{d9Ƣa_;)ҕ4+~N/Og!Kl?YbÉWlXNAPqkJ_YteMPu?=˜_J56Y?|_0 [w|eP$ # lF]6a/S)Q(ܺPd3 pJUS{"0_aDh>8brԞuT(ԷMSC X ˼ockb#*T}|ᨯҠ5c*Ո]&`\l;lT@c+al:=8u霅irs@eƔ;ET>Ÿ # hh'9fM'sn0"ƛu+*F˚-q6_a@"%nspI0UQQG*hFJb5Ijy M~S6͚8ÚPkPurXkovX;U0*wkT$m.Cso Be~rs sm%ӨcVhKٗ?9-&P<*_rlboc)f?]fC6,3z}# f>l,DIwwBysy۹^*#C=܆܀ђ8/u䨜 GC&xWEeA NN3~ɓb9CG! Qa+ܹ_D?QbBxmD&QqF{w@a`F$X9 3@fwC;Fk"-iR9H4ƢJ,ff#DBf5j3`mL;E>S-A!ePRʹ?1Cj7''[onhm`V3-J1K[ճ0X#+,U NΤ8^f-X Q}QvF2L~hhN b*@D ۖ;#\l-G_}(-" HJJET^sՕ'dj0{m>|X-t -dF˾_]*-&>[m2,NBdxƭaQ >rKѡtSec)OeZC12@F,B̨g-ħ(vVx(!]@Aq4OcG&i2}L?Tab#T<LaDm~J#(dL2c*/J YibB a;;UIjQqHE)|Q] 㤵S)ޯĆlc.хjFܞLAG3pڰ*zH*p~x9lu̇%^В9]>CeZlE]O$a/ ÃD T7M^Jؕ^/^g0>F!gU4핸͜XyZ)zSc0e*k/UcCes|S3wEahIf5&$(BtiH3-,g-~SO9~ʸ[,Z67O{/ qI%dsՔCAe|х6'1)jm_-NԊ60M ].>Bh> r0Mzfy6B,~.) hT|Y"VOf_كl[쐱NE`<[9ڣj$5O^}̱(O35X mmhộdX5PmV eZQ aCϴd*_eL_S5MX2MWWȥ]}ZLo]YPՌy @ d*?*VTEL,DT̡ g wCC,㳑7ܱߩKy !+a^@eWtCo~iCD2Ԟ4 1D:g=g<6zHCƲrqj*IGHgv?uL\wɦvY2p:'P_XW6.Y<\,Z$BNPo'deӷaO5dh=J%Hob)gi0$n1rjyj}5DXl\0 0B\{> XRA;.݊E ߉%Q4e, B4ɳG)P?ݢhNQkIòK?!ֆ\:$}O(E!O,p7yu$Ǡa0=LQ?k<~hQ1hH@&E@J~·o-rW'GD}VW "),Aq,iNN`oܹϥz|aODS($sh/8] 'dRs;uAaF's;˝] e(J$>Wv\;اrE,%uuR\y?d*<0GeK],>?U,%S=aB#sWpPuV.uS1w)O75f참DžKN,]2Źo0华Ea+P'iW?r;^L?  5K2[e%rx'0M*Vm$`;^Uݱxw'٤n~joO4nӠׯ7o]Swuv9Q#NߕhN\ X | }urh;\l(}`WU9i}/m5]]ګn1 ;( J=F Fx3|:C!ƸW6z0c迠+C0sx/F]WF'nbN^}hvHlX tfze\CXMf94p1Xߦ,CVBWqp[Ӭ*Rե7G҃ڻkm%Xm}^>E3Tlu-om`DU׵)qqu}qtI_k_掷㟀Iy^rpqk=vgc6m|;-'ͥ;HFqM왡o uWy7_c5|[ ׿TnS}o\n'he:qVݮW`Sܲ{7h~F OQ$$g<Dendstream endobj 300 0 obj << /Filter /FlateDecode /Length 3611 >> stream xZY~'=|1,Wje+*^3GrH.5ɑgf-T0Zr*qIn . gd;錺oapyvy-łl͙B.rXb1'|A t&kJ,ڶ3P&;pM@GtR,˅2s 8]o~0(E[V=,)"E trEI"ʳT"S Klڮ\2K(~_]UBO?_^trDW* r,eӳOz tW C nDL~ivB@31=WHn{.CUjDN1覬r_4maEU7ۺypƘoxVhSݾo{蛲:D0瓉APuץVc; HM"-7[{i)SPD)-T^*Ӂ۟Mʦ4:2@9`mW6gB`fU2v!v^ϵDbbE0` )Vu%w@?7l y,4'4( BT^ϖ~O`v>+ 9R2.#) &vG:Sr R-)iF^ɥČ9=۶ߗn,J1eBf5ζP[ ):EVQ4tҘp0qUF,#;@Y}e"TWL)Ɗ|4k&J(KCYnq9GP jOuaT3mWVEp"#|J`QPU{l&H934-]U;awaŠS 0MmZo2HE] čAU @@o8)*2%CwAf2BxX<*2(㾇U㣄{&QAɫ̃vIjp+TTZNu3mc ù-)Q?87B ĠU6z1JF{4Rў{zqNcN$CaN32C[e\JLZe/â-vIhzXx8PTXVrvu<:bȈ4 S)Ri2poi%!| edU\(I>BM+~4@P1Zd\jI,t%$yotg[N OHOvYsC bCF=04mZ嵶 L0;;Eb*ȜOQiaԆvu*՘ j:pK*\5l&l@.Nꆋ~ %wQ{ ,n§غF2eDZfSHbIsk1zV,>LkMȹ5X^y˯vEPwc]p>shf3S}h pLLb{WwCaskLt p&VǀXϖo>Lnj=^-\b!oFz[s\ !i&p ̩wZ%K\P[FXXC l"ƍ ̎]P3( .4c? 'Ah(t$BjܣT'@yN4;>L!;yk2A+w߃s9'|OI:m(GDTq+O*8;Nb> mHcL5þWк JQ$9YsQ/|j֠xzԵ\Y .Pm[462W'P&8i]k%#(F0z<ݹZfƕG}E gL%Ƞ;OiQ55m11ЧaJ v'3%)>S4>N0ciTyynnq@w> pE=Oy+8cźð!Wǧti y?= =0khs`t@-ò3 AȁO KѮ_F>Ӏ߅3b`k`r!J*-`3-ˈ <-h_O [꿜HfVty#t"#!)' M\ @\*)`Jg}㞾?ɟl ߤ$gkɵ˹AS5w(yr6 &1ۮa2ۧzqRwU0a"AƳ:tUj*4^!*R+08GM[x3Ⴂ79< gdb)D{J8 ^]>.WZOMU /Er?+'WD ޽*U'Vٿ'u!vx}{,oV`rѿU@Os_yycn]B{:Ъ㦷jv׎m|UPco4vLl)XƓ]`ho_Eǚs[[h˄C=v`*r{l IϽ Cپ,;]yn`endstream endobj 301 0 obj << /Filter /FlateDecode /Length 2533 >> stream xYs۸{ˁ@kqo89YM;cenVxDؗwE|4bw/)x̟Mt3u۩MXLN9bRx%xJӜPQ>]&7htD+&%h*?|0D"%к,>9sK"\B*M <[29 PP1QoK}Sfp0߇,\^_-2[f3Jq` OgwRJ{ ?8,{nw)Ld>=nUatٕ#nߕþ||zjί/%E $\Y˫^fϳ#we>5DŽ_/43]^-.~,7,bY^F,clН8OwLsb҅M.1Sً ŦN] q[ͮ#<:D#Z٨|rީ0Ue4=#޻կWz+/z}ޔK>f/zlpqYl_(\u(wƐqR )5U? Tσ)jYFr$@g3*2S$J5/. ,CBOUܒۭ7œ_`E\ut| N21RȈ#3#֔ґ"B H,L3.-VJkPX*$J}gP.{͸2HPe b$BU̽`2E(۵7?;[R@t0s&()j!&.S(bMwt[{,#ޕ~70V+O1إ.*fTRIL)7E(]XMPīH<\(1 1+ #b"A|SЕxUa`c5aK&s %9VSG5`6)0&(6\vScSۏ҉Nƫ߱9Mm%ơ]5O&Y{'fOɶ^LpGiTrQIcA.=9x#8jyA׵.lK7T.JD956afscrje,eJC֙&P!ʮ!fj"`GSfoac,S!PGagyYz8́npX{D{g`R`6 A(83iyLx2vcS7#P2}^E.O|V,ԕ&b,MT_cJ#q3oc_4'/H(CsH ÜŃk !I2_ dρY-Nd] l̈PI{>#.;㢫پdrrilp}E]w ]Em)P)mp{AԯF9"R%Du A^:2 Ft..yRof33M*>mImWI[G#{s7;C/Q,/(H$9 a6cB*zCiSЌ1pXy8wݲi Z&.yNMY4MDmiI89!ѦL1EgI7 6۳FDA#Q&*Ȉ`TAPט(l T^3&@k*v=Bvyh*}pp(dPc;Ҿ8:oxa6wgyit])5tg78(&<[մLnqZG6G.etyQzxܵzT!+{"_Q5r]bN͝ldπmo/&?Mšendstream endobj 302 0 obj << /Filter /FlateDecode /Length 434 >> stream xRKo1W8؉DBF=zi=E-,eIqߣ}<@Eƽj-[R Dr4:I[^4lM,(%YB  5R:fOlfΤl@42Д?Xn乶73LPD3PHeaAZ1$t: ApGMêzuhd IsG Reśͬ}@ au՝5)G>R'ï4gdLU*/ێwrb?*t.nfe_)hXOJTܑAK|=t>^g (>o[_ OqXgO/8_<:wX%nYa; FϾendstream endobj 303 0 obj << /Filter /FlateDecode /Length 6241 >> stream x\KsFrd|7'1( XmHy#Vc0$Ł=jh4̬ @b]Y_~_oW+Oo>k)xQ^tEUuz9\1*σG\XS ,xzߛvlَ:r;u/]'x v֊`\ lߟcUqE5²>%bih GCc?*+i鹐Ӗhp\X6;#{޼Z4{Be"rixfMJǭͮ R/vtط42&>"nmi WFI@^:±.&vS iΰdG#m筕T2!SI뵐\*ݮ2ZV%5QiKy:\:1-$)XT[ޝWws\IgZ|m3Ujا4`rXaԏg\6us:uJYnu'5&*Z1i\bQEϭa~:#$³:,;hEu++{SXVC*iЍOC7:3YVf(sMj_-|IUe: ezV>=+z[@=Ii$;W*統EngP1`TC!]o兙 Im%ja]x=hɮvlWϧ<#NeJ#ְ` #?fI5#/ S6CUt[.O0jBNo MD1F{9qSlܪŮ+L!c"q Uӡl@d!L9})cB YGG=e؅c+aMN'x=kh4igQv,M?/{C.WGx:ߘҥ}<}۝f`c&cJnm PX(>-Y$țz&```1?65]Vii-<^rů0hNyHHq);jucvA]T[\~b2 G:Oy`ڿnM15$ZB*٢{L+,jӬ.p)5),DUА݄N PKЙvF=Q"Ed%Ya)iR` )1MnZޚms [SFOϡw-%LE"df~vRϓK|?&%µ¾T (%%Iɣ f!6ܯNi8r]:'jE\I4\zW/幭*}\Cܴ=qz/rĀ"PFygb2TRrL6>Ou2Zy  riBL[\C[<[H!SH%e,Pޞ5uD8S9*z:)"!"e4y-j$q~i$Sx;,&Js~m3vhҞW|l9ΐ Ơ:K*P.=6PXXbc. sګqXvZlVGmtOVaԋYIhPR2D_Zmcc3+Nhg BS#BӀzH,e ΄(_k 8AI@̩J^-`ZhKdfs"W2y{oծ's129Qиi 7ka4{ Ȩ(BDmL㢘@AHF1pRr"QLv2tYԙ GCɢ'3ƙ][:eR1jcQ9 cb =rR+=,MOLK/i18R7KnX=Dꚇ\ܮ(s^L@V9Oi#L U~7qT<yxLROCtSmCɰ,ךZ2ecDϢmw:]X],%! 5"vG5Qyǿ|:c#8("^'UЉn 2mCas4k 5Z;Ϻ9ۃr`s eaaOh2}8ݺPkX=]{k֏- ;=B=Lht뽱@vFRC)y~xA_Ak9,Eռ^m\bJT.\ ZE"ÍW_ӯ괈  O/K|V{[ ?7=DMueNi ]=,Hħ8éw_I7I 'Y 0bvb|@EгEt@1gL[))fm_ݛ2b4W/0ұء?G%F{ !r7_Yf-y5lj߸,8~A faSKElvL48NsmNIx2%^gyym/D ?U9=帀³ƗGT[ٲw5/DŽ>|e KS蔄 8רkL>+}JN!4iWCuMp 5zȠB `Kǭ1ϒ;U!w M]&E ^X.4IJ\0 pK Odr%!>9wu:Ԇ [$c{E_;'W6.J3l}h:b*%kHK&wgidvqiܘaEWJ]!3dcxɅP: Ɋl&JFs١}Iih4,XRW+1)\ԃMСWᇪs+`Ԅ/82!15Q3ߑ;~ glL j)?0 ԰z9&f% oوG/̿%#8zkA8.|=/SX@fU~*m\c T YW|OdyaP.1i B6pH_o龌dg5~= -Z|FeZrc%#GWqےdY Pc-X[t*wlFPK Ȼ`眝i\0 =l6a9蘧O}JϾ;Zsuv?aoTc8ǹ 3L~`$&.bs6v@Mm0vE@ӖyD/ }Zˋܰo p9ߦg'KZ)C W[wop1#@hcZ4En V1lQ5NX ǹfU +ٟ#O.{{%#V/OjQH񜛿i7Hϵ ΁s47m_ws|;W|J%e6Mqy/Se"6ŖX%En|#SRQE}iE_7\ABs[`:ߙ c.QĘ ~N|a}^#Y:I86L!|lW ϛ!R~8endstream endobj 304 0 obj << /Filter /FlateDecode /Length 5287 >> stream x\Ks$7rdrov!ӬCCሕA̔ͦ_P=]x#嗉Q~/8ް7p6{8zP #jKԷǛɿ73ʴ9R %4>{C dy2 {Qi-!zw^qI{3LB^2y'eZzP)/gKҖ w0XI3ON$| +S6q' U_wc{|w+&9 )'Cb8i̕d*}w_pmV}>4n⸍#нVBF#,^Sqwww/,VYvO#u-cy>_Ķ1 ^fge:}hK*Ep> C拕O^ ]nt具CҤ/+oKiG``D&}!:C|-NFSnTniR On>Y4{ `F°&ɥ YR簗QKaTC1e.{ ŧ^rM㳗TڲVc~^IO3 6lV5P7ݡ-|Xb܋{E?CP] nYTJP(RJO8.&_W4Ҕ|a}k}9zD4O"6(u$L `2ʔsap0uSd?s. C[Emb/T+҄rbɶeRG!߿eޏ.ړ.GT+(yKM7}ztlVL5; Cq$PFR99;ssRĂ;ʥk^(((\8BÆ*(@ *'A cbq-lTB\7wp 5Zc/as ~6==V7'/|> .QFcLMX9 &8NI917h@l[K#S(ZǾ@CoP(ixHʼnb^g!KA L9g*k8qTɤWO`nʺQ)ΐ_-+Pxq)pR,Sf(>.$Up t B/;"|k0('d5> I(v|&-!x$s)|@ :  (hb% {"]Qg:߄7B; @DtmzcN$ޖpk;͊\\R9(nqxh䆋dcM o󩌶Yc(wqʥL[>K Vnȗd$9K@ ,O@p@Oe'$^ 2TFⰝu:)laB_RyPNY]mcM = MQ˸M, *l3+* VsAᅚ&jbJwJI:dÕ:R l G)H^ UJkB}=]Z(f:6h3 G[(^) F|c<՗ %hc W=Y:ؾ;7Ed3y 53 3O,Oi*~Y‡+;sM@ۼ"; SM 8 A -ݐB#TOKc)>H}_ww,!#5TvHc#:qT|%&4䐔oȩ{B\a@*P]#Nﯥ=85plLjw.-fB+kn)Ȧ2;'G8D l|f`6h_t$pϻ2lSP]Ei5 `UI?oq؟tͩ"zUSqGQb8-R0ENci$j~U<0XaFH:jTbW&r7[q`ct;u]_Crx:}t`8:AS *1;jwS88G}{ @su텶sbUӂz I{KkID:GMjF͈В*Q#E>CvAbZNrGPޭSB|Jϱ.\7å{x-NJ[}a]TjT'QHPRU*]3W ڔO6]jNBȠ2Y_X}K5c/Z-d̘Tk ~/ɩƒpȓ\{aƖFEOʅHj6Z՛5h ~:ffGz%V]Ҵ} S\=u}5S~6N,FgF+0n͎r)*;T_Eف'qWNQ%۔ld2Dzi, !?@z3sH29Aa#1t<cf)[dB^Er UW^ &#uJFD EMD WRA]R7&ƂDJTWW6mSm.<dVCxҶCpIfnLC-iҽVG,GIp@B@Ő/$ZƂcԺ̦~`/ +PA?a;DӜןxk3HS]a LqH9YpBٶ6l4`/BIHB`Bi䊀j)t#Wer s+w?43;E&:?c\ e`"S }b.$Μn֚n|݇E5kQ ЅH"0g2 ڤT ,㾩s|:|VsTi!)R),`UFV+f$9Ji9w`PIZEn>HV^cmVQ&yeIᎤT5%:mSg UUӍ"u 3Ō.g0u-LZl]BDSQ,G5^|c)`t*1%tET814:\sUyѣOF߷2AY@ ͊Rrnju\)J|_O]bVbWIY}aRp1^yG]sHм X`2 MFU2x(> a2%&U6`nJHұ<5QsuěB'!#kN"UhYFO ?'M.lJ28!3P-xR@=4:,%,)5Na^vRX>rʩܝpZq5ۿi̐,WFw2elΈ3d؋.Yl(a"-*%į2c RK'P6ahGgtݭZ,8Z<%D_5nэ_W]!ozcK.Iu0&8*'(u OUIޛ"ܜuۈdح2r:Wxh V|xo᚞ 4·s` 7b]%HK@Px 1ɠ%xXxpB ,dB>'XG:< Yj3)Y^;ked5.%f:`"}* uJ!T^ [5PF52dsK߯B9Xm0EfavcIX/-3}U9{#*.+yZ$κ4vo6Xd? 8,) k_P{ \ʪL4rQkXCqr/;;wyȣH}&fd㠼C0D#J\}S).5hi,ucLrXW.C9;XC|kgwvv.NtV; X.5P(m[c()V4h'}L$`al$6HDPc{K>b̧k,hLGUݱݙ@Smg6CNpr1YmlG}f煜8iĨ' & k-d ~05}ҢM\q~!E_)pv $q^)ʥ$K~,EB ?N_EH扔h3I'> stream x\KsG7†Pc&b# O 9Ij F4odfRCgfe~e] .Wwbuw_WˋoYIruU+o=ڮ.w̭/?\~u<˛~-KV ,{OB[~YoЏ-с['T1we]BFkc-.l~_5« a_Kߤb}Zhwڅz6Zz.]m9ZD7)y4u v=oFq{Zow%6DY\^+ǣ _o^u?[9ˣ1kV)eW3/7BʙT\aO*x[~ sCEk@hJ}^4.׻/UP*'4)M-V`#}O:mlZ>L>~i>>'{W.@tZmWwǖU!h2+Uh)a0C3;p6x! bc?fֳ_*/=)6<:nRmɥչ}(vןЁcQe Ҳ}<i %;U _SAT$:) =UyXhXɧhmmC@?}hhY_Gp}J9; zvUE/qj콇%'y6?%G.@G2ɪ兙bg%JVaWO C<ݫ1Mjכ `}uH:^c&|r560i=8'5{JG$Qv>h-RZͅl=ћg;c_ƈ8iH#dnxW]{nLuĢԀON4-eaa"9&-Bw |)ip XU6Z>4Y /7InQ4)V՘N1M%MeI58{!ׁ(=6u|e\OfO5h mWU|^2!#Y۾s$ V@{:L4vHG3ejoՑ弩iҖ:R9'6>C^:~2ZJ:C/Dbݶf;"S ,#$)+:|.@^!.;PQs."/9U״Gz!ٷtpK, tY+o]m i[>aJ+k |]ڈ˾֔pҡܤ:wS;4ٖV6:..!F(˚>aB*Umb2 f?C*RکhpI/Tz 3KIm͗ ߕj ވnK"|pvW@eb[\tD`O̟ʚH̳=VcoT)Ʈ/_oTLI5MA6 IР&HHe.~[icYl:s]{&)om *{(.%m -%4L€ $AY@T]*w mfatc /1/Ou_.^͍aӶ '+<@ $_)Yk `Zdi,{5 !.$<7O.JB񨦔?H+7vĺ&, -!=A'" X()Ti!( We LTzTGHnj?@V3%=VYÝnZ?GU |,\ߵ};UucЋ  f848U=>]T=#pt "ϻ $ͭ. }XV%SP{~aᤈ6ΔY (4BBaX}&Hc ϊgKjT s8ŧ0Ɖ`M&Nµ5#5ND{c-qVET#ZRTp50] io&Yte4Xmծ*yC]mHȇBIJIAS8U( [R(w G]lXX`A5dCτgStEя$F5{ڒMwHAU0$koR2>_> stream xZKoaC 4~?;0by9Pf+ZIAUw$gV@q9w}U7Fm.\p|]6__^| g37a #vc^%]eisR %4>{C~ dy2 }.|U~ЎJ#7lsysAluŗ/˗l⛭^c+''2.4yOLvWoSa,siG#ғnj+!pO~9ׇ\/-gw'+MjA>Jqg"F:МZdnmM;.GϪ42&w=͕f5'DΩ+-Γ+4de%CU8d$IiG+☻t+rԵ⷗?^כϤej ʁU{M>,KwQz#9nos `+½W9J`*VzUJ˨Z"^1)>㚑 iʸ$udMGxK۰KJPNXߵ]Awks=4mkO+23aA')>nu.P#5䅷>)[G9-T+亂>g$7]Ȭ&C˥դI&cQe\k8#PvғBRcxEdկkJRqgnU"Ӥr"$rE?U)w8{dz?HMIjE2N'$f)0ȷ~81<{^e'ժL.dV_U(8?Xa2C=tg0:-ye 6iXjSRuҡ4}q^:Klxd/y(Zpg}2e&/tF8X C=2 9,spa\)?n?Y#{.*? \]N)cnxpi%Sj@WZgNfɓ%_ڐvn"Y􏫘&%z- iś\%!=^F 3x ?x J^Z&VRT^6LkD^X5;I5}KQ"exIfg1Z1dvp\`  :ꞶOC $}Ɩ2f#Pj 7~!WpXGY/@C= ,pH2;z>ҸjQG/Ss71DZm2j?ό]bEadPHD|mW EWs y5֏`bi8^sҰD& /-dvv 2LPZJVraQātA(iߥ隻f[%B 2R^HʨK(0 :/.:(b/Ԛ>rNLc3q~F8J;2L1}5\.׸/uHZua٤. Qﮉ%ҍSv]2W dEbȔ\#)6q`.r[Y 2kMr{eK 'y8R6&izˤRtY*ĊdL>+! W1`wk1Dimr.T~ٲl)/I=L k9(*Ø!{f+q%f㋢NHkf]m8^CwB2ʹ)H*hP 0Av J[d{? pgL A;Xp6kK FY9Qqz?+Lm򄍖}V7TkCF RÐ4ĐƐVҐ=!9-x+W' J/DAF^ܥJ#rWiq6e+SavRsH']|!(0t|DVGt\ĔP<}>9C~R؏H1y]55oCE9K($oe M(ԝ$c):qBE졯؜%*ղ'Ѳ֧:֮b^BQ ay e&~"Z(lbq(|x7˒sb&*v(I2`cĿA2_WE V[$5p6dscm:=9(D]s%3@)9@<1j\#XHc./T, NWWlч@!ϱwh1@{aP̡71xl]p2hNYT{)ԣe•‡z&A,q>, QuĆs#hz*a1\M<4YwE RzĚxP7d3[Ke E.B<2 EZF`s//Ga< UAeO;~3Ԍ]Șisl7V'T "vX|mP,ڰ \h3=]VyS3np} X qE峜RLu 弔; xIOTkJ>.S+LJ}^Z?U*iMCz- Ӎ`G͹t̴;~{B]&pk>hJD|3uX,;8$-ihV(U1ll:^$ë &>|rҧgfHئ>W)D_@aQb!'Ф,i4M4tEeVQte//:2#?"-j7qCo*ď!-fjiZ" |f͋>b9 1MXǽgXa{kiӀaޝ&אq="NQ.@`ckV-Ia&)d4c}rcAP$u< 7[i 鵁E[a@\ 5y4튡)qopcŒ,Oa'4LO2m__)/zӂ|(]~b<5vC3DRgScQG*h 2L&S?Z{>c7arxLi/e6?kφ"6Wäb-*mTHcܥN"|"4'U|,&Uݐ rGMr^ ( ˉkY2`|:1e1p]F|v/5q 8Ā^wtawſ]嫟rXoۇ5yZ\y@0k v&аi3՜*-Lq̐Dbs)c{ܖ;s՝[^l P3Qwݰ{?-=q|I鄌p=UxMv7Jq/B+'.endstream endobj 307 0 obj << /Filter /FlateDecode /Length 2253 >> stream xYK6Wj/![+Im[ItsH38&93@q|D7 `&/Wd}:o6o~rM zD)k-5\7{ֵ( &RZa jshU=,XcQwoV"Esd٭+V5"]vC97 ]k0Q6xV lA?~޶a_c}Z~ў0L {~;JL(CUwUtEQZ! ǿ0Ye!Rb+"B1j.D};ƇRsoZww_/HRQl[$Zɹ 뾺@ qzМWw7." n&X' II[)T;XXs\ۦ(9j:D2:Uf8\C}ش@F]R(GUQr ^L%R]Qr-M|62]'2M{৤Dr6ǖ%3%#˂?{1a닒I u(ԜE^stt3PC ݌}Ae藺r,'ҠP -ϙZxg\V v*v|)n„ms3S 2qET0 άDYd nM-ը]bJ12OP YI|E&l`?HvOK.TKʱû昩T='&R3좀`H&b@v~\(AfDq,ˉqhC+< &9\rb1C`t St_*LXH>$zO>#lГA>6r$"C]*r= 89\r, ~1BqԺ(+Frt@{@SJW5(/h$A)8+WE}C⁔& =ԍF{y_.paEeC}VϩӔ_>[\~7Ydhi6T崫4:ң˳w?ߣ).8j߾!%Y A*OoUA|̜"pQ p׫&֮'"Є=# VN|K##]VU 8=-X{8{ `p-)Of"EIJ>fKf-0me=p$}:TPs72Q%pIF,[H|vDƅ(ov^bȁs =25V@#wC%.)^Λt\+_22E^G0'ޤ*0b#*KQ]ڵ!@T-T…mU_0Z6d> stream xYKs/EY7n%=lj(5E[L%zHקI!HQbP%LcBDDDu>yȑTr^%|[$\"HRAS4򮬣 ~ʻܿQB^,ڢ$XTC ,)FJCR2k88I%!yWAL`xPvur 1ڔV#J$g^iEmzyRS 6\sT4]yS@b+>IȰ(؉B3c&0gi͛r`~A7N_ÉԨNRa *M4h$o$<&Ov5 cQ ,mWp=nufw\lF]_ny#`1"&1% 7 S[$]C< D܏2 >S/)"jh$[c) sh,#.I-o, |gv M07 .`,z83[8F: 5,CO^4Bk;V{"dгk?9hP˄O2Kƛz7"+ata}͵BTŔbY ®I*2bmz.R V2@-ٖ0U 0jG>ԺQ`t+Raô8 #1pr5EH8|aI#&+/Юv[WT"SC>d+dvdA3sUoNAc78?Cxj-bAyDcA~sTϳ5H`#pjLTw&L# gC*粏2RtF@MTpY' g C!C)g"^k6}?UKW"&=Il {)(G:/}m?ZbΗA) vle{O)&T`T[7 (:X(6b̪1 !w073Mj}2}- 0,bpyf*fa~D&#FHEНҭ Ϫ̲ۓ=_ET;M?وvú9W*d@Ci&jd8H}B -dtnr{DZS`Wwcㅍ8bs}yPAz(SӸi5uU=̖$o%lR&fO4ÓwoUN ӣc ApbPU Vk~[t>M!31a^L(>ބoOǎ6Fʱ<'[cBqD3l͆&5 cVװEȍ4F^LJXӒiA0/e[-Q:\^!4ؑm?8ڰҾJfJasM%bzi/(,v(+Ra3L]SBb]stu($}jN'5.i7q̷u%b4j+5)AXR>C Bd=z{5Mqx7gܸ={(| P{0;\cQj{ۢl1Ftfuvı3= ؂1Kp՛FԒ))IwiQz&4Yu -vM5Sy !ƗI*mmݦ+:&˪j®O3b~C5| @:~^-~[L5h.aa1h+Av6J|35g[b $z[7kT:v+FW5&0$n[*}vF$]+Β3!%|͛&a8[b07lǭaŋ>8'>]'s]={ ]v~35^m ^endstream endobj 309 0 obj << /Filter /FlateDecode /Length 3327 >> stream xZKo'@"@8H$,G@(k,swf%UMvK^d8z~U5?;]t]7/qF=|w"l;wV[]/߼X,%L9U2--gJ8ʸ#>1IX}Os:QmOtWR 59?U !/U /wƑC3]K%eL4c?qAr5[\Q3j A 8^kKj)UvWKM1jZ՚1ʘ <SƤVޒf;δR[Q%]{qWEUK%(z4('']pf/>TZSIsBujmIv^x110KWQRU0$uB'ew7QLd4P792)IW%-/ rg.dhL0ݍc3TE)XrhߐܢpKna^c M- e}Ak(uhMƥQK5לjw5T+/X[#LxcFCtPqʸ嚴#Hl#Cd[`i2 uuU,O6)H2ѴǦ@C2zea""2r`Gn!5J8/S{@ 1Vdl1GvrS܄Ll, } 企qUFs8ՈX.ԋkn@ ȟ0&opRs)HK%\9d8Kd isN1|Wq]e9cqfZCdCApO3Ik0Ve?jB_XP*02%zRZ(zZJr+?SN Q?,(o-糕m,e. ,Tq_;R-0/<(?hUŽ!F(Ho2o3BedcK$JrF8jYmh(qCQХ!*x.d'oT&x#O*ijѢ믶-@:]O_oyK0^_K-GC4ϭ\匑64/ayWC{{Ne(K^ C{+X Ș'cd,ʀ⸫j6Yʬ5dqG vV%Vܱ .n1(Zbt8U7j%KB[=5e[:WCsx߬븵T+Ä9Ԋ3D%[e]&0[XlJPnst} 7cEiгyQ9|Hˌ;آ|gyO^oD-sPζz4XgQ:xZt?Lcd8 fD lz}Q4Cš $H۬`XBk>!=ӋT{LE;,➘~aKZ _U5FQ5ļZIytȩQeu9 u_ֱʷ z~iUf{rLcoTmtɋ)o[B L3c߬'%RHciFLhxbwC;e 4s.R0LNi֗VO )sUN1ޔ֚KnKE.xgCRa҆vֆ2ͺ#aY1,Er8)ݿ>[LJg@WoHn|Up[y7FUMqaUˆļ^ϒ1n\@E+}Cn14<4έji&m3o/3R^{`VBCk89?a??]*:DZ/c?~KC/B"4jv%UuU7GG(G5?̏v~t󣟑g83~zx9 -rendstream endobj 310 0 obj << /Filter /FlateDecode /Length 3703 >> stream x[Yo~oÂc vAÈ\3#R̯{{R`;3}TWա7 mn~?v\6^}Ψgo.ߝ)|#FڍՖz7仺vՖQWΑJ)w\%Γa.y/Z; 4r6gDg_|(kaT2Ɣߌoct 7Vʌ'xZ(#y6].9s3< s +`r{RjC.zI3T[8e!ޓ824s ]̓rLo]2VXO+fJXʘ52%I3'ǵ͙ aԤޟkr>dK~̓lTsy- KOH}% ٻ0 Ǧ`1’c\rQP<@ rYԈKdz?+VRn^2ʭ]~M.v ,xyrR>_aGpy]j>%)wn78~"l8^k1=#T:ke5edg_::!FAHҕm׊260ZW vPܭ~nq9)_l5CzKZǕ k:[킥AZKKGK#MΆS`QWOn*|))Q,FG.9`2U18 JJ p~HR3}w֓/2z7H$ḇSH%(=ߴ)Â$HN5HރTC\-ًL\Ty"{%b(R@ m;\bPSٙ_4f4(@~ bqEN{R{KԀf>h㭧y]p(y<k*v[%&&jOD9Rul?]]fhc q$eQһE)`D6S}ٛϡSFA^t[˂IDd4`.2j'DzcC 4  (̾Ŝ`9#e5AZyn ,ѿ SXEUǥı Ԅ'"r}~-KyCp h%ǤMX(!|Dn9xf0͏v2BNJ0@ dTi!8N557a2WVyZIb)6$n͟ nG(jkC F!M mJ`,=lo0sa@Zan0?!K#wZ7AQ`r9)6t:daY.דd\)lkIC> j].,APp٧&5_0+ŏ.oTٲ؄gbti<BEpglcQq2 1,BPʋ2&ȋt!X/}! a qw&rB<+5'j0Μh^p΀[Mv4;]@wB,GZc"7D:u9e $ie!@ui0˄˳Y´DN)"L)Fӷ1a^4w[ U֖', B(!ȎtR+C:Eϯ;59X_H0W&z滝xY BdGLQ65]/Y )SV$,bC)]8R)9O%g~J;-2-q!wאƕxs%{hiNM$aafCW1ɋ] N΢2xI> Yҁt$1If|"OpI|2k!hŋ sd;~niK{"v (ئc}BlH̩C[b', vH꧶?}Nr Z+\$O^.oMU#Fq+mՍ9vNھo~:cm}&륺n S\a* Ñ#f LR{ f)ru?ǮBRM0k_iDаJ^}S!aׁH`A3GSS]hBlkIauk-t1uu )aם-)G6ߜrrVL[εfaь<gРĖ'#˱tOBd<>l.endstream endobj 311 0 obj << /Filter /FlateDecode /Length 3570 >> stream xZK丑{ 4:ig ذp=u:KLJ]oDHJY=AJJ "?mmW?]quݞ6[6Q<| ]Ֆz77+"W{keXJ*ܰ2ʴyҎ[(BG|bRi_a#Ն4mwJ)B6.=lwR*m;3닎Gh*)c|׌M|FlDͨa&Fނy&{zsg#/Yʌ=#iQo޶kC Ҍyl$T+/67mЎ='C_nw^iF&jV*]& PFS+ױI{נS~3sTeˠwX9畋QΏj~Ը6ɨ3v8÷]_;uL꺹^>/>ii-riߵv"Uwnе}:hSwNpQݰleK)%O0F9w1H yR#h}HEud)*60vh3'p\Q#zP'tza(0NM_1*ONv';i-5ovp4} V$olw@<5 IHRN*]+#w(C06> ,Hn `A6,S~KNv[qzd!xաN NaoBA$uv-Z%.$"`wpdK4y4d\S?`&܌hq1TCH"%P!N1EE c|;c&lMnVCZR`aYc vШM鑍sm,?G~k8CN=LW²#:| 8mϥH/CɩHsSd#=rRΣ$-kBr >"+{ړ>Ǩ qa`X+=Ɇow$ߔDDtFQ*Dqbm#} diA?4ǨF h% |94+sJIF/OZ)\Wζ p2#D:x}K拄[WGMj`䍚㱟ZӢ1 NjZx l/tΉ!.eK $V͖p/f9*^#YY]kjLU~JH aJ3Sr橐]3Сz(^TA£`/'Ie8e3\KjNU1*l K{XG. |T" Cc \`_n-DŽmP;퍇.7$ `D᛭yT: 'ࡲ}oVn&?/vGvՀL'}a)j 2ϸ"`$"v2<$;K(d'JK! "LR-|+l@fZV>ܾ*+ZǨJVއ\_9K] pOY*]w‘Ǻ2*LXA.༅GPj,+1&.#*#Px42 2a +Pp[t;4l(\+\ &O[͹i剭n5BE"q40G1E.rgzyOD͛#^K¥'KB[ ͥy,ܟoVKQmendstream endobj 312 0 obj << /Filter /FlateDecode /Length 3302 >> stream xZoFp `ugQ4$mh{$$'3K-؊_=g ¿awJ-uluoa+VF <ח}ΈlbEW_qM aԑ_s[PyOT(Ҵw/R:JS|H)a y[D˛:z!ZoeV[/6a((U/7IJ0f2-4՞5k!WFp^HUX /FpS8HgH˝#5ЅʒO.ay_yTsRɫo>ŮT.U@Q:yҏ֒(l# C2?s72(! M7r 9 `;&q PШܐnd튔`%A6BE(t|u]P-Hs}pJC` 𫊎 RQb`hME7"C S& Ot2[jBltaB2E)}lIHJ91bCBH5VB&Hgemԅ6, /M6S쥛%uC:S)5b o*E9GDv M>-~ڛ6k`R\ `#$Lrt1#qzKWOB> +>a?USNX1q ԭ&ptbfF}$u6YB7䔪`PY|XFJ3CmS6T5J%wj=d̀bִ&Oy&9V*O f = iņК8}׊aZj.놱ҬNc!7a@8 S)W1"דy1*E-e;OнX F'M}hB$)'=/.B9|oi|D#)BIjL>\HXӷ8leO2yN /xʄ: o yRlv|d3ňDP:Y/bap~|jQ8\Wc r2 R'''9!k5 Igy\X8 mMiTUAz8lej>ľ2n!ՒfOYM4$j4 ?v>mstrlìP4l3])X5XHan,N0D-|a&$5#cy&I^3ˑ1q90q!YK\,udf~uy-uNUU{K{KX B+,h=<0CY'7o70x}CݳϒRTm{L;wq[G.Fa7'#j=~z+ݾVدgt"V}(o7r>϶WO }]sXY|Waƺ]4xx. χ/w~ujW_yjl0? puy**Dcy`%d :֨ $|يSyh9l~?,s BZPJ[ O||pV?yn1}\p< VPG[(Q n ;tA%L2]2,A:$~wꉓ'^we}Y'*p7{>:'Y!άuǛQt87rOa`,P$_ s3gendstream endobj 313 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2343 >> stream x}VkPga #!\- 0塈 a #jXcʍʚ5&e`+F4qMcQM*ts=rt Ŵ)[_Eor'1?8g%8;̔F r3nN0˒R32Q)q[.YJ*ʋ "5@EQRT DQTN(HeR+B#GazM͎Uzt}g}NNN`zR) $96[1Wɇ!Um`;@Iў\bf1T,F'K/Mn F(>SUD/HXXM,{$F;UI{8Ae:C&RV3߯vud]'E*X z\ XPcRIAAŭSkZʓO*r I FYq#iale>WnD(DYO/F $?Ӿ?`~K1B;ąx$OZ$8P>FJa[Rdޜg.n78[R 9z>&b#[@tS }I=;mOu>lH6/-f1S & +Pϙ g:y@/A=8؇gk -J8Eqwe N׾'F22RV;K"^.2{ϞmbMN?嶫fha.YM% 7Xs;ͩ3oUtT,7B ϱ\\ x3otc5 $-=w~~zF;H^={߾$ERJ~v rLe'P>yZ]gp-v'[_̧DDK@s֙L54a+V\ymaKܾOG~dy$+mn=[,s=+3&똨uoKf-$dW8'[t \{n~BRwz$m:KUp vK/]z(Bt@F>+z!XpnN㵨AE< > <|i-)zǛ;IZwlXX 6%5P #:/ږ֘<єRs㛖ψ2$㛐y ,a#QO߿rxԷW\4bʂCY95c#9);ppSAsiqi!YnJjz]n[[]C+O XX..'NX+jb6Q@-Nt' mK~&5R:J7Ý'[W[T̏ځ$k\\RR\5i`jۆvUl~T0gG?BkvbcV.`H`4áȇ,vƒ{u厢O1L{)]S?8<[gߞo`u!g~?|yW~0z3O)qk~Io /8(~c8F8;u[,fsYذ3E endstream endobj 314 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 933 >> stream x5kLSwO)9ÎўKɲKJ"Y nx"TDK- 2iK)H[ gR6 V cfa nd4lą,<o<,2ҏ3S+8+]7B,$R;қM`k|+170,S`2Ğ H,$\Hd:V_}G}Hg6a9CrD$?棲U?FL~v$t~̧S9L.}sm#D X*h*^6sg#_7\9p4L(_!M YVf_g{oTQX{86d\buw𠧾_ƒW KȸsQA1HJ8m`1?x}耫L68XK=M^Ki~ lEXȗW{DMAm*(VA)q ǧgEʭ\8H/,h jq%1`;AW}B{aOƬ:7Cٯ꟬,@b(H/W>Ō.\Y]T/F/60ֺ6> stream xWyTea DͦLΘZ1#9ixEE"\{^1e[P"b5bIk^>86/I}k~}yXx澱i[^NrO/L71ƿ| Ńм<406yrH^/(,%SO̊,ێ-b8,ۉ%`l):ۀ=`a<,k_ _q_LpsVf3k欘3=1*dy?gA En-UfSfoT 6x]񽶛p?UxM{ MPiG-o7{rǹ'8rU$DBMn<"."+6eNIəWPXYstp'{Qa9 ƟEfG& L&u2:y6n Pkf6تQsˮzˡzIЍ3 @˫mQLGGU\A*0MgnDOI![?c'lݬ0I< uE*Vt\6䴌Dj[ۿ Rxw]2z$܌F7~u @ɗnVT|қ,m.*C`Ņf:,Z1|{zbe D^2(A f-(Me Ne_!gSՊ}`\4<\:B\V>/>8\% 69;Mp.7]ޭ>iA-V/RU ,?Y!q'޸kZHyV'[Мnq(I!dHsECٜ;@Jx~Rq ?L:U b )RRݚݞM"e,5v*x݅}l*{A) @Qr9+=">EwOKSo=*h; AD(! K<$B|6>OzBʾ]eq2V.gJ̋QJ \オrXM|P9;QZln(cMJ^6{{t];x?-~{&7WLMaF]ndoDNKo2:2~իyVm'ڎNAnHt:%wi.l=7Ur\l~L9CJ eOV3-V" %ݯ~/7?x4%a> 4_FՂ1/\2-AuT9КTf=>m` fF 'N.'M_NMЄAcVh]fۡf Lwx1z*sBU:MŘ*HTHӂۼoZKH@/O"209yA;h^ڑ- 9j:zhgSTQS{H=}S xw0/sr.ɏ6~ ᳼"c2i1M-9[E/=N*{TPC&wPWjk e]%cv%rub^"Qq09B|崖SS6<9c˷V:jOPJA jMKpOĖƛ:__\~芠 .iSG t!Y,'7/W\W?j:LֽW)+cW`qSv? V%B5`[ЙJ)4Tr:N,`l`1iHr42w贐Ch_i`<d`%G*;>cs!ϊ<*"1 r-`frAS ܩ ZCT֫Á 2,ȴdOq縵\83|c ʞn phQg' UvH> stream x=mLSg߶ =f ɈsYdA. ́eVjGJKiiRVZJ< F` ٲlM]BP5q1 ^?\d$ANd2fE֊쌢uCOjpH(Au?ڸgө^ޘBRh GVaDF%Y_|LH1,aLa-ſDEbUnkVv&><[Z=,kwTˡgAC> stream xXy\Sֽ!{E5$jTjJqD!̣$; 32.X2Ց:>ϖWU+Jkms_zx/^7嗿sgZ눨!6H$r{HW>~QJpc,M{194vl#FDf!o-_,:+vޫvZ6PasM4bcM9kGܨ ;5ZCMRjZHmQөԛ j1rfQKej9<ZEEDP2JNhvQC);*zrSoP( %PIMHC6m $sLP]vb;aabA9|p͈Fidc0;=5*|UiS1۲z09/'<9ȹm1sc O[xaK7҉CUv|8Mjj +Oeamrv61OrL5&Ԑ8%b89JJvxA ytUX]E`pG'"qOU}_ z(a0fޯ;Y43pWċpma@#EwYMQVHUrWE*Fo8nNƭ]uQJ`%٪ɪS:}VH5h{E0Z]." N3 Xnaέ7dnE8Nz=M%2>ClV7 4@Vkv LƛR {C=/+] 6Vo8wDR NEwJC$买Eu`&O‚!r30YҿS-a[) uEąHB0ʶßWSnJ՛Jye+nPa6cתHNhj9C/T6(p ݘPii6."в=e5c.^xl)t#e}/-l}OI jg5(PCݒs_‹),iMǢ_JeB EuG1X()Ę*vz ,ca>t2Mwz)\ 5*Qܧ@vB9&))5MYe  7UD)ꔇS&M<.ߓlfD7!NLf$VQHJ9cfn~FFӎV %c}Ǖ1 "+ GH;Co(L!v3SL8~tTKȐ9R+ ᲪIm 5qWsMP dǻiŢҚOp?WA=[AаZcS1訨>^8 o]ćӯh)r>:g%;Ԯ ; D_'YyIx WJ 24-<Njb)O@(u!zFIWk0HjUIHJɄ,CP&R! n(ʼnqِ Yp,ސϫYW:jOj oCTus |0Wq9p+G''>m}U'J!RvȾ r)I.C:ѡeO tVMvBu:ʈ7&s.ddk/im.lg 2 b-Iɗ Lu&r3yutm ؑ]tZ׀!]%R28죖b Llh5xz(zʰfiUGkG>yqXzf=JE՗N%+-3)QvM [`9.C{<,)π|EF"$t@G W-%l]dpKGFYzَ^179c#clz}سs kaF0Qw;Z9v\hr +m2TqO\XYs(8B~c?%AIoZNAh+5N}' 6e<P oÌ+_7cٱTS8j);҅IҒ}wϟ -Y̴En+ګhBa*3fq޾[G;;~1]JnM0 b f|S>|#.@qPA:9 v3؊2,'4j6|SnT -tÔH|\m'r.Rܓpˊ' 1O*R\hme-7?Wm&<ʋG鱩 8C.-:)p] Rڄ.~wN~=ޛ "CΜZۖ4E4r#6[sp>n̜O8/Y-~`TdyY:]^_ع;A=R 9‹ZwQQ%1$")y8Jr4Dg]wS)9d@~S6pH;qPXg esf(dX{W@B"c2'_;n%p77[߹lpi|JPqL&B {P‰(jsNT'(C(TW<+2 $ȭVh+c 7 ^Y26 `m40hmcf ͅW`m kLH}ޙ;o:<2F fSxGvďe.RVA z"A itM ''/ ֨2;̱n<R`ՉMRWUt߫r2Wk˺08RA>yƾ<%)}=p΃̌\/\M1@}fG:DڄLbnJ/5ydžs9^`@,- F4&-3%+_ўíN˴1M;brl;ݙ=)=>w,+c_-p՞C8xi>V~BkzÎVc(X)37ݼ֢,IAi̻2B~*Jbq'̰^0ݛ9\EDMĞ8~~;];hqn͸']0~zf8ȱRV!*;\sCpKƷJj'_L|3&[ ,{n-܊4Zz W[d! _SVzEG48mYJClۆ̵;ڹ4ﹽp5. _obYm2Wy[Nr/tN-&Dy}&X;w\}geyM[c)%e ndڏ!9e9~Z?5ˑ :Kܨ9Yѽ$}dZOYeHAE 8vC,:7 Rs?>>=Ii4Q5g[zLFjV ǖ%دj/173Y?܁[$c\y1~I6f)ĥA7|Gz룲Ҍ) :nԈg EDr؝&{a1Q &%IVY)7  0ad @hƨ9y~{@{-Zt5&ѣ+W\">eC8CF×S#LT%$0A{*e%ε-L"\8b+{" t[f)-,Drv>`닸4HIhg< WYq1U)Hq iu)(("( E2^%|)^5ݏgƏ겲jUQj:[gE˶n Q(=5}\1Id-pk>x1vJFPu^{ #{Z7Ax9,qG~Cu6ս-ϛ6yXxB`CW( KU&{[[8vyPϑIDPB!"QI ͎::m\ U.,:ޮ{g7dmJ^3u)@"endstream endobj 318 0 obj << /Filter /FlateDecode /Length 5742 >> stream x\[o$r~_~1'PӼ_l!cKk$NJA5gqgaW|2qAY-5̄_˛t[ʸΘ "21 P n-~W1:ސ{R ("8s 0Cw 68)6P+u?a$4bGk Fdiv[C(A2b;9v.27NFsNz2+9dIL|[ KW|6'CO(m$UKg6Ana!nIG(yqI%,S&J*!ؙL):ڰCT*pHWU6ߤq }kز]|e!9vސy!ɇ8YvگwY;|$ŦQ%GYAqF3 ZDx.ڐ|X,f)w|)?Z@gR'"&-@y))kW+# g$#nq^4~Q1~ i[$r~v++<(MvdTo'K ;㘖MY'G%Cׇ@,RTi&y)T )|:=ڐ81 *`1’U _cWRU'9lx䆰j+*p iCJYb})k3i͆|I؆OV3P%g;4-tc*9AFU> x`$wm3*e.>FQUQH$YFJ]9o?׭9Ǒ 4锴(&|vN\a$oCþ9NqOzYR~<1g&w3@#zO+1~ I\\qCZnh{IvFZ b'RhG<`~ %z O 4,RBrF>͑J2ָ2,xn,μ:_1"_:v!$$(Pkr .=RMcDLp: m ݪɕ#S &dJgr&C@R- Бx+NSNGa+ [vf]ʁ]$z8Ba0_n,{AW oyxݩ.bfkRYMAICN #??u$sqih\a Sw,}Crp_NY0|#@J=0ud?ѦAATxv{Wxnm&Jc%O|đ_GJ5'gد v .V 'iGl.3AB㯅myFם[- sO<{!e\ z2hvyA-A#8Frfrg `bAɦFy#+%~ߖaSy;P/Lt-CO1/:Je ٱlHAQSbnH)3%iq8Um:~ .V4\IGc/ P{aILL-Z;sY_l ev]8 >)6=&Vij&9CG;(?#viSA]E(a!|/)< oO;1*iG^U;-NmX W+1 ")0s|?@= @c) s]@`(mF }>!h-V='",bE y AŒĈ =8Fg&6pc4'/  [&ao8l m!W~.0~ݿt Ca!4}90@X''sccL&F.1)}2Zm&w4c;l\0P;+ύaYRL4gG O6\> !0ahl#88'a25eʳ|1ϕ7jBJ?o͸/=sAe%oR۫_W}iƫtEW(΂/+W" hBkJYLI.cVpI٤fZU84-J8h'-b`/%V.sYg >@2OAKd1N'o>|nW':*}]ir֫ :oZ'0l#b~l4M9iŎ>0 ddA1Pc.}B{"gx<r€&xw;|5Y!IY1̟L&՟;SdV985b>ie+ż]pB,/":da >tJ8m8,rj|mՎ-j}EeH 泗gH,3Wi5 .ʼnK{SA2hKr Ǖ >B,`۱dΨ3'\Of>7't@]PDB|\N]),ABby6S=C!B8}ij5jod?*u.d?N4Rx gk |:3%#P}].ؙAZΈ0C^K?c I z!c 4 C\.ŸQ.@} k)Q}xGL3ergʹ+_Vݸxf7I)[9,PD*UtU/a$nקЄA5EB1Gr(˸HpLaxM[˷ )kΤvxrLxcB8H!v&uأĸԾVfQNiaB2a^s2)ҟH*5.& *GFl٠tMFuVxWS8 Ld0Y:^F) ̱ o{@2p$ 3ṶEDWO1؍0GAfZ G;aq?PH~8tZ睕nR S_`Q1 :vΓ:_ U1g6U#XaVSQpXrM*_Z}v BnfbZP 8Y,q2>d‡,:)b2~@ ܰARL @cV;yηU*GJ_F+QeY:D?b []шyui5`^zƏ0/Hy.8QI*), o 3/#<=]!KTI(/DӦu|ouoB5knRK]cN{ؾV _~8OC42si/JR).F"Ú{ K1 d)L2܄T۪i[nGx4eT_OkKű${5z/W*U9cP9 [Ep/rAXF[ AbdʔU](?U"K r)OUv "pmTO^sY{_/KFElIդ`T֥9 1.4!Gi41mEk#/$ \&7!ƥLSf:K^zJk ^sW5Djqzqٔ6Tendstream endobj 319 0 obj << /Filter /FlateDecode /Length 1586 >> stream xWnFœ4"]Aj7VLE%G=8C/6+V{&{^(yHli jʳu?AĹfJ./(%P+ 0SX L^P5E\LAoH%F3CڌpYC owQi}R`#U(9NdH^ `r1/Z` s`ǫ!u>ũ/!@pz=3RjZoZ%x&ԓ=+@) ڸ{ʕR?E)mLJD>n=KVS2v9&a 9TCޚ7:0/CCu?{P(DB\&DmLŸ`MB(Dʗ*v 4i;\ڱUjAgϦ&ti#Fw[YhR?)co׫+Қ,z<~|( ¡"wOy wWCS9~XgE6m߄c|3b wn9lM6҅4NU*6pj \r?6[@k-!t6>nL^0UwGS J"4-秪3'^ME>`x_wT xC5ֿ~ E֤9Mhd!v~,;SV/& MUp 5s YnB~~-$"WXBHfHT'ӱSŇ?x7k| OY"M#>?JR\Ll;op gD)4rъmeE^ ƿ4hИ%>|_ڜ'8bVo2AWt;Φ0e}(rknjS?zEaVendstream endobj 320 0 obj << /Filter /FlateDecode /Length 3587 >> stream x[KݶϪwqw ߏ4"hhĝ^Ȟbݑ#ɏ9$fF ^X%GoF;^v!|gZ8y~z}-R׋oY5J&pusqM*F3ONc%e\hԤV/ rt*G: oR שI_o !N~pGzlc M%eLc߸ 85-Q3j S#@ ?^]r(k~`T2Ɣ?_}]k(w`x5Q SP ~<}?1Ci@E!Ga).(*$S|7/ߏ7vp\OGث8I_WW7*SoMflZWh4YMnam/ȩvs&E-?`Eu_rJ2Z1{eu6oCYZlC\-f`{"vF'EŖ27ݡUӌz#X dlEO+WЙ@)0ϓ(e*Sq(sI (HnN!n|R<5V2T ս\#bfжa 3f $ CyEqa}`[`yDLG[S&wS.+׶S,fcT97Cr5H:>+1)OWIW?tA4UNޕ;)>6EPJsy|/=$Gz?rǡ:r8&||m c8ϭ *Y@ S gh++;Ctg~We"02pʨNa-O֊Z!@)ʌQFj0i (n@4:ONõY68kT yn'Q3Yv"ɐY`!c [ƄStu_9[݆@ P5Đ3k˂`m}EՁ7wQ0fF}2b:Nibg-&c~Z1 InG{Qܗ0 ȟM<pr+) fVZ)gI$f9m5R+jG* H߰ 9iP؈<<D~*?OTm)<무+/Ȝi(Q,]LPbL -906q/ͰwE&d?L\a&^*ϋyfQ':>~UNT :1`>N/ ́KrqtH-V|3j60=l#u qԖ*a٦-+Jyf%pRO=%Eᢒd}懧@4"Χ@$VxӤ>KShN@}0PjU5&:IS!QGt&%C> xNhe $֙R*O8\ 3?X}dq 1-s.l D='onvRQ%ύpZHre"7~hA\ E~ &\pޮ8Z4 4&un.GBP6[=˹9 tZ$\yzuЂ؊kZc7a}AIĵAxuɜmo&"Bigs8fc'W8 "/VȭSk(*9b' mfF@c(A5tg/lwTjXߝ6.k.4HFuP+&)19N ǒrW' IA~m蛩ENʻQ*rA]k&3릝`/XqI뽺#ɨ'o۩,<672-5'U^*7 vH_ ;&w\$obGqY1U 2E3#f](Oѧo#; -r9 tUG)|E̮>20?5Xn_… qy8x[c X -UeӅ`uqV ",F=?(D?p4}%HP5=g.Fr^ `3\,?aylqIp%q%恲@LH~B .߸Dߵ ?]^LE5{|JQI"UI) jjE|R(:,痋endstream endobj 321 0 obj << /Filter /FlateDecode /Length 1094 >> stream xW]o6}ׯۨbMbPh%ɃbˎRJ$IJ%ra3`:sy<Ә?"ovYUeJ˘ hD Xqk1p/56OR AMr0دA{NMnDoFb`xL:B&ˇr}@x2nNSP|f }&dnSI`~Ips|A^xкhPGMұK,^~?A 7Nv=Q5ӱ3z{cMqyBb826Ʃp-Vy;bd@&]iVr}̛u˺~lwj_Yc {imV6o/ƞ`ϕb!% )2VEXc[rwi'TjL S1/yc{zd˪ADNw(w S\0Nic=7&΁qb!hJ{Q5%} @$Z``<DeQ"JLPn>:[5a([M=  ]ΘFΥPkQoLͽh=P;5)LcyOaQձxۿQL)QY6hS7"I(UU*jt>E3i aP5_')N73 o`%dymq *YTF@]sk).Ir&Pu9R9%'\6Ui2XuZIU28IꄠB4C=¾dUPq1vp|!k٤f뚀M* k21hZ- :h:ʬR$C۰#W`ru ۳{"Pոg :.\/2EjR"\Иi9r)a1 0Ô)|-*ٛbIbȊ"G9K-( L-W]a?En@endstream endobj 322 0 obj << /Filter /FlateDecode /Length 2910 >> stream xZ[o~_(P(h2K H] Ŷ.!ڒm&t/Ιj7'Ĺ~\֌5a׫+og篵ZsF=|}v ]Ֆzg:{zʢT2f eZZ< pq=~bR{W|GHGa>j.u>h}_ &!w8#zhڢJʘ&:~ƥbQLXy (|wq(w+>Xq6r g!(3p~CRmai=opNn q+D5{a91zkfN74#߿?e~ ÌVFW!nDޓ&)S~iG>ՇS;H ;VR#z_rXθXImA h@9.f鏻l$M$(-m./]q\Q$i೤^mBMgz|$oJhNG Lt ,D"ɫ۸)avNF >Vrݒ5KG<4q8ӼhJJi&䔛) ƊqT{N0Ug:ݞus '^Y@pHc{D":#f] ړE?>| \dhQƤVҠoM𐧥}DxW1ihƐͣ_nJ)W3\sF{ұ`H|DƒkGC"F'fD7P5 HxrtV9Sx[ ׭'/S< `{jI"`!LU4qLkRfUKfУc篵/hjjU/O(ES6v#T_OHVfw pAer'DB bB-#'/:&b֧\Q*n9)p՘qMZ ?68c`#$~˕5 MȝLrIE'Y5)٬08qvIغz3 9n2{VHVOד0)ܠaQABT|REj} W1jT'ՏpR.s&nJ8، "yi3 Pڑ <09XkOWZ"l FP Jjq\pD3i0 Z xzbLQw\Ke<ۜp jbYXW ˨:ֺ y|H ̂,Iɐ3=D5~r  ,‹IxyX" "ąto'07exGRv/8JG%5Zړ%umūm!4]e4&$DI1K}{Ih. W贔Rp`]v #J+ʙӋ< BM43X0*(k0NZ2&:6g9n;qNzI0yRh4N ])%B Ee˘[,:HcW: v/]k40Mc.gr&ڟWxF)DB:a U'j9_U:  6DX%㦍sb ~V M `*Qbh?zx#w}xhNE{ܠCѼ 15Q7?=Fؙ~E^]*X ׊J:2e1m8%S4 ~7aD[0: X6R=hw\XM,u^3 μ嘿-V(!0nHtio~مE t^h.v]jƮH3 yn!,\,"^.ۻN d$c :=!FQ {T_8Jmw}3<R@1lS${2\dYFIQwn}D3 y $.nʯMqwdyZ-.Rk{g?hh~? endstream endobj 323 0 obj << /Filter /FlateDecode /Length 825 >> stream xWo0~Lû6ؓ:ݪJS'){J4#A%6L0vi<>wˣ ]0,pΣ[]{;&TB7sv+эDDntr/~p>L"y1ʀ3gJVP,BPdIA~wɋM6T,G眛O7Ջ|Ƹ!!DJMw>̫EotiVE- !;Ĩp;PTJ t2ʭWkiBey}zJ=?J|F[vRTI/ʌՋJёQUNnJ.IzT(g( $ݿ8Z+L@3mtVM'饴$q^6_[' \9Nzy;/6ur  $4i=_r߻Ǡrküc+:.yf0'ImA=?SfdPj8M}HU}x0NVb:?':*ɡ}q*5כyHTpJ}mL/VV<$~'ݓOܛm~af U R]r?oɧ8]׼CtSL'RNH^ _Ya)^fӴAh:5j{(.T2VHJֶt2d|4]- +Gǻ9`lA1>=̥R M$Q4h7N@t]]O5]I/H ޵qF!߹5;qIO66endstream endobj 324 0 obj << /Filter /FlateDecode /Length 1826 >> stream xXKoF? tɲ6)E-T=Y9RKv__.MAQo^ WA0-ԟcw,ޮkYP-7 B 8V\Zj \}oP&R0shz@ @}ߕ?-^"Ĥ\QY?.~X/~[L Ee^A -4c([$Pl]omiN7u)߼]08 !84`BEp~p. Ơ?~W(.1Nr:?,C]uR \DW7b&-Vc)qP%\1R XX}YVg4rދh)D! Q$}-1qX*K64%ȔȰ2î$L|A>5 R:6E( 2t虐Ƞ #S?'}AW˓ίPOx8O?!ݮCSW;#NmvߴpHmLۮ?Ե=U䆤6NAWޏvooOg=-Νi.~g-;-ڇIxv^1վo2~lE{6X{uӞ33>01Q*_79LB]0 cBz,Fq NAV~X"@hrAi AF8?AW d(qxt)}5cJ0Wk_6< ЦQl{+t~C=on1i %Әp@l4b&U)_R1 #od%8Ŝ޲jyfdc]*e4Mvzz4N;Tqp^gBMrxUE}"DsTwQDEmB<Ŕb:־ycl\`@O fUS 4BqYbbUó4y/}\adI8 1oU@}~q=QП6 r%SO W}]< v-PHQܝ\R"rp_uY0} xջ>.sT+#])>2a?kڴβ 8d&t`-;c*dh$C}uʣga"g`"0K09O %B]DPĨr0溉Å &C kg(Xȱ;:' cX ^dI*Fzr[,]'q\br%|SoBKGf8ڍ+ L:fv\tmq ԡ>Iz%ݳMZIsrWm2H %^;+T7=FM'k*;l6홐$cKvoU, 6qK-C=G'ἉE3\MKeu~+ū¾`Wk E0q$l)&5 gFFMQ&ָS%W[?~Y 0}y=1qU]^рVذ(9}uqRq o(f~GIY`W8϶i7%>Iendstream endobj 325 0 obj << /Filter /FlateDecode /Length 1514 >> stream xXKoFWeX}?<9( $Pуڢe鐴K$N^fP?& o6y=}oT(qԱdq>GXµ Z(CPb;;7n4*夵P8k`A 79AuжMa{%ǞDhd3݌f,-JSX %sBѿH3C'3,õ$ )y]-zܸLCL%O?N&n~<^iƘRy'7fr F`!/W/_=$9HJt͗#R 0]fẔqɈEl;y  iqdQPSnvtXa'o/-au󛦊OY(RF(uCpUqRYϢ7ˬ;CS;bW+y$F1$ Cuv!#}n.Fqg \tY)xH݃gz37 K%47M.Gce(jhB2е{}[sFgI$dmDhҌ;ڇyRij\o$LO)R629ZAUPP}qo:bʡ1!x*8F{h56XR*}ST)p!4e8O<:(^{ rNZi{BЏQM֚@0-'- \܄(i*p͍Cߐ4Su ]J¸*n;5dXh!06j,\3z79ibA+Naս{Zs2t;-9z\}6봅q h zIo>~g^`Cz8JO'ix[mh K¯{D.'˫i;/4nz* O.5<(US辝Ľ}U_>#{UW91:ź5Mٻ||lOUWNDp!^t_~j5* 7`|}jxmGXB>UudZ-YVMUMY/Aꤢrx=*)o/aj]7w}\X2!`003p^WM;^0{ %*" !L>,ŰRu7 f7h)Vw.g=kQP>bZkl=ND9sP1Wr.)J֓,Ww h'-컧?"ACnZ`WNGCW:bǂyD i}zlqkgK3f,ru^Ve> \Z{Rh7SˑO_)Ut.VELk$!8w~B|,*z`Tfiendstream endobj 326 0 obj << /Filter /FlateDecode /Length 3583 >> stream xZKs`cR"Õr\]J9NTZFK.w$#sF0 A$h4~%|_z`_ Q<_^,t|i^~A.._XY,J&ly^&Q̓M_ G'&5i.ttNG: 7J)[?hmj%CŦZwƑ]7mqK%eLu_o\`dWԌfk"HJ A]ΘpAJXHWpw+C6J9N =i&WD<WU\,ٵ H>, iBAp {u_|]gU+@E(Fs%|{)0$Dݓ]۾,%uNUM\RRjm\Ë~,%vS(*nM AV%{F3x^x9KwrB+.V^zv_uĬQM]'dڑ@p䮁I>0(rh9qO-w.ɬ?~(iAڛ1*nͬ5Z|\B]o$¸l+'ADZʐk[==UIM$}~)0FX%'!V\79i9yh\ReDsAxĢUFQNj%9PJ(dsZ5Z<$(^njSo6@3x^N{MV+ e̒*zbx- Lk<)Z #wu~ѳk t \ߍ| Iz[mz;UJZMp_tA!&9KOJAErC˟{M^=^[R3&Iuʒ-}cM S˰7悓J0!YR̠m߅QǾ9{Z+J^:p X]sNQH'725u5譠 wDI9꿌W޵yl.@d7mD6MY&q FCJC ؼɖ溃$ϱXr_]"9w-A~9e\"&u{ Q3:NR욮O*)B 袇Vh,U>&fޒRTc,0CzB*z'p%]-O7V{;1W7/,{ŗ I26q jEpq_p6xA `vA ΉoLA˭ӌ|uٷw# æ7Lƫ>!ʠ<&JLM0^'ԍl毅+c/_>[^P5_j)TQ|?l8+ә8tV҉ca]_Jj8zbG{%4z K߷9l/1z `/H}܌}$șFtZh>&-Ԯ}j%P}YgO8K6bhbgHo(˾ ݀?ҚSmߋ.T`%Shu(V1(WZAݮTA詝&15.@cTt') Z3I6,ҩE"ja\]vx x7l7jfFf}8[`)82DQOϹZZ-+¸ np!! ?-BnDgVR3 W.RO,54h3k`##Jf҃fEg.ahyŲH? Q[MhHKCI.`֓ܛ膀hA]H3Z+4B3P>`Q)SOZ?+M: wRzHBCs8TSl"{K~zl +?~Q!ĿFȀ Bdd e>K]|8X H{$X0Jl#]ghڒsMQ$@F0i ġ8 iE[n8װARۓƯPTiM9ȏ0;2rqK]coۋarl@G@w9=\ ;@ˋ>ZY$$ ̹*V=$FrH"-wq< /BCC1T4bbF[s2} lr΋^1nIm-kH[>RIs>1n3-2?=:B]zs> {$v!K"ҿfBYU},QO OG}=I\bl1 G&G70i3.{Q¡NSM>Nտ-B̻HWA5lL g;S88}€}JPng5Ii0p',w*zq pXj ήIFcJ.}v&n.Jғ+tP4%:ai%R̓&tx LjGJ42gNZ¬B>~G:<#=Bw1N!Y9YSYBVzrs|?j=yO{ 1 |zň҇GTh5gt6}+mչWaSIjߐ|*YEă!ǿ0CN&Lӧs!Ϗtxܝm]T)&nǡ gl 8;NL *8zS'3uŌ%*D J"/y mn/" q84X. >uKMJѕ뱯 t"L(̺JRǜ B#݌?ЍN5]9DoBHW/;En>!s1 Wڡ9r3rsrO6 W,k^>=2#v8 O+A*Mn#$ q~KAtuYfendstream endobj 327 0 obj << /Filter /FlateDecode /Length 163 >> stream x]10 E7H$T]BRǩ2ԉt(i`K_~reA>Repm% F> stream xcd`ab`dd74 JM/I, Jtw?ew+;7  KKR3sRJ YDzʅ>?+. +tstUUupOSܞcySمzpgr| ~8On; r\,!<gO '00M~endstream endobj 329 0 obj << /Filter /FlateDecode /Length 493 >> stream xS[k0~ׯMaգ`0-ChPW)ۿ$Wɇ}_hAh_"#sgf_ITZŭrQɂ_1$)p0NR$GX=ZvmPzd1>&yύ$* 4[&0ɾˌ\#jAgh}\USNJ;oHAH6XᩬU:BqQdG"Dݰ*3q$p}ƴ9c?n{Sc;2ўQ@#Wkly O{Ug%voioƘK#8{\~Z-|xwrK]+a]2gU(M}٬ޜI$}F{xV鉠GNpz7h.y-JIr8 Ar,hGH5\8T;AM3R{m%&Tendstream endobj 330 0 obj << /Filter /FlateDecode /Length 1440 >> stream xXKo6w! Qb~HN)8{AZ*j)yK7 9aD2lnӂ\Wgg# V׋AddJ(dVP^<;W,be8[]-ְ1‚) T}N5„ F hGzFBb< ι?Xim^0!p^]DK Mm"ح a,KE( i*qQ`$Ls«#b$ÈaN3XKv֔",z k A92ZuQkJwVCplxϸwH!1*.ÊRRAcvƤ.s ktT{"e ~VPa"+Nc1)O4cd (/8h/yAqs/.~M7ʔpS!^Oo ;DRbAӝ(w%is49SPy<]ʋxt6.E8;)z(4XyغfTYIkC'&12<×9FQm;yK$RPK~]p{m=)"{ɊeIgwH>[fvTa>D Nv5F8\ܳv$m^Qvm1^m?AW+ > stream xZ[oܸ~aPja1_MMR 3틝#;3J$9␔Djd7Ex.<L3dէuozY^kQ-4[߬< ͘Xqi2[WeWyA0 cP3lFkBo`?zy.E,I֛b4_*Y%6J (lAma֢ʿ'Bܻ_P3Qe-'ҠCD}*Tw. u>jA}vKՠהSs &rP?Aϴ:^Bm)6/qKemƤD-FJ v$¤vشO :t KaYjGD}δ@y=[&W>x GW$f"!#V\l4HC}*BD>e 6ʃ])ʦqr)P;5ӱ  +HP>ț,-ZP5b+xSyhsj`_11 NW 5a'.E%5Z.)@J ppʼq?k |r(}SEcPѪ]Ԗ6,3@(GKxN*si2 q8 |CÒ T FnM-k|Hs. n,fZ&laT+H v\)phWZAAˬ} ZfJPlu^H&]pOucCH}^yA%L2ޫk R)jb%J'o\@tho  W`ٳG 'Y1;W?ԇ`emłDc@bi#RZ'"yBLMȅq;0Im1!p)eR\ҖR1ioEۑb Uk6@dJB=6bR] M=v?oMՏ,n]]^Rʮ,urj4QQꕴd_MjܕLs-QGU#Nw("m'NWp ;w8A#p,dKM Wm-vD9LpX"JL*zLwy]^By6@۳gB\ BnуQ}j D`m>f2jB/˶4#r`n4d >2u0&b;(; c@x1ͅYl(f"<ʢfׅeV.qa)ڳ؜SLdtAbX'bU-=+q(Ṕgeӧ>e(d9l}Cdfes0yt=2܏j D`)ƴu_}䃇i]!~Z[zx6pp)R e JŸ:9OjbۅN)YO-T0E.Ed`gO )m=7BE\[E x5 `sq^M6w0 F˳EKhDSyY'ދ۞GQz d0yo>WӋr+^ccJ,V\e+̉񻦓lӯ?^fig͐#x<GcSo,DlBGh)gߩ{O68C{O^(\qMG3\9ys ssQu# nbi4W@*g'eTjbɧ q$sgI&٢]kRcpUv\FaI9Oӗ./2&Z6{`HZ fs2@mߐCrqÊ=D1Mxxs۔D 7@jٗ}LD<8P s;)v7> stream xVK8 Wx3(V.bVD=-X:pO9x&E2/Yt!RǏ0m$xqe(D; 5Ph ZА')L53<9p"e(R%N׻zYǼI,H-C& $p@p$ ,Fڵ$8 V2mqy6nr6vm֙OKL&z@ʉ0y$ϧ}=d]Sgm-ex)hNsJ4]/}~٭ffOR^~%}ֲ6~0~k|&ٳٰ}-Y{d}M]LPGЍSvP1: x(&cQq?l ho*v HŻjaVCYc.TMtQD9W.k~%h[Z^(/4M6bGk m >g \أҹrc bYN^kacuxP,OӠ:(캏W-vH@N!UPwEٿp yN"PNu ! 1#A&w  DsOYrO:P?v=x@$7*ݫY3ʢ6OOYd8x ko;endstream endobj 333 0 obj << /Type /XRef /Length 279 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 334 /ID [<418e22acd56ea6f08e3c087887ef43f6><48203689de6f137207e05e3e6127b920>] >> stream xԱ/CQsj=U"i644a011&PMb;T~ߘ w9羜UYّS[2Z"'2T|T[2P?[-3%̵,mN&2}(V Cs9#ULR dkDZ܋=bj䤊EnD?w:i~0Y endstream endobj startxref 232747 %%EOF network/inst/doc/networkVignette.Rnw0000644000176200001440000023443013357022000017352 0ustar liggesusers\documentclass[article,shortnames,nojss]{jss} %\documentclass{article} \usepackage{amsfonts,amssymb,amsthm,amsmath,rotating} %\usepackage{natbib} %for easy biblo %\usepackage{hyperref} %for url links %\usepackage{comment} %\usepackage{color} %\VignetteIndexEntry{network Vignette} \author{Carter T.\ Butts\\ University of California, Irvine} \Plainauthor{Carter T. Butts} \title{\pkg{network}: A Package for Managing Relational Data in \proglang{R}} \Plaintitle{network: A Package for Managing Relational Data in R} \Shorttitle{\pkg{network}: Managing Relational Data in \proglang{R}} \Abstract{ Effective memory structures for relational data within \proglang{R} must be capable of representing a wide range of data while keeping overhead to a minimum. The \pkg{network} package provides an class which may be used for encoding complex relational structures composed a vertex set together with any combination of undirected/directed, valued/unvalued, dyadic/hyper, and single/multiple edges; storage requirements are on the order of the number of edges involved. Some simple constructor, interface, and visualization functions are provided, as well as a set of operators to facilitate employment by end users. The package also supports a \proglang{C}-language API, which allows developers to work directly with \pkg{network} objects within backend code.} \Keywords{relational data, data structures, graphs, \pkg{network}, \pkg{statnet}, \proglang{R}} \Plainkeywords{relational data, data structures, graphs, network, statnet, R} \Volume{24} \Issue{2} \Month{February} \Year{2008} \Submitdate{2007-06-01} \Acceptdate{2007-12-25} \Address{ Carter T.\ Butts\\ Department of Sociology and Institute for Mathematical Behavioral Sciences\\ University of California, Irvine\\ Irvine, CA 92697-5100, United States of America\\ E-mail: \email{buttsc@uci.edu}\\ URL: \url{http://www.faculty.uci.edu/profile.cfm?faculty_id=5057} } \begin{document} \definecolor{Sinput}{rgb}{0.19,0.19,0.75} \definecolor{Soutput}{rgb}{0.2,0.3,0.2} \definecolor{Scode}{rgb}{0.75,0.19,0.19} \DefineVerbatimEnvironment{Sinput}{Verbatim}{formatcom = {\color{Sinput}}} \DefineVerbatimEnvironment{Soutput}{Verbatim}{formatcom = {\color{Soutput}}} \DefineVerbatimEnvironment{Scode}{Verbatim}{formatcom = {\color{Scode}}} \renewenvironment{Schunk}{}{} \SweaveOpts{concordance=TRUE} PLEASE NOTE: This document has been modified from the original paper to form a package vignette. It has been compiled with the version of the network package it is bundled with, and has been partially updated to reflect some changes in the package. The original paper is:\\ \pkg{network}: A Package for Managing Relational Data in \proglang{R}. \emph{Journal of Statistical Software} 24:2, 2008. \url{http://www.jstatsoft.org/v24/i02/paper} \section{Background and introduction} In early 2002, the author and several other members of what would ultimately become the \pkg{statnet} project \citep{statnet} came to the conclusion that the simple, matrix-based approach to representation of relational data utilized by early versions of packages such as \pkg{sna} were inadequate for the next generation of relational analysis tools in \proglang{R}. Rather, what was required was a customized class structure to support relational data. This class structure would be used for all \pkg{statnet} packages, thus insuring interoperability; ideally, it would also be possible to port this structure to other languages, thereby further enhancing compatibility. The requirements which were posed for a network data class were as follows, in descending order of priority: \begin{enumerate} \item The class had to be sufficiently general to encode all major types of network data collected presently or in the foreseeable future; \item Class storage needed to be of sufficient efficiency to permit representation of large networks (in particular, storage which was sub-quadratic in graph order for sparse networks); and \item It had to be possible to develop interface methods to the class which were of reasonable computational efficiency. \end{enumerate} Clearly, there are multiple approaches which could be taken to construct such a class structure. Here we describe the result of one particular effort, specifically the \pkg{network} package \citep{network} for the \proglang{R} system for statistical computing \citep{R}. \subsection{Historical note} The \pkg{network} package as described here evolved from a specification originally written as an unpublished working paper, ``Memory Structures for Relational Data in \proglang{R}: Classes and Interfaces'' \citep{butts:tr:2002}. At this time, the class in question was tentatively entitled ``graph.'' It subsequently emerged that a similar package was being developed by Robert Gentleman under the \pkg{graph} title (as part of the BioConductor project) \citep{gentleman.et.al:sw:2007}, and the name of the present project was hence changed to ``network'' in early 2005. A somewhat later version of the above relational data specification was also shared with Gabor Csardi in mid-2004, portions of which were incorporated in the development by Gabor of the \pkg{igraph} package \citep{gabor:sw:2007}. As a result, there are currently three commonly available class systems for relational data in \proglang{R}, two of which (\pkg{network} and \pkg{igraph}) share some common syntax and interface concepts. It should also be noted that (as mentioned above) both standard and sparse matrix \citep[e.g., \pkg{sparseM}][]{koenker.ng:sw:2007} classes have been and continue to be used to represent relational data in \proglang{R}. This article does not attempt to address the relative benefits and drawbacks of these different tools, but readers should be aware that multiple alternatives are available. \subsection{A very quick note on notation} Throughout this paper we will use ``graph'' or ``network'' ($G$) generically to refer to any relational structure on a given vertex set ($V$), and ``edge'' to refer to a generalized edge (i.e., an ordered pair $(T,H)$ where $T$ is the ``tail set'' of the edge and $H$ is the corresponding ``head set,'' and where $T,H \subseteq V(G)$). The cardinality of the vertex set we denote $|V(G)|=n$, and the cardinality of the corresponding edge set we likewise denote $|E(G)|=m$. When discussing storage/computational complexity we will often use a loose order notation, where $\mathcal{O}\bigl(f\left(x\right)\bigr)$ is intended to indicate that the quantity in question grows more slowly than $f(x)$ as $x \to \infty$. A general familiarity with the \proglang{R} statistical computing system (and related syntax/terminology) is assumed. Those unfamiliar with \proglang{R} may wish to peruse a text such as those of \citet{venables.ripley:bk:2000,venables.ripley:bk:2002} or \citet{chambers:bk:1998}. \section[The network class]{The \code{network} class} The \code{network} class is a (reasonably) simple object structure designed to store a single relation on a vertex set of arbitrary size. The relation stored by a \code{network} class object is based on a generalized edge model; thus, edges may be directed, arbitrarily valued (with multiple values per edge), multiplex (i.e., multiple edges per directed dyad), hyper (i.e., multiple head/tail vertices per edge), etc. Storage requirements for the \code{network} class are on the order of the number of nodes plus the total number of edges (which is substantially sub-$n^2$ for sparse graphs), and retrieval of edge values has a time complexity which is no worse than $\mathcal{O}(n)$.\footnote{Edge retrieval actually scales with degree, and average retrieval time is hence approximately constant for many data sources. For an argument regarding constraints on the growth of mean degree in interpersonal networks, see e.g., \citet{mayhew.levinger:ajs:1976}.} For example, a network with 100,000 vertices and 100,000 edges currently consumes approximately 74MB of RAM (\proglang{R} 2.6.1), versus approximately 40GB for a full sociomatrix (a savings of approximately 99.8\%). When dealing with extremely large, sparse graphs it therefore follows that \code{network} objects are substantially more efficient than simpler representations such as adjacency matrices. The class also provides for the storage of arbitrary metadata at the edge, vertex, and network level. Thus, \code{network} objects may be preferred to matrix representations for reasons of generality, performance, or integrative capability; while alternative means exist of obtaining these goals separately, \pkg{network} provides a single toolkit which is designed to be effective across a wide range of applications. In this section, we provide a basic introduction to the \code{network} class, from a user's point of view. We describe the conditions which are necessary for \pkg{network} to be employed, and the properties of \code{network} objects (and their components). This serves as background for a discussion of the use of \pkg{network} methods in practical settings, which is given in the section which follows. \subsection{Identification of vertices and edges} For purposes of storage, we presume that each vertex and each edge can be uniquely identified. \citep[For partially labeled or unlabeled graphs, observe that this internal labeling is essentially arbitrary. See][for a discussion.]{butts.carley:cmot:2005} Vertices are labeled by positive integers in the order of entry, with edges likewise; it is further assumed that this is maintained for vertices (e.g., removing a vertex requires relabeling) but not for edges. (This last has to do with how edges are handled internally, but has the desirable side effect of making edge changes less expensive.) Vertices and edges are always stored by label. In the text that follows, any reference to a vertex or edge ``ID'' refers to these labeling numbers, and not to any other (external) identification that a vertex or edge may have. \subsection{Basic class structure} Functionally, a \code{network} object can be thought as a collection of vertices and edges, together with metadata regarding those vertices and edges (as well as the network itself). As noted above, each vertex is assumed to be identifiable, and the number of vertices is fixed. Here, we discuss the way in which edges are defined within \pkg{network}, as well as the manner in which associated metadata is stored. \subsubsection{Edge structure} Edges within a \code{network} object consist of three essential components. First, each edge contains two vectors of vertex IDs, known respectively as the \emph{head} and \emph{tail} lists of the edge. In addition to these lists, each edge also contains a list of attribute information. This is discussed in more detail below. The content and interpretation of the head and tail lists are dependent on the type of network in which they reside. In a directed network, an edge connects the elements of its tail list with those of its head list, but not vice versa: $i$ is adjacent to $j$ iff there exists some edge, $e=(T,H)$, such that $i\in T, j\in H$. In an undirected network, by contrast, the head and tail sets of an edge are regarded as exchangeable. Thus, $i$ is adjacent to $j$ in an undirected network iff there exists an edge such that $i\in T, j\in H$ or $i\in H, j\in T$. \pkg{network} methods which deal with adjacency and incidence make this distinction transparently, based on the network object's directedness attribute (see below). Note that in the familiar case of dyadic networks (the focus of packages such as \pkg{sna} \citep{sna}), the head and tail lists of any given edge must have exactly one element. This need not be true in general, however. An edge with a head or tail list containing more than one element is said to be \emph{hypergraphic}, reflecting a one-to-many, many-to-one, or many-to-many relationship. Hyperedges are permitted natively within \pkg{network}, although some methods may not support them -- a corresponding network attribute is used by \pkg{network} methods to determine whether these edges are present, as explained below. Finally, another fundamental distinction is made between edges in which $H$ and $T$ are disjoint, versus those in which these endpoint lists have one or more elements in common. Edges of the latter type are said to be \emph{loop-like}, generalizing the familiar notion of ``loop'' (self-tie) from the theory of dyadic graphs. Loop-like edges allow vertices to relate to themselves, and are disallowed in many applications. Applicable methods are expected to interpret such edges intelligently, where present. \subsubsection[network attributes]{\code{network} attributes} \label{sec_net_attr} As we have already seen, each \code{network} object contains a range of metadata in addition to relational information. This metadata -- in the form of attributes -- is divided into information stored at the network, vertex, and edge levels. In all three cases, attributes are stored in \code{list}s, and are expected to be named. While there is no limit to the user-defined attributes which may be stored in this manner, certain attributes are required of all \code{network} objects. At the network level, such attributes describe general properties of the network as a whole; specifically, they may be enumerated as follows: \begin{description} \item[\code{bipartite}] This is a \code{logical} or \code{numeric} attribute, which is used to indicate the presence of an intrinsic bipartition in the \code{network} object. Formally, a bipartition is a partition of a network's vertices into two classes, such that no vertex in either class is adjacent to any vertex in the same class. While such partitions occur naturally, they may also be specifically enforced by the nature of the data in question. (This is the case, for instance, with two-mode networks \citep{wass:faus1994}, in which edges represent connections between two distinct classes of entities.) In order to allow for bipartite networks with a partition size of zero, non-bipartite networks are marked as \code{bipartite=FALSE}. Where the value of \code{bipartite} is numeric, \pkg{network} methods will automatically assume that vertices with IDs less than or equal to \code{bipartite} belong to one such class, with those with IDs greater than \code{bipartite} belonging to the other. This information may be used in selecting default modes for data display, calculating numbers of possible edges, etc. When \code{bipartite == FALSE} or {NULL}, by contrast, no such bipartition is assumed. Because of the dual \code{logical}/\code{numeric} nature of the attribute, it is safest to check it using the \code{is.bipartite} method. It should be emphasized that \code{bipartite} is intended to reflect bipartitions which are required \emph{ex ante,} rather than those which happen to arise empirically. There is also no performance advantage to the use of \code{bipartite}, since \pkg{network} only stores edges which are defined; it can make data processing more convenient, however, when working with intrinsically bipartite structures. \item[\code{directed}] This is a \code{logical} attribute, which should be set to \code{TRUE} iff edges are to be interpreted as directed. As explained earlier, \pkg{network} methods will regard edge endpoint lists as exchangeable when \code{directed} is \code{FALSE}, allowing for automatic handling of both directed and undirected networks. For obvious reasons, misspecification of this attribute may lead to surprising results; it is generally set when a \code{network} object is created, and considered fixed thereafter. \item[\code{hyper}] This attribute is a \code{logical} variable which is set to \code{TRUE} iff the network is allowed to contain hyperedges. Since the vast majority of network data is dyadic, this attribute defaults to \code{FALSE} for must construction methods. The setting of \code{hyper} to \code{TRUE} has potentially serious implications for edge retrieval, and so methods should not activate this option unless hypergraphic edges are explicitly to be permitted. \item[\code{loops}] As noted, loop-like edges are frequently undefined in practical settings. The \code{loops} attribute is a \code{logical} which should be set to \code{TRUE} iff such edges are permitted within the network. \item[\code{multiple}] In most settings, an edge is uniquely defined by its head and tail lists. In other cases, however, one must represent data in which multiple edges are permitted between the same endpoints. (``Same'' here includes the effect of directedness; an edge from set $H$ to set $T$ is not the same as an edge from set $T$ to set $H$, unless the network is undirected.) The \code{multiple} attribute is a \code{logical} variable which is set to \code{TRUE} iff such multiplex edges are permitted within the network. Where \code{multiple} is \code{FALSE}, \pkg{network} methods will assume all edges to be unique -- like \code{directed}, the possibility of multiplex edges thus can substantially impact both behavior and performance. For this reason, \code{multiple} is generally set to \code{FALSE} by default, and should not be set to \code{TRUE} unless it is specifically necessary to permit multiple edges between the same endpoint sets. \item[\code{n}] Finally, \code{n} is a \code{numeric} attribute containing the number of elements in the vertex set. Applicable methods are expected to adjust this attribute up or down, should vertices be added or deleted from the network. Note that as of \pkg{network} v1.8, networks of size zero are permitted. \end{description} While these attributes are clearly reserved, any number of others may be added. Attributes specifically pertaining to edges and/or vertices can be stored at the network level, but this is generally non-optimal -- such attributes would have to be manually updated to reflect edge or vertex changes, and would require the creation of custom access methods. The preferred approach is to store such information directly at the edge or vertex level, as we discuss below. \subsubsection[Vertex attributes]{Vertex attributes} As with the network as a whole, it is often useful to be able to supply attribute data for individual vertices (e.g., names, attributes, etc.). Each vertex thus has a \code{list} of named attributes, which can be used to store arbitrary information on a per-vertex basis; there is no restriction on the type of information which may be stored in this fashion, nor are all vertices constrained to carry information regarding the same attributes. Each vertex does carry two special attributes, however, which are assumed to be available to all class methods. These are \code{vertex.names}, which must be a \code{character} containing the name of the vertex, and the \code{logical} attribute \code{na}. Where \code{TRUE}, \code{na} indicates that the associated vertex is unobserved; this is useful in cases for which individual entities are known to belong to a given network, but where data regarding those entities is unavailable. By default, \code{na} is set to \code{FALSE} and \code{vertex.names} is set equal to the corresponding vertex ID. \subsubsection[Edge attributes]{Edge attributes} Just as vertices can carry attributes, so too can edges. Each edge is endowed with a \code{list} of named attributes, which can be used to carry arbitrary information (e.g., tie strength, onset and termination times, etc.). As with vertex attributes, any information type may be employed and there is no requirement that all edges carry the same attributes. The one attribute required to be carried by each edge is \code{na}, a \code{logical} which (like the vertex case) is used to indicate the missingness of a given edge. Many \pkg{network} methods provide the option of filtering out missing edges when retrieving information, and/or returning the associated information (e.g., adjacency) as missing. \section[Using the network class]{Using the \code{network} class} In addition to the class itself, \pkg{network} provides a range of tools for creating, manipulating, and visualizing \code{network} objects.\footnote{These tools are currently implemented via S3 methods.} Here, we provide an overview of some of these tools, with a focus on the basic tasks most frequently encountered by end users. Additional information on these functions is also provided within the package manual. For the examples below, we begin by loading the network package into memory; we also set the random seed, to ensure that examples using random data match the output shown here. Within \proglang{R}, this may be accomplished via the following: <<>>= library(network) set.seed(1702) @ Throughout, we will represent \proglang{R} code in the above format. Readers may wish to try the demonstrations listed here for themselves, to get a better feel for how the package operates. \subsection{Importing data} It almost goes without saying that an important aspect of \pkg{network} functionality is the ability to import data from external sources. \pkg{network} includes functionality for the importation of \pkg{Pajek} project files \citep{pajek}, a popular and versatile network data format, via the \code{read.paj} routine. Other formats supported by \pkg{sna} can be used as well, by importing to adjacency matrix form (using the relevant \pkg{sna} routines) and then coercing the result into a \code{network} object as described below. The \pkg{foreign} package can be used to import adjacency, edgelist, or incidence matrices from other computing environments in much the same way. Future package versions may include support for converting to and from other related classes, e.g., those of \pkg{RBGL} \citep{carey.et.al:sw:2007} and \pkg{Rgraphviz} \citep{gentry.et.al:sw:2007}. In addition to these methods, \code{network} objects can be loaded into \proglang{R} using native tools such as \code{load} (for saved objects) or \code{data} (for packaged data sets). With respect to the latter, \pkg{network} contains two sample data sets: \code{flo}, John Padgett's Florentine wedding data \citep[from][]{wass:faus1994}; and \code{emon}, a set of interorganizational networks from search and rescue operations collected by \citet{drabek.et.al:bk:1981}. \code{flo} consists of a single adjacency matrix, and is useful for illustrating the process of converting data from adjacency matrix to \code{network} form. \code{emon}, on the other hand, consists of a list of seven \code{network} objects with vertex and edge metadata. \code{emon} is thus especially useful for illustrating the use of \code{network} objects for rich data storage (in addition to being an interesting data set in its own right). Loading these data sets is as simple as invoking the \code{data} command, like so: <<>>= data("flo") data("emon") @ Further information on each of these data sets is given in the \pkg{network} manual. We shall also use these data sets as illustrative examples at various points within this paper. \subsection[Creating and viewing network objects]{Creating and viewing \code{network} objects} While importation is sometimes possible, in other cases we must create our own \code{network} objects. \pkg{network} supports two basic approaches to this task: create the object from scratch, or build it from existing relational data via coercion. Both methods are useful, and we illustrate each here. In the most minimal case, we begin by creating an empty network to which edges may be added. This task is performed by the \code{network.initialize} routine, which serves as a constructor for the \code{network} class. \code{network.initialize} takes the order of the desired graph (i.e., $n$) as a required argument, and the required network attributes discussed in Section~\ref{sec_net_attr} may be passed as well. In the event that these are unspecified, it is assumed that a simple digraph (directed, no loops, hyperedges, multiplexity, or bipartitions) is desired. For example, one may create and print an empty digraph like so: <<>>= net <- network.initialize(5) net @ \pkg{network} has default \code{print} and \code{summary} methods, as well as low-level operators for assignment and related operations. These do not show much in the above case, since the network in question caries little information. To create a \code{network} along with a specified set of edges, the preferred high-level constructor is the eponymous \code{network}. Like \code{network.initialize}, this function returns a newly allocated \code{network} object having specified properties. Unlike the former, however, \code{network} may be called with adjacency and/or attribute information. Adjacency information may be passed by using a full or bipartite adjacency matrix, incidence matrix, or edgelist as the function's first argument. These input types are defined as follows: \begin{description} \item[Adjacency matrix:] This must consist of a square \code{matrix} or two-dimensional \code{array}, whose $i,j$th cell contains the value of the edge from $i$ to $j$; as such, adjacency matrices may only be used to specify dyadic networks. By default, edges are assumed to exist for all non-zero matrix values, and are constructed accordingly. Edge values may be retained by passing \code{ignore.eval = FALSE}, as described in the manual page for the \code{network.adjacency} constructor. The \code{matrix.type} for an adjacency matrix is \code{"adjacency"}. \item[Bipartite adjacency matrix:] This must consist of a rectangular \code{matrix} or two-dimensional \code{array} whose row and column elements reflect vertices belonging to the lower and upper sets of a bipartition (respectively). Otherwise, the matrix is interpreted as per a standard adjacency matrix. (Thus, a bipartite adjacency matrix is simply the upper off-diagonal block of the full adjacency matrix for a bipartite graph, where vertices have been ordered by partition membership. See also \citet{doreian.et.al:bk:2005}.) The \code{matrix.type} for a bipartite adjacency matrix is \code{"bipartite"}. \item[Incidence matrix:] This must consist of a rectangular \code{matrix} or two-dimensional \code{array} whose row elements represent vertices, and whose column elements represent edges. A non-zero value is placed in the $i,j$th cell if vertex $i$ is an endpoint of edge $j$. In the directed case, negative values signify membership in the tail set of the corresponding edge, while positive values signify membership in the edge's head set. Unlike adjacency matrices, incidence matrices can thus be used to describe hypergraphic edges (directed or otherwise). Note, however, that an undirected hypergraph composed of two-endpoint edges is not the same as a simple graph, since the edges of the former are necessarily loop-like. When \code{loops}, \code{hyper}, and \code{directed} are all \code{FALSE}, therefore, the two positive row-elements of an incidence matrix for each column are taken to signify the head and tail elements of a dyadic edge. (This is without loss of generality, since such an incidence matrix would otherwise be inadmissible.) When specifying that an incidence matrix is to be used, \code{matrix.type} should be set to \code{"incidence"}. \item[Edge list:] This must consist of a rectangular \code{matrix} or two-dimensional \code{array} whose row elements represent edges. The $i,1$st cell of this structure is taken to be the ID of the tail vertex for the edge with ID $i$, with the $i,2$st cell containing the ID of the edge's head vertex. (Only dyadic networks may be input in this fashion.) Additional columns, if present, are taken to contain edge attribute values. The \code{matrix.type} for an edge list is \code{"edgelist"}. \end{description} As one might suspect, the \code{network} function actually operates by first calling \break\code{network.initialize} to create the required object, and then calling an appropriate edge set constructor based on the input type. This fairly modular design allows for the eventual inclusion of a wider range of input formats (although the above covers the formats currently in widest use within the social network community). Although \code{network} attempts to infer the matrix type from context, is wise to fix the function's behavior via the \code{matrix.type} argument when passing information which is not in the default, adjacency matrix form. As a simple example of the \code{network} constructor in action, consider the following: %\begin{Code} %#Create a less empty network %nmat <- matrix(rbinom(25,1,0.5),nr=5,nc=5) #Generate a random adjacency % #matrix %net <- network(nmat,loops=TRUE) #Use it to create a digraph % #w/loops %net #Display using print method %summary(net) #Display using summary method %all(nmat==net[,]) #Should be TRUE %\end{Code} <<>>= nmat <- matrix(rbinom(25, 1, 0.5), nr = 5, nc = 5) net <- network(nmat, loops = TRUE) net @ <<>>= summary(net) @ <<>>= all(nmat == net[,]) @ Here, we have generated a random adjacency matrix (permitting diagonal elements) and used this to construct a digraph (with loops) in \code{network} object form. Since we employed an adjacency matrix, there was no need to set the matrix type explicitly; had we failed to set \code{loops = TRUE}, however, the diagonal entries of \code{nmat} would have been ignored. The above example also demonstrates the use of an important form of operator overloading which can be used with dyadic network objects: specifically, dyadic network objects respond to the use of the subset and subset assignment operators \code{[} and \code{[<-} as if they were conventional adjacency matrices. Thus, in the above case, \code{net[,]} returns \code{net}'s adjacency matrix (a fact we verify by comparing it with \code{nmat}). This is an extremely useful ``shorthand'' which can be used to simplify otherwise cumbersome network operations, especially on small networks. The use of \code{network} function to create objects from input matrices has a functional parallel in the use of coercion methods to transform other objects into \code{network} form. These operate in the same manner as the above, but follow the standard \proglang{R} syntax for coercion, e.g.: %\begin{Code} %#Can also use coercion %net <- as.network(nmat, loops = TRUE) %all(nmat==net[,]) #Should still be TRUE %\end{Code} <<>>= net <- as.network(nmat, loops = TRUE) all(nmat == net[,]) @ By default, \code{as.network} assumes that square input matrices should be treated as adjacency matrices, and that diagonal entries should be ignored; here we have overridden the latter behavior by invoking the additional argument \code{loops = TRUE}. Matrix-based input can also be given in edgelist or incidence matrix form, as selected by the \code{matrix.type} argument. This and other options are described in greater detail within the package documentation. The above methods can be used in conjunction with \code{data}, \code{load}, or \code{read} functions to convert imported relational data into \code{network} form. For example, we may apply this to the Florentine data mentioned in the previous section: <<>>= nflo <- network(flo, directed = FALSE) nflo @ Although the network's adjacency structure is summarized here in edgelist form, it may be queried in other ways. For instance, the following example demonstrates three simple methods for examining the neighborhood of a particular vertex: <<>>= nflo[9,] nflo[9,1] nflo[9,4] is.adjacent(nflo, 9, 1) is.adjacent(nflo, 9, 4) @ As the example shows, overloading can be used to extract partial as well as complete adjacency information from a \code{network} object. A more cumbersome (but slightly faster) method is to use a direct call to \code{is.adjacent}, the general indicator method for network adjacency. Calling the indicator method avoids the call parsing required by the extraction operator, which is the source of the performance difference. In practice, however, the impact of call parsing is quite minimal, and users are unlikely to detect a difference between the two approaches. (Where such overhead is an issue, it will generally be more efficacious to conduct adjacency queries directly from the backend code; this will be discussed below, in the context of the \proglang{C}-language API.) In addition to adjacency, \pkg{network} supplies methods to query many basic properties of \code{network} objects. Although complex structural descriptives \citep[e.g., centrality scores][]{wass:faus1994} are the province of other packages, \pkg{network}'s built-in functionality is sufficient to determine the types of edges allowed within a \code{network} object and constraints such as enforced bipartitions, as well as essential quantities such as size (number of vertices), edge count, and density (the ratio of observed to potential edges). Use of these indicator methods is straightforward, as illustrated by the following examples. <<>>= network.size(nflo) #Number of vertices network.edgecount(nflo) #Number of edges network.density(nflo) #Network density has.loops(nflo) #Can nflo have loops? is.bipartite(nflo) #Is nflo coded as bipartite? is.directed(nflo) #Is nflo directed? is.hyper(nflo) #Is nflo hypergraphic? is.multiplex(nflo) #Are multiplex edges allowed? @ \subsection[Coercing network objects to other forms]{Coercing \code{network} objects to other forms} Just as one may often seek to coerce data from other forms into \code{network} object, so to does one sometimes need to coerce \code{network} objects into other data types. \pkg{network} currently supports several such coercion functions, all of which take network objects as input and produce matrices of one type or another. The class method for \code{as.matrix} performs this task, converting network objects to adjacency, incidence, or edgelist matrices as desired (adjacency being the default). Scalar-valued edge attributes, where present, may be used to set edge values using the appropriate functional arguments. Similar functionality is provided by \code{as.sociomatrix} and the extraction operator, although these are constrained to produce adjacency matrices. These equivalent approaches may be illustrated with application to the Florentine data as follows: <<>>= as.sociomatrix(nflo) all(nflo[,]==as.sociomatrix(nflo)) all(as.matrix(nflo)==as.sociomatrix(nflo)) as.matrix(nflo,matrix.type="edgelist") @ Note that vertex names (per the \code{vertex.names} attribute) are used by \code{as.sociomatrix} to set adjacency matrix row/column names where present. The less-flexible \code{as.sociomatrix} function also plays an important role with respect to coercion in the \pkg{sna} package; the latter's \code{as.sociomatrix.sna} dispatches to \pkg{network}'s \code{as.sociomatrix} routine when \pkg{network} is loaded and a \code{network} object is given. The intent in both packages is to maintain an interoperable and uniform mechanism for guaranteeing adjacency matrix representations of input data (which are necessary for backward compatibility with some legacy functions). \subsection{Creating and modifying edges and vertices} In addition to coercion of data to \code{network} form, the \pkg{network} package contains many mechanisms for creating, modifying, and removing edges and vertices from \code{network} objects. The simplest means of manipulating edges for most users is the use of the overloaded extraction and assignment operators, which (as noted previously) simulate the effects of working with an adjacency matrix. Thus, a statement such as \code{g[i,j] <- 1} adds an edge between \code{i} and \code{j} (if one is not already present), \code{g[i,j] <- 0} removes an existing edge, and \code{g[i,j]} itself is a dichotomous indicator of adjacency. Subset selection and assignment otherwise works in the same fashion as for \proglang{R} matrices, including the role of \code{logical}s and element lists. (One minor exception involves the effects of assignment on undirected and/or loopless graphs: \pkg{network} will enforce symmetry and/or empty diagonal entries, and will ignore any assignments which are contrary to this.) The uses of assignment by overloading are hence legion, as partially illustrated by the following: <<>>= #Add edges to an empty network net <- network.initialize(5,loops=TRUE) net[nmat>0] <- 1 #One way to add edges all(nmat==net[,]) #Should be TRUE net[,] <- 0 #Remove the edges net[,] <- nmat #Not quite kosher, but _will_ work.... all(nmat==net[,]) #Should still be TRUE net[,] <- 0 #Remove the edges for(i in 1:5) #Add the hard way! for(j in 1:5) if(nmat[i,j]) net[i,j] <- 1 all(nmat==net[,]) #Should STILL be TRUE net[,] <- 0 #Remove the edges add.edges(net,row(nmat)[nmat>0],col(nmat)[nmat>0]) all(nmat==net[,]) #When will it all end?? net[,] <- as.numeric(nmat[,]) all(nmat==net[,]) #When will it all end?? @ The above example also introduces \code{add.edges}, to which the overloaded assignment operator is a front end. \code{add.edges} is more cumbersome to employ than the assignment operators, but is substantially more powerful. In particular, it can be used to add edges of arbitrary type, with arbitrary attribute data. A comparison of usage is instructive; we begin by creating an empty digraph, and adding a single edge: <<>>= #Add edges (redux) net<-network.initialize(5) #Create empty graph add.edge(net,2,3) #Create 2->3 edge net[,] #Trust, but verify add.edges(net,c(3,5),c(4,4)) #3 and 5 send ties to 4 net[,] #Again, verify edges net[,2]<-1 #Everyone sends ties to 2 net[,] #Note that loops are not created! @ Observe that the (2,2) loop is not created, since \code{loops} is \code{FALSE} for this network. This automatic behavior is \emph{not} true of \code{add.edges}, unless optional edge checking is turned on (by means of the \code{edge.check} argument). For this reason, explicit use of \code{add.edges} is discouraged for novice users. In addition to edge addition/removal, vertices can be added or removed via \code{add.vertices} and \code{delete.vertices}. The former adds the specified number of vertices to a \code{network} object (along with any supplied attribute information), while the latter deletes a specified list of vertices from its argument. Usage is straightforward: <<>>= #Deleting vertices delete.vertices(net,4) #Remove vertex 4 net[,] #It's gone! add.vertices(net,2) #Add two new vertices net[,] #Both are isolates @ As the above illustrates, vertex names are not automatically created for newly added vertices\footnote{See the ``Persistent ID'' functionality in the the networkDynamic package for maintainable ids} (but can be subsequently assigned). New vertices are always added as isolates (i.e., without existing ties), and any edges having a deleted vertex as an endpoint are removed along with the deleted vertex. The use of \code{is.adjacent} (and friends) to perform adjacency testing has been shown above. While this is adequate for many purposes, it is sometimes necessary to examine an edge's contents in detail. As we have seen, each edge can be thought of as a list made up of a vector of tail vertex IDs, a vector of head vertex IDs, and a vector of attributes. The utility function \code{get.edges} retrieves edges in this form, returning them as lists with elements \code{inl} (tail), \code{outl} (head), and \code{atl} (attributes). \code{get.edges} allows for edges to be retrieved by endpoint(s), and is usable even on multiplex networks. Incoming or outgoing edges (or both) can be selected, as per the following example: <<>>= #Retrieving edges get.edges(net,1) #Out-edges sent by vertex 1 get.edges(net,2,neighborhood="in") #In-edges to vertex 2 get.edges(net,1,alter=2) #Out-edges from 1 to 2 @ The \code{alter} argument in the last case tells \code{get.edges} to supply only edges from vertex 1 to vertex 2. As with other applications of \code{get.edges}, this will return all applicable edges in the multiplex case. Retrieving edges themselves is useful, but does not provide the edges' ID information -- particularly in multiplex networks, such information is needed to delete or modify edges. For that purpose, we employ a parallel routine called \code{get.edgeIDs}: <<>>= #Retrieving edge IDs get.edgeIDs(net,1) #Same as above, but gets ID numbers get.edgeIDs(net,2,neighborhood="in") get.edgeIDs(net,1,alter=2) @ By the same token, it is sometimes the vertex neighborhood (rather than edge neighborhood) which is of interest. The \code{get.neighborhood} function can be used in these cases to obtain vertex neighborhoods directly, without having to first query edges. (Since this operation is implemented in the underlying compiled code, it is considerably faster than an \proglang{R}-level front end would be.) <<>>= #Vertex neighborhoods get.neighborhood(net,1) #1's out-neighbors get.neighborhood(net,2,type="in") #2's in-neighbors @ Finally, we note that edge deletion can be performed either by assignment operators (as noted above) or by the \code{delete.edges} function. \code{delete.edges} removes edges by ID, and hence is not primarily employed by end users. In conjunction with tools such as \code{get.edgeIDs}, however, it can be seen to be quite versatile. A typical example is as follows: <<>>= #Deleting edges net[2,3]<-0 #This deletes the 2->3 #edge net[2,3]==0 #Should be TRUE delete.edges(net,get.edgeIDs(net,2,neighborhood="in")) #Remove all->2 net[,] @ Since it works by IDs, it should be noted that \code{delete.edges} can be used to selectively remove edges from multiplex networks. The operator-based approach automatically removes any edges connecting the selected pair, and is not recommended for use with multiplex networks. \subsection{Working with attributes} A major advantage of \code{network} objects over simple matrix or list based data representations is the ability to store meta-information regarding vertices, edges, or the network as a whole. For each such attribute type, \pkg{network} contains access functions to manage the creation, modification, and extraction of such information. Here, we briefly introduce the primary functions used for these tasks, by attribute type. \subsubsection{Network attributes} As indicated previously, network-level attributes are those attached to the \code{network} object as a whole. Such attributes are created via the \code{set.network.attribute} function, which takes as arguments the object to which the attribute should be attached, the name of the attribute, and the value of the attribute in question. Network attributes may contain arbitrary data, as they are stored internally via generalized vectors (\code{list}s). To streamline the creation of such attributes, the network attribute operator, \code{\%n\%}, has also been provided. Assignment using the operator is performed via the syntax \code{network \%n\% "attrname" <- value}, as in the second portion of the example below (which assigns the first seven lowercase letters to an attribute called ``hoo'' in \code{net}). <<>>= net <- network.initialize(5) set.network.attribute(net, "boo", 1:10) net %n% "hoo" <- letters[1:7] @ After network attributes have been created, they may be listed using the \break\code{list.network.attributes} command. Attribute extraction may then be performed by a call to \code{get.network.attribute}, or via the network attribute operator. In the latter case, a call of the form \code{network \%n\% "attrname"} returns the value of attribute ``attrname'' in the object ``network.'' In our current example, for instance, we have created the attributes ``boo'' and ``hoo,'' each of which may be accessed using either method: <<>>= #List attributes list.network.attributes(net) #Retrieve attributes get.network.attribute(net,"boo") net %n% "hoo" @ Finally, it is sometimes desirable to remove network attributes which have been created. This is accomplished using \code{delete.network.attributes}, which removes the indicated attribute from the network object (freeing the associated memory). One can verify that the attribute has been removed by checking the list of network attributes, e.g: <<>>= #Delete attributes delete.network.attribute(net,"boo") list.network.attributes(net) @ \subsubsection{Vertex attributes} Vertex attributes are manipulated in the same general manner as network attributes, with the caveat that each vertex can have its own attributes. There is no requirement that all vertices have the same attributes, or that all attributes of a given name contain the same data type; however, not all extraction methods work well in the latter case. Complete functionality for arbitrary vertex creation, listing, retrieval, and deletion is provided by the \code{set.vertex.attribute}, \code{list.vertex.attributes}, \code{get.vertex.attribute}, and \break\code{delete.vertex.attribute} methods (respectively). These allow attribute data to be passed in list form (permitting arbitrary contents) and to be assigned to specific vertices. While the generality of these functions is helpful, they are cumbersome to use for simple tasks such as assigning scalar or character values to each vertex (or retrieving the same). To facilitate such routine tasks, \pkg{network} provides a vertex attribute operator, \code{\%v\%}. The operator may be used either for extraction or assignment, treating the right-hand value as a vector of attribute values (with the $i$th element corresponding to the $i$th vertex). By passing a \code{list} with a \code{list} for each element, one may assign arbitrary vertex values in this manner; however, the vertex operator will vectorize these values upon retrieval (and hence one must use \code{get.vertex.attribute} with \code{unlist = FALSE} to recover the full list structure). If a requested attribute is unavailable for a particular vertex, an \code{NA} is returned. Typical use of the vertex attribute methods is illustrated via the following example. Note that more complex usage is also possible, as detailed in the package manual. <<>>= #Add vertex attributes set.vertex.attribute(net,"boo",1:5) #Create a numeric attribute net %v% "hoo" <- letters[1:5] #Now, a character attribute #Listing attributes list.vertex.attributes(net) #List all vertex attributes #Retrieving attributes get.vertex.attribute(net,"boo") #Retrieve 'em net %v% "hoo" #Deleting attributes delete.vertex.attribute(net,"boo") #Remove one list.vertex.attributes(net) #Check to see that it's gone @ \subsubsection{Edge attributes} Finally, we come to edge attributes. The operations involved here are much like those for the network and vertex cases. List, set, get, and delete methods exist for edge attributes (\code{list.edge.attributes}, \code{set.edge.attribute}, \code{get.edge.attribute}, and \break\code{delete.edge.attribute}), as does an edge attribute operator (\code{\%e\%}). Operations with edges are rendered somewhat more complex, however, because of the need to employ edge IDs in referencing the edges themselves. These can be obtained via the \code{get.edgeIDs} function (as described above), but this adds complexity which is unnecessary in the case of simple attribute assignment on non-multiplex, dyadic graphs (where edges are uniquely identifiable by a pair of endpoints). For such cases, the convenience function \code{set.edge.value} allows edge values to be specified in adjacency matrix form. Also useful is the bracket operator, which can be used to assign values as well as to create edges. For network \code{net}, \code{net[sel, names.eval = "attrname"] <- value} will set the attribute named by ``attrname'' on the edges selected by \code{sel} (which follows standard \proglang{R} syntax for selection of cells from square matrices) to the values in \code{value}. By default, values for non-existent edges are ignored (although new edges can be created by adding \code{add.edges = TRUE} to the included arguments). Reasonable behavior for non-scalar values using this method is not guaranteed. In addition to the above, methods such as \code{as.sociomatrix} allow for edge attributes to be employed in some settings. These provide a more convenient (if less flexible) interface for the common case of scalar attributes on the edges of non-multiplex, dyadic networks. The following is a typical example of these routines in action, although much more exotic scenarios are certainly possible. <<>>= #Create a network with some edges net <- network(nmat) #Add attributes set.edge.attribute(net,"boo",sum(nmat):1) set.edge.value(net,"hoo",matrix(1:25,5,5)) #Note: only sets for extant edges! net %e% "woo" <- matrix(rnorm(25),5,5) #Ditto net[,,names.eval="zoo"] <- nmat*6 #Ditto if add.edges!=TRUE #List attributes list.edge.attributes(net) #Retrieving attributes get.edge.attribute(get.edges(net,1),"boo") #Get the attribute for 1's out-edges get.edge.value(net,"hoo") net %e% "woo" as.sociomatrix(net,"zoo") #Deleting attributes delete.edge.attribute(net,"boo") list.edge.attributes(net) @ As this example illustrates, edge attributes are only set for actually existing edges (although the optional \code{add.edges} argument to the network assignment operator can be used to force addition of edges with non-zero attribute values). Also illustrated is the difference between attribute setting using \code{set.edge.attribute} (which is edge ID based) and function such as the assignment operator. The relative ease of the latter recommends itself for everyday use, although more complex settings may call for the former approach. \subsubsection{From attributes to networks} In addition to simply storing covariate information, it should be noted that one can actively use attributes to construct new networks. For instance, consider the \code{emon} data set used above. Among other variables, each vertex carries an attribute called \code{"Location"} which contains information on whether the corresponding organization had headquarters or command post installations which were local, non-local, or both with respect to the operation from which the network was drawn. We may thus use this information to construct a very simple hypergraph, in which locations constitute edges and edge membership is defined as having an installation at the respective location. For the Mt.\ St.\ Helens network, such a network may be constructed as follows. First, we extract the location information from the relevant network object, and use this to build an incidence matrix based on location. Then we convert this incidence matrix to a hypergraphic network object (setting vertex names from the original network object for convenience). <<>>= #Extract location information MtSHloc<-emon$MtStHelens%v%"Location" #Build an incidence matrix based on Local/Non-local/Both placement MtSHimat<-cbind(MtSHloc%in%c("L","B"),MtSHloc%in%c("NL","B")) #Convert incidence matrix to a hypergraph MtSHbyloc<-network(MtSHimat,matrix="incidence",hyper=TRUE,directed=FALSE, loops=TRUE) #Set vertex names, for convenience MtSHbyloc%v%"vertex.names"<-emon$MtStHelens%v%"vertex.names" #Examine the result MtSHbyloc @ Obviously, the simple location coding used here cannot lead to a very complex structure. Nevertheless, this case serves to illustrate the flexibility of the \pkg{network} tools in allowing attribute information to be used in creative ways. In addition to constructing networks from attributes, one can use attributes to store networks \citep[useful for joint representation of cognitive and behavioral structures such as those of][]{krackhardt:sn:1988,killworth.bernard:ho:1976}, edge timing information (for dynamic structures, as in the package \pkg{networkDynamic} \citep{networkDynamic}), etc. Appropriate use of network, edge, and vertex attributes allows a wide range of complex relational data structures to be supported without the need for a cumbersome array of of custom data classes. \subsection[Visualizing network objects]{Visualizing \code{network} objects} In addition to manipulating \code{network} objects, the \pkg{network} package provides built-in support for network visualization. This capability is supplied by the package \code{plot} method (ported from \pkg{sna}'s \code{gplot}), which is dispatched transparently when \code{plot} is called with a \code{network} object. The plot method supports a range of layout and display options, which are specified through additional arguments. For instance, to visualize the Florentine marriage data we might use commands such as the following: <<>>= plot(nflo, displaylabels = TRUE, boxed.labels = FALSE) plot(nflo, displaylabels = TRUE, mode = "circle") @ Typical results of these commands are shown in Figure~\ref{f_nflo_layout}. Note that the plot method automatically determines whether the network being visualized is directed, and adds or suppresses arrowheads accordingly. For instance, compare the above with the Mt.\ Si communication network (Figure~\ref{f_mtsi}): \begin{figure} \begin{center} %\rotatebox{270}{\resizebox{3in}{6in}{\includegraphics{nflo.layouts.ps}}} %\rotatebox{270}{\resizebox{3in}{6in}{\includegraphics{Figures/nflo_layouts.pdf}}} <>= op<-par(no.readonly=TRUE) # cache the plot params par(mfcol=c(1,2),mar=c(1,1,1,1),cex=0.5) # adjust margins and text size to fit two panels plot(nflo, displaylabels = TRUE,boxed.labels = TRUE) plot(nflo, displaylabels = TRUE, mode = "circle") par(op) # reset the plot params @ \caption{\label{f_nflo_layout} Sample displays of the Florentine marriage data; the left panel depicts the default Fruchterman-Reingold layout, while the right panel depicts a circular layout.} \end{center} \end{figure} <<>>= plot(emon$MtSi) @ \begin{figure} \begin{center} %\rotatebox{270}{\resizebox{4in}{4in}{\includegraphics{mtsi.layout.ps}}} %\rotatebox{0}{\resizebox{4in}{4in}{\includegraphics{Figures/mtsi_layout.pdf}}} <>= plot(emon$MtSi) @ \caption{\label{f_mtsi} Sample display of the Mt.\ Si EMON data, using the default Fruchterman-Reingold layout.} \end{center} \end{figure} The default layout algorithm for the plot method is that of \citet{fruchterman.reingold:spae:1991}, a force-directed display with good overall performance. Other layout methods are available \citep[including the well-known energy-minimization algorithm of][]{kamada.kawai:ipl:1989}, and support is included for user-added functions. To create a custom layout method, one need only create a function with the prefix \code{network.layout} which supplies the appropriate formal arguments (see the \pkg{network} manual for details). The \code{plot} method can then be directed to utilize the custom layout function, as in this simple example (shown in Figure~\ref{f_mtsthelens_custom}): <<>>= library(sna) network.layout.degree <- function(d, layout.par){ id <- degree(d, cmode = "indegree") od <- degree(d, cmode = "outdegree") cbind(id, od) } plot(emon$MtStHelens, mode = "degree", displaylabels = TRUE, boxed.labels = FALSE, suppress.axes = FALSE, label.cex = 0.5, xlab = "Indegree", ylab = "Outdegree", label.col = 3) @ \begin{figure} \begin{center} %\rotatebox{270}{\resizebox{6in}{6in}{\includegraphics{mtsthelens.custom.layout.ps}}} %\rotatebox{270}{\resizebox{6in}{6in}{\includegraphics{Figures/mtsthelens_custom_layout.pdf}}} <>= plot(emon$MtStHelens, mode = "degree", displaylabels = TRUE, boxed.labels = FALSE, suppress.axes = FALSE, label.cex = 0.5, xlab = "Indegree", ylab = "Outdegree", label.col = 3) @ \caption{\label{f_mtsthelens_custom} Sample display of the Mt.\ St.\ Helens EMON data, using a custom indegree/outdegree layout.} \end{center} \end{figure} As this example illustrates, most properties of the visualization can be adjusted where necessary. This is especially helpful when visualizing structures such as hypergraphs: <<>>= plot(MtSHbyloc, displaylabels = TRUE, label = c(network.vertex.names(MtSHbyloc), "Local", "Non-Local"), boxed.labels = FALSE, label.cex = rep(c(0.5, 1), times = c(27, 2)), label.col = rep(c(3, 4), times = c(27, 2)), vertex.col = rep(c(2, 5), times = c(27, 2))) @ Note that the \code{plot} method automatically recognizes that the network being passed is hypergraphic, an employs a two-mode representation for visualization purposes (see Figure~\ref{f_mtsthelens_twomode}). Supplying custom labeling and vertex coloring helps clarify the interpretation. For instance, here we can immediately see the division between organizations who maintained headquarters exclusively at local or remote locations during the Mount St. Helens search and rescue operation, as well as those organizations (e.g. the Salvation Army and Red Cross) which bridged the two. Though simple, examples such as this demonstrate how the default \emph{plot} settings can be adjusted to produce effective visualizations of even complex relational data. \begin{figure} \begin{center} %\rotatebox{270}{\resizebox{4.5in}{6in}{\includegraphics{mtsthelens.twomode.ps}}} %\rotatebox{270}{\resizebox{4.5in}{6in}{\includegraphics{Figures/mtsthelens_twomode.pdf}}} <>= plot(MtSHbyloc, displaylabels = TRUE, label = c(network.vertex.names(MtSHbyloc), "Local", "Non-Local"), boxed.labels = FALSE, label.cex = rep(c(0.5, 1), times = c(27, 2)), label.col = rep(c(3, 4), times = c(27, 2)), vertex.col = rep(c(2, 5), times = c(27, 2))) @ \caption{\label{f_mtsthelens_twomode} Sample display of the Mt.\ St.\ Helens location hypergraph, showing division between locally, non-locally, and dual headquartered organizations.} \end{center} \end{figure} \section[C-language API]{\proglang{C}-language API} While the functionality described thus far has been aimed at users working within an interpreted \proglang{R} environment, many \pkg{network} package features can also be accessed through a \proglang{C}-language application programming interface (API). Although this API still makes use of \proglang{R} data structures, it provides mechanisms for direct manipulation of those structures via compiled code. While invisible to most end users, the API has a number of attractions for developers. Chief among these is performance: in the author's experience, a reasonably well-designed \proglang{C} function can run as much as one to two orders of magnitude faster than an equivalent \proglang{R} implementation. For many day-to-day applications, such gains are unlikely to be worth the considerable increase in implementation and maintenance costs associated with choosing \proglang{C} over \proglang{R}; however, they may prove vital when performing computationally demanding tasks such as Markov chain Monte Carlo simulation, large-graph computations, and small-N solutions for non-polynomial time problems (e.g., cycle counting). Another useful feature of the \proglang{C} API is its ability to make the complex data storage capabilities of \code{network} objects accessible to developers whose projects involve existing backend code, or developing packages such as \pkg{networkDynamic} which extend \pkg{network}'s functionality at the \proglang{C} level. Instead of performing data extraction on a \code{network} object and passing the result to the compiled routine, the \pkg{network} API allows for such routines to work with such objects directly. Finally, a third useful asset of the \pkg{network} API is the capacity it provides for generating user-transparent functionality which transcends what is feasible with \proglang{R}'s pass-by-value semantics. The use of compiled code to directly modify objects without copying has been fundamental to the functionality of the package since version 1.0, as can be gleaned from an examination of the package source code\footnote{The pass-by-value semantics are somewhat contrary to R's design philosophy and have been somewhat blocked in recent R versions. While the pass-by-value semantics functionality described is still operational, it must be implemented in less than optimal ways and my not offer the original speed gains.}. The mechanism by which the API is currently implemented is fairly simple. A shared header file (which must be included in the user's application) defines a series of macros which point to the package's internal routines. During program execution, a global registration function is used to map these macros to their internal symbols; following this, the macros may be called normally. Other then ensuring that the \pkg{network} library is loaded prior to invoking the registration function, no other measures are necessary. In particular, the calling routine does not have to be linked against the \pkg{network} library, although the aforementioned header/registration routines must be included at compile time.\footnote{Required files for the \pkg{network} API are available from \url{http://www.statnetproject.org/}.} In addition, \pkg{network} versions 1.11.1 and higher implement \proglang{R}'s template for registering native \proglang{C} routines \footnote{See the `Registering-native-routines' section of \url{http://cran.r-project.org/doc/manuals/r-release/R-exts.html }} so that packages may compile against \pkg{network}'s code by declaring a \code{LinkingTo: network} in the DESCRIPTION file. The listing of exported functions are in the file \code{src/Rinit.c}. \subsection[Using the network API]{Using the \pkg{network} API} To use the \pkg{network} API within one's own code, the following steps are necessary: \begin{enumerate} \item The required \pkg{network} header and function registration files must be added to the developer's source tree. \item The \pkg{network} header file must be included during compilation. \item The \code{netRegisterFunctions} function must be invoked at the entry point to any \proglang{C} program using the API. \item The \pkg{network} API functions must be used as required. \end{enumerate} The command \code{netRegisterFunctions} takes and returns no arguments, being invoked solely for its side effect. Although it must be called at each entry to the \proglang{C} backend (i.e., each invocation of \code{.Call} or \code{.External} from \proglang{R}), its effects persist until the calling routine exits. The API is designed for use with the \code{.Call} interface, although wrappers for conversion to \code{.External} are in principle possible. Object references are maintained through \code{SEXP} pointers, as is standard for \proglang{R}'s \proglang{C} language interface. Because references (rather than copies of the objects themselves) are passed to \proglang{C} via the interface, \proglang{C} routines may directly alter the objects with which they are called. \pkg{network} has many routines for creating and modifying \code{networks}, as well as for accessing object contents within compiled code. To illustrate the use of the network API in practical settings, we here provide a walk-through for a relatively simple (but non-trivial) example. Consider a \proglang{C} function which generates an undirected network from a homogeneous Bernoulli graph distribution, tagging each edge with random ``onset'' and ``termination'' times based on a piecewise-exponential process with fixed onset/termination hazards. Such a function might also keep track of the first and last edge times for each vertex (and for the network as a whole), storing these within the network object via appropriately named attributes. To implement our sample function, we begin with the standard header for a \code{.Call} function, which both takes and receives arguments of type \code{SEXP} (S-expression pointers). In this case, the parameters to be passed consist of an initialized \code{network} object, the probability of an edge between any two vertices, and the hazards for edge onset and termination (respectively). Note that we do not need to tell the function about properties such as network size, since it can determine these itself using the API's interface methods. \begin{Code} SEXP rnbernexp_R(SEXP g, SEXP ep, SEXP oh, SEXP th) /* C-Language code for a simple random dynamic network generator. Arguments are as follows: g - a pre-initialized network object ep - the edge probability parameter oh - the edge onset hazard parameter th - the edge termination hazard parameter */ { int n, i, w; double u, fet, let, *vfet, *vlet, ot, tt; SEXP tail, head, atl, atlnam, sot, stt, ec; /*Verify that we were called properly, and set things up*/ netRegisterFunctions(); if(!netIsNetwork(g)) error("rnbernexp_R must be called with a network object.\n"); if(netIsDir(g)) error("Network passed to rnbernexp_R should be undirected.\n"); n = netNetSize(g); PROTECT(ep = coerceVector(ep, REALSXP)); PROTECT(oh = coerceVector(oh, REALSXP)); PROTECT(th = coerceVector(th, REALSXP)); PROTECT(ec = allocVector(LGLSXP, 1)); LOGICAL(ec)[0] = 0; GetRNGstate(); /*Allocate memory for first/last edge time trackers*/ vfet = (double *)R_alloc(n, sizeof(double)); vlet = (double *)R_alloc(n, sizeof(double)); for(i = 0; i < n; i++) vfet[i] = vlet[i] = NA_REAL; fet = let = NA_REAL; \end{Code} In order to assure that all arguments are of the appropriate type, we employ a combination of verification and coercion. After registering the \pkg{network} API functions using \code{netRegisterFunctions}, we use the indicators \code{netIsNetwork} and \code{netIsDir} to verify that the \code{g} argument is indeed a \code{network} object, and that it is undirected. After verifying these conditions, we can use \code{netNetSize} to obtain the number of vertices in the network. This quantity is saved for further use. With the preliminaries out of the way, we are now in a position to draw edges. The algorithm used to generate the underlying graph is that of \cite{batagelj.brandes:pre:2005}, which scales well for sparse graphs (complexity is $\mathcal{O}(n+m)$). Edges themselves are added via the \code{netAddEdge} API function, which is analogous to \code{add.edge} in the \proglang{R} interface. Because we are operating directly on the network object, we must handle memory allocation ourselves: the \code{allocVector} calls in the following section are used to allocate memory for the head, tail, and attribute lists, and for the vector of attribute names. These are set accordingly, with the ``OnsetTime'' and ``TerminationTime'' attributes being created to store edge onsets and terminations, respectively. Once the edge elements are created, \code{netAddEdge} assures that they are placed within the \code{network} object; since \proglang{R}'s garbage collection mechanism protects these elements once they are linked to \code{g} (which is a protected object), we can subsequently remove them from the memory protection stack using \code{UNPROTECT}. \begin{Code} /*Draw the network information*/ w = -1; i = 1; while(i < n){ u = runif(0.0, 1.0); w += 1+ (int)floor(log(1.0 - u) / log(1.0 - REAL(ep)[0])); while((w >= i) && (i < n)){ w -= i; i++; } if(i < n){ /*Generate an edge*/ /*Draw and track timing information*/ ot = rexp(REAL(oh)[0]); tt = ot + rexp(REAL(th)[0]); fet = ((ISNA(fet)) || (ot < fet)) ? ot : fet; let = ((ISNA(let)) || (tt > let)) ? tt : let; vfet[i] = ((ISNA(vfet[i])) || (ot < vfet[i])) ? ot : vfet[i]; vlet[i] = ((ISNA(vlet[i])) || (tt > vlet[i])) ? tt : vlet[i]; /*Allocate memory for the new edge*/ PROTECT(tail = allocVector(INTSXP, 1)); /*Allocate head/tail*/ PROTECT(head = allocVector(INTSXP, 1)); INTEGER(tail)[0] = i + 1; INTEGER(head)[0] = w + 1; PROTECT(atl = allocVector(VECSXP, 2)); /*Allocate attributes*/ PROTECT(sot = allocVector(REALSXP, 1)); PROTECT(stt = allocVector(REALSXP, 1)); PROTECT(atlnam = allocVector(STRSXP, 2)); SET_STRING_ELT(atlnam, 0, mkChar("OnsetTime")); SET_STRING_ELT(atlnam, 1, mkChar("TerminationTime")); REAL(sot)[0] = ot; REAL(stt)[0] = tt; SET_VECTOR_ELT(atl, 0, sot); SET_VECTOR_ELT(atl, 1, stt); g = netAddEdge(g, tail, head, atlnam, atl, ec); /*Add the edge*/ UNPROTECT(6); } } \end{Code} At this point, all edges have been placed within the network. While we could stop here, it seems useful to first tabulate some basic meta-data regarding the network being produced. In particular, a function to analyze a network of this type would doubtless need to know the total time interval over which each vertex (and the network as a whole) is active. Via the \pkg{network} API, we can easily store this information in \code{g}'s network and vertex attribute lists before returning. To do this, we employ \code{netSetVertexAttrib} and \code{netSetNetAttrib}, API functions which are analogous to \code{set.vertex.attribute} and \code{set.network.attribute}. As with the case of edge addition, we must allocate memory for the attribute entry prior to installing it -- the \code{netSet*} routines pass references to their arguments, rather than copying them -- but these functions do handle the creation of attribute names from raw strings. After writing our metadata into the graph, we clear the protection stack and return the \proglang{R} object pointer. \begin{Code} /*Add network and vertex attributes*/ for(i = 0; i < n; i++){ PROTECT(sot = allocVector(REALSXP, 1)); PROTECT(stt = allocVector(REALSXP, 1)); REAL(sot)[0] = vfet[i]; REAL(stt)[0] = vlet[i]; g = netSetVertexAttrib(g, "FirstOnsetTime", sot, i + 1); g = netSetVertexAttrib(g, "LastTerminationTime", stt, i + 1); UNPROTECT(2); } PROTECT(sot = allocVector(REALSXP, 1)); PROTECT(stt = allocVector(REALSXP, 1)); REAL(sot)[0] = fet; REAL(stt)[0] = let; g = netSetNetAttrib(g, "FirstOnsetTime", sot); g = netSetNetAttrib(g, "LastTerminationTime", stt); /*Clear protection stack and return*/ PutRNGstate(); UNPROTECT(6); return g; } \end{Code} To use the \code{rnbernexp_R} function, it must be invoked from \proglang{R} using the \code{.Call} interface. A simple wrapper function (whose behavior is similar to \proglang{R}'s built-in random number generation routines) might look like the following: <<>>= rnbernexp <- function(n, nv, p = 0.5, onset.hazard = 1, termination.hazard = 1){ nets <- list() for(i in 1:n) nets[[i]] <- .Call("rnbernexp_R", network.initialize(nv, directed = FALSE), p, onset.hazard, termination.hazard, PACKAGE = "networkapi.example") if(i > 1) nets else nets[[1]] } @ In actual use, the \code{PACKAGE} setting would be changed to the name of the shared object file in which the \code{rnbernexp_R} symbol resides. (This file would need to be linked against the \code{networkapi} file, and dynamically loaded after \pkg{network} is in memory. Linking against the entire \pkg{network} library is not required, however.) Although the specific distribution simulated is too simplistic to serve as a very good model of social dynamics, it nevertheless illustrates how the \pkg{network} API can be used to efficiently simulate and store the results of non-trivial processes within compiled code. \section{Final comments} For several decades, tools for social network analysis were essentially isolated from those supporting conventional statistical analyses. A major reason for this isolation was the difficulty in manipulating -- or even representing -- relational data within standard statistical packages. In recent years, the emergence of flexible statistical computing environments such as \proglang{R} have helped to change this situation. Platforms like \proglang{R} allow for the creation of the complex data structures needed to represent rich relational data, while also facilitating the development of tools to make such structures accessible to the end user. The \pkg{network} package represents one attempt to leverage these capabilities in order to create a low-level infrastructure for the analysis of relational data. Together with packages like \pkg{sna}, \pkg{ergm}, and the rest of the \pkg{statnet} suite, it is hoped that \pkg{network} will provide a useful resource for scientists both inside and outside of the social network community. \section*{Acknowledgments} The author gratefully acknowledges the input of present and past \pkg{statnet} collaborators, including Mark Handcock, David Hunter, Daniel Westreich, Martina Morris, Steve Goodreau, Pavel Krivitsky, and Krista Gile. This paper is based upon work supported by National Institutes of Health award 5 R01 DA012831-05, subaward 918197, and by NSF award IIS-0331707. \begin{thebibliography}{} \bibitem[Batagelj \& Brandes(2005)]{batagelj.brandes:pre:2005} Batagelj V, Brandes U (2005). ``Efficient Generation of Large Random Networks.'' \emph{Physical Review E}, 71(3), 036113, 1-5. doi:10.1103/PhysRevE.71.036113. \bibitem[Batagelj(2007)]{pajek} Batagelj V, Mrvar A (2007). \emph{Pajek: Package for Large Network Analysis.} University of Ljubljana, Slovenia. URL \url{http://vlado.fmf.uni-lj.si/pub/networks/pajek/}. \bibitem[Butts(2002)]{butts:tr:2002} Butts CT (2002). ``Memory Structures for Relational Data in R: Classes and Interfaces.'' \emph{Unpublished manuscript}, University of California, Irvine. \bibitem[Butts(2007)]{sna} Butts CT (2007). \emph{sna: Tools for Social Network Analysis}. Statnet Project \url{http://statnetproject.org/}, Seattle, WA. R package version 1.5, URL \url{http://CRAN.R-project.org/package=sna}. \bibitem[Butts \& Carley(2005)]{butts.carley:cmot:2005} Butts CT, Carley KM (2005). ``Some Simple Algorithms for Structural Comparison.' \emph{Computational and Mathematical Organization Theory}, 11(4), 291-305. \bibitem[Butts, et al.(2007)]{network} Butts CT, Handcock MS, Hunter DR (2007). \emph{network: Classes for Relational Data}. Statnet Project \url{http://statnetproject.org/}, Seattle, WA. R package version 1.3, URL \url{http://CRAN.R-project.org/package=network}. \bibitem[Butts, et all.(2014)]{networkDynamic} Butts CT, Leslie-Cook A, Krivitsky P and Bender-deMoll S (2014). \emph{networkDynamic: Dynamic Extensions for Network Objects.} R package version 0.6.3. http://statnet.org URL \url{http://CRAN.R-project.org/package=networkDynamic} \bibitem[Carey, et al.(2007)]{carey.et.al:sw:2007} Carey VJ, Long L, Gentleman R (2007). \emph{RBGL: R Interface to Boost C++ Graph Library}. R package version 1.14.0, URL \url{http://www.bioconductor.org/}. \bibitem[Chambers(1998)]{chambers:bk:1998} Chambers JM (1998). \emph{Programming with Data}. Springer-Verlag, New York. ISBN 0-387- 98503-4. \bibitem[Csardi \& Nepusz(2006)]{gabor:sw:2007} Csardi G, Nepusz T (2006). ``The igraph Software Package for Complex Network Re- search.'' \emph{InterJournal, Complex Systems}, 1695. URL \url{http://www.interjournal.org/manuscript_abstract.php?361100992.} \bibitem[Doreian, et al.(2005)]{doreian.et.al:bk:2005} Doreian P, Batagelj V, Ferlioj A (2005). \emph{Generalized Blockmodeling}. Cambridge University Press, Cambridge. \bibitem[Drabek, et al.(1981)]{drabek.et.al:bk:1981} Drabek TE, Tamminga HL, Kilijanek TS, Adams CR (1981). \emph{Managing Multiorganizational Emergency Responses: Emergent Search and Rescue Networks in Natural Disaster and Remote Area Settings}. Number Monograph 33 in Program on Technology, Environment, and Man. Institute of Behavioral Sciences, University of Colorado, Boulder, CO. \bibitem[Fruchterman \& Reingold(1991)]{fruchterman.reingold:spae:1991} Fruchterman TMJ, Reingold EM (1991). ``Graph Drawing by Force-directed Placement.' \emph{Software -- Practice and Experience}, 21(11), 1129-1164. \bibitem[Gentleman, et al.(2007)]{gentleman.et.al:sw:2007} Gentleman R, Whalen E, Huber W, Falcon S (2007). \emph{graph: A Package to Handle Graph Data Structures}. R package version 1.14.2, URL \url{http://CRAN.R-project.org/package=graph.} \bibitem[Gentry, et al.(2007)]{gentry.et.al:sw:2007} Gentry J, Long L, Gentleman R, Falcon S (2007). \emph{Rgraphviz: Plotting Capabilities for R Graph Objects}. R package version 1.16.0, URL \url{http://CRAN.R-project.org/package=Rgraphviz}. \bibitem[Handcock, et al.(2003)]{statnet} Handcock MS, Hunter DR, Butts CT, Goodreau SM, Morris M (2003). \emph{statnet: Software Tools for the Statistical Modeling of Network Data}. Statnet Project \url{http://statnetproject.org/}, Seattle, WA. R package version 2.0, URL \url{http://CRAN. R-project.org/package=statnet}. \bibitem[Kamada\& Kawai(1989)]{kamada.kawai:ipl:1989} Kamada T, Kawai S (1989). ``An Algorithm for Drawing General Undirected Graphs.'' \emph{Information Processing Letters}, 31(1), 7-15. \bibitem[Killworth \& Bernard(1976)]{killworth.bernard:ho:1976} Killworth PD, Bernard HR (1976). ``Informant Accuracy in Social Network Data.'' \emph{Human Organization}, 35(8), 269-286. \bibitem[Koenker \& Ng(2007)]{koenker.ng:sw:2007} Koenker R, Ng P (2007). \emph{SparseM: Sparse Linear Algebra}. R package version 0.73, URL \url{http://CRAN.R-project.org/package=SparseM}. \bibitem[Krackhardt(1988)]{krackhardt:sn:1988} Krackhardt D (1988). ``Predicting with Networks: Nonparametric Multiple Regression Anal- yses of Dyadic Data.'' \emph{Social Networks}, 10, 359-382. \bibitem[Mayhew \& Levinger(1976)]{mayhew.levinger:ajs:1976} Mayhew BH, Levinger RL (1976). ``Size and Density of Interaction in Human Aggregates.'' \emph{American Journal of Sociology}, 82, 86-110. \bibitem[R Development Core Team(2007)]{R} R Development Core Team (2007). \emph{R: A Language and Environment for Statistical Computing}. R Foundation for Statistical Computing, Vienna, Austria. ISBN 3-900051-07-0, Version 2.6.1, URL \url{http://www.R-project.org/}. \bibitem[Venables \& Ripley(2000)]{venables.ripley:bk:2000} Venables WN, Ripley BD (2000). \emph{S Programming}. Springer-Verlag, New York. ISBN 0-387-98966-8. \bibitem[Venables \& Ripley(2002)]{venables.ripley:bk:2002} Venables WN, Ripley BD (2002). \emph{Modern Applied Statistics with S}. Springer-Verlag, New York, fourth edition. ISBN 0-387-95457-0. \bibitem[Wasserman \& Faust(1994)]{wass:faus1994} Wasserman SS, Faust K (1994). \emph{Social Network Analysis: Methods and Applications}. Structural Analysis in the Social Sciences. Cambridge University Press, Cambridge. \end{thebibliography} \end{document} network/inst/doc/networkVignette.R0000644000176200001440000003061714725415437017032 0ustar liggesusers### R code from vignette source 'networkVignette.Rnw' ################################################### ### code chunk number 1: networkVignette.Rnw:151-153 ################################################### library(network) set.seed(1702) ################################################### ### code chunk number 2: networkVignette.Rnw:171-173 ################################################### data("flo") data("emon") ################################################### ### code chunk number 3: networkVignette.Rnw:184-186 ################################################### net <- network.initialize(5) net ################################################### ### code chunk number 4: networkVignette.Rnw:213-216 ################################################### nmat <- matrix(rbinom(25, 1, 0.5), nr = 5, nc = 5) net <- network(nmat, loops = TRUE) net ################################################### ### code chunk number 5: networkVignette.Rnw:218-219 ################################################### summary(net) ################################################### ### code chunk number 6: networkVignette.Rnw:221-222 ################################################### all(nmat == net[,]) ################################################### ### code chunk number 7: networkVignette.Rnw:234-236 ################################################### net <- as.network(nmat, loops = TRUE) all(nmat == net[,]) ################################################### ### code chunk number 8: networkVignette.Rnw:242-244 ################################################### nflo <- network(flo, directed = FALSE) nflo ################################################### ### code chunk number 9: networkVignette.Rnw:248-253 ################################################### nflo[9,] nflo[9,1] nflo[9,4] is.adjacent(nflo, 9, 1) is.adjacent(nflo, 9, 4) ################################################### ### code chunk number 10: networkVignette.Rnw:260-268 ################################################### network.size(nflo) #Number of vertices network.edgecount(nflo) #Number of edges network.density(nflo) #Network density has.loops(nflo) #Can nflo have loops? is.bipartite(nflo) #Is nflo coded as bipartite? is.directed(nflo) #Is nflo directed? is.hyper(nflo) #Is nflo hypergraphic? is.multiplex(nflo) #Are multiplex edges allowed? ################################################### ### code chunk number 11: networkVignette.Rnw:274-278 ################################################### as.sociomatrix(nflo) all(nflo[,]==as.sociomatrix(nflo)) all(as.matrix(nflo)==as.sociomatrix(nflo)) as.matrix(nflo,matrix.type="edgelist") ################################################### ### code chunk number 12: networkVignette.Rnw:287-305 ################################################### #Add edges to an empty network net <- network.initialize(5,loops=TRUE) net[nmat>0] <- 1 #One way to add edges all(nmat==net[,]) #Should be TRUE net[,] <- 0 #Remove the edges net[,] <- nmat #Not quite kosher, but _will_ work.... all(nmat==net[,]) #Should still be TRUE net[,] <- 0 #Remove the edges for(i in 1:5) #Add the hard way! for(j in 1:5) if(nmat[i,j]) net[i,j] <- 1 all(nmat==net[,]) #Should STILL be TRUE net[,] <- 0 #Remove the edges add.edges(net,row(nmat)[nmat>0],col(nmat)[nmat>0]) all(nmat==net[,]) #When will it all end?? net[,] <- as.numeric(nmat[,]) all(nmat==net[,]) #When will it all end?? ################################################### ### code chunk number 13: networkVignette.Rnw:309-317 ################################################### #Add edges (redux) net<-network.initialize(5) #Create empty graph add.edge(net,2,3) #Create 2->3 edge net[,] #Trust, but verify add.edges(net,c(3,5),c(4,4)) #3 and 5 send ties to 4 net[,] #Again, verify edges net[,2]<-1 #Everyone sends ties to 2 net[,] #Note that loops are not created! ################################################### ### code chunk number 14: networkVignette.Rnw:323-328 ################################################### #Deleting vertices delete.vertices(net,4) #Remove vertex 4 net[,] #It's gone! add.vertices(net,2) #Add two new vertices net[,] #Both are isolates ################################################### ### code chunk number 15: networkVignette.Rnw:334-338 ################################################### #Retrieving edges get.edges(net,1) #Out-edges sent by vertex 1 get.edges(net,2,neighborhood="in") #In-edges to vertex 2 get.edges(net,1,alter=2) #Out-edges from 1 to 2 ################################################### ### code chunk number 16: networkVignette.Rnw:343-347 ################################################### #Retrieving edge IDs get.edgeIDs(net,1) #Same as above, but gets ID numbers get.edgeIDs(net,2,neighborhood="in") get.edgeIDs(net,1,alter=2) ################################################### ### code chunk number 17: networkVignette.Rnw:351-354 ################################################### #Vertex neighborhoods get.neighborhood(net,1) #1's out-neighbors get.neighborhood(net,2,type="in") #2's in-neighbors ################################################### ### code chunk number 18: networkVignette.Rnw:358-364 ################################################### #Deleting edges net[2,3]<-0 #This deletes the 2->3 #edge net[2,3]==0 #Should be TRUE delete.edges(net,get.edgeIDs(net,2,neighborhood="in")) #Remove all->2 net[,] ################################################### ### code chunk number 19: networkVignette.Rnw:376-379 ################################################### net <- network.initialize(5) set.network.attribute(net, "boo", 1:10) net %n% "hoo" <- letters[1:7] ################################################### ### code chunk number 20: networkVignette.Rnw:382-388 ################################################### #List attributes list.network.attributes(net) #Retrieve attributes get.network.attribute(net,"boo") net %n% "hoo" ################################################### ### code chunk number 21: networkVignette.Rnw:392-395 ################################################### #Delete attributes delete.network.attribute(net,"boo") list.network.attributes(net) ################################################### ### code chunk number 22: networkVignette.Rnw:403-417 ################################################### #Add vertex attributes set.vertex.attribute(net,"boo",1:5) #Create a numeric attribute net %v% "hoo" <- letters[1:5] #Now, a character attribute #Listing attributes list.vertex.attributes(net) #List all vertex attributes #Retrieving attributes get.vertex.attribute(net,"boo") #Retrieve 'em net %v% "hoo" #Deleting attributes delete.vertex.attribute(net,"boo") #Remove one list.vertex.attributes(net) #Check to see that it's gone ################################################### ### code chunk number 23: networkVignette.Rnw:426-447 ################################################### #Create a network with some edges net <- network(nmat) #Add attributes set.edge.attribute(net,"boo",sum(nmat):1) set.edge.value(net,"hoo",matrix(1:25,5,5)) #Note: only sets for extant edges! net %e% "woo" <- matrix(rnorm(25),5,5) #Ditto net[,,names.eval="zoo"] <- nmat*6 #Ditto if add.edges!=TRUE #List attributes list.edge.attributes(net) #Retrieving attributes get.edge.attribute(get.edges(net,1),"boo") #Get the attribute for 1's out-edges get.edge.value(net,"hoo") net %e% "woo" as.sociomatrix(net,"zoo") #Deleting attributes delete.edge.attribute(net,"boo") list.edge.attributes(net) ################################################### ### code chunk number 24: networkVignette.Rnw:462-477 ################################################### #Extract location information MtSHloc<-emon$MtStHelens%v%"Location" #Build an incidence matrix based on Local/Non-local/Both placement MtSHimat<-cbind(MtSHloc%in%c("L","B"),MtSHloc%in%c("NL","B")) #Convert incidence matrix to a hypergraph MtSHbyloc<-network(MtSHimat,matrix="incidence",hyper=TRUE,directed=FALSE, loops=TRUE) #Set vertex names, for convenience MtSHbyloc%v%"vertex.names"<-emon$MtStHelens%v%"vertex.names" #Examine the result MtSHbyloc ################################################### ### code chunk number 25: networkVignette.Rnw:489-491 ################################################### plot(nflo, displaylabels = TRUE, boxed.labels = FALSE) plot(nflo, displaylabels = TRUE, mode = "circle") ################################################### ### code chunk number 26: networkVignette.Rnw:502-507 ################################################### op<-par(no.readonly=TRUE) # cache the plot params par(mfcol=c(1,2),mar=c(1,1,1,1),cex=0.5) # adjust margins and text size to fit two panels plot(nflo, displaylabels = TRUE,boxed.labels = TRUE) plot(nflo, displaylabels = TRUE, mode = "circle") par(op) # reset the plot params ################################################### ### code chunk number 27: networkVignette.Rnw:513-514 ################################################### plot(emon$MtSi) ################################################### ### code chunk number 28: networkVignette.Rnw:521-522 ################################################### plot(emon$MtSi) ################################################### ### code chunk number 29: networkVignette.Rnw:532-541 ################################################### library(sna) network.layout.degree <- function(d, layout.par){ id <- degree(d, cmode = "indegree") od <- degree(d, cmode = "outdegree") cbind(id, od) } plot(emon$MtStHelens, mode = "degree", displaylabels = TRUE, boxed.labels = FALSE, suppress.axes = FALSE, label.cex = 0.5, xlab = "Indegree", ylab = "Outdegree", label.col = 3) ################################################### ### code chunk number 30: networkVignette.Rnw:548-551 ################################################### plot(emon$MtStHelens, mode = "degree", displaylabels = TRUE, boxed.labels = FALSE, suppress.axes = FALSE, label.cex = 0.5, xlab = "Indegree", ylab = "Outdegree", label.col = 3) ################################################### ### code chunk number 31: networkVignette.Rnw:559-564 ################################################### plot(MtSHbyloc, displaylabels = TRUE, label = c(network.vertex.names(MtSHbyloc), "Local", "Non-Local"), boxed.labels = FALSE, label.cex = rep(c(0.5, 1), times = c(27, 2)), label.col = rep(c(3, 4), times = c(27, 2)), vertex.col = rep(c(2, 5), times = c(27, 2))) ################################################### ### code chunk number 32: networkVignette.Rnw:573-578 ################################################### plot(MtSHbyloc, displaylabels = TRUE, label = c(network.vertex.names(MtSHbyloc), "Local", "Non-Local"), boxed.labels = FALSE, label.cex = rep(c(0.5, 1), times = c(27, 2)), label.col = rep(c(3, 4), times = c(27, 2)), vertex.col = rep(c(2, 5), times = c(27, 2))) ################################################### ### code chunk number 33: networkVignette.Rnw:718-730 ################################################### rnbernexp <- function(n, nv, p = 0.5, onset.hazard = 1, termination.hazard = 1){ nets <- list() for(i in 1:n) nets[[i]] <- .Call("rnbernexp_R", network.initialize(nv, directed = FALSE), p, onset.hazard, termination.hazard, PACKAGE = "networkapi.example") if(i > 1) nets else nets[[1]] } network/inst/network.api/0000755000176200001440000000000013357022000015151 5ustar liggesusersnetwork/inst/network.api/networkapi.c0000644000176200001440000000617113656361200017517 0ustar liggesusers/* ###################################################################### # # networkapi.c # # Written by Carter T. Butts # Last Modified 5/07/16 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater. # # Provides support for the R/network package API. # # This file is known to be compatible with network package version 1.14. # It should be compatible with subsequent versions, but updates may be # necessary in rare cases. # # This file contains the registration routine needed to use the # C-level network package API. # ###################################################################### */ /*INCLUSIONS----------------------------------------------------------------*/ #include #include #include "networkapi.h" /*INTERNAL FUNCTIONS--------------------------------------------------------*/ void netRegisterFunctions(void) /*Register functions for the network package API. This function must be called before using any API routines, since these routines will not otherwise be defined within the local namespace.*/ { /*Register access routines*/ netGetEdgeAttrib_ptr = (SEXP (*)(SEXP, int, const char*)) R_GetCCallable("network", "getEdgeAttribute"); netGetEdgeIDs_ptr = (SEXP (*)(SEXP, int, int, const char*, int)) R_GetCCallable("network", "getEdgeIDs"); netGetEdges_ptr = (SEXP (*)(SEXP, int, int, const char*, int)) R_GetCCallable("network", "getEdges"); netGetNeighborhood_ptr = (SEXP (*)(SEXP, int, const char*, int)) R_GetCCallable("network", "getNeighborhood"); netGetNetAttrib_ptr = (SEXP (*)(SEXP, const char*)) R_GetCCallable("network", "getNetworkAttribute"); netHasLoops_ptr = (int (*)(SEXP)) R_GetCCallable("network", "hasLoops"); netIsAdj_ptr = (int (*)(SEXP, int, int, int)) R_GetCCallable("network", "isAdjacent"); netIsDir_ptr = (int (*)(SEXP)) R_GetCCallable("network", "isDirected"); netIsHyper_ptr = (int (*)(SEXP)) R_GetCCallable("network", "isHyper"); netIsLoop_ptr = (int (*)(SEXP, SEXP)) R_GetCCallable("network", "isLoop"); netIsMulti_ptr = (int (*)(SEXP)) R_GetCCallable("network", "isMultiplex"); netIsNetwork_ptr = (int (*)(SEXP)) R_GetCCallable("network", "isNetwork"); netNetEdgecount_ptr = (int (*)(SEXP, int)) R_GetCCallable("network", "networkEdgecount"); netNetSize_ptr = (int (*)(SEXP)) R_GetCCallable("network", "networkSize"); /*Register modification routines*/ netAddEdge_ptr = (SEXP (*)(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP)) R_GetCCallable("network", "addEdge_R"); netAddEdges_ptr = (SEXP (*)(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP)) R_GetCCallable("network", "addEdges_R"); netDelEdgeAttrib_ptr = (SEXP (*)(SEXP, int, const char*)) R_GetCCallable("network", "deleteEdgeAttribute"); netDelVertexAttrib_ptr = (SEXP (*)(SEXP, int, const char*)) R_GetCCallable("network", "deleteVertexAttribute"); netDelNetAttrib_ptr = (SEXP (*)(SEXP, const char*)) R_GetCCallable("network", "deleteNetworkAttribute"); netSetNetAttrib_ptr = (SEXP (*)(SEXP, const char*, SEXP)) R_GetCCallable("network", "setNetworkAttribute"); netSetVertexAttrib_ptr = (SEXP (*)(SEXP, const char*, SEXP, int)) R_GetCCallable("network", "setVertexAttribute"); network/inst/network.api/networkapi.h0000644000176200001440000000602213656361215017525 0ustar liggesusers/* ###################################################################### # # networkapi.h # # Written by Carter T. Butts # Last Modified 5/07/16 # Licensed under the GNU General Public License version 2 (June, 1991) # or greater. # # Provides support for the R/network package API. # # This file was written for network version 1.14. If using a later # version of network, you may need to update it. # # This file contains headers for networkapi.c, as well as macros and # other definitions needed to support the network package API. # ###################################################################### */ #ifndef NETWORKAPI_H #define NETWORKAPI_H /*INCLUSIONS----------------------------------------------------------------*/ #include #include #include #include /*FUNCTION MACROS-----------------------------------------------------------*/ /*Access functions*/ #define netGetEdgeAttrib (*netGetEdgeAttrib_ptr) #define netGetEdgeIDs (*netGetEdgeIDs_ptr) #define netGetEdges (*netGetEdges_ptr) #define netGetNeighborhood (*netGetNeighborhood_ptr) #define netGetNetAttrib (*netGetNetAttrib_ptr) #define netHasLoops (*netHasLoops_ptr) #define netIsAdj (*netIsAdj_ptr) #define netIsDir (*netIsDir_ptr) #define netIsHyper (*netIsHyper_ptr) #define netIsLoop (*netIsLoop_ptr) #define netIsMulti (*netIsMulti_ptr) #define netIsNetwork (*netIsNetwork_ptr) #define netNetEdgecount (*netNetEdgecount_ptr) #define netNetSize (*netNetSize_ptr) /*Modification functions*/ #define netAddEdge (*netAddEdge_ptr) #define netAddEdges (*netAddEdges_ptr) #define netDelEdgeAttrib (*netDelEdgeAttrib_ptr) #define netDelNetAttrib (*netDelNetAttrib_ptr) #define netDelVertexAttrib (*netDelVertexAttrib_ptr) #define netSetNetAttrib (*netSetNetAttrib_ptr) #define netSetVertexAttrib (*netSetVertexAttrib_ptr) /*POINTER VARIABLES---------------------------------------------------------*/ /*Access functions*/ SEXP (*netGetEdgeAttrib_ptr)(SEXP, int, const char*); SEXP (*netGetEdgeIDs_ptr)(SEXP, int, int, const char*, int); SEXP (*netGetEdges_ptr)(SEXP, int, int, const char*, int); SEXP (*netGetNeighborhood_ptr)(SEXP, int, const char*, int); SEXP (*netGetNetAttrib_ptr)(SEXP, const char*); int (*netHasLoops_ptr)(SEXP); int (*netIsAdj_ptr)(SEXP, int, int, int); int (*netIsDir_ptr)(SEXP); int (*netIsHyper_ptr)(SEXP); int (*netIsLoop_ptr)(SEXP, SEXP); int (*netIsMulti_ptr)(SEXP); int (*netIsNetwork_ptr)(SEXP); int (*netNetEdgecount_ptr)(SEXP, int); int (*netNetSize_ptr)(SEXP); /*Modification functions*/ SEXP (*netAddEdge_ptr)(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); SEXP (*netAddEdges_ptr)(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); SEXP (*netDelEdgeAttrib_ptr)(SEXP, int, const char*); SEXP (*netDelNetAttrib_ptr)(SEXP, const char*); SEXP (*netDelVertexAttrib_ptr)(SEXP, int, const char*); SEXP (*netSetNetAttrib_ptr)(SEXP, const char*, SEXP); SEXP (*netSetVertexAttrib_ptr)(SEXP, const char*, SEXP, int); /*REGISTRATION FUNCTIONS----------------------------------------------------*/ void netRegisterFunctions(void); #endif network/build/0000755000176200001440000000000014725415437013056 5ustar liggesusersnetwork/build/vignette.rds0000644000176200001440000000031514725415437015414 0ustar liggesusers 0?@OS7݄Dt;rS`tד4rsPJ@\n`  t-o*R= 2.10), utils\cr Suggests: \tab sna, statnet.common (>= 3.1-0)\cr License: \tab GPL (>=2)\cr } Index of documentation pages: \preformatted{ add.edges Add Edges to a Network Object add.vertices Add Vertices to an Existing Network as.matrix.network Coerce a Network Object to Matrix Form as.network.matrix Coercion from Matrices to Network Objects as.sociomatrix Coerce One or More Networks to Sociomatrix Form attribute.methods Attribute Interface Methods for the Network Class deletion.methods Remove Elements from a Network Object edgeset.constructors Edgeset Constructors for Network Objects emon Interorganizational Search and Rescue Networks (Drabek et al.) flo Florentine Wedding Data (Padgett) get.edges Retrieve Edges or Edge IDs Associated with a Given Vertex get.inducedSubgraph Retrieve Induced Subgraphs and Cuts get.neighborhood Obtain the Neighborhood of a Given Vertex is.adjacent Determine Whether Two Vertices Are Adjacent loading.attributes Examples of how to load vertex and edge attributes into networks missing.edges Identifying and Counting Missing Edges in a Network Object network Network Objects network.arrow Add Arrows or Segments to a Plot network.density Compute the Density of a Network network.dyadcount Return the Number of (Possibly Directed) Dyads in a Network Object network.edgecount Return the Number of Edges in a Network Object network.edgelabel Plots a label corresponding to an edge in a network plot. network.extraction Extraction and Replacement Operators for Network Objects network.indicators Indicator Functions for Network Properties network.initialize Initialize a Network Class Object network.layout Vertex Layout Functions for plot.network network.loop Add Loops to a Plot network.operators Network Operators network-package Classes for Relational Data network.size Return the Size of a Network network.vertex Add Vertices to a Plot permute.vertexIDs Permute (Relabel) the Vertices Within a Network plotArgs.network Expand and transform attributes of networks to values appropriate for aguments to plot.network plot.network.default Two-Dimensional Visualization for Network Objects prod.network Combine Networks by Edge Value Multiplication read.paj Read a Pajek Project or Network File and Convert to an R 'Network' Object sum.network Combine Networks by Edge Value Addition valid.eids Get the valid edge which are valid in a network which.matrix.type Heuristic Determination of Matrix Types for Network Storage } } \seealso{ Useful links: \itemize{ \item \url{https://statnet.org/} } } \author{ Carter T. Butts \href{mailto:buttsc@uci.edu}{buttsc@uci.edu}, with help from Mark S. Handcock \href{mailto:handcock@stat.ucla.edu}{handcock@stat.ucla.edu}, David Hunter \href{mailto:dhunter@stat.psu.edu}{dhunter@stat.psu.edu}, Martina Morris \href{mailto:morrism@u.washington.edu}{morrism@u.washington.edu}, Skye Bender-deMoll \href{mailto:skyebend@u.washington.edu}{skyebend@u.washington.edu}, and Jeffrey Horner \href{mailto:jeffrey.horner@gmail.com}{jeffrey.horner@gmail.com}. Maintainer: Carter T. Butts \href{mailto:buttsc@uci.edu}{buttsc@uci.edu} } \keyword{package} network/man/network.density.Rd0000644000176200001440000000353014723241675016170 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.R \name{network.density} \alias{network.density} \title{Compute the Density of a Network} \usage{ network.density(x, na.omit = TRUE, discount.bipartite = FALSE) } \arguments{ \item{x}{an object of class \code{network}} \item{na.omit}{logical; omit missing edges from extant edges when assessing density?} \item{discount.bipartite}{logical; if \code{x} is bipartite, should \dQuote{forbidden} edges be excluded from the count of potential edges?} } \value{ The network density. } \description{ \code{network.density} computes the density of its argument. } \details{ The density of a network is defined as the ratio of extant edges to potential edges. We do not currently consider edge values; missing edges are omitted from extent (but not potential) edge count when \code{na.omit==TRUE}. } \section{Warning }{ \code{network.density} relies on network attributes (see \link{network.indicators}) to determine the properties of the underlying network object. If these are set incorrectly (e.g., multiple edges in a non-multiplex network, network coded with directed edges but set to \dQuote{undirected}, etc.), surprising results may ensue. } \examples{ #Create an arbitrary adjacency matrix m<-matrix(rbinom(25,1,0.5),5,5) diag(m)<-0 g<-network.initialize(5) #Initialize the network network.density(g) #Calculate the density } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} Wasserman, S. and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. } \seealso{ \code{\link{network.edgecount}}, \code{\link{network.size}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} network/man/network.edgecount.Rd0000644000176200001440000000520614723241675016470 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{network.edgecount} \alias{network.edgecount} \alias{network.edgecount.network} \title{Return the Number of Edges in a Network Object} \usage{ \method{network.edgecount}{network}(x, na.omit = TRUE, ...) } \arguments{ \item{x}{an object of class \code{network}} \item{na.omit}{logical; omit edges with \code{na==TRUE} from the count?} \item{\dots}{additional arguments, used by extending functio} } \value{ The number of edges } \description{ \code{network.edgecount} returns the number of edges within a \code{network}, removing those flagged as missing if desired. } \details{ The return value is the number of distinct edges within the network object, including multiplex edges as appropriate. (So if there are 3 edges from vertex i to vertex j, each contributes to the total edge count.) The return value \code{network.edgecount} is in the present implementation related to the (required) \code{mnext} network attribute. \code{mnext} is an internal legacy attribute that currently indicates the index number of the next edge to be added to a network object. (Do not modify it unless you enjoy unfortunate surprises.) The number of edges returned by \code{network.edgecount} is equal to \code{x\%n\%"mnext"-1}, minus the number of \code{NULL} edges (and missing edges, if \code{na.omit==TRUE}). Note that \code{g\%n\%"mnext"-1} cannot, by itself, be counted upon to be an accurate count of the number of edges! As \code{mnext} is not part of the API (and is not guaranteed to remain), users and developers are urged to use \code{network.edgecount} instead. } \section{Warning }{ \code{network.edgecount} uses the real state of the network object to count edges, not the state it hypothetically should have. Thus, if you add extra edges to a non-multiplex network, directed edges to an undirected network, etc., the actual number of edges in the object will be returned (and not the number you would expect if you relied only on the putative number of possible edges as reflected by the \link{network.indicators}). Don't create \code{network} objects with contradictory attributes unless you know what you are doing. } \examples{ #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) network.edgecount(g)==3 #Verify the edgecount } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{get.network.attribute}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/emon.Rd0000644000176200001440000001043714057014734013755 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/network-package.R \docType{data} \name{emon} \alias{emon} \title{Interorganizational Search and Rescue Networks (Drabek et al.)} \format{ A list of 7 \code{\link{network}} objects: \tabular{rlll}{ \verb{[[1]]} \tab Cheyenne \tab network \tab Cheyenne SAR EMON\cr \verb{[[2]]} \tab HurrFrederic \tab network \tab Hurricane Frederic SAR EMON\cr \verb{[[3]]} \tab LakePomona \tab network \tab Lake Pomona SAR EMON\cr \verb{[[4]]} \tab MtSi \tab network \tab Mt. Si SAR EMON\cr \verb{[[5]]} \tab MtStHelens \tab network \tab Mt. St. Helens SAR EMON\cr \verb{[[6]]} \tab Texas \tab network \tab Texas Hill Country SAR EMON\cr \verb{[[7]]} \tab Wichita \tab network \tab Wichita Falls SAR EMON } Each network has one edge attribute: \tabular{lll}{ Frequency \tab numeric \tab Interaction frequency (1-4; 1=most frequent) } Each network also has 8 vertex attributes: \tabular{lll}{ Command.Rank.Score \tab numeric \tab Mean rank in the command structure\cr Decision.Rank.Score \tab numeric \tab Mean rank in the decision process\cr Formalization \tab numeric \tab Degree of formalization\cr Location \tab character \tab Location code\cr Paid.Staff \tab numeric \tab Number of paid staff\cr Sponsorship \tab character \tab Sponsorship type\cr vertex.names \tab character \tab Organization name\cr Volunteer.Staff \tab numeric \tab Number of volunteer staff } } \source{ Drabek, T.E.; Tamminga, H.L.; Kilijanek, T.S.; and Adams, C.R. (1981). \emph{Data from Managing Multiorganizational Emergency Responses: Emergent Search and Rescue Networks in Natural Disaster and Remote Area Settings.} Program on Technology, Environment, and Man Monograph 33. Institute for Behavioral Science, University of Colorado. } \usage{ data(emon) } \description{ Drabek et al. (1981) provide seven case studies of emergent multi-organizational networks (EMONs) in the context of search and rescue (SAR) activities. Networks of interaction frequency are reported, along with several organizational attributes. } \details{ All networks collected by Drabek et al. reflect reported frequency of organizational interaction during the search and rescue effort; the (i,j) edge constitutes i's report regarding interaction with j, with non-adjacent vertices reporting no contact. Frequency is rated on a four-point scale, with 1 indicating the highest frequency of interaction. (Response options: 1=\dQuote{continuously}, 2=\dQuote{about once an hour}, 3=\dQuote{every few hours}, 4=\dQuote{about once a day or less}) This is stored within the \code{"Frequency"} edge attribute. For each network, several covariates are recorded as vertex attributes: \describe{ \item{Command.Rank.Score}{ Mean (reversed) rank for the prominence of each organization in the command structure of the response, as judged by organizational informants.} \item{Decision.Rank.Score}{ Mean (reversed) rank for the prominence of each organization in decision making processes during the response, as judged by organizational informants.} \item{Formalization}{ An index of organizational formalization, ranging from 0 (least formalized) to 4 (most formalized).} \item{Localization}{ For each organization, \code{"L"} if the organization was sited locally to the impact area, \code{"NL"} if the organization was not sited near the impact area, \code{"B"} if the organization was sited at both local and non-local locations.} \item{Paid.Staff}{ Number of paid staff employed by each organization at the time of the response.} \item{Sponsorship}{ The level at which each organization was sponsored (e.g., \code{"City"}, \code{"County"}, \code{"State"}, \code{"Federal"}, and \code{"Private"}).} \item{vertex.names}{ The identity of each organization.} \item{Volunteer.Staff}{ Number of volunteer staff employed by each organization at the time of the response.} } Note that where intervals were given by the original source, midpoints have been substituted. For detailed information regarding data coding and procedures, see Drabek et al. (1981). } \examples{ data(emon) #Load the emon data set #Plot the EMONs par(mfrow=c(3,3)) for(i in 1:length(emon)) plot(emon[[i]],main=names(emon)[i],edge.lwd="Frequency") } \seealso{ \code{\link{network}} } \keyword{datasets} network/man/network.arrow.Rd0000644000176200001440000000541414723241675015646 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{network.arrow} \alias{network.arrow} \title{Add Arrows or Segments to a Plot} \usage{ network.arrow( x0, y0, x1, y1, length = 0.1, angle = 20, width = 0.01, col = 1, border = 1, lty = 1, offset.head = 0, offset.tail = 0, arrowhead = TRUE, curve = 0, edge.steps = 50, ... ) } \arguments{ \item{x0}{A vector of x coordinates for points of origin} \item{y0}{A vector of y coordinates for points of origin} \item{x1}{A vector of x coordinates for destination points} \item{y1}{A vector of y coordinates for destination points} \item{length}{Arrowhead length, in current plotting units} \item{angle}{Arrowhead angle (in degrees)} \item{width}{Width for arrow body, in current plotting units (can be a vector)} \item{col}{Arrow body color (can be a vector)} \item{border}{Arrow border color (can be a vector)} \item{lty}{Arrow border line type (can be a vector)} \item{offset.head}{Offset for destination point (can be a vector)} \item{offset.tail}{Offset for origin point (can be a vector)} \item{arrowhead}{Boolean; should arrowheads be used? (Can be a vector))} \item{curve}{Degree of edge curvature (if any), in current plotting units (can be a vector)} \item{edge.steps}{For curved edges, the number of steps to use in approximating the curve (can be a vector)} \item{\dots}{Additional arguments to \code{\link{polygon}}} } \value{ None. } \description{ \code{network.arrow} draws a segment or arrow between two pairs of points; unlike \code{\link{arrows}} or \code{\link{segments}}, the new plot element is drawn as a polygon. } \details{ \code{network.arrow} provides a useful extension of \code{\link{segments}} and \code{\link{arrows}} when fine control is needed over the resulting display. (The results also look better.) Note that edge curvature is quadratic, with \code{curve} providing the maximum horizontal deviation of the edge (left-handed). Head/tail offsets are used to adjust the end/start points of an edge, relative to the baseline coordinates; these are useful for functions like \code{\link{plot.network}}, which need to draw edges incident to vertices of varying radii. } \note{ \code{network.arrow} is a direct adaptation of \code{\link[sna]{gplot.arrow}} from the \code{sna} package. } \examples{ #Plot two points plot(1:2,1:2) #Add an edge network.arrow(1,1,2,2,width=0.01,col="red",border="black") } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{plot.network}}, \code{\link{network.loop}}, \code{\link{polygon}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{aplot} \keyword{graphs} network/man/as.network.matrix.Rd0000644000176200001440000000710514723241675016421 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coercion.R \name{as.network.matrix} \alias{as.network.matrix} \alias{as.network.default} \title{Coercion from Matrices to Network Objects} \usage{ \method{as.network}{default}(x, ...) \method{as.network}{matrix}( x, matrix.type = NULL, directed = TRUE, hyper = FALSE, loops = FALSE, multiple = FALSE, bipartite = FALSE, ignore.eval = TRUE, names.eval = NULL, na.rm = FALSE, edge.check = FALSE, ... ) } \arguments{ \item{x}{a matrix containing an adjacency structure} \item{...}{additional arguments} \item{matrix.type}{one of \code{"adjacency"}, \code{"edgelist"}, \code{"incidence"}, or \code{NULL}} \item{directed}{logical; should edges be interpreted as directed?} \item{hyper}{logical; are hyperedges allowed?} \item{loops}{logical; should loops be allowed?} \item{multiple}{logical; are multiplex edges allowed?} \item{bipartite}{count; should the network be interpreted as bipartite? If present (i.e., non-NULL) it is the count of the number of actors in the bipartite network. In this case, the number of nodes is equal to the number of actors plus the number of events (with all actors preceding all events). The edges are then interpreted as nondirected.} \item{ignore.eval}{logical; ignore edge values?} \item{names.eval}{optionally, the name of the attribute in which edge values should be stored} \item{na.rm}{logical; ignore missing entries when constructing the network?} \item{edge.check}{logical; perform consistency checks on new edges?} } \value{ An object of class \code{network} } \description{ \code{as.network.matrix} attempts to coerce its first argument to an object of class \code{network}. } \details{ Depending on \code{matrix.type}, one of three edgeset constructor methods will be employed to read the input matrix (see \code{\link{edgeset.constructors}}). If \code{matrix.type==NULL}, \code{\link{which.matrix.type}} will be used to guess the appropriate matrix type. The coercion methods will recognize and attempt to utilize the \code{sna} extended matrix attributes where feasible. These are as follows: \itemize{ \item\code{"n"}: taken to indicate number of vertices in the network. \item\code{"bipartite"}: taken to indicate the network's \code{bipartite} attribute, where present. \item\code{"vnames"}: taken to contain vertex names, where present. } These attributes are generally used with edgelists, and indeed data in \code{sna} edgelist format should be transparently converted in most cases. Where the extended matrix attributes are in conflict with the actual contents of \code{x}, results are no guaranteed (but the latter will usually override the former). For an edge list, the number of nodes in a network is determined by the number of unique nodes specified. If there are isolate nodes not in the edge list, the "n" attribute needs to be set. See example below. } \examples{ #Draw a random matrix m<-matrix(rbinom(25,1,0.5),5) diag(m)<-0 #Coerce to network form g<-as.network.matrix(m,matrix.type="adjacency") # edge list example. Only 4 nodes in the edge list. m = matrix(c(1,2, 2,3, 3,4), byrow = TRUE, nrow=3) attr(m, 'n') = 7 as.network(m, matrix.type='edgelist') } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{edgeset.constructors}}, \code{\link{network}}, \code{\link{which.matrix.type}} } \author{ Carter T. Butts \email{buttsc@uci.edu} and David Hunter \email{dhunter@stat.psu.edu} } \keyword{classes} \keyword{graphs} network/man/prod.network.Rd0000644000176200001440000000447214723241675015463 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{prod.network} \alias{prod.network} \title{Combine Networks by Edge Value Multiplication} \usage{ \method{prod}{network}(..., attrname = NULL, na.rm = FALSE) } \arguments{ \item{\dots}{one or more \code{network} objects.} \item{attrname}{the name of an edge attribute to use when assessing edge values, if desired.} \item{na.rm}{logical; should edges with missing data be ignored?} } \value{ A \code{\link{network}} object. } \description{ Given a series of networks, \code{prod.network} attempts to form a new network by multiplication of edges. If a non-null \code{attrname} is given, the corresponding edge attribute is used to determine and store edge values. } \details{ The network product method attempts to combine its arguments by edgewise multiplication (\emph{not} composition) of their respective adjacency matrices; thus, this method is only applicable for networks whose adjacency coercion is well-behaved. Multiplication is effectively boolean unless \code{attrname} is specified, in which case this is used to assess edge values -- net values of 0 will result in removal of the underlying edge. Other network attributes in the return value are carried over from the first element in the list, so some persistence is possible (unlike the multiplication operator). Note that it is sometimes possible to \dQuote{multiply} networks and raw adjacency matrices using this routine (if all dimensions are correct), but more exotic combinations may result in regrettably exciting behavior. } \examples{ #Create some networks g<-network.initialize(5) h<-network.initialize(5) i<-network.initialize(5) g[1:3,,names.eval="marsupial",add.edges=TRUE]<-1 h[1:2,,names.eval="marsupial",add.edges=TRUE]<-2 i[1,,names.eval="marsupial",add.edges=TRUE]<-3 #Combine by addition pouch<-prod(g,h,i,attrname="marsupial") pouch[,] #Edge values in the pouch? as.sociomatrix(pouch,attrname="marsupial") #Recover the marsupial } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{network.operators}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{arith} \keyword{graphs} network/man/flo.Rd0000644000176200001440000000173513566403644013606 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/network-package.R \name{flo} \alias{flo} \title{Florentine Wedding Data (Padgett)} \source{ Padgett, John F. (1994). \dQuote{Marriage and Elite Structure in Renaissance Florence, 1282-1500.} Paper delivered to the Social Science History Association. } \usage{ data(flo) } \description{ This is a data set of Padgett (1994), consisting of weddings among leading Florentine families. This data is stored in symmetric adjacency matrix form. } \examples{ data(flo) nflo<-network(flo,directed=FALSE) #Convert to network object form all(nflo[,]==flo) #Trust, but verify #A fancy display: plot(nflo,displaylabels=TRUE,boxed.labels=FALSE,label.cex=0.75) } \references{ Wasserman, S. and Faust, K. (1994) \emph{Social Network Analysis: Methods and Applications}, Cambridge: Cambridge University Press. } \seealso{ \code{\link{network}} } \keyword{datasets} network/man/network.naedgecount.Rd0000644000176200001440000000605014723241675017005 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{missing.edges} \alias{missing.edges} \alias{is.na.network} \alias{network.naedgecount} \title{Identifying and Counting Missing Edges in a Network Object} \usage{ \method{is.na}{network}(x) network.naedgecount(x, ...) } \arguments{ \item{x}{an object of class \code{network}} \item{\dots}{additional arguments, not used} } \value{ \code{is.na(x)} returns a network object, and \code{network.naedgecount(x)} returns the number of missing edges. } \description{ \code{network.naedgecount} returns the number of edges within a \code{network} object which are flagged as missing. The \code{is.na} network method returns a new network containing the missing edges. } \details{ The missingness of an edge is controlled by its \code{na} attribute (which is mandatory for all edges); \code{network.naedgecount} returns the number of edges for which \code{na==TRUE}. The \code{is.na} network method produces a new network object whose edges correspond to the missing (\code{na==TRUE}) edges of the original object, and is thus a covenient method of extracting detailed missingness information on the entire network. The network returned by \code{is.na} is guaranteed to have the same base network attributes (directedness, loopness, hypergraphicity, multiplexity, and bipartite constraint) as the original network object, but no other information is copied; note too that edge IDs are \emph{not} preserved by this process (although adjacency obviously is). Since the resulting object is a \code{\link{network}}, standard coercion, print/summary, and other methods can be applied to it in the usual fashion. It should be borne in mind that \dQuote{missingness} in the sense used here reflects the assertion that an edge's presence or absence is unknown, \emph{not} that said edge is known not to be present. Thus, the \code{na} count for an empty graph is properly 0, since all edges are known to be absent. Edges can be flagged as missing by setting their \code{na} attribute to \code{TRUE} using \code{\link{set.edge.attribute}}, or by appropriate use of the network assignment operators; see below for an example of the latter. } \examples{ #Create an empty network with no missing data g<-network.initialize(5) g[,] #No edges present.... network.naedgecount(g)==0 #Edges not present are not "missing"! #Now, add some missing edges g[1,,add.edges=TRUE]<-NA #Establish that 1's ties are unknown g[,] #Observe the missing elements is.na(g) #Observe in network form network.naedgecount(g)==4 #These elements do count! network.edgecount(is.na(g)) #Same as above } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{network.edgecount}}, \code{\link{get.network.attribute}}, \code{is.adjacent}, \code{\link{is.na}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/network-operators.Rd0000644000176200001440000001247314723241675016534 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{network.operators} \alias{network.operators} \alias{+.network} \alias{\%c\%} \alias{-.network} \alias{*.network} \alias{!.network} \alias{|.network} \alias{&.network} \alias{\%c\%.network} \title{Network Operators} \usage{ \method{+}{network}(e1, e2) \method{-}{network}(e1, e2) \method{*}{network}(e1, e2) \method{!}{network}(e1) \method{|}{network}(e1, e2) \method{&}{network}(e1, e2) \method{\%c\%}{network}(e1, e2) } \arguments{ \item{e1}{an object of class \code{network}.} \item{e2}{another \code{network}.} } \value{ The resulting network. } \description{ These operators allow for algebraic manipulation of relational structures. } \details{ In general, the binary network operators function by producing a new network object whose edge structure is based on that of the input networks. The properties of the new structure depend upon the inputs as follows: \itemize{ \item The size of the new network is equal to the size of the input networks (for all operators save \code{\%c\%}), which must themselves be of equal size. Likewise, the \code{bipartite} attributes of the inputs must match, and this is preserved in the output. \item If either input network allows loops, multiplex edges, or hyperedges, the output acquires this property. (If both input networks do not allow these features, then the features are disallowed in the output network.) \item If either input network is directed, the output is directed; if exactly one input network is directed, the undirected input is treated as if it were a directed network in which all edges are reciprocated. \item Supplemental attributes (including vertex names, but not edgwise missingness) are not transferred to the output. } The unary operator acts per the above, but with a single input. Thus, the output network has the same properties as the input, with the exception of supplemental attributes. The behavior of the composition operator, \code{\%c\%}, is somewhat more complex than the others. In particular, it will return a bipartite network whenever either input network is bipartite \emph{or} the vertex names of the two input networks do not match (or are missing). If both inputs are non-bipartite and have identical vertex names, the return value will have the same structure (but with loops). This behavior corresponds to the interpretation of the composition operator as counting walks on labeled sets of vertices. Hypergraphs are not yet supported by these routines, but ultimately will be (as suggested by the above). The specific operations carried out by these operators are generally self-explanatory in the non-multiplex case, but semantics in the latter circumstance bear elaboration. The following summarizes the behavior of each operator: \describe{ \item{\code{+}}{An \eqn{(i,j)} edge is created in the return graph for every \eqn{(i,j)} edge in each of the input graphs.} \item{\code{-}}{An \eqn{(i,j)} edge is created in the return graph for every \eqn{(i,j)} edge in the first input that is not matched by an \eqn{(i,j)} edge in the second input; if the second input has more \eqn{(i,j)} edges than the first, no \eqn{(i,j)} edges are created in the return graph.} \item{\code{*}}{An \eqn{(i,j)} edge is created for every pairing of \eqn{(i,j)} edges in the respective input graphs.} \item{\code{\%c\%}}{An \eqn{(i,j)} edge is created in the return graph for every edge pair \eqn{(i,k),(k,j)} with the first edge in the first input and the second edge in the second input.} \item{\code{!}}{An \eqn{(i,j)} edge is created in the return graph for every \eqn{(i,j)} in the input not having an edge.} \item{\code{|}}{An \eqn{(i,j)} edge is created in the return graph if either input contains an \eqn{(i,j)} edge.} \item{\code{&}}{An \eqn{(i,j)} edge is created in the return graph if both inputs contain an \eqn{(i,j)} edge.} } Semantics for missing-edge cases follow from the above, under the interpretation that edges with \code{na==TRUE} are viewed as having an unknown state. Thus, for instance, \code{x*y} with \code{x} having 2 \eqn{(i,j)} non-missing and 1 missing edge and \code{y} having 3 respective non-missing and 2 missing edges will yield an output network with 6 non-missing and 9 missing \eqn{(i,j)} edges. } \note{ Currently, there is a naming conflict between the composition operator and the \code{\%c\%} operator in the \code{\link[sna]{sna}} package. This will be resolved in future releases; for the time being, one can determine which version of \code{\%c\%} is in use by varying which package is loaded first. } \examples{ #Create an in-star m<-matrix(0,6,6) m[2:6,1]<-1 g<-network(m) plot(g) #Compose g with its transpose gcgt<-g \%c\% (network(t(m))) plot(gcgt) gcgt #Show the complement of g !g #Perform various arithmatic and logical operations (g+gcgt)[,] == (g|gcgt)[,] #All TRUE (g-gcgt)[,] == (g&(!(gcgt)))[,] (g*gcgt)[,] == (g&gcgt)[,] } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} Wasserman, S. and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: University of Cambridge Press. } \seealso{ \code{\link{network.extraction}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} \keyword{math} network/man/valid.eids.Rd0000644000176200001440000000241614317402074015034 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{valid.eids} \alias{valid.eids} \alias{valid.eids.network} \title{Get the ids of all the edges that are valid in a network} \usage{ valid.eids(x, ...) \method{valid.eids}{network}(x, ...) } \arguments{ \item{x}{a network object, possibly with some deleted edges.} \item{...}{additional arguments to methods.} } \value{ a vector of integer ids corresponding to the non-null edges in x } \description{ Returns a vector of valid edge ids (corresponding to non-NULL edges) for a network that may have some deleted edges. } \details{ The edge ids used in the network package are positional indices on the internal "mel" list. When edges are removed using \code{\link{delete.edges}} \code{NULL} elements are left on the list. The function \code{valid.eids} returns the ids of all the valid (non-null) edge ids for its \code{network} argument. } \note{ If it is known that x has no deleted edges, \code{seq_along(x$mel)} is a faster way to generate the sequence of possible edge ids. } \examples{ net<-network.initialize(100) add.edges(net,1:99,2:100) delete.edges(net,eid=5:95) # get the ids of the non-deleted edges valid.eids(net) } \seealso{ See also \code{\link{delete.edges}} } \author{ skyebend } network/man/permute.vertexIDs.Rd0000644000176200001440000000355214723241675016422 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{permute.vertexIDs} \alias{permute.vertexIDs} \alias{permute.vertexIDs.network} \title{Permute (Relabel) the Vertices Within a Network} \usage{ permute.vertexIDs(x, vids, ...) \method{permute.vertexIDs}{network}(x, vids, ...) } \arguments{ \item{x}{an object of class \code{\link{network}}.} \item{vids}{a vector of vertex IDs, in the order to which they are to be permuted.} \item{...}{additional arguments to methods.} } \value{ Invisibly, a pointer to the permuted network. \code{permute.vertexIDs} modifies its argument in place. } \description{ \code{permute.vertexIDs} permutes the vertices within a given network in the specified fashion. Since this occurs internally (at the level of vertex IDs), it is rarely of interest to end-users. } \details{ \code{permute.vertexIDs} alters the internal ordering of vertices within a \code{\link{network}}. For most practical applications, this should not be necessary -- de facto permutation can be accomplished by altering the appropriate vertex attributes. \code{permute.vertexIDs} is needed for certain other routines (such as \code{\link{delete.vertices}}), where it is used in various arcane and ineffable ways. } \examples{ data(flo) #Load the Florentine Families data nflo<-network(flo) #Create a network object n<-network.size(nflo) #Get the number of vertices permute.vertexIDs(nflo,n:1) #Reverse the vertices all(flo[n:1,n:1]==as.sociomatrix(nflo)) #Should be TRUE } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{network}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} \keyword{manip} network/man/attribute.methods.Rd0000644000176200001440000002251614723241675016473 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{attribute.methods} \alias{attribute.methods} \alias{delete.edge.attribute} \alias{delete.edge.attribute.network} \alias{delete.network.attribute} \alias{delete.network.attribute.network} \alias{delete.vertex.attribute} \alias{delete.vertex.attribute.network} \alias{get.edge.attribute} \alias{get.edge.attribute.network} \alias{get.edge.attribute.list} \alias{get.edge.value} \alias{get.edge.value.network} \alias{get.edge.value.list} \alias{get.network.attribute} \alias{get.network.attribute.network} \alias{get.vertex.attribute} \alias{get.vertex.attribute.network} \alias{list.edge.attributes} \alias{list.edge.attributes.network} \alias{list.network.attributes} \alias{list.network.attributes.network} \alias{list.vertex.attributes} \alias{list.vertex.attributes.network} \alias{network.vertex.names} \alias{network.vertex.names<-} \alias{set.edge.attribute} \alias{set.edge.attribute.network} \alias{set.edge.value} \alias{set.edge.value.network} \alias{set.network.attribute} \alias{set.network.attribute.network} \alias{set.vertex.attribute} \alias{set.vertex.attribute.network} \title{Attribute Interface Methods for the Network Class} \usage{ delete.edge.attribute(x, attrname, ...) \method{delete.edge.attribute}{network}(x, attrname, ...) delete.network.attribute(x, attrname, ...) \method{delete.network.attribute}{network}(x, attrname, ...) delete.vertex.attribute(x, attrname, ...) \method{delete.vertex.attribute}{network}(x, attrname, ...) get.edge.attribute(x, ..., el) \method{get.edge.attribute}{network}( x, attrname, unlist = TRUE, na.omit = FALSE, null.na = FALSE, deleted.edges.omit = FALSE, ..., el ) \method{get.edge.attribute}{list}( x, attrname, unlist = TRUE, na.omit = FALSE, null.na = FALSE, deleted.edges.omit = FALSE, ..., el ) get.edge.value(x, ...) \method{get.edge.value}{network}( x, attrname, unlist = TRUE, na.omit = FALSE, null.na = FALSE, deleted.edges.omit = FALSE, ... ) \method{get.edge.value}{list}( x, attrname, unlist = TRUE, na.omit = FALSE, null.na = FALSE, deleted.edges.omit = FALSE, ... ) get.network.attribute(x, ...) \method{get.network.attribute}{network}(x, attrname, unlist = FALSE, ...) get.vertex.attribute(x, ...) \method{get.vertex.attribute}{network}( x, attrname, na.omit = FALSE, null.na = TRUE, unlist = TRUE, ... ) list.edge.attributes(x, ...) \method{list.edge.attributes}{network}(x, ...) list.network.attributes(x, ...) \method{list.network.attributes}{network}(x, ...) list.vertex.attributes(x, ...) \method{list.vertex.attributes}{network}(x, ...) network.vertex.names(x) network.vertex.names(x) <- value set.edge.attribute(x, attrname, value, e, ...) \method{set.edge.attribute}{network}(x, attrname, value, e = seq_along(x$mel), ...) set.edge.value(x, attrname, value, e, ...) \method{set.edge.value}{network}(x, attrname, value, e = seq_along(x$mel), ...) set.network.attribute(x, attrname, value, ...) \method{set.network.attribute}{network}(x, attrname, value, ...) set.vertex.attribute(x, attrname, value, v = seq_len(network.size(x)), ...) \method{set.vertex.attribute}{network}(x, attrname, value, v = seq_len(network.size(x)), ...) } \arguments{ \item{x}{an object of class \code{network}, or a list of edges (possibly \code{network$mel}) in \code{get.edge.attribute}.} \item{attrname}{the name of the attribute to get or set.} \item{...}{additional arguments} \item{el}{Deprecated; use \code{x} instead.} \item{unlist}{logical; should retrieved attribute values be \code{\link{unlist}}ed prior to being returned?} \item{na.omit}{logical; should retrieved attribute values corresponding to vertices/edges marked as 'missing' be removed?} \item{null.na}{logical; should \code{NULL} values (corresponding to vertices or edges with no values set for the attribute) be replaced with \code{NA}s in output?} \item{deleted.edges.omit}{logical: should the elements corresponding to deleted edges be removed?} \item{value}{values of the attribute to be set; these should be in \code{vector} or \code{list} form for the \code{edge} and \code{vertex} cases, or \code{matrix} form for \code{set.edge.value}.} \item{e}{IDs for the edges whose attributes are to be altered.} \item{v}{IDs for the vertices whose attributes are to be altered.} } \value{ For the \code{list.attributes} methods, a vector containing attribute names. For the \code{get.attribute} methods, a list containing the values of the attribute in question (or simply the value itself, for \code{get.network.attribute}). For the \code{set.attribute} and \code{delete.attribute} methods, a pointer to the updated \code{network} object. } \description{ These methods get, set, list, and delete attributes at the network, edge, and vertex level. } \details{ The \code{list.attributes} functions return the names of all edge, network, or vertex attributes (respectively) in the network. All attributes need not be defined for all elements; the union of all extant attributes for the respective element type is returned. The \code{get.attribute} functions look for an edge, network, or vertex attribute (respectively) with the name \code{attrname}, returning its values. Note that, to retrieve an edge attribute from all edges within a network \code{x}, \code{x$mel} should be used as the first argument to \code{get.edge.attribute}; \code{get.edge.value} is a convenience function which does this automatically. As of v1.7.2, if a \code{network} object is passed to \code{get.edge.attribute} it will automatically call \code{get.edge.value} instead of returning NULL. When the parameters \code{na.omit}, or \code{deleted.edges.omit} are used, the position index of the attribute values returned will not correspond to the vertex/edge id. To preserved backward compatibility, if the edge attribute \code{attrname} does not exist for any edge, \code{get.edge.attribute} will still return \code{NULL} even if \code{null.na=TRUE} \code{network.vertex.names} is a convenience function to extract the \code{"vertex.names"} attribute from all vertices. The \code{set.attribute} functions allow one to set the values of edge, network, or vertex attributes. \code{set.edge.value} is a convenience function which allows edge attributes to be given in adjacency matrix form, and the assignment form of \code{network.vertex.names} is likewise a convenient front-end to \code{set.vertex.attribute} for vertex names. The \code{delete.attribute} functions, by contrast, remove the named attribute from the network, from all edges, or from all vertices (as appropriate). If \code{attrname} is a vector of attribute names, each will be removed in turn. These functions modify their arguments in place, although a pointer to the modified object is also (invisibly) returned. Additional practical example of how to load and attach attributes are on the \code{\link{loading.attributes}} page. Some attribute assignment/extraction can be performed conveniently through the various extraction/replacement operators, although they may be less efficient. See the associated man page for details. } \note{ As of version 1.9 the \code{set.vertex.attribute} function can accept and modify multiple attributes in a single call to improve efficiency. For this case \code{attrname} can be a list or vector of attribute names and \code{value} is a list of values corresponding to the elements of \code{attrname} (can also be a list of lists of values if elements in v should have different values). } \examples{ #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] #List the attributes list.edge.attributes(g) list.network.attributes(g) list.vertex.attributes(g) #Retrieve the attributes get.edge.attribute(g$mel,"myeval") #Note the first argument! get.edge.value(g,"myeval") #Another way to do this get.edge.attribute(g$mel,"myeval2") get.network.attribute(g,"mygval") get.vertex.attribute(g,"myvval") network.vertex.names(g) #Purge the attributes delete.edge.attribute(g,"myeval") delete.edge.attribute(g,"myeval2") delete.network.attribute(g,"mygval") delete.vertex.attribute(g,"myvval") #Verify that the attributes are gone list.edge.attributes(g) list.network.attributes(g) list.vertex.attributes(g) #Note that we can do similar things using operators g \%n\% "mygval" <- "boo" #Set attributes, as above g \%v\% "myvval" <- letters[1:3] g \%e\% "myeval" <- mm g[,,names.eval="myeval"] <- mm #Another way to do this g \%n\% "mygval" #Retrieve the attributes g \%v\% "myvval" g \%e\% "mevval" as.sociomatrix(g,"myeval") # Or like this } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{loading.attributes}},\code{\link{network}}, \code{\link{as.network.matrix}}, \code{\link{as.sociomatrix}}, \code{\link{as.matrix.network}}, \code{\link{network.extraction}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/edgeset.constructors.Rd0000644000176200001440000001015614723241675017212 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/constructors.R \name{edgeset.constructors} \alias{edgeset.constructors} \alias{network.bipartite} \alias{network.adjacency} \alias{network.edgelist} \alias{network.incidence} \title{Edgeset Constructors for Network Objects} \usage{ network.bipartite(x, g, ignore.eval = TRUE, names.eval = NULL, ...) network.adjacency(x, g, ignore.eval = TRUE, names.eval = NULL, ...) network.edgelist(x, g, ignore.eval = TRUE, names.eval = NULL, ...) network.incidence(x, g, ignore.eval = TRUE, names.eval = NULL, ...) } \arguments{ \item{x}{a matrix containing edge information} \item{g}{an object of class \code{network}} \item{ignore.eval}{logical; ignore edge value information in x?} \item{names.eval}{a name for the edge attribute under which to store edge values, if any} \item{\dots}{possible additional arguments (such as \code{edge.check})} } \value{ Invisibly, an object of class \code{network}; these functions modify their argument in place. } \description{ These functions convert relational data in matrix form to network edge sets. } \details{ Each of the above functions takes a \code{network} and a matrix as input, and modifies the supplied \code{network} object by adding the appropriate edges. \code{network.adjacency} takes \code{x} to be an adjacency matrix; \code{network.edgelist} takes \code{x} to be an edgelist matrix; and \code{network.incidence} takes \code{x} to be an incidence matrix. \code{network.bipartite} takes \code{x} to be a two-mode adjacency matrix where rows and columns reflect each respective mode (conventionally, actors and events); If \code{ignore.eval==FALSE}, (non-zero) edge values are stored as edgewise attributes with name \code{names.eval}. The \code{edge.check} argument can be added via \code{\dots} and will be passed to \code{\link{add.edges}}. Edgelist matrices to be used with \code{network.edgelist} should have one row per edge, with the first two columns indicating the sender and receiver of each edge (respectively). Edge values may be provided in additional columns. The edge attributes will be created with names corresponding to the column names unless alternate names are provided via \code{names.eval}. The vertices specified in the first two columns, which can be characters, are added to the network in default sort order. The edges are added in the order specified by the edgelist matrix. Incidence matrices should contain one row per vertex, with one column per edge. A non-zero entry in the matrix means that the edge with the id corresponding to the column index will have an incident vertex with an id corresponding to the row index. In the directed case, negative cell values are taken to indicate tail vertices, while positive values indicate head vertices. Results similar to \code{network.adjacency} can also be obtained by means of extraction/replacement operators. See the associated man page for details. } \examples{ #Create an arbitrary adjacency matrix m<-matrix(rbinom(25,1,0.5),5,5) diag(m)<-0 g<-network.initialize(5) #Initialize the network network.adjacency(m,g) #Import the edge data #Do the same thing, using replacement operators g<-network.initialize(5) g[,]<-m # load edges from a data.frame via network.edgelist edata <-data.frame( tails=c(1,2,3), heads=c(2,3,1), love=c('yes','no','maybe'), hate=c(3,-5,2), stringsAsFactors=FALSE ) g<-network.edgelist(edata,network.initialize(4),ignore.eval=FALSE) as.sociomatrix(g,attrname='hate') g\%e\%'love' # load edges from an incidence matrix inci<-matrix(c(1,1,0,0, 0,1,1,0, 1,0,1,0),ncol=3,byrow=FALSE) inci g<-network.incidence(inci,network.initialize(4,directed=FALSE)) as.matrix(g) } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{loading.attributes}}, \code{\link{network}}, \code{\link{network.initialize}}, \code{\link{add.edges}}, \code{\link{network.extraction}} } \author{ Carter T. Butts \email{buttsc@uci.edu} and David Hunter \email{dhunter@stat.psu.edu} } \keyword{classes} \keyword{graphs} network/man/network.vertex.Rd0000644000176200001440000000345614723241675016035 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{network.vertex} \alias{network.vertex} \title{Add Vertices to a Plot} \usage{ network.vertex( x, y, radius = 1, sides = 4, border = 1, col = 2, lty = NULL, rot = 0, lwd = 1, ... ) } \arguments{ \item{x}{a vector of x coordinates.} \item{y}{a vector of y coordinates.} \item{radius}{a vector of vertex radii.} \item{sides}{a vector containing the number of sides to draw for each vertex.} \item{border}{a vector of vertex border colors.} \item{col}{a vector of vertex interior colors.} \item{lty}{a vector of vertex border line types.} \item{rot}{a vector of vertex rotation angles (in degrees).} \item{lwd}{a vector of vertex border line widths.} \item{\dots}{Additional arguments to \code{\link{polygon}}} } \value{ None } \description{ \code{network.vertex} adds one or more vertices (drawn using \code{\link{polygon}}) to a plot. } \details{ \code{network.vertex} draws regular polygons of specified radius and number of sides, at the given coordinates. This is useful for routines such as \code{\link{plot.network}}, which use such shapes to depict vertices. } \note{ \code{network.vertex} is a direct adaptation of \code{\link[sna]{gplot.vertex}} from the \code{sna} package. } \examples{ #Open a plot window, and place some vertices plot(0,0,type="n",xlim=c(-1.5,1.5),ylim=c(-1.5,1.5),asp=1) network.vertex(cos((1:10)/10*2*pi),sin((1:10)/10*2*pi),col=1:10, sides=3:12,radius=0.1) } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{plot.network}}, \code{\link{polygon}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{aplot} \keyword{graphs} network/man/network.initialize.Rd0000644000176200001440000000324214723241675016652 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/constructors.R \name{network.initialize} \alias{network.initialize} \title{Initialize a Network Class Object} \usage{ network.initialize( n, directed = TRUE, hyper = FALSE, loops = FALSE, multiple = FALSE, bipartite = FALSE ) } \arguments{ \item{n}{the number of vertices to initialize} \item{directed}{logical; should edges be interpreted as directed?} \item{hyper}{logical; are hyperedges allowed?} \item{loops}{logical; should loops be allowed?} \item{multiple}{logical; are multiplex edges allowed?} \item{bipartite}{count; should the network be interpreted as bipartite? If present (i.e., non-NULL) it is the count of the number of actors in the first mode of the bipartite network. In this case, the overall number of vertices is equal to the number of 'actors' (first mode) plus the number of `events' (second mode), with the vertex.ids of all actors preceeding all events. The edges are then interpreted as nondirected.} } \value{ An object of class \code{network} } \description{ Create and initialize a \code{network} object with \code{n} vertices. } \details{ Generally, \code{network.initialize} is called by other constructor functions as part of the process of creating a network. } \examples{ g<-network.initialize(5) #Create an empty graph on 5 vertices } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{network}}, \code{\link{as.network.matrix}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/network-internal.Rd0000644000176200001440000000127414723241675016327 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.R, R/operators.R \name{network-internal} \alias{network-internal} \alias{is.discrete.numeric} \alias{is.discrete.character} \alias{is.discrete} \alias{networkOperatorSetup} \title{Internal Network Package Functions} \usage{ is.discrete.numeric(x) is.discrete.character(x) is.discrete(x) networkOperatorSetup(x, y = NULL) } \arguments{ \item{x}{an object to be designated either discrete or continuous, or a network.} \item{y}{a network or something coercible to one.} } \description{ Internal network functions. } \details{ Most of these are not to be called by the user. } \seealso{ network } \keyword{internal} network/man/plot.network.Rd0000644000176200001440000002374714723241675015503 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{plot.network.default} \alias{plot.network.default} \alias{plot.network} \title{Two-Dimensional Visualization for Network Objects} \usage{ \method{plot}{network}(x, ...) \method{plot.network}{default}(x, attrname = NULL, label = network.vertex.names(x), coord = NULL, jitter = TRUE, thresh = 0, usearrows = TRUE, mode = "fruchtermanreingold", displayisolates = TRUE, interactive = FALSE, xlab = NULL, ylab = NULL, xlim = NULL, ylim = NULL, pad = 0.2, label.pad = 0.5, displaylabels = !missing(label), boxed.labels = FALSE, label.pos = 0, label.bg = "white", vertex.sides = 50, vertex.rot = 0, vertex.lwd=1, arrowhead.cex = 1, label.cex = 1, loop.cex = 1, vertex.cex = 1, edge.col = 1, label.col = 1, vertex.col = 2, label.border = 1, vertex.border = 1, edge.lty = 1, label.lty = NULL, vertex.lty = 1, edge.lwd = 0, edge.label = NULL, edge.label.cex = 1, edge.label.col = 1, label.lwd = par("lwd"), edge.len = 0.5, edge.curve = 0.1, edge.steps = 50, loop.steps = 20, object.scale = 0.01, uselen = FALSE, usecurve = FALSE, suppress.axes = TRUE, vertices.last = TRUE, new = TRUE, layout.par = NULL, \dots) } \arguments{ \item{x}{an object of class \code{network}.} \item{\dots}{additional arguments to \code{\link{plot}}.} \item{attrname}{an optional edge attribute, to be used to set edge values.} \item{label}{a vector of vertex labels, if desired; defaults to the vertex labels returned by \code{\link{network.vertex.names}}. If \code{label} has one element and it matches with a vertex attribute name, the value of the attribute will be used. Note that labels may be set but hidden by the \code{displaylabels} argument.} \item{coord}{user-specified vertex coordinates, in an network.size(x)x2 matrix. Where this is specified, it will override the \code{mode} setting.} \item{jitter}{boolean; should the output be jittered?} \item{thresh}{real number indicating the lower threshold for tie values. Only ties of value >\code{thresh} are displayed. By default, \code{thresh}=0.} \item{usearrows}{boolean; should arrows (rather than line segments) be used to indicate edges?} \item{mode}{the vertex placement algorithm; this must correspond to a \code{\link{network.layout}} function.} \item{displayisolates}{boolean; should isolates be displayed?} \item{interactive}{boolean; should interactive adjustment of vertex placement be attempted?} \item{xlab}{x axis label.} \item{ylab}{y axis label.} \item{xlim}{the x limits (min, max) of the plot.} \item{ylim}{the y limits of the plot.} \item{pad}{amount to pad the plotting range; useful if labels are being clipped.} \item{label.pad}{amount to pad label boxes (if \code{boxed.labels==TRUE}), in character size units.} \item{displaylabels}{boolean; should vertex labels be displayed?} \item{boxed.labels}{boolean; place vertex labels within boxes?} \item{label.pos}{position at which labels should be placed, relative to vertices. \code{0} results in labels which are placed away from the center of the plotting region; \code{1}, \code{2}, \code{3}, and \code{4} result in labels being placed below, to the left of, above, and to the right of vertices (respectively); and \code{label.pos>=5} results in labels which are plotted with no offset (i.e., at the vertex positions).} \item{label.bg}{background color for label boxes (if \code{boxed.labels==TRUE}); may be a vector, if boxes are to be of different colors.} \item{vertex.sides}{number of polygon sides for vertices; may be given as a vector or a vertex attribute name, if vertices are to be of different types. As of v1.12, radius of polygons are scaled so that all shapes have equal area} \item{vertex.rot}{angle of rotation for vertices (in degrees); may be given as a vector or a vertex attribute name, if vertices are to be rotated differently.} \item{vertex.lwd}{line width of vertex borders; may be given as a vector or a vertex attribute name, if vertex borders are to have different line widths.} \item{arrowhead.cex}{expansion factor for edge arrowheads.} \item{label.cex}{character expansion factor for label text.} \item{loop.cex}{expansion factor for loops; may be given as a vector or a vertex attribute name, if loops are to be of different sizes.} \item{vertex.cex}{expansion factor for vertices; may be given as a vector or a vertex attribute name, if vertices are to be of different sizes.} \item{edge.col}{color for edges; may be given as a vector, adjacency matrix, or edge attribute name, if edges are to be of different colors.} \item{label.col}{color for vertex labels; may be given as a vector or a vertex attribute name, if labels are to be of different colors.} \item{vertex.col}{color for vertices; may be given as a vector or a vertex attribute name, if vertices are to be of different colors.} \item{label.border}{label border colors (if \code{boxed.labels==TRUE}); may be given as a vector, if label boxes are to have different colors.} \item{vertex.border}{border color for vertices; may be given as a vector or a vertex attribute name, if vertex borders are to be of different colors.} \item{edge.lty}{line type for edge borders; may be given as a vector, adjacency matrix, or edge attribute name, if edge borders are to have different line types.} \item{label.lty}{line type for label boxes (if \code{boxed.labels==TRUE}); may be given as a vector, if label boxes are to have different line types.} \item{vertex.lty}{line type for vertex borders; may be given as a vector or a vertex attribute name, if vertex borders are to have different line types.} \item{edge.lwd}{line width scale for edges; if set greater than 0, edge widths are scaled by \code{edge.lwd*dat}. May be given as a vector, adjacency matrix, or edge attribute name, if edges are to have different line widths.} \item{edge.label}{if non-\code{NULL}, labels for edges will be drawn. May be given as a vector, adjacency matrix, or edge attribute name, if edges are to have different labels. A single value of \code{TRUE} will use edge ids as labels. NOTE: currently doesn't work for curved edges.} \item{edge.label.cex}{character expansion factor for edge label text; may be given as a vector or a edge attribute name, if edge labels are to have different sizes.} \item{edge.label.col}{color for edge labels; may be given as a vector or a edge attribute name, if labels are to be of different colors.} \item{label.lwd}{line width for label boxes (if \code{boxed.labels==TRUE}); may be given as a vector, if label boxes are to have different line widths.} \item{edge.len}{if \code{uselen==TRUE}, curved edge lengths are scaled by \code{edge.len}.} \item{edge.curve}{if \code{usecurve==TRUE}, the extent of edge curvature is controlled by \code{edge.curv}. May be given as a fixed value, vector, adjacency matrix, or edge attribute name, if edges are to have different levels of curvature.} \item{edge.steps}{for curved edges (excluding loops), the number of line segments to use for the curve approximation.} \item{loop.steps}{for loops, the number of line segments to use for the curve approximation.} \item{object.scale}{base length for plotting objects, as a fraction of the linear scale of the plotting region. Defaults to 0.01.} \item{uselen}{boolean; should we use \code{edge.len} to rescale edge lengths?} \item{usecurve}{boolean; should we use \code{edge.curve}?} \item{suppress.axes}{boolean; suppress plotting of axes?} \item{vertices.last}{boolean; plot vertices after plotting edges?} \item{new}{boolean; create a new plot? If \code{new==FALSE}, vertices and edges will be added to the existing plot.} \item{layout.par}{parameters to the \code{\link{network.layout}} function specified in \code{mode}.} } \value{ A two-column matrix containing the vertex positions as x,y coordinates } \description{ \code{plot.network} produces a simple two-dimensional plot of network \code{x}, using optional attribute \code{attrname} to set edge values. A variety of options are available to control vertex placement, display details, color, etc. } \details{ \code{plot.network} is the standard visualization tool for the \code{network} class. By means of clever selection of display parameters, a fair amount of display flexibility can be obtained. Vertex layout -- if not specified directly using \code{coord} -- is determined via one of the various available algorithms. These should be specified via the \code{mode} argument; see \code{\link{network.layout}} for a full list. User-supplied layout functions are also possible -- see the aforementioned man page for details. Note that where \code{is.hyper(x)==TRUE}, the network is converted to bipartite adjacency form prior to computing coordinates. If \code{interactive==TRUE}, then the user may modify the initial network layout by selecting an individual vertex and then clicking on the location to which this vertex is to be moved; this process may be repeated until the layout is satisfactory. } \note{ \code{plot.network} is adapted (with minor modifications) from the \code{\link[sna]{gplot}} function of the \code{sna} library (authors: Carter T. Butts and Alex Montgomery); eventually, these two packages will be integrated. } \examples{ #Construct a sparse graph m<-matrix(rbinom(100,1,1.5/9),10) diag(m)<-0 g<-network(m) #Plot the graph plot(g) #Load Padgett's marriage data data(flo) nflo<-network(flo) #Display the network, indicating degree and flagging the Medicis plot(nflo, vertex.cex=apply(flo,2,sum)+1, usearrows=FALSE, vertex.sides=3+apply(flo,2,sum), vertex.col=2+(network.vertex.names(nflo)=="Medici")) } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. } \seealso{ \code{\link{network}}, \code{\link{network.arrow}}, \code{\link{network.loop}}, \code{\link{network.vertex}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} \keyword{hplot} network/man/deletion.methods.Rd0000644000176200001440000000514214723241675016267 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{deletion.methods} \alias{deletion.methods} \alias{delete.edges} \alias{delete.edges.network} \alias{delete.vertices} \alias{delete.vertices.network} \title{Remove Elements from a Network Object} \usage{ delete.edges(x, eid, ...) \method{delete.edges}{network}(x, eid, ...) delete.vertices(x, vid, ...) \method{delete.vertices}{network}(x, vid, ...) } \arguments{ \item{x}{an object of class \code{network}.} \item{eid}{a vector of edge IDs.} \item{...}{additional arguments to methods.} \item{vid}{a vector of vertex IDs.} } \value{ Invisibly, a pointer to the updated network; these functions modify their arguments in place. } \description{ \code{delete.edges} removes one or more edges (specified by their internal ID numbers) from a network; \code{delete.vertices} performs the same task for vertices (removing all associated edges in the process). } \details{ Note that an edge's ID number corresponds to its order within \code{x$mel}. To determine edge IDs, see \code{\link{get.edgeIDs}}. Likewise, vertex ID numbers reflect the order with which vertices are listed internally (e.g., the order of \code{x$oel} and \code{x$iel}, or that used by \code{as.matrix.network.adjacency}). When vertices are removed from a network, all edges having those vertices as endpoints are removed as well. When edges are removed, the remaining edge ids are NOT permuted and \code{NULL} elements will be left on the list of edges, which may complicate some functions that require eids (such as \code{\link{set.edge.attribute}}). The function \code{\link{valid.eids}} provides a means to determine the set of valid (non-NULL) edge ids. Edges can also be added/removed via the extraction/replacement operators. See the associated man page for details. } \examples{ #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) as.matrix.network(g) delete.edges(g,2) #Remove an edge as.matrix.network(g) delete.vertices(g,2) #Remove a vertex as.matrix.network(g) #Can also remove edges using extraction/replacement operators g<-network(m) g[1,2]<-0 #Remove an edge g[,] g[,]<-0 #Remove all edges g[,] } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{get.edgeIDs}}, \code{\link{network.extraction}}, \code{\link{valid.eids}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/add.edges.Rd0000644000176200001440000000716114723241675014643 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{add.edges} \alias{add.edges} \alias{add.edge} \alias{add.edges.network} \alias{add.edge.network} \title{Add Edges to a Network Object} \usage{ add.edge( x, tail, head, names.eval = NULL, vals.eval = NULL, edge.check = FALSE, ... ) add.edges(x, tail, head, names.eval = NULL, vals.eval = NULL, ...) } \arguments{ \item{x}{an object of class \code{network}} \item{tail}{for \code{add.edge}, a vector of vertex IDs reflecting the tail set for the edge to be added; for \code{add.edges}, a list of such vectors} \item{head}{for \code{add.edge}, a vector of vertex IDs reflecting the head set for the edge to be added; for \code{add.edges}, a list of such vectors} \item{names.eval}{for \code{add.edge}, an optional list of names for edge attributes; for \code{add.edges}, a list of length equal to the number of edges, with each element containing a list of names for the attributes of the corresponding edge} \item{vals.eval}{for \code{add.edge}, an optional list of edge attribute values (matching \code{names.eval}); for \code{add.edges}, a list of such lists} \item{edge.check}{logical; should we perform (computationally expensive) tests to check for the legality of submitted edges?} \item{...}{additional arguments} } \value{ Invisibly, \code{add.edge} and \code{add.edges} return pointers to their modified arguments; both functions modify their arguments in place.. } \description{ Add one or more edges to an existing network object. } \details{ The edge checking procedure is very slow, but should always be employed when debugging; without it, one cannot guarantee that the network state is consistent with network level variables (see \code{\link{network.indicators}}). For example, by default it is possible to add multiple edges to a pair of vertices. Edges can also be added/removed via the extraction/replacement operators. See the associated man page for details. } \note{ \code{add.edges} and \code{add.edge} were converted to an S3 generic funtions in version 1.9, so they actually call \code{add.edges.network} and \code{add.edge.network} by default, and may call other versions depending on context (i.e. when called with a \code{networkDynamic} object). } \examples{ #Initialize a small, empty network g<-network.initialize(3) #Add an edge add.edge(g,1,2) g #Can also add edges using the extraction/replacement operators #note that replacement operators are much slower than add.edges() g[,3]<-1 g[,] #Add multiple edges with attributes to a network # pretend we just loaded in this data.frame from a file # Note: network.edgelist() may be simpler for this case elData<-data.frame( from_id=c("1","2","3","1","3","1","2"), to_id=c("1", "1", "1", "2", "2", "3", "3"), myEdgeWeight=c(1, 2, 1, 2, 5, 3, 9.5), someLetters=c("B", "W", "L", "Z", "P", "Q", "E"), edgeCols=c("red","green","blue","orange","pink","brown","gray"), stringsAsFactors=FALSE ) valueNet<-network.initialize(3,loops=TRUE) add.edges(valueNet,elData[,1],elData[,2], names.eval=rep(list(list("myEdgeWeight","someLetters","edgeCols")),nrow(elData)), vals.eval=lapply(1:nrow(elData),function(r){as.list(elData[r,3:5])})) list.edge.attributes(valueNet) } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{network}}, \code{\link{add.vertices}}, \code{\link{network.extraction}}, \code{\link{delete.edges}}, \code{\link{network.edgelist}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/network.Rd0000644000176200001440000002452114723241675014515 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R, R/coercion.R, R/constructors.R, % R/dataframe.R, R/printsum.R \name{network} \alias{network} \alias{is.network} \alias{as.network.network} \alias{print.summary.network} \alias{$<-.network} \alias{<-.network} \alias{as.network} \alias{network.copy} \alias{as.network.data.frame} \alias{print.network} \alias{summary.network} \title{Network Objects} \usage{ is.network(x) as.network(x, ...) network( x, vertex.attr = NULL, vertex.attrnames = NULL, directed = TRUE, hyper = FALSE, loops = FALSE, multiple = FALSE, bipartite = FALSE, ... ) network.copy(x) \method{as.network}{data.frame}( x, directed = TRUE, vertices = NULL, hyper = FALSE, loops = FALSE, multiple = FALSE, bipartite = FALSE, bipartite_col = "is_actor", ... ) \method{print}{network}( x, matrix.type = which.matrix.type(x), mixingmatrices = FALSE, na.omit = TRUE, print.adj = FALSE, ... ) \method{summary}{network}(object, na.omit = TRUE, mixingmatrices = FALSE, print.adj = TRUE, ...) } \arguments{ \item{x}{for \code{network}, a matrix giving the network structure in adjacency, incidence, or edgelist form; otherwise, an object of class \code{network}.} \item{...}{additional arguments.} \item{vertex.attr}{optionally, a list containing vertex attributes.} \item{vertex.attrnames}{optionally, a list containing vertex attribute names.} \item{directed}{logical; should edges be interpreted as directed?} \item{hyper}{logical; are hyperedges allowed?} \item{loops}{logical; should loops be allowed?} \item{multiple}{logical; are multiplex edges allowed?} \item{bipartite}{count; should the network be interpreted as bipartite? If present (i.e., non-NULL, non-FALSE) it is the count of the number of actors in the bipartite network. In this case, the number of nodes is equal to the number of actors plus the number of events (with all actors preceeding all events). The edges are then interpreted as nondirected. Values of bipartite==0 are permited, indicating a bipartite network with zero-sized first partition.} \item{vertices}{If \code{x} is a \code{data.frame}, \code{vertices} is an optional \code{data.frame} containing the vertex attributes. The first column is assigned to the \code{"vertex.names"} and additional columns are used to set vertex attributes using their column names. If \code{bipartite} is \code{TRUE}, a \code{logical} column named \code{"is_actor"} (or the name of a column specified using the \code{bipartite_col} parameter) can be provided indicating which vertices should be considered as actors. If not provided, vertices referenced in the first column of \code{x} are assumed to be the network's actors. If your network has isolates (i.e. there are vertices referenced in \code{vertices} that are not referenced in \code{x}), the \code{"is_actor"} column is required.} \item{bipartite_col}{\code{character(1L)}, default: \code{"is_actor"}. The name of the \code{logical} column indicating which vertices should be considered as actors in bipartite networks.} \item{matrix.type}{one of \code{"adjacency"}, \code{"edgelist"}, \code{"incidence"}. See \code{\link{edgeset.constructors}} for details and optional additional arguments} \item{mixingmatrices}{logical; print the mixing matrices for the discrete attributes?} \item{na.omit}{logical; omit summarization of missing attributes in \code{network}?} \item{print.adj}{logical; print the network adjacency structure?} \item{object}{an object of class \code{network}.} } \value{ \code{network}, \code{as.network}, and \code{print.network} all return a network class object; \code{is.network} returns TRUE or FALSE. } \description{ Construct, coerce to, test for and print \code{network} objects. } \details{ \code{network} constructs a \code{network} class object from a matrix representation. If the \code{matrix.type} parameter is not specified, it will make a guess as to the intended \code{edgeset.constructors} function to call based on the format of these input matrices. If the class of \code{x} is not a matrix, network construction can be dispatched to other methods. For example, If the \code{ergm} package is loaded, \code{network()} can function as a shorthand for \code{as.network.numeric} with \code{x} as an integer specifying the number of nodes to be created in the random graph. If the \code{ergm} package is loaded, \code{network} can function as a shorthand for \code{as.network.numeric} if \code{x} is an integer specifying the number of nodes. See the help page for \code{as.network.numeric} in \code{ergm} package for details. \code{network.copy} creates a new \code{network} object which duplicates its supplied argument. (Direct assignment with \code{<-} should be used rather than \code{network.copy} in most cases.) \code{as.network} tries to coerce its argument to a network, using the \code{as.network.matrix} functions if \code{x} is a matrix. (If the argument is already a network object, it is returned as-is and all other arguments are ignored.) \code{is.network} tests whether its argument is a network (in the sense that it has class \code{network}). \code{print.network} prints a network object in one of several possible formats. It also prints the list of global attributes of the network. \code{summary.network} provides similar information. } \note{ Between versions 0.5 and 1.2, direct assignment of a network object created a pointer to the original object, rather than a copy. As of version 1.2, direct assignment behaves in the same manner as \code{network.copy}. Direct use of the latter is thus superfluous in most situations, and is discouraged. Many of the network package functions modify their network object arguments in-place. For example, \code{set.network.attribute(net,"myVal",5)} will have the same effect as \code{net<-set.network.attribute(net,"myVal",5)}. Unfortunately, the current implementation of in-place assignment breaks when the network argument is an element of a list or a named part of another object. So \code{set.network.attribute(myListOfNetworks[[1]],"myVal",5)} will silently fail to modify its network argument, likely leading to incorrect output. } \examples{ m <- matrix(rbinom(25,1,.4),5,5) diag(m) <- 0 g <- network(m, directed=FALSE) summary(g) h <- network.copy(g) #Note: same as h<-g summary(h) # networks from data frames =========================================================== #* simple networks ==================================================================== simple_edge_df <- data.frame( from = c("b", "c", "c", "d", "a"), to = c("a", "b", "a", "a", "b"), weight = c(1, 1, 2, 2, 3), stringsAsFactors = FALSE ) simple_edge_df as.network(simple_edge_df) # simple networks with vertices ======================================================= simple_vertex_df <- data.frame( name = letters[1:5], residence = c("urban", "rural", "suburban", "suburban", "rural"), stringsAsFactors = FALSE ) simple_vertex_df as.network(simple_edge_df, vertices = simple_vertex_df) as.network(simple_edge_df, directed = FALSE, vertices = simple_vertex_df, multiple = TRUE ) #* splitting multiplex data frames into multiple networks ============================= simple_edge_df$relationship <- c(rep("friends", 3), rep("colleagues", 2)) simple_edge_df lapply(split(simple_edge_df, f = simple_edge_df$relationship), as.network, vertices = simple_vertex_df ) #* bipartite networks without isolates ================================================ bip_edge_df <- data.frame( actor = c("a", "a", "b", "b", "c", "d", "d", "e"), event = c("e1", "e2", "e1", "e3", "e3", "e2", "e3", "e1"), actor_enjoyed_event = rep(c(TRUE, FALSE), 4), stringsAsFactors = FALSE ) bip_edge_df bip_node_df <- data.frame( node_id = c("a", "e1", "b", "e2", "c", "e3", "d", "e"), node_type = c( "person", "event", "person", "event", "person", "event", "person", "person" ), color = c( "red", "blue", "red", "blue", "red", "blue", "red", "red" ), stringsAsFactors = FALSE ) bip_node_df as.network(bip_edge_df, directed = FALSE, bipartite = TRUE) as.network(bip_edge_df, directed = FALSE, vertices = bip_node_df, bipartite = TRUE) #* bipartite networks with isolates =================================================== bip_nodes_with_isolates <- rbind( bip_node_df, data.frame( node_id = c("f", "e4"), node_type = c("person", "event"), color = c("red", "blue"), stringsAsFactors = FALSE ) ) # indicate which vertices are actors via a column named `"is_actor"` bip_nodes_with_isolates$is_actor <- bip_nodes_with_isolates$node_type == "person" bip_nodes_with_isolates as.network(bip_edge_df, directed = FALSE, vertices = bip_nodes_with_isolates, bipartite = TRUE ) #* hyper networks from data frames ==================================================== hyper_edge_df <- data.frame( from = c("a/b", "b/c", "c/d/e", "d/e"), to = c("c/d", "a/b/e/d", "a/b", "d/e"), time = 1:4, stringsAsFactors = FALSE ) tibble::as_tibble(hyper_edge_df) # split "from" and "to" at `"/"`, coercing them to list columns hyper_edge_df$from <- strsplit(hyper_edge_df$from, split = "/") hyper_edge_df$to <- strsplit(hyper_edge_df$to, split = "/") tibble::as_tibble(hyper_edge_df) as.network(hyper_edge_df, directed = FALSE, vertices = simple_vertex_df, hyper = TRUE, loops = TRUE ) # convert network objects back to data frames ========================================= simple_g <- as.network(simple_edge_df, vertices = simple_vertex_df) as.data.frame(simple_g) as.data.frame(simple_g, unit = "vertices") bip_g <- as.network(bip_edge_df, directed = FALSE, vertices = bip_node_df, bipartite = TRUE ) as.data.frame(bip_g) as.data.frame(bip_g, unit = "vertices") hyper_g <- as.network(hyper_edge_df, directed = FALSE, vertices = simple_vertex_df, hyper = TRUE, loops = TRUE ) as.data.frame(hyper_g) as.data.frame(hyper_g, unit = "vertices") } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{network.initialize}}, \code{\link{attribute.methods}}, \code{\link{as.network.matrix}}, \code{\link{as.matrix.network}}, \code{\link{deletion.methods}}, \code{\link{edgeset.constructors}}, \code{\link{network.indicators}}, \code{\link{plot.network}} } \author{ Carter T. Butts \email{buttsc@uci.edu} and David Hunter \email{dhunter@stat.psu.edu} } \keyword{classes} \keyword{graphs} network/man/is.adjacent.Rd0000644000176200001440000000575714723241675015221 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{is.adjacent} \alias{is.adjacent} \title{Determine Whether Two Vertices Are Adjacent} \usage{ is.adjacent(x, vi, vj, na.omit = FALSE) } \arguments{ \item{x}{an object of class \code{network}} \item{vi}{a vertex ID} \item{vj}{a second vertex ID} \item{na.omit}{logical; should missing edges be ignored when assessing adjacency?} } \value{ A logical, giving the status of the (i,j) edge } \description{ \code{is.adjacent} returns \code{TRUE} iff \code{vi} is adjacent to \code{vj} in \code{x}. Missing edges may be omitted or not, as per \code{na.omit}. } \details{ Vertex \eqn{v} is said to be adjacent to vertex \eqn{v'} within directed network \eqn{G} iff there exists some edge whose tail set contains \eqn{v} and whose head set contains \eqn{v'}. In the undirected case, head and tail sets are exchangeable, and thus \eqn{v} is adjacent to \eqn{v'} if there exists an edge such that \eqn{v} belongs to one endpoint set and \eqn{v'} belongs to the other. (In dyadic graphs, these sets are of cardinality 1, but this may not be the case where hyperedges are admitted.) If an edge which would make \eqn{v} and \eqn{v'} adjacent is marked as missing (via its \code{na} attribute), then the behavior of \code{is.adjacent} depends upon \code{na.omit}. If \code{na.omit==FALSE} (the default), then the return value is considered to be \code{NA} unless there is also \emph{another} edge from \eqn{v} to \eqn{v'} which is \emph{not} missing (in which case the two are clearly adjacent). If \code{na.omit==TRUE}, on the other hand the missing edge is simply disregarded in assessing adjacency (i.e., it effectively treated as not present). It is important not to confuse \dQuote{not present} with \dQuote{missing} in this context: the former indicates that the edge in question does not belong to the network, while the latter indicates that the state of the corresponding edge is regarded as unknown. By default, all edge states are assumed \dQuote{known} unless otherwise indicated (by setting the edge's \code{na} attribute to \code{TRUE}; see \code{\link{attribute.methods}}). Adjacency can also be determined via the extraction/replacement operators. See the associated man page for details. } \note{ Prior to version 1.4, \code{na.omit} was set to \code{TRUE} by default. } \examples{ #Create a very simple graph g<-network.initialize(3) add.edge(g,1,2) is.adjacent(g,1,2) #TRUE is.adjacent(g,2,1) #FALSE g[1,2]==1 #TRUE g[2,1]==1 #FALSE } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} Wasserman, S. and Faust, K. 1994. \emph{Social Network Analysis: Methods and Applications}. Cambridge: Cambridge University Press. } \seealso{ \code{\link{get.neighborhood}}, \code{\link{network.extraction}}, \code{\link{attribute.methods}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} network/man/which.matrix.type.Rd0000644000176200001440000000303214723241675016403 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.R \name{which.matrix.type} \alias{which.matrix.type} \title{Heuristic Determination of Matrix Types for Network Storage} \usage{ which.matrix.type(x) } \arguments{ \item{x}{a matrix, or an object of class \code{network}} } \value{ One of \code{"adjacency"}, \code{"incidence"}, or \code{"edgelist"} } \description{ \code{which.matrix.type} attempts to choose an appropriate matrix expression for a \code{network} object, or (if its argument is a matrix) attempts to determine whether the matrix is of type adjacency, incidence, or edgelist. } \details{ The heuristics used to determine matrix types are fairly arbitrary, and should be avoided where possible. This function is intended to provide a modestly intelligent fallback option when explicit identification by the user is not possible. } \examples{ #Create an arbitrary adjacency matrix m<-matrix(rbinom(25,1,0.5),5,5) diag(m)<-0 #Can we guess the type? which.matrix.type(m) #Try the same thing with a network g<-network(m) which.matrix.type(g) which.matrix.type(as.matrix.network(g,matrix.type="incidence")) which.matrix.type(as.matrix.network(g,matrix.type="edgelist")) } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{as.matrix.network}}, \code{\link{as.network.matrix}} } \author{ David Hunter \email{dhunter@stat.psu.edu} } \keyword{graphs} network/man/mixingmatrix.Rd0000644000176200001440000000666514057014734015547 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.R \name{mixingmatrix} \alias{mixingmatrix} \alias{mixingmatrix.network} \alias{[[.mixingmatrix} \alias{$.mixingmatrix} \alias{is.directed.mixingmatrix} \alias{is.bipartite.mixingmatrix} \alias{print.mixingmatrix} \title{Mixing matrix} \usage{ mixingmatrix(object, ...) \method{mixingmatrix}{network}(object, attrname, useNA = "ifany", expand.bipartite = FALSE, ...) \method{[[}{mixingmatrix}(x, ...) \method{$}{mixingmatrix}(x, name) \method{is.directed}{mixingmatrix}(x, ...) \method{is.bipartite}{mixingmatrix}(x, ...) \method{print}{mixingmatrix}(x, ...) } \arguments{ \item{object}{a network or some other data structure for which a mixing matrix is meaningful.} \item{...}{arguments passed to \code{\link{table}}.} \item{attrname}{a vertex attribute name.} \item{useNA}{one of "ifany", "no" or "always". Argument passed to \code{\link{table}}. By default (\code{useNA = "ifany"}) if there are any \code{NA}s on the attribute corresponding row \emph{and} column will be contained in the result. See Details.} \item{expand.bipartite}{logical; if \code{object} is bipartite, should we return the \emph{square} mixing matrix representing every level of \code{attrname} against every other level, or a \emph{rectangular} matrix considering only levels present in each bipartition?} \item{x}{mixingmatrix object} \item{name}{name of the element to extract, one of "matrix" or "type"} } \value{ Function \code{mixingmatrix()} returns an object of class \code{mixingmatrix} extending \code{table} with a cross-tabulation of edges in the \code{object} according to the values of attribute \code{attrname} for the two incident vertices. If \code{object} is a \emph{directed} network rows correspond to the "tie sender" and columns to the "tie receiver". If \code{object} is an \emph{undirected} network there is no such distinction and the matrix is symmetrized. In both cases the matrix is square and all the observed values of the attribute \code{attrname} are represented in rows and columns. If \code{object} is a \emph{bipartite} network and \code{expand.bipartite} is \code{FALSE} the resulting matrix does not have to be square as only the actually observed values of the attribute are shown for each partition, if \code{expand.bipartite} is \code{TRUE} the matrix will be square. Functions \code{is.directed()} and \code{is.bipartite()} return \code{TRUE} or \code{FALSE}. The values will be identical for the input network \code{object}. } \description{ Return the mixing matrix for a network, on a given attribute. } \details{ Handling of missing values on the attribute \code{attrname} almost follows similar logic to \code{\link{table}}. If there are \code{NA}s on the attribute and \code{useNA="ifany"} (default) the result will contain both row and column for the missing values to ensure the resulting matrix is square (essentially calling \code{\link{table}} with \code{useNA="always"}). Also for that reason passing \code{exclude} parameter with \code{NULL}, \code{NA} or \code{NaN} is ignored with a warning as it may break the symmetry. } \note{ The \code{$} and \code{[[} methods are included only for backward-compatiblity reason and will become defunct in future releases of the package. } \examples{ # Interaction ties between Lake Pomona SAR organizations by sponsorship type # of tie sender and receiver (data from Drabek et al. 1981) data(emon) mixingmatrix(emon$LakePomona, "Sponsorship") } network/man/get.inducedSubgraph.Rd0000644000176200001440000000714314723241675016712 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R, R/operators.R \name{get.inducedSubgraph} \alias{get.inducedSubgraph} \alias{get.inducedSubgraph.network} \alias{\%s\%} \title{Retrieve Induced Subgraphs and Cuts} \usage{ get.inducedSubgraph(x, ...) \method{get.inducedSubgraph}{network}(x, v, alters = NULL, eid = NULL, ...) x \%s\% v } \arguments{ \item{x}{an object of class \code{network}.} \item{...}{additional arguments for methods.} \item{v}{a vector of vertex IDs, or, for \code{\%s\%}, optionally a list containing two disjoint vectors of vertex IDs (see below).} \item{alters}{optionally, a second vector of vertex IDs. Must be disjoint with \code{v}.} \item{eid}{optionally, a numeric vector of valid edge ids in \code{x} that should be retained (cannot be used with \code{v} or \code{alter})} } \value{ A \code{\link{network}} object containing the induced subgraph. } \description{ Given a set of vertex IDs, \code{get.inducedSubgraph} returns the subgraph induced by the specified vertices (i.e., the vertices and all associated edges). Optionally, passing a second set of alters returns the cut from the first to the second set (i.e., all edges passing between the sets), along with the associated endpoints. Alternatively, passing in a vector of edge ids will induce a subgraph containing the specified edges and their incident vertices. In all cases, the result is returned as a network object, with all attributes of the selected edges and/or vertices (and any network attributes) preserved. } \details{ For \code{get.inducedSubgraph}, \code{v} can be a vector of vertex IDs. If \code{alter=NULL}, the subgraph induced by these vertices is returned. Calling \code{\%s\%} with a single vector of vertices has an identical effect. Where \code{alters} is specified, it must be a vector of IDs disjoint with \code{v}. Where both are given, the edges spanning \code{v} and \code{alters} are returned, along with the vertices in question. (Technically, only the edges really constitute the \dQuote{cut,} but the vertices are included as well.) The same result can be obtained with the \code{\%s\%} operator by passing a two-element list on the right hand side; the first element is then interpreted as \code{v}, and the second as \code{alters}. When \code{eid} is specified, the \code{v} and \code{alters} argument will be ignored and the subgraph induced by the specified edges and their incident vertices will be returned. Any network, vertex, or edge attributes for the selected network elements are retained (although features such as vertex IDs and the network size will typically change). These are copies of the elements in the original network, which is not altered by this function. } \examples{ #Load the Drabek et al. EMON data data(emon) #For the Mt. St. Helens, EMON, several types of organizations are present: type<-emon$MtStHelens \%v\% "Sponsorship" #Plot interactions among the state organizations plot(emon$MtStHelens \%s\% which(type=="State"), displaylabels=TRUE) #Plot state/federal interactions plot(emon$MtStHelens \%s\% list(which(type=="State"), which(type=="Federal")), displaylabels=TRUE) #Plot state interactions with everyone else plot(emon$MtStHelens \%s\% list(which(type=="State"), which(type!="State")), displaylabels=TRUE) # plot only interactions with frequency of 2 subG2<-get.inducedSubgraph(emon$MtStHelens, eid=which(emon$MtStHelens\%e\%'Frequency'==2)) plot(subG2,edge.label='Frequency') } \seealso{ \code{\link{network}}, \code{\link{network.extraction}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} \keyword{manip} network/man/network.loop.Rd0000644000176200001440000000523013650471474015461 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{network.loop} \alias{network.loop} \title{Add Loops to a Plot} \usage{ network.loop( x0, y0, length = 0.1, angle = 10, width = 0.01, col = 1, border = 1, lty = 1, offset = 0, edge.steps = 10, radius = 1, arrowhead = TRUE, xctr = 0, yctr = 0, ... ) } \arguments{ \item{x0}{a vector of x coordinates for points of origin.} \item{y0}{a vector of y coordinates for points of origin.} \item{length}{arrowhead length, in current plotting units.} \item{angle}{arrowhead angle (in degrees).} \item{width}{width for loop body, in current plotting units (can be a vector).} \item{col}{loop body color (can be a vector).} \item{border}{loop border color (can be a vector).} \item{lty}{loop border line type (can be a vector).} \item{offset}{offset for origin point (can be a vector).} \item{edge.steps}{number of steps to use in approximating curves.} \item{radius}{loop radius (can be a vector).} \item{arrowhead}{boolean; should arrowheads be used? (Can be a vector.)} \item{xctr}{x coordinate for the central location away from which loops should be oriented.} \item{yctr}{y coordinate for the central location away from which loops should be oriented.} \item{\dots}{additional arguments to \code{\link{polygon}}.} } \value{ None. } \description{ \code{network.loop} draws a "loop" at a specified location; this is used to designate self-ties in \code{\link{plot.network}}. } \details{ \code{network.loop} is the companion to \code{\link{network.arrow}}; like the latter, plot elements produced by \code{network.loop} are drawn using \code{\link{polygon}}, and as such are scaled based on the current plotting device. By default, loops are drawn so as to encompass a circular region of radius \code{radius}, whose center is \code{offset} units from \code{x0,y0} and at maximum distance from \code{xctr,yctr}. This is useful for functions like \code{\link{plot.network}}, which need to draw loops incident to vertices of varying radii. } \note{ \code{network.loop} is a direct adaptation of \code{\link[sna]{gplot.loop}}, from the \code{sna} package. } \examples{ #Plot a few polygons with loops plot(0,0,type="n",xlim=c(-2,2),ylim=c(-2,2),asp=1) network.loop(c(0,0),c(1,-1),col=c(3,2),width=0.05,length=0.4, offset=sqrt(2)/4,angle=20,radius=0.5,edge.steps=50,arrowhead=TRUE) polygon(c(0.25,-0.25,-0.25,0.25,NA,0.25,-0.25,-0.25,0.25), c(1.25,1.25,0.75,0.75,NA,-1.25,-1.25,-0.75,-0.75),col=c(2,3)) } \seealso{ \code{\link{network.arrow}}, \code{\link{plot.network}}, \code{\link{polygon}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{aplot} \keyword{graphs} network/man/preparePlotArgs.Rd0000644000176200001440000000450113566403644016132 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{plotArgs.network} \alias{plotArgs.network} \title{Expand and transform attributes of networks to values appropriate for aguments to plot.network} \usage{ plotArgs.network(x, argName, argValue, d = NULL, edgetouse = NULL) } \arguments{ \item{x}{a \code{network} object which is going to be plotted} \item{argName}{character, the name of \code{plot.network} graphic parameter} \item{argValue}{value for the graphic paramter named in \code{argName} which to be transformed/prepared. For many attributes, if this is a single character vector it will be assumed to be the name of a vertex or edge attribute to be extracted and transformed} \item{d}{is an edgelist matrix of edge values optionally used by some edge attribute functions} \item{edgetouse}{numeric vector giving set of edge ids to be used (in case some edges are not being shown) required by some attributes} } \value{ returns a vector with length corresponding to the number of vertices or edges (depending on the paramter type) giving the appropriately prepared values for the parameter type. If the values or specified attribute can not be processed correctly, and Error may occur. } \description{ This is primairly an internal function called by \code{plot.network} or by external packages such as \code{ndtv} that want to prepare \code{plot.network} graphic arguments in a standardized way. } \details{ Given a network object, the name of graphic parameter argument to \code{plot.network} and value, it will if necessary transform the value, or extract it from the network, according to the description in \code{\link{plot.network}}. For some attributes, if the value is the name of a vertex or edge attribute, the appropriate values will be extracted from the network before transformation. } \examples{ net<-network.initialize(3) set.vertex.attribute(net,'color',c('red','green','blue')) set.vertex.attribute(net,'charm',1:3) # replicate a single colorname value plotArgs.network(net,'vertex.col','purple') # map the 'color' attribute to color plotArgs.network(net,'vertex.col','color') # similarly for a numeric attribute ... plotArgs.network(net,'vertex.cex',12) plotArgs.network(net,'vertex.cex','charm') } \seealso{ See also \code{\link{plot.network}} } \author{ skyebend@uw.edu } network/man/loading.attributes.Rd0000644000176200001440000001563414723241675016633 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/network-package.R \name{loading.attributes} \alias{loading.attributes} \title{Examples of how to load vertex and edge attributes into networks} \description{ Additional examples of how to manipulate network attributes using the functions documented in \code{\link{attribute.methods}} } \details{ The \code{\link{attribute.methods}} documentation gives details about the use of the specific network attribute methods such as \code{get.vertex.attribute} and \code{set.edge.attribute}. This document gives examples of how to load in and attach attribute data, drawing heavily on material from the Sunbelt statnet workshops \url{https://statnet.org/workshops/}. The examples section below give a quick overview of: \itemize{ \item Loading in a matrix \item Attaching vertex attributes \item Attaching edge atributes from a matrix \item Loading in an edgelist \item Attaching edge atributes from an edgelist } The \code{\link{read.table}} documentation provides more information about reading data in from various tabular file formats prior to loading into a network. Note that the output is usually a \code{\link{data.frame}} object in which each columns is represented as a \code{\link{factor}}. This means that in some cases when the output is directly loaded into a network the variable values will appear as factor level numbers instead of text values. The \code{stringsAsFactors=FALSE} flag may help with this, but some columns may need to be converted using \code{as.numeric} or \code{as.character} where appropriate. } \examples{ # read in a relational data adjacency matrix # LOADING IN A MATRIX \dontrun{ # can download matrix file from # https://statnet.csde.washington.edu/trac/raw-attachment/wiki/Resources/relationalData.csv # and download vertex attribute file from # https://statnet.csde.washington.edu/trac/raw-attachment/wiki/Resources/vertexAttributes.csv # load in relation matrix from file relations <- read.csv("relationalData.csv",header=FALSE,stringsAsFactors=FALSE) # convert to matrix format from data frame relations <- as.matrix(relations) # load in vertex attributes nodeInfo <- read.csv("vertexAttributes.csv",header=TRUE,stringsAsFactors=FALSE) } \dontshow{ # since no access to file, creating it here relations <- matrix( c(0,0,0,1,1,1,0,0,0, 0,0,0,0,0,1,0,0,0, 0,0,0,0,0,0,1,0,1, 1,0,0,0,1,0,0,0,0, 1,0,0,1,0,0,0,0,0, 1,1,0,0,0,0,0,0,1, 0,0,1,0,0,0,0,0,1, 0,0,0,0,0,0,0,0,0, 0,0,1,0,0,1,1,0,0),ncol=9,byrow=TRUE) nodeInfo <- data.frame( name=c("Danielle","Josh","Mark","Emma","Sarah","Dave","Theresa","Carolyn","Gil"), age=c(44,44,40,32,33,36,38,42,30), sex=c("F","M","M","F","F","M","F","F","M"), handed=c("R","R","R","L","R","L","L","R","L"), lastDocVisit=c(2012,2008,2010,2012,2011,2007,2009,2009,2010), stringsAsFactors=FALSE ) } print(relations) # peek at matrix print(nodeInfo) # peek at attribute data # Since our relational data has no row/column names, let's set them now rownames(relations) <- nodeInfo$name colnames(relations) <- nodeInfo$name # create undirected network object from matrix nrelations<-network(relations,directed=FALSE) # it read in vertex names from matrix col names ... network.vertex.names(nrelations) # ATTACHING VERTEX ATTRIBUTES # ... but could also set vertex.names with nrelations\%v\%'vertex.names'<- nodeInfo$name # load in other attributes nrelations\%v\%"age" <- nodeInfo$age nrelations\%v\%"sex" <- nodeInfo$sex nrelations\%v\%"handed" <- nodeInfo$handed nrelations\%v\%"lastDocVisit" <- nodeInfo$lastDocVisit # Note: order of attributes in the data frame MUST match vertex ids # otherwise the attribute will get assigned to the wrong vertex # check that they got loaded list.vertex.attributes(nrelations) # what if we had an adjaceny matrix like: valuedMat<-matrix(c(1,2,3, 2,0,9.5,1,5,0),ncol=3,byrow=TRUE) valuedMat # make a network from it valuedNet<-network(valuedMat,loops=TRUE,directed=TRUE) # print it back out ... as.matrix(valuedNet) # wait, where did the values go!!? # LOADING A MATRIX WITH VALUES # to construct net from matrix with values: valuedNet<-network(valuedMat,loops=TRUE,directed=TRUE, ignore.eval=FALSE,names.eval='myEdgeWeight') # also have to specify the name of the attribute when converting to matrix as.matrix(valuedNet,attrname='myEdgeWeight') # ATTACHING EDGE ATTRIBUTES FROM A MATRIX # maybe we have edge attributes of a different sort in another matrix like: edgeAttrs<-matrix(c("B","Z","Q","W","A","E","L","P","A"),ncol=3,byrow=TRUE) edgeAttrs # we can still attach them valuedNet<-set.edge.value(valuedNet,'someLetters',edgeAttrs) # and extract them as.matrix(valuedNet,attrname='someLetters') valuedNet\%e\%'someLetters' # but notice that some of the values didn't get used # the ("A"s are missing) because there were no corresponding edges (loops) # for the attribute to be attached to # ATTACHING EDGE ATTRIBUTES FROM A LIST # it is also possible to attach edge attributes directly from a list edgeCols<-c("red","green","blue","orange","pink","brown","gray") valuedNet<-set.edge.attribute(valuedNet,"edgeColors",edgeCols) # but this can be risky, because we may not know the ordering of the edges, # (especially if some have been deleted). Does "green" go with the edge from # 1 to 2, or from 3 to 1? # Usually if the edge data is only availible in list form, it is safer to construct # the network from an edgelist in the first place # LOADING IN AN EDGELIST # pretend we just loaded in this data.frame from a file elData<-data.frame( from_id=c("1","2","3","1","3","1","2"), to_id=c("1", "1", "1", "2", "2", "3", "3"), myEdgeWeight=c(1, 2, 1, 2, 5, 3, 9.5), someLetters=c("B", "W", "L", "Z", "P", "Q", "E"), edgeCols=c("red","green","blue","orange","pink","brown","gray"), stringsAsFactors=FALSE ) # peek at data # each row corresponds to a relationship (edge) in the network elData # to make a network we just use the first two id columns valuedNet2<-network(elData[,1:2],loops=TRUE) # print it out as.matrix(valuedNet2) # has right edges, but no values # to include values (with names from the columns) valuedNet2<-network(elData,loops=TRUE) list.edge.attributes(valuedNet2) as.matrix(valuedNet2,attrname='someLetters') } \references{ Acton, R. M., Jasny, L (2012) \emph{An Introduction to Network Analysis with R and statnet} Sunbelt XXXII Workshop Series, March 13, 2012. Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{attribute.methods}}, \code{\link{as.network.matrix}}, \code{\link{as.sociomatrix}}, \code{\link{as.matrix.network}}, \code{\link{network.extraction}} } \keyword{classes} \keyword{graphs} network/man/network.dyadcount.Rd0000644000176200001440000000361414723241675016506 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{network.dyadcount} \alias{network.dyadcount} \alias{network.dyadcount.network} \title{Return the Number of (Possibly Directed) Dyads in a Network Object} \usage{ \method{network.dyadcount}{network}(x, na.omit = TRUE, ...) } \arguments{ \item{x}{an object of class \code{network}} \item{na.omit}{logical; omit edges with \code{na==TRUE} from the count?} \item{\dots}{possible additional arguments, used by other implementations} } \value{ The number of dyads in the network } \description{ \code{network.dyadcount} returns the number of possible dyads within a \code{network}, removing those flagged as missing if desired. If the network is directed, directed dyads are counted accordingly. } \details{ The return value \code{network.dyadcount} is equal to the number of dyads, minus the number of \code{NULL} edges (and missing edges, if \code{na.omit==TRUE}). If \code{x} is directed, the number of directed dyads is returned. If the network allows loops, the number of possible entries on the diagnonal is added. Allthough the function does not give an error on multiplex networks or hypergraphs, the results probably don't make sense. } \examples{ #Create a directed network with three edges m<-matrix(0,3,3) m[1,2]<-1; m[2,3]<-1; m[3,1]<-1 g<-network(m) network.dyadcount(g)==6 #Verify the directed dyad count g<-network(m|t(m),directed=FALSE) network.dyadcount(g)==3 #nC2 in undirected case } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{get.network.attribute}}, \code{\link{network.edgecount}}, \code{\link{is.directed}} } \author{ Mark S. Handcock \email{handcock@stat.washington.edu}, skyebend } \keyword{classes} \keyword{graphs} network/man/as.data.frame.network.Rd0000644000176200001440000000251514363701063017107 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dataframe.R \name{as.data.frame.network} \alias{as.data.frame.network} \title{Coerce a Network Object to a \code{data.frame}} \usage{ \method{as.data.frame}{network}( x, ..., unit = c("edges", "vertices"), na.rm = TRUE, attrs_to_ignore = "na", name_vertices = TRUE, sort_attrs = FALSE, store_eid = FALSE ) } \arguments{ \item{x}{an object of class \code{network}} \item{...}{additional arguments} \item{unit}{whether a \code{data.frame} of edge or vertex attributes should be returned.} \item{na.rm}{logical; ignore missing edges/vertices when constructing the data frame?} \item{attrs_to_ignore}{character; a vector of attribute names to exclude from the returned \code{data.frame} (Default: \code{"na"})} \item{name_vertices}{logical; for \code{unit="edges"}, should the \code{.tail} and the \code{.head} columns contain vertex names as opposed to vertex indices?} \item{sort_attrs}{logical; should the attribute columns in the returned data frame be sorted alphabetically?} \item{store_eid}{logical; for \code{unit="edges"}, should the edge ID in the network's internal representation be stored in a column \code{.eid}?} } \description{ The \code{as.data.frame} method coerces its input to a \code{data.frame} containing \code{x}'s edges or vertices. } network/man/has.edges.Rd0000644000176200001440000000144613566403644014666 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.R \name{has.edges} \alias{has.edges} \alias{is.isolate} \title{Determine if specified vertices of a network have any edges (are not isolates)} \usage{ has.edges(net, v = seq_len(network.size(net))) } \arguments{ \item{net}{a \code{\link{network}} object to be queried} \item{v}{integer vector of vertex ids to check} } \value{ returns a logical vector with the same length as v, with TRUE if the vertex is involved in any edges, FALSE if it is an isolate. } \description{ Returns a logical value for each specified vertex, indicating if it has any incident (in or out) edges. Checks all vertices by default } \examples{ test<-network.initialize(5) test[1,2]<-1 has.edges(test) has.edges(test,v=5) } \author{ skyebend } network/man/sum.network.Rd0000644000176200001440000000436614723241675015325 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{sum.network} \alias{sum.network} \title{Combine Networks by Edge Value Addition} \usage{ \method{sum}{network}(..., attrname = NULL, na.rm = FALSE) } \arguments{ \item{\dots}{one or more \code{network} objects.} \item{attrname}{the name of an edge attribute to use when assessing edge values, if desired.} \item{na.rm}{logical; should edges with missing data be ignored?} } \value{ A \code{\link{network}} object. } \description{ Given a series of networks, \code{sum.network} attempts to form a new network by accumulation of edges. If a non-null \code{attrname} is given, the corresponding edge attribute is used to determine and store edge values. } \details{ The network summation method attempts to combine its arguments by addition of their respective adjacency matrices; thus, this method is only applicable for networks whose adjacency coercion is well-behaved. Addition is effectively boolean unless \code{attrname} is specified, in which case this is used to assess edge values -- net values of 0 will result in removal of the underlying edge. Other network attributes in the return value are carried over from the first element in the list, so some persistence is possible (unlike the addition operator). Note that it is sometimes possible to \dQuote{add} networks and raw adjacency matrices using this routine (if all dimensions are correct), but more exotic combinations may result in regrettably exciting behavior. } \examples{ #Create some networks g<-network.initialize(5) h<-network.initialize(5) i<-network.initialize(5) g[1,,names.eval="marsupial",add.edges=TRUE]<-1 h[1:2,,names.eval="marsupial",add.edges=TRUE]<-2 i[1:3,,names.eval="marsupial",add.edges=TRUE]<-3 #Combine by addition pouch<-sum(g,h,i,attrname="marsupial") pouch[,] #Edge values in the pouch? as.sociomatrix(pouch,attrname="marsupial") #Recover the marsupial } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{network.operators}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{arith} \keyword{graphs} network/man/network.extraction.Rd0000644000176200001440000001376514723241675016704 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/operators.R \name{network.extraction} \alias{network.extraction} \alias{[.network} \alias{[<-.network} \alias{\%e\%} \alias{\%e\%<-} \alias{\%eattr\%} \alias{\%eattr\%<-} \alias{\%n\%} \alias{\%n\%<-} \alias{\%nattr\%} \alias{\%nattr\%<-} \alias{\%v\%} \alias{\%v\%<-} \alias{\%vattr\%} \alias{\%vattr\%<-} \title{Extraction and Replacement Operators for Network Objects} \usage{ \method{[}{network}(x, i, j, na.omit = FALSE) \method{[}{network}(x, i, j, names.eval = NULL, add.edges = FALSE) <- value x \%e\% attrname x \%e\% attrname <- value x \%eattr\% attrname x \%eattr\% attrname <- value x \%n\% attrname x \%n\% attrname <- value x \%nattr\% attrname x \%nattr\% attrname <- value x \%v\% attrname x \%v\% attrname <- value x \%vattr\% attrname x \%vattr\% attrname <- value } \arguments{ \item{x}{an object of class \code{network}.} \item{i, j}{indices of the vertices with respect to which adjacency is to be tested. Empty values indicate that all vertices should be employed (see below).} \item{na.omit}{logical; should missing edges be omitted (treated as no-adjacency), or should \code{NA}s be returned? (Default: return \code{NA} on missing.)} \item{names.eval}{optionally, the name of an edge attribute to use for assigning edge values.} \item{add.edges}{logical; should new edges be added to \code{x} where edges are absent and the appropriate element of \code{value} is non-zero?} \item{value}{the value (or set thereof) to be assigned to the selected element of \code{x}.} \item{attrname}{the name of a network or vertex attribute (as appropriate).} } \value{ The extracted data, or none. } \description{ Various operators which allow extraction or replacement of various components of a \code{network} object. } \details{ Indexing for edge extraction operates in a manner analogous to \code{matrix} objects. Thus, \code{x[,]} selects all vertex pairs, \code{x[1,-5]} selects the pairing of vertex 1 with all vertices except for 5, etc. Following this, it is acceptable for \code{i} and/or \code{j} to be logical vectors indicating which vertices are to be included. During assignment, an attempt is made to match the elements of \code{value} to the extracted pairs in an intelligent way; in particular, elements of \code{value} will be replicated if too few are supplied (allowing expressions like \code{x[1,]<-1}). Where \code{names.eval==NULL}, zero and non-zero values are taken to indicate the presence of absence of edges. \code{x[2,4]<-6} thus adds a single (2,4) edge to \code{x}, and \code{x[2,4]<-0} removes such an edge (if present). If \code{x} is multiplex, assigning 0 to a vertex pair will eliminate \emph{all} edges on that pair. Pairs are taken to be directed where \code{is.directed(x)==TRUE}, and undirected where \code{is.directed(x)==FALSE}. If an edge attribute is specified using \code{names.eval}, then the provided values will be assigned to that attribute. When assigning values, only extant edges are employed (unless \code{add.edges==TRUE}); in the latter case, any non-zero assignment results in the addition of an edge where currently absent. If the attribute specified is not present on a given edge, it is added. Otherwise, any existing value is overwritten. The \code{\%e\%} operator can also be used to extract/assign edge values; in those roles, it is respectively equivalent to \code{get.edge.value(x,attrname)} and \code{set.edge.value(x,attrname=attrname,value=value)} (if \code{value} is a matrix) and \code{set.edge.attribute(x,attrname=attrname,value=value)} (if \code{value} is anything else). That is, if \code{value} is a matrix, the assignment operator treats it as an adjacency matrix; and if not, it treats it as a vector (recycled as needed) in the internal ordering of edges (i.e., edge IDs), skipping over deleted edges. In no case will attributes be assigned to nonexisted edges. The \code{\%n\%} and \code{\%v\%} operators serve as front-ends to the network and vertex extraction/assignment functions (respectively). In the extraction case, \code{x \%n\% attrname} is equivalent to \code{get.network.attribute(x,attrname)}, with \code{x \%v\% attrname} corresponding to \code{get.vertex.attribute(x,attrname)}. In assignment, the respective equivalences are to \code{set.network.attribute(x,attrname,value)} and \code{set.vertex.attribute(x,attrname,value)}. Note that the \code{\%\%} assignment forms are generally slower than the named versions of the functions beause they will trigger an additional internal copy of the network object. The \code{\%eattr\%}, \code{\%nattr\%}, and \code{\%vattr\%} operators are equivalent to \code{\%e\%}, \code{\%n\%}, and \code{\%v\%} (respectively). The short forms are more succinct, but may produce less readable code. } \examples{ #Create a random graph (inefficiently) g<-network.initialize(10) g[,]<-matrix(rbinom(100,1,0.1),10,10) plot(g) #Demonstrate edge addition/deletion g[,]<-0 g[1,]<-1 g[2:3,6:7]<-1 g[,] #Set edge values g[,,names.eval="boo"]<-5 as.sociomatrix(g,"boo") #Assign edge values from a vector g \%e\% "hoo" <- "wah" g \%e\% "hoo" g \%e\% "om" <- c("wow","whee") g \%e\% "om" #Assign edge values as a sociomatrix g \%e\% "age" <- matrix(1:100, 10, 10) g \%e\% "age" as.sociomatrix(g,"age") #Set/retrieve network and vertex attributes g \%n\% "blah" <- "Pork!" #The other white meat? g \%n\% "blah" == "Pork!" #TRUE! g \%v\% "foo" <- letters[10:1] #Letter the vertices g \%v\% "foo" == letters[10:1] #All TRUE } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{is.adjacent}}, \code{\link{as.sociomatrix}}, \code{\link{attribute.methods}}, \code{\link{add.edges}}, \code{\link{network.operators}}, and \code{\link{get.inducedSubgraph}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} \keyword{manip} network/man/as.color.Rd0000644000176200001440000000420214057014734014530 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/misc.R \name{as.color} \alias{as.color} \alias{is.color} \title{Transform vector of values into color specification} \usage{ as.color(x, opacity = 1) is.color(x) } \arguments{ \item{x}{vector of numeric, character or factor values to be transformed} \item{opacity}{optional numeric value in the range 0.0 to 1.0 used to specify the opacity/transparency (alpha) of the colors to be returned. 0 means fully opaque, 1 means fully transparent. Behavior of \code{as.color} is as follows: \itemize{ \item integer numeric values: unchanged, (assumed to corespond to values of R's active \code{\link{palette}}) \item integer real values: will be translated to into grayscale values ranging between the max and min \item factor: integer values corresponding to factor levels will be used \item character: if values are valid colors (as determined by \code{is.color}) they will be returned as is. Otherwise converted to factor and numeric value of factor returned. } The optional \code{opacity} parameter can be used to make colors partially transparent (as a shortcut for \code{\link{adjustcolor}}. If used, colors will be returned as hex rgb color string (i.e. \code{"#00FF0080"}) The \code{is.color} function checks if each character element of \code{x} appears to be a color name by comparing it to \code{\link{colors}} and checking if it is an HTML-style hex color code. Note that it will return FALSE for integer values. These functions are used for the color parameters of \code{\link{plot.network}}.} } \value{ For \code{as.color}, a vector integer values (corresponding to color palette values) or character color name. For \code{is.color}, a logical vector indicating if each element of x appears to be a color \code{as.color()} returns TRUE if x is a character in a known color format. } \description{ Convenience function to convert a vector of values into a color specification. } \examples{ as.color(1:3) as.color(c('a','b','c')) # add some transparency as.color(c('red','green','blue'),0.5) # gives "#FF000080", "#00FF0080", "#0000FF80" is.color(c('red',1,'foo',NA,'#FFFFFF55')) } network/man/read.paj.Rd0000644000176200001440000001430214724033152014472 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fileio.R \name{read.paj} \alias{read.paj} \alias{read.paj.simplify} \alias{switchArcDirection} \alias{readAndVectorizeLine} \title{Read a Pajek Project or Network File and Convert to an R 'Network' Object} \usage{ read.paj( file, verbose = FALSE, debug = FALSE, edge.name = NULL, simplify = FALSE, time.format = c("pajekTiming", "networkDynamic") ) } \arguments{ \item{file}{the name of the file whence the data are to be read. If it does not contain an absolute path, the file name is relative to the current working directory (as returned by \code{\link{getwd}}). \code{file} can also be a complete URL.} \item{verbose}{logical: Should longer descriptions of the reading and coercion process be printed out?} \item{debug}{logical: Should very detailed descriptions of the reading and coercion process be printed out? This is typically used to debug the reading of files that are corrupted on coercion.} \item{edge.name}{optional name for the edge variable read from the file. The default is to use the value in the project file if found.} \item{simplify}{Should the returned network be simplified as much as possible and saved? The values specifies the name of the file which the data are to be stored. If it does not contain an absolute path, the file name is relative to the current working directory (see \code{\link{getwd}}). If \code{specify} is TRUE the file name is the name \code{file}.} \item{time.format}{if the network has timing information attached to edges/vertices, how should it be processed? \code{'pajekTiming'} will attach the timing information unchanged in an attribute named \code{pajek.timing}. \code{'networkDynamic'} will translate it to a spell matrix format, attach it as an \code{'activity'} attribute and add the class \code{'networkDynamic'} -- formating it for use by the \code{networkDynamic} package.} } \value{ The structure of the object returned by \code{read.paj} depends on the contents of the file it parses. \itemize{ \item if input file contains information about a single 'network' object (i.e .net input file) a single network object is returned with attribute data set appropriately if possible. or a list of networks (for .paj input). \item if input file contains multiple sets of relations for a single network, a list of network objects ('network.series') is returned, along with a formula object?. \item if input .paj file contains additional information (like partition information), or multiple \code{*Network} definitions a two element list is returned. The first element is a list of all the network objects created, and the second is a list of partitions, etc. (how are these matched up) } } \description{ Return a (list of) \code{\link{network}} object(s) after reading a corresponding .net or .paj file. The code accepts ragged array edgelists, but cannot currently handle 2-mode, multirelational (e.g. KEDS), or networks with entries for both edges and arcs (e.g. GD-a99m). See \code{network}, \code{statnet}, or \code{sna} for more information. } \details{ If the \code{*Vertices} block includes the optional graphic attributes (coordinates, shape, size, etc.) they will be read attached to the network as vertex attributes but values will not be interperted (i.e. Pajek's color names will not be translated to R color names). Vertex attributes included in a \code{*Vector} block will be attached as vertex attributes. Edges or Arc weights in the \code{*Arcs} or \code{*Edges} block are include in the network as an attribute with the same name as the network. If no weight is included, a default weight of 1 is used. Optional graphic attributes or labels will be attached as edge attributes. If the file contains an empty \code{Arcs} block, an undirected network will be returned. Otherwise the network will be directed, with two edges (one in each direction) added for every row in the \code{*Edges} block. If the \code{*Vertices}, \code{*Arcs} or \code{*Edges} blocks having timing information included in the rows (indicated by \code{...} tokens), it will be attached to the vertices with behavior determined by the \code{time.format} option. If the \code{'networkDynamic'} format is used, times will be translated to \code{networkDynamic}'s spell model with the assumtion that the original Pajek representation was indicating discrete time chunks. For example \code{"[5-10]"} will become the spell \code{[5,11]}, \code{"[2-*]"} will become \code{[2,Inf]} and \code{"[7]"} will become \code{[7,8]}. See documentation for \code{networkDynamic}'s \code{?activity.attribute} for details. The \code{*Arcslist}, \code{*Edgelist} and \code{*Events} blocks are not yet supported. As there is no known single complete specification for the file format, parsing behavior has been infered from references and examples below. } \examples{ \dontrun{ require(network) par(mfrow=c(2,2)) test.net.1 <- read.paj("http://vlado.fmf.uni-lj.si/pub/networks/data/GD/gd98/A98.net") plot(test.net.1,main=test.net.1\%n\%'title') test.net.2 <- read.paj("http://vlado.fmf.uni-lj.si/pub/networks/data/mix/USAir97.net") # plot using coordinates from the file in the file plot(test.net.2,main=test.net.2\%n\%'title', coord=cbind(test.net.2\%v\%'x', test.net.2\%v\%'y'), jitter=FALSE) # read .paj project file # notice output has $networks and $partitions read.paj('http://vlado.fmf.uni-lj.si/vlado/podstat/AO/net/Tina.paj') } } \references{ Batagelj, Vladimir and Mrvar, Andrej (2011) Pajek Reference Manual version 2.05 \url{http://web.archive.org/web/20240906013709/http://vlado.fmf.uni-lj.si/pub/networks/pajek/doc/pajekman.pdf} Section 5.3 pp 73-79 Batageli, Vladimir (2008) "Network Analysis Description of Networks" \url{http://web.archive.org/web/20240511173536/http://vlado.fmf.uni-lj.si/pub/networks/doc/ECPR/08/ECPR01.pdf} Pajek Datasets \url{http://web.archive.org/web/20240411203537/http://vlado.fmf.uni-lj.si/pub/networks/data/esna} } \seealso{ \code{\link{network}} } \author{ Dave Schruth \email{dschruth@u.washington.edu}, Mark S. Handcock \email{handcock@stat.washington.edu} (with additional input from Alex Montgomery \email{ahm@reed.edu}), Skye Bender-deMoll \email{skyebend@uw.edu} } \keyword{datasets} network/man/network.layout.Rd0000644000176200001440000001573214723241675016035 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/layout.R \name{network.layout} \alias{network.layout} \alias{network.layout.circle} \alias{network.layout.fruchtermanreingold} \alias{network.layout.kamadakawai} \title{Vertex Layout Functions for plot.network} \usage{ network.layout.circle(nw, layout.par) network.layout.fruchtermanreingold(nw, layout.par) network.layout.kamadakawai(nw, layout.par) } \arguments{ \item{nw}{a network object, as passed by \code{\link{plot.network}}.} \item{layout.par}{a list of parameters.} } \value{ A matrix whose rows contain the x,y coordinates of the vertices of \code{d}. } \description{ Various functions which generate vertex layouts for the \code{\link{plot.network}} visualization routine. } \details{ Vertex layouts for network visualization pose a difficult problem -- there is no single, ``good'' layout algorithm, and many different approaches may be valuable under different circumstances. With this in mind, \code{\link{plot.network}} allows for the use of arbitrary vertex layout algorithms via the \code{network.layout.*} family of routines. When called, \code{\link{plot.network}} searches for a \code{network.layout} function whose fourth name matches its \code{mode} argument (see \code{\link{plot.network}} help for more information); this function is then used to generate the layout for the resulting plot. In addition to the routines documented here, users may add their own layout functions as needed. The requirements for a \code{network.layout} function are as follows: \enumerate{ \item the first argument, \code{nw}, must be a network object; \item the second argument, \code{layout.par}, must be a list of parameters (or \code{NULL}, if no parameters are specified); and \item the return value must be a real matrix of dimension \code{c(2,network.size(nw))}, whose rows contain the vertex coordinates. } Other than this, anything goes. (In particular, note that \code{layout.par} could be used to pass additional matrices or other information, if needed. Alternately, it is possible to make layout methods that respond to covariates on the network object, which are maintained intact by plot.network.) The \code{network.layout} functions currently supplied by default are as follows (with \code{n==network.size(nw)}): \describe{ \item{circle}{ This function places vertices uniformly in a circle; it takes no arguments.} \item{fruchtermanreingold}{ This function generates a layout using a variant of Fruchterman and Reingold's force-directed placement algorithm. It takes the following arguments: \describe{ \item{layout.par$niter}{ This argument controls the number of iterations to be employed. Larger values take longer, but will provide a more refined layout. (Defaults to 500.) } \item{layout.par$max.delta}{ Sets the maximum change in position for any given iteration. (Defaults to \code{n}.)} \item{layout.par$area}{ Sets the "area" parameter for the F-R algorithm. (Defaults to \code{n^2}.)} \item{layout.par$cool.exp}{ Sets the cooling exponent for the annealer. (Defaults to 3.)} \item{layout.par$repulse.rad}{ Determines the radius at which vertex-vertex repulsion cancels out attraction of adjacent vertices. (Defaults to \code{area*log(n)}.)} \item{layout.par$ncell}{ To speed calculations on large graphs, the plot region is divided at each iteration into \code{ncell} by \code{ncell} \dQuote{cells}, which are used to define neighborhoods for force calculation. Moderate numbers of cells result in fastest performance; too few cells (down to 1, which produces \dQuote{pure} F-R results) can yield odd layouts, while too many will result in long layout times. (Defaults to \code{n^0.4}.)} \item{layout.par$cell.jitter}{ Jitter factor (in units of cell width) used in assigning vertices to cells. Small values may generate \dQuote{grid-like} anomalies for graphs with many isolates. (Defaults to \code{0.5}.)} \item{layout.par$cell.pointpointrad}{ Squared \dQuote{radius} (in units of cells) such that exact point interaction calculations are used for all vertices belonging to any two cells less than or equal to this distance apart. Higher values approximate the true F-R solution, but increase computational cost. (Defaults to \code{0}.)} \item{layout.par$cell.pointcellrad}{ Squared \dQuote{radius} (in units of cells) such that approximate point/cell interaction calculations are used for all vertices belonging to any two cells less than or equal to this distance apart (and not within the point/point radius). Higher values provide somewhat better approximations to the true F-R solution at slightly increased computational cost. (Defaults to \code{18}.)} \item{layout.par$cell.cellcellrad}{ Squared \dQuote{radius} (in units of cells) such that approximate cell/cell interaction calculations are used for all vertices belonging to any two cells less than or equal to this distance apart (and not within the point/point or point/cell radii). Higher values provide somewhat better approximations to the true F-R solution at slightly increased computational cost. Note that cells beyond this radius (if any) do not interact, save through edge attraction. (Defaults to \code{ncell^2}.)} \item{layout.par$seed.coord}{ A two-column matrix of initial vertex coordinates. (Defaults to a random circular layout.) } } } \item{kamadakawai}{ This function generates a vertex layout using a version of the Kamada-Kawai force-directed placement algorithm. It takes the following arguments: \describe{ \item{layout.par$niter}{ This argument controls the number of iterations to be employed. (Defaults to 1000.) } \item{layout.par$sigma}{ Sets the base standard deviation of position change proposals. (Defaults to \code{n/4}.)} \item{layout.par$initemp}{ Sets the initial "temperature" for the annealing algorithm. (Defaults to 10.)} \item{layout.par$cool.exp}{ Sets the cooling exponent for the annealer. (Defaults to 0.99.)} \item{layout.par$kkconst}{ Sets the Kamada-Kawai vertex attraction constant. (Defaults to \code{n)^2}.)} \item{layout.par$elen}{ Provides the matrix of interpoint distances to be approximated. (Defaults to the geodesic distances of \code{nw} after symmetrizing, capped at \code{sqrt(n)}.)} \item{layout.par$seed.coord}{ A two-column matrix of initial vertex coordinates. (Defaults to a gaussian layout.) } } } } } \note{ The \code{network.layout} routines shown here are adapted directly from the \code{\link[sna]{gplot.layout}} routines of the \code{sna} package. } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} Fruchterman, T.M.J. and Reingold, E.M. (1991). \dQuote{Graph Drawing by Force-directed Placement.} \emph{Software - Practice and Experience,} 21(11):1129-1164. Kamada, T. and Kawai, S. (1989). \dQuote{An Algorithm for Drawing General Undirected Graphs.} \emph{Information Processing Letters,} 31(1):7-15. } \seealso{ \code{\link{plot.network}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{dplot} \keyword{graphs} network/man/as.sociomatrix.Rd0000644000176200001440000000611414723241675015765 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coercion.R \name{as.sociomatrix} \alias{as.sociomatrix} \title{Coerce One or More Networks to Sociomatrix Form} \usage{ as.sociomatrix( x, attrname = NULL, simplify = TRUE, expand.bipartite = FALSE, ... ) } \arguments{ \item{x}{an adjacency matrix, array, \code{\link{network}} object, or list thereof.} \item{attrname}{optionally, the name of a network attribute to use for extracting edge values (if \code{x} is a \code{\link{network}} object).} \item{simplify}{logical; should \code{as.sociomatrix} attempt to combine its inputs into an adjacency array (\code{TRUE}), or return them as separate list elements (\code{FALSE})?} \item{expand.bipartite}{logical; if \code{x} is bipartite, should we return the full adjacency matrix (rather than the abbreviated, two-mode form)?} \item{...}{additional arguments for the coercion routine.} } \value{ One or more adjacency matrices. If all matrices are of the same dimension and \code{simplify==TRUE}, the matrices are joined into a single array; otherwise, the return value is a list of single adjacency matrices. } \description{ \code{as.sociomatrix} takes adjacency matrices, adjacency arrays, \code{\link{network}} objects, or lists thereof, and returns one or more sociomatrices (adjacency matrices) as appropriate. This routine provides a useful input-agnostic front-end to functions which process adjacency matrices. } \details{ \code{as.sociomatrix} provides a more general means of coercing input into adjacency matrix form than \code{\link{as.matrix.network}}. In particular, \code{as.sociomatrix} will attempt to coerce all input networks into the appropriate form, and return the resulting matrices in a regularized manner. If \code{simplify==TRUE}, \code{as.sociomatrix} attempts to return the matrices as a single adjacency array. If the input networks are of variable size, or if \code{simplify==FALSE}, the networks in question are returned as a list of matrices. In any event, a single input network is always returned as a lone matrix. If \code{attrname} is given, the specified edge attribute is used to extract edge values from any \code{\link{network}} objects contained in \code{x}. Note that the same attribute will be used for all networks; if no attribute is specified, the standard dichotomous default will be used instead. } \examples{ #Generate an adjacency array g<-array(rbinom(100,1,0.5),dim=c(4,5,5)) #Generate a network object net<-network(matrix(rbinom(36,1,0.5),6,6)) #Coerce to adjacency matrix form using as.sociomatrix as.sociomatrix(g,simplify=TRUE) #Returns as-is as.sociomatrix(g,simplify=FALSE) #Returns as list as.sociomatrix(net) #Coerces to matrix as.sociomatrix(list(net,g)) #Returns as list of matrices } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{as.matrix.network}}, \code{\link{network}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} \keyword{manip} network/man/get.edges.Rd0000644000176200001440000000573314723241675014675 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{get.edges} \alias{get.edges} \alias{get.edgeIDs} \alias{get.dyads.eids} \title{Retrieve Edges or Edge IDs Associated with a Given Vertex} \usage{ get.edgeIDs( x, v, alter = NULL, neighborhood = c("out", "in", "combined"), na.omit = TRUE ) get.edges( x, v, alter = NULL, neighborhood = c("out", "in", "combined"), na.omit = TRUE ) get.dyads.eids( x, tails, heads, neighborhood = c("out", "in", "combined"), na.omit = TRUE ) } \arguments{ \item{x}{an object of class \code{network}} \item{v}{a vertex ID} \item{alter}{optionally, the ID of another vertex} \item{neighborhood}{an indicator for whether we are interested in in-edges, out-edges, or both (relative to \code{v}). defaults to \code{'combined'} for undirected networks} \item{na.omit}{logical; should we omit missing edges?} \item{tails}{a vector of vertex ID for the 'tails' (v) side of the dyad} \item{heads}{a vector of vertex ID for the 'heads' (alter) side of the dyad} } \value{ For \code{get.edges}, a list of edges. For \code{get.edgeIDs}, a vector of edge ID numbers. For \code{get.dyads.eids}, a list of edge IDs corresponding to the dyads defined by the vertex ids in \code{tails} and \code{heads} } \description{ \code{get.edges} retrieves a list of edges incident on a given vertex; \code{get.edgeIDs} returns the internal identifiers for those edges, instead. Both allow edges to be selected based on vertex neighborhood and (optionally) an additional endpoint. } \details{ By default, \code{get.edges} returns all out-, in-, or out- and in-edges containing \code{v}. \code{get.edgeIDs} is identical, save in its return value, as it returns only the ids of the edges. Specifying a vertex in \code{alter} causes these edges to be further selected such that alter must also belong to the edge -- this can be used to extract edges between two particular vertices. Omission of missing edges is accomplished via \code{na.omit}. Note that for multiplex networks, multiple edges or edge ids can be returned. The function \code{get.dyads.eids} simplifies the process of looking up the edge ids associated with a set of 'dyads' (tail and head vertex ids) for edges. It only is intended for working with non-multiplex networks and will return a warning and \code{NA} value for any dyads that correspond to multiple edges. The value \code{numeric(0)} will be returned for any dyads that do not have a corresponding edge. } \examples{ #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) get.edges(g,1,neighborhood="out") get.edgeIDs(g,1,neighborhood="in") } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{get.neighborhood}}, \code{\link{valid.eids}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/as.edgelist.Rd0000644000176200001440000000707314724264342015226 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/as.edgelist.R \name{as.edgelist} \alias{as.edgelist} \alias{as.edgelist.network} \alias{edgelist} \alias{as.edgelist.matrix} \alias{as.edgelist.tbl_df} \alias{is.edgelist} \title{Convert a network object into a numeric edgelist matrix} \usage{ \method{as.edgelist}{network}( x, attrname = NULL, as.sna.edgelist = FALSE, output = c("matrix", "tibble"), ... ) \method{as.edgelist}{matrix}( x, n, directed = TRUE, bipartite = FALSE, loops = FALSE, vnames = seq_len(n), ... ) \method{as.edgelist}{tbl_df}( x, n, directed = TRUE, bipartite = FALSE, loops = FALSE, vnames = seq_len(n), ... ) is.edgelist(x) } \arguments{ \item{x}{a \code{network} object with additional class added indicating how it should be dispatched.} \item{attrname}{optionally, the name of an edge attribute to use for edge values; may be a vector of names if \code{output="tibble"}} \item{as.sna.edgelist}{logical; should the edgelist be returned in edgelist form expected by the sna package? Ignored if \code{output="tibble"}} \item{output}{return type: a \code{\link{matrix}} or a \code{\link[tibble]{tibble}}; see \code{\link{as.matrix.network}} for the difference.} \item{\dots}{additional arguments to other methods} \item{n}{integer number of vertices in network, value passed to the 'n' flag on edgelist returned} \item{directed}{logical; is network directed, value passed to the 'directed' flag on edgelist returned} \item{bipartite}{logical or integer; is network bipartite, value passed to the 'bipartite' flag on edgelist returned} \item{loops}{logical; are self-loops allowed in network?, value passed to the 'loops' flag on edgelist returned} \item{vnames}{vertex names (defaults to vertex ids) to be attached to edgelist for sna package compatibility} } \value{ A matrix in which the first two columns are integers giving the tail (source) and head (target) vertex ids of each edge. The matrix will be given the class \code{edgelist}. The edgelist has additional attributes attached to it: \itemize{ \item \code{attr(,"n")} the number of vertices in the original network \item \code{attr(,"vnames")} the names of vertices in the original network \item \code{attr(,"directed")} logical, was the original network directed \item \code{attr(,"bipartite")} was the original network bipartite \item \code{attr(,"loops")} does the original network contain self-loops } Note that if the \code{attrname} attribute is used the resulting edgelist matrix will have three columns. And if \code{attrname} refers to a character attribute, the resulting edgelist matrix will be character rather than numeric unless \code{output="tibble"}. } \description{ Constructs an edgelist in a sorted format with defined attributes. } \details{ Constructs a edgelist matrix or tibble from a network, sorted tails-major order, with tails first, and, for undirected networks, tail < head. This format is required by some reverse-depending packages (e.g. \code{ergm}) The \code{\link{as.matrix.network.edgelist}} provides similar functionality but it does not enforce ordering or set the \code{edgelist} class and so should be slightly faster. \code{is.edgelist} tests if an object has the class \code{'edgelist'} } \note{ NOTE: this function was moved to network from the ergm package in network version 1.13 } \examples{ data(emon) as.edgelist(emon[[1]]) as.edgelist(emon[[1]],output="tibble") # contrast with unsorted columns of as.matrix.network.edgelist(emon[[1]]) } \seealso{ See also \code{\link{as.matrix.network.edgelist}} } network/man/as.matrix.network.Rd0000644000176200001440000001335114724264426016421 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coercion.R \name{as.matrix.network} \alias{as.matrix.network} \alias{as.matrix.network.adjacency} \alias{as.matrix.network.edgelist} \alias{as_tibble.network} \alias{as.tibble.network} \alias{as.matrix.network.incidence} \title{Coerce a Network Object to Matrix or Table Form} \usage{ \method{as.matrix}{network}(x, matrix.type = NULL, attrname = NULL, ...) \method{as.matrix.network}{adjacency}(x, attrname=NULL, expand.bipartite = FALSE, ...) \method{as.matrix.network}{edgelist}(x, attrname=NULL, as.sna.edgelist = FALSE, na.rm = TRUE, ...) \method{as_tibble}{network}( x, attrnames = (match.arg(unit) == "vertices"), na.rm = TRUE, ..., unit = c("edges", "vertices"), store.eid = FALSE ) as.tibble.network( x, attrnames = (match.arg(unit) == "vertices"), na.rm = TRUE, ..., unit = c("edges", "vertices"), store.eid = FALSE ) \method{as.matrix.network}{incidence}(x, attrname=NULL, ...) } \arguments{ \item{x}{an object of class \code{network}} \item{matrix.type}{one of \code{"adjacency"}, \code{"incidence"}, \code{"edgelist"}, or \code{NULL}} \item{attrname}{optionally, the name of an edge attribute to use for edge values} \item{...}{additional arguments.} \item{expand.bipartite}{logical; if \code{x} is bipartite, should we return the full adjacency matrix (rather than the abbreviated, two-mode form)?} \item{as.sna.edgelist}{logical; should the edgelist be returned in sna edglist form?} \item{na.rm}{logical; should missing edges/vertices be included in the edgelist formats? Ignored if \code{as.sna.edgelist=TRUE}.} \item{attrnames}{optionally, either a character vector of the names of edge attributes to use for edge values, or a numerical or logical vector to use as indices for selecting them from \code{\link{list.edge.attributes}(x)} or \code{\link{list.vertex.attributes}(x)} (depending on \code{unit}); passing \code{TRUE} therefore returns all edge attributes as columns} \item{unit}{whether a \code{\link[tibble]{tibble}} of edge or vertex attributes should be returned.} \item{store.eid}{whether the edge ID should be stored in the third column (\code{.eid}).} } \value{ For \code{as.matrix} methods, an adjacency, incidence, or edgelist matrix. For the \code{as_tibble} method, a \code{tibble} whose first two columns are \code{.head} and \code{.tail}, whose third column \code{.eid} is the edge ID, and whose subsequent columns are the requested edge attributes. } \description{ The \code{as.matrix} methods attempt to coerce their input to a matrix in adjacency, incidence, or edgelist form. Edge values (from a stored attribute) may be used if present. \code{\link[tibble:as_tibble]{as_tibble}} coerces into an edgelist in \code{\link[tibble]{tibble}} (a type of \code{\link{data.frame}}) form; this can be especially useful if extrecting a character-type edge attribute. } \details{ If no matrix type is specified, \code{\link{which.matrix.type}} will be used to make an educated guess based on the shape of \code{x}. Where edge values are not specified, a dichotomous matrix will be assumed. Edgelists returned by the \code{as.matrix} methods are by default in a slightly different form from the \code{sna} edgelist standard, but do contain the \code{sna} extended matrix attributes (see \code{\link{as.network.matrix}}). They should typically be compatible with \code{sna} library functions. To ensure compatibility, the \code{as.sna.edgelist} argument can be set (which returns an exact \code{sna} edgelist). The \code{\link{as.edgelist}} function also returns a similar edgelist matrix but with an enforced sorting. For the \code{as.matrix} methods, if the \code{attrname} attribute is used to include a charcter attribute, the resulting edgelist matrix will be character rather than numeric. The \code{as_tibble} methods never coerce. Note that adjacency matrices may also be obtained using the extraction operator. See the relevant man page for details. Also note that which attributes get returned by the \code{as_tibble} method by default depends on \code{unit}: by default no edge attributes are returned but all vertex attributes are. } \examples{ # Create a random network m <- matrix(rbinom(25,4,0.159),5,5) # 50\% density diag(m) <- 0 g <- network(m, ignore.eval=FALSE, names.eval="a") # With values g \%e\% "ac" <- letters[g \%e\% "a"] # Coerce to matrix form # No attributes: as.matrix(g,matrix.type="adjacency") as.matrix(g,matrix.type="incidence") as.matrix(g,matrix.type="edgelist") # Attributes: as.matrix(g,matrix.type="adjacency",attrname="a") as.matrix(g,matrix.type="incidence",attrname="a") as.matrix(g,matrix.type="edgelist",attrname="a") as.matrix(g,matrix.type="edgelist",attrname="ac") # Coerce to a tibble: library(tibble) as_tibble(g) as_tibble(g, attrnames=c("a","ac")) as_tibble(g, attrnames=TRUE) # Get vertex attributes instead: as_tibble(g, unit = "vertices") # Missing data handling: g[1,2] <- NA as.matrix(g,matrix.type="adjacency") # NA in the corresponding cell as.matrix(g,matrix.type="edgelist", na.rm=TRUE) # (1,2) excluded as.matrix(g,matrix.type="edgelist", na.rm=FALSE) # (1,2) included as_tibble(g, attrnames="na", na.rm=FALSE) # Which edges are marked missing? # Can also use the extraction operator g[,] # Get entire adjacency matrix g[1:2,3:5] # Obtain a submatrix } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{which.matrix.type}}, \code{\link{network}}, \code{\link{network.extraction}},\code{\link{as.edgelist}} } \author{ Carter T. Butts \email{buttsc@uci.edu} and David Hunter \email{dhunter@stat.psu.edu} } \keyword{classes} \keyword{graphs} network/man/add.vertices.Rd0000644000176200001440000000560314723241675015377 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{add.vertices} \alias{add.vertices} \alias{add.vertices.network} \title{Add Vertices to an Existing Network} \usage{ add.vertices(x, nv, vattr = NULL, last.mode = TRUE, ...) } \arguments{ \item{x}{an object of class \code{network}} \item{nv}{the number of vertices to add} \item{vattr}{optionally, a list of attributes with one entry per new vertex} \item{last.mode}{logical; should the new vertices be added to the last (rather than the first) mode of a bipartite network?} \item{...}{possible additional arguments to add.vertices} } \value{ Invisibly, a pointer to the updated \code{network} object; \code{add.vertices} modifies its argument in place. } \description{ \code{add.vertices} adds a specified number of vertices to an existing network; if desired, attributes for the new vertices may be specified as well. } \details{ New vertices are generally appended to the end of the network (i.e., their vertex IDs begin with \code{network.size(x)} an count upward). The one exception to this rule is when \code{x} is bipartite and \code{last.mode==FALSE}. In this case, new vertices are added to the end of the first mode, with existing second-mode vertices being permuted upward in ID. (\code{x}'s \code{bipartite} attribute is adjusted accordingly.) Note that the attribute format used here is based on the internal (vertex-wise) storage method, as opposed to the attribute-wise format used by \code{\link{network}}. Specifically, \code{vattr} should be a list with one entry per new vertex, the ith element of which should be a list with an element for every attribute of the ith vertex. (If the required \code{na} attribute is not given, it will be automatically created.) } \note{ \code{add.vertices} was converted to an S3 generic funtion in version 1.9, so it actually calls \code{add.vertices.network} by default and may call other versions depending on context (i.e. when called with a \code{networkDynamic} object). } \examples{ #Initialize a network object g<-network.initialize(5) g #Add five more vertices add.vertices(g,5) g #Create two more, with attributes vat<-replicate(2,list(is.added=TRUE,num.added=2),simplify=FALSE) add.vertices(g,2,vattr=vat) g\%v\%"is.added" #Values are only present for the new cases g\%v\%"num.added" #Add to a bipartite network bip <-network.initialize(5,bipartite=3) get.network.attribute(bip,'bipartite') # how many vertices in first mode? add.vertices(bip,3,last.mode=FALSE) get.network.attribute(bip,'bipartite') } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{network}}, \code{\link{get.vertex.attribute}}, \code{\link{set.vertex.attribute}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/network.edgelabel.Rd0000644000176200001440000000363013650471474016416 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{network.edgelabel} \alias{network.edgelabel} \title{Plots a label corresponding to an edge in a network plot.} \usage{ network.edgelabel( px0, py0, px1, py1, label, directed, loops = FALSE, cex, curve = 0, ... ) } \arguments{ \item{px0}{vector of x coordinates of tail vertex of the edge} \item{py0}{vector of y coordinates of tail vertex of the edge} \item{px1}{vector of x coordinates of head vertex of the edge} \item{py1}{vector of y coordinate of head vertex of the edge} \item{label}{vector strings giving labels to be drawn for edge edge} \item{directed}{logical: is the underlying network directed? If FALSE, labels will be drawn in the middle of the line segment, otherwise in the first 3rd so that the labels for edges pointing in the opposite direction will not overlap.} \item{loops}{logical: if true, assuming the labels to be drawn belong to loop-type edges and render appropriately} \item{cex}{numeric vector giving the text expansion factor for each label} \item{curve}{numeric vector controling the extent of edge curvature (0 = straight line edges)} \item{\dots}{additional arguments to be passed to \code{\link{text}}} } \value{ no value is returned but text will be rendered on the active plot } \description{ Draws a text labels on (or adjacent to) the line segments connecting vertices on a network plot. } \details{ Called internally by \code{\link{plot.network}} when \code{edge.label} parameter is used. For directed, non-curved edges, the labels are shifted towards the tail of the edge. Labels for curved edges are not shifted because opposite-direction edges curve the opposite way. Makes a crude attempt to shift labels to either side of line, and to draw the edge labels for self-loops near the vertex. No attempt is made to avoid overlap between vertex and edge labels. } \author{ skyebend } network/man/network.indicators.Rd0000644000176200001440000000527214723241675016655 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{network.indicators} \alias{network.indicators} \alias{has.loops} \alias{is.bipartite} \alias{is.bipartite.network} \alias{is.directed} \alias{is.directed.network} \alias{is.hyper} \alias{is.multiplex} \title{Indicator Functions for Network Properties} \usage{ has.loops(x) is.bipartite(x, ...) \method{is.bipartite}{network}(x, ...) is.directed(x, ...) \method{is.directed}{network}(x, ...) is.hyper(x) is.multiplex(x) } \arguments{ \item{x}{an object of class \code{network}} \item{...}{other arguments passed to/from other methods} } \value{ \code{TRUE} or \code{FALSE} } \description{ Various indicators for properties of \code{network} class objects. } \details{ These methods are the standard means of assessing the state of a \code{network} object; other methods can (and should) use these routines in governing their own behavior. As such, improper setting of the associated attributes may result in unpleasantly creative results. (See the \code{edge.check} argument to \code{\link{add.edges}} for an example of code which makes use of these network properties.) The functions themselves behave has follows: \code{has.loops} returns \code{TRUE} iff \code{x} is allowed to contain loops (or loop-like edges, in the hypergraphic case). \code{is.bipartite} returns \code{TRUE} iff the \code{x} has been explicitly bipartite-coded. Values of \code{bipartite=NULL}, and \code{bipartite=FALSE} will evaluate to \code{FALSE}, numeric values of \code{bipartite>=0} will evaluate to \code{TRUE}. (The value \code{bipartite==0} indicates that it is a bipartite network with a zero-sized first partition.) Note that \code{is.bipartite} refers only to the storage properties of \code{x} and how it should be treated by some algorithms; \code{is.bipartite(x)==FALSE} it does \emph{not} mean that \code{x} cannot admit a bipartition! \code{is.directed} returns \code{TRUE} iff the edges of \code{x} are to be interpreted as directed. \code{is.hyper} returns \code{TRUE} iff \code{x} is allowed to contain hypergraphic edges. \code{is.multiplex} returns \code{TRUE} iff \code{x} is allowed to contain multiplex edges. } \examples{ g<-network.initialize(5) #Initialize the network is.bipartite(g) is.directed(g) is.hyper(g) is.multiplex(g) has.loops(g) } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{network}}, \code{\link{get.network.attribute}}, \code{set.network.attribute}, \code{\link{add.edges}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/man/get.neighborhood.Rd0000644000176200001440000000300514723241675016243 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{get.neighborhood} \alias{get.neighborhood} \title{Obtain the Neighborhood of a Given Vertex} \usage{ get.neighborhood(x, v, type = c("out", "in", "combined"), na.omit = TRUE) } \arguments{ \item{x}{an object of class \code{network}} \item{v}{a vertex ID} \item{type}{the neighborhood to be computed} \item{na.omit}{logical; should missing edges be ignored when obtaining vertex neighborhoods?} } \value{ A vector containing the vertex IDs for the chosen neighborhood. } \description{ \code{get.neighborhood} returns the IDs of all vertices belonging to the in, out, or combined neighborhoods of \code{v} within network \code{x}. } \details{ Note that the combined neighborhood is the union of the in and out neighborhoods -- as such, no vertex will appear twice. } \examples{ #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) #Examine the neighborhood of vertex 1 get.neighborhood(g,1,"out") get.neighborhood(g,1,"in") get.neighborhood(g,1,"combined") } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} Wasserman, S. and Faust, K. 1994. \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. } \seealso{ \code{\link{get.edges}}, \code{\link{is.adjacent}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{graphs} network/man/network.size.Rd0000644000176200001440000000165314723241675015467 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/access.R \name{network.size} \alias{network.size} \title{Return the Size of a Network} \usage{ network.size(x, ...) } \arguments{ \item{x}{an object of class \code{network}} \item{\dots}{additional arguments, not used} } \value{ The network size } \description{ \code{network.size} returns the order of its argument (i.e., number of vertices). } \details{ \code{network.size(x)} is equivalent to \code{get.network.attribute(x,"n")}; the function exists as a convenience. } \examples{ #Initialize a network g<-network.initialize(7) network.size(g) } \references{ Butts, C. T. (2008). \dQuote{network: a Package for Managing Relational Data in R.} \emph{Journal of Statistical Software}, 24(2). \doi{10.18637/jss.v024.i02} } \seealso{ \code{\link{get.network.attribute}} } \author{ Carter T. Butts \email{buttsc@uci.edu} } \keyword{classes} \keyword{graphs} network/DESCRIPTION0000644000176200001440000000411214725552272013462 0ustar liggesusersPackage: network Version: 1.19.0 Date: 2024-12-08 Title: Classes for Relational Data Authors@R: c( person("Carter T.", "Butts", role=c("aut","cre"), email="buttsc@uci.edu"), person("David", "Hunter", role=c("ctb"), email="dhunter@stat.psu.edu"), person("Mark", "Handcock", role=c("ctb"), email="handcock@stat.ucla.edu"), person("Skye", "Bender-deMoll", role=c("ctb"), email="skyebend@uw.edu"), person("Jeffrey", "Horner", role=c("ctb"), email="jeffrey.horner@gmail.com"), person("Li", "Wang", role=c("ctb"), email="lxwang@uw.edu"), person("Pavel N.", "Krivitsky", role=c("ctb"), email="pavel@statnet.org", comment=c(ORCID="0000-0002-9101-3362")), person("Brendan", "Knapp", role=c("ctb"), email="brendan.g.knapp@gmail.com", comment=c(ORCID="0000-0003-3284-4972")), person("Michał", "Bojanowski", role=c("ctb"), email = "michal2992@gmail.com", comment = c(ORCID = "0000-0001-7503-852X")), person("Chad", "Klumb", role=c("ctb"), email="cklumb@gmail.com")) Maintainer: Carter T. Butts Depends: R (>= 2.10), utils Imports: tibble, magrittr, statnet.common (>= 4.5), stats Suggests: sna, testthat, covr Description: Tools to create and modify network objects. The network class can represent a range of relational data types, and supports arbitrary vertex/edge/graph attributes. License: GPL (>= 2) URL: https://statnet.org/ RoxygenNote: 7.3.2.9000 Collate: 'access.R' 'as.edgelist.R' 'assignment.R' 'coercion.R' 'constructors.R' 'dataframe.R' 'fileio.R' 'layout.R' 'misc.R' 'network-package.R' 'operators.R' 'plot.R' 'printsum.R' 'zzz.R' Encoding: UTF-8 NeedsCompilation: yes Packaged: 2024-12-08 22:18:07 UTC; buttsc Author: Carter T. Butts [aut, cre], David Hunter [ctb], Mark Handcock [ctb], Skye Bender-deMoll [ctb], Jeffrey Horner [ctb], Li Wang [ctb], Pavel N. Krivitsky [ctb] (), Brendan Knapp [ctb] (), Michał Bojanowski [ctb] (), Chad Klumb [ctb] Repository: CRAN Date/Publication: 2024-12-09 11:30:02 UTC