====== Basic statistical models ======
===== Campnet =====
> setwd("C:/Users/batagelj/Documents/papers/2018/moskva/NetR/doc/BasicStat/data")
> nam <- c("HOLLY","BRAZEY","CAROL","PAM","PAT","JENNIE","PAULINE","ANN",
+ "MICHAEL","BILL","LEE","DON","JOHN","HARRY","GERY","STEVE","BERT","RUSS")
> A <- c(
+ 0,0,0,1,1,0,0,0,0,0,0,1,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,1,1,0,
+ 0,0,0,1,1,0,1,0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,
+ 1,0,1,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,1,1,0,0,1,0,0,0,0,0,0,0,0,0,0,
+ 0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,1,0,1,1,0,0,0,0,0,0,0,0,0,0,0,
+ 1,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,
+ 0,0,0,0,0,0,0,0,1,0,0,1,0,1,0,0,0,0,
+ 0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,
+ 1,0,0,0,0,0,0,0,1,0,0,0,0,1,0,0,0,0,
+ 0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,1,
+ 1,0,0,0,0,0,0,0,1,0,0,1,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,1,0,1,
+ 0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,1,
+ 0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,1,0,1,
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,0)
> M <- matrix(A,ncol=18,nrow=18,byrow=TRUE)
> rownames(M) <- nam
> colnames(M) <- nam
> gender <- c(1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2)
> role <- c(1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,2,2,2)
> combo <- c(1,1,1,1,1,1,1,1,2,2,2,2,2,2,3,3,3,3)
> save(M,gender,role,combo,file="campnet.Rdata",ascii=TRUE)
===== ICexample =====
> setwd("C:/Users/batagelj/Documents/papers/2018/moskva/NetR/doc/BasicStat/data")
> na <- c("A", "B", "C", "D", "E", "F", "G", "H", "I")
> C <- c(
+ 0,1,0,1,0,0,0,0,0,
+ 1,0,1,0,1,0,0,0,0,
+ 0,1,0,0,0,1,0,0,0,
+ 1,0,0,0,1,0,1,0,0,
+ 0,1,0,1,0,1,0,1,0,
+ 0,0,1,0,1,0,0,0,1,
+ 0,0,0,1,0,0,0,1,0,
+ 0,0,0,0,1,0,1,0,1,
+ 0,0,0,0,0,1,0,1,0)
> N <- matrix(C,ncol=9,nrow=9,byrow=TRUE)
> rownames(N) <- na; colnames(N) <- na
> pos <- c( 1, 2, 3, 2, 3, 4, 3, 4, 5 )
> no <- c( 3, 4, 3, 4, 3, 2, 1, 2, 5 )
> neg <- c( 4, 1, 4, 2, 5, 2, 3, 3, 3 )
> save(N,pos,no,neg,file="ICexample.Rdata",ascii=TRUE)
===== Geary and Moran with sna =====
[[https://github.com/kateto/Network_Analysis_R_Examples/blob/master/R%20Scripts/Comm645-RNetworks.R|Networks]];
[[https://github.com/cran/sna/blob/master/R/models.R|Models]];
[[https://github.com/kateto/Network_Analysis_R_Examples/blob/master/R%20Scripts/Comm645-MRQAP.R|kateto QAP]]
> library(network)
> library(sna)
> net <- network(N,directed=FALSE,loops=FALSE,bipartite=FALSE,matrix.type="adjacency")
> gplot(net)
> network.size(net)
[1] 9
> set.vertex.attribute(net,"pos",pos)
> set.vertex.attribute(net,"neg",neg)
> set.vertex.attribute(net,"no",no)
> set.network.attribute(net,"title","ICexample")
> summary(net)
Network attributes:
vertices = 9
directed = FALSE
hyper = FALSE
loops = FALSE
multiple = FALSE
bipartite = FALSE
title = ICexample
total edges = 12
missing edges = 0
non-missing edges = 12
density = 0.3333333
Vertex attributes:
neg:
numeric valued attribute
attribute summary:
Min. 1st Qu. Median Mean 3rd Qu. Max.
1 2 3 3 4 5
no:
numeric valued attribute
attribute summary:
Min. 1st Qu. Median Mean 3rd Qu. Max.
1 2 3 3 4 5
pos:
numeric valued attribute
attribute summary:
Min. 1st Qu. Median Mean 3rd Qu. Max.
1 2 3 3 4 5
vertex.names:
character valued attribute
9 valid vertex names
No edge attributes
Network adjacency matrix:
A B C D E F G H I
A 0 1 0 1 0 0 0 0 0
B 1 0 1 0 1 0 0 0 0
C 0 1 0 0 0 1 0 0 0
D 1 0 0 0 1 0 1 0 0
E 0 1 0 1 0 1 0 1 0
F 0 0 1 0 1 0 0 0 1
G 0 0 0 1 0 0 0 1 0
H 0 0 0 0 1 0 1 0 1
I 0 0 0 0 0 1 0 1 0
> gplot(net,gmode="graph",label=net%v%"vertex.names",vertex.cex=net%v%"no",vertex.col="blue")
> gplot(net,gmode="graph",label=net%v%"vertex.names",vertex.cex=net%v%"pos",vertex.col="blue")
> gplot(net,gmode="graph",label=net%v%"vertex.names",vertex.cex=net%v%"neg",vertex.col="blue")
> x <- c(2,3,4,2,3,4,2,3,4); y <- c(4,4,4,3,3,3,2,2,2)
> xy <- cbind(x,y)
> gplot(net,gmode="graph",label=net%v%"vertex.names",coord=xy,vertex.cex=net%v%"neg",vertex.col="blue")
> gplot(net,gmode="graph",label=net%v%"vertex.names",coord=xy,vertex.cex=net%v%"no",vertex.col="blue")
> gplot(net,gmode="graph",label=net%v%"vertex.names",coord=xy,vertex.cex=net%v%"pos",vertex.col="blue")
===== Chi-square test =====
> L <- as.edgelist.sna(M)
> head(L)
snd rec val
[1,] 5 1 1
[2,] 9 1 1
[3,] 12 1 1
[4,] 14 1 1
[5,] 11 2 1
[6,] 5 3 1
> gender
[1] 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2
> Tc <- 10*gender[L[,1]]+gender[L[,2]]
> Tc
[1] 11 21 21 21 21 11 11 11 11 11 11 11 11 11 11 11 11 11 11 11 11 11 21 11 11
[26] 22 22 22 22 12 22 22 12 22 22 22 22 22 22 22 22 12 22 22 22 22 12 22 22 22
[51] 22 22 22 22
> table(Tc)
Tc
11 12 21 22
20 4 5 25
> CT <- matrix(table(Tc),nrow=2,ncol=2,byrow=TRUE)
> rownames(CT) <- colnames(CT) <- c("F","M")
> CT
F M
F 20 4
M 5 25
> Net <- network(M,directed=FALSE,loops=FALSE,bipartite=FALSE,matrix.type="adjacency")
> summary(Net)
Network attributes:
vertices = 18
directed = FALSE
hyper = FALSE
loops = FALSE
multiple = FALSE
bipartite = FALSE
total edges = 35
missing edges = 0
non-missing edges = 35
density = 0.2287582
> L <- as.edgelist.sna(Net)
> L
[,1] [,2] [,3]
[1,] 4 1 1
[2,] 5 1 1
[3,] 9 1 1
[4,] 12 1 1
...
[67,] 15 18 1
[68,] 16 17 1
[69,] 16 18 1
[70,] 17 18 1
> Tu <- 10*gender[L[,1]]+gender[L[,2]]
> J <- table(Tu)
> J
Tu
11 12 21 22
24 7 7 32
> t <- table(gender)
> t
gender
1 2
8 10
> t %o% t
gender
gender 1 2
1 64 80
2 80 100
> H <- t %o% t - diag(t)
> H
gender
gender 1 2
1 56 80
2 80 90
> n <- length(gender)
> U <- matrix(J,nrow=2,byrow=TRUE)
> U
[,1] [,2]
[1,] 24 7
[2,] 7 32
> U/H
gender
gender 1 2
1 0.4285714 0.0875000
2 0.0875000 0.3555556
> m <- length(Tu)
> m
[1] 70
> u <- as.vector(U)
> u
[1] 24 7 7 32
> sum(u)
[1] 70
> g <- m/n/(n-1)
> E <- H*g
> E
gender
gender 1 2
1 12.81046 18.30065
2 18.30065 20.58824
> sum(E)
[1] 70
> e <- as.vector(E)
> e
[1] 12.81046 18.30065 18.30065 20.58824
> (u-e)**2/e
[1] 9.773723 6.978154 6.978154 6.325378
> chi <- sum((u-e)**2/e)
> chi
[1] 30.05541