R社会网络分析教程六

原创 2016-01-03 16:08  阅读 718 次 评论 0 条

# LAB 6 - Blockmodeling Lab
# The point of this lab is to introduce students to blockmodeling techniques that call for a metric of structural equivalence, a method
# and rationale for the selection of the number of positions, and then a means of summary representation (mean cutoff and reduced graph
# presentation). Students will be shown how to identify positions using correlation as a metric of structural equivalence (euclidean distance
# is used in earlier lab), and they will be taught how to identify more isomorphic notions of role-position using the triad census. Last, the
# lab calls upon the user to compare positional techniques and come up  with a rationale for why they settle on one over another.
#1. SETUP
###
library(igraph)
library(sna)
     Tools for Social Network Analysis
Version      2.0-1 created on      2009-06-07.
copyright (c) 2005, Carter T. Butts, University of California-Irvine
Type help(package="sna") to get started.
Attaching package: ’sna’

 The following object(s) are masked from package:igraph :
  %c%,
  betweenness,
  bonpow,
  closeness,
  degree,
  dyad.census,
  evcent,
  is.connected,
  neighborhood,
  triad.census
library(triads)
library(psych)
library(nFactors)
Loading required package: MASS
Loading required package: boot
Attaching package: ’boot’

 The following object(s) are masked from package:psych :
  logit
Loading required package: lattice
Attaching package: ’lattice’

 The following object(s) are masked from package:boot :
  melanoma

Attaching package: ’nFactors’

 The following object(s) are masked from package:lattice :
  parallel
library(NetCluster)

###
#2. LOADING AND FORMATTING DATA
###

data(studentnets.M182, package = "NetData")

# Reduce to non-zero edges and build a graph object
m182_full_nonzero_edges <- subset(m182_full_data_frame, (friend_tie 0 | social_tie 0 | task_tie 0))
head(m182_full_nonzero_edges)
   ego alter friend_tie social_tie task_tie
5    1     5          0       1.20     0.30
8    1     8          0       0.15     0.00
9    1     9          0       2.85     0.30
10   1    10          0       6.45     0.30
11   1    11          0       0.30     0.00
12   1    12          0       1.95     0.15

m182_full <- graph.data.frame(m182_full_nonzero_edges)
summary(m182_full)
Vertices: 16
Edges: 144
Directed: TRUE
No graph attributes.
Vertex attributes: name.
Edge attributes: friend_tie, social_tie, task_tie.

# Create sub-graphs based on edge attributes
m182_friend <- delete.edges(m182_full, E(m182_full)[E(m182_full)$friend_tie==0])
summary(m182_friend)
Vertices: 16
Edges: 62
Directed: TRUE
No graph attributes.
Vertex attributes: name.
Edge attributes: friend_tie, social_tie, task_tie.

m182_social <- delete.edges(m182_full, E(m182_full)[E(m182_full)$social_tie==0])
summary(m182_social)
Vertices: 16
Edges: 129
Directed: TRUE
No graph attributes.
Vertex attributes: name.
Edge attributes: friend_tie, social_tie, task_tie.

m182_task <- delete.edges(m182_full, E(m182_full)[E(m182_full)$task_tie==0])
summary(m182_task)
Vertices: 16
Edges: 88
Directed: TRUE
No graph attributes.
Vertex attributes: name.
Edge attributes: friend_tie, social_tie, task_tie.

# Look at the plots for each sub-graph
friend_layout <- layout.fruchterman.reingold(m182_friend)
plot(m182_friend, layout=friend_layout, edge.arrow.size=.5)

social_layout <- layout.fruchterman.reingold(m182_social)
plot(m182_social, layout=social_layout, edge.arrow.size=.5)

task_layout <- layout.fruchterman.reingold(m182_task)
plot(m182_task, layout=task_layout, edge.arrow.size=.5)

###
# 3. HIERARCHICAL CLUSTERING ON SOCIAL & TASK TIES
###

# We’ll use the "task" and "social" sub-graphs together as the
# basis for our structural equivalence methods. First, we’ll use
# the task graph to generate an adjacency matrix.
#
# This matrix represents task interactions directed FROM the
# row individual TO the column individual.
m182_task_matrix_row_to_col <- get.adjacency(m182_task, attr=’task_tie’)
m182_task_matrix_row_to_col
      1    2    3    4    5    6    7    8    9   10  11   12   13   14   15
1  0.00 0.00 0.00 0.00 0.30 0.00 0.00 0.00 0.30 0.30 0.0 0.15 0.00 0.00 0.15
2  0.00 0.00 0.00 0.00 0.00 0.00 0.75 0.30 0.00 0.00 0.0 0.00 0.90 0.15 0.15
3  0.00 0.00 0.00 0.00 0.15 0.60 0.00 0.00 0.00 0.00 0.3 0.00 0.00 0.00 0.00
4  0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.15 0.0 0.00 0.00 0.00 0.00
5  0.30 0.00 0.15 0.00 0.00 0.75 0.00 0.00 0.00 0.00 2.1 0.00 0.15 0.00 0.00
6  0.00 0.00 0.75 0.00 0.45 0.00 0.00 0.00 0.00 0.15 0.3 0.00 0.00 0.00 0.00
7  0.00 1.20 0.00 0.00 0.00 0.00 0.00 0.15 0.00 0.00 0.0 0.00 0.30 0.00 0.00
8  0.00 0.45 0.00 0.00 0.00 0.00 0.30 0.00 0.00 0.00 0.0 0.00 0.75 0.15 0.00
9  0.15 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.30 0.0 2.70 0.00 0.00 0.15
10 0.15 0.00 0.00 0.15 0.00 0.30 0.00 0.00 0.45 0.00 0.0 0.75 0.00 0.00 0.30
11 0.00 0.00 0.15 0.00 1.80 0.45 0.00 0.00 0.00 0.00 0.0 0.00 0.00 0.00 0.00
12 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 2.40 0.45 0.0 0.00 0.00 0.00 0.75
13 0.00 1.05 0.00 0.00 0.00 0.00 0.30 0.60 0.00 0.00 0.0 0.00 0.00 0.00 0.00
14 0.00 0.30 0.00 0.00 0.15 0.15 0.15 0.30 0.00 0.00 0.0 0.00 0.00 0.00 0.00
15 0.15 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.15 0.30 0.0 0.45 0.00 0.00 0.00
16 4.65 4.80 0.75 1.05 2.40 1.20 2.40 1.95 2.85 5.40 1.2 5.25 3.90 3.90 5.55
     16
1  5.10
2  4.80
3  0.30
4  0.90
5  1.80
6  0.90
7  2.85
8  2.40
9  2.40
10 5.40
11 1.05
12 4.50
13 4.50
14 3.15
15 6.60
16 0.00

# To operate on a binary graph, simply leave off the "attr"
# parameter:
m182_task_matrix_row_to_col_bin <- get.adjacency(m182_task)
m182_task_matrix_row_to_col_bin
   1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
1  0 0 0 0 1 0 0 0 1  1  0  1  0  0  1  1
2  0 0 0 0 0 0 1 1 0  0  0  0  1  1  1  1
3  0 0 0 0 1 1 0 0 0  0  1  0  0  0  0  1
4  0 0 0 0 0 0 0 0 0  1  0  0  0  0  0  1
5  1 0 1 0 0 1 0 0 0  0  1  0  1  0  0  1
6  0 0 1 0 1 0 0 0 0  1  1  0  0  0  0  1
7  0 1 0 0 0 0 0 1 0  0  0  0  1  0  0  1
8  0 1 0 0 0 0 1 0 0  0  0  0  1  1  0  1
9  1 0 0 0 0 0 0 0 0  1  0  1  0  0  1  1
10 1 0 0 1 0 1 0 0 1  0  0  1  0  0  1  1
11 0 0 1 0 1 1 0 0 0  0  0  0  0  0  0  1
12 0 0 0 0 0 0 0 0 1  1  0  0  0  0  1  1
13 0 1 0 0 0 0 1 1 0  0  0  0  0  0  0  1
14 0 1 0 0 1 1 1 1 0  0  0  0  0  0  0  1
15 1 0 0 0 0 0 0 0 1  1  0  1  0  0  0  1
16 1 1 1 1 1 1 1 1 1  1  1  1  1  1  1  0

# For this lab, we’ll use the valued graph. The next step is to
# concatenate it with its transpose in order to capture both
# incoming and outgoing task interactions.
m182_task_matrix_col_to_row <- t(m182_task_matrix_row_to_col)
m182_task_matrix_col_to_row
      1    2    3    4    5    6    7    8    9   10   11   12   13   14   15
1  0.00 0.00 0.00 0.00 0.30 0.00 0.00 0.00 0.15 0.15 0.00 0.00 0.00 0.00 0.15
2  0.00 0.00 0.00 0.00 0.00 0.00 1.20 0.45 0.00 0.00 0.00 0.00 1.05 0.30 0.00
3  0.00 0.00 0.00 0.00 0.15 0.75 0.00 0.00 0.00 0.00 0.15 0.00 0.00 0.00 0.00
4  0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.15 0.00 0.00 0.00 0.00 0.00
5  0.30 0.00 0.15 0.00 0.00 0.45 0.00 0.00 0.00 0.00 1.80 0.00 0.00 0.15 0.00
6  0.00 0.00 0.60 0.00 0.75 0.00 0.00 0.00 0.00 0.30 0.45 0.00 0.00 0.15 0.00
7  0.00 0.75 0.00 0.00 0.00 0.00 0.00 0.30 0.00 0.00 0.00 0.00 0.30 0.15 0.00
8  0.00 0.30 0.00 0.00 0.00 0.00 0.15 0.00 0.00 0.00 0.00 0.00 0.60 0.30 0.00
9  0.30 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.45 0.00 2.40 0.00 0.00 0.15
10 0.30 0.00 0.00 0.15 0.00 0.15 0.00 0.00 0.30 0.00 0.00 0.45 0.00 0.00 0.30
11 0.00 0.00 0.30 0.00 2.10 0.30 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
12 0.15 0.00 0.00 0.00 0.00 0.00 0.00 0.00 2.70 0.75 0.00 0.00 0.00 0.00 0.45
13 0.00 0.90 0.00 0.00 0.15 0.00 0.30 0.75 0.00 0.00 0.00 0.00 0.00 0.00 0.00
14 0.00 0.15 0.00 0.00 0.00 0.00 0.00 0.15 0.00 0.00 0.00 0.00 0.00 0.00 0.00
15 0.15 0.15 0.00 0.00 0.00 0.00 0.00 0.00 0.15 0.30 0.00 0.75 0.00 0.00 0.00
16 5.10 4.80 0.30 0.90 1.80 0.90 2.85 2.40 2.40 5.40 1.05 4.50 4.50 3.15 6.60
     16
1  4.65
2  4.80
3  0.75
4  1.05
5  2.40
6  1.20
7  2.40
8  1.95
9  2.85
10 5.40
11 1.20
12 5.25
13 3.90
14 3.90
15 5.55
16 0.00

m182_task_matrix <- rbind(m182_task_matrix_row_to_col, m182_task_matrix_col_to_row)
m182_task_matrix
      1    2    3    4    5    6    7    8    9   10   11   12   13   14   15
1  0.00 0.00 0.00 0.00 0.30 0.00 0.00 0.00 0.30 0.30 0.00 0.15 0.00 0.00 0.15
2  0.00 0.00 0.00 0.00 0.00 0.00 0.75 0.30 0.00 0.00 0.00 0.00 0.90 0.15 0.15
3  0.00 0.00 0.00 0.00 0.15 0.60 0.00 0.00 0.00 0.00 0.30 0.00 0.00 0.00 0.00
4  0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.15 0.00 0.00 0.00 0.00 0.00
5  0.30 0.00 0.15 0.00 0.00 0.75 0.00 0.00 0.00 0.00 2.10 0.00 0.15 0.00 0.00
6  0.00 0.00 0.75 0.00 0.45 0.00 0.00 0.00 0.00 0.15 0.30 0.00 0.00 0.00 0.00
7  0.00 1.20 0.00 0.00 0.00 0.00 0.00 0.15 0.00 0.00 0.00 0.00 0.30 0.00 0.00
8  0.00 0.45 0.00 0.00 0.00 0.00 0.30 0.00 0.00 0.00 0.00 0.00 0.75 0.15 0.00
9  0.15 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.30 0.00 2.70 0.00 0.00 0.15
10 0.15 0.00 0.00 0.15 0.00 0.30 0.00 0.00 0.45 0.00 0.00 0.75 0.00 0.00 0.30
11 0.00 0.00 0.15 0.00 1.80 0.45 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
12 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 2.40 0.45 0.00 0.00 0.00 0.00 0.75
13 0.00 1.05 0.00 0.00 0.00 0.00 0.30 0.60 0.00 0.00 0.00 0.00 0.00 0.00 0.00
14 0.00 0.30 0.00 0.00 0.15 0.15 0.15 0.30 0.00 0.00 0.00 0.00 0.00 0.00 0.00
15 0.15 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.15 0.30 0.00 0.45 0.00 0.00 0.00
16 4.65 4.80 0.75 1.05 2.40 1.20 2.40 1.95 2.85 5.40 1.20 5.25 3.90 3.90 5.55
1  0.00 0.00 0.00 0.00 0.30 0.00 0.00 0.00 0.15 0.15 0.00 0.00 0.00 0.00 0.15
2  0.00 0.00 0.00 0.00 0.00 0.00 1.20 0.45 0.00 0.00 0.00 0.00 1.05 0.30 0.00
3  0.00 0.00 0.00 0.00 0.15 0.75 0.00 0.00 0.00 0.00 0.15 0.00 0.00 0.00 0.00
4  0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.15 0.00 0.00 0.00 0.00 0.00
5  0.30 0.00 0.15 0.00 0.00 0.45 0.00 0.00 0.00 0.00 1.80 0.00 0.00 0.15 0.00
6  0.00 0.00 0.60 0.00 0.75 0.00 0.00 0.00 0.00 0.30 0.45 0.00 0.00 0.15 0.00
7  0.00 0.75 0.00 0.00 0.00 0.00 0.00 0.30 0.00 0.00 0.00 0.00 0.30 0.15 0.00
8  0.00 0.30 0.00 0.00 0.00 0.00 0.15 0.00 0.00 0.00 0.00 0.00 0.60 0.30 0.00
9  0.30 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.45 0.00 2.40 0.00 0.00 0.15
10 0.30 0.00 0.00 0.15 0.00 0.15 0.00 0.00 0.30 0.00 0.00 0.45 0.00 0.00 0.30
11 0.00 0.00 0.30 0.00 2.10 0.30 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
12 0.15 0.00 0.00 0.00 0.00 0.00 0.00 0.00 2.70 0.75 0.00 0.00 0.00 0.00 0.45
13 0.00 0.90 0.00 0.00 0.15 0.00 0.30 0.75 0.00 0.00 0.00 0.00 0.00 0.00 0.00
14 0.00 0.15 0.00 0.00 0.00 0.00 0.00 0.15 0.00 0.00 0.00 0.00 0.00 0.00 0.00
15 0.15 0.15 0.00 0.00 0.00 0.00 0.00 0.00 0.15 0.30 0.00 0.75 0.00 0.00 0.00
16 5.10 4.80 0.30 0.90 1.80 0.90 2.85 2.40 2.40 5.40 1.05 4.50 4.50 3.15 6.60
     16
1  5.10
2  4.80
3  0.30
4  0.90
5  1.80
6  0.90
7  2.85
8  2.40
9  2.40
10 5.40
11 1.05
12 4.50
13 4.50
14 3.15
15 6.60
16 0.00
1  4.65
2  4.80
3  0.75
4  1.05
5  2.40
6  1.20
7  2.40
8  1.95
9  2.85
10 5.40
11 1.20
12 5.25
13 3.90
14 3.90
15 5.55
16 0.00

# Next, we’ll use the same procedure to add social-interaction
# information.
m182_social_matrix_row_to_col <- get.adjacency(m182_task, attr=’social_tie’)
m182_social_matrix_row_to_col
      1     2    3   4     5   6    7    8     9   10   11    12    13   14
1  0.00  0.00 0.00 0.0  1.20 0.0 0.00 0.00  2.85 6.45  0.0  1.95  0.00 0.00
2  0.00  0.00 0.00 0.0  0.00 0.0 2.25 3.90  0.00 0.00  0.0  0.00 14.10 3.45
3  0.00  0.00 0.00 0.0  0.75 9.3 0.00 0.00  0.00 0.00  0.9  0.00  0.00 0.00
4  0.00  0.00 0.00 0.0  0.00 0.0 0.00 0.00  0.00 0.30  0.0  0.00  0.00 0.00
5  1.20  0.00 0.75 0.0  0.00 1.5 0.00 0.00  0.00 0.00 13.2  0.00  0.15 0.00
6  0.00  0.00 9.30 0.0  1.50 0.0 0.00 0.00  0.00 0.60  1.8  0.00  0.00 0.00
7  0.00  2.25 0.00 0.0  0.00 0.0 0.00 4.20  0.00 0.00  0.0  0.00  4.35 0.00
8  0.00  4.05 0.00 0.0  0.00 0.0 4.20 0.00  0.00 0.00  0.0  0.00  8.40 4.65
9  2.70  0.00 0.00 0.0  0.00 0.0 0.00 0.00  0.00 1.35  0.0 10.80  0.00 0.00
10 6.75  0.00 0.00 0.3  0.00 0.6 0.00 0.00  1.35 0.00  0.0  4.05  0.00 0.00
11 0.00  0.00 0.90 0.0 13.20 1.8 0.00 0.00  0.00 0.00  0.0  0.00  0.00 0.00
12 0.00  0.00 0.00 0.0  0.00 0.0 0.00 0.00 10.65 3.90  0.0  0.00  0.00 0.00
13 0.00 14.70 0.00 0.0  0.00 0.0 4.35 8.55  0.00 0.00  0.0  0.00  0.00 0.00
14 0.00  3.45 0.00 0.0  0.00 0.3 3.45 4.80  0.00 0.00  0.0  0.00  0.00 0.00
15 5.10  0.00 0.00 0.0  0.00 0.0 0.00 0.00  4.20 0.90  0.0  4.80  0.00 0.00
16 1.20  1.35 0.30 0.3  0.45 0.3 1.05 1.20  0.45 1.20  0.3  1.35  1.35 1.05
     15   16
1  5.10 1.35
2  0.00 2.85
3  0.00 0.00
4  0.00 0.00
5  0.00 0.30
6  0.00 0.00
7  0.00 1.35
8  0.00 1.35
9  4.05 0.15
10 0.90 2.40
11 0.00 0.00
12 4.80 2.10
13 0.00 3.15
14 0.00 0.90
15 0.00 1.50
16 1.05 0.00

m182_social_matrix_row_to_col_bin <- get.adjacency(m182_task)
m182_social_matrix_row_to_col_bin
   1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
1  0 0 0 0 1 0 0 0 1  1  0  1  0  0  1  1
2  0 0 0 0 0 0 1 1 0  0  0  0  1  1  1  1
3  0 0 0 0 1 1 0 0 0  0  1  0  0  0  0  1
4  0 0 0 0 0 0 0 0 0  1  0  0  0  0  0  1
5  1 0 1 0 0 1 0 0 0  0  1  0  1  0  0  1
6  0 0 1 0 1 0 0 0 0  1  1  0  0  0  0  1
7  0 1 0 0 0 0 0 1 0  0  0  0  1  0  0  1
8  0 1 0 0 0 0 1 0 0  0  0  0  1  1  0  1
9  1 0 0 0 0 0 0 0 0  1  0  1  0  0  1  1
10 1 0 0 1 0 1 0 0 1  0  0  1  0  0  1  1
11 0 0 1 0 1 1 0 0 0  0  0  0  0  0  0  1
12 0 0 0 0 0 0 0 0 1  1  0  0  0  0  1  1
13 0 1 0 0 0 0 1 1 0  0  0  0  0  0  0  1
14 0 1 0 0 1 1 1 1 0  0  0  0  0  0  0  1
15 1 0 0 0 0 0 0 0 1  1  0  1  0  0  0  1
16 1 1 1 1 1 1 1 1 1  1  1  1  1  1  1  0

m182_social_matrix_col_to_row <- t(m182_social_matrix_row_to_col)
m182_social_matrix_col_to_row
      1     2    3   4     5   6    7    8     9   10   11    12    13   14  15
1  0.00  0.00 0.00 0.0  1.20 0.0 0.00 0.00  2.70 6.75  0.0  0.00  0.00 0.00 5.1
2  0.00  0.00 0.00 0.0  0.00 0.0 2.25 4.05  0.00 0.00  0.0  0.00 14.70 3.45 0.0
3  0.00  0.00 0.00 0.0  0.75 9.3 0.00 0.00  0.00 0.00  0.9  0.00  0.00 0.00 0.0
4  0.00  0.00 0.00 0.0  0.00 0.0 0.00 0.00  0.00 0.30  0.0  0.00  0.00 0.00 0.0
5  1.20  0.00 0.75 0.0  0.00 1.5 0.00 0.00  0.00 0.00 13.2  0.00  0.00 0.00 0.0
6  0.00  0.00 9.30 0.0  1.50 0.0 0.00 0.00  0.00 0.60  1.8  0.00  0.00 0.30 0.0
7  0.00  2.25 0.00 0.0  0.00 0.0 0.00 4.20  0.00 0.00  0.0  0.00  4.35 3.45 0.0
8  0.00  3.90 0.00 0.0  0.00 0.0 4.20 0.00  0.00 0.00  0.0  0.00  8.55 4.80 0.0
9  2.85  0.00 0.00 0.0  0.00 0.0 0.00 0.00  0.00 1.35  0.0 10.65  0.00 0.00 4.2
10 6.45  0.00 0.00 0.3  0.00 0.6 0.00 0.00  1.35 0.00  0.0  3.90  0.00 0.00 0.9
11 0.00  0.00 0.90 0.0 13.20 1.8 0.00 0.00  0.00 0.00  0.0  0.00  0.00 0.00 0.0
12 1.95  0.00 0.00 0.0  0.00 0.0 0.00 0.00 10.80 4.05  0.0  0.00  0.00 0.00 4.8
13 0.00 14.10 0.00 0.0  0.15 0.0 4.35 8.40  0.00 0.00  0.0  0.00  0.00 0.00 0.0
14 0.00  3.45 0.00 0.0  0.00 0.0 0.00 4.65  0.00 0.00  0.0  0.00  0.00 0.00 0.0
15 5.10  0.00 0.00 0.0  0.00 0.0 0.00 0.00  4.05 0.90  0.0  4.80  0.00 0.00 0.0
16 1.35  2.85 0.00 0.0  0.30 0.0 1.35 1.35  0.15 2.40  0.0  2.10  3.15 0.90 1.5
     16
1  1.20
2  1.35
3  0.30
4  0.30
5  0.45
6  0.30
7  1.05
8  1.20
9  0.45
10 1.20
11 0.30
12 1.35
13 1.35
14 1.05
15 1.05
16 0.00

m182_social_matrix <- rbind(m182_social_matrix_row_to_col, m182_social_matrix_col_to_row)
m182_social_matrix
      1     2    3   4     5   6    7    8     9   10   11    12    13   14
1  0.00  0.00 0.00 0.0  1.20 0.0 0.00 0.00  2.85 6.45  0.0  1.95  0.00 0.00
2  0.00  0.00 0.00 0.0  0.00 0.0 2.25 3.90  0.00 0.00  0.0  0.00 14.10 3.45
3  0.00  0.00 0.00 0.0  0.75 9.3 0.00 0.00  0.00 0.00  0.9  0.00  0.00 0.00
4  0.00  0.00 0.00 0.0  0.00 0.0 0.00 0.00  0.00 0.30  0.0  0.00  0.00 0.00
5  1.20  0.00 0.75 0.0  0.00 1.5 0.00 0.00  0.00 0.00 13.2  0.00  0.15 0.00
6  0.00  0.00 9.30 0.0  1.50 0.0 0.00 0.00  0.00 0.60  1.8  0.00  0.00 0.00
7  0.00  2.25 0.00 0.0  0.00 0.0 0.00 4.20  0.00 0.00  0.0  0.00  4.35 0.00
8  0.00  4.05 0.00 0.0  0.00 0.0 4.20 0.00  0.00 0.00  0.0  0.00  8.40 4.65
9  2.70  0.00 0.00 0.0  0.00 0.0 0.00 0.00  0.00 1.35  0.0 10.80  0.00 0.00
10 6.75  0.00 0.00 0.3  0.00 0.6 0.00 0.00  1.35 0.00  0.0  4.05  0.00 0.00
11 0.00  0.00 0.90 0.0 13.20 1.8 0.00 0.00  0.00 0.00  0.0  0.00  0.00 0.00
12 0.00  0.00 0.00 0.0  0.00 0.0 0.00 0.00 10.65 3.90  0.0  0.00  0.00 0.00
13 0.00 14.70 0.00 0.0  0.00 0.0 4.35 8.55  0.00 0.00  0.0  0.00  0.00 0.00
14 0.00  3.45 0.00 0.0  0.00 0.3 3.45 4.80  0.00 0.00  0.0  0.00  0.00 0.00
15 5.10  0.00 0.00 0.0  0.00 0.0 0.00 0.00  4.20 0.90  0.0  4.80  0.00 0.00
16 1.20  1.35 0.30 0.3  0.45 0.3 1.05 1.20  0.45 1.20  0.3  1.35  1.35 1.05
1  0.00  0.00 0.00 0.0  1.20 0.0 0.00 0.00  2.70 6.75  0.0  0.00  0.00 0.00
2  0.00  0.00 0.00 0.0  0.00 0.0 2.25 4.05  0.00 0.00  0.0  0.00 14.70 3.45
3  0.00  0.00 0.00 0.0  0.75 9.3 0.00 0.00  0.00 0.00  0.9  0.00  0.00 0.00
4  0.00  0.00 0.00 0.0  0.00 0.0 0.00 0.00  0.00 0.30  0.0  0.00  0.00 0.00
5  1.20  0.00 0.75 0.0  0.00 1.5 0.00 0.00  0.00 0.00 13.2  0.00  0.00 0.00
6  0.00  0.00 9.30 0.0  1.50 0.0 0.00 0.00  0.00 0.60  1.8  0.00  0.00 0.30
7  0.00  2.25 0.00 0.0  0.00 0.0 0.00 4.20  0.00 0.00  0.0  0.00  4.35 3.45
8  0.00  3.90 0.00 0.0  0.00 0.0 4.20 0.00  0.00 0.00  0.0  0.00  8.55 4.80
9  2.85  0.00 0.00 0.0  0.00 0.0 0.00 0.00  0.00 1.35  0.0 10.65  0.00 0.00
10 6.45  0.00 0.00 0.3  0.00 0.6 0.00 0.00  1.35 0.00  0.0  3.90  0.00 0.00
11 0.00  0.00 0.90 0.0 13.20 1.8 0.00 0.00  0.00 0.00  0.0  0.00  0.00 0.00
12 1.95  0.00 0.00 0.0  0.00 0.0 0.00 0.00 10.80 4.05  0.0  0.00  0.00 0.00
13 0.00 14.10 0.00 0.0  0.15 0.0 4.35 8.40  0.00 0.00  0.0  0.00  0.00 0.00
14 0.00  3.45 0.00 0.0  0.00 0.0 0.00 4.65  0.00 0.00  0.0  0.00  0.00 0.00
15 5.10  0.00 0.00 0.0  0.00 0.0 0.00 0.00  4.05 0.90  0.0  4.80  0.00 0.00
16 1.35  2.85 0.00 0.0  0.30 0.0 1.35 1.35  0.15 2.40  0.0  2.10  3.15 0.90
     15   16
1  5.10 1.35
2  0.00 2.85
3  0.00 0.00
4  0.00 0.00
5  0.00 0.30
6  0.00 0.00
7  0.00 1.35
8  0.00 1.35
9  4.05 0.15
10 0.90 2.40
11 0.00 0.00
12 4.80 2.10
13 0.00 3.15
14 0.00 0.90
15 0.00 1.50
16 1.05 0.00
1  5.10 1.20
2  0.00 1.35
3  0.00 0.30
4  0.00 0.30
5  0.00 0.45
6  0.00 0.30
7  0.00 1.05
8  0.00 1.20
9  4.20 0.45
10 0.90 1.20
11 0.00 0.30
12 4.80 1.35
13 0.00 1.35
14 0.00 1.05
15 0.00 1.05
16 1.50 0.00

m182_task_social_matrix <- rbind(m182_task_matrix, m182_social_matrix)
m182_task_social_matrix
      1     2    3    4     5    6    7    8     9   10    11    12    13   14
1  0.00  0.00 0.00 0.00  0.30 0.00 0.00 0.00  0.30 0.30  0.00  0.15  0.00 0.00
2  0.00  0.00 0.00 0.00  0.00 0.00 0.75 0.30  0.00 0.00  0.00  0.00  0.90 0.15
3  0.00  0.00 0.00 0.00  0.15 0.60 0.00 0.00  0.00 0.00  0.30  0.00  0.00 0.00
4  0.00  0.00 0.00 0.00  0.00 0.00 0.00 0.00  0.00 0.15  0.00  0.00  0.00 0.00
5  0.30  0.00 0.15 0.00  0.00 0.75 0.00 0.00  0.00 0.00  2.10  0.00  0.15 0.00
6  0.00  0.00 0.75 0.00  0.45 0.00 0.00 0.00  0.00 0.15  0.30  0.00  0.00 0.00
7  0.00  1.20 0.00 0.00  0.00 0.00 0.00 0.15  0.00 0.00  0.00  0.00  0.30 0.00
8  0.00  0.45 0.00 0.00  0.00 0.00 0.30 0.00  0.00 0.00  0.00  0.00  0.75 0.15
9  0.15  0.00 0.00 0.00  0.00 0.00 0.00 0.00  0.00 0.30  0.00  2.70  0.00 0.00
10 0.15  0.00 0.00 0.15  0.00 0.30 0.00 0.00  0.45 0.00  0.00  0.75  0.00 0.00
11 0.00  0.00 0.15 0.00  1.80 0.45 0.00 0.00  0.00 0.00  0.00  0.00  0.00 0.00
12 0.00  0.00 0.00 0.00  0.00 0.00 0.00 0.00  2.40 0.45  0.00  0.00  0.00 0.00
13 0.00  1.05 0.00 0.00  0.00 0.00 0.30 0.60  0.00 0.00  0.00  0.00  0.00 0.00
14 0.00  0.30 0.00 0.00  0.15 0.15 0.15 0.30  0.00 0.00  0.00  0.00  0.00 0.00
15 0.15  0.00 0.00 0.00  0.00 0.00 0.00 0.00  0.15 0.30  0.00  0.45  0.00 0.00
16 4.65  4.80 0.75 1.05  2.40 1.20 2.40 1.95  2.85 5.40  1.20  5.25  3.90 3.90
1  0.00  0.00 0.00 0.00  0.30 0.00 0.00 0.00  0.15 0.15  0.00  0.00  0.00 0.00
2  0.00  0.00 0.00 0.00  0.00 0.00 1.20 0.45  0.00 0.00  0.00  0.00  1.05 0.30
3  0.00  0.00 0.00 0.00  0.15 0.75 0.00 0.00  0.00 0.00  0.15  0.00  0.00 0.00
4  0.00  0.00 0.00 0.00  0.00 0.00 0.00 0.00  0.00 0.15  0.00  0.00  0.00 0.00
5  0.30  0.00 0.15 0.00  0.00 0.45 0.00 0.00  0.00 0.00  1.80  0.00  0.00 0.15
6  0.00  0.00 0.60 0.00  0.75 0.00 0.00 0.00  0.00 0.30  0.45  0.00  0.00 0.15
7  0.00  0.75 0.00 0.00  0.00 0.00 0.00 0.30  0.00 0.00  0.00  0.00  0.30 0.15
8  0.00  0.30 0.00 0.00  0.00 0.00 0.15 0.00  0.00 0.00  0.00  0.00  0.60 0.30
9  0.30  0.00 0.00 0.00  0.00 0.00 0.00 0.00  0.00 0.45  0.00  2.40  0.00 0.00
10 0.30  0.00 0.00 0.15  0.00 0.15 0.00 0.00  0.30 0.00  0.00  0.45  0.00 0.00
11 0.00  0.00 0.30 0.00  2.10 0.30 0.00 0.00  0.00 0.00  0.00  0.00  0.00 0.00
12 0.15  0.00 0.00 0.00  0.00 0.00 0.00 0.00  2.70 0.75  0.00  0.00  0.00 0.00
13 0.00  0.90 0.00 0.00  0.15 0.00 0.30 0.75  0.00 0.00  0.00  0.00  0.00 0.00
14 0.00  0.15 0.00 0.00  0.00 0.00 0.00 0.15  0.00 0.00  0.00  0.00  0.00 0.00
15 0.15  0.15 0.00 0.00  0.00 0.00 0.00 0.00  0.15 0.30  0.00  0.75  0.00 0.00
16 5.10  4.80 0.30 0.90  1.80 0.90 2.85 2.40  2.40 5.40  1.05  4.50  4.50 3.15
1  0.00  0.00 0.00 0.00  1.20 0.00 0.00 0.00  2.85 6.45  0.00  1.95  0.00 0.00
2  0.00  0.00 0.00 0.00  0.00 0.00 2.25 3.90  0.00 0.00  0.00  0.00 14.10 3.45
3  0.00  0.00 0.00 0.00  0.75 9.30 0.00 0.00  0.00 0.00  0.90  0.00  0.00 0.00
4  0.00  0.00 0.00 0.00  0.00 0.00 0.00 0.00  0.00 0.30  0.00  0.00  0.00 0.00
5  1.20  0.00 0.75 0.00  0.00 1.50 0.00 0.00  0.00 0.00 13.20  0.00  0.15 0.00
6  0.00  0.00 9.30 0.00  1.50 0.00 0.00 0.00  0.00 0.60  1.80  0.00  0.00 0.00
7  0.00  2.25 0.00 0.00  0.00 0.00 0.00 4.20  0.00 0.00  0.00  0.00  4.35 0.00
8  0.00  4.05 0.00 0.00  0.00 0.00 4.20 0.00  0.00 0.00  0.00  0.00  8.40 4.65
9  2.70  0.00 0.00 0.00  0.00 0.00 0.00 0.00  0.00 1.35  0.00 10.80  0.00 0.00
10 6.75  0.00 0.00 0.30  0.00 0.60 0.00 0.00  1.35 0.00  0.00  4.05  0.00 0.00
11 0.00  0.00 0.90 0.00 13.20 1.80 0.00 0.00  0.00 0.00  0.00  0.00  0.00 0.00
12 0.00  0.00 0.00 0.00  0.00 0.00 0.00 0.00 10.65 3.90  0.00  0.00  0.00 0.00
13 0.00 14.70 0.00 0.00  0.00 0.00 4.35 8.55  0.00 0.00  0.00  0.00  0.00 0.00
14 0.00  3.45 0.00 0.00  0.00 0.30 3.45 4.80  0.00 0.00  0.00  0.00  0.00 0.00
15 5.10  0.00 0.00 0.00  0.00 0.00 0.00 0.00  4.20 0.90  0.00  4.80  0.00 0.00
16 1.20  1.35 0.30 0.30  0.45 0.30 1.05 1.20  0.45 1.20  0.30  1.35  1.35 1.05
1  0.00  0.00 0.00 0.00  1.20 0.00 0.00 0.00  2.70 6.75  0.00  0.00  0.00 0.00
2  0.00  0.00 0.00 0.00  0.00 0.00 2.25 4.05  0.00 0.00  0.00  0.00 14.70 3.45
3  0.00  0.00 0.00 0.00  0.75 9.30 0.00 0.00  0.00 0.00  0.90  0.00  0.00 0.00
4  0.00  0.00 0.00 0.00  0.00 0.00 0.00 0.00  0.00 0.30  0.00  0.00  0.00 0.00
5  1.20  0.00 0.75 0.00  0.00 1.50 0.00 0.00  0.00 0.00 13.20  0.00  0.00 0.00
6  0.00  0.00 9.30 0.00  1.50 0.00 0.00 0.00  0.00 0.60  1.80  0.00  0.00 0.30
7  0.00  2.25 0.00 0.00  0.00 0.00 0.00 4.20  0.00 0.00  0.00  0.00  4.35 3.45
8  0.00  3.90 0.00 0.00  0.00 0.00 4.20 0.00  0.00 0.00  0.00  0.00  8.55 4.80
9  2.85  0.00 0.00 0.00  0.00 0.00 0.00 0.00  0.00 1.35  0.00 10.65  0.00 0.00
10 6.45  0.00 0.00 0.30  0.00 0.60 0.00 0.00  1.35 0.00  0.00  3.90  0.00 0.00
11 0.00  0.00 0.90 0.00 13.20 1.80 0.00 0.00  0.00 0.00  0.00  0.00  0.00 0.00
12 1.95  0.00 0.00 0.00  0.00 0.00 0.00 0.00 10.80 4.05  0.00  0.00  0.00 0.00
13 0.00 14.10 0.00 0.00  0.15 0.00 4.35 8.40  0.00 0.00  0.00  0.00  0.00 0.00
14 0.00  3.45 0.00 0.00  0.00 0.00 0.00 4.65  0.00 0.00  0.00  0.00  0.00 0.00
15 5.10  0.00 0.00 0.00  0.00 0.00 0.00 0.00  4.05 0.90  0.00  4.80  0.00 0.00
16 1.35  2.85 0.00 0.00  0.30 0.00 1.35 1.35  0.15 2.40  0.00  2.10  3.15 0.90
     15   16
1  0.15 5.10
2  0.15 4.80
3  0.00 0.30
4  0.00 0.90
5  0.00 1.80
6  0.00 0.90
7  0.00 2.85
8  0.00 2.40
9  0.15 2.40
10 0.30 5.40
11 0.00 1.05
12 0.75 4.50
13 0.00 4.50
14 0.00 3.15
15 0.00 6.60
16 5.55 0.00
1  0.15 4.65
2  0.00 4.80
3  0.00 0.75
4  0.00 1.05
5  0.00 2.40
6  0.00 1.20
7  0.00 2.40
8  0.00 1.95
9  0.15 2.85
10 0.30 5.40
11 0.00 1.20
12 0.45 5.25
13 0.00 3.90
14 0.00 3.90
15 0.00 5.55
16 6.60 0.00
1  5.10 1.35
2  0.00 2.85
3  0.00 0.00
4  0.00 0.00
5  0.00 0.30
6  0.00 0.00
7  0.00 1.35
8  0.00 1.35
9  4.05 0.15
10 0.90 2.40
11 0.00 0.00
12 4.80 2.10
13 0.00 3.15
14 0.00 0.90
15 0.00 1.50
16 1.05 0.00
1  5.10 1.20
2  0.00 1.35
3  0.00 0.30
4  0.00 0.30
5  0.00 0.45
6  0.00 0.30
7  0.00 1.05
8  0.00 1.20
9  4.20 0.45
10 0.90 1.20
11 0.00 0.30
12 4.80 1.35
13 0.00 1.35
14 0.00 1.05
15 0.00 1.05
16 1.50 0.00

# Now we have a single 4n x n matrix that represents both in- and
# out-directed task and social communication. From this, we can
# generate an n x n correlation matrix that shows the degree of
# structural equivalence of each actor in the network.
m182_task_social_cors <- cor(m182_task_social_matrix)
m182_task_social_cors
              1            2            3            4           5           6
1   1.000000000  0.008181433 -0.067114712  0.600921857 -0.04830312 -0.01154803
2   0.008181433  1.000000000 -0.075438297  0.206850624 -0.05724836 -0.08112171
3  -0.067114712 -0.075438297  1.000000000 -0.005377598  0.15884493 -0.03523042
4   0.600921857  0.206850624 -0.005377598  1.000000000  0.07773701  0.05098959
5  -0.048303124 -0.057248356  0.158844933  0.077737012  1.00000000  0.18380522
6  -0.011548032 -0.081121707 -0.035230422  0.050989592  0.18380522  1.00000000
7   0.016574471  0.780200059 -0.089401825  0.260199171 -0.06975067 -0.09160923
8  -0.072641922  0.823354736 -0.094080337  0.091275830 -0.09112988 -0.10540792
9   0.320884611 -0.074677149 -0.079640364  0.157341809 -0.05568491 -0.08549654
10  0.287834097  0.045517119 -0.003544792  0.475554290  0.04338668 -0.07127879
11  0.060157599 -0.075245157  0.167052464  0.013252867 -0.04472996  0.16933137
12  0.706448468 -0.026195255 -0.081074953  0.368234833 -0.05675941 -0.06830649
13 -0.018855121  0.124046172 -0.076357816  0.146729305 -0.07014722 -0.08777621
14  0.109590365  0.245544572 -0.039782038  0.413219006 -0.02754010 -0.06155805
15  0.406393300  0.050334781 -0.070670296  0.541374413  0.02246905 -0.05802797
16 -0.227234542 -0.082917632 -0.236172952 -0.168409035 -0.26433417 -0.27199926
             7           8           9           10          11          12
1   0.01657447 -0.07264192  0.32088461  0.287834097  0.06015760  0.70644847
2   0.78020006  0.82335474 -0.07467715  0.045517119 -0.07524516 -0.02619526
3  -0.08940183 -0.09408034 -0.07964036 -0.003544792  0.16705246 -0.08107495
4   0.26019917  0.09127583  0.15734181  0.475554290  0.01325287  0.36823483
5  -0.06975067 -0.09112988 -0.05568491  0.043386681 -0.04472996 -0.05675941
6  -0.09160923 -0.10540792 -0.08549654 -0.071278789  0.16933137 -0.06830649
7   1.00000000  0.64747482 -0.08684143  0.059615964 -0.08852312 -0.02843091
8   0.64747482  1.00000000 -0.11874330 -0.049195104 -0.09778570 -0.09414272
9  -0.08684143 -0.11874330  1.00000000  0.605778088 -0.08196615  0.11739678
10  0.05961596 -0.04919510  0.60577809  1.000000000 -0.05669091  0.29964445
11 -0.08852312 -0.09778570 -0.08196615 -0.056690909  1.00000000 -0.08042189
12 -0.02843091 -0.09414272  0.11739678  0.299644453 -0.08042189  1.00000000
13  0.54543051  0.32781543 -0.08509138  0.011844138 -0.07258542 -0.04675838
14  0.63332853  0.23908721 -0.02953223  0.164109377 -0.05360676  0.04946323
15  0.06942680 -0.04364811  0.60234608  0.916630404 -0.06124972  0.52200511
16 -0.09783064 -0.07620766 -0.02281276 -0.225155004 -0.21762708 -0.22436781
            13          14          15          16
1  -0.01885512  0.10959036  0.40639330 -0.22723454
2   0.12404617  0.24554457  0.05033478 -0.08291763
3  -0.07635782 -0.03978204 -0.07067030 -0.23617295
4   0.14672930  0.41321901  0.54137441 -0.16840903
5  -0.07014722 -0.02754010  0.02246905 -0.26433417
6  -0.08777621 -0.06155805 -0.05802797 -0.27199926
7   0.54543051  0.63332853  0.06942680 -0.09783064
8   0.32781543  0.23908721 -0.04364811 -0.07620766
9  -0.08509138 -0.02953223  0.60234608 -0.02281276
10  0.01184414  0.16410938  0.91663040 -0.22515500
11 -0.07258542 -0.05360676 -0.06124972 -0.21762708
12 -0.04675838  0.04946323  0.52200511 -0.22436781
13  1.00000000  0.84735919  0.01564220 -0.09716591
14  0.84735919  1.00000000  0.17465373 -0.18272028
15  0.01564220  0.17465373  1.00000000 -0.23517251
16 -0.09716591 -0.18272028 -0.23517251  1.00000000

# To use correlation values in hierarchical NetCluster, they must
# first be coerced into a "dissimilarity structure" using dist().
# We subtract the values from 1 so that they are all greater than
# or equal to 0; thus, highly dissimilar (i.e., negatively
# correlated) actors have higher values.
dissimilarity <- 1 - m182_task_social_cors
m182_task_social_dist <- as.dist(dissimilarity)
m182_task_social_dist
           1         2         3         4         5         6         7
2  0.9918186                                                           
3  1.0671147 1.0754383                                                 
4  0.3990781 0.7931494 1.0053776                                       
5  1.0483031 1.0572484 0.8411551 0.9222630                             
6  1.0115480 1.0811217 1.0352304 0.9490104 0.8161948                   
7  0.9834255 0.2197999 1.0894018 0.7398008 1.0697507 1.0916092         
8  1.0726419 0.1766453 1.0940803 0.9087242 1.0911299 1.1054079 0.3525252
9  0.6791154 1.0746771 1.0796404 0.8426582 1.0556849 1.0854965 1.0868414
10 0.7121659 0.9544829 1.0035448 0.5244457 0.9566133 1.0712788 0.9403840
11 0.9398424 1.0752452 0.8329475 0.9867471 1.0447300 0.8306686 1.0885231
12 0.2935515 1.0261953 1.0810750 0.6317652 1.0567594 1.0683065 1.0284309
13 1.0188551 0.8759538 1.0763578 0.8532707 1.0701472 1.0877762 0.4545695
14 0.8904096 0.7544554 1.0397820 0.5867810 1.0275401 1.0615581 0.3666715
15 0.5936067 0.9496652 1.0706703 0.4586256 0.9775310 1.0580280 0.9305732
16 1.2272345 1.0829176 1.2361730 1.1684090 1.2643342 1.2719993 1.0978306
           8         9        10        11        12        13        14
2                                                                      
3                                                                      
4                                                                      
5                                                                      
6                                                                      
7                                                                      
8                                                                      
9  1.1187433                                                           
10 1.0491951 0.3942219                                                 
11 1.0977857 1.0819661 1.0566909                                       
12 1.0941427 0.8826032 0.7003555 1.0804219                             
13 0.6721846 1.0850914 0.9881559 1.0725854 1.0467584                   
14 0.7609128 1.0295322 0.8358906 1.0536068 0.9505368 0.1526408         
15 1.0436481 0.3976539 0.0833696 1.0612497 0.4779949 0.9843578 0.8253463
16 1.0762077 1.0228128 1.2251550 1.2176271 1.2243678 1.0971659 1.1827203
          15
2          
3          
4          
5          
6          
7          
8          
9          
10         
11         
12         
13         
14         
15         
16 1.2351725

# Note that it is also possible to use dist() directly on the
# matrix. However, since cor() looks at associations between
# columns and dist() looks at associations between rows, it is
# necessary to transpose the matrix first.
#
# A variety of distance metrics are available; Euclidean
# is the default.
#m182_task_social_dist <- dist(t(m182_task_social_matrix))
#m182_task_social_dist

# hclust() performs a hierarchical agglomerative NetCluster
# operation based on the values in the dissimilarity matrix
# yielded by as.dist() above. The standard visualization is a
# dendrogram. By default, hclust() agglomerates clusters via a
# "complete linkakage" algorithm, determining cluster proximity
# by looking at the distance of the two points across clusters
# that are farthest away from one another. This can be changed via
# the "method" parameter.
m182_task_social_hclust <- hclust(m182_task_social_dist)
plot(m182_task_social_hclust)

# cutree() allows us to use the output of hclust() to set
# different numbers of clusters and assign vertices to clusters
# as appropriate. For example:
cutree(m182_task_social_hclust, k=2)
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  2

# Now we’ll try to figure out the number of clusters that best
# describes the underlying data. To do this, we’ll loop through
# all of the possible numbers of clusters (1 through n, where n is
# the number of actors in the network). For each solution
# corresponding to a given number of clusters, we’ll use cutree()
# to assign the vertices to their respective clusters
# corresponding to that solution.
#
# From this, we can generate a matrix of within- and between-
# cluster correlations. Thus, when there is one cluster for each
# vertex in the network, the cell values will be identical to the
# observed correlation matrix, and when there is one cluster for
# the whole network, the values will all be equal to the average
# correlation across the observed matrix.
#
# We can then correlate each by-cluster matrix with the observed
# correlation matrix to see how well the by-cluster matrix fits
# the data. We’ll store the correlation for each number of
# clusters in a vector, which we can then plot.

# First, we initialize a vector for storing the correlations and
# set a variable for our number of vertices.
clustered_observed_cors = vector()
num_vertices = length(V(m182_task))

# Next, we loop through the different possible cluster
# configurations, produce matrices of within- and between-
# cluster correlations, and correlate these by-cluster matrices
# with the observed correlation matrix.

clustered_observed_cors <-clustConfigurations(num_vertices,m182_task_social_hclust,m182_task_social_cors)
Warning message:
In cor(as.vector(d[g1[i], , ]), as.vector(d[g2[j], , ]), use = "complete.obs") :
  the standard deviation is zero
clustered_observed_cors
$label
[1] "number of clusters:  1"
$clusters
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1
$correlation
[1] NA
$label
[1] "number of clusters:  2"
$clusters
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  2
$correlation
[1] 0.3690311
$label
[1] "number of clusters:  3"
$clusters
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  1  1  1  1  2  2  1  1  1  1  2  2  1  3
$correlation
[1] 0.6678834
$label
[1] "number of clusters:  4"
$clusters
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  1  3  3  2  2  1  1  3  1  2  2  1  4
$correlation
[1] 0.860548
$label
[1] "number of clusters:  5"
$clusters
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  1  4  4  2  2  1  1  3  1  2  2  1  5
$correlation
[1] 0.8597826
$label
[1] "number of clusters:  6"
$clusters
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  1  4  4  2  2  5  5  3  1  2  2  5  6
$correlation
[1] 0.8829948
$label
[1] "number of clusters:  7"
$clusters
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  1  4  4  2  2  5  5  3  1  6  6  5  7
$correlation
[1] 0.9142175
$label
[1] "number of clusters:  8"
$clusters
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  1  4  4  2  2  5  5  6  1  7  7  5  8
$correlation
[1] 0.9225892
$label
[1] "number of clusters:  9"
$clusters
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  1  4  5  2  2  6  6  7  1  8  8  6  9
$correlation
[1] 0.934292
$label
[1] "number of clusters:  10"
$clusters
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  4  5  6  2  2  7  7  8  1  9  9  7 10
$correlation
[1] 0.951914
$label
[1] "number of clusters:  11"
$clusters
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  4  5  6  2  2  7  8  9  1 10 10  8 11
$correlation
[1] 0.9702271
$label
[1] "number of clusters:  12"
$clusters
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  4  5  6  7  2  8  9 10  1 11 11  9 12
$correlation
[1] 0.9828988
$label
[1] "number of clusters:  13"
$clusters
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  4  5  6  7  2  8  9 10 11 12 12  9 13
$correlation
[1] 0.9881683
$label
[1] "number of clusters:  14"
$clusters
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  4  5  6  7  8  9 10 11 12 13 13 10 14
$correlation
[1] 0.99119
$label
[1] "number of clusters:  15"
$clusters
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 10 15
$correlation
[1] 0.9975656
$label
[1] "number of clusters:  16"
$clusters
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
$correlation
[1] 1
$correlations
 [1]        NA 0.3690311 0.6678834 0.8605481 0.8597826 0.8829948 0.9142175
 [8] 0.9225892 0.9342920 0.9519140 0.9702271 0.9828988 0.9881683 0.9911899
[15] 0.9975656 1.0000000
plot(clustered_observed_cors$correlations)

clustered_observed_cors$correlations
 [1]        NA 0.3690311 0.6678834 0.8605481 0.8597826 0.8829948 0.9142175
 [8] 0.9225892 0.9342920 0.9519140 0.9702271 0.9828988 0.9881683 0.9911899
[15] 0.9975656 1.0000000
# From a visual inspection of the correlation matrix, we can
# decide on the proper number of clusters in this network.
# For this network, we’ll use 4. (Note that the 1-cluster
# solution doesn’t appear on the plot because its correlation
# with the observed correlation matrix is undefined.)
num_clusters = 4
clusters <- cutree(m182_task_social_hclust, k = num_clusters)
clusters
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  1  3  3  2  2  1  1  3  1  2  2  1  4

cluster_cor_mat <- clusterCorr(m182_task_social_cors,
+                                             clusters)
cluster_cor_mat
             1           2           3           4           5           6
1   0.55159937  0.03728248 -0.03229849  0.55159937 -0.03229849 -0.03229849
2   0.03728248  0.61709130 -0.07530479  0.03728248 -0.07530479 -0.07530479
3  -0.03229849 -0.07530479  0.32488420 -0.03229849  0.32488420  0.32488420
4   0.55159937  0.03728248 -0.03229849  0.55159937 -0.03229849 -0.03229849
5  -0.03229849 -0.07530479  0.32488420 -0.03229849  0.32488420  0.32488420
6  -0.03229849 -0.07530479  0.32488420 -0.03229849  0.32488420  0.32488420
7   0.03728248  0.61709130 -0.07530479  0.03728248 -0.07530479 -0.07530479
8   0.03728248  0.61709130 -0.07530479  0.03728248 -0.07530479 -0.07530479
9   0.55159937  0.03728248 -0.03229849  0.55159937 -0.03229849 -0.03229849
10  0.55159937  0.03728248 -0.03229849  0.55159937 -0.03229849 -0.03229849
11 -0.03229849 -0.07530479  0.32488420 -0.03229849  0.32488420  0.32488420
12  0.55159937  0.03728248 -0.03229849  0.55159937 -0.03229849 -0.03229849
13  0.03728248  0.61709130 -0.07530479  0.03728248 -0.07530479 -0.07530479
14  0.03728248  0.61709130 -0.07530479  0.03728248 -0.07530479 -0.07530479
15  0.55159937  0.03728248 -0.03229849  0.55159937 -0.03229849 -0.03229849
16 -0.18385861 -0.10736843 -0.24753336 -0.18385861 -0.24753336 -0.24753336
             7           8           9          10          11          12
1   0.03728248  0.03728248  0.55159937  0.55159937 -0.03229849  0.55159937
2   0.61709130  0.61709130  0.03728248  0.03728248 -0.07530479  0.03728248
3  -0.07530479 -0.07530479 -0.03229849 -0.03229849  0.32488420 -0.03229849
4   0.03728248  0.03728248  0.55159937  0.55159937 -0.03229849  0.55159937
5  -0.07530479 -0.07530479 -0.03229849 -0.03229849  0.32488420 -0.03229849
6  -0.07530479 -0.07530479 -0.03229849 -0.03229849  0.32488420 -0.03229849
7   0.61709130  0.61709130  0.03728248  0.03728248 -0.07530479  0.03728248
8   0.61709130  0.61709130  0.03728248  0.03728248 -0.07530479  0.03728248
9   0.03728248  0.03728248  0.55159937  0.55159937 -0.03229849  0.55159937
10  0.03728248  0.03728248  0.55159937  0.55159937 -0.03229849  0.55159937
11 -0.07530479 -0.07530479 -0.03229849 -0.03229849  0.32488420 -0.03229849
12  0.03728248  0.03728248  0.55159937  0.55159937 -0.03229849  0.55159937
13  0.61709130  0.61709130  0.03728248  0.03728248 -0.07530479  0.03728248
14  0.61709130  0.61709130  0.03728248  0.03728248 -0.07530479  0.03728248
15  0.03728248  0.03728248  0.55159937  0.55159937 -0.03229849  0.55159937
16 -0.10736843 -0.10736843 -0.18385861 -0.18385861 -0.24753336 -0.18385861
            13          14          15         16
1   0.03728248  0.03728248  0.55159937 -0.1838586
2   0.61709130  0.61709130  0.03728248 -0.1073684
3  -0.07530479 -0.07530479 -0.03229849 -0.2475334
4   0.03728248  0.03728248  0.55159937 -0.1838586
5  -0.07530479 -0.07530479 -0.03229849 -0.2475334
6  -0.07530479 -0.07530479 -0.03229849 -0.2475334
7   0.61709130  0.61709130  0.03728248 -0.1073684
8   0.61709130  0.61709130  0.03728248 -0.1073684
9   0.03728248  0.03728248  0.55159937 -0.1838586
10  0.03728248  0.03728248  0.55159937 -0.1838586
11 -0.07530479 -0.07530479 -0.03229849 -0.2475334
12  0.03728248  0.03728248  0.55159937 -0.1838586
13  0.61709130  0.61709130  0.03728248 -0.1073684
14  0.61709130  0.61709130  0.03728248 -0.1073684
15  0.03728248  0.03728248  0.55159937 -0.1838586
16 -0.10736843 -0.10736843 -0.18385861  1.0000000

# Let’s look at the correlation between this cluster configuration
# and the observed correlation matrix. This should match the
# corresponding value from clustered_observed_cors above.
gcor(cluster_cor_mat, m182_task_social_cors)
[1] 0.860548

### NOTE ON DEDUCTIVE CLUSTERING

# It’s pretty straightforward, using the code above, to explore
# your own deductive NetCluster. Simply supply your own cluster
# vector, where the elements in the vector are in the same order
# as the vertices in the matrix, and the values represent the
# cluster to which each vertex belongs.
#
# For example, if you believed that actors 2, 7, and 8 formed one
# group, actor 16 former another group, and everyone else formed
# a third group, you could represent this as follows:
deductive_clusters = c(1, 2, 1, 1, 1, 1, 2, 2, 1, 1, 1, 1, 1, 1,
+                        1, 3)

# You could then examine the fitness of this cluster configuration
# as follows:
deductive_cluster_cor_mat <- generate_cluster_cor_mat(
+   m182_task_social_cors,
+   deductive_clusters)
deductive_cluster_cor_mat
             1           2           3           4           5           6
1   0.19466275  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
2   0.03644363  0.83356214  0.03644363  0.03644363  0.03644363  0.03644363
3   0.19466275  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
4   0.19466275  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
5   0.19466275  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
6   0.19466275  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
7   0.03644363  0.83356214  0.03644363  0.03644363  0.03644363  0.03644363
8   0.03644363  0.83356214  0.03644363  0.03644363  0.03644363  0.03644363
9   0.19466275  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
10  0.19466275  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
11  0.19466275  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
12  0.19466275  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
13  0.19466275  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
14  0.19466275  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
15  0.19466275  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
16 -0.19776428 -0.08565198 -0.19776428 -0.19776428 -0.19776428 -0.19776428
             7           8           9          10          11          12
1   0.03644363  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
2   0.83356214  0.83356214  0.03644363  0.03644363  0.03644363  0.03644363
3   0.03644363  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
4   0.03644363  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
5   0.03644363  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
6   0.03644363  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
7   0.83356214  0.83356214  0.03644363  0.03644363  0.03644363  0.03644363
8   0.83356214  0.83356214  0.03644363  0.03644363  0.03644363  0.03644363
9   0.03644363  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
10  0.03644363  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
11  0.03644363  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
12  0.03644363  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
13  0.03644363  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
14  0.03644363  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
15  0.03644363  0.03644363  0.19466275  0.19466275  0.19466275  0.19466275
16 -0.08565198 -0.08565198 -0.19776428 -0.19776428 -0.19776428 -0.19776428
            13          14          15          16
1   0.19466275  0.19466275  0.19466275 -0.19776428
2   0.03644363  0.03644363  0.03644363 -0.08565198
3   0.19466275  0.19466275  0.19466275 -0.19776428
4   0.19466275  0.19466275  0.19466275 -0.19776428
5   0.19466275  0.19466275  0.19466275 -0.19776428
6   0.19466275  0.19466275  0.19466275 -0.19776428
7   0.03644363  0.03644363  0.03644363 -0.08565198
8   0.03644363  0.03644363  0.03644363 -0.08565198
9   0.19466275  0.19466275  0.19466275 -0.19776428
10  0.19466275  0.19466275  0.19466275 -0.19776428
11  0.19466275  0.19466275  0.19466275 -0.19776428
12  0.19466275  0.19466275  0.19466275 -0.19776428
13  0.19466275  0.19466275  0.19466275 -0.19776428
14  0.19466275  0.19466275  0.19466275 -0.19776428
15  0.19466275  0.19466275  0.19466275 -0.19776428
16 -0.19776428 -0.19776428 -0.19776428  1.00000000
gcor(deductive_cluster_cor_mat, m182_task_social_cors)
[1] 0.5597477

### END NOTE ON DEDUCTIVE CLUSTERING

# Now we’ll use the 4-cluster solution to generate blockmodels,
# using the raw tie data from the underlying task and social
# networks.

# Task valued
task_mean <- mean(m182_task_matrix_row_to_col)
task_mean
[1] 0.478125

task_valued_blockmodel <- blockmodel(m182_task_matrix_row_to_col, clusters)
task_valued_blockmodel
Network Blockmodel:
Block membership:
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  1  3  3  2  2  1  1  3  1  2  2  1  4
Reduced form blockmodel:
  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
        Block 1 Block 2 Block 3 Block 4
Block 1 0.36000  0.0000  0.0250  4.1500
Block 2 0.00500  0.4050  0.0150  3.5400
Block 3 0.01875  0.0075  0.6625  1.0125
Block 4 4.12500  3.3900  1.3875     NaN

# Task binary
task_density <- graph.density(m182_task)
task_density
[1] 0.3666667

task_binary_blockmodel <- blockmodel(m182_task_matrix_row_to_col_bin, clusters)
task_binary_blockmodel
Network Blockmodel:
Block membership:
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  1  3  3  2  2  1  1  3  1  2  2  1  4
Reduced form blockmodel:
  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
           Block 1 Block 2    Block 3 Block 4
Block 1 0.70000000    0.00 0.08333333       1
Block 2 0.03333333    0.85 0.10000000       1
Block 3 0.08333333    0.05 1.00000000       1
Block 4 1.00000000    1.00 1.00000000     NaN

# Social valued
social_mean <- mean(m182_social_matrix_row_to_col)
social_mean
[1] 1.045313

social_valued_blockmodel <- blockmodel(m182_social_matrix_row_to_col, clusters)
social_valued_blockmodel
Network Blockmodel:
Block membership:
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  1  3  3  2  2  1  1  3  1  2  2  1  4
Reduced form blockmodel:
  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
        Block 1 Block 2 Block 3 Block 4
Block 1   2.775  0.0000  0.0750   1.250
Block 2   0.000  4.7550  0.0150   1.920
Block 3   0.075  0.0075  4.5750   0.075
Block 4   0.925  1.2000  0.3375     NaN

# Social binary
social_density <- graph.density(m182_social)
social_density
[1] 0.5375

social_binary_blockmodel <- blockmodel(m182_social_matrix_row_to_col_bin, clusters)
social_binary_blockmodel
Network Blockmodel:
Block membership:
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  2  3  1  3  3  2  2  1  1  3  1  2  2  1  4
Reduced form blockmodel:
  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
           Block 1 Block 2    Block 3 Block 4
Block 1 0.70000000    0.00 0.08333333       1
Block 2 0.03333333    0.85 0.10000000       1
Block 3 0.08333333    0.05 1.00000000       1
Block 4 1.00000000    1.00 1.00000000     NaN

# We can also permute the network to examine the within- and
# between-cluster correlations.

cluster_cor_mat_per <- permute_matrix(clusters, cluster_cor_mat)
cluster_cor_mat_per
           16           3           5           6          11           2
16  1.0000000 -0.24753336 -0.24753336 -0.24753336 -0.24753336 -0.10736843
3  -0.2475334  0.32488420  0.32488420  0.32488420  0.32488420 -0.07530479
5  -0.2475334  0.32488420  0.32488420  0.32488420  0.32488420 -0.07530479
6  -0.2475334  0.32488420  0.32488420  0.32488420  0.32488420 -0.07530479
11 -0.2475334  0.32488420  0.32488420  0.32488420  0.32488420 -0.07530479
2  -0.1073684 -0.07530479 -0.07530479 -0.07530479 -0.07530479  0.61709130
7  -0.1073684 -0.07530479 -0.07530479 -0.07530479 -0.07530479  0.61709130
8  -0.1073684 -0.07530479 -0.07530479 -0.07530479 -0.07530479  0.61709130
13 -0.1073684 -0.07530479 -0.07530479 -0.07530479 -0.07530479  0.61709130
14 -0.1073684 -0.07530479 -0.07530479 -0.07530479 -0.07530479  0.61709130
1  -0.1838586 -0.03229849 -0.03229849 -0.03229849 -0.03229849  0.03728248
4  -0.1838586 -0.03229849 -0.03229849 -0.03229849 -0.03229849  0.03728248
9  -0.1838586 -0.03229849 -0.03229849 -0.03229849 -0.03229849  0.03728248
10 -0.1838586 -0.03229849 -0.03229849 -0.03229849 -0.03229849  0.03728248
12 -0.1838586 -0.03229849 -0.03229849 -0.03229849 -0.03229849  0.03728248
15 -0.1838586 -0.03229849 -0.03229849 -0.03229849 -0.03229849  0.03728248
             7           8          13          14           1           4
16 -0.10736843 -0.10736843 -0.10736843 -0.10736843 -0.18385861 -0.18385861
3  -0.07530479 -0.07530479 -0.07530479 -0.07530479 -0.03229849 -0.03229849
5  -0.07530479 -0.07530479 -0.07530479 -0.07530479 -0.03229849 -0.03229849
6  -0.07530479 -0.07530479 -0.07530479 -0.07530479 -0.03229849 -0.03229849
11 -0.07530479 -0.07530479 -0.07530479 -0.07530479 -0.03229849 -0.03229849
2   0.61709130  0.61709130  0.61709130  0.61709130  0.03728248  0.03728248
7   0.61709130  0.61709130  0.61709130  0.61709130  0.03728248  0.03728248
8   0.61709130  0.61709130  0.61709130  0.61709130  0.03728248  0.03728248
13  0.61709130  0.61709130  0.61709130  0.61709130  0.03728248  0.03728248
14  0.61709130  0.61709130  0.61709130  0.61709130  0.03728248  0.03728248
1   0.03728248  0.03728248  0.03728248  0.03728248  0.55159937  0.55159937
4   0.03728248  0.03728248  0.03728248  0.03728248  0.55159937  0.55159937
9   0.03728248  0.03728248  0.03728248  0.03728248  0.55159937  0.55159937
10  0.03728248  0.03728248  0.03728248  0.03728248  0.55159937  0.55159937
12  0.03728248  0.03728248  0.03728248  0.03728248  0.55159937  0.55159937
15  0.03728248  0.03728248  0.03728248  0.03728248  0.55159937  0.55159937
             9          10          12          15
16 -0.18385861 -0.18385861 -0.18385861 -0.18385861
3  -0.03229849 -0.03229849 -0.03229849 -0.03229849
5  -0.03229849 -0.03229849 -0.03229849 -0.03229849
6  -0.03229849 -0.03229849 -0.03229849 -0.03229849
11 -0.03229849 -0.03229849 -0.03229849 -0.03229849
2   0.03728248  0.03728248  0.03728248  0.03728248
7   0.03728248  0.03728248  0.03728248  0.03728248
8   0.03728248  0.03728248  0.03728248  0.03728248
13  0.03728248  0.03728248  0.03728248  0.03728248
14  0.03728248  0.03728248  0.03728248  0.03728248
1   0.55159937  0.55159937  0.55159937  0.55159937
4   0.55159937  0.55159937  0.55159937  0.55159937
9   0.55159937  0.55159937  0.55159937  0.55159937
10  0.55159937  0.55159937  0.55159937  0.55159937
12  0.55159937  0.55159937  0.55159937  0.55159937
15  0.55159937  0.55159937  0.55159937  0.55159937

###
# 4. HIERARCHICAL CLUSTERING ON TRIAD CENSUS
###

# Another way to think about roles within a network is by looking
# at the triads that each actor belongs to. We can then use
# correlations between triad-type memberships to identify people
# with similar roles regardless of the specific people with whom
# they interact.

# First, we’ll generate an individual-level triad census of the
# network using triadcensus() from the triads package.
task_triads <- triadcensus(m182_task)
Case:  1  of:  14
Case:  2  of:  14
Case:  4  of:  14
Case:  5  of:  14
Case:  10  of:  14
task_triads
      003 012_S 012_E 012_I 102_D 102_I 021D_S 021D_E 021U_S 021U_E 021C_S
 [1,]  23     9     0     2    28    11      0      0      0      0      0
 [2,]  21     5     0     1    33    14      0      0      0      0      0
 [3,]  34     0     0     3    28    18      0      0      0      0      0
 [4,]  52     0     0     6     8    20      0      0      0      0      0
 [5,]  17     5     5     1    27    10      0      1      0      0      0
 [6,]  23     0     6     2    29    11      0      1      0      0      0
 [7,]  26     0     8     1    28    18      0      2      0      0      0
 [8,]  26     0     0     1    36    18      0      0      0      0      0
 [9,]  27     0     0     4    36    14      0      0      0      0      0
[10,]  14     0     0     3    42    11      0      0      0      0      0
[11,]  34     0     0     3    28    18      0      0      0      0      0
[12,]  27     0     9     4    27    14      0      0      0      0      0
[13,]  29     0     5     2    26    14      0      0      0      0      0
[14,]  24    19     0     1    15    11      2      0      0      0      1
[15,]  22     0     5     4    33    10      0      0      0      0      0
[16,]   0     0     0     0     0     0      0      0      0      0      0
      021C_B 021C_E 111D_S 111D_B 111D_E 111U_S 111U_B 111U_E 030T_S 030T_B
 [1,]      0      0      0      0      2      1      1      0      0      0
 [2,]      0      0      4      0      1      2      4      0      0      0
 [3,]      0      0      0      0      2      1      0      0      0      0
 [4,]      0      0      0      0      0      0      0      0      0      0
 [5,]      1      0      3      3      0      1      4      2      0      0
 [6,]      0      0      0      3      0      1      0      2      0      0
 [7,]      0      0      0      1      1      1      0      0      0      0
 [8,]      0      0      0      0      1      3      0      0      0      0
 [9,]      0      0      0      0      1      0      0      0      0      0
[10,]      0      0      0      0      2      0      0      0      0      0
[11,]      0      0      0      0      2      1      0      0      0      0
[12,]      0      0      0      0      1      0      0      1      0      0
[13,]      0      1      0      3      1      1      0      4      0      0
[14,]      0      0      7      0      0      1      4      0      0      0
[15,]      0      0      0      4      0      0      0      4      0      0
[16,]      0      0      0      0      0      0      0      0      0      0
      030T_E 030C 201_S 201_B 120D_S 120D_E 120U_E 120U_S 120C_S 120C_B 120C_E
 [1,]      0    0    14     3      0      0      0      0      0      0      0
 [2,]      0    0     9     1      0      0      0      0      0      0      0
 [3,]      0    0    13     0      0      0      0      0      0      0      0
 [4,]      0    0    18     0      0      0      0      0      0      0      0
 [5,]      0    0    12     3      0      1      0      0      0      0      0
 [6,]      0    0    15     3      0      1      0      0      0      0      0
 [7,]      0    0    10     0      0      0      0      0      0      0      0
 [8,]      0    0    10     1      0      0      0      0      0      0      0
 [9,]      0    0    13     0      0      0      0      0      0      0      0
[10,]      0    0    12     9      0      0      0      0      0      0      0
[11,]      0    0    13     0      0      0      0      0      0      0      0
[12,]      0    0    12     0      0      0      0      0      0      0      0
[13,]      0    0    12     0      0      0      0      0      0      0      0
[14,]      0    0    11     0      1      0      0      0      0      0      0
[15,]      0    0    12     0      0      0      0      0      0      0      0
[16,]      0    0     0    73      0      0      0      0      0      0      0
      210_S 210_B 210_E 300
 [1,]     4     0     0   7
 [2,]     1     0     1   8
 [3,]     0     0     0   6
 [4,]     0     0     0   1
 [5,]     1     1     0   7
 [6,]     0     1     0   7
 [7,]     0     3     0   6
 [8,]     0     0     1   8
 [9,]     0     0     1   9
[10,]     0     0     1  11
[11,]     0     0     0   6
[12,]     0     4     0   6
[13,]     0     1     0   6
[14,]     5     0     0   3
[15,]     0     1     1   9
[16,]     0     0     6  26

# Next, we’ll generate a matrix of correlations between actors
# in the network based on their similarity in triad-type
# membership. Note that the cor() function in R operates on
# columns, not rows, so in order to get correlations between
# the actors in the network we have to transpose it.
m182_task_triad_cors <- cor(t(task_triads))
m182_task_triad_cors
            [,1]         [,2]        [,3]        [,4]       [,5]       [,6]
 [1,] 1.00000000  0.961888240  0.94032430  0.73262745 0.95950514 0.94830062
 [2,] 0.96188824  1.000000000  0.93189012  0.65681925 0.97106774 0.94222088
 [3,] 0.94032430  0.931890119  1.00000000  0.86979672 0.90744646 0.94946671
 [4,] 0.73262745  0.656819246  0.86979672  1.00000000 0.64685590 0.73565596
 [5,] 0.95950514  0.971067735  0.90744646  0.64685590 1.00000000 0.97272158
 [6,] 0.94830062  0.942220880  0.94946671  0.73565596 0.97272158 1.00000000
 [7,] 0.91962800  0.937025144  0.96723092  0.77951172 0.93650655 0.96593832
 [8,] 0.94861629  0.980853028  0.96500774  0.71437586 0.94889386 0.96155823
 [9,] 0.96066576  0.975131351  0.96742837  0.72871947 0.95633741 0.97502016
[10,] 0.89455740  0.931901344  0.82515802  0.46617701 0.92737963 0.91164775
[11,] 0.94032430  0.931890119  1.00000000  0.86979672 0.90744646 0.94946671
[12,] 0.92383854  0.921802436  0.96549781  0.79957603 0.93565302 0.97415687
[13,] 0.93286253  0.926737209  0.98340815  0.83557488 0.93360294 0.97482734
[14,] 0.86597435  0.796734824  0.79829205  0.75554441 0.78628346 0.73099817
[15,] 0.93493822  0.952141657  0.92807129  0.66910342 0.96787959 0.98405458
[16,] 0.03242732 -0.006294769 -0.04252585 -0.06518911 0.03757553 0.03204222
             [,7]         [,8]        [,9]     [,10]       [,11]       [,12]
 [1,]  0.91962800  0.948616292  0.96066576 0.8945574  0.94032430  0.92383854
 [2,]  0.93702514  0.980853028  0.97513135 0.9319013  0.93189012  0.92180244
 [3,]  0.96723092  0.965007738  0.96742837 0.8251580  1.00000000  0.96549781
 [4,]  0.77951172  0.714375855  0.72871947 0.4661770  0.86979672  0.79957603
 [5,]  0.93650655  0.948893863  0.95633741 0.9273796  0.90744646  0.93565302
 [6,]  0.96593832  0.961558225  0.97502016 0.9116477  0.94946671  0.97415687
 [7,]  1.00000000  0.967894798  0.95914154 0.8531498  0.96723092  0.98813492
 [8,]  0.96789480  1.000000000  0.98943077 0.9256330  0.96500774  0.95023187
 [9,]  0.95914154  0.989430766  1.00000000 0.9301096  0.96742837  0.95994515
[10,]  0.85314978  0.925632960  0.93010960 1.0000000  0.82515802  0.84572151
[11,]  0.96723092  0.965007738  0.96742837 0.8251580  1.00000000  0.96549781
[12,]  0.98813492  0.950231867  0.95994515 0.8457215  0.96549781  1.00000000
[13,]  0.97854957  0.958659180  0.96463907 0.8345337  0.98340815  0.98357433
[14,]  0.74585439  0.738857208  0.74601089 0.5916022  0.79829205  0.74974802
[15,]  0.94886528  0.963361771  0.98027135 0.9297345  0.92807129  0.95832706
[16,] -0.04819527 -0.005460961 -0.01872521 0.1837009 -0.04252585 -0.04895212
            [,13]       [,14]       [,15]        [,16]
 [1,]  0.93286253  0.86597435  0.93493822  0.032427322
 [2,]  0.92673721  0.79673482  0.95214166 -0.006294769
 [3,]  0.98340815  0.79829205  0.92807129 -0.042525846
 [4,]  0.83557488  0.75554441  0.66910342 -0.065189112
 [5,]  0.93360294  0.78628346  0.96787959  0.037575534
 [6,]  0.97482734  0.73099817  0.98405458  0.032042224
 [7,]  0.97854957  0.74585439  0.94886528 -0.048195270
 [8,]  0.95865918  0.73885721  0.96336177 -0.005460961
 [9,]  0.96463907  0.74601089  0.98027135 -0.018725208
[10,]  0.83453367  0.59160224  0.92973449  0.183700919
[11,]  0.98340815  0.79829205  0.92807129 -0.042525846
[12,]  0.98357433  0.74974802  0.95832706 -0.048952119
[13,]  1.00000000  0.77202477  0.96016010 -0.048922347
[14,]  0.77202477  1.00000000  0.69846044 -0.086837052
[15,]  0.96016010  0.69846044  1.00000000 -0.021428581
[16,] -0.04892235 -0.08683705 -0.02142858  1.000000000

# As above, we can use the correlation matrix to generate a
# dissimilartiy structure, which we can then hierarchically
# cluster into groups of similar people.
dissimilarity <- 1 - m182_task_triad_cors
m182_task_triad_dist <- as.dist(dissimilarity)
m182_task_triad_dist
            1          2          3          4          5          6          7
2  0.03811176                                                                 
3  0.05967570 0.06810988                                                      
4  0.26737255 0.34318075 0.13020328                                           
5  0.04049486 0.02893226 0.09255354 0.35314410                                
6  0.05169938 0.05777912 0.05053329 0.26434404 0.02727842                     
7  0.08037200 0.06297486 0.03276908 0.22048828 0.06349345 0.03406168          
8  0.05138371 0.01914697 0.03499226 0.28562414 0.05110614 0.03844177 0.03210520
9  0.03933424 0.02486865 0.03257163 0.27128053 0.04366259 0.02497984 0.04085846
10 0.10544260 0.06809866 0.17484198 0.53382299 0.07262037 0.08835225 0.14685022
11 0.05967570 0.06810988 0.00000000 0.13020328 0.09255354 0.05053329 0.03276908
12 0.07616146 0.07819756 0.03450219 0.20042397 0.06434698 0.02584313 0.01186508
13 0.06713747 0.07326279 0.01659185 0.16442512 0.06639706 0.02517266 0.02145043
14 0.13402565 0.20326518 0.20170795 0.24445559 0.21371654 0.26900183 0.25414561
15 0.06506178 0.04785834 0.07192871 0.33089658 0.03212041 0.01594542 0.05113472
16 0.96757268 1.00629477 1.04252585 1.06518911 0.96242447 0.96795778 1.04819527
            8          9         10         11         12         13         14
2                                                                             
3                                                                             
4                                                                             
5                                                                             
6                                                                             
7                                                                             
8                                                                             
9  0.01056923                                                                 
10 0.07436704 0.06989040                                                      
11 0.03499226 0.03257163 0.17484198                                           
12 0.04976813 0.04005485 0.15427849 0.03450219                                
13 0.04134082 0.03536093 0.16546633 0.01659185 0.01642567                     
14 0.26114279 0.25398911 0.40839776 0.20170795 0.25025198 0.22797523          
15 0.03663823 0.01972865 0.07026551 0.07192871 0.04167294 0.03983990 0.30153956
16 1.00546096 1.01872521 0.81629908 1.04252585 1.04895212 1.04892235 1.08683705
           15
2           
3           
4           
5           
6           
7           
8           
9           
10          
11          
12          
13          
14          
15          
16 1.02142858

m182_task_triad_hclust <- hclust(m182_task_triad_dist)
plot(m182_task_triad_hclust)

# As above, we’ll loop through each possible cluster solution
# and see how well they match the observed matrix of triad-type
# correlations.
clustered_observed_cors = vector()
num_vertices = length(V(m182_task))

clustered_observed_cors <-clustConfigurations(num_vertices,m182_task_triad_hclust,m182_task_triad_cors)
Warning message:
In cor(as.vector(d[g1[i], , ]), as.vector(d[g2[j], , ]), use = "complete.obs") :
  the standard deviation is zero
clustered_observed_cors
$label
[1] "number of clusters:  1"
$clusters
 [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
$correlation
[1] NA
$label
[1] "number of clusters:  2"
$clusters
 [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2
$correlation
[1] 0.949383
$label
[1] "number of clusters:  3"
$clusters
 [1] 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 3
$correlation
[1] 0.9847109
$label
[1] "number of clusters:  4"
$clusters
 [1] 1 1 1 2 1 1 1 1 1 1 1 1 1 3 1 4
$correlation
[1] 0.9854826
$label
[1] "number of clusters:  5"
$clusters
 [1] 1 1 1 2 1 1 1 1 1 3 1 1 1 4 1 5
$correlation
[1] 0.993611
$label
[1] "number of clusters:  6"
$clusters
 [1] 1 1 2 3 1 1 2 1 1 4 2 2 2 5 1 6
$correlation
[1] 0.9974528
$label
[1] "number of clusters:  7"
$clusters
 [1] 1 1 2 3 4 4 2 1 1 5 2 2 2 6 4 7
$correlation
[1] 0.997722
$label
[1] "number of clusters:  8"
$clusters
 [1] 1 2 3 4 5 5 3 2 2 6 3 3 3 7 5 8
$correlation
[1] 0.998331
$label
[1] "number of clusters:  9"
$clusters
 [1] 1 2 3 4 5 5 6 2 2 7 3 6 3 8 5 9
$correlation
[1] 0.9987682
$label
[1] "number of clusters:  10"
$clusters
 [1]  1  2  3  4  5  6  7  2  2  8  3  7  3  9  6 10
$correlation
[1] 0.999174
$label
[1] "number of clusters:  11"
$clusters
 [1]  1  2  3  4  5  6  7  8  8  9  3  7  3 10  6 11
$correlation
[1] 0.9995733
$label
[1] "number of clusters:  12"
$clusters
 [1]  1  2  3  4  5  6  7  8  8  9  3  7 10 11  6 12
$correlation
[1] 0.9997194
$label
[1] "number of clusters:  13"
$clusters
 [1]  1  2  3  4  5  6  7  8  8  9  3  7 10 11 12 13
$correlation
[1] 0.9999464
$label
[1] "number of clusters:  14"
$clusters
 [1]  1  2  3  4  5  6  7  8  8  9  3 10 11 12 13 14
$correlation
[1] 0.99997
$label
[1] "number of clusters:  15"
$clusters
 [1]  1  2  3  4  5  6  7  8  9 10  3 11 12 13 14 15
$correlation
[1] 1
$label
[1] "number of clusters:  16"
$clusters
 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
$correlation
[1] 1
$correlations
 [1]        NA 0.9493829 0.9847109 0.9854826 0.9936109 0.9974528 0.9977220
 [8] 0.9983311 0.9987682 0.9991741 0.9995733 0.9997194 0.9999464 0.9999700
[15] 1.0000000 1.0000000

# From a visual inspection of the data, we’ll use a 3-cluster
# solution (though a case could also be made for using 5.)
num_clusters = 3
clusters <- cutree(m182_task_triad_hclust, k = num_clusters)
clusters
 [1] 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 3

cluster_cor_mat <- clusterCorr (m182_task_triad_cors,
+                                             clusters)
cluster_cor_mat
              [,1]         [,2]         [,3]        [,4]         [,5]
 [1,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
 [2,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
 [3,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
 [4,] 0.7432201244 0.7432201244 0.7432201244  0.87777221 0.7432201244
 [5,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
 [6,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
 [7,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
 [8,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
 [9,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
[10,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
[11,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
[12,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
[13,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
[14,] 0.7432201244 0.7432201244 0.7432201244  0.87777221 0.7432201244
[15,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
[16,] 0.0002088502 0.0002088502 0.0002088502 -0.07601308 0.0002088502
              [,6]         [,7]         [,8]         [,9]        [,10]
 [1,] 0.9496069575 0.9496069575 0.9496069575 0.9496069575 0.9496069575
 [2,] 0.9496069575 0.9496069575 0.9496069575 0.9496069575 0.9496069575
 [3,] 0.9496069575 0.9496069575 0.9496069575 0.9496069575 0.9496069575
 [4,] 0.7432201244 0.7432201244 0.7432201244 0.7432201244 0.7432201244
 [5,] 0.9496069575 0.9496069575 0.9496069575 0.9496069575 0.9496069575
 [6,] 0.9496069575 0.9496069575 0.9496069575 0.9496069575 0.9496069575
 [7,] 0.9496069575 0.9496069575 0.9496069575 0.9496069575 0.9496069575
 [8,] 0.9496069575 0.9496069575 0.9496069575 0.9496069575 0.9496069575
 [9,] 0.9496069575 0.9496069575 0.9496069575 0.9496069575 0.9496069575
[10,] 0.9496069575 0.9496069575 0.9496069575 0.9496069575 0.9496069575
[11,] 0.9496069575 0.9496069575 0.9496069575 0.9496069575 0.9496069575
[12,] 0.9496069575 0.9496069575 0.9496069575 0.9496069575 0.9496069575
[13,] 0.9496069575 0.9496069575 0.9496069575 0.9496069575 0.9496069575
[14,] 0.7432201244 0.7432201244 0.7432201244 0.7432201244 0.7432201244
[15,] 0.9496069575 0.9496069575 0.9496069575 0.9496069575 0.9496069575
[16,] 0.0002088502 0.0002088502 0.0002088502 0.0002088502 0.0002088502
             [,11]        [,12]        [,13]       [,14]        [,15]
 [1,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
 [2,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
 [3,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
 [4,] 0.7432201244 0.7432201244 0.7432201244  0.87777221 0.7432201244
 [5,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
 [6,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
 [7,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
 [8,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
 [9,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
[10,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
[11,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
[12,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
[13,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
[14,] 0.7432201244 0.7432201244 0.7432201244  0.87777221 0.7432201244
[15,] 0.9496069575 0.9496069575 0.9496069575  0.74322012 0.9496069575
[16,] 0.0002088502 0.0002088502 0.0002088502 -0.07601308 0.0002088502
              [,16]
 [1,]  0.0002088502
 [2,]  0.0002088502
 [3,]  0.0002088502
 [4,] -0.0760130824
 [5,]  0.0002088502
 [6,]  0.0002088502
 [7,]  0.0002088502
 [8,]  0.0002088502
 [9,]  0.0002088502
[10,]  0.0002088502
[11,]  0.0002088502
[12,]  0.0002088502
[13,]  0.0002088502
[14,] -0.0760130824
[15,]  0.0002088502
[16,]  1.0000000000
gcor(cluster_cor_mat, m182_task_triad_cors)
[1] 0.9847109

# As before, we can use these clusters to run a blockmodel
# analysis using the underlying tie data from the task network.

# Task valued
task_mean <- mean(m182_task_matrix_row_to_col)
task_mean
[1] 0.478125

task_valued_blockmodel <- blockmodel(m182_task_matrix_row_to_col, clusters)
task_valued_blockmodel
Network Blockmodel:
Block membership:
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  1  1  2  1  1  1  1  1  1  1  1  1  2  1  3
Reduced form blockmodel:
  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
           Block 1    Block 2  Block 3
Block 1 0.17211538 0.01730769 3.276923
Block 2 0.04615385 0.00000000 2.025000
Block 3 3.25384615 2.47500000      NaN

# Task binary
task_density <- graph.density(m182_task)
task_density
[1] 0.3666667

task_binary_blockmodel <- blockmodel(m182_task_matrix_row_to_col_bin, clusters)
task_binary_blockmodel
Network Blockmodel:
Block membership:
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16
 1  1  1  2  1  1  1  1  1  1  1  1  1  2  1  3
Reduced form blockmodel:
  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
          Block 1   Block 2 Block 3
Block 1 0.3141026 0.1153846       1
Block 2 0.2307692 0.0000000       1
Block 3 1.0000000 1.0000000     NaN

# Finally, we can try to get a sense of what our different
# clusters represent by generating a cluster-by-triad-type matrix.
# This is an m x n matrix, where m is the number of clusters and n
# is the 36 possible triad types. Each cell is the average
# number of the given triad type for each individual in the
# cluster.
cluster_triad_mat <- matrix(nrow=max(clusters), ncol=ncol(task_triads))
for (i in 1:max(clusters)) {
+  for (j in 1:ncol(task_triads)) {
+   cluster_triad_mat[i,j] <- mean(task_triads[which(clusters==i),j])
+  }
+ }

cluster_triad_mat
         [,1]     [,2]     [,3]     [,4]     [,5]     [,6] [,7]      [,8] [,9]
[1,] 24.84615 1.461538 2.923077 2.384615 30.84615 13.92308    0 0.3076923    0
[2,] 38.00000 9.500000 0.000000 3.500000 11.50000 15.50000    1 0.0000000    0
[3,]  0.00000 0.000000 0.000000 0.000000  0.00000  0.00000    0 0.0000000    0
     [,10] [,11]      [,12]      [,13]     [,14]    [,15]    [,16]    [,17]
[1,]     0   0.0 0.07692308 0.07692308 0.5384615 1.076923 1.076923 0.923077
[2,]     0   0.5 0.00000000 0.00000000 3.5000000 0.000000 0.000000 0.500000
[3,]     0   0.0 0.00000000 0.00000000 0.0000000 0.000000 0.000000 0.000000
         [,18] [,19] [,20] [,21] [,22] [,23]    [,24]     [,25] [,26]     [,27]
[1,] 0.6923077     1     0     0     0     0 12.07692  1.538462   0.0 0.1538462
[2,] 2.0000000     0     0     0     0     0 14.50000  0.000000   0.5 0.0000000
[3,] 0.0000000     0     0     0     0     0  0.00000 73.000000   0.0 0.0000000
     [,28] [,29] [,30] [,31] [,32]     [,33]     [,34]     [,35]     [,36]
[1,]     0     0     0     0     0 0.4615385 0.8461538 0.3846154  7.384615
[2,]     0     0     0     0     0 2.5000000 0.0000000 0.0000000  2.000000
[3,]     0     0     0     0     0 0.0000000 0.0000000 6.0000000 26.000000

###
# 5. FACTOR ANALYSIS
###

# Note that although we are conducting a principal components
# analysis (PCA), which is technically not exactly the same as
# factor analysis, we will use the term "factor" to describe the
# individual components in our PCA.

# We’ll analyze the 4n x n matrix generated above.

# First, we want to determine the ideal number of components
# (factors) to extract. We’ll do this by examining the eigenvalues
# in a scree plot and examining how each number of factors stacks
# up to a few proposed non-graphical solutions to selecting the
# optimal number of components, available via the nFactors
# package.
ev <- eigen(cor(m182_task_social_matrix)) # get eigenvalues
ap <- parallel(subject=nrow(m182_task_social_matrix),
+   var=ncol(m182_task_social_matrix),
+   rep=100,cent=.05)
nS <- nScree(ev$values, ap$eigen$qevpea)
plotnScree(nS)

# To draw a line across the graph where eigenvalues are = 1,
# use the following code:
plotnScree(nS)
abline(h=1)

# For more information on this proceedure, please see
# the references provided in the parallel() documentation
# (type "?parallel" in the R command line with the pacakge
# loaded).

# Now we’ll run a principal components analysis on the matrix,
# using the number of factors determined above (note this may not
# be the same number as you get):
pca_m182_task_social = principal(m182_task_social_matrix, nfactors=5, rotate="varimax")

# Let’s take a look at the results in the R terminal:
pca_m182_task_social
Principal Components Analysis
Call: principal(r = m182_task_social_matrix, nfactors = 5, rotate = "varimax")
Standardized loadings based upon correlation matrix
     RC1   RC2   RC5   RC4   RC3   h2    u2
1   0.17 -0.03  0.89  0.00  0.00 0.83 0.172
2   0.02  0.97  0.04  0.03 -0.04 0.95 0.046
3   0.02 -0.07 -0.16 -0.01  0.52 0.30 0.697
4   0.34  0.17  0.62  0.28  0.13 0.62 0.376
5   0.14 -0.03 -0.17 -0.02  0.59 0.39 0.606
6  -0.15 -0.06  0.07 -0.07  0.55 0.34 0.665
7   0.01  0.77  0.03  0.52 -0.06 0.86 0.140
8  -0.07  0.90 -0.05  0.12 -0.09 0.84 0.159
9   0.80 -0.10  0.06 -0.10 -0.14 0.68 0.321
10  0.91  0.02  0.21  0.08  0.07 0.89 0.112
11 -0.21 -0.08  0.14 -0.06  0.45 0.27 0.726
12  0.16 -0.06  0.85 -0.05 -0.06 0.75 0.246
13 -0.05  0.13 -0.04  0.94 -0.08 0.90 0.095
14  0.08  0.19  0.12  0.94  0.01 0.94 0.057
15  0.86  0.03  0.40  0.07  0.02 0.90 0.096
16 -0.13 -0.13 -0.25 -0.13 -0.72 0.64 0.359
                RC1  RC2  RC5  RC4  RC3
SS loadings    2.49 2.48 2.27 2.18 1.71
Proportion Var 0.16 0.15 0.14 0.14 0.11
Cumulative Var 0.16 0.31 0.45 0.59 0.70
Test of the hypothesis that 5 factors are sufficient.
The degrees of freedom for the null model are  120  and the objective function was  11.4
The degrees of freedom for the model are 50  and the objective function was  3.34
The number of observations was  64  with Chi Square =  178.95  with prob <  2.1e-16
Fit based upon off diagonal values = 0.93
# You can see the standardized loadings for each factor for each
# node. Note that R sometimes puts the factors in a funky order
# (e.g. RC1, RC2, RC5, RC4, RC3) but all of the factors are there.
# You can see that the SS loadings, proportion of variance
# explained and cumulative variance explained is provided below. A
# Chi Square test of the factors and various other statistics are
# provided below.

# Note that the eigenvalues can be accessed via the following
# command:
pca_m182_task_social$values
 [1] 3.67201996 3.09591101 1.71727307 1.35850628 1.28200199 1.05254020
 [7] 1.00859184 0.71491042 0.61727964 0.53344924 0.36098519 0.30754606
[13] 0.12473332 0.08838900 0.03628568 0.02957712

# Now we will use the factor loadings to cluster and compare that
# to our other NetCluster techniques, using dendrograms.

# Take the distance based on Euclidian Distance
m182_task_factor_dist = dist(pca_m182_task_social$loadings)

# And cluster
m182_task_factor_hclust <- hclust(m182_task_factor_dist)
plot(m182_task_factor_hclust)

# And compare to NetCluster based on correlations and triads:
par(mfrow = c(1,3))
plot(m182_task_social_hclust, main = "Correlation")
plot(m182_task_factor_hclust, main = "PCA")
plot(m182_task_triad_hclust, main = "Triads")

文档资料.rar

 

本文地址:http://51blog.net/?p=241
关注我们:请关注一下我们的微信公众号:扫描二维码广东高校数据家园_51博客的公众号,公众号:数博联盟
版权声明:本文为原创文章,版权归 jnussl 所有,欢迎分享本文,转载请保留出处!

发表评论


表情