-
Notifications
You must be signed in to change notification settings - Fork 0
/
3.1_Additions_during_review.R
105 lines (80 loc) · 4.24 KB
/
3.1_Additions_during_review.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
########################################################################################################################
## THE EFFECTS OF GOSSIP ON FRIENDSHIP IN A DUTCH CHILDCARE ORGANISATION
## Additions based on reviewers' comments (3.1)
## R script written by Jose Luis Estevez (Masaryk University & Linkoping University)
## Date: May 29th, 2022
########################################################################################################################
# R PACKAGES REQUIRED
library(igraph);library(statnet)
# DATA LOADING
rm(list=ls())
load('sienadata.RData')
########################################################################################################################
# QAP REGRESSION (CHANGES IN FRIENDSHIP VS. COMMUNICATION FREQUENCY)
# (1) Ties created
A_tiescreated <- ntw$friendship_imp$AW2 - ntw$friendship$AW1 # substract existing ties from W2
A_tiescreated[!is.na(A_tiescreated) & A_tiescreated == -1] <- 0 # send minus ones to zeroes
B_tiescreated <- ntw$friendship_imp$BW2 - ntw$friendship$BW1
B_tiescreated[!is.na(B_tiescreated) & B_tiescreated == -1] <- 0
C_tiescreated <- ntw$friendship_imp$CW2 - ntw$friendship$CW1
C_tiescreated[!is.na(C_tiescreated) & C_tiescreated == -1] <- 0
# (2) Ties broken
A_tiesbroken <- ntw$friendship$AW1 - ntw$friendship_imp$AW2 # substract ties that remains from W1
A_tiesbroken[!is.na(A_tiesbroken) & A_tiesbroken == -1] <- 0 # send minus ones to zeroes
B_tiesbroken <- ntw$friendship$BW1 - ntw$friendship_imp$BW2
B_tiesbroken[!is.na(B_tiesbroken) & B_tiesbroken == -1] <- 0
C_tiesbroken <- ntw$friendship$CW1 - ntw$friendship_imp$CW2
C_tiesbroken[!is.na(C_tiesbroken) & C_tiesbroken == -1] <- 0
# (3) Stable ties
A_tiesstable <- array(NA,dim=c(nrow(A_tiescreated),ncol(A_tiescreated),2))
A_tiesstable[,,1] <- ntw$friendship$AW1
A_tiesstable[,,2] <- ntw$friendship_imp$AW2
A_tiesstable <- apply(A_tiesstable,c(1,2),min)
B_tiesstable <- array(NA,dim=c(nrow(B_tiescreated),ncol(B_tiescreated),2))
B_tiesstable[,,1] <- ntw$friendship$BW1
B_tiesstable[,,2] <- ntw$friendship_imp$BW2
B_tiesstable <- apply(B_tiesstable,c(1,2),min)
C_tiesstable <- array(NA,dim=c(nrow(C_tiescreated),ncol(C_tiescreated),2))
C_tiesstable[,,1] <- ntw$friendship$CW1
C_tiesstable[,,2] <- ntw$friendship_imp$CW2
C_tiesstable <- apply(C_tiesstable,c(1,2),min)
# Use zeroes instead of NAs in the predictors
A_tiescreated[is.na(A_tiescreated)] <- 0
A_tiesbroken[is.na(A_tiesbroken)] <- 0
A_tiesstable[is.na(A_tiesstable)] <- 0
B_tiescreated[is.na(B_tiescreated)] <- 0
B_tiesbroken[is.na(B_tiesbroken)] <- 0
B_tiesstable[is.na(B_tiesstable)] <- 0
C_tiescreated[is.na(C_tiescreated)] <- 0
C_tiesbroken[is.na(C_tiesbroken)] <- 0
C_tiesstable[is.na(C_tiesstable)] <- 0
# QAP regressions
set.seed(0708) # random seed
A_qap <- netlm(ntw$communication$A,list(A_tiescreated,A_tiesbroken,A_tiesstable),nullhyp='qap',reps=5000)
B_qap <- netlm(ntw$communication$B,list(B_tiescreated,B_tiesbroken,B_tiesstable),nullhyp='qap',reps=5000)
C_qap <- netlm(ntw$communication$C,list(C_tiescreated,C_tiesbroken,C_tiesstable),nullhyp='qap',reps=5000)
# Removal of unnecesary objects
rm(A_tiescreated);rm(A_tiesbroken);rm(A_tiesstable)
rm(B_tiescreated);rm(B_tiesbroken);rm(B_tiesstable)
rm(C_tiescreated);rm(C_tiesbroken);rm(C_tiesstable)
########################################################################################################################
# Tabulation of results
results <- data.frame(effect=c('Constant','Tie creation','Tie destruction','Tie maintenance'))
results$A_est <- A_qap$coefficients
results$A_p <- A_qap$pgreqabs
results$B_est <- B_qap$coefficients
results$B_p <- B_qap$pgreqabs
results$C_est <- C_qap$coefficients
results$C_p <- C_qap$pgreqabs
sig <- function(x){
ifelse(x < .001,'***',
ifelse(x < .01,'**',
ifelse(x < .05,'*','')))
}
results$A_s <- sig(results$A_p)
results$B_s <- sig(results$B_p)
results$C_s <- sig(results$C_p)
write.csv(results[,c('effect','A_est','A_p','A_s','B_est','B_p','B_s','C_est','C_p','C_s')],'QAPs.csv',row.names=FALSE)
########################################################################################################################
# Save image
save.image('QAPs.RData')