rdiffnet
functionIn 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))
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.