Basic statistical models

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

Networks; Models; 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