---
title: "Practical 5"
author: "James Hollway"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Practical 5}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
```

# Setting up

For this lab, we'll use a few different packages for data and analysis.
We're going to use the `ison_algebra` dataset again, directly from the package.

```{r setup}
suppressPackageStartupMessages(library(migraph)) # note that you may need a special version for what follows...
data("ison_algebra", package = "migraph")
```

The network is anonymous, but I think it would be nice to add some names,
even if it's just pretend. Luckily, I've added a function for this.
This makes plotting the network just a wee bit more accessible:

```{r addingnames}
ison_algebra <- to_named(ison_algebra)
autographr(ison_algebra)
```

There are actually three different types of tie here. 
Let's separate them out into separate networks.

```{r separatingnets}
(m182_friend <- to_uniplex(ison_algebra, "friend_tie"))
gfriend <- autographr(m182_friend) + ggtitle("Friendship")
(m182_social <- to_uniplex(ison_algebra, "social_tie"))
gsocial <- autographr(m182_social) + ggtitle("Social")
(m182_task <- to_uniplex(ison_algebra, "task_tie"))
gtask <- autographr(m182_task) + ggtitle("Task")
library(patchwork)
gfriend + gsocial + gtask
```

# Structural Holes and Constraint

Where might innovation be most likely to occur in these networks?
Let's take a look at which actors are least constrained 
by their position in the task network to begin with.
`{migraph}` makes this easy enough with the `node_constraint()` function.

```{r constraint}
node_constraint(m182_task)
```

We see that this function returns a vector of 
constraint scores that can range between 0 and 1.
Let's size the nodes according to this score,
and identify the node with the minimum constraint score.

```{r constraintplot}
ggidentify(m182_task, node_constraint, min)
```

Why minimum? And what can we learn from this plot
about where innovation might occur within this network?

# Structural Equivalence

Now we are going to identify and interpret the roles
or relations between a set of structurally equivalent positions.
We're going to identify structurally equivalent positions
across all the data that we have, including 'task', 'social' and 'friend' ties,
but the unit test this week will ask you to run this on a uniplex version of this network.

## Constructing a multiplex matrix

Ok, so to begin with we need to obtain the profiles that we are going to correlate to
identify same/similar positions. 
For structural equivalence, we can start with a census of all the outgoing
and incoming ties to reveal their tie partners.

```{r construct-cor}
dim(node_tie_census(ison_algebra))
head(structural_combo <- node_tie_census(ison_algebra))[,c(1,17,33,49,65,81)]
```

We can see that the result is a matrix of `r dim(node_tie_census(ison_algebra))[1]` rows
and `r dim(node_tie_census(ison_algebra))[2]` columns, because we want to catalogue or take a census
of all the different incoming/outgoing partners our 16 nodes might have across these three networks.
Note also that the result is a weighted matrix; what would you do if you wanted it to be binary?

## Calculating structural (dis)similarity

The next step, once we have our data (the tie census),
is to cluster nodes by their equivalence.
In summary, we're going to hierarchically cluster the nodes
based on the distances in dissimilarity in their outgoing and incoming ties.
Or you can just run the following line:

```{r cluster-str}
(str_res <- cluster_structural_equivalence(ison_algebra))
```

This object doesn't tell us much,
but we can investigate it more using `{migraph}`'s `ggtree()`.
This is a dendrogram of the hierarchical clustering object.
Basically, as we move to the right, we're allowing for
more and more dissimilarity among those we cluster together.
A fork or branching point indicates the level of dissimilarity
at which those two or more nodes would be said to be equivalent.

```{r}
ggtree(str_res)
ggtree(str_res, 2) # for example let's say there are just two main clusters
ggtree(str_res, 4) # or four? what are we seeing here?
```

Ok, so we can draw a line and this establishes how many clusters
we have (or vice versa), but also which nodes belong to which cluster.
But how many clusters should we pick?

## Identifying number of clusters

To establish that, we need to iterate through all of our options,
calculating for each how correlated this pattern is with the observed network.
We then plot this and, using the "elbow method", decide how many clusters.

```{r idstrclust}
ggidentify_clusters(str_res, structural_combo)
```

When there is one cluster for each vertex in the network, 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.
So the correlations in each by-cluster matrix are correlated with the observed 
correlation matrix to see how well each by-cluster matrix fits the data.

Ok, so it looks here as if there is a clear bend in the elbow/knee
at four clusters. This is reasonably parsimonious and well-fitting.
More clusters than this only distinguishes nodes that are less dissimilar.

We can use `cutree()` to cut the tree at our desired point
and return the resulting vector of cluster assignments.

```{r cutree}
(str_clu <- cutree(str_res, 4))
```

This we can use for various things.
Most immediately, we may wish to see these cluster assignments
mapped onto our networks.
All we need to do is add the variable to existing networks and
plot them:

```{r strclu-plots}
m182_task <- m182_task %>% as_tidygraph() %>% mutate(clu = str_clu)
autographr(m182_task, node_color = "clu") + ggtitle("Task")
m182_social <- m182_social %>% as_tidygraph() %>% mutate(clu = str_clu)
autographr(m182_social, node_color = "clu") + ggtitle("Social")
m182_friend <- m182_friend %>% as_tidygraph() %>% mutate(clu = str_clu)
autographr(m182_friend, node_color = "clu") + ggtitle("Friend")
```

## Blockmodelling

Now we can use the 4-cluster solution to generate blockmodels.
We'll do this on the valued network, but binary is possible too.

```{r structblock}
(task_blockmodel <- blockmodel(m182_task, str_clu))
plot(task_blockmodel)
(social_blockmodel <- blockmodel(m182_social, str_clu))
plot(social_blockmodel)
(friend_blockmodel <- blockmodel(m182_friend, str_clu))
plot(friend_blockmodel)
```

What do these plots show?
Plotting the blockmodel like this is particularly useful for characterising what
the profile of ties (partners) is for each position/equivalence class.
We might characterise them like so:

- `r names(str_clu[which(str_clu==1)])` work together only in reciprocal pairs on tasks,
preferring to approach `r names(str_clu[which(str_clu==4)])` but also those of the other two roles.
While they hang out with each other socially quite a bit, friendship from groups 2 and 3 are preferred.
We shall call them *freaks*.
- `r names(str_clu[which(str_clu==2)])` also work together only in reciprocal pairs,
preferring to work collaboratively with group 1 or also `r names(str_clu[which(str_clu==4)])`.
They also tend to count those from group 1 as friends,
and hang out with everyone else but themselves.
We shall call them *squares*.
- `r names(str_clu[which(str_clu==3)])` will work with either some in group 1 and 3, or 2,
but again prefer `r names(str_clu[which(str_clu==4)])` for task advice.
They are pretty good friends with each other though,
and pretty happy to socialise with everyone.
We shall call them *nerds*.
- `r names(str_clu[which(str_clu==4)])` is a loner, no friends, 
but everyone hangs out with them for task advice, therefore the *geek*.

## Reduced graph

Finally, we can reduce the graph to just interactions between roles.
Let's start off by graphing the valued/weighted blockmodel.

```{r strredgraph}
group_labels <- c("Freaks","Squares","Nerds","Geek")
(social_reduced <- reduce_graph(social_blockmodel, group_labels))
autographr(social_reduced)
(task_reduced <- reduce_graph(task_blockmodel, group_labels))
autographr(task_reduced)
(friend_reduced <- reduce_graph(friend_blockmodel, group_labels))
autographr(friend_reduced)
```

What can help interpreting these profiles is getting the summaries of average weight ties by group.

```{r str-group}
group_tie_census(m182_task, str_clu)
```

```
# ADVANCED: Note on deductive clustering:

# It's pretty straightforward to alter the code above to test hypotheses.
# 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. 

  task_social_cors <- cor(task_social)
  
# 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:
dedclust = c(1, 2, 1, 1, 1, 1, 2, 2, 1, 1, 1, 1, 1, 1, 1, 3)

# Then examine the fitness of this cluster configuration as follows:
dedclust_mat <- NetCluster::generate_cluster_cor_mat(task_social_cors, dedclust)
dedclust_mat
gcor(dedclust_mat, task_social_cors)
```

# Regular Equivalence

## Constructing a triad census

We're going to use the same pair of networks as with structural equivalence.
But this time we're not going to get the correlation of ties,
but rather the correlation of profiles/patterns of local configurations. 
How can we identify patterns of local configurations?
We'll measure these profiles in terms of triad counts.

Now, there is a function for calculating triad censuses:

```{r graphtriads}
(graph_triad_census(m182_task))
```

But as you can see, it just gives a aggregated tally for the whole network
and not one differentiated by actor (which is what we need).
Fortunately, `{migraph}` offers a node-level triad census too.

```{r nodetriads}
# (By putting parentheses around this command, it'll assign AND print!)
(task_triads <- node_triad_census(m182_task))
```

Can you recall what these MAD codes mean?
MAN might be easier to remember, for NULL dyads is the last,
but MAD is probably more appropriate.
`?igraph::triad.census` can be used to check what each of the MAD codes means.

As with the structural equivalence, we can simply run our function
and return an object that has hierarchically clustered our nodes,
but this time it will be based on their (dis)similarity
from each others patterns of ties.

```{r regeq}
reg_res <- cluster_regular_equivalence(m182_task)
ggtree(reg_res,4)
```

Ok, so it looks like these nodes are much more similar
in terms of their patterns of ties than their actual ties.

Like before, we'll loop through each possible cluster solution
and see how well they match the observed matrix of triad type correlations.

```{r regid}
ggidentify_clusters(reg_res, task_triads)
```

The cluster correlation plot seems a bit ambiguous here, at least visually.
But the elbow method has highlighted 2 clusters as a pretty good solution.

```{r cutreereg}
ggtree(reg_res, 2)
(reg_clu <- cutree(reg_res, 2))
m182_task <- m182_task %>% as_tidygraph() %>% mutate(regclu = reg_clu)
autographr(m182_task, node_color = "regclu") + ggtitle("Task")
```

## Blockmodelling

As before, we can use these clusters to blockmodel the task network.

```{r regblock}
(task_blockmodel <- blockmodel(m182_task, reg_clu))
plot(task_blockmodel)
```

## Reduced graph

Finally, we can reduce the graph to just interactions between roles.
Obviously this is not particularly informative with only two clusters though...

```{r regredgraph}
(task_reduced <- reduce_graph(task_blockmodel, c("Regulars","Geek")))
autographr(task_reduced)
```

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 16 possible triad types. 
Each cell is the average number of the given triad type for each individual 
in the cluster:

```{r clustercensus}
group_triad_census(m182_task, reg_clu)
```

```
# ADVANCED: Note that we can also blockmodel our communities from last week.
# walktrap_blockmodel <- blockmodel(get.adjacency(m182_main, sparse = F), 
#                                   friend_wt$membership)
# plot(walktrap_blockmodel)
# walktrap_blockmodel
# # And graphs that from the reduced form blockmodels...
# walktrap_blockmodel_red <- graph.adjacency(walktrap_blockmodel$block.model, weighted = T)
# plot(walktrap_blockmodel_red, edge.width = E(walktrap_blockmodel_red)$weight,
#      vertex.color = rainbow(2) )
# # Admittedly, not terribly interesting...
# 
# edgebet_blockmodel <- blockmodel(get.adjacency(m182_main, sparse = F), 
#                                  friend_eb$membership)
# plot(edgebet_blockmodel) # blockmodel
# edgebet_blockmodel_red <- graph.adjacency(edgebet_blockmodel$block.model, weighted = T)
# plot(edgebet_blockmodel_red, edge.width=E(edgebet_blockmodel_red)$weight,
#      vertex.color=rainbow(3) ) # reduced graph
# # Cool
# 
# fastgreed_blockmodel <- blockmodel(get.adjacency(m182_main, sparse = F), 
#                                    friend_fg$membership)
# plot(fastgreed_blockmodel) # blockmodel
# fastgreed_blockmodel_red <- graph.adjacency(fastgreed_blockmodel$block.model, weighted = T)
# plot(fastgreed_blockmodel_red, edge.width=E(fastgreed_blockmodel_red)$weight,
#      vertex.color=rainbow(3) ) # reduced graph
```

# Unit Test

1. Visualise the m182 FRIENDSHIP network, 
sizing the vertices by constraint and identifying the structural hole
What would being in a structural hole mean here?
2. Plot labelled, reduced graph of REGULARLY equivalent classes on friendship network only
3. Plot labelled, reduced graph of STRUCTURALLY equivalent classes on task network only
