WiNS Presentation Examples
2022-05-02
Variable domains and data editing
install.packages("netropy")library('netropy')data(lawdata)
adj.advice <- lawdata[[1]]
adj.friend <- lawdata[[2]]
adj.cowork <-lawdata[[3]]
df.att <- lawdata[[4]]# for years:
x <- table(df.att$years)
values<-as.numeric(names(x))
prop.x <- round(prop.table(x),2)
cum.prop=cumsum(prop.x)
frq.years = data.frame(value=values,freq=as.vector(x),
rel.freq=as.vector(prop.x),
cum.rel.freq=as.vector(cum.prop))
# for age:
x <- table(df.att$age)
values<-as.numeric(names(x))
prop.x <- round(prop.table(x),2)
cum.prop=cumsum(prop.x)
frq.age = data.frame(value=values,freq=as.vector(x),
rel.freq=as.vector(prop.x),
cum.rel.freq=as.vector(cum.prop))att.var <-
data.frame(
status = df.att$status-1,
gender = df.att$gender,
office = df.att$office-1,
years = ifelse(df.att$years <= 3,0,
ifelse(df.att$years <= 13,1,2)),
age = ifelse(df.att$age <= 35,0,
ifelse(df.att$age <= 45,1,2)),
practice = df.att$practice,
lawschool= df.att$lawschool-1
)df.att.var <- data.frame(
senior = df.att$senior,
status = df.att$status,
gender = df.att$gender,
office = df.att$office-1,
years = ifelse(df.att$years<=3,0,
ifelse(df.att$years<=13,1,2)),
age = ifelse(df.att$age<=35,0,
ifelse(df.att$age<=45,1,2)),
practice = df.att$practice,
lawschool= df.att$lawschool-1)
head(df.att.var, 5)## senior status gender office years age practice lawschool
## 1 1 1 1 0 2 2 1 0
## 2 2 1 1 0 2 2 0 0
## 3 3 1 1 1 1 2 1 0
## 4 4 1 1 0 2 2 0 2
## 5 5 1 1 1 2 2 1 1dyad.status <- get_dyad_var(att.var$status, type = 'att')
dyad.gender <- get_dyad_var(att.var$gender, type = 'att')
dyad.office <- get_dyad_var(att.var$office, type = 'att')
dyad.years <- get_dyad_var(att.var$years, type = 'att')
dyad.age <- get_dyad_var(att.var$age, type = 'att')
dyad.practice <- get_dyad_var(att.var$practice, type = 'att')
dyad.lawschool <- get_dyad_var(att.var$lawschool, type = 'att')dyad.cwk <- get_dyad_var(adj.cowork, type = 'tie')
dyad.adv <- get_dyad_var(adj.advice, type = 'tie')
dyad.frn <- get_dyad_var(adj.friend, type = 'tie')dyad.var <-
data.frame(cbind(status = dyad.status$var,
gender = dyad.gender$var,
office = dyad.office$var,
years = dyad.years$var,
age = dyad.age$var,
practice = dyad.practice$var,
lawschool = dyad.lawschool$var,
cowork = dyad.cwk$var,
advice = dyad.adv$var,
friend = dyad.frn$var)
)
head(dyad.var,5)## status gender office years age practice lawschool cowork advice friend
## 1 3 3 0 8 8 1 0 0 3 2
## 2 3 3 3 5 8 3 0 0 0 0
## 3 3 3 3 5 8 2 0 0 1 0
## 4 3 3 0 8 8 1 6 0 1 2
## 5 3 3 0 8 8 0 6 0 1 1triad.status <- get_triad_var(att.var$status, type = 'att')
triad.gender <- get_triad_var(att.var$gender, type = 'att')
triad.office <- get_triad_var(att.var$office, type = 'att')
triad.years <- get_triad_var(att.var$years, type = 'att')
triad.age <- get_triad_var(att.var$age, type = 'att')
triad.practice <- get_triad_var(att.var$practice, type = 'att')
triad.lawschool <- get_triad_var(att.var$lawschool,type = 'att')triad.cwk <- get_triad_var(adj.cowork, type = 'tie')
triad.adv <- get_triad_var(adj.advice, type = 'tie')
triad.frn <- get_triad_var(adj.friend, type = 'tie')triad.var <- data.frame(cbind(
status = triad.status$var,
gender = triad.gender$var,
office = triad.office$var,
years = triad.years$var,
age = triad.age$var,
practice = triad.practice$var,
lawschool = triad.lawschool$var,
cowork = triad.cwk$var,
advice = triad.adv$var,
friend = triad.frn$var)
)
head(triad.var,5)## status gender office years age practice lawschool cowork advice friend
## 1 7 7 9 17 26 5 0 0 35 1
## 2 7 7 0 26 26 1 18 0 43 37
## 3 7 7 9 26 26 5 9 0 11 1
## 4 7 7 9 26 26 5 0 0 19 1
## 5 7 7 9 26 26 1 18 4 35 1Univariate and bivariate entropies (dyad variables)
H.vert <- round(entropy_bivar(df.att.var),2)
H.vert## senior status gender office years age practice lawschool
## senior 6.15 6.15 6.15 6.15 6.15 6.15 6.15 6.15
## status NA 1.00 1.70 2.08 2.01 2.28 1.98 2.46
## gender NA NA 0.82 1.93 2.23 2.38 1.80 2.32
## office NA NA NA 1.12 2.69 2.67 2.09 2.61
## years NA NA NA NA 1.58 2.75 2.56 3.01
## age NA NA NA NA NA 1.58 2.56 2.88
## practice NA NA NA NA NA NA 0.98 2.51
## lawschool NA NA NA NA NA NA NA 1.53diag(H.vert)## senior status gender office years age practice lawschool
## 6.15 1.00 0.82 1.12 1.58 1.58 0.98 1.53redundancy(df.att.var)## senior status gender office years age practice lawschool
## senior 0 1 1 1 1 1 1 1
## status 0 0 0 0 0 0 0 0
## gender 0 0 0 0 0 0 0 0
## office 0 0 0 0 0 0 0 0
## years 0 0 0 0 0 0 0 0
## age 0 0 0 0 0 0 0 0
## practice 0 0 0 0 0 0 0 0
## lawschool 0 0 0 0 0 0 0 0Joint entropies (dyad variables)
J <- joint_entropy(dyad.var, 2)
J$matrix## status gender office years age practice lawschool cowork advice
## status 1.49 0.17 0.09 0.79 0.38 0.00 0.08 0.02 0.05
## gender NA 1.55 0.03 0.28 0.07 0.00 0.06 0.00 0.01
## office NA NA 2.24 0.08 0.14 0.05 0.13 0.06 0.10
## years NA NA NA 2.67 0.61 0.05 0.20 0.02 0.05
## age NA NA NA NA 2.80 0.02 0.41 0.01 0.02
## practice NA NA NA NA NA 1.96 0.04 0.05 0.08
## lawschool NA NA NA NA NA NA 2.95 0.00 0.01
## cowork NA NA NA NA NA NA NA 0.62 0.18
## advice NA NA NA NA NA NA NA NA 1.25
## friend NA NA NA NA NA NA NA NA NA
## friend
## status 0.05
## gender 0.01
## office 0.08
## years 0.07
## age 0.05
## practice 0.01
## lawschool 0.02
## cowork 0.04
## advice 0.18
## friend 0.88J$freq## j #(J = j) #(J >= j)
## 1 0.79 1 1
## 2 0.61 1 2
## 3 0.41 1 3
## 4 0.38 1 4
## 5 0.28 1 5
## 6 0.2 1 6
## 7 0.18 2 8
## 8 0.17 1 9
## 9 0.14 1 10
## 10 0.13 1 11
## 11 0.1 1 12
## 12 0.09 1 13
## 13 0.08 4 17
## 14 0.07 2 19
## 15 0.06 2 21
## 16 0.05 7 28
## 17 0.04 2 30
## 18 0.03 1 31
## 19 0.02 5 36
## 20 0.01 5 41
## 21 0 4 45library(ggraph)
assoc_graph(dyad.var, 0.15)
Prediction power (dyad variables)
Predicting status using pairs of other variables in
dataframe:
pred_status <- prediction_power('status', dyad.var)
diag(pred_status)## status gender office years age practice lawschool cowork
## NA 1.375 2.147 2.265 1.877 2.446 3.335 2.419
## advice friend
## 2.781 3.408Divergence tests of goodness of fit (dyad variables)
# install.packages("devtools")
devtools::install_github("termehs/netropy")Specified model: friend is independent of
cowork given advice:
div_gof(dat = dyad.var, var1 = "friend", var2 = "cowork", var_cond = "advice")## the specified model of conditional independence cannot be rejected## D df(D)
## 1 0.94 12