Simulating diffusion networks: Using the rdiffnet function

In this example we compare 3 different simulations that use the same baseline (seed) network, a scale-free generated via rgraph_ba (Barabasi-Albert) with parameter m=4 (number of new ties that each added node includes in the graph). The only difference between the three simulations is that we use a different set of seed adopters, “random”, “central” and “marginal”. All three cases start with 5% of the network having adopted the innovation.

library(netdiffuseR)
s <- 113
set.seed(s)
diffnet_ran <- rdiffnet(200, 20, "random", seed.p.adopt = .05, rgraph.args = list(m=4))

set.seed(s)
diffnet_cen <- rdiffnet(200, 20, "central", seed.p.adopt = .05, rgraph.args = list(m=4))

set.seed(s)
diffnet_mar <- rdiffnet(200, 20, "marginal", seed.p.adopt = .05, rgraph.args = list(m=4))

Furthermore, we can take a more detail view of what’s going on in each network using the summary method. For example, lets take a look at the marginal network:

summary(diffnet_mar)
## Diffusion network summary statistics
## -----------------------------------------------------------------------
##  Period  Adopters Cum Adopt. Cum Adopt. % Hazard Rate Density Moran's I 
## -------- -------- ---------- ------------ ----------- ------- --------- 
##        1       10         10         0.05           -    0.03     -0.00 
##        2        1         11         0.06        0.01    0.03     -0.00 
##        3        3         14         0.07        0.02    0.03      0.01 
##        4        1         15         0.07        0.01    0.03      0.01 
##        5        1         16         0.08        0.01    0.03      0.01 
##        6        2         18         0.09        0.01    0.03      0.02 
##        7        3         21         0.10        0.02    0.03      0.01 
##        8        4         25         0.12        0.02    0.03      0.01 
##        9        4         29         0.14        0.02    0.03      0.01 
##       10        5         34         0.17        0.03    0.03      0.01 
##       11        2         36         0.18        0.01    0.03      0.01 
##       12        4         40         0.20        0.02    0.03      0.00 
##       13        4         44         0.22        0.02    0.03      0.00 
##       14        7         51         0.26        0.04    0.02      0.01 
##       15        2         53         0.27        0.01    0.02      0.01 
##       16        4         57         0.28        0.03    0.02      0.01 
##       17        3         60         0.30        0.02    0.02      0.01 
##       18        2         62         0.31        0.01    0.02      0.01 
##       19        3         65         0.33        0.02    0.02      0.01 
##       20        1         66         0.33        0.01    0.02      0.01 
## -----------------------------------------------------------------------
##  Left censoring  : 0.05 (10)
##  Right centoring : 0.67 (134)
##  # of nodes      : 200

At a first look, printing the networks, we can see that they differ in the number of adopters, as the adoption rate shows:

diffnet_ran; diffnet_cen; diffnet_mar
## Dynamic network of class -diffnet-
##  # of nodes        : 200
##  # of time periods : 20
##  Final prevalence  : 0.77
##  Type              : directed
## Dynamic network of class -diffnet-
##  # of nodes        : 200
##  # of time periods : 20
##  Final prevalence  : 0.95
##  Type              : directed
## Dynamic network of class -diffnet-
##  # of nodes        : 200
##  # of time periods : 20
##  Final prevalence  : 0.33
##  Type              : directed

So, as expected, the network that used central nodes as first adopters is the one that reached the highest adoption rate, 0.95; meanwhile the network that used marginal nodes as seed has the lowest adoption rate, 0.56. Lets compare the set of initial adopters graphically

cols <- c("lightblue","green", "blue")

oldpar <- par(no.readonly = TRUE)
par(mfcol=c(1,3), mai = c(0, 0, 1, 0), mar = rep(1, 4) +  0.1)
set.seed(s);plot(diffnet_ran, main="Random seed")
set.seed(s);plot(diffnet_cen, main="Central seed")
set.seed(s);plot(diffnet_mar, main="Marginal seed")

par(oldpar)

An interesting way of visualizing the diffusion process is using the plot_diffnet function. In this case, instead of plotting all the 20 periods (networks), we only focus on a subset (henceforth we use the slices argument).

plot_diffnet(diffnet_ran, slices = c(1,4,8,12,16,20))

Diffusion process

An easy way to compare these three networks is by checking the cumulative adoption counts, in particular, the proportion. Using the function plot_adopters we can achieve our goal

plot_adopters(diffnet_ran, bg = cols[1], include.legend = FALSE, what="cumadopt")
plot_adopters(diffnet_cen, bg = cols[2], add=TRUE, what="cumadopt")
plot_adopters(diffnet_mar, bg = cols[3], add=TRUE, what="cumadopt")

legend("topleft", bty="n",
       legend = c("Random","Central", "Marginal"),
       fill=cols)

Comparing hazard rates we can do the following

plot_hazard(diffnet_ran, ylim=c(0,.4), bg=cols[1])
plot_hazard(diffnet_cen, add=TRUE, bg=cols[2])
plot_hazard(diffnet_mar, add=TRUE, bg=cols[3])

legend("topleft", bty="n",
       legend = c("Random","Central", "Marginal"),
       fill=cols)

Furthermore, we can calculate infectiousness and susceptibility on each network and see whether both are correlated in each one of the processess.

plot_infectsuscep(diffnet_ran, bins=15, K=3, 
                  main = "Distribution of Infectiousness and\nSusceptibility (Random)")
## Warning in plot_infectsuscep.list(graph$graph, graph$toa, t0, normalize, :
## When applying logscale some observations are missing.

plot_infectsuscep(diffnet_cen, bins=15, K=3, 
                  main = "Distribution of Infectiousness and\nSusceptibility (Central)")
## Warning in plot_infectsuscep.list(graph$graph, graph$toa, t0, normalize, :
## When applying logscale some observations are missing.

plot_infectsuscep(diffnet_mar, bins=15, K=3, 
                  main = "Distribution of Infectiousness and\nSusceptibility (Marginal)")
## Warning in plot_infectsuscep.list(graph$graph, graph$toa, t0, normalize, :
## When applying logscale some observations are missing.