Nothing
## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
## -----------------------------------------------------------------------------
library(ghypernet)
library(texreg, quietly = TRUE) # for regression tables
library(ggplot2) # for plotting
library(ggraph) #for network plots using ggplot2
## ---- eval=FALSE, echo=FALSE--------------------------------------------------
# data("swissParliament_network", package = "ghypernet")
## -----------------------------------------------------------------------------
el <- adj2el(cospons_mat, directed = TRUE)
## -----------------------------------------------------------------------------
summary(el$edgecount)
## -----------------------------------------------------------------------------
nodes <- colnames(cospons_mat)
adj_mat <- el2adj(el, nodes = nodes)
## -----------------------------------------------------------------------------
identical(cospons_mat, adj_mat)
## -----------------------------------------------------------------------------
identical(rownames(cospons_mat), dt$idMP)
## -----------------------------------------------------------------------------
dt_unsorted <- dt[order(dt$firstName),]
identical(rownames(cospons_mat), dt_unsorted$idMP)
## -----------------------------------------------------------------------------
dtsorted <- data.frame(idMP = rownames(cospons_mat))
dtsorted <- dplyr::left_join(dtsorted, dt_unsorted, by = "idMP")
identical(dt$idMP, dtsorted$idMP)
## -----------------------------------------------------------------------------
dim(cospons_mat) == dim(onlinesim_mat)
## -----------------------------------------------------------------------------
table(rownames(cospons_mat) == rownames(onlinesim_mat))
## -----------------------------------------------------------------------------
recip_cospons <- reciprocity_stat(cospons_mat)
recip_cospons[1:5, 1:3]
## ---- out.width='100%', fig.align='center', fig.cap='Figure 1: Triadic closure: (a) undirected triangle, (b) transitive triplet, (c) edge-wise shared partners. Source: Brandenberger et al. [-@brandenberger2019quantifying].', echo=FALSE----
knitr::include_graphics('images/tikz_nweffects.pdf')
## -----------------------------------------------------------------------------
shp_cospons_unweighted <- sharedPartner_stat(cospons_mat, directed = TRUE, weighted = FALSE)
shp_cospons_unweighted[1:5, 1:3]
shp_cospons_weighted <- sharedPartner_stat(cospons_mat, directed = TRUE)
shp_cospons_weighted[1:5, 1:3]
## -----------------------------------------------------------------------------
shp_cospons_incoming <- sharedPartner_stat(cospons_mat, directed = TRUE,
triad.type = 'directed.incoming')
shp_cospons_incoming[1:5, 1:3]
shp_cospons_outgoing <- sharedPartner_stat(cospons_mat, directed = TRUE,
triad.type = 'directed.outgoing')
shp_cospons_outgoing[1:5, 1:3]
## -----------------------------------------------------------------------------
canton_homophilymat <- homophily_stat(dt$canton, type = 'categorical',
nodes = dt$idMP)
canton_homophilymat[1:5, 1:3]
## -----------------------------------------------------------------------------
canton_BE_homophilymat <- homophily_stat(dt$canton, type = 'categorical',
nodes = dt$idMP, these.categories.only = 'Bern')
## -----------------------------------------------------------------------------
canton_BEZH_homophilymat <- homophily_stat(dt$canton, type = 'categorical',
nodes = dt$idMP,
these.categories.only = c('Bern', 'Zuerich'))
## -----------------------------------------------------------------------------
party_homophilymat <- homophily_stat(dt$party, type = 'categorical', nodes = dt$idMP)
parlgroup_homophilymat <- homophily_stat(dt$parlGroup, type = 'categorical', nodes = dt$idMP)
gender_homophilymat <- homophily_stat(dt$gender, type = 'categorical', nodes = dt$idMP)
## -----------------------------------------------------------------------------
dt$age <- 2019 - as.numeric(format(as.Date(dt$birthdate, format = '%d.%m.%Y'), "%Y"))
age_absdiffmat <- homophily_stat(dt$age, type = 'absdiff', nodes = dt$idMP)
age_absdiffmat[1:5, 1:3]
## -----------------------------------------------------------------------------
head(dtcommittee)
## -----------------------------------------------------------------------------
## This is just one potential way of accomplishing this!
identical(as.character(dtcommittee$idMP), rownames(cospons_mat))
shared_committee <- matrix(0, nrow = nrow(cospons_mat), ncol = ncol(cospons_mat))
rownames(shared_committee) <- rownames(cospons_mat)
colnames(shared_committee) <- colnames(cospons_mat)
for(i in 1:nrow(shared_committee)){
for(j in 1:ncol(shared_committee)){
committees_i <- unlist(strsplit(as.character(dtcommittee$committee_names[i]), ";"))
committees_j <- unlist(strsplit(as.character(dtcommittee$committee_names[j]), ";"))
shared_committee[i, j] <- length(intersect(committees_i, committees_j))
}
}
shared_committee[1:5, 1:3]
## -----------------------------------------------------------------------------
dt$degree <- rowSums(cospons_mat) + colSums(cospons_mat)
degreemat <- cospons_mat
for(i in 1:nrow(cospons_mat)){
for(j in 1:ncol(cospons_mat)){
degreemat[i, j] <- sum(dt$degree[i], dt$degree[j])
}
}
## -----------------------------------------------------------------------------
age_activity_mat <- matrix(rep(dt$age, ncol(cospons_mat)),
nrow = nrow(cospons_mat), byrow = FALSE)
svp_activity_mat <- matrix(rep(dt$party, ncol(cospons_mat)),
nrow = nrow(cospons_mat), byrow = FALSE)
svp_activity_mat <- ifelse(svp_activity_mat == 'SVP', exp(1), 1)
## -----------------------------------------------------------------------------
age_popularity_mat <- matrix(rep(dt$age, ncol(cospons_mat)),
nrow = nrow(cospons_mat), byrow = TRUE)
svp_popularity_mat <- matrix(rep(dt$party, ncol(cospons_mat)),
nrow = nrow(cospons_mat), byrow = TRUE)
svp_popularity_mat <- ifelse(svp_popularity_mat == 'SVP', exp(1), 1)
## -----------------------------------------------------------------------------
recip_cospons <- get_zero_dummy(recip_cospons, name = 'reciprocity')
age_absdiffmat <- get_zero_dummy(age_absdiffmat, name = 'age')
shared_committee <- get_zero_dummy(shared_committee, name = 'committee')
## ---- eval=FALSE,echo=TRUE----------------------------------------------------
# fit <- nrm(adj = cospons_mat, w = recip_cospons,
# directed = TRUE, selfloops = FALSE, regular = FALSE)
## -----------------------------------------------------------------------------
nfit1 <- nrm(adj = cospons_mat,
w = list(same_canton = canton_homophilymat),
directed = TRUE)
summary(nfit1)
## -----------------------------------------------------------------------------
nfit1 <- nrm(adj = cospons_mat,
w = list(same_canton = canton_homophilymat),
directed = TRUE,
init = c(0.208))
summary(nfit1)
## -----------------------------------------------------------------------------
texreg::screenreg(nfit1)
## -----------------------------------------------------------------------------
nfit2 <- nrm(adj = cospons_mat,
w = c(
recip_cospons,
list(party = party_homophilymat,
canton = canton_homophilymat,
gender = gender_homophilymat),
age_absdiffmat,
shared_committee,
list(online_similarity = onlinesim_mat)
),
directed = TRUE,
init = c(.1,-.9, 1.2, .2, .2, 0, 0,0, -.2,-.1))
## -----------------------------------------------------------------------------
screenreg(nfit2,
groups = list('Endogenous' = 1:2,
'Homophily' = c(3:7),
'Exogenous' = c(8:10)))
## -----------------------------------------------------------------------------
nfit3 <- nrm(adj = cospons_mat,
w = c(
get_zero_dummy(degreemat, name = 'degree'),
recip_cospons,
list(party = party_homophilymat,
svp_in = svp_popularity_mat,
svp_out = svp_activity_mat,
canton = canton_homophilymat,
gender = gender_homophilymat),
age_absdiffmat,
list(agein = age_popularity_mat,
ageout = age_activity_mat),
shared_committee,
list(online_similarity = onlinesim_mat)
),
directed = TRUE, regular = TRUE,
init = c(1,0,0,0, 0.1, 0.5, 0, 0, .1, 0,0, 0,0, .1, .01))
summary(nfit3)
## -----------------------------------------------------------------------------
screenreg(list(nfit2, nfit3),
custom.model.names = c('with degree correction', 'without deg. cor.'))
## -----------------------------------------------------------------------------
fullfit <- ghype(graph = cospons_mat, directed = TRUE, selfloops = FALSE)
## -----------------------------------------------------------------------------
nfit2omega <- data.frame(omega = as.vector(nfit2$omega),
cosponsfull = as.vector(cospons_mat),
age_absdiff = as.vector(age_absdiffmat$age),
sameparty = as.vector(party_homophilymat))
nfit2omega[nfit2omega == 0] <- NA
nfit2omega <- na.omit(nfit2omega)
## ---- fig.height=4, fig.width=7-----------------------------------------------
ggplot(nfit2omega, aes(x = age_absdiff, y = omega, color = factor(sameparty)))+
geom_point(alpha = .1) +
geom_smooth() + theme(legend.position = 'bottom') +
scale_color_manual("", values = c('#E41A1C', '#377EB8'), labels = c('Between parties', 'Within party'))+
xlab("Age difference") + ylab("Tie propensities")+
ggtitle('Model (2): Marginal effects of age difference')
## -----------------------------------------------------------------------------
simnw <- rghype(nsamples = 1, model = nfit2, seed = 1253)
## ---- fig.height=5, fig.width=5-----------------------------------------------
ggraph(graph = simnw, layout = 'stress') +
geom_edge_link(aes(filter = weight>5, alpha=weight)) +
geom_node_point(aes(colour = dt$parlGroup), size=10*apply(simnw,1,sum)/max(apply(simnw,1,sum))) +
scale_colour_manual("", values = c('orange', 'yellow', 'blue', 'green', 'grey',
'darkblue', 'red', 'darkgreen', 'purple')) +
theme(legend.position = 'bottom') + coord_fixed() + theme_graph()
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.