Update 2015-11-09: This is migration from an old post.

I took the SNA course by Lada Adamic in coursera. It’s a super interesting course. In fact, I was using the networks only how a visualization tool, and that is what it make me little bit embarrassing because there are more, a lot of more. You can detect communities, know more centric nodes and a lot of other information. So, there are a lot of reasons to look the course

By other hand I like the d3 javascript library. Recently I was learning javascript, so I decided make a very little app to keep learning this library and show differents measures of centrality for each node in a set of 4 toy networks and see these measures by size, color or a label

Now, the R code to make the data:

##### Load Packages ####
library(sna) 
## Loading required package: statnet.common
## 
## Attaching package: 'statnet.common'
## The following object is masked from 'package:base':
## 
##     order
## Loading required package: network
## network: Classes for Relational Data
## Version 1.13.0 created on 2015-08-31.
## copyright (c) 2005, Carter T. Butts, University of California-Irvine
##                     Mark S. Handcock, University of California -- Los Angeles
##                     David R. Hunter, Penn State University
##                     Martina Morris, University of Washington
##                     Skye Bender-deMoll, University of Washington
##  For citation information, type citation("network").
##  Type help("network-package") to get started.
## sna: Tools for Social Network Analysis
## Version 2.4 created on 2016-07-23.
## copyright (c) 2005, Carter T. Butts, University of California-Irvine
##  For citation information, type citation("sna").
##  Type help(package="sna") to get started.
# for build a block diagonal matrix
library(Matrix)   
# (https://stat.ethz.ch/pipermail/r-help/2007-June/133875.html)
library(reldist)  
## Warning: package 'reldist' was built under R version 3.4.4
## reldist: Relative Distribution Methods
## Version 1.6-6 created on 2016-10-07.
## copyright (c) 2003, Mark S. Handcock, University of California-Los Angeles
##  For citation information, type citation("reldist").
##  Type help(package="reldist") to get started.
library(plyr)
## 
## Attaching package: 'plyr'
## The following object is masked from 'package:network':
## 
##     is.discrete
library(rjson)

##### Functions ####
degree_sna <- function(net, norm = TRUE, ...){
  degree(net, ...)/2/(if (norm) ncol(net) - 1 else 1)
}

betweenness_sna <- function(net, norm = FALSE, ...){
  n <- ncol(net)
  betweenness(net, ...)/2/(if (norm) (n - 1)*(n - 2)/2 else 1)
}

##### Networks ####
net.butterfly <- matrix(c(0,1,1,0,0,0,0,
                          1,0,1,0,0,0,0,
                          1,1,0,1,0,0,0,
                          0,0,1,0,1,0,0,
                          0,0,0,1,0,1,1,
                          0,0,0,0,1,0,1,
                          0,0,0,0,1,1,0),
                        byrow = TRUE, nrow = 7)

net.star <- matrix(c(0,1,1,1,1,1,
                     1,0,0,0,0,0,
                     1,0,0,0,0,0,
                     1,0,0,0,0,0,
                     1,0,0,0,0,0,
                     1,0,0,0,0,0),
                   byrow = TRUE, nrow = 6)

net.line <- matrix(c(0,1,0,0,0,
                     1,0,1,0,0,
                     0,1,0,1,0,
                     0,0,1,0,1,
                     0,0,0,1,0),
                   byrow = TRUE, nrow = 5)

net.circular <- matrix(c(0,1,0,0,1,
                         1,0,1,0,0,
                         0,1,0,1,0,
                         0,0,1,0,1,
                         1,0,0,1,0),
                       byrow = TRUE, nrow = 5)

nets <- list(net.butterfly, net.star, net.line, net.circular)
net.all <- as.matrix(bdiag(net.butterfly, net.star, net.line, net.circular))


##### Plots ####
gplot(net.butterfly, displaylabels = TRUE, usearrows = FALSE)

gplot(net.star, displaylabels = TRUE, usearrows = FALSE)

gplot(net.line, displaylabels = TRUE, usearrows = FALSE)

gplot(net.circular, displaylabels = TRUE, usearrows = FALSE)

gplot(net.all, usearrows = FALSE,
      label = unlist(llply(nets, degree_sna, norm = FALSE)))

#### Indicators ####
# Degrees for each node of each network
llply(nets, degree_sna)
## [[1]]
## [1] 0.3333333 0.3333333 0.5000000 0.3333333 0.5000000 0.3333333 0.3333333
## 
## [[2]]
## [1] 1.0 0.2 0.2 0.2 0.2 0.2
## 
## [[3]]
## [1] 0.25 0.50 0.50 0.50 0.25
## 
## [[4]]
## [1] 0.5 0.5 0.5 0.5 0.5
llply(nets, degree_sna, norm = FALSE)
## [[1]]
## [1] 2 2 3 2 3 2 2
## 
## [[2]]
## [1] 5 1 1 1 1 1
## 
## [[3]]
## [1] 1 2 2 2 1
## 
## [[4]]
## [1] 2 2 2 2 2
# Differences beetween degree for nodes in each network
laply(nets, function(net){ gini(degree_sna(net)) })
## [1] 0.08928571 0.33333333 0.15000000 0.00000000
laply(nets, function(net){   sd(degree_sna(net)) })
## [1] 0.08132501 0.32659863 0.13693064 0.00000000
# Centralization coefficient $C_D$
laply(nets, centralization, degree)
## [1] 0.1666667 1.0000000 0.1666667 0.0000000
# Betweenness
llply(nets, betweenness_sna)
## [[1]]
## [1] 0 0 8 9 8 0 0
## 
## [[2]]
## [1] 10  0  0  0  0  0
## 
## [[3]]
## [1] 0 3 4 3 0
## 
## [[4]]
## [1] 1 1 1 1 1
llply(nets, betweenness_sna, norm = TRUE)
## [[1]]
## [1] 0.0000000 0.0000000 0.5333333 0.6000000 0.5333333 0.0000000 0.0000000
## 
## [[2]]
## [1] 1 0 0 0 0 0
## 
## [[3]]
## [1] 0.0000000 0.5000000 0.6666667 0.5000000 0.0000000
## 
## [[4]]
## [1] 0.1666667 0.1666667 0.1666667 0.1666667 0.1666667
# Closeness
llply(nets, closeness)
## [[1]]
## [1] 0.4000000 0.4000000 0.5454545 0.6000000 0.5454545 0.4000000 0.4000000
## 
## [[2]]
## [1] 1.0000000 0.5555556 0.5555556 0.5555556 0.5555556 0.5555556
## 
## [[3]]
## [1] 0.4000000 0.5714286 0.6666667 0.5714286 0.4000000
## 
## [[4]]
## [1] 0.6666667 0.6666667 0.6666667 0.6666667 0.6666667
# Eigenvector Centrality
llply(nets, evcent)
## Warning in FUN(X[[i]], ...): Maximum iterations exceeded in evcent_R
## without convergence. This matrix may be pathological - increase maxiter or
## try eigen().
## Warning in FUN(X[[i]], ...): Maximum iterations exceeded in evcent_R
## without convergence. This matrix may be pathological - increase maxiter or
## try eigen().
## [[1]]
## [1] 0.3348053 0.3348053 0.4496177 0.3838092 0.4496177 0.3348053 0.3348053
## 
## [[2]]
## [1] 0.4082483 0.4082483 0.4082483 0.4082483 0.4082483 0.4082483
## 
## [[3]]
## [1] 0.3086067 0.4629100 0.6172134 0.4629100 0.3086067
## 
## [[4]]
## [1] 0.4472136 0.4472136 0.4472136 0.4472136 0.4472136
#### Consolidate Data ####
names <- paste(rep(1:length(nets), laply(nets, ncol)),
               unlist(llply(nets, function(x) 1:ncol(x))), sep = "_")

colnames(net.all) <- names
rownames(net.all) <- names

links <- ldply(names, function(name){
  # name <- sample(names, size = 1)
  # name <- names[1]
  data.frame(source = which(names == name) - 1, 
             target = which(net.all[name,] == 1) - 1)
})

nodes <- data.frame(name = names)
nodes$degree_norm <- unlist(llply(nets, degree_sna))
nodes$degree <- unlist(llply(nets, degree_sna, norm = FALSE))
nodes$betweenness <- unlist(llply(nets, betweenness_sna))
nodes$betweenness_norm <- unlist(llply(nets, betweenness_sna, norm = TRUE))
nodes$closeness <- unlist(llply(nets, closeness))
nodes$eigen_vector_centrality <- unlist(llply(nets, evcent))
## Warning in FUN(X[[i]], ...): Maximum iterations exceeded in evcent_R
## without convergence. This matrix may be pathological - increase maxiter or
## try eigen().

## Warning in FUN(X[[i]], ...): Maximum iterations exceeded in evcent_R
## without convergence. This matrix may be pathological - increase maxiter or
## try eigen().
#### Exporting Data ####
nodes_json <- adply(nodes, 1, toJSON )$V1
nodes_json <- paste(" \"nodes\" : [", paste("\n", nodes_json, collapse = ", "), "\n]")

links_json <- adply(links, 1, toJSON)$V1
links_json <- paste(" \"links\" : [", paste("\n", links_json, collapse = ", "), "\n]")

data_json <- paste("{\n", nodes_json, "\n,\n", links_json, "}")
# write(data_json, "data.json")

You can fork the repo from here.

comments powered by Disqus