Introduction

Before start, a recapt of concepts that we will be using here

  1. Exposure: What proportion/number of your neighbors has adopted an innovation.
  2. Threshold: What was the proportion/number of your neighbors had adopted by the time you adopted.
  3. Infectiousness: How much \(i\)’s adoption affects her alters
  4. Susceptibility: How much \(i\)’s alters’ adoption affects her.
  5. Structural equivalence: How similar are \(i\) and \(j\) in terms of position on the network.

Simulating diffusion networks

We will simulate a diffusion network with the following parameters:

  1. Will have 1,000 vertices,
  2. Will span 20 time periods,
  3. The set of early adopters will be random,
  4. Early adopters will be a 10% of the network,
  5. The graph will be small-world,
  6. Will use the WS algorithmwith \(p=.2\) (probability of rewire).
  7. Threshold levels will be uniformly distributed between [0.3, 0.7]

To generate such diffusion network we can use the rdiffnet function included in the package:

# Setting the seed for the RNG
set.seed(1213)

# Generating a random diffusion network
net <- rdiffnet(
  n              = 1e3,                         # 1.
  t              = 20,                          # 2.
  seed.nodes     = "random",                    # 3.
  seed.p.adopt   = .1,                          # 4.
  seed.graph     = "small-world",               # 5.
  rgraph.args    = list(p=.2),                  # 6.
  threshold.dist = function(x) runif(1, .3, .7) # 7.
  )
  • The function rdiffnet generates random diffusion networks. Main features:

    1. Simulating random graph or using your own,

    2. Setting threshold levels per node,

    3. Network rewiring throughout the simulation, and

    4. Setting the seed nodes.

  • The simulation algorithm is as follows:

    1. If required, a baseline graph is created,

    2. Set of initial adopters and threshold is established,

    3. Se set of t networks is created (if required), and

    4. Simulation starts at t=2, assigning adopters based on exposures and thresholds:

      1. For each \(i \in N\), if its exposure at \(t-1\) is greater than its threshold, then adopts, otherwise continue without change.

      2. next \(i\)

Disease spreading

library(netdiffuseR)

set.seed(09)
diffnet_disease <- rdiffnet(
  n = 5e2,
  t = 5, 
  seed.graph = "small-world",
  rgraph.args = list(k = 4, p = .3),
  seed.nodes = "random",
  seed.p.adopt = .05,
  rewire = TRUE,
  threshold.dist = function(i) 1L,
  exposure.args = list(normalized = FALSE)
  )
summary(diffnet_disease)
# Diffusion network summary statistics
# Name     : A diffusion network
# Behavior : Random contagion
# -----------------------------------------------------------------------------
#  Period   Adopters   Cum Adopt. (%)   Hazard Rate   Density   Moran's I (sd)  
# -------- ---------- ---------------- ------------- --------- ---------------- 
#        1         25        25 (0.05)             -      0.01 -0.00 (0.00)     
#        2        100       125 (0.25)          0.21      0.01  0.01 (0.00) *** 
#        3        228       353 (0.71)          0.61      0.01  0.01 (0.00) *** 
#        4        141       494 (0.99)          0.96      0.01  0.00 (0.00) *** 
#        5          6       500 (1.00)          1.00      0.01               -  
# -----------------------------------------------------------------------------
#  Left censoring  : 0.05 (25)
#  Right centoring : 0.00 (0)
#  # of nodes      : 500
# 
#  Moran's I was computed on contemporaneous autocorrelation using 1/geodesic
#  values. Significane levels  *** <= .01, ** <= .05, * <= .1.
plot_diffnet(diffnet_disease, slices = c(1, 3, 5))

# We want to use igraph to compute layout
igdf <- diffnet_to_igraph(diffnet_disease, slices=c(1,2))[[1]]
pos <- igraph::layout_with_drl(igdf)

plot_diffnet2(diffnet_disease, vertex.size = dgr(diffnet_disease)[,1], layout=pos)

Complex contagion

set.seed(09)
diffnet_complex <- rdiffnet(
  seed.graph = diffnet_disease$graph,
  seed.nodes = which(diffnet_disease$toa == 1),
  rewire = FALSE,
  threshold.dist = function(i) rbeta(1, 3, 10),
  name = "Complex Sim",
  behavior = "More complex than contact"
)
plot_adopters(diffnet_disease, what = "cumadopt", include.legend = FALSE)
plot_adopters(diffnet_complex, bg="tomato", add=TRUE, what = "cumadopt")
legend("topleft", legend = c("Disease", "Complex"), col = c("lightblue", "tomato"),
       bty = "n", pch=19)

Mentor Matching

# Finding mentors
mentors <- mentor_matching(diffnet_disease, 25, lead.ties.method = "random")

# Simulating diffusion with these mentors
set.seed(09)
diffnet_mentored <- rdiffnet(
  seed.graph = diffnet_complex,
  seed.nodes = which(mentors$`1`$isleader),
  rewire = FALSE,
  threshold.dist = diffnet_complex[["real_threshold"]],
  name = "Diffusion using Mentors"
)

summary(diffnet_mentored)
# Diffusion network summary statistics
# Name     : Diffusion using Mentors
# Behavior : Random contagion
# -----------------------------------------------------------------------------
#  Period   Adopters   Cum Adopt. (%)   Hazard Rate   Density   Moran's I (sd)  
# -------- ---------- ---------------- ------------- --------- ---------------- 
#        1         25        25 (0.05)             -      0.01 -0.00 (0.00)     
#        2         92       117 (0.23)          0.19      0.01  0.01 (0.00) *** 
#        3        152       269 (0.54)          0.40      0.01  0.01 (0.00) *** 
#        4        150       419 (0.84)          0.65      0.01  0.01 (0.00) *** 
#        5         73       492 (0.98)          0.90      0.01 -0.00 (0.00) **  
# -----------------------------------------------------------------------------
#  Left censoring  : 0.05 (25)
#  Right centoring : 0.02 (8)
#  # of nodes      : 500
# 
#  Moran's I was computed on contemporaneous autocorrelation using 1/geodesic
#  values. Significane levels  *** <= .01, ** <= .05, * <= .1.
cumulative_adopt_count(diffnet_complex)
#          1      2          3           4           5
# num  25.00 88.000 229.000000 395.0000000 485.0000000
# prop  0.05  0.176   0.458000   0.7900000   0.9700000
# rate  0.00  2.520   1.602273   0.7248908   0.2278481
cumulative_adopt_count(diffnet_mentored)
#          1       2          3           4           5
# num  25.00 117.000 269.000000 419.0000000 492.0000000
# prop  0.05   0.234   0.538000   0.8380000   0.9840000
# rate  0.00   3.680   1.299145   0.5576208   0.1742243

Example by changing threshold


# Simulating a scale-free homophilic network
set.seed(1231)
X <- rep(c(1,1,1,1,1,0,0,0,0,0), 50)
net <- rgraph_ba(t = 499, m=4, eta = X)

# Taking a look in igraph
ig  <- igraph::graph_from_adjacency_matrix(net)
plot(ig, vertex.color = c("azure", "tomato")[X+1], vertex.label = NA,
     vertex.size = sqrt(dgr(net)))


# Now, simulating a bunch of diffusion processes
nsim <- 500L
ans_1and2 <- vector("list", nsim)
set.seed(223)
for (i in 1:nsim) {
  # We just want the cum adopt count
  ans_1and2[[i]] <- 
    cumulative_adopt_count(
      rdiffnet(
        seed.graph = net,
        t = 10,
        threshold.dist = sample(1:2, 500L, TRUE),
        seed.nodes = "random",
        seed.p.adopt = .10,
        exposure.args = list(outgoing = FALSE, normalized = FALSE),
        rewire = FALSE
        )
      )
  
  # Are we there yet?
  if (!(i %% 50))
    message("Simulation ", i," of ", nsim, " done.")
}
# Simulation 50 of 500 done.
# Simulation 100 of 500 done.
# Simulation 150 of 500 done.
# Simulation 200 of 500 done.
# Simulation 250 of 500 done.
# Simulation 300 of 500 done.
# Simulation 350 of 500 done.
# Simulation 400 of 500 done.
# Simulation 450 of 500 done.
# Simulation 500 of 500 done.

# Extracting prop
ans_1and2 <- do.call(rbind, lapply(ans_1and2, "[", i="prop", j=))

ans_2and3 <- vector("list", nsim)
set.seed(223)
for (i in 1:nsim) {
  # We just want the cum adopt count
  ans_2and3[[i]] <- 
    cumulative_adopt_count(
      rdiffnet(
        seed.graph = net,
        t = 10,
        threshold.dist = sample(2:3, 500L, TRUE),
        seed.nodes = "random",
        seed.p.adopt = .10,
        exposure.args = list(outgoing = FALSE, normalized = FALSE),
        rewire = FALSE
        )
      )
  
  # Are we there yet?
  if (!(i %% 50))
    message("Simulation ", i," of ", nsim, " done.")
}
# Simulation 50 of 500 done.
# Simulation 100 of 500 done.
# Simulation 150 of 500 done.
# Simulation 200 of 500 done.
# Simulation 250 of 500 done.
# Simulation 300 of 500 done.
# Simulation 350 of 500 done.
# Simulation 400 of 500 done.
# Simulation 450 of 500 done.
# Simulation 500 of 500 done.

ans_2and3 <- do.call(rbind, lapply(ans_2and3, "[", i="prop", j=))
boxplot(ans_1and2, col="ivory")
boxplot(ans_2and3, col="tomato", add=TRUE)

  • Example simulating a thousand networks by changing threshold levels. The final prevalence, or hazard as a function of threshold levels.

Problems

  1. Given the following types of networks: Small-world, Scale-free, Bernoulli, what set of \(n\) initiators maximizes diffusion?
LS0tCnRpdGxlOiAiU2ltdWxhdGlvbiBvZiBkaWZmdXNpb24gbmV0d29ya3M6IHJkaWZmbmV0IgphdXRob3I6ICJUaG9tYXMgVy4gVmFsZW50ZSBhbmQgR2VvcmdlIEcuIFZlZ2EgWW9uIgotLS0KCmBgYHtyIHNldHVwLCBlY2hvPUZBTFNFLCBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQpsaWJyYXJ5KG5ldGRpZmZ1c2VSKQprbml0cjo6b3B0c19jaHVuayRzZXQoY29tbWVudCA9ICIjIikKCmBgYAoKIyBJbnRyb2R1Y3Rpb24KCkJlZm9yZSBzdGFydCwgYSByZWNhcHQgb2YgY29uY2VwdHMgdGhhdCB3ZSB3aWxsIGJlIHVzaW5nIGhlcmUKCjEuIEV4cG9zdXJlOiBXaGF0IHByb3BvcnRpb24vbnVtYmVyIG9mIHlvdXIgbmVpZ2hib3JzIGhhcyBhZG9wdGVkIGFuIGlubm92YXRpb24uCjIuIFRocmVzaG9sZDogV2hhdCB3YXMgdGhlIHByb3BvcnRpb24vbnVtYmVyIG9mIHlvdXIgbmVpZ2hib3JzIGhhZCBhZG9wdGVkIGJ5IHRoZSB0aW1lIHlvdSBhZG9wdGVkLgozLiBJbmZlY3Rpb3VzbmVzczogSG93IG11Y2ggJGkkJ3MgYWRvcHRpb24gYWZmZWN0cyBoZXIgYWx0ZXJzCjQuIFN1c2NlcHRpYmlsaXR5OiBIb3cgbXVjaCAkaSQncyBhbHRlcnMnIGFkb3B0aW9uIGFmZmVjdHMgaGVyLgo1LiBTdHJ1Y3R1cmFsIGVxdWl2YWxlbmNlOiBIb3cgc2ltaWxhciBhcmUgJGkkIGFuZCAkaiQgaW4gdGVybXMgb2YgcG9zaXRpb24gb24gdGhlIG5ldHdvcmsuCgojIFNpbXVsYXRpbmcgZGlmZnVzaW9uIG5ldHdvcmtzCgpXZSB3aWxsIHNpbXVsYXRlIGEgZGlmZnVzaW9uIG5ldHdvcmsgd2l0aCB0aGUgZm9sbG93aW5nIHBhcmFtZXRlcnM6CgoxLiAgV2lsbCBoYXZlIDEsMDAwIHZlcnRpY2VzLAoyLiAgV2lsbCBzcGFuIDIwIHRpbWUgcGVyaW9kcywKMy4gIFRoZSBzZXQgb2YgZWFybHkgYWRvcHRlcnMgd2lsbCBiZSByYW5kb20sCjQuICBFYXJseSBhZG9wdGVycyB3aWxsIGJlIGEgMTBcJSBvZiB0aGUgbmV0d29yaywKNS4gIFRoZSBncmFwaCB3aWxsIGJlIHNtYWxsLXdvcmxkLAo2LiAgV2lsbCB1c2UgdGhlIFdTIGFsZ29yaXRobXdpdGggJHA9LjIkIChwcm9iYWJpbGl0eSBvZiByZXdpcmUpLgo3LiAgVGhyZXNob2xkIGxldmVscyB3aWxsIGJlIHVuaWZvcm1seSBkaXN0cmlidXRlZCBiZXR3ZWVuIFswLjMsIDAuN1xdCgpUbyBnZW5lcmF0ZSBzdWNoIGRpZmZ1c2lvbiBuZXR3b3JrIHdlIGNhbiB1c2UgdGhlIGByZGlmZm5ldGAgZnVuY3Rpb24gaW5jbHVkZWQgaW4gdGhlIHBhY2thZ2U6CgoKYGBge3IgR2VuZXJhdGluZyB0aGUgcmFuZG9tIGdyYXBofQojIFNldHRpbmcgdGhlIHNlZWQgZm9yIHRoZSBSTkcKc2V0LnNlZWQoMTIxMykKCiMgR2VuZXJhdGluZyBhIHJhbmRvbSBkaWZmdXNpb24gbmV0d29yawpuZXQgPC0gcmRpZmZuZXQoCiAgbiAgICAgICAgICAgICAgPSAxZTMsICAgICAgICAgICAgICAgICAgICAgICAgICMgMS4KICB0ICAgICAgICAgICAgICA9IDIwLCAgICAgICAgICAgICAgICAgICAgICAgICAgIyAyLgogIHNlZWQubm9kZXMgICAgID0gInJhbmRvbSIsICAgICAgICAgICAgICAgICAgICAjIDMuCiAgc2VlZC5wLmFkb3B0ICAgPSAuMSwgICAgICAgICAgICAgICAgICAgICAgICAgICMgNC4KICBzZWVkLmdyYXBoICAgICA9ICJzbWFsbC13b3JsZCIsICAgICAgICAgICAgICAgIyA1LgogIHJncmFwaC5hcmdzICAgID0gbGlzdChwPS4yKSwgICAgICAgICAgICAgICAgICAjIDYuCiAgdGhyZXNob2xkLmRpc3QgPSBmdW5jdGlvbih4KSBydW5pZigxLCAuMywgLjcpICMgNy4KICApCmBgYAoKCiogICBUaGUgZnVuY3Rpb24gYHJkaWZmbmV0YCBnZW5lcmF0ZXMgcmFuZG9tIGRpZmZ1c2lvbiBuZXR3b3Jrcy4gTWFpbiBmZWF0dXJlczoKICAgIAogICAgMS4gIFNpbXVsYXRpbmcgcmFuZG9tIGdyYXBoIG9yIHVzaW5nIHlvdXIgb3duLAogICAgCiAgICAyLiAgU2V0dGluZyB0aHJlc2hvbGQgbGV2ZWxzIHBlciBub2RlLAogICAgCiAgICAzLiAgTmV0d29yayByZXdpcmluZyB0aHJvdWdob3V0IHRoZSBzaW11bGF0aW9uLCBhbmQKICAgIAogICAgNC4gIFNldHRpbmcgdGhlIHNlZWQgbm9kZXMuCiAgICAKICAgIAoqICAgVGhlIHNpbXVsYXRpb24gYWxnb3JpdGhtIGlzIGFzIGZvbGxvd3M6CiAgICAKICAgIDEuICBJZiByZXF1aXJlZCwgYSBiYXNlbGluZSBncmFwaCBpcyBjcmVhdGVkLAogICAgCiAgICAyLiAgU2V0IG9mIGluaXRpYWwgYWRvcHRlcnMgYW5kIHRocmVzaG9sZCBpcyBlc3RhYmxpc2hlZCwKICAgIAogICAgMy4gIFNlIHNldCBvZiB0IG5ldHdvcmtzIGlzIGNyZWF0ZWQgKGlmIHJlcXVpcmVkKSwgYW5kCiAgICAKICAgIDQuICBTaW11bGF0aW9uIHN0YXJ0cyBhdCB0PTIsIGFzc2lnbmluZyBhZG9wdGVycyBiYXNlZCBvbiBleHBvc3VyZXMgYW5kIHRocmVzaG9sZHM6CiAgICAKICAgICAgICBhLiAgRm9yIGVhY2ggJGkgXGluIE4kLCBpZiBpdHMgZXhwb3N1cmUgYXQgJHQtMSQgaXMgZ3JlYXRlciB0aGFuIGl0cyB0aHJlc2hvbGQsIHRoZW4gCiAgICAgICAgICAgIGFkb3B0cywgb3RoZXJ3aXNlIGNvbnRpbnVlIHdpdGhvdXQgY2hhbmdlLgogICAgICAgICAgICAKICAgICAgICBiLiAgbmV4dCAkaSQKICAgIAojIERpc2Vhc2Ugc3ByZWFkaW5nCgpgYGB7ciBzaW0tZGlzZWFzZX0KbGlicmFyeShuZXRkaWZmdXNlUikKCnNldC5zZWVkKDA5KQpkaWZmbmV0X2Rpc2Vhc2UgPC0gcmRpZmZuZXQoCiAgbiA9IDVlMiwKICB0ID0gNSwgCiAgc2VlZC5ncmFwaCA9ICJzbWFsbC13b3JsZCIsCiAgcmdyYXBoLmFyZ3MgPSBsaXN0KGsgPSA0LCBwID0gLjMpLAogIHNlZWQubm9kZXMgPSAicmFuZG9tIiwKICBzZWVkLnAuYWRvcHQgPSAuMDUsCiAgcmV3aXJlID0gVFJVRSwKICB0aHJlc2hvbGQuZGlzdCA9IGZ1bmN0aW9uKGkpIDFMLAogIGV4cG9zdXJlLmFyZ3MgPSBsaXN0KG5vcm1hbGl6ZWQgPSBGQUxTRSkKICApCmBgYAoKYGBge3Igc3VtbWFyeS1kaXNlYXNlfQpzdW1tYXJ5KGRpZmZuZXRfZGlzZWFzZSkKYGBgCgoKYGBge3IgcGxvdC1kaXNlYXNlLCBmaWcuYWxpZ249J2NlbnRlcicsIGNhY2hlPVRSVUV9CnBsb3RfZGlmZm5ldChkaWZmbmV0X2Rpc2Vhc2UsIHNsaWNlcyA9IGMoMSwgMywgNSkpCgojIFdlIHdhbnQgdG8gdXNlIGlncmFwaCB0byBjb21wdXRlIGxheW91dAppZ2RmIDwtIGRpZmZuZXRfdG9faWdyYXBoKGRpZmZuZXRfZGlzZWFzZSwgc2xpY2VzPWMoMSwyKSlbWzFdXQpwb3MgPC0gaWdyYXBoOjpsYXlvdXRfd2l0aF9kcmwoaWdkZikKCnBsb3RfZGlmZm5ldDIoZGlmZm5ldF9kaXNlYXNlLCB2ZXJ0ZXguc2l6ZSA9IGRncihkaWZmbmV0X2Rpc2Vhc2UpWywxXSwgbGF5b3V0PXBvcykKYGBgCgoKIyBDb21wbGV4IGNvbnRhZ2lvbgoKYGBge3Igc2ltLWNvbXBsZXh9CnNldC5zZWVkKDA5KQpkaWZmbmV0X2NvbXBsZXggPC0gcmRpZmZuZXQoCiAgc2VlZC5ncmFwaCA9IGRpZmZuZXRfZGlzZWFzZSRncmFwaCwKICBzZWVkLm5vZGVzID0gd2hpY2goZGlmZm5ldF9kaXNlYXNlJHRvYSA9PSAxKSwKICByZXdpcmUgPSBGQUxTRSwKICB0aHJlc2hvbGQuZGlzdCA9IGZ1bmN0aW9uKGkpIHJiZXRhKDEsIDMsIDEwKSwKICBuYW1lID0gIkNvbXBsZXggU2ltIiwKICBiZWhhdmlvciA9ICJNb3JlIGNvbXBsZXggdGhhbiBjb250YWN0IgopCgpgYGAKCmBgYHtyIHBsb3QtY29tcGxleC1hbmQtZGlzZWFzZX0KcGxvdF9hZG9wdGVycyhkaWZmbmV0X2Rpc2Vhc2UsIHdoYXQgPSAiY3VtYWRvcHQiLCBpbmNsdWRlLmxlZ2VuZCA9IEZBTFNFKQpwbG90X2Fkb3B0ZXJzKGRpZmZuZXRfY29tcGxleCwgYmc9InRvbWF0byIsIGFkZD1UUlVFLCB3aGF0ID0gImN1bWFkb3B0IikKbGVnZW5kKCJ0b3BsZWZ0IiwgbGVnZW5kID0gYygiRGlzZWFzZSIsICJDb21wbGV4IiksIGNvbCA9IGMoImxpZ2h0Ymx1ZSIsICJ0b21hdG8iKSwKICAgICAgIGJ0eSA9ICJuIiwgcGNoPTE5KQpgYGAKCgojIE1lbnRvciBNYXRjaGluZwoKYGBge3IgbWVudG9yLW1hdGNoLCBjYWNoZSA9IFRSVUV9CgojIEZpbmRpbmcgbWVudG9ycwptZW50b3JzIDwtIG1lbnRvcl9tYXRjaGluZyhkaWZmbmV0X2Rpc2Vhc2UsIDI1LCBsZWFkLnRpZXMubWV0aG9kID0gInJhbmRvbSIpCgojIFNpbXVsYXRpbmcgZGlmZnVzaW9uIHdpdGggdGhlc2UgbWVudG9ycwpzZXQuc2VlZCgwOSkKZGlmZm5ldF9tZW50b3JlZCA8LSByZGlmZm5ldCgKICBzZWVkLmdyYXBoID0gZGlmZm5ldF9jb21wbGV4LAogIHNlZWQubm9kZXMgPSB3aGljaChtZW50b3JzJGAxYCRpc2xlYWRlciksCiAgcmV3aXJlID0gRkFMU0UsCiAgdGhyZXNob2xkLmRpc3QgPSBkaWZmbmV0X2NvbXBsZXhbWyJyZWFsX3RocmVzaG9sZCJdXSwKICBuYW1lID0gIkRpZmZ1c2lvbiB1c2luZyBNZW50b3JzIgopCgpzdW1tYXJ5KGRpZmZuZXRfbWVudG9yZWQpCmBgYAoKYGBge3IgdG9hX21hdC1tZW50b3JzfQpjdW11bGF0aXZlX2Fkb3B0X2NvdW50KGRpZmZuZXRfY29tcGxleCkKY3VtdWxhdGl2ZV9hZG9wdF9jb3VudChkaWZmbmV0X21lbnRvcmVkKQpgYGAKCgojIEV4YW1wbGUgYnkgY2hhbmdpbmcgdGhyZXNob2xkCgpgYGB7ciBzaW0tc2ltLCBjYWNoZSA9IFRSVUUsIGNvbGxhcHNlID0gVFJVRX0KCiMgU2ltdWxhdGluZyBhIHNjYWxlLWZyZWUgaG9tb3BoaWxpYyBuZXR3b3JrCnNldC5zZWVkKDEyMzEpClggPC0gcmVwKGMoMSwxLDEsMSwxLDAsMCwwLDAsMCksIDUwKQpuZXQgPC0gcmdyYXBoX2JhKHQgPSA0OTksIG09NCwgZXRhID0gWCkKCiMgVGFraW5nIGEgbG9vayBpbiBpZ3JhcGgKaWcgIDwtIGlncmFwaDo6Z3JhcGhfZnJvbV9hZGphY2VuY3lfbWF0cml4KG5ldCkKcGxvdChpZywgdmVydGV4LmNvbG9yID0gYygiYXp1cmUiLCAidG9tYXRvIilbWCsxXSwgdmVydGV4LmxhYmVsID0gTkEsCiAgICAgdmVydGV4LnNpemUgPSBzcXJ0KGRncihuZXQpKSkKCiMgTm93LCBzaW11bGF0aW5nIGEgYnVuY2ggb2YgZGlmZnVzaW9uIHByb2Nlc3Nlcwpuc2ltIDwtIDUwMEwKYW5zXzFhbmQyIDwtIHZlY3RvcigibGlzdCIsIG5zaW0pCnNldC5zZWVkKDIyMykKZm9yIChpIGluIDE6bnNpbSkgewogICMgV2UganVzdCB3YW50IHRoZSBjdW0gYWRvcHQgY291bnQKICBhbnNfMWFuZDJbW2ldXSA8LSAKICAgIGN1bXVsYXRpdmVfYWRvcHRfY291bnQoCiAgICAgIHJkaWZmbmV0KAogICAgICAgIHNlZWQuZ3JhcGggPSBuZXQsCiAgICAgICAgdCA9IDEwLAogICAgICAgIHRocmVzaG9sZC5kaXN0ID0gc2FtcGxlKDE6MiwgNTAwTCwgVFJVRSksCiAgICAgICAgc2VlZC5ub2RlcyA9ICJyYW5kb20iLAogICAgICAgIHNlZWQucC5hZG9wdCA9IC4xMCwKICAgICAgICBleHBvc3VyZS5hcmdzID0gbGlzdChvdXRnb2luZyA9IEZBTFNFLCBub3JtYWxpemVkID0gRkFMU0UpLAogICAgICAgIHJld2lyZSA9IEZBTFNFCiAgICAgICAgKQogICAgICApCiAgCiAgIyBBcmUgd2UgdGhlcmUgeWV0PwogIGlmICghKGkgJSUgNTApKQogICAgbWVzc2FnZSgiU2ltdWxhdGlvbiAiLCBpLCIgb2YgIiwgbnNpbSwgIiBkb25lLiIpCn0KCiMgRXh0cmFjdGluZyBwcm9wCmFuc18xYW5kMiA8LSBkby5jYWxsKHJiaW5kLCBsYXBwbHkoYW5zXzFhbmQyLCAiWyIsIGk9InByb3AiLCBqPSkpCgphbnNfMmFuZDMgPC0gdmVjdG9yKCJsaXN0IiwgbnNpbSkKc2V0LnNlZWQoMjIzKQpmb3IgKGkgaW4gMTpuc2ltKSB7CiAgIyBXZSBqdXN0IHdhbnQgdGhlIGN1bSBhZG9wdCBjb3VudAogIGFuc18yYW5kM1tbaV1dIDwtIAogICAgY3VtdWxhdGl2ZV9hZG9wdF9jb3VudCgKICAgICAgcmRpZmZuZXQoCiAgICAgICAgc2VlZC5ncmFwaCA9IG5ldCwKICAgICAgICB0ID0gMTAsCiAgICAgICAgdGhyZXNob2xkLmRpc3QgPSBzYW1wbGUoMjozLCA1MDBMLCBUUlVFKSwKICAgICAgICBzZWVkLm5vZGVzID0gInJhbmRvbSIsCiAgICAgICAgc2VlZC5wLmFkb3B0ID0gLjEwLAogICAgICAgIGV4cG9zdXJlLmFyZ3MgPSBsaXN0KG91dGdvaW5nID0gRkFMU0UsIG5vcm1hbGl6ZWQgPSBGQUxTRSksCiAgICAgICAgcmV3aXJlID0gRkFMU0UKICAgICAgICApCiAgICAgICkKICAKICAjIEFyZSB3ZSB0aGVyZSB5ZXQ/CiAgaWYgKCEoaSAlJSA1MCkpCiAgICBtZXNzYWdlKCJTaW11bGF0aW9uICIsIGksIiBvZiAiLCBuc2ltLCAiIGRvbmUuIikKfQoKYW5zXzJhbmQzIDwtIGRvLmNhbGwocmJpbmQsIGxhcHBseShhbnNfMmFuZDMsICJbIiwgaT0icHJvcCIsIGo9KSkKYGBgCgpgYGB7ciBzaW0tc2ltLXJlc3VsdHN9CmJveHBsb3QoYW5zXzFhbmQyLCBjb2w9Iml2b3J5IikKYm94cGxvdChhbnNfMmFuZDMsIGNvbD0idG9tYXRvIiwgYWRkPVRSVUUpCgpgYGAKCgoqICAgRXhhbXBsZSBzaW11bGF0aW5nIGEgdGhvdXNhbmQgbmV0d29ya3MgYnkgY2hhbmdpbmcgdGhyZXNob2xkIGxldmVscy4KICAgIFRoZSBmaW5hbCBwcmV2YWxlbmNlLCBvciBoYXphcmQgYXMgYSBmdW5jdGlvbiBvZiB0aHJlc2hvbGQgbGV2ZWxzLgoKIyBQcm9ibGVtcwoKMS4gIEdpdmVuIHRoZSBmb2xsb3dpbmcgdHlwZXMgb2YgbmV0d29ya3M6IFNtYWxsLXdvcmxkLCBTY2FsZS1mcmVlLCBCZXJub3VsbGksCiAgICB3aGF0IHNldCBvZiAkbiQgaW5pdGlhdG9ycyBtYXhpbWl6ZXMgZGlmZnVzaW9uPwo=

University of Southern California
Center for Applied Network Analysis (CANA)