forked from core-methods-in-edm/assignment2
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Assignment 2.Rmd
242 lines (197 loc) · 11.5 KB
/
Assignment 2.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
---
title: "Assignment 6 - Social Network Analysis"
author: "Charles Lang"
date: "Oct 13, 2016"
output: html_document
---
In Assignment 2 we will be looking at some disciplinary data from a middle school. The file "discipline-data.csv" shows which teacher sent which student to the principal during the semester.
We will be using the "igraph" package to visualize the disciplinary relationships between teachers and students as a network. You can read more about igraph here:
http://igraph.org/r/
Start by installing the "igraph" package. Once you have installed igraph, load the package.
Now upload the data file "discipline-data.csv" as a data frame called "D1". Each row is a disciplinary action from a teacher to a student so the first line shows that teacher "E" sent student "21" to the principal. It also shows the gender of both the teacher and student and the student's main elective field of study ("major"") and the field that the teacher instructs in ("t.expertise").
Before you proceed, you will need to change the data type of the student id variable. Since it is a number R will automatically think it is an integer and code it as such (look at the list of variables by clicking on the data frame arrow in the Data pane. Here you will see the letters "int"" next to the stid variable, that stands for integer). However, in this case we are treating the variable as a category, there is no numeric meaning in the variable. So we need to change the format to be a category, what R calls a "factor". We can do this with the following code:
```{r}
D1$stid <- as.factor(D1$stid)
```
igraph requires data to be in a particular structure. There are several structures that it can use but we will be using a combination of an "edge list" and a "vertex list". As you might imagine the edge list contains a list of all the relationships between students and teachers and any characteristics of those edges that we might be interested in. There are two essential variables in the edge list a "from" variable and a "to" variable that descibe the relationships between vertices (a disciplinary action is given "from" and teacher "to" a student). While the vertix list contains all the characteristics of those vertices, in our case gender and major.
So let's convert our data into an edge list!
First we will isolate the variables that are of interest: tid and stid
```{r}
library(dplyr)
D2 <- dplyr::select(D1, tid, stid)
```
Since our data represnts every time a teacher sends a student to the principal there are multiple rows when the same teacher sends the same student. We want to collapse these into a single row, with a variable that shows how many times a teacher-student pair appears.
```{r}
EDGE <- dplyr::count(D2, tid, stid)
names(EDGE) <- c("from", "to", "count")
```
EDGE is your edge list. Now we need to make the vertex list, a list of all the teachers and students and their characteristics in our network.
```{r}
#First we will separate the teachers from our original data frame
V.TCH <- dplyr::select(D1, tid, t.gender, t.expertise)
#Remove all the repeats so that we just have a list of each teacher and their characteristics
V.TCH <- unique(V.TCH)
#Add a variable that describes that they are teachers
V.TCH$group <- "teacher"
#Now repeat this process for the students
V.STD <- dplyr::select(D1, stid, s.gender, s.major)
V.STD <- unique(V.STD)
V.STD$group <- "student"
#Make sure that the student and teacher data frames have the same variables names
names(V.TCH) <- c("id", "gender", "topic", "group")
names(V.STD) <- c("id", "gender", "topic", "group")
#Bind the two data frames together (you will get a warning because the teacher data frame has 5 types of id (A,B,C,D,E) and the student has 25 (1-30), this isn't a problem)
VERTEX <- dplyr::bind_rows(V.TCH, V.STD)
```
Now we have both a Vertex and Edge list it is time to plot our graph!
```{r}
#Load the igraph package
library(igraph)
#First we will make an object that contains the graph information using our two dataframes EDGE and VERTEX. Notice that we have made "directed = TRUE" - our graph is directed since discipline is being given from a teacher to a student.
g <- graph.data.frame(EDGE, directed=TRUE, vertices=VERTEX)
#Now we can plot our graph using the force directed graphing technique - our old friend Fruchertman-Reingold!
plot(g,layout=layout.fruchterman.reingold)
#There are many ways to change the attributes of the graph to represent different characteristics of the newtork. For example, we can color the nodes according to gender.
plot(g,layout=layout.fruchterman.reingold, vertex.color=VERTEX$gender)
#We can change the thickness of the edge according to the number of times a particular teacher has sent a particular student to the principal.
plot(g,layout=layout.fruchterman.reingold, vertex.color=VERTEX$gender, edge.width=EDGE$count)
#Other attributes you may want to change are:
#Arrow size
edge.arrow.size=
#Remove the labels
vertex.label=NA
#Vertex size
vertex.size=
#And many others!
```
Play around with different graphs and then save your final version to the repo. Create a Zotero item for this R program and then commit, push and pull.
Once you have done this you need to practice with data from our class. Please create a **person-network** with the data set hudk4050-classes.csv. Once you have done this, also [look up](http://igraph.org/r/) how to generate the following network metrics: betweeness centrality and dregree. **Who is the most central person in the network?**
Joonyoung most central person..Dave,Devan, and Jie have highest degree
```{r}
library(dplyr)
library(igraph)
Z1<-read.csv("hudk4050-classes.csv")
Z1<-as.data.frame(Z1)
#data read into R as data frame
Z1$FullName <- do.call(paste, c(Z1[c("First.name", "Last.name")], sep = " "))
#Combines first and last name to full name in 1 cell
Z2<-Z1%>% tidyr ::gather(Newcol,classes,3:7)
#gathers all classes into 1
Z3 <- Z2[-which(g$classes == ""), ]
Z4 <- subset(Z3, select = -c(First.name,Last.name,Newcol))
name<-c(Z4$FullName)
class<-c(Z4$classes)
data<-data.frame(name,class)
data<-xtabs(Col~name+class,cbind(data,Col=1))
# at this point 3 columns.. name, class, and 1 or 0 binary
person.net <- data %*% t(data)
group.net <- t(data) %*% data
#transposes names and classes into diagonals
diag(group.net) <- NA
diag(person.net) <- NA
person.g <- graph.adjacency(person.net,mode="undirected",weighted=NULL,diag=FALSE)
group.g <- graph.adjacency(group.net, weighted=TRUE,mode="undirected",diag=FALSE)
la <- layout.fruchterman.reingold(group.g)
e.wt <- get.edge.attribute(group.g, "weight")
plot(group.g, layout=la, vertex.size=15,edge.width=e.wt,vertex.label=V(group.g$name)
+ )
plot(group.g, layout=la, vertex.size=15,edge.width=e.wt,vertex.label=V(group.g$name)
+ )
plot(group.g, layout=la, vertex.size=15,edge.width=e.wt,
+ vertex.label=V(group.g)$name)
dev.off()
null device
1
plot(group.g, layout=la, vertex.size=15,edge.width=e.wt,
+ vertex.label=V(group.g)$name)
dev.off()
null device
1
la <- layout.fruchterman.reingold(person.g)
e.wt <- get.edge.attribute(person.g, "weight")
plot(person.g, layout=la, vertex.size=3,edge.width=0.1,
+ vertex.label=V(person.g)$name)
dev.off()
null device
1
la <- layout.fruchterman.reingold(person.g)
e.wt <- get.edge.attribute(person.g, "weight")
plot(person.g, layout=la, vertex.size=3,edge.width=0.1,
+ vertex.label=V(person.g)$name)
dev.off()
null device
1
data.t <- t(data)
person2.net <- data %*% t(data)
diag(person2.net) <- NA
person2.g <- graph.adjacency(person2.net, mode="undirected", weighted=TRUE, diag=FALSE)
la <- layout.fruchterman.reingold(person2.g)
e.wt <- get.edge.attribute(person2.g, "weight")
plot(person2.g, layout=la, vertex.size=15,edge.width=e.wt,
+ vertex.label=V(person2.g)$name)
dev.off()
null device
1
plot(person2.g, layout=la, vertex.size=15,edge.width=e.wt,
+ vertex.label=V(person2.g)$name)
dev.off()
null device
1
#betweeness measure
btwn.person <- betweenness(person.g)
names(btwn.person) <- V(person.g)$name
ind <- order(-btwn.person)
btwn.person[ind][1:10]
Joonyoung Park Benjamin Roberts Chuheng Hu David Cody David Nitkin
25 0 0 0 0
David Rudel Devan Goto Jiaqing Zhang Jiaxi Li Jie Gao
0 0 0 0 0
#centrality measure
cent.bonpow <- bonpow(person.g, exponent=1)
names(cent.bonpow) <- V(person.g)$name
ind <- order(cent.bonpow)
cent.bonpow[ind][1:28]
Jiaxi Li Lauren Fox Ngoc Bich (Gemy) Pham
-1.2258845 -1.2258845 -1.2258845
Victoria Bertotti Wei Wei Xiaoting Kuang
-1.2258845 -1.2258845 -1.2258845
ZhiJun Huang David Nitkin David Rudel
-1.2258845 -1.2258845 -1.2258845
Jiaqing Zhang Jonathan Stelman Robert Jackson
-1.2258845 -1.1518129 -1.1518129
Joshua Coleman Lauren Romine Zhuqian Zhou
-1.1518129 -1.1518129 -1.1518129
Shreya Goel Jingtong Feng Chuheng Hu
-1.1221843 -0.8555266 -0.8110837
Samantha Pepe Benjamin Roberts David Cody
-0.8110837 -0.8036765 -0.6777549
Jie Gao Devan Goto Joonyoung Park
-0.6777549 -0.6777549 -0.5629439
Xiangyu Wang Xiaoyue Zhang Linh Doan
-0.5222046 -0.5222046 0.0000000
Magdalena Bennett Colomer
0.3814686
#degree measure
degree(person.g, v = V(person.g), mode = c("all", "out", "in", "total"),
+ loops = TRUE, normalized = FALSE)
Benjamin Roberts Chuheng Hu David Cody
27 41 43
David Nitkin David Rudel Devan Goto
25 25 43
Jiaqing Zhang Jiaxi Li Jie Gao
25 25 43
Jingtong Feng Jonathan Stelman Joonyoung Park
42 36 26
Joshua Coleman Lauren Fox Lauren Romine
36 25 36
Linh Doan Magdalena Bennett Colomer Ngoc Bich (Gemy) Pham
0 1 25
Robert Jackson Samantha Pepe Shreya Goel
36 41 37
Victoria Bertotti Wei Wei Xiangyu Wang
25 25 29
Xiaoting Kuang Xiaoyue Zhang ZhiJun Huang
25 29 25
Zhuqian Zhou
36
```