Chains

November 7-8, 2014

The STMI partition

The set of vertices of any directed graph G = (V,A) can be partitioned into four subsets:

  • Terminal vertices T = { v ∈ V : (outdeg(v) = 0) ∧ (indeg(v) > 0) }
  • Initial vertices I = { v ∈ V : (indeg(v) = 0) ∧ (outdeg(v) > 0) }
  • interMediate vertices M = { v ∈ V : (outdeg(v) > 0) ∧ (indeg(v) > 0)}
  • iSolated vertices S = { v ∈ V : (outdeg(v) = 0) ∧ (indeg(v) = 0) }

This partition induces a blockmodel

S T M I
S null null null null
T null null null null
M null ? ? null
I null ? ? null

The blocks I ✕ (M ⋃ T) and M ✕ (T ⋃ M) are row-regular and the block (I ⋃ M) ✕ T is column-regular.

Note that in general some clusters (subsets, classes) can be empty.

Determining the STMI partition in Pajek

read network
Network/Create Partition/Degree/Input
Network/Create Partition/Degree/Output
select Indeg partition as Second
Partitions/Add
Partition/Binarize Partition [0]
File/Partition/Relabel [S partition, S=1]
select Outdeg partition
Partition/Binarize Partition [1-*]
select Indeg partition
Partition/Binarize Partition [0]
Partition/Copy to vector
Vector/Transform/Add Constant [1]
Vector/Make Partition/Copy to Partition
Select binarized Outdeg partition as Second
Partitions/Add
select S partition as Second
Partitions/Cover with [0]
File/Partition/Relabel [STMI partition]
remove temporary files

Class numbers: S → 0 / white, T → 1 / yellow, M → 2 / green, I → 3 / red, J → 4 / blue.

The STMIJ partition

The class I can be partitioned further by introducing the class

  • directly linked J = { v ∈ V : ∃u ∈ N+(v) : u ∈ T }
  • indirectly linked I' = I ∖ J

In the following we use I for I'.

S T M I J
S null null null null null
T null null null null null
M null ? ? null null
I null null rre null null
J null rre ? null null

model.svg

The block M ✕ (T ⋃ M) is row-regular and the blocks (J ⋃ M) ✕ T and (M ⋃ I ⋃ J) ✕ M are column-regular. The block M ✕ M can be a null block.

Determining the STMIJ partition in Pajek

We obtain the STMIJ partition from the STMI partition by splitting the class I into classes J and I':

select STMI partition
Partition/Copy to Vector
Operations/Network+Vector/Neighbors/Min/Output [No]
Vector/Make Partition/Copy to Partition
Partition/Binarize Partition [1]
select STMI partition as First
Partition/Binarize Partition [3]
select previous partition as Second
Partitions/Min
select STMI partition as Second
Partitions/Add
File/Partition/Relabel [STMIJ partition]
remove temporary files

lauranet.svg

The STMIJ macro

To avoid entering the above sequences of commands they were put into the STMIJ macro. It is available in stmij.zip. The ZIP file contains the following files:

  • STMIJ.mcr - STMIJ macro code
  • Laura.net - test network file with a network derived from Laura Prota's network ModelC.net by adding 3 isolated vertices and randomly renumbering the set of vertices
  • Laura.ini - Pajek's INI file with settings for reproducing network pictures from this note.

The ZIP file contains some additional files related to random generation of STMIJ partitioned graphs:

  • rndSTMIJ.R - random STMIJ generator function in R
  • testA.net - random network obtained using the generator
  • testA.clu - STMIJ partition

Transforming the STMIJ partition into its blockmodel

select STMIJ partition
Partition/Make Permutation
File/Network/Export Matrix to EPS/Using Permutation and Partition

Transforming in Inkscape the EPS file into SVG we finally get

lauramat.svg

Clicking on the button partition Info we get the sizes of the sets

==============================================================================
11. STMIJ partition (54)
==============================================================================
Dimension: 54
The lowest value:  1
The highest value: 4

Frequency distribution of cluster values:

   Cluster      Freq     Freq%   CumFreq  CumFreq% Representative
 ----------------------------------------------------------------
         1        17   31.4815        17   31.4815         4
         2         8   14.8148        25   46.2963         1
         3        21   38.8889        46   85.1852         2
         4         8   14.8148        54  100.0000        12
 ----------------------------------------------------------------
       Sum        54  100.0000

Using the command

Operations/Network+Partition/Shrink  [1,5]

and double-clicking in the network register field + selecting valued matrix [2] we get the image matrix with number of arcs in each block

         1  2  3  4  Label
-----------------------------
   1.   10  0  9  0  #5
   2.   26  0  0  0  #26
   3.    0  0  0  0  #32
   4.    9  0  8  0  #87

Unfortunately the shrink command does not preserve the class numbers. So we have to identify classes/clusters on the basis of their representatives: 32 ∈ T, 5 ∈ M, 26 ∈ I, 87 ∈ J . In this way we finally get the image matrix:

S T M I J
S 0 0 0 0 0
T 0 0 0 0 0
M 0 9 10 0 0
I 0 0 26 0 0
J 0 8 9 0 0

Drawing by Layers

Using in the drawing window the command

Layers/In y Direction

and some manual repositioning we can get the picture of network by the STMIJ partition classes as layers

levels.svg

Random generation of STMIJ partitioned graphs

Still needs some corrections - (M ⋃ I ⋃ J) ✕ M is column-regular.

# random generator of STMIJ partitioned graphs
# Vladimir Batagelj, November 10, 2014

setwd("C:/Users/batagelj/work/R/BM/laura")
nS <- 3; nT <- 17; nM <- 8; nI <- 21; nJ <- 8
mMT <- 9; mMM <- 10; mIM <- 26; mJT <- 8; mJM <- 9

rndSTMIJ <- function(fnet='test.net',fclu='test.clu',nS=3,nT=17,nM=8,nI=21,nJ=8,
  mMT=9,mMM=10,mIM=26,mJT=8,mJM=9,acyclic=FALSE){

  dice <- function(n=6){return(trunc(n*runif(1,0,1)))}

  rndBlock <- function(fr,lr,fc,lc,m){
    nr <- lr-fr+1; nc <- lc-fc+1
    for (i in 1:m){
      repeat { r <- fr+dice(nr); c <- fc+dice(nc)
        arc <- paste(r,c) 
        if (!exists(arc,env=A,inherits=FALSE)) break 
      }
      assign(arc,0,env=A); cat(arc,'\n',file=net)
    }
  }

  rndRreg <- function(fr,lr,fc,lc,m){
    nr <- lr-fr+1; nc <- lc-fc+1; U <- integer(nc)
    r <- fr:lr; c <- sample(fc:lc,nr,replace=TRUE); U[c-fc+1] <- TRUE
    for(r in 1:nr) {arc <- paste(fr+r-1,c[r]); 
      cat(arc,'\n',file=net); assign(arc,0,env=A)}
    if(m>nr) for(i in 1:(m-nr)){
      repeat { r <- fr+dice(nr); c <- fc+dice(nc)
        arc <- paste(r,c) 
        if (!exists(arc,env=A,inherits=FALSE)) break 
      }
      U[c-fc+1] <- TRUE
      assign(arc,0,env=A); cat(arc,'\n',file=net)
    }
    return(U)
  }

  if(acyclic){if(mMM > nM*(nM-1)/2){cat('nM:mMM inconsistency'); return(NULL)}
  } else {if(mMM > nM*(nM-1)){cat('nM:mMM inconsistency'); return(NULL)}} 
  if(mMT > nM*nT){cat('nM:nT:mMT inconsistency'); return(NULL)} 
  if(mIM > nI*nM){cat('nI:nM:mIM inconsistency'); return(NULL)} 
  if(mJT > nJ*nT){cat('nJ:nT:mJT inconsistency'); return(NULL)} 
  if(mJM > nJ*nM){cat('nJ:nM:mJM inconsistency'); return(NULL)} 
  if(mIM < nI){cat('nI:mIM inconsistency'); return(NULL)} 
  if(mJT < nJ){cat('nJ:mJT inconsistency'); return(NULL)} 
  if(mMM+mMT < nM){cat('nM:mMM:mMT inconsistency'); return(NULL)} 
  if(mJT+mMT < nT){cat('nT:mJT:mMT inconsistency'); return(NULL)} 
  
  sS <- 1; sT <- sS+nS; sM <- sT+nT; sI <- sM+nM; sJ <- sI+nI; n <- sJ+nJ-1

  P <- c(rep(0,nS),rep(1,nT),rep(2,nM),rep(3,nI),rep(4,nJ))
  clu <- file(fclu,"w")
  cat('% random STMIJ directed graph partition',date(),'\n',file=clu)
  cat("*vertices",n,"\n",file=clu); for(p in P) cat(p,'\n',file=clu)
  close(clu)

  net <- file(fnet,"w")
  cat('% random STMIJ directed graph ',date(),'\n',file=net)
  cat("*vertices",n,"\n",file=net); k <- 0
  if(nS>0) for(i in 1:nS) {k<-k+1; cat(k,' "S',i,'"\n',sep='',file=net)}
  if(nT>0) for(i in 1:nT) {k<-k+1; cat(k,' "T',i,'"\n',sep='',file=net)}
  if(nM>0) for(i in 1:nM) {k<-k+1; cat(k,' "M',i,'"\n',sep='',file=net)}
  if(nI>0) for(i in 1:nI) {k<-k+1; cat(k,' "I',i,'"\n',sep='',file=net)}
  if(nJ>0) for(i in 1:nJ) {k<-k+1; cat(k,' "J',i,'"\n',sep='',file=net)}
  cat("*arcs\n",file=net); A <- new.env(hash=TRUE,parent=emptyenv())
# MM
  R <- logical(nM)
  for (i in 1:mMM){
    repeat { u <- sM+dice(nM); v <- sM+dice(nM)
      if (u!=v) {
        r <- u; c <- v
        if(acyclic) if (u<v) {r <- v; c <- u}
        arc <- paste(r,c) 
        if (!exists(arc,env=A,inherits=FALSE)) break }
    }
    R[r-sM+1] <- TRUE
    assign(arc,0,env=A); cat(arc,'\n',file=net)
  }
  M <- (sM:(sI-1))[!R]
# IM
  U <- rndRreg(sI,sJ-1,sM,sI-1,mIM)
# JT
  V <- rndRreg(sJ,n   ,sT,sM-1,mJT)
  T <- (sT:(sM-1))[!V]
# MT
  km <- length(M); kt <- length(T) 
  if(km>kt) {
    if(kt>0){
      c <- T; r <- sample(M,kt,replace=FALSE); R[r-sM+1] <- TRUE
      for(i in 1:length(c)) {arc <- paste(r[i],c[i]);
        cat(arc,'\n',file=net); assign(arc,0,env=A)}
      M <- (sM:(sI-1))[!R]
    }
    r <- M; c <- sample(sT:(sM-1),km-kt,replace=TRUE)
    for(i in 1:length(r)) {arc <- paste(r[i],c[i]);
      cat(arc,'\n',file=net); assign(arc,0,env=A)}
    rndBlock(sM,sI-1,sT,sM-1,mMT-km)    
  } else { # kt >= km
    if(km>0){
      r <- M; c <- sample(T,km,replace=FALSE); V[c-sT+1] <- TRUE
      for(i in 1:length(r)) {arc <- paste(r[i],c[i]);
        cat(arc,'\n',file=net); assign(arc,0,env=A)}
      T <- (sT:(sM-1))[!V]
    }
    c <- T; r <- sample(sM:(sI-1),kt-km,replace=TRUE)
    for(i in 1:length(c)) {arc <- paste(r[i],c[i]);
      cat(arc,'\n',file=net); assign(arc,0,env=A)}
    rndBlock(sM,sI-1,sT,sM-1,mMT-kt)    
  }
# JM
  rndBlock(sJ,n   ,sM,sI-1,mJM)

  close(net); return(A)
}

Requesting

> source("C:\\Users\\batagelj\\work\\R\\BM\\laura\\rndSTMIJ.R")
> Arcs <- rndSTMIJ('testC.net','testC.clu',acyclic=FALSE)
> ls(Arcs)
 [1] "21 20" "21 23" "21 24" "21 28" "21 6"  "22 12" "22 24" "22 27" "23 10"
[10] "23 14" "23 17" "24 15" "24 21" "25 13" "25 21" "26 23" "26 27" "26 6" 
[19] "27 11" "27 16" "27 17" "27 5"  "28 24" "29 24" "29 26" "30 28" "31 24"
[28] "32 23" "33 25" "34 21" "34 22" "35 21" "36 25" "37 21" "37 25" "38 22"
[37] "39 22" "40 26" "41 28" "42 21" "43 22" "44 23" "44 24" "45 28" "46 27"
[46] "47 23" "47 26" "48 28" "49 22" "50 19" "51 24" "51 27" "51 8"  "52 23"
[55] "52 27" "52 9"  "53 22" "53 7"  "54 18" "54 21" "55 12" "55 23" "55 27"
[64] "56 27" "56 4"  "57 18"
> length(Arcs)
[1] 66
> 

we get a random STMIJ network presented with a picture

testc.svg

and a matrix

testcmat.svg

Attaching new nodes

An alternative strategy for generating the MM subnetwork is to give higher probability to link a not yet used node - to select as initial node an old (already linked node) with probability pb (0.0 - 0.3) and the terminal node randomly:

# MM 15. December 2014 
  R <- logical(nM); V <- sM:(sM+nM); k <- 0
  for(t in 1:mMM){
    repeat {  
      ru <- rndNodeM(pb); iu <- ru$ind
      iv <- 1+dice(nM); vnov <- iv > k
      if (iu!=iv) {
        r <- V[iu]; c <- V[iv]
        if(acyclic) if (c<r) {r <- V[iv]; c <- V[iu]}
        arc <- paste(r,c) 
        if (!exists(arc,env=A,inherits=FALSE)) break }
    }
    R[r-sM+1] <- TRUE
    assign(arc,0,env=A); cat(arc,'\n',file=net)
    if(ru$nov) {k <- k+1; z <- V[k]; V[k] <- V[iu]; V[iu] <- z}
    if(vnov) {k <- k+1; z <- V[k]; V[k] <- V[iv]; V[iv] <- z}
  }
  M <- (sM:(sI-1))[!R]

Structure of the M✕M block

Reading Pajek file into R

The compact graph representation lab[1:n], base[1:n+1], N[1:m] is used. The set of neighbors of node v N(v) = N[first:last], where first = base[v]+1 and last = base[v+1] and first < last:

> # Pisa / ERCIM 2014; 8. dec 2014
> setwd("C:/Users/batagelj/work/R/BM/laura")
>
> readPajek <- function(fname){
+   net <- file(fname,"r")
+   repeat { L <- readLines(net,n=1); if(substr(L,1,1)=="*") break }
+   S <- unlist(strsplit(L,"[[:space:]]+"))
+   n <- as.integer(S[2])
+   L <- read.table(net,nrows=n); lab <- as.character(L$V2)
+   S <- readLines(net,n=1); S <- read.table(net)
+   close(net)
+   T <- S[order(S$V1,S$V2),]; m <- nrow(T)
+   base <- integer(n+1); base[1] <- 0; v <- 1
+   for(k in 1:m){while(v < T$V1[k]){v <- v+1; base[v] <- k-1}}
+   while(v < n+1){v <- v+1; base[v] <- m} 
+   return(list(lab=lab,base=base,N=T$V2))
+ }
> G <- readPajek('testC.net')
> G$lab
 [1] "S1"  "S2"  "S3"  "T1"  "T2"  "T3"  "T4"  "T5"  "T6"  "T7"  "T8"  "T9" 
[13] "T10" "T11" "T12" "T13" "T14" "T15" "T16" "T17" "M1"  "M2"  "M3"  "M4" 
[25] "M5"  "M6"  "M7"  "M8"  "I1"  "I2"  "I3"  "I4"  "I5"  "I6"  "I7"  "I8" 
[37] "I9"  "I10" "I11" "I12" "I13" "I14" "I15" "I16" "I17" "I18" "I19" "I20"
[49] "I21" "J1"  "J2"  "J3"  "J4"  "J5"  "J6"  "J7"  "J8" 
> G$base
 [1]  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  5  8 11 13
[26] 15 18 22 23 25 26 27 28 29 31 32 33 35 36 37 38 39 40 41 43 44 45 47 48 49
[51] 50 53 56 58 60 63 65 66
> G$N
 [1]  6 20 23 24 28 12 24 27 10 14 17 15 21 13 21  6 23 27  5 11 16 17 24 24 26
[26] 28 24 23 25 21 22 21 25 21 25 22 22 26 28 21 22 23 24 28 27 23 26 28 22 19
[51]  8 24 27  9 23 27  7 22 18 21 12 23 27  4 27 18
> 

Snow ball

snowBall(G,seeds,probs,depth,getNext)

The networks obtained using the random generation procedure rndSTMIJ are directed - not strongly connected. If you need in the snow ball strongly connected networks symmetrize the obtained networks in Pajek.

Queue data structure

In the implementation of the snowBall function we will use a queue data structure (implemented as a circular buffer):

createQ <- function(n){
  Q <<- integer(n); qFirst <<- 1; qLast <<- n; nQ <<- 0; qLen <<- n }

addTail <- function(v){
  qLast <<- qLast+1; if(qLast > qLen) qLast <<- 1
  Q[qLast] <<- v; nQ <<- nQ+1 }

addHead <- function(v){
  qFirst <<- qFirst-1; if(qFirst < 1) qFirst <<- qLen
  Q[qFirst] <<- v; nQ <<- nQ+1 }

getHead <- function(){
  if(nQ <= 0) stop("Empty queue")
  v <- Q[qFirst]; nQ <<- nQ-1
  qFirst <<- qFirst+1; if(qFirst > qLen) qFirst <<- 1
  return(v) }

getRandom <- function(){
  if(nQ <= 0) stop("Empty queue")
  i <- qFirst+trunc(nQ*runif(1)); if(i > qLen) i <- i-qLen
  v <- Q[i]; Q[i] <<- Q[qFirst]; nQ <<- nQ-1
  qFirst <<- qFirst+1; if(qFirst > qLen) qFirst <<- 1
  return(v) }

getTail <- function(){
  if(nQ <= 0) stop("Empty queue")
  v <- Q[qLast]; nQ <<- nQ-1
  qLast <<- qLast-1; if(qLast < 1) qLast <<- qLen
  return(v) }

SnowBall

The parameters of the snowBall procedure are:

  • G - a graph obtained using readPajek;
  • seeds - a vector containing the seed nodes from which the snowball procedure starts;
  • p - a vector of probabilities that a node will be “infected” (is accepted into the sample);
  • h - positive integer limiting the depth of the snowball procedure;
  • getNext - search strategy: getHead - breath first; getTail - depth first; getRandom - random search.
snowBall <- function(G,seeds,p,h,getNext){
  n <- length(G$lab); infected <- integer(n); height <- rep(-1,n)
  infected[seeds] <- 1; height[seeds] <- 0; createQ(n)
  for(v in seeds) addTail(v)
  while(nQ > 0){
    v <- getNext(); s <- G$base[v]+1; f <- G$base[v+1]
    if(s <= f) for(e in s:f){
      u <- G$N[e]
      if(!infected[u]) if(runif(1) < p[u]){
        infected[u] <- 1; height[u] <- height[v]+1
        if(height[u] < h) addTail(u)
  } } }
  return(list(infect=infected,height=height))
}

The procedure snawBall returns a list of two vectors:

  • infect - a binary vector - selected nodes have value 1;
  • height - an integer vector - distance (number of steps) of a node from a seed node (source of infection)

Test runs:

> G <- readPajek('testC.net')
> n <- length(G$lab); p <- rep(0.5,n); seeds <- c(23,35,46,52)
> R1 <- snowBall(G,seeds,p,5,getHead)
> R1$infect
 [1] 0 0 0 0 0 1 0 0 0 1 0 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0
[39] 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0
> R1$height
 [1] -1 -1 -1 -1 -1  2 -1 -1 -1  2 -1 -1 -1  2  1 -1 -1 -1 -1 -1 -1  1  0 -1  1
[26] -1 -1 -1 -1 -1 -1 -1 -1 -1  0 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1  0 -1 -1 -1 -1
[51] -1  0 -1 -1 -1 -1 -1
> R2 <- snowBall(G,seeds,p,5,getRandom)
> R2$infect
 [1] 0 0 0 0 0 1 1 0 0 0 1 1 0 0 1 0 1 0 0 0 1 1 1 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0
[39] 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0
> R2$height
 [1] -1 -1 -1 -1 -1  2  1 -1 -1 -1  2  2 -1 -1  1 -1  2 -1 -1 -1  1  1  0 -1  1
[26]  1  2 -1 -1 -1 -1 -1 -1 -1  0 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1  0 -1 -1 -1 -1
[51] -1  0 -1 -1 -1 -1 -1
> p <- rep(1,n)
> R3 <- snowBall(G,seeds,p,5,getTail)
> R3$infect
 [1] 0 0 0 0 1 1 1 0 0 1 1 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 1 0 0 0
[39] 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0
> R3$height
 [1] -1 -1 -1 -1  2  2  1 -1 -1  2  2  5  4  2  1  2  2 -1 -1 -1  4  1  0  3  1
[26]  1  2 -1 -1 -1 -1 -1 -1 -1  0 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1  0 -1 -1 -1 -1
[51] -1  0 -1 -1 -1 -1 -1

Saving results as Pajek's partitions

To save the obtained results as Pajek's partitions we can use the procedure:

cluSave <- function(fname,C){
  n <- length(C); clu <- file(fname,"w")
  cat('*vertices ',n,'\n',sep='',file=clu)
  for(v in 1:n) cat(C[v],'\n',sep='',file=clu)
  close(clu)
}

For example

> cluSave("R3selected.clu",R3$infect)
> D <- R3$height; D[D==-1] <- 9999
> cluSave("R3depth.clu",D)

In Pajek we can then extract the subnetwork determined by the selected sample nodes, draw it, …

SnowBall with source information

If needed we can get also the information about the “source of infection” - a seed node that started the infection that infected a given node. In this case we add to the snowBall procedure another result partition source:

snowBall <- function(G,seeds,p,h,getNext){
  n <- length(G$lab); infected <- integer(n); height <- rep(-1,n)
  infected[seeds] <- 1; height[seeds] <- 0; createQ(n)
  source <- integer(n); source[seeds] <- 1:length(seeds)
  for(v in seeds) addTail(v)
  while(nQ > 0){
    v <- getNext(); s <- G$base[v]+1; f <- G$base[v+1]
    if(s <= f) for(e in s:f){
      u <- G$N[e]
      if(!infected[u]) if(runif(1) < p[u]){
        infected[u] <- 1; height[u] <- height[v]+1
        source[u] <- source[v]; if(height[u] < h) addTail(u)
  } } }
  return(list(infect=infected,height=height,source=source))
}

A test run:

> R <- snowBall(G,seeds,p,5,getTail)
> R$infect
 [1] 0 0 0 0 1 1 1 0 0 1 1 1 1 1 1 1 1 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 0 1 0 0 0
[39] 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0
> R$height
 [1] -1 -1 -1 -1  2  2  1 -1 -1  2  2  5  4  2  1  2  2 -1 -1 -1  4  1  0  3  1
[26]  1  2 -1 -1 -1 -1 -1 -1 -1  0 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1  0 -1 -1 -1 -1
[51] -1  0 -1 -1 -1 -1 -1
> R$source
 [1] 0 0 0 0 3 2 4 0 0 4 3 2 2 4 1 3 4 0 0 0 2 4 1 2 2 3 2 0 0 0 0 0 0 0 2 0 0 0
[39] 0 0 0 0 0 0 0 3 0 0 0 0 0 4 0 0 0 0 0

Symmetrizing the network

Ljubljana, 13. December 2014

symmetrize <- function(G){
  n <- length(G$base)-1; B <- integer(length(G$N))
  for(v in 1:n){ s <- G$base[v]+1; f <- G$base[v+1]; if(s <= f) B[s:f] <- v }
  T <- unique(cbind(c(B,G$N),c(G$N,B))); T <- T[order(T[,1],T[,2]),] 
  m <- nrow(T); base <- integer(n+1); base[1] <- 0; v <- 1
  for(k in 1:m){while(v < T[k,1]){v <- v+1; base[v] <- k-1}}
  while(v < n+1){v <- v+1; base[v] <- m}
  return(list(lab=G$lab,base=base,N=T[,2]))
}

Starting with the network small.net

*vertices 4
 1 "a"
 2 "b"
 3 "c"
 4 "d"
*arcs
 1 2
 1 4
 3 2
 3 4
 4 2
 4 3

we get

> A <- readPajek("small.net")
> A$lab
[1] "a" "b" "c" "d"
> A$base
[1] 0 2 2 4 6
> A$N
[1] 2 4 2 4 2 3

The arcs in its symmetrized version are:

> T
      [,1] [,2]
 [1,]    1    2
 [2,]    1    4
 [3,]    2    1
 [4,]    2    3
 [5,]    2    4
 [6,]    3    2
 [7,]    3    4
 [8,]    4    1
 [9,]    4    2
[10,]    4    3

or in our compact representation

> S <- symmetrize(A)
> S$lab
[1] "a" "b" "c" "d"
> S$base
[1]  0  2  5  7 10
> S$N
 [1] 2 4 1 3 4 2 4 1 2 3

Application:

> G <- readPajek('testC.net')
> n <- length(G$lab); p <- rep(1,n); seeds <- c(23,35,46,52)
> R <- snowBall(symmetrize(G),seeds,p,5,getRandom)
> R$infect
 [1] 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[39] 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1
> R$height
 [1] -1 -1 -1  3  2  2  4  3  1  1  2  2  3  1  3  2  1  3 -1  2  1  2  0  2  2
[26]  1  1  2  3  3  3  1  3  2  0  3  2  3  3  2  3  2  3  1  3  0  1  3  3 -1
[51]  2  0  3  2  1  2  4
> R$source
 [1] 0 0 0 4 4 2 4 4 4 1 4 1 2 1 1 4 1 2 0 2 2 4 1 1 2 1 4 2 1 2 1 1 2 2 2 2 2 4
[39] 4 1 2 2 4 1 2 3 1 2 4 0 4 4 4 2 1 4 2
notes/chain.txt · Last modified: 2015/07/16 21:10 by vlado
 
Except where otherwise noted, content on this wiki is licensed under the following license: CC Attribution-Noncommercial-Share Alike 3.0 Unported
Recent changes RSS feed Donate Powered by PHP Valid XHTML 1.0 Valid CSS Driven by DokuWiki