---
title: "Projectoin in R Lab"
date: "CRJ 605 Statistical Analysis of Networks"
output:
html_document:
df_print: paged
theme: cosmo
highlight: haddock
toc: yes
toc_float: yes
code_fold: show
---
```{r,echo=FALSE,eval=TRUE,message=FALSE,warning=FALSE}
library(devtools)
library(network)
library(sna)
```
###
*This lab works with unipartite/one-mode projections of two-mode networks.*
***
###**One-Mode Networks by Projection**
*Projection* is the process by which we map the connectivity between modes to a single mode.
For example, consider a two-mode network of people in groups. By projecting, we get:
* One-mode network of people connected to people by groups.
* One-mode network of groups connected by people.
*How do we do this?*
Following [Breiger (1974)](https://www.jstor.org/stable/2576011), we can build the adjacency matrix for each projected network through matrix algebra. Specifically, multiplying an adjacency matrix by it’s **transpose**. The transpose of a matrix *A* simply reverses the columns and rows: $\sf{AT_{ij}}$ = $\sf{A_{ji}}$.
The two-mode, *NxM*, adjacency matrix, when multiplied by it’s transpose, produces either:
* An *MxM* matrix (ties among *M* nodes via *N*)
* An *NxN* matrix (ties among *N* nodes via *M*)
In R, the `t()` function, or `transpose()` returns the transposition of a matrix:
```{r,echo=TRUE,eval=TRUE,message=FALSE,include=TRUE}
# clear the workspace.
rm(list = ls())
# call the libraries.
library(sna, quietly=TRUE)
library(network, quietly=TRUE)
# create the example network.
bipartite.example <- rbind(c(1,1,0,0,0),c(1,0,0,0,0),c(1,1,0,0,0),c(0,1,1,1,1),c(0,0,1,0,0),c(0,0,1,0,1))
rownames(bipartite.example) <- c("A","B","C","D","E","F")
colnames(bipartite.example) <- c("1","2","3","4","5")
bipartite.example.net <- as.network(bipartite.example,bipartite=dim(bipartite.example)[1]) # take the first dimension of the matrix.
gplot(bipartite.example.net,label=network.vertex.names(bipartite.example.net),gmode="twomode", usearrows=FALSE, vertex.cex=2,label.cex=1.2,main="Bipartite Graph of Example Graph")
# print out the object.
bipartite.example
# Now, take a look at the t() function.
?t
# Compare the objects. What has changed?
t(bipartite.example)
```
To multiply in R, we have to use the following character: `%*%`. This is different then `*` in that `%*%` tells R to use matrix multiplication. For example, compare the difference between these two objects:
```{r,echo=TRUE,eval=TRUE,message=FALSE,include=TRUE}
# Compare these objects:
a <- matrix(c(1,1,1,1),nrow=2,byrow=T)
b <- matrix(c(2,2,2,2),nrow=2,byrow=T)
a*b #this one is multiplying the first element in a by the first element in b.
a%*%b #this one is actual matrix multiplication.
# what is different between them?
```
To multiply two matrices, the number of columns in the first matrix must match the number of rows in the second matrix. Only matrices with *conformable* dimensions can be multiplied. For example, 5x6 X 6x5 works, but not 5x6 X 5x6. The *product* matrix has the number of rows equal to the first matrix and the number of columns equal to the second matrix.
```{r,echo=TRUE,eval=TRUE,message=FALSE,include=TRUE}
#bipartite.example%*%bipartite.example # this does not work because the dimensions do not match.
bipartite.example%*%t(bipartite.example) #but this works, because we have arranged the dimensions correctly.
# again, note that the use of the * operator produces a different matrix.
bipartite.example*bipartite.example
```
Now, let's look at our results from the slides:
```{r,echo=TRUE,eval=TRUE,message=FALSE,include=TRUE}
# let's redefine the object to be consistent with the slides.
A <- bipartite.example
# create the "person" matrix: recall this is A X t(A).
P <- A%*%t(A)
P
# What does the diagonal represent in this matrix?
# What do the off-diagonal elements represent?
set.seed(1)
gplot(P,gmode="graph",label=c("A","B","C","D","E","F"))
# create the "group" matrix: recall this is t(A) X A.
G <- t(A)%*%A
G
# What does the diagonal represent in this matrix?
# What do the off-diagonal elements represent?
set.seed(1)
gplot(G,gmode="graph",label=c("1","2","3","4","5"))
```
###**One-Mode Networks using `tnet()` functions**
As discussed in the "Projection and Weighted Networks" lecture, we have some options when working with the projected network. For example, we can *binarize* the off-diagonal elements to reflect 0 and 1s for the presence and absense of ties. Alternatively, we could use the *summation* method whereby the off-diagonal elements represent the count of shared nodes. Finally, we could use the *Newman* method were ties are weighted by the number of edges incident on a node prior to projection.
We can look at these various approaches in the `tnet()` package. The function we want to examine is the `projecting_tm()` function. This function has a `method=` argument where we can stipulate what type of projection we want.
```{r,echo=TRUE,eval=TRUE,message=FALSE,include=TRUE}
# First, call the tnet() package.
library(tnet)
# Look at the function.
?projecting_tm
# Coerce the object to be of class tnet.
bipartite.example.tnet <- as.tnet(as.matrix(bipartite.example.net))
# Now, create the various projections based on the different method= arguments.
binary.projection.example <- projecting_tm(bipartite.example.tnet, method="binary")
sum.projection.example <- projecting_tm(bipartite.example.tnet, method="sum")
newman.projection.example <- projecting_tm(bipartite.example.tnet, method="Newman")
```
Now let's take a look at the differences between them. I prefer to view these as matrices, which requires us to coerce to an object of class `network()`. This takes several steps:
```{r,echo=TRUE,eval=TRUE,message=FALSE,include=TRUE}
# First, coerce the object to an igraph object using the tnet_igraph function.
binary.projection.example.igraph <- tnet_igraph(binary.projection.example,type="weighted one-mode tnet")
sum.projection.example.igraph <- tnet_igraph(sum.projection.example,type="weighted one-mode tnet")
newman.projection.example.igraph <- tnet_igraph(newman.projection.example,type="weighted one-mode tnet")
# Now, load the intergraph package to coerce the igraph object to a network object using the asNetwork() function.
library(intergraph)
binary.projection.example.net <- asNetwork(binary.projection.example.igraph)
sum.projection.example.net <- asNetwork(sum.projection.example.igraph)
newman.projection.example.net <- asNetwork(newman.projection.example.igraph)
# Then, detach tnet and igraph because they conflict with sna.
detach(package: tnet)
detach(package: igraph)
# Now, finally, we can look at the matrices.
as.matrix(binary.projection.example.net, attrname = "weight")
as.matrix(sum.projection.example.net, attrname = "weight")
as.matrix(newman.projection.example.net, attrname = "weight")
# It is a bit easier to just pull the edge atttribute.
weights.mat <-cbind(
binary.projection.example.net %e% "weight",
sum.projection.example.net %e% "weight",
newman.projection.example.net %e% "weight"
)
colnames(weights.mat) <- c("Binary","Summation","Newman")
weights.mat
# plot the graph with the edge weights to see the differences.
par(mfrow=c(2,2))
set.seed(1)
gplot(bipartite.example.net,label=c("A","B","C","D","E","F","","","","",""),gmode="twomode", usearrows=FALSE, vertex.cex=2,label.cex=1.2,main="Bipartite Graph of Example Graph")
set.seed(1)
gplot(binary.projection.example.net,gmode="graph", main="Binary",
edge.lwd = binary.projection.example.net %e% "weight"*5, # size the edges based on the weight.
vertex.col= "orange",label = c("A","B","C","D","E","F")) # set the correct labels.
set.seed(1)
gplot(sum.projection.example.net,gmode="graph",main="Summation", edge.lwd = sum.projection.example.net %e% "weight"*5, vertex.col = "lightblue",label = c("A","B","C","D","E","F"))
set.seed(1)
gplot(newman.projection.example.net,gmode="graph",main="Newman", edge.lwd = newman.projection.example.net %e% "weight"*5, vertex.col = "lightgreen",label = c("A","B","C","D","E","F"))
par(mfrow=c(1,1))
```
***
###**Empirical Example**
Now, let's take a look at the biparite graph used in a paper I wrote with Justin Ready entitled ["Diffusion of Ideas and Technology: The Role of Networks in Influencing the Endorsement and Use of On-Officer Video Cameras"](https://journals.sagepub.com/doi/10.1177/1043986214553380). The goal of the paper was to examine how police officers develop cognitive frames about the usefulness of body-worn cameras and try to determine whether interactions with other officers provide a conduit for facilitating cognitive frames that increase camera legitimacy.
The bipartite graph is available as an edgelist is available [here](https://www.jacobtnyoung.com/uploads/2/3/4/5/23459640/officer.event.edgelist.csv). Let's import the edgelist and take a look at the network.
```{r,echo=TRUE,eval=TRUE,message=FALSE,include=TRUE}
library(sna)
library(network)
officer.event.edgelist <- as.matrix(read.csv("https://www.jacobtnyoung.com/uploads/2/3/4/5/23459640/officer.event.edgelist.csv", as.is=TRUE, header=TRUE))
# create the matrix format.
uR <-unique(officer.event.edgelist[,1])
uC <- unique(officer.event.edgelist[,2])
mat <- matrix(0, length(uR), length(uC))
rownames(mat) <- uR
colnames(mat) <- uC
mat[officer.event.edgelist] <- 1
diag(mat) <- 0
# Now, create the bipartite network.
officer.event.net <- as.network(mat,bipartite=81,matrix.type="adjacency")
# Load tnet.
library(tnet)
# Coerce the object to be of class tnet.
bipartite.officer.tnet <- as.tnet(as.matrix(officer.event.net))
# Now, create the various projections based on the different method= arguments.
binary.projection.officer <- projecting_tm(bipartite.officer.tnet, method="binary")
sum.projection.officer <- projecting_tm(bipartite.officer.tnet, method="sum")
newman.projection.officer <- projecting_tm(bipartite.officer.tnet, method="Newman")
# Now, load the intergraph package to coerce the igraph object to a network object using the asNetwork() function.
library(intergraph)
binary.projection.officer.net <- asNetwork(binary.projection.officer)
sum.projection.officer.net <- asNetwork(sum.projection.officer)
newman.projection.officer.net <- asNetwork(newman.projection.officer)
# Then, detach tnet and igraph because they conflict with sna.
detach(package: tnet)
detach(package: igraph)
# Create some stuff for the plot.
status <- c(rep("Control",44),rep("Treatment",37),rep("Event",153))
vcol <- status
vcol[status == "Control"] <- "green" # make controls green.
vcol[status == "Treatment"] <- "Red" # make treatment group red.
vcol[status == "Event"] <- "White" # make events white.
vsides <- rep(0,length(status))
vsides[status == "Control"] <- 3 # make controls triangles.
vsides[status == "Treatment"] <- 4 # make treatment group squares.
vsides[status == "Event"] <- 50 # make events circles.
# plot the graph with the edge weights to see the differences.
par(mfrow=c(2,2))
set.seed(1)
gplot(officer.event.net,gmode="twomode",usearrows=FALSE,displayisolates=FALSE,vertex.col=vcol,vertex.sides=vsides,edge.col="grey60",edge.lwd=1.2,vertex.cex = c(rep(2,dim(as.matrix(officer.event.net))[1]),rep(1.2,dim(as.matrix(officer.event.net))[2])))
set.seed(1)
gplot(binary.projection.officer.net,gmode="graph", main="Binary", edge.lwd = binary.projection.officer.net %e% "w", vertex.col= "orange")
set.seed(1)
gplot(sum.projection.officer.net,gmode="graph", main="Summation", edge.lwd = sum.projection.officer.net %e% "w"*2, vertex.col= "lightblue")
set.seed(1)
gplot(newman.projection.officer.net,gmode="graph", main="Newman", edge.lwd = sum.projection.officer.net %e% "w"*2, vertex.col= "lightgreen")
par(mfrow=c(1,1))
```
***
####***Questions?***####
```{r,echo=FALSE,eval=FALSE}
#END OF LAB
```