# This R script Demonstrates how to USE NetdifuseR to analyze the
# 3 classic network diffusion datasets and estimate cohesion vs
# Structural equivalence influences on adoption
rm(list = ls())
library(foreign)
install.packages("netdiffuseR")
library(netdiffuseR)
# Read MI data note the "groupvar" option
mi_att <- read.dta("c:/misc/diffnet/mi_v2.dta")
midiffnet <- survey_to_diffnet(mi_att, idvar="id", netvars=c("net11", "net12", "net13",
"net21", "net22", "net23"),
toavar="toa", groupvar = "city", warn.coercion = FALSE)
# Make sure it makes sense
summary(midiffnet)
# Calculate exposures
midiffnet[["cohexp"]] <- exposure(midiffnet)
midiffnet[["seexp2"]] <- exposure(midiffnet, alt.graph = "se", groupvar = "city")
midiffnet.df <- diffnet.attrs(midiffnet, as.df = TRUE) # Convert to dataframe
midiffnet.df$adopted <- as.integer(with(midiffnet.df, ado == per)) # Set adoption variable
midiffnet.df <- midiffnet.df[midiffnet.df$per <= midiffnet.df$toa, ] # Keep pre-adoption time only
mod_all <- as.formula(paste("adopted ~ factor(per) + proage + journ2 + science + detail + cohexp + seexp2 "))
out_all <- glm(mod_all, data=midiffnet.df, family = binomial(link="logit"))
summary(out_all)
# Draw a cumulate and new adopters graph
plot_adopters(midiffnet)
# Plot the the diffusion process
plot_diffnet(midiffnet)
plot_diffnet(midiffnet, slices=c(1, 6, 12, 18))
# BF data
bf_att <- read.dta("c:/misc/diffnet/bf_v2.dta")
bfdiffnet <- survey_to_diffnet(bf_att, idvar="id", netvars=c("net11", "net12", "net13",
"net21", "net22", "net23",
"net31", "net32", "net33"),
toavar="toa", groupvar = "village")
summary(bfdiffnet)
bfdiffnet[["cohexp"]] <- exposure(bfdiffnet)
bfdiffnet[["seexp"]] <- exposure(bfdiffnet, alt.graph="se", groupvar="village",
valued = TRUE)
# Store village variable with diffnet object
bfdiffnet[["village"]] <- bf_att$village
bfdiffnet.df <- diffnet.attrs(bfdiffnet, as.df = TRUE)
bfdiffnet.df$adopted <- as.integer(with(bfdiffnet.df, ado == per))
bfdiffnet.df <- bfdiffnet.df[bfdiffnet.df$per <= bfdiffnet.df$toa, ]
mod_all <- as.formula(paste("adopted ~ factor(per) + visits + news1 + immexp + cohexp + seexp "))
out_all <- glm(mod_all, data=bfdiffnet.df, family = binomial(link="logit"))
summary(out_all)
# Draw a cumulate and new adopters graph
plot_adopters(bfdiffnet)
# Plot the the diffusion process but just one time point
plot_diffnet(bfdiffnet, slices=10)
# Plot the the diffusion process but just one time point and one village
#plot_diffnet((with(bfdiffnet, village==10)), slices=10)
# Plot the the diffusion process for just one village
bfdiffnet10<-bfdiffnet[["village"]]==10
plot_diffnet(bfdiffnet[bfdiffnet10], slices=10)
# KFP Data
kfp_att<- read.dta("c:/misc/diffnet/kfp_v3.dta")
kfpdiffnet <- survey_to_diffnet(
kfp_att, idvar="id",
netvars=c("net11", "net12", "net13", "net14", "net15",
"net21", "net22", "net23", "net24", "net25",
"net31", "net32", "net33", "net34", "net35"),
toavar="toa", groupvar = "village")
summary(kfpdiffnet)
kfpdiffnet[["cohexp"]] <- exposure(kfpdiffnet)
kfpdiffnet[["seexp"]] <- exposure(kfpdiffnet, alt.graph="se", groupvar="village",
valued=TRUE)
kfpdiffnet.df <- diffnet.attrs(kfpdiffnet, as.df = TRUE)
kfpdiffnet.df$adopted <- as.integer(with(kfpdiffnet.df, ado == per))
kfpdiffnet.df <- kfpdiffnet.df[kfpdiffnet.df$per <= kfpdiffnet.df$toa, ]
mod_all <- as.formula(paste("adopted ~ factor(per) + sons + mmex + pregs + cohexp + seexp "))
out_all <- glm(mod_all, data=kfpdiffnet.df, family = binomial(link="logit"))
summary(out_all)
########################################################################
# The End #
########################################################################
LS0tCnRpdGxlOiAiQ2xhc3NpYyBEaWZmbmV0IEFuYWx5c2VzIgphdXRob3I6ICJUaG9tYXMgVy4gVmFsZW50ZSIKLS0tCgpgYGByCiMgVGhpcyBSIHNjcmlwdCBEZW1vbnN0cmF0ZXMgaG93IHRvIFVTRSBOZXRkaWZ1c2VSIHRvIGFuYWx5emUgdGhlIAojIDMgY2xhc3NpYyBuZXR3b3JrIGRpZmZ1c2lvbiBkYXRhc2V0cyBhbmQgZXN0aW1hdGUgY29oZXNpb24gdnMKIyBTdHJ1Y3R1cmFsIGVxdWl2YWxlbmNlIGluZmx1ZW5jZXMgb24gYWRvcHRpb24gCgpybShsaXN0ID0gbHMoKSkKbGlicmFyeShmb3JlaWduKQppbnN0YWxsLnBhY2thZ2VzKCJuZXRkaWZmdXNlUiIpCmxpYnJhcnkobmV0ZGlmZnVzZVIpCgojIFJlYWQgTUkgZGF0YSBub3RlIHRoZSAiZ3JvdXB2YXIiIG9wdGlvbgptaV9hdHQgPC0gcmVhZC5kdGEoImM6L21pc2MvZGlmZm5ldC9taV92Mi5kdGEiKQptaWRpZmZuZXQgPC0gc3VydmV5X3RvX2RpZmZuZXQobWlfYXR0LCBpZHZhcj0iaWQiLCBuZXR2YXJzPWMoIm5ldDExIiwgIm5ldDEyIiwgIm5ldDEzIiwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJuZXQyMSIsICJuZXQyMiIsICJuZXQyMyIpLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgdG9hdmFyPSJ0b2EiLCBncm91cHZhciA9ICJjaXR5Iiwgd2Fybi5jb2VyY2lvbiA9IEZBTFNFKQojIE1ha2Ugc3VyZSBpdCBtYWtlcyBzZW5zZQpzdW1tYXJ5KG1pZGlmZm5ldCkKCiMgQ2FsY3VsYXRlIGV4cG9zdXJlcwptaWRpZmZuZXRbWyJjb2hleHAiXV0gPC0gZXhwb3N1cmUobWlkaWZmbmV0KQptaWRpZmZuZXRbWyJzZWV4cDIiXV0gPC0gZXhwb3N1cmUobWlkaWZmbmV0LCBhbHQuZ3JhcGggPSAic2UiLCBncm91cHZhciA9ICJjaXR5IikKCm1pZGlmZm5ldC5kZiA8LSBkaWZmbmV0LmF0dHJzKG1pZGlmZm5ldCwgYXMuZGYgPSBUUlVFKSAgICAgICAgICAgICAgICAgICMgQ29udmVydCB0byBkYXRhZnJhbWUKbWlkaWZmbmV0LmRmJGFkb3B0ZWQgPC0gYXMuaW50ZWdlcih3aXRoKG1pZGlmZm5ldC5kZiwgYWRvID09IHBlcikpICAgICAgICAgICMgU2V0IGFkb3B0aW9uIHZhcmlhYmxlCm1pZGlmZm5ldC5kZiA8LSBtaWRpZmZuZXQuZGZbbWlkaWZmbmV0LmRmJHBlciA8PSAgbWlkaWZmbmV0LmRmJHRvYSwgXSAgICAgICAgIyBLZWVwIHByZS1hZG9wdGlvbiB0aW1lIG9ubHkKbW9kX2FsbCA8LSBhcy5mb3JtdWxhKHBhc3RlKCJhZG9wdGVkIH4gZmFjdG9yKHBlcikgKyBwcm9hZ2UgKyBqb3VybjIgKyBzY2llbmNlICsgZGV0YWlsICsgY29oZXhwICsgc2VleHAyICAiKSkKb3V0X2FsbCA8LSBnbG0obW9kX2FsbCwgZGF0YT1taWRpZmZuZXQuZGYsIGZhbWlseSA9IGJpbm9taWFsKGxpbms9ImxvZ2l0IikpCnN1bW1hcnkob3V0X2FsbCkKIyBEcmF3IGEgY3VtdWxhdGUgYW5kIG5ldyBhZG9wdGVycyBncmFwaApwbG90X2Fkb3B0ZXJzKG1pZGlmZm5ldCkKIyBQbG90IHRoZSB0aGUgZGlmZnVzaW9uIHByb2Nlc3MKcGxvdF9kaWZmbmV0KG1pZGlmZm5ldCkKcGxvdF9kaWZmbmV0KG1pZGlmZm5ldCwgc2xpY2VzPWMoMSwgNiwgMTIsIDE4KSkKCgoKIyBCRiBkYXRhCmJmX2F0dCA8LSByZWFkLmR0YSgiYzovbWlzYy9kaWZmbmV0L2JmX3YyLmR0YSIpCmJmZGlmZm5ldCA8LSBzdXJ2ZXlfdG9fZGlmZm5ldChiZl9hdHQsIGlkdmFyPSJpZCIsIG5ldHZhcnM9YygibmV0MTEiLCAibmV0MTIiLCAibmV0MTMiLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIm5ldDIxIiwgIm5ldDIyIiwgIm5ldDIzIiwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICJuZXQzMSIsICJuZXQzMiIsICJuZXQzMyIpLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgdG9hdmFyPSJ0b2EiLCBncm91cHZhciA9ICJ2aWxsYWdlIikKCnN1bW1hcnkoYmZkaWZmbmV0KQoKYmZkaWZmbmV0W1siY29oZXhwIl1dIDwtIGV4cG9zdXJlKGJmZGlmZm5ldCkKYmZkaWZmbmV0W1sic2VleHAiXV0gPC0gIGV4cG9zdXJlKGJmZGlmZm5ldCwgYWx0LmdyYXBoPSJzZSIsIGdyb3VwdmFyPSJ2aWxsYWdlIiwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHZhbHVlZCA9IFRSVUUpCiMgU3RvcmUgdmlsbGFnZSB2YXJpYWJsZSB3aXRoIGRpZmZuZXQgb2JqZWN0CmJmZGlmZm5ldFtbInZpbGxhZ2UiXV0gPC0gYmZfYXR0JHZpbGxhZ2UKCmJmZGlmZm5ldC5kZiA8LSBkaWZmbmV0LmF0dHJzKGJmZGlmZm5ldCwgYXMuZGYgPSBUUlVFKQpiZmRpZmZuZXQuZGYkYWRvcHRlZCA8LSBhcy5pbnRlZ2VyKHdpdGgoYmZkaWZmbmV0LmRmLCBhZG8gPT0gcGVyKSkKYmZkaWZmbmV0LmRmIDwtIGJmZGlmZm5ldC5kZltiZmRpZmZuZXQuZGYkcGVyIDw9ICBiZmRpZmZuZXQuZGYkdG9hLCBdCm1vZF9hbGwgPC0gYXMuZm9ybXVsYShwYXN0ZSgiYWRvcHRlZCB+IGZhY3RvcihwZXIpICsgdmlzaXRzICsgbmV3czEgKyBpbW1leHAgKyBjb2hleHAgKyBzZWV4cCAgIikpCm91dF9hbGwgPC0gZ2xtKG1vZF9hbGwsIGRhdGE9YmZkaWZmbmV0LmRmLCBmYW1pbHkgPSBiaW5vbWlhbChsaW5rPSJsb2dpdCIpKQpzdW1tYXJ5KG91dF9hbGwpCiMgRHJhdyBhIGN1bXVsYXRlIGFuZCBuZXcgYWRvcHRlcnMgZ3JhcGgKcGxvdF9hZG9wdGVycyhiZmRpZmZuZXQpCiMgUGxvdCB0aGUgdGhlIGRpZmZ1c2lvbiBwcm9jZXNzIGJ1dCBqdXN0IG9uZSB0aW1lIHBvaW50CnBsb3RfZGlmZm5ldChiZmRpZmZuZXQsIHNsaWNlcz0xMCkKIyBQbG90IHRoZSB0aGUgZGlmZnVzaW9uIHByb2Nlc3MgYnV0IGp1c3Qgb25lIHRpbWUgcG9pbnQgYW5kIG9uZSB2aWxsYWdlCiNwbG90X2RpZmZuZXQoKHdpdGgoYmZkaWZmbmV0LCB2aWxsYWdlPT0xMCkpLCBzbGljZXM9MTApCgojIFBsb3QgdGhlIHRoZSBkaWZmdXNpb24gcHJvY2VzcyBmb3IganVzdCBvbmUgdmlsbGFnZQpiZmRpZmZuZXQxMDwtYmZkaWZmbmV0W1sidmlsbGFnZSJdXT09MTAKcGxvdF9kaWZmbmV0KGJmZGlmZm5ldFtiZmRpZmZuZXQxMF0sIHNsaWNlcz0xMCkKCiMgS0ZQIERhdGEKa2ZwX2F0dDwtIHJlYWQuZHRhKCJjOi9taXNjL2RpZmZuZXQva2ZwX3YzLmR0YSIpCmtmcGRpZmZuZXQgPC0gc3VydmV5X3RvX2RpZmZuZXQoCiAga2ZwX2F0dCwgaWR2YXI9ImlkIiwgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbmV0dmFycz1jKCJuZXQxMSIsICJuZXQxMiIsICJuZXQxMyIsICJuZXQxNCIsICJuZXQxNSIsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAibmV0MjEiLCAibmV0MjIiLCAibmV0MjMiLCAibmV0MjQiLCAibmV0MjUiLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIm5ldDMxIiwgIm5ldDMyIiwgIm5ldDMzIiwgIm5ldDM0IiwgIm5ldDM1IiksCiAgICAgICAgICAgICAgICAgIHRvYXZhcj0idG9hIiwgZ3JvdXB2YXIgPSAidmlsbGFnZSIpCgpzdW1tYXJ5KGtmcGRpZmZuZXQpCgprZnBkaWZmbmV0W1siY29oZXhwIl1dIDwtIGV4cG9zdXJlKGtmcGRpZmZuZXQpCmtmcGRpZmZuZXRbWyJzZWV4cCJdXSA8LSAgZXhwb3N1cmUoa2ZwZGlmZm5ldCwgYWx0LmdyYXBoPSJzZSIsIGdyb3VwdmFyPSJ2aWxsYWdlIiwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICB2YWx1ZWQ9VFJVRSkKCgprZnBkaWZmbmV0LmRmIDwtIGRpZmZuZXQuYXR0cnMoa2ZwZGlmZm5ldCwgYXMuZGYgPSBUUlVFKQprZnBkaWZmbmV0LmRmJGFkb3B0ZWQgPC0gYXMuaW50ZWdlcih3aXRoKGtmcGRpZmZuZXQuZGYsIGFkbyA9PSBwZXIpKQprZnBkaWZmbmV0LmRmIDwtIGtmcGRpZmZuZXQuZGZba2ZwZGlmZm5ldC5kZiRwZXIgPD0gIGtmcGRpZmZuZXQuZGYkdG9hLCBdCm1vZF9hbGwgPC0gYXMuZm9ybXVsYShwYXN0ZSgiYWRvcHRlZCB+IGZhY3RvcihwZXIpICsgc29ucyArIG1tZXggKyBwcmVncyArIGNvaGV4cCArIHNlZXhwICAiKSkKb3V0X2FsbCA8LSBnbG0obW9kX2FsbCwgZGF0YT1rZnBkaWZmbmV0LmRmLCBmYW1pbHkgPSBiaW5vbWlhbChsaW5rPSJsb2dpdCIpKQpzdW1tYXJ5KG91dF9hbGwpCgoKIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjCiMgICAgICAgICAgICAgICAgICAgICAgIFRoZSBFbmQgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIwojIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMKYGBgCgo=
University of Southern California
Center for Applied Network Analysis (CANA)