SSNA Deliverables 1-6
Sumaya Malas
2024-12-20
Deliverable 1: Data Formats and Transformations I (one-mode)
For the co-authorship dataset that I downloaded from Scopus, the topic I chose was Authoritarian Politics and the time frame was from 1968-2024 which I did not limit. I used all the inclusion criteria that we mentioned in class including it being a journal article in the social sciences, and I specified that it is in the US and the UK as well as the language as English.
a. The topic you selected (with a description of why you are interested in such a topic)
I chose authoritarian politics because that is the primary topic of my dissertation project. I initially used authoritarianism as the key word, however, many of the articles were not within political science, rather covered authoritarian practices in other subjects like marine biology. I am interested in authoritarianism in political science because of the nature of authoritarian regimes and the importance of their research in order to address governance structures that are repressive to people and have negative social development outcomes for citizens. Additionally, as an Arab-American I have had an interest in this topic especially since many countries in the Middle East are authoritarian. Moreover, the Arab Spring was a salient memory for me as a young adult as a popular movement swept across the region to depose violent dictators.
As a future academic, I am also interested in the co-authorship network of scholars writing on authoritarianism for my own professional development. This includes important scholars that have contributed to the literature that I would like to know about and keep in mind.
The key words I used were “authoritarian” and “politics”, the key word limits I included were “Authoritarianism” and “Middle East”. I also limited the subject to the social sciences. My time frame was from 1968-2024 inlucding the document type of articles and the language as English particularly published in the countries of the US and the UK. In addition, I specified the source type to be a journal.
b. The time span (illustrate why you selected this time span)
I chose to not limit the time span because there were fundamental papers written on authoritarianism in political science since the end of World War II. I wanted to include these co-authorship networks because often PhD students will write with their famous advisors and so on.
c. Type of publication (journal article, conference papers, book chapters or all types) mentioning also why you selected this topic.
I selected journal articles because I believe it is representative of mainstream political science. At least that is what adviors tell PhD students to prioritize for their future professional career prospects. I thought it would be interesting to explore these relationships.
Create a co-authorship network wherein all relationships among coauthors are established.
#clean data, prepare author names that match ID, get one-mode matrix g and two-mode matrix g2
library(splitstackshape)
library(igraph)##
## Attaching package: 'igraph'## The following objects are masked from 'package:stats':
##
## decompose, spectrum## The following object is masked from 'package:base':
##
## union## [1] 394 25# clean the data, keep only authors where ID is included
source <- source[source$Author.s..ID!="[No author id available]",]
#--> we see that all rows are kept, so all authors had an ID
#Let's take out only the column with author relationships:
authors<-as.data.frame(source[,1]) #take first column, all rows
colnames(authors)<-"Authors" #same column name as original data set
#Since next step is to separate all names, we need to consider how they are separated in papers with multiple co-authors, also need to account for different name suffixes:
#Addressing names and titles
authors$Authors <- gsub(" Jr.,", "",
gsub(" II.,", "",
gsub(" Jr.", "",
gsub(" M.S.", "",
gsub(" M.S.,", "",
gsub(" II.", "", authors[,1]))))))
#authors$Authors <- gsub("\\.,", ";",authors$Authors) #-> not needed because data set already formatted with ; between each name
#Lower case all the text to avoid the same author being recognized two in case of accidental lack of capitalized letters in one instance of their name.
authors$Authors <- tolower(authors$Authors)
a1<-cSplit(authors, splitCols = "Authors", sep = ";", direction = "wide", drop = FALSE) #retain the matrix form version of the adjacency list input
#Here we just drop the original first column, which is where the complete list of coauthors for each paper is held
a1<-a1[,-1]
#read it as a matrix
mat <- as.matrix(a1)
a1<-mat
edgelist1<-matrix(NA, 1, 2)#empty matrix two columns
for (i in 1:(ncol(a1)-1)) {
edgelist11 <- cbind(a1[, i], c(a1[, -c(1:i)]))
edgelist1 <- rbind(edgelist1,edgelist11)
edgelist1<-edgelist1[!is.na(edgelist1[,2]),]
#handles where it's not considered empty but it's missing
edgelist1<-edgelist1[edgelist1[,2]!="",]
}
#dim(edgelist1)
# install.packages("igraph")
library(igraph)
plot(graph.edgelist(edgelist1))
g<- graph.edgelist(edgelist1, directed = FALSE)
#weight exists in igraph (it's a hidden attribute)
E(g)$weight <- 1 #must step
#simplify command "collapses" it -- i.e. it takes the long list of relationships where A - B can be listed multiple times, so that it only has A - B once but the weight is the sum of how many times A - B showed up
g.c <- simplify(g)
#E(g.c)$weight
links<-as.data.frame(cbind(as_edgelist(g.c), E(g.c)$weight))
#links
#dim(links)
links$V3<-as.numeric(links$V3)
links<- links[order(links$V3, decreasing=T),]
#table(links[,1])Module 2: using IDs
# Creating adjacency list from names
a1<-cSplit(authors, splitCols = "Authors", sep = ";", direction = "wide", drop = FALSE)
a1<-a1[,-1]
#Adjacency list from authors' IDs, that is, split the authorsID column
df_authors_id <- as.data.frame(source[ , 3])
colnames(df_authors_id) <- "AU"
author_id_split <- cSplit(df_authors_id, splitCols = "AU", sep = ";", direction = "wide", drop = TRUE)
dim(author_id_split) ## [1] 394 9## [1] 394 91. With your own words, explain what problems we aimed to solve with the creation of an ID adjacency list and a names adjacency list?
It is better to use the author’s ID number to avoid any inaccuracies if an authors’ names is misspelled or changed over time. This allows us to be more precise when referencing authors through their ID.
2. During your cleaning procedures, did your adjacency lists for names and ID have the same dimensions?
- If so, what is the meaning of these dimensions?
My adjacency lists did have the same dimensions which was 394 by 9. This means that I have 394 articles and at least one article has 9 co-authors.
- Let us assume that you did not have the same dimensions, what would be the reason for this discrepancy and how would you address this issue?
This discrepancy would be due to the dataset containing authors’ names without ID’s or ID’s without associated names. I would address this by looking at the articles where there are not an equal number of author name / ID columns that are filled in (not NA) and assess what is the issue with those that do not match.
#unlisting the values of the adjacency matrices
df_authorid_authorname_unlisted <- data.frame(id = unlist(author_id_split), names = unlist(a1))
dim(df_authorid_authorname_unlisted)## [1] 3546 2#gets rid of where the id is missing
df_authorid_authorname_unlisted <- df_authorid_authorname_unlisted[!is.na(df_authorid_authorname_unlisted$id),]
dim(df_authorid_authorname_unlisted)## [1] 590 2#gets rid of duplicates
df_authorid_authorname_unlisted <- df_authorid_authorname_unlisted[!duplicated(df_authorid_authorname_unlisted$id),]
dim(df_authorid_authorname_unlisted)## [1] 539 2## id names
## AU_11 58453712500 raunet n.
## AU_12 57719903200 kao j.c.
## AU_13 13105580800 malka a.
## AU_14 56426390400 ilbiz e.
## AU_15 26530837600 bonikowski b.
## AU_16 35606207700 hill t.d.3.As part of the feature engineering procedures, we created a database with ID and Name columns.
- What is the meaning of the number of rows of this database?
In this dataset, the number of rows is the number of unique individual authors we have which is 539.
- Does this number match the number of unique actors you have in your first deliverable in the object g (i.e., the graph we created)?
No it does not, there were 304 unique actors in the first deliverable, whereas now there is 539.
- If the number does not match, what do you think is the reason for this mismatch?
In the first deliverable we were focusing on co-authorship pairs, therefore we have a larger number of individual authors once we clean up the data to account for authors outside of co-authorship articles (such as those in more or less than a pair including solo authors).
4. Please explain the role of unlisting in this data cleaning or feature engineering process.
The unlisting process takes multiple names or IDs stored across separate columns and combines them into a single column for all author names and another single column for all author IDs. This approach works effectively because the articles in each matrix are arranged in the same order. As we unlist and stack the names and IDs, it automatically pairs each name with its corresponding ID. For instance, if the first row (representing an article) contains two authors, unlisting will place author ID 1 in the first row of column 1 and author ID 2 in the second row of column 1, while author name 1 will appear in the first row of column 2 and author name 2 in the second row of column 2. This ensures that author name 1 matches author ID 1, and author name 2 matches author ID 2. Subsequently, we remove any NA or missing values and eliminate duplicates, leaving a unique list of authors where each appears only once. Note how the dimensions of the dataset shrink when duplicates are removed (not due to NA values, as there were none in this case).
Module 3: Data Formats and Transformations I (two-mode)
Create a publication network wherein all relationships link (co-)authors with their respective publication.
library(splitstackshape)
# clean the data, keep only authors and articles
source <- source[source$Author.s..ID!="[No author id available]",]
### create a author-author matrix through transformation of a two-mode edgelist#
authors <- as.data.frame(source[,3])
colnames(authors) <- "AU"
source_split <- cSplit(authors, splitCols = "AU", sep = ";", direction = "wide", drop = TRUE)
#dim(source_split)
mat_source_split <- as.matrix(source_split)
combined <- cbind(source$EID, mat_source_split)
mat_combined_eid_source_split <- as.matrix(combined)
edgelist_two_mode <- cbind(mat_combined_eid_source_split[, 1], c(mat_combined_eid_source_split[, -1]))
edgelist_two_mode <- edgelist_two_mode[!is.na(edgelist_two_mode[,2]), ]
head(edgelist_two_mode)## [,1] [,2]
## [1,] "2-s2.0-85163977034" "58453712500"
## [2,] "2-s2.0-85131051316" "57719903200"
## [3,] "2-s2.0-85148345416" "13105580800"
## [4,] "2-s2.0-85170671951" "56426390400"
## [5,] "2-s2.0-85135919459" "26530837600"
## [6,] "2-s2.0-85147114362" "35606207700"#2:1 makes it so article linked to author
g2 <- graph.edgelist(edgelist_two_mode[, 2:1], directed = TRUE)
g2## IGRAPH fb1ca39 DN-- 933 590 --
## + attr: name (v/c)
## + edges from fb1ca39 (vertex names):
## [1] 58453712500->2-s2.0-85163977034 57719903200->2-s2.0-85131051316
## [3] 13105580800->2-s2.0-85148345416 56426390400->2-s2.0-85170671951
## [5] 26530837600->2-s2.0-85135919459 35606207700->2-s2.0-85147114362
## [7] 58284340700->2-s2.0-85162097124 55119860600->2-s2.0-85203134624
## [9] 57211436935->2-s2.0-85210588039 55147961100->2-s2.0-85209368766
## [11] 57211800415->2-s2.0-85181248177 58002972900->2-s2.0-85182984708
## [13] 55566495100->2-s2.0-85177067223 57191258940->2-s2.0-85146344926
## [15] 36599335300->2-s2.0-85130209439 57207914025->2-s2.0-85130443222
## + ... omitted several edges#933 is total number
#590 is number of connections
#articles, authors
#igraph will assume its a one mode network unless there is a type attribute
#true if name does exist at vertex level in the human column of edge list
V(g2)$type <- V(g2)$name %in% edgelist_two_mode[ , 2]
#V(g2)$name is the column called name at the vertex level
#true means human, false means article
table(V(g2)$type)##
## FALSE TRUE
## 394 539#we have 539 authors and 394 articles
#i<-table(V(g2)$type)[2]
#Transformations to retain actors, move from graph to matrix
mat_g2_incidence <- t(get.incidence(g2))
mat_g2_incidence_to_1 <- mat_g2_incidence%*%t(mat_g2_incidence)
summary(diag(mat_g2_incidence_to_1))## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 1.000 1.000 1.095 1.000 5.000diag(mat_g2_incidence_to_1)<-0 #set like this if looking at peer effects or spill overs, like no one is influence by theirselves
#also need to do it for visualization purposes
g <- graph.adjacency(mat_g2_incidence_to_1, mode = "undirected")
plot(g)
##
## FALSE TRUE
## 394 539After this, describe the network by answering: ## 1. How many authors are represented? 539 authors ## 2. How many publications are represented in this network? 394 articles
3. And how many connections were established?
## [1] 590 2There are 590 connections established.
6. How are points 4 and 5 similar or different? In what ways?
In question 4, we are assessing which authors are the most prolific, i.e. which individual authors publish the most articles. Whereas in question 5, we are assessing which article has the most authors on it, i.e. the most prolific article. Therefore, these questions are assessing two different elements within this co-authorship network.
7. If the number of human actors is different in this deliverable and deliverable 1, what is the cause?
The number of human actors is different because we are working off of a two mode versus a one mode network, therefore the number of authors are different because they either correspond to other authors or to articles.
Module 4:
Below are the replications for both a one-mode and a two-mode network visualization. For my dataset, I have 180 solo authored papers so I plan to plot the co-author relationships by linking authors to papers and then transforming this to a one-mode network in order to retain solo authors in my dataset. Because of how important solo authors are to the integrity of my co-authorship network, I am choosing to start with the two-mode form and then getting the co-authors via network transformation.
We should care about attributes because it is important for the description of the network including publication count, citation count, and most importantly, centrality measures. We should also care about solo authors because they can have high citation and publication counts which are important to consider within a co-authorship network in order to understand whether prolific authors exist as solo authors or within co-authorship articles.
a<-read.csv("scopus.csv")
#Keeping only column with author relationships
authors<-as.data.frame(a[,1])#"Author.s..ID"])
colnames(authors)<-"AU"
#package for first split
library(splitstackshape)
library(stringr)
library(igraph)
authors$AU <- str_remove_all(authors$AU, "[^[\\a-zA-Z ]]")
#As can be seen in the file the separator of interest is :
a1<-cSplit(authors, splitCols = "AU", sep = ";", direction = "wide", drop = TRUE) #retain the matrix form version of the adjacency list input## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE
## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE
## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE
## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE
## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE
## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE
## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE
## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE
## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE## [1] "data.table" "data.frame"#read it as a matrix
mat <- as.matrix(a1)
# mat
dim(mat)# the resulting column dimension is the number of times you will have to repeat the following procedure minus 1## [1] 394 9mat <- cbind(a$EID, mat)
edgelist1<-matrix(NA, 1, 2)#empty matrix two columns
# for (i in 1:(ncol(mat)-1)) {
for (i in 1:1) {
edgelist11 <- cbind(mat[, i], c(mat[, -c(1:i)]))
edgelist1 <- rbind(edgelist1,edgelist11)
edgelist1<-edgelist1[!is.na(edgelist1[,2]),]
edgelist1<-edgelist1[edgelist1[,2]!="",]
}
dim(edgelist1)## [1] 590 2## Warning: `graph.data.frame()` was deprecated in igraph 2.0.0.
## ℹ Please use `graph_from_data_frame()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.##
## FALSE TRUE
## 394 540i<-table(V(g)$type)[2]
#Transformations to retain actors
mat_g2_incidence <- t(get.incidence(g))
dta <- data.frame(id=rownames(mat_g2_incidence), count=rowSums(mat_g2_incidence))
dta <- dta[order(dta$count, decreasing=T), ]
mat_g2_incidence_to_1 <- mat_g2_incidence%*%t(mat_g2_incidence)
diag(mat_g2_incidence_to_1)<-0
g<-graph.adjacency(mat_g2_incidence_to_1, mode="undirected")
E(g)$weight <- 1 #must step
g.c <- simplify(g)
# E(g.c)$weight
#centrality measures
cent<-data.frame(ID=V(g.c)$name, ev=evcent(g.c)$vector, deg=degree(g.c)/max(degree(g.c)), bet=betweenness(g.c, normalized=F)/max(betweenness(g.c, normalized=F)), clo=closeness(g.c)/max(closeness(g.c)[!is.na(closeness(g.c))])) ## Warning: `evcent()` was deprecated in igraph 2.0.0.
## ℹ Please use `eigen_centrality()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## ID ev deg bet clo
## Raunet N. Raunet N. 0.000000e+00 0.000 0 NaN
## Kao J.C. Kao J.C. 7.793186e-18 0.250 0 0.5
## Malka A. Malka A. 0.000000e+00 0.125 0 1.0
## Ilbiz E. Ilbiz E. 0.000000e+00 0.125 0 1.0
## Bonikowski B. Bonikowski B. 0.000000e+00 0.125 0 1.0
## Hill T.D. Hill T.D. 0.000000e+00 0.625 0 0.2cent$max_cent <- cent$ev + cent$deg + cent$bet + cent$clo
cent<- cent[order(cent$max_cent, decreasing=T),]
head(cent)## ID ev deg bet clo max_cent
## Sullivan S. Sullivan S. 1 1 0 0.125 2.125
## Benjaminsen T.A. Benjaminsen T.A. 1 1 0 0.125 2.125
## Harcourt W. Harcourt W. 1 1 0 0.125 2.125
## Childs J. Childs J. 1 1 0 0.125 2.125
## Cavanagh C.J. Cavanagh C.J. 1 1 0 0.125 2.125
## Batterbury S. Batterbury S. 1 1 0 0.125 2.125library(networkD3)
V(g.c)$label <- V(g.c)$name
V(g.c)$name<-1:length(V(g.c)) #(1:length(V(g)))-1
links<-as.data.frame(cbind(get.edgelist(g.c),as.numeric(E(g.c)$weight)))## Warning: `get.edgelist()` was deprecated in igraph 2.0.0.
## ℹ Please use `as_edgelist()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.links$V1<-as.numeric(as.character(links$V1))
links$V2<-as.numeric(as.character(links$V2))
str(links)## 'data.frame': 297 obs. of 3 variables:
## $ V1: num 2 2 3 4 5 6 6 6 6 6 ...
## $ V2: num 373 488 374 375 376 377 489 520 530 535 ...
## $ V3: num 1 1 1 1 1 1 1 1 1 1 ...links<-cbind(links[,1:2]-1, links[,3])
colnames(links)<-c("source","target", "value")
#Get pub count matching names
#most Prolific authors by name
V(g.c)$pub_count <- dta$count[match(V(g.c)$label, dta$id)]
V(g.c)$label <- paste("Name: ", V(g.c)$label, ", Pub. count = ", V(g.c)$pub_count, ", Degree = ", degree(g.c), ", Max Centrality (max = 4) = ", round(cent$max_cent[match(V(g.c)$label, cent$ID)], 3) , sep="")
head(V(g.c)$label)## [1] "Name: Raunet N., Pub. count = 1, Degree = 0, Max Centrality (max = 4) = NaN"
## [2] "Name: Kao J.C., Pub. count = 1, Degree = 2, Max Centrality (max = 4) = 0.75"
## [3] "Name: Malka A., Pub. count = 1, Degree = 1, Max Centrality (max = 4) = 1.125"
## [4] "Name: Ilbiz E., Pub. count = 1, Degree = 1, Max Centrality (max = 4) = 1.125"
## [5] "Name: Bonikowski B., Pub. count = 1, Degree = 1, Max Centrality (max = 4) = 1.125"
## [6] "Name: Hill T.D., Pub. count = 1, Degree = 5, Max Centrality (max = 4) = 0.825"nodes <- data.frame(name=V(g.c)$label, group = V(g.c)$pub_count, size=round(betweenness(g.c,directed=F,normalized=T)/max(betweenness(g.c,directed=F,normalized=T))*115, 3)) #so size isn't tiny
netviz <- forceNetwork(Links = links, Nodes = nodes,
Source = 'source', Target = 'target',
NodeID = 'name',
Group = 'group', # color nodes by group calculated earlier
charge = -5, # node repulsion
linkDistance = 20,
opacity = 1,
Value = 'value',
Nodesize = 'size', # color nodes by group calculated earlier
zoom = T,
legend= TRUE,
fontSize=24,
colourScale = JS("d3.scaleOrdinal(d3.schemeCategory20)"))## Warning: It looks like Source/Target is not zero-indexed. This is required in
## JavaScript and so your plot may not render.##
## Attaching package: 'htmlwidgets'## The following object is masked from 'package:networkD3':
##
## JSlibrary(htmltools)
HTMLaddons <-
"function(el, x) {
d3.select('body').style('background-color', ' #C0C0C0')
d3.selectAll('.legend text').style('fill', 'black')
d3.selectAll('.link').append('svg:title')
.text(function(d) { return 'Intensity: ' + d.value ; })
var options = x.options;
var svg = d3.select(el).select('svg')
var node = svg.selectAll('.node');
var link = svg.selectAll('link');
var mouseout = d3.selectAll('.node').on('mouseout');
function nodeSize(d) {
if (options.nodesize) {
return eval(options.radiusCalculation);
} else {
return 6;
}
}
d3.selectAll('.node').on('click', onclick)
function onclick(d) {
if (d3.select(this).on('mouseout') == mouseout) {
d3.select(this).on('mouseout', mouseout_clicked);
} else {
d3.select(this).on('mouseout', mouseout);
}
}
function mouseout_clicked(d) {
node.style('opacity', +options.opacity);
link.style('opacity', +options.opacity);
d3.select(this).select('circle').transition()
.duration(750)
.attr('r', function(d){return nodeSize(d);});
d3.select(this).select('text').transition()
.duration(1250)
.attr('x', 0)
.style('font', options.fontSize + 'px ');
}
}
"
netviz$x$links$linkDistance <- (1/links$value)*125
onRender(netviz, HTMLaddons) # ChatGPT co-authorship network
# Since December 2022, there has been 897 academic articles published on the topic ChatGPT. These articles have been co-authored by 2,118 academics, representing 8,173 collaborations.
# This network highlights the most influential authors as a function of connecting different articles together (i.e., betweenness centrality). Access to the original data available at https://cutt.ly/rwaClF9g.
# ChatGPT_co-authorship_network Replication for a two-mode network
#Keeping only column with author relationships
authors<-as.data.frame(a[,1])#"Author.s..ID"])
colnames(authors)<-"AU"
#package for first split
authors$AU <- str_remove_all(authors$AU, "[^[\\a-zA-Z ]]")
#As can be seen in the file the separator of interest is :
a1<-cSplit(authors, splitCols = "AU", sep = ";", direction = "wide", drop = TRUE) #retain the matrix form version of the adjacency list input
# fix(a1)
class(a1)## [1] "data.table" "data.frame"#read it as a matrix
mat <- as.matrix(a1)
# mat
dim(mat)# the resulting column dimension is the number of times you will have to repeat the following procedure minus 1## [1] 394 9mat <- cbind(a$EID, mat)
edgelist1<-matrix(NA, 1, 2)#empty matrix two columns
# for (i in 1:(ncol(mat)-1)) {
for (i in 1:1) {
edgelist11 <- cbind(mat[, i], c(mat[, -c(1:i)]))
edgelist1 <- rbind(edgelist1,edgelist11)
edgelist1<-edgelist1[!is.na(edgelist1[,2]),]
edgelist1<-edgelist1[edgelist1[,2]!="",]
}
dim(edgelist1)## [1] 590 2g<- graph.data.frame(edgelist1[, 2:1], directed = FALSE)
V(g)$type <- V(g)$name %in% edgelist1[ , 2]
table(V(g)$type)##
## FALSE TRUE
## 394 540i<-table(V(g)$type)[2]
V(g)$label<-V(g)$name
#Transformations to count number of publications
mat_g2_incidence <- t(get.incidence(g))
dta <- data.frame(id=rownames(mat_g2_incidence), count=rowSums(mat_g2_incidence))
dta <- dta[order(dta$count, decreasing=T), ]
# Centrality key actors
cent<-data.frame(bet=betweenness(g, normalized=T, directed = FALSE)/max(betweenness(g, normalized=T, directed = FALSE)),eig=evcent(g)$vector, degree=degree(g, mode="total")/max(degree(g, mode="total")))
cent$index <- rowSums(cent)
cent$name<-rownames(cent) #Ids in this case
head(cent);tail(cent)## bet eig degree index name
## Raunet N. 0 2.778781e-18 0.1111111 0.1111111 Raunet N.
## Kao J.C. 0 4.358448e-17 0.1111111 0.1111111 Kao J.C.
## Malka A. 0 1.832187e-17 0.1111111 0.1111111 Malka A.
## Ilbiz E. 0 2.884677e-17 0.1111111 0.1111111 Ilbiz E.
## Bonikowski B. 0 2.431741e-17 0.1111111 0.1111111 Bonikowski B.
## Hill T.D. 0 0.000000e+00 0.1111111 0.1111111 Hill T.D.## bet eig degree index
## 2-s2.0-85047689709 0.00000000 9.053066e-18 0.1111111 0.1111111
## 2-s2.0-79957609966 0.02061856 9.820749e-19 0.2222222 0.2428408
## 2-s2.0-56849086752 0.00000000 6.663173e-19 0.1111111 0.1111111
## 2-s2.0-80054721606 0.00000000 3.183169e-18 0.1111111 0.1111111
## 2-s2.0-0036337175 0.00000000 4.839807e-18 0.1111111 0.1111111
## 2-s2.0-42149150619 0.00000000 0.000000e+00 0.1111111 0.1111111
## name
## 2-s2.0-85047689709 2-s2.0-85047689709
## 2-s2.0-79957609966 2-s2.0-79957609966
## 2-s2.0-56849086752 2-s2.0-56849086752
## 2-s2.0-80054721606 2-s2.0-80054721606
## 2-s2.0-0036337175 2-s2.0-0036337175
## 2-s2.0-42149150619 2-s2.0-42149150619###
cent$bet[1:i]<-(cent$bet[1:i]/max(cent$bet[1:i]))#*10
cent$eig[1:i]<-cent$eig[1:i]/max(cent$eig[1:i])
cent$index[1:i]<-cent$index[1:i]/max(cent$index[1:i])*5
summary(cent[1:i,])## bet eig degree index
## Min. :0.000000 Min. :0.00000 Min. :0.1111 Min. :0.3571
## 1st Qu.:0.000000 1st Qu.:0.00000 1st Qu.:0.1111 1st Qu.:0.3571
## Median :0.000000 Median :0.00000 Median :0.1111 Median :0.3571
## Mean :0.009164 Mean :0.01667 Mean :0.1214 Mean :0.4375
## 3rd Qu.:0.000000 3rd Qu.:0.00000 3rd Qu.:0.1111 3rd Qu.:0.3571
## Max. :1.000000 Max. :1.00000 Max. :0.5556 Max. :5.0000
## name
## Length:540
## Class :character
## Mode :character
##
##
## cent$bet[(i+1):nrow(cent)]<-cent$bet[(i+1):nrow(cent)]/max(cent$bet[(i+1):nrow(cent)])#*20
cent$eig[(i+1):nrow(cent)]<-cent$eig[(i+1):nrow(cent)]/max(cent$eig[(i+1):nrow(cent)])
cent$index[(i+1):nrow(cent)]<-cent$index[(i+1):nrow(cent)]/max(cent$index[(i+1):nrow(cent)])*10
summary(cent[(i+1):nrow(cent),])## bet eig degree index
## Min. :0.00000 Min. :0.000000 Min. :0.1111 Min. : 0.4052
## 1st Qu.:0.00000 1st Qu.:0.000000 1st Qu.:0.1111 1st Qu.: 0.4052
## Median :0.00000 Median :0.000000 Median :0.1111 Median : 0.4052
## Mean :0.03645 Mean :0.002538 Mean :0.1664 Mean : 0.7147
## 3rd Qu.:0.02778 3rd Qu.:0.000000 3rd Qu.:0.2222 3rd Qu.: 0.8855
## Max. :1.00000 Max. :1.000000 Max. :1.0000 Max. :10.0000
## name
## Length:394
## Class :character
## Mode :character
##
##
## ## bet eig degree index name
## Raunet N. 0 8.336343e-18 0.1111111 0.3571429 Raunet N.
## Kao J.C. 0 1.307534e-16 0.1111111 0.3571429 Kao J.C.
## Malka A. 0 5.496561e-17 0.1111111 0.3571429 Malka A.
## Ilbiz E. 0 8.654031e-17 0.1111111 0.3571429 Ilbiz E.
## Bonikowski B. 0 7.295222e-17 0.1111111 0.3571429 Bonikowski B.
## Hill T.D. 0 0.000000e+00 0.1111111 0.3571429 Hill T.D.cent$max_cent <- NA
cent$max_cent[1:i] <- cent$eig[1:i] + cent$degree[1:i] + cent$bet[1:i]
cent$max_cent[(i+1):nrow(cent)] <- cent$eig[(i+1):nrow(cent)] + cent$degree[(i+1):nrow(cent)] + cent$bet[(i+1):nrow(cent)]
cent<- cent[order(cent$max_cent, decreasing=T),]
head(cent)## bet eig degree index name
## 2-s2.0-85061318839 1.0000000 1 1.0000000 10.000000 2-s2.0-85061318839
## Ross C. 1.0000000 0 0.5555556 5.000000 Ross C.
## 2-s2.0-85021157342 0.6944444 0 0.6666667 4.310777 2-s2.0-85021157342
## 2-s2.0-85138541839 0.9722222 0 0.3333333 3.847118 2-s2.0-85138541839
## 2-s2.0-85060847939 0.7222222 0 0.5555556 3.980785 2-s2.0-85060847939
## Batterbury S. 0.0000000 1 0.1111111 1.428571 Batterbury S.
## max_cent
## 2-s2.0-85061318839 3.000000
## Ross C. 1.555556
## 2-s2.0-85021157342 1.361111
## 2-s2.0-85138541839 1.305556
## 2-s2.0-85060847939 1.277778
## Batterbury S. 1.111111# Units or elements
V(g)$pub_citat_count <- c(dta$count[match(V(g)$label[1:i], dta$id)], a$Cited.by[match(V(g)$label[(i+1):length(V(g)$name)], a$EID)])
V(g)$label <- c(paste("Name: ", V(g)$label[1:i], ", Pub. count = ", V(g)$pub_citat_count[1:i], ", Degree = ", degree(g)[1:i], ", Max Centrality (max = 3) = ", round(cent$max_cent[match(V(g)$label[1:i], cent$name)], 3) , sep=""),
paste("EID: ", V(g)$label[(i+1):length(V(g)$name)], ", Citation count = ", V(g)$pub_citat_count[(i+1):length(V(g)$name)], ", Degree = ", degree(g)[(i+1):length(V(g)$name)], ", Max Centrality (max = 3) = ", round(cent$max_cent[match(V(g)$label[(i+1):length(V(g)$name)], cent$name)], 3) , sep=""))
head(V(g)$label)## [1] "Name: Raunet N., Pub. count = 1, Degree = 1, Max Centrality (max = 3) = 0.111"
## [2] "Name: Kao J.C., Pub. count = 1, Degree = 1, Max Centrality (max = 3) = 0.111"
## [3] "Name: Malka A., Pub. count = 1, Degree = 1, Max Centrality (max = 3) = 0.111"
## [4] "Name: Ilbiz E., Pub. count = 1, Degree = 1, Max Centrality (max = 3) = 0.111"
## [5] "Name: Bonikowski B., Pub. count = 1, Degree = 1, Max Centrality (max = 3) = 0.111"
## [6] "Name: Hill T.D., Pub. count = 1, Degree = 1, Max Centrality (max = 3) = 0.111"## [1] "EID: 2-s2.0-85047689709, Citation count = 5, Degree = 1, Max Centrality (max = 3) = 0.111"
## [2] "EID: 2-s2.0-79957609966, Citation count = 7, Degree = 2, Max Centrality (max = 3) = 0.25"
## [3] "EID: 2-s2.0-56849086752, Citation count = 24, Degree = 1, Max Centrality (max = 3) = 0.111"
## [4] "EID: 2-s2.0-80054721606, Citation count = 11, Degree = 1, Max Centrality (max = 3) = 0.111"
## [5] "EID: 2-s2.0-0036337175, Citation count = 7, Degree = 1, Max Centrality (max = 3) = 0.111"
## [6] "EID: 2-s2.0-42149150619, Citation count = 49, Degree = 1, Max Centrality (max = 3) = 0.111"#Gets edgelist from graph, also any other attribute at the edge level to be included in the mapping
links_p<-as.data.frame(cbind(get.edgelist(g))) #To get a place_holder transformation
#Adding other attributes
links_p$V3<-as.numeric(a$Cited.by)[match(links_p$V2, a$EID)]
links_p$V4<-a$Title[match(links_p$V2, a$EID)]
# Making edgelist for interactive visualization
V(g)$name<-1:length(V(g))-1
links<-as.data.frame(cbind(get.edgelist(g))) #PHUDCFILY
links$V1<-as.numeric(as.character(links$V1))
links$V2<-as.numeric(as.character(links$V2))
links$V3 <- links_p$V3
links$V4 <- links_p$V4
str(links)## 'data.frame': 590 obs. of 4 variables:
## $ V1: num 0 1 2 3 4 5 6 7 8 9 ...
## $ V2: num 540 541 542 543 544 545 546 547 548 549 ...
## $ V3: num 0 2 5 2 8 7 0 0 0 0 ...
## $ V4: chr "Transnational Strategies of Legitimation in the 1990s: The Togolese Regime and its Exiled Opposition in Ghana" "Minority Language Recognition and Political Trust in Authoritarian Regimes" "Professed Democracy Support and Openness to Politically Congenial Authoritarian Actions Within the American Public" "Securitization, fear politics, and the formation of an opposition alliance in competitive authoritarian regimes" ...## V1 V2 V3
## 1 0 540 0
## 2 1 541 2
## 3 2 542 5
## 4 3 543 2
## 5 4 544 8
## 6 5 545 7
## V4
## 1 Transnational Strategies of Legitimation in the 1990s: The Togolese Regime and its Exiled Opposition in Ghana
## 2 Minority Language Recognition and Political Trust in Authoritarian Regimes
## 3 Professed Democracy Support and Openness to Politically Congenial Authoritarian Actions Within the American Public
## 4 Securitization, fear politics, and the formation of an opposition alliance in competitive authoritarian regimes
## 5 Reclaiming the Past to Transcend the Present: Nostalgic Appeals in U.S. Presidential Elections
## 6 Political ideology and pandemic lifestyles: the indirect effects of empathy, authoritarianism, and threatcolnames(links)<-c("source","target", "citation", "title") #value is students' performance of the course
nodes <- data.frame(name= V(g)$label, pubs_citation = V(g)$pub_citat_count, groups = ifelse(V(g)$type==1, "Author", "Article"))
head(nodes)## name
## 1 Name: Raunet N., Pub. count = 1, Degree = 1, Max Centrality (max = 3) = 0.111
## 2 Name: Kao J.C., Pub. count = 1, Degree = 1, Max Centrality (max = 3) = 0.111
## 3 Name: Malka A., Pub. count = 1, Degree = 1, Max Centrality (max = 3) = 0.111
## 4 Name: Ilbiz E., Pub. count = 1, Degree = 1, Max Centrality (max = 3) = 0.111
## 5 Name: Bonikowski B., Pub. count = 1, Degree = 1, Max Centrality (max = 3) = 0.111
## 6 Name: Hill T.D., Pub. count = 1, Degree = 1, Max Centrality (max = 3) = 0.111
## pubs_citation groups
## 1 1 Author
## 2 1 Author
## 3 1 Author
## 4 1 Author
## 5 1 Author
## 6 1 Author{
nodes$group<-NA
nodes$group <-cut(nodes$pubs_citation, c(0,1,3,10,20,max(nodes$pubs_citation)), right=TRUE, include.lowest = FALSE)
table(is.na(nodes$group))
table(nodes$group)
head(nodes[is.na(nodes$group),],20)
nodes$group<-ifelse(is.na(nodes$group), "No Citation", ifelse(nodes$group=="(0,1]", "1 cit/pub", ifelse(nodes$group=="(1,3]", "2 or 3 cit/pub", ifelse(nodes$group=="(3,10]", "4 to 10 cit/pub", ifelse(nodes$group=="(10,20]", "11 to 20 cit/pub", "Over 20 cit/pub")))))
counts<-data.frame(table(nodes$group))
#counts$labels <- paste(counts$Var1, ", N= ", counts$Freq, sep="")
#nodes$groups <- counts$labels[match(nodes$group, counts$Var1)]
#head(nodes)
}
ColourScale <- 'd3.scaleOrdinal()
.domain(["1 cit/pub", "11 to 20 cit/pub", "2 or 3 cit/pub", "4 to 10 cit/pub", "No Citation", "Over 20 cit/pub"])
.range(["#ff3397", "#e5ff33", "#F4BB44", "#B2BEB5", "#EE4B2B", "#FF3131"]);'
netviz<-forceNetwork(Links = links, Nodes = nodes,
Source = 'source', Target = 'target',
NodeID = 'name',
Group = "groups", # color nodes by group calculated earlier
charge = -20, # node repulsion
linkDistance = JS("function(d) { return d.linkDistance; }"),#JS("function(d){return d.value}"),
linkWidth = JS("function(d) { return Math.sqrt(d.citation)*4; }"),
opacity = 0.8,
Value = "citation",
Nodesize = 'pubs_citation',
radiusCalculation = JS("Math.sqrt(d.nodesize*30)+10"),
zoom = T,
fontSize=14,
bounded= F,
legend= TRUE,
colourScale = JS(ColourScale))
HTMLaddons <-
"function(el, x) {
d3.select('body').style('background-color', ' #FFFFFF')
d3.selectAll('.legend text').style('fill', 'black')
d3.selectAll('.link').append('svg:title')
.text(function(d) { return 'Number of citations : ' + d.value + ', Title: ' + d.title ; })
var options = x.options;
var svg = d3.select(el).select('svg')
var node = svg.selectAll('.node');
var link = svg.selectAll('link');
var mouseout = d3.selectAll('.node').on('mouseout');
function nodeSize(d) {
if (options.nodesize) {
return eval(options.radiusCalculation);
} else {
return 6;
}
}
d3.selectAll('.node').on('click', onclick)
function onclick(d) {
if (d3.select(this).on('mouseout') == mouseout) {
d3.select(this).on('mouseout', mouseout_clicked);
} else {
d3.select(this).on('mouseout', mouseout);
}
}
function mouseout_clicked(d) {
node.style('opacity', +options.opacity);
link.style('opacity', +options.opacity);
d3.select(this).select('circle').transition()
.duration(750)
.attr('r', function(d){return nodeSize(d);});
d3.select(this).select('text').transition()
.duration(1250)
.attr('x', 0)
.style('font', options.fontSize + 'px ');
}
}
"
netviz$x$links$value <- links$citation
netviz$x$links$title <- links$title
netviz$x$links$linkDistance <- (links$citation)*50
onRender(netviz, HTMLaddons)Module 5
## Loading required package: spData## To access larger datasets in this package, install the spDataLarge
## package with: `install.packages('spDataLarge',
## repos='https://nowosad.github.io/drat/', type='source')`## Loading required package: Matrix## Loading required package: sf## Linking to GEOS 3.11.0, GDAL 3.5.3, PROJ 9.1.0; sf_use_s2() is TRUE##
## Attaching package: 'spdep'## The following objects are masked from 'package:spatialreg':
##
## get.ClusterOption, get.coresOption, get.mcOption,
## get.VerboseOption, get.ZeroPolicyOption, set.ClusterOption,
## set.coresOption, set.mcOption, set.VerboseOption,
## set.ZeroPolicyOptionlibrary(igraph)
library(classInt)
library(RColorBrewer)
#Friendship
idfriend <- "1dwX4kKlx-ctkU0JyH74p3r1w-jJdTAqi"
friendshiplazega <- read.csv(sprintf("https://docs.google.com/uc?id=%s&export=download", idfriend))
advicelazega <- as.matrix(friendshiplazega)
advicelazegac <- advicelazega
str(advicelazega)## int [1:71, 1:71] 0 0 0 0 0 0 0 0 0 0 ...
## - attr(*, "dimnames")=List of 2
## ..$ : NULL
## ..$ : chr [1:71] "V1" "V2" "V3" "V4" ...## [1] 71 71#Reading attributes also provided by Lazega
idattributes <- "1e0GtrRS5PFFNdnd1e4fJcjeuBZ6deF7g"
datattrout <- read.csv(sprintf("https://docs.google.com/uc?id=%s&export=download", idattributes))
#Transforming the matrices to spatial form (row normalized) as shown in equation (21)
advicelazega <-advicelazega /rowSums(advicelazega)
summary(rowSums(advicelazega))## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 1 1 1 1 1 1 6# Replacing potential NAN to zeros as shown in equation (22)
advicelazega[is.na(advicelazega)]<-0
listwAd<-mat2listw(advicelazega, style = "W", zero.policy = TRUE)## Warning in mat2listw(advicelazega, style = "W", zero.policy = TRUE): neighbour
## object has 3 sub-graphs#########
#Testing influence
#########impacting the outcome of my peer
moran.test(datattrout$HrRATE90,listwAd, zero.policy=TRUE)##
## Moran I test under randomisation
##
## data: datattrout$HrRATE90
## weights: listwAd
## n reduced by no-neighbour observations
##
## Moran I statistic standard deviate = 8.6798, p-value < 2.2e-16
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## 0.520938960 -0.015625000 0.003821452##
## Moran I test under randomisation
##
## data: datattrout$FeesCollec90
## weights: listwAd
## n reduced by no-neighbour observations
##
## Moran I statistic standard deviate = 7.628, p-value = 1.192e-14
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## 0.455321539 -0.015625000 0.003811733Question 1:
Because the Moran’s I statistic is larger for the hourly rate than for the fees collected, we can see there is stronger social dependence for the per hour rate over the fees collected- or in other words, more positive spatial autocorrelation. They are both statistically significant. The difference between the two might be due to the fees collected being a nosier value than the hourly rate. An hourly rate can be determined based on the other individuals present in the firm whereas the fees collected might be more related to the individual attributes rather than the attributes of the network. This indicates that people will associate or have friendships with those who have a similar hourly rate compared to the same fees collected.
Question 2:
Part 1:
##
## FALSE TRUE
## 65 6Part 1: Do you have isolates in the model? Yes, there are 6 isolates in the model. This means that there are 6 people in this community without friends.
#########
#Visualizing Local Moran’s I clusters and outliers
#########
mt <- moran.test(datattrout$FeesCollec90, listwAd, zero.policy=TRUE)
label_x = "Individual Fees Collected"
label_y = "Lagged Individual Fees Collected"
mp <- moran.plot(datattrout$FeesCollec90, listwAd, zero.policy=T,
labels=datattrout$id, xlab = label_x, ylab = label_y)
title(main="Moran’s Plot", cex.main=2, col.main="grey11",
font.main=2, sub=paste("Plot includes 71 lawyers (Moran’s I = ",
round(mt$ estimate[1], 3), ", p < .0001)", sep=""), cex.sub=1.15, col.sub="grey11", font.sub=2,)
# Part 2 and 3: Here I attempted to find the higher order neighbors when
there are still isolates, but the code was not working because I
recieved an error that it is a character and not an integer, and
debugging did not work either.
# 1 is friendship, 0 is no friendship
advicelazega <- as.matrix(friendshiplazega)
advicelazega <- advicelazega%*%t(advicelazega)#increasing relationships by considering friends of friends
diag(advicelazega)<-0
advicelazega[advicelazega>1]<-1
table(rowSums(advicelazega)==0)##
## FALSE TRUE
## 65 6#Transforming the matrices to spatial form (row normalized) as shown in equation (21)
advicelazega <-advicelazega /rowSums(advicelazega)
summary(rowSums(advicelazega))## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 1 1 1 1 1 1 6# Replacing potential NAN to zeros as shown in equation (22)
advicelazega[is.na(advicelazega)]<-0
listwAd<-mat2listw(advicelazega)## Warning in mat2listw(advicelazega): style is M (missing); style should be set
## to a valid value## Warning in mat2listw(advicelazega): no-neighbour observations found, set zero.policy to TRUE;
## this warning will soon become an error## Warning in mat2listw(advicelazega): neighbour object has 7 sub-graphs##
## Moran I test under randomisation
##
## data: datattrout$HrRATE90
## weights: listwAd
## n reduced by no-neighbour observations
##
## Moran I statistic standard deviate = 14.477, p-value < 2.2e-16
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## 0.3297516714 -0.0156250000 0.0005691894##
## Moran I test under randomisation
##
## data: datattrout$FeesCollec90
## weights: listwAd
## n reduced by no-neighbour observations
##
## Moran I statistic standard deviate = 12.736, p-value < 2.2e-16
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## 0.2878698755 -0.0156250000 0.0005678319#run plots to see number of higher order neighbors before removing the isolates
keep_listNAd1 <- subset(listwAd[[2]], subset=card(listwAd[[2]])>= 0)
plot.spcor(sp.correlogram(keep_listNAd1, datattrout$HrRATE90, order = 3, method = "I", zero.policy=T), xlab = "Social lags", main = "Social correlogram: Autocorrelation with CIs")## Warning in nblag(neighbours, maxlag = order): lag 1 neighbour object has 7
## sub-graphs## Warning in nblag(neighbours, maxlag = order): lag 2 neighbour object has 7
## sub-graphs## Warning in nblag(neighbours, maxlag = order): lag 3 neighbour object has 61
## sub-graphs
#plot.spcor(sp.correlogram(listwAd[[2]], datattrout$HrRATE90, order = 6, method = "I", zero.policy=T), xlab = "Social lags", main = "Social correlogram: Autocorrelation with CIs")
#plot.spcor(sp.correlogram(listwAd[[2]], datattrout$FeesCollec90, order = 6, method = "I", zero.policy=T), xlab = "Social lags", main = "Social correlogram: Autocorrelation with CIs")Question 3
#########
#How are disconnected unit influencing these results and how to remove them?
#########
sub_listNAd <- subset(listwAd[[2]], subset=card(listwAd[[2]])> 0)
sub_listNAd## Neighbour list object:
## Number of regions: 65
## Number of nonzero links: 2130
## Percentage nonzero weights: 50.4142
## Average number of links: 32.76923sub_listWAd <- nb2listw(sub_listNAd, glist=NULL, style="W", zero.policy=NULL)
#making this a spatial points dataframe
sub_datattrout <- subset(datattrout, subset=card(listwAd[[2]]) > 0)
dim(sub_datattrout)## [1] 65 21##
## Moran I test under randomisation
##
## data: sub_datattrout$HrRATE90
## weights: sub_listWAd
##
## Moran I statistic standard deviate = 16.973, p-value < 2.2e-16
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## 0.3914759894 -0.0156250000 0.0005752643##
## Moran I test under randomisation
##
## data: sub_datattrout$FeesCollec90
## weights: sub_listWAd
##
## Moran I statistic standard deviate = 13.474, p-value < 2.2e-16
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## 0.3056191088 -0.0156250000 0.0005684217Part 1 and 2: How do the Moran’s I estimates change? Are there any differences in these changes by outcome?
After removing isolates, the Moran’s I changes positively for both the hourly rate and for the fees collected, however the hourly rate Moran’s I is still greater than the fees collected Morans I. The hourly rate Morans I increased from 0.520938960 (with isolates) to 0.684439193 (without isolates). For the fees collected, we see that the Morans I increased from 0.455321539 (with isolates) to 0.528467238 (with isolates). This still supports that there is stronger social dependence for the per hour rate over the fees collected, or more positive spatial autocorrelation. They are both statistically significant.
The fees collected changed by 0.073 and the hourly rate changed by 0.16. The fees collected changed less than the hourly rate. This is because there is a greater social dependence on the hourly rate than the fees collected in addition to the fees collected is a noisier outcome.
#########
#Visualizing Local Moran’s I clusters and outliers
#########
mt <- moran.test(sub_datattrout$HrRATE90, sub_listWAd, zero.policy=TRUE)
label_x = "Hr Rate Collected"
label_y = "Lagged Hr Rates Collected"
mp <- moran.plot(sub_datattrout$HrRATE90, sub_listWAd, zero.policy=T,
labels=sub_datattrout$id, xlab = label_x, ylab = label_y)
title(main="Moran’s Plot", cex.main=2, col.main="grey11",
font.main=2, sub=paste("Plot includes 71 lawyers (Moran’s I = ",
round(mt$ estimate[1], 3), ", p < .0001)", sep=""), cex.sub=1.15, col.sub="grey11", font.sub=2,)
#Finding the number of higher order neighbors
plot.spcor(sp.correlogram(sub_listNAd, sub_datattrout$HrRATE90, order = 3, method = "I", zero.policy=T), xlab = "Social lags", main = "Social correlogram: Autocorrelation with CIs")## Warning in nblag(neighbours, maxlag = order): lag 3 neighbour object has 55
## sub-graphs
plot.spcor(sp.correlogram(sub_listNAd, sub_datattrout$FeesCollec90, order = 3, method = "I", zero.policy=T), xlab = "Social lags", main = "Social correlogram: Autocorrelation with CIs")## Warning in nblag(neighbours, maxlag = order): lag 3 neighbour object has 55
## sub-graphs
Part 3 and 4: How many higher order neighbors did you find? Does this
change by outcome? From these two plots, we can see that there are
second order higher neighbors from the plots for both hourly rate and
fees collected. This is because up until the second order neighbor is
above zero and statistically significant. This does not change by
outcome, both the hourly rate and fees collected have second order
neighbors.
Module 6
Question 1:
I want to include all authors including solo authors. This is because solo authors are critical to my dataset and consist of 180 out of 539 authors. This means that using a two-mode network will be more useful for me.
#Procedures to decompose an adjacency list into a weighted graph
packages = c("splitstackshape", "stringr", "igraph", "spdep", "magrittr", "htmlwidgets", "htmltools", "plotly")
## Now load or install&load all
package.check <- lapply(
packages,
FUN = function(x) {
if (!require(x, character.only = TRUE)) {
install.packages(x, dependencies = TRUE)
library(x, character.only = TRUE)
}
}
)## Loading required package: plotly## Loading required package: ggplot2##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:igraph':
##
## groups## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary()
library()
library(igraph)
library(spdep)
a<-read.csv("scopus.csv")
#Keeping only column with author relationships
authors<-as.data.frame(a[,1])#"Author.s..ID"])
colnames(authors)<-"AU"
#package for first split
authors$AU <- str_remove_all(authors$AU, "[^[\\a-zA-Z ]]")
#As can be seen in the file the separator of interest is :
a1<-cSplit(authors, splitCols = "AU", sep = ";", direction = "wide", drop = TRUE) #retain the matrix form version of the adjacency list input## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE
## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE
## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE
## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE
## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE
## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE
## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE
## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE
## Warning in type.convert.default(X[[i]], ...): 'as.is' should be specified by
## the caller; using TRUE## [1] "data.table" "data.frame"# In case package cannot be installed uncomment and keep working using this version, alternatively you can decompose the cells into columns using excel
#read it as a matrix
mat <- as.matrix(a1)
# mat
dim(mat)# the resulting column dimension is the number of times you will have to repeat the following procedure minus 1## [1] 394 9mat <- cbind(a$EID, mat)
edgelist1<-matrix(NA, 1, 2)#empty matrix two columns
# for (i in 1:(ncol(mat)-1)) {# for coauthors
for (i in 1:1) {
edgelist11 <- cbind(mat[, i], c(mat[, -c(1:i)]))
edgelist1 <- rbind(edgelist1,edgelist11)
edgelist1<-edgelist1[!is.na(edgelist1[,2]),]
edgelist1<-edgelist1[edgelist1[,2]!="",]
}
dim(edgelist1)## [1] 590 2g<- graph.data.frame(edgelist1[, 2:1], directed = FALSE)
V(g)$type <- V(g)$name %in% edgelist1[ , 2]
table(V(g)$type)##
## FALSE TRUE
## 394 540i<-table(V(g)$type)[2]
#Transformations to retain actors
mat_g2_incidence <- t(get.incidence(g))
# This removes papers with only one author
# dim(mat_g2_incidence[,colSums(mat_g2_incidence)>1])
# mat_g2_incidence <- mat_g2_incidence[,colSums(mat_g2_incidence)>1]
dta <- data.frame(id=rownames(mat_g2_incidence), count=rowSums(mat_g2_incidence))
dta <- dta[order(dta$count, decreasing=T), ]
mat_g2_incidence_to_1 <- mat_g2_incidence%*%t(mat_g2_incidence)
diag(mat_g2_incidence_to_1)<-0
mat_g2_incidence_to_1 <- mat_g2_incidence_to_1 /rowSums(mat_g2_incidence_to_1)
summary(rowSums(mat_g2_incidence_to_1))## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 1 1 1 1 1 1 235## Warning in mat2listw(mat_g2_incidence_to_1): style is M (missing); style should
## be set to a valid value## Warning in mat2listw(mat_g2_incidence_to_1): no-neighbour observations found, set zero.policy to TRUE;
## this warning will soon become an error## Warning in mat2listw(mat_g2_incidence_to_1): neighbour object has 351
## sub-graphs#Creating a dataset for tests
pd <- data.frame(id=colnames(mat_g2_incidence_to_1))
pd$pub<- dta$count[match(pd$id, dta$id)]
pd$lag.pub <- round(lag.listw(listw, pd$pub, zero.policy=T, na.action=na.omit),3)
moran.test(pd$pub, listw, zero.policy=TRUE)##
## Moran I test under randomisation
##
## data: pd$pub
## weights: listw
## n reduced by no-neighbour observations
##
## Moran I statistic standard deviate = 4.7795, p-value = 8.785e-07
## alternative hypothesis: greater
## sample estimates:
## Moran I statistic Expectation Variance
## 0.303601898 -0.003289474 0.004122861Question 2:
The Morans I shows us that an author’s number of publications is positively spatially autocorrelated with his/her co-author’s number of publications.
Question 3: Visualization
#For the visualizations
#Moran's I procedures for social dependence
mi <- moran.test(pd$pub, listw, zero.policy=TRUE)
mp_math <- moran.plot(pd$pub, listw, labels=as.character(pd$id), zero.policy = TRUE)
mp_math$new_label <- paste("Author Name: ", mp_math$labels, "<br>own pub record: ", pd$pub[match(mp_math$labels, pd$id)],
"<br>Peers' record: ", pd$lag.pub[match(mp_math$labels, pd$id)], sep="")
library(ggplot2)
mphu <-ggplot(mp_math, aes(x=jitter(x), y=jitter(wx), text=new_label)) + geom_point(shape=1, alpha=0) +
geom_hline(yintercept=mean(mp_math$wx), lty=2) +
geom_vline(xintercept=mean(mp_math$x), lty=2) + theme_minimal() +
geom_point(data=mp_math[(mp_math$wx>=mean(mp_math$wx)&mp_math$x>=mean(mp_math$x))&mp_math$is_inf==FALSE,], aes(x=x, y=wx), shape=1, alpha=.1) +
geom_point(data=mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx>=mean(mp_math$wx))&mp_math$is_inf==TRUE,], aes(x=x, y=wx), shape=9, alpha=.4) +
geom_point(data=mp_math[(mp_math$x<mean(mp_math$x)&mp_math$wx>=mean(mp_math$wx))&mp_math$is_inf==FALSE,], aes(x=x, y=wx), shape=1, alpha=.1) +
geom_point(data=mp_math[(mp_math$x<mean(mp_math$x)&mp_math$wx>=mean(mp_math$wx))&mp_math$is_inf==TRUE,], aes(x=x, y=wx), shape=9, alpha=.4) +
geom_point(data=mp_math[(mp_math$x<mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==FALSE,], aes(x=x, y=wx), shape=1, alpha=.1) +
geom_point(data=mp_math[(mp_math$x<mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==TRUE,], aes(x=x, y=wx), shape=9, alpha=.4) +
geom_point(data=mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==FALSE&(mp_math$x-mp_math$wx<min(mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==TRUE,]$x-mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==TRUE,]$wx)),], aes(x=x, y=wx), shape=1, alpha=.3, position=position_jitter(h=0.1,w=0.1)) +
geom_point(data=mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==FALSE&(mp_math$x-mp_math$wx>=min(mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==TRUE,]$x-mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==TRUE,]$wx)),], aes(x=x, y=wx), shape=9, alpha=.8, colour=rgb(223, 255, 0, max=255, 255/1), position=position_jitter(h=0.1,w=0.1)) +
geom_point(data=mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==TRUE,], aes(x=x, y=wx), shape=9, alpha=.8, colour=rgb(255, 0, 126, max=255, 255/1), position=position_jitter(h=0.1,w=0.1)) +
xlab("Authors' Own Publication count (y_i)") + ylab("Coauthors' Publication count (y_j)") + ggtitle("Peer effects",
subtitle = "") + labs(caption = "(PHUDCFILY)") +
theme(plot.title = element_text(color=rgb(255, 0, 126, max=255, 255/1), size=14, face="bold"),
plot.subtitle = element_text(color = "blue"))
ggplotly(mphu, tooltip = c("new_label")) %>%
layout(title = list(text = paste0('<b>Peer effects on Publication Performance</b>',
'<br>',
'<sup style="color:black; font-weight:bold">',
paste(dim(mat_g2_incidence_to_1)[1],' authors in ', dim(mat_g2_incidence)[2],' Publications. Conservative: ', dim(mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==TRUE,])[1], ' HL cases (pink), Liberal: ', dim(mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==FALSE&(mp_math$x-mp_math$wx>=round(min(mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==TRUE,]$x-mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==TRUE,]$wx),3)),])[1], ' HL cases (green) </sup>', sep=""),
'<span style="font-size:10px; font-weight:bold; color: rgb(255, 0, 126, max=255, 255/1)">',
paste("\nSource: Scopus. Moran's I = ", round(mi$estimate[1], 3)," P. Value ", ifelse(mi$p.value==0, "< 0.001", mi$p.value), ', Liberal threshold = ', round(min(mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==TRUE,]$x-mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==TRUE,]$wx),3), '</span>', sep=""))))#Conservative
mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==TRUE,]## x wx is_inf labels dfb.1_ dfb.x dffit cov.r cook.d
## 26 2 0 TRUE Harvey C.J. 0.1678966 -0.201853 -0.2166063 1.005707 0.02335985
## 46 2 0 TRUE Sheng Y. 0.1678966 -0.201853 -0.2166063 1.005707 0.02335985
## 125 2 0 TRUE Mirshak N. 0.1678966 -0.201853 -0.2166063 1.005707 0.02335985
## 205 2 0 TRUE Tansey O. 0.1678966 -0.201853 -0.2166063 1.005707 0.02335985
## 245 2 0 TRUE Boas T.C. 0.1678966 -0.201853 -0.2166063 1.005707 0.02335985
## 308 2 0 TRUE D'Anieri P. 0.1678966 -0.201853 -0.2166063 1.005707 0.02335985
## hat
## 26 0.01407367
## 46 0.01407367
## 125 0.01407367
## 205 0.01407367
## 245 0.01407367
## 308 0.01407367
## new_label
## 26 Author Name: Harvey C.J.<br>own pub record: 2<br>Peers' record: 0
## 46 Author Name: Sheng Y.<br>own pub record: 2<br>Peers' record: 0
## 125 Author Name: Mirshak N.<br>own pub record: 2<br>Peers' record: 0
## 205 Author Name: Tansey O.<br>own pub record: 2<br>Peers' record: 0
## 245 Author Name: Boas T.C.<br>own pub record: 2<br>Peers' record: 0
## 308 Author Name: D'Anieri P.<br>own pub record: 2<br>Peers' record: 0# Liberal
mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==FALSE&(mp_math$x-mp_math$wx>=round(min(mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==TRUE,]$x-mp_math[(mp_math$x>=mean(mp_math$x)&mp_math$wx<mean(mp_math$wx))&mp_math$is_inf==TRUE,]$wx),3)),]## [1] x wx is_inf labels dfb.1_ dfb.x dffit
## [8] cov.r cook.d hat new_label
## <0 rows> (or 0-length row.names)Question 4: Higher Order Neighbors
plot.spcor(sp.correlogram(listw[[2]], pd$pub, order = 3, method = "I", zero.policy=TRUE), xlab = "Social lags", main = "Social correlogram: Autocorrelation with CIs")## Warning in nblag(neighbours, maxlag = order): lag 1 neighbour object has 351
## sub-graphs## Warning in nblag(neighbours, maxlag = order): lag 2 neighbour object has 510
## sub-graphs## Warning in nblag(neighbours, maxlag = order): lag 3 neighbour object has 537
## sub-graphs## Warning in moran.test(var, listw, randomisation = randomisation, zero.policy = zero.policy): Negative variance,
## distribution of variable does not meet test assumptions## Warning in sqrt(VI): NaNs produced## Warning in moran.test(var, listw, randomisation = randomisation, zero.policy =
## zero.policy): Out-of-range p-value: reconsider test arguments## Warning in arrows(lags, x$res[, 1] + sd2, lags, x$res[, 1] - sd2, length = 0.1,
## : zero-length arrow is of indeterminate angle and so skipped## Warning in arrows(lags, x$res[, 1] - sd2, lags, x$res[, 1] + sd2, length = 0.1,
## : zero-length arrow is of indeterminate angle and so skipped