Assign_SNA

R Markdown

This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.

When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:

library(igraph)

## 
## Attaching package: 'igraph'

## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum

## The following object is masked from 'package:base':
## 
##     union

library(readxl)
rm(list=ls())

cnet<-read_graph("/Users/joanneyang/Documents/HU/512-51-B-2020-Spring-DataVisualization/assign_network/cnet", format = "graphml")

• read the file

library(htmlTable); library(expss);library(stringi); library(tidyverse)

## 
## Use 'expss_output_rnotebook()' to display tables inside R Notebooks.
##  To return to the console output, use 'expss_output_default()'.

## 
## Attaching package: 'expss'

## The following object is masked from 'package:igraph':
## 
##     %u%

## ── Attaching packages ────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse 1.3.0 ──

## ✔ ggplot2 3.2.1     ✔ purrr   0.3.3
## ✔ tibble  2.1.3     ✔ dplyr   0.8.3
## ✔ tidyr   1.0.0     ✔ stringr 1.4.0
## ✔ readr   1.3.1     ✔ forcats 0.4.0

## ── Conflicts ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::as_data_frame() masks tibble::as_data_frame(), igraph::as_data_frame()
## ✖ dplyr::between()       masks expss::between()
## ✖ purrr::compose()       masks igraph::compose()
## ✖ dplyr::compute()       masks expss::compute()
## ✖ dplyr::contains()      masks tidyr::contains(), expss::contains()
## ✖ tidyr::crossing()      masks igraph::crossing()
## ✖ dplyr::filter()        masks stats::filter()
## ✖ dplyr::first()         masks expss::first()
## ✖ stringr::fixed()       masks expss::fixed()
## ✖ dplyr::groups()        masks igraph::groups()
## ✖ purrr::keep()          masks expss::keep()
## ✖ dplyr::lag()           masks stats::lag()
## ✖ dplyr::last()          masks expss::last()
## ✖ purrr::modify()        masks expss::modify()
## ✖ purrr::modify_if()     masks expss::modify_if()
## ✖ dplyr::na_if()         masks expss::na_if()
## ✖ tidyr::nest()          masks expss::nest()
## ✖ dplyr::recode()        masks expss::recode()
## ✖ stringr::regex()       masks expss::regex()
## ✖ purrr::simplify()      masks igraph::simplify()
## ✖ purrr::transpose()     masks expss::transpose()
## ✖ dplyr::vars()          masks ggplot2::vars(), expss::vars()

htmlTable(cro(V(cnet)$rank_from_high ,V(cnet)$party))

	V(cnet)$party
	Democratic	Republican
V(cnet)$rank_from_high
-2147483648	23	4
1	1
2		1
3	1
4	1
5	1
6	1
8	1
9	1
10	1
11	1
12	1
13	1
14	2
16	1
17	1
18	1
19	1
20	1
21	1
22	1
23	1
25	1
26	1
27	1
28	1
29	1
30	1
31	2
33	1
34	1
35	1
36	1
37	1
38	1
40	1
41	1
42	1
43	3
46	2
48	1
49	1
50	1
53	1
54	1
55	1
56	1
57	1
58	1
59	1
61	1
62	2
64	1
66	1
68	1
69	1
70	2
72	1
73	2
76	1
77	1
78	1
79	1
80	1
81	1
82	1
83	1
85	1
86	1
87	1
88	1	1
90	1
91	2
93	1
94	1
95	1
96		1
97	3
99	1
100	1
101	1
102	1
103	1
105	2
108	3
111	1
112		1
113	1
114	1
115	2
117	1
118	3
122		1
123	1
124	2
126	1
127	1
128	1
129	1
130	1
131	2
133	1
134	1
135	1
136	1
137	1
138	2
141	1
142	1
143	1
144	1
145	3
148	1
149	1
150	2
152	2
154	1
155	3
158	1
159	1	1
161	1
163		1
164	2
166	2
168	1
169	1
170	2	1
173	1
174	1
175	1
176	2	1
179	1
181	1
182	1	1
184	1
185	2	1
188	1
189	1
190	2	1
193		1
194	1
195	1
196	1
197		1
198	1
200	1
201	1
202	2
204	1	1
207	3	1
211	1	1
213		2
215		1
217	2	1
220	1	1
222	1
224	3
227		2
229		1
230		1
231	1
232	2
234		1
235		1
236	1	2
239	1
240	1	1
242	1
244		1
245		1
246	2	1
249	1
250		2
252		3
256	1
257	1	1
259	1	1
261		1
262		1
263		1
265		1
267		2
269	1
270	3	1
274	1
275	1	1
277	1
278	1	1
280		1
281		2
283		1
284		2
286		3
289		3
292		2
294		1
295		1
296		3
299		2
301		2
303		1
304	1	1
306	1	1
309		1
310		1
311		2
313		3
316		2
318		1
319		3
322	1	1
324		1
326		1
327		1
328		1
329		2
331		1
332		2
334	1	1
336	1	1
338		1
339		1
340		2
343		2
345		1
346		1
347		1
348		1
349		4
353		1
354		4
358		2
360	1	3
364		1
365		1
366		2
368		3
371	1	1
372		2
375		1
376		4
380		3
383		1
384		1
385		2
387		1
388		1
389		2
392		1
393		1
394		5
399		2
401		1
402		2
404		1
405		1
407		2
409		1
410		2
412		2
414		1
415		2
417		1
418		1
419		1
420		2
422		1
423		2
425		2
427		1
428		2
430		1
431		1
433		1
434		1
#Total cases	236	196

htmlTable(cro(V(cnet)$chamber ,V(cnet)$party))

	V(cnet)$party
	Democratic	Republican
V(cnet)$chamber
House	236	196
#Total cases	236	196

htmlTable(cro(V(cnet)$cosponsored ,V(cnet)$party))

	V(cnet)$party
	Democratic	Republican
V(cnet)$cosponsored
-2147483648	23	4
31		1
44		1
45		1
47		1
52		2
54		1
55		2
58		2
66		1
67		2
68		1
70		1
71		1
72		2
76		1
78		2
80		2
81		1
82		2
84		1
85		1
87		2
88		1
90		2
91		5
93		1
96		1
98		2
99		1
101		1
102		2
104		1
105		1
106		3
107		4
108		1
110		2
111	1	1
112		3
113		2
114		1
117		1
118	1	3
119		2
120		4
121		1
122		4
123		1
125		1
127		1
129		1
130		2
131		2
132		1
134		1
135	1	1
136	1	1
137		2
138		1
140		2
141		1
142		1
143		1
144		1
145	1	1
146		3
150		1
154		2
155		3
156		2
157		1
158		1
159	1	1
160	1	1
161		1
163		2
164		2
165		3
166		1
170		1
172		2
173		3
175		3
177		2
178		1
180		2
182		1
183	1	1
184	1
185	1	1
188	1
189	3	1
191	1
192		2
193		1
195		1
196		1
198		1
199	1	1
200	1	1
202	1
203		3
204		2
205	1
207	2	1
208		1
210		1
212	1
213	1	1
214	1
215	1	2
216		1
217		1
219	2
220	1
221		1
222		1
223		2
227	3
231	1
232	1	1
233	2	1
235		1
236		2
237	1	1
238	3	1
240	1	1
241	2
243	1
244	1
245	1
249		1
250	1
251	1
252	1
254		1
255	2	1
256	1
257	1
258	2	1
263	1
264	1	1
265	1
266	1
267	2	1
268	1
272	1
273	1
275	2	1
279	1
281	1
282	2
283	2
284		1
286	1
287	1	1
288	1
289	3
290	1
293	2
294	2
296	1
298	1
301	3
302	1
303	1
304	1
305	1
307	2
308	1
310	1
311	1
313	1
315	1
316	2
318	1
323	1
325	1
327	1
328	1
330	2
331	1
334		1
335	3
336	1
338	2
339	1
340	1
342		1
344	1
346	3
350	2
356	1
358	1
359	1
360	1
361	1
362	3
363		1
364	1
365	1
366	1
367	2
368	1
369	1	1
370	1
371	1
373	1
379	1
381	1
382	1
383	1
388	1
389	1
390	1
395	1
396	2
397	1
400	2
403	1
406	1
409	1
419	1
420	2
421	1
424	1
425	1
426	1
428	1
431	1
432	1
436	1
441	1
442	1
443	1
444	2
458	3
459	1
467	1
468	1
474	1
476	1
487	1
490	1
493	1
501	1
502	2
503	1
505	1
510	1
514	1
521	1
523	1
559	1
560	1
564	1
567	1
579	1
585	1
588	1
601	1
624	2
644	1
669	1
678	1
700	1
714	1
741	1
778	1
781	1
806	1
830	1
867		1
1283	1
#Total cases	236	196

• use htmltable to see the allocation between the two parties and rank_from_high, chamber, and cosponsored
• I decided to use party with rank from high to do the further analysis

esize<- eigen_centrality(cnet, directed = FALSE)
esize<-esize$vector
eBtwn<-betweenness(cnet)
df<-as.data.frame(cbind(esize,eBtwn))
df$eBtwn<-as.numeric(df$eBtwn)
df$esize<-as.numeric(df$esize)

ggplot(df, aes(esize,eBtwn)) + geom_point()+theme_bw()+
  ggtitle("Figure 1: Relationship Between Eigen Centrality and Betweenness")

- plot the relationship between

gsize(cnet)

## [1] 17983

mean <- mean(V(cnet))
cnet2 <- cnet - V(cnet)[which(V(cnet)$rank_from_high < 250)]
gsize(cnet2)

## [1] 2519

htmlTable(cro(V(cnet2)$rank_from_high ,V(cnet2)$party))

	V(cnet2)$party
	Democratic	Republican
V(cnet2)$rank_from_high
250		2
252		3
256	1
257	1	1
259	1	1
261		1
262		1
263		1
265		1
267		2
269	1
270	3	1
274	1
275	1	1
277	1
278	1	1
280		1
281		2
283		1
284		2
286		3
289		3
292		2
294		1
295		1
296		3
299		2
301		2
303		1
304	1	1
306	1	1
309		1
310		1
311		2
313		3
316		2
318		1
319		3
322	1	1
324		1
326		1
327		1
328		1
329		2
331		1
332		2
334	1	1
336	1	1
338		1
339		1
340		2
343		2
345		1
346		1
347		1
348		1
349		4
353		1
354		4
358		2
360	1	3
364		1
365		1
366		2
368		3
371	1	1
372		2
375		1
376		4
380		3
383		1
384		1
385		2
387		1
388		1
389		2
392		1
393		1
394		5
399		2
401		1
402		2
404		1
405		1
407		2
409		1
410		2
412		2
414		1
415		2
417		1
418		1
419		1
420		2
422		1
423		2
425		2
427		1
428		2
430		1
431		1
433		1
434		1
#Total cases	18	158

• The data contains 17983 edges
• Test a few number with ranking and see the allocation of two parties
• Subset using rank_from_high and eliminate people whose rank is under 250, which in total we have 2519 edges now

set.seed(444)
plot(cnet2, vertex.label=NA)

par(mar=c(1,1,1,1))
set.seed(444)
V(cnet2)$color<-ifelse(V(cnet2)$party=="Republican" , "red", ifelse(V(cnet2)$party=="Democratic", "blue","green"))

plot(cnet2,
     vertex.label=ifelse(V(cnet2)$party=="Republican",NA,V(cnet2)),
     vertex.size=V(cnet2)$degree,
     main="Politicians - Rank >250")

legend("bottomright", c("Democratic","Republican"), pch=25,
       col="#777777", pt.bg=c("blue","red"), title="Party",pt.cex=2, cex=.8)

- Plot subset data - Democrats is much lesser than republican when it comes to rank higher than 250 - How about lower rank?

cnet3 <- cnet - V(cnet)[which(V(cnet)$rank_from_high > 250)]
gsize(cnet3)

## [1] 6968

htmlTable(cro(V(cnet3)$rank_from_high ,V(cnet3)$party))

	V(cnet3)$party
	Democratic	Republican
V(cnet3)$rank_from_high
-2147483648	23	4
1	1
2		1
3	1
4	1
5	1
6	1
8	1
9	1
10	1
11	1
12	1
13	1
14	2
16	1
17	1
18	1
19	1
20	1
21	1
22	1
23	1
25	1
26	1
27	1
28	1
29	1
30	1
31	2
33	1
34	1
35	1
36	1
37	1
38	1
40	1
41	1
42	1
43	3
46	2
48	1
49	1
50	1
53	1
54	1
55	1
56	1
57	1
58	1
59	1
61	1
62	2
64	1
66	1
68	1
69	1
70	2
72	1
73	2
76	1
77	1
78	1
79	1
80	1
81	1
82	1
83	1
85	1
86	1
87	1
88	1	1
90	1
91	2
93	1
94	1
95	1
96		1
97	3
99	1
100	1
101	1
102	1
103	1
105	2
108	3
111	1
112		1
113	1
114	1
115	2
117	1
118	3
122		1
123	1
124	2
126	1
127	1
128	1
129	1
130	1
131	2
133	1
134	1
135	1
136	1
137	1
138	2
141	1
142	1
143	1
144	1
145	3
148	1
149	1
150	2
152	2
154	1
155	3
158	1
159	1	1
161	1
163		1
164	2
166	2
168	1
169	1
170	2	1
173	1
174	1
175	1
176	2	1
179	1
181	1
182	1	1
184	1
185	2	1
188	1
189	1
190	2	1
193		1
194	1
195	1
196	1
197		1
198	1
200	1
201	1
202	2
204	1	1
207	3	1
211	1	1
213		2
215		1
217	2	1
220	1	1
222	1
224	3
227		2
229		1
230		1
231	1
232	2
234		1
235		1
236	1	2
239	1
240	1	1
242	1
244		1
245		1
246	2	1
249	1
250		2
#Total cases	218	40

set.seed(444)
V(cnet3)$color<-ifelse(V(cnet3)$party=="Republican" , "red", ifelse(V(cnet3)$party=="Democratic", "blue","green"))

plot(cnet3,
     vertex.label=ifelse(V(cnet3)$party=="Republican",NA,V(cnet2)),
     vertex.size=V(cnet3)$degree,
     main="Politicians - Rank >250")

legend("bottomright", c("Democratic","Republican"), pch=25,
       col="#777777", pt.bg=c("blue","red"), title="Party",pt.cex=2, cex=.8)

- Accordign to the graph above, it indicates a totoally opposite pattern - From the plots we can tell that most of the higher ranking politicians are Repunlican and most of the lower-ranking politicians are Democratic - Since we have the pattern now, I’d like to see the network between extremely high and low politicians

cnet_H <- cnet - V(cnet)[which(V(cnet)$rank_from_high < 400)]
gsize(cnet_H)

## [1] 81

htmlTable(cro(V(cnet_H)$rank_from_high ,V(cnet_H)$party))

	V(cnet_H)$party
	Republican
V(cnet_H)$rank_from_high
401	1
402	2
404	1
405	1
407	2
409	1
410	2
412	2
414	1
415	2
417	1
418	1
419	1
420	2
422	1
423	2
425	2
427	1
428	2
430	1
431	1
433	1
434	1
#Total cases	32

set.seed(444)
V(cnet_H)$color<-ifelse(V(cnet_H)$party=="Republican" , "red", ifelse(V(cnet_H)$party=="Democratic", "blue","green"))
par(mar=c(1,2,1,2))
plot(cnet_H,
     vertex.label=ifelse(V(cnet_H)$party=="Republican",NA,V(cnet2)),
     vertex.size=V(cnet_H)$degree,
     main="Politicians - Rank >400")

legend("bottomright", c("Democratic","Republican"), pch=25,
       col="#777777", pt.bg=c("blue","red"), title="Party",pt.cex=2, cex=.8)

- Number of rank higher than 400: 81; Number of rank lower than 2: 96

cnet_L <- cnet - V(cnet)[which(V(cnet)$rank_from_high > 2)]
gsize(cnet_L)

## [1] 96

#htmlTable(cro(V(cnet_H)$rank_from_high ,V(cnet_L)$party))
set.seed(444)
V(cnet_L)$color<-ifelse(V(cnet_L)$party=="Republican" , "red", ifelse(V(cnet_L)$party=="Democratic", "blue","green"))

plot(cnet_L,
     vertex.label=ifelse(V(cnet_L)$party=="Republican",NA,V(cnet2)),
     vertex.size=V(cnet_L)$degree,
     main="Politicians - Rank <10")

legend("bottomright", c("Democratic","Republican"), pch=25,
       col="#777777", pt.bg=c("blue","red"), title="Party",pt.cex=2, cex=.8)

- Next, I’d like to know, between high ranking politicians and low ranking poloticiant, do they care about different issues?

library(igraph)
ceb1 <- cluster_edge_betweenness(cnet_H) 
dendPlot(ceb1, mode="hclust")

ceb2 <- cluster_edge_betweenness(cnet_L) 
dendPlot(ceb2, mode="hclust")