Source: McFarland, Daniel, et.al. 2010. “Social Network Analysis Labs in R.” Stanford University..
FRN(友誼): Friendship (2 = best friend, 1 = friend, 0 = not friend)
GND(性別): Gender homophily
RCE(族群): Race homophily
SEAT(座位位置): who sits next to whom (2 = faces, 1 = behind, 0 = not adjacent)
SSL(互動): social interactions per hour
TSL(任務互動): task interactions per hour(例如:交作業)
研究敘述
這組data是學生和學生的兩兩關係
研究題目是要看第二學期的朋友關係會受到第一學期的什麼因素影響?
[設定所需的函式庫(libraries)以及載入資料]
install.packages("sna")
install.packages("NetData")
library(sna)
setwd("/media/hsusir/DATA/Rdata Practice/05Network/QAP-Regression")
data(studentnets.mrqap173, package="NetData")
[Part 1].Data-distribution
ls() #總共有8組data-frame
## [1] "m173_sem1_FRN" "m173_sem1_GND" "m173_sem1_RCE" "m173_sem1_SEAT"
## [5] "m173_sem1_SSL" "m173_sem1_TSL" "m173_sem2_SSL" "m173_sem2_TSL"
1-1.Predictor matrices
#這些都是X，要轉成矩陣
m173_sem1_SSL <- as.matrix(m173_sem1_SSL)
m173_sem1_TSL <- as.matrix(m173_sem1_TSL)
m173_sem1_FRN <- as.matrix(m173_sem1_FRN)
m173_sem1_SEAT <- as.matrix(m173_sem1_SEAT)
m173_sem1_RCE <- as.matrix(m173_sem1_RCE)
m173_sem1_GND <- as.matrix(m173_sem1_GND)
1-2.Response matrices
#這兩組是第二學期的資料
m173_sem2_SSL <- as.matrix(m173_sem2_SSL)
m173_sem2_TSL <- as.matrix(m173_sem2_TSL)
1-3.Predictor matrices: creating a # 3-d matrix (predictor x n x n)
predictor_matrices <- array(NA, c(6, length(m173_sem1_SSL[1,]),length(m173_sem1_SSL[1,])))
# OR: predictor_matrices <- array(NA, c(6, 26,26))
#因為要弄成3D，所以需要用陣列的型式，因此把X的6層矩陣疊起來
predictor_matrices[1,,] <- m173_sem1_SSL
predictor_matrices[2,,] <- m173_sem1_TSL
predictor_matrices[3,,] <- m173_sem1_FRN
predictor_matrices[4,,] <- m173_sem1_SEAT
predictor_matrices[5,,] <- m173_sem1_RCE
predictor_matrices[6,,] <- m173_sem1_GND
[Part 2].Modeling
要做兩組model
SSL2 <- SSL1 + TSL1 + FRN1 + SEAT1 + RCE + GND
TSL2 <- TSL1 + SSL1 + FRN1 + SEAT1 + RCE + GND
2-1.Model A.
# SSL2 <- SSL1 + TSL1 + FRN1 + SEAT1 + RCE + GND
# Fit a netlm model: the response matrix and the array of predictor matrices
nl<-netlm(m173_sem2_SSL, predictor_matrices)
# Make the model easier ot read
nlLabeled <- list()
nlLabeled <- summary(nl)
# adding lables
nlLabeled$names <- c("Intercept", "SSL1", "TSL1", "Friends", "Seat","Race","Gender")
# Round the ocefficients to two decimals
nlLabeled$coefficients = round(nlLabeled$coefficients, 2)
nlLabeled
##
## OLS Network Model
##
## Residuals:
## 0% 25% 50% 75% 100%
## -1.652583881 -0.067206384 0.008678721 0.015216870 2.924942741
##
## Coefficients:
## Estimate Pr(<=b) Pr(>=b) Pr(>=|b|)
## Intercept -0.02 0.370 0.630 0.602
## SSL1 0.45 1.000 0.000 0.000
## TSL1 0.03 0.967 0.033 0.039
## Friends 0.16 0.999 0.001 0.001
## Seat 0.08 0.997 0.003 0.003
## Race 0.00 0.499 0.501 0.951
## Gender 0.01 0.596 0.404 0.843
##
## Residual standard error: 0.3437 on 643 degrees of freedom
## Multiple R-squared: 0.3817 Adjusted R-squared: 0.3759
## F-statistic: 66.16 on 6 and 643 degrees of freedom, p-value: 0
##
##
## Test Diagnostics:
##
## Null Hypothesis: qap
## Replications: 1000
## Coefficient Distribution Summary:
##
## Intercept SSL1 TSL1 Friends Seat Race
## Min -4.835101 -3.848676 -6.843939 -3.266911 -3.520514 -3.737670
## 1stQ -1.125070 -0.806845 -0.783574 -0.799514 -0.947425 -1.142628
## Median -0.256750 -0.221661 -0.335592 -0.085591 -0.131062 -0.148626
## Mean -0.297379 -0.005229 -0.056990 0.036192 -0.029378 0.024847
## 3rdQ 0.589071 0.485192 0.268172 0.770962 0.789694 1.144962
## Max 4.657048 13.816184 9.720934 4.535343 4.997866 5.281548
## Gender
## Min -3.945004
## 1stQ -0.930677
## Median -0.050041
## Mean -0.004787
## 3rdQ 0.927229
## Max 4.546052
2-2.Model B.
# TSL2 <- TSL1 + SSL1 + FRN1 + SEAT1 + RCE + GND
n2<-netlm(m173_sem2_TSL, predictor_matrices)
n2Labeled <- list()
n2Labeled <- summary(n2)
n2Labeled$names <- c("Intercept", "SSL1", "TSL1", "Friends", "Seat","Race","Gender")
n2Labeled$coefficients = round(n2Labeled$coefficients, 2)
n2Labeled
##
## OLS Network Model
##
## Residuals:
## 0% 25% 50% 75% 100%
## -6.79570345 -0.10044585 -0.00923077 0.02628499 7.90740702
##
## Coefficients:
## Estimate Pr(<=b) Pr(>=b) Pr(>=|b|)
## Intercept 0.10 0.803 0.197 0.219
## SSL1 -0.28 0.008 0.992 0.021
## TSL1 1.01 1.000 0.000 0.000
## Friends 0.01 0.554 0.446 0.900
## Seat -0.14 0.019 0.981 0.037
## Race -0.04 0.406 0.594 0.746
## Gender -0.09 0.152 0.848 0.314
##
## Residual standard error: 0.8241 on 643 degrees of freedom
## Multiple R-squared: 0.756 Adjusted R-squared: 0.7538
## F-statistic: 332.1 on 6 and 643 degrees of freedom, p-value: 0
##
##
## Test Diagnostics:
##
## Null Hypothesis: qap
## Replications: 1000
## Coefficient Distribution Summary:
##
## Intercept SSL1 TSL1 Friends Seat Race
## Min -4.0268805 -6.2551704 -1.8586626 -3.4576230 -3.7069031 -3.7656178
## 1stQ -0.1003922 -0.8102844 -1.0192076 -0.6279900 -0.8848548 -1.1328113
## Median 0.7704761 -0.1280847 -0.6852947 -0.0069583 0.0059962 -0.2063013
## Mean 0.7519104 -0.0972823 -0.0648420 0.1098535 0.0105724 -0.0127129
## 3rdQ 1.6702136 0.5244875 -0.1503772 0.7603680 0.9333441 0.9748831
## Max 4.1858691 8.0154740 24.3921331 5.4722805 3.9877675 4.7927760
## Gender
## Min -3.7377799
## 1stQ -0.9854272
## Median 0.0004029
## Mean 0.0031215
## 3rdQ 0.9567233
## Max 4.0795075