library(tidyverse)
## Warning: package 'tidyverse' was built under R version 3.6.2
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
## ✓ ggplot2 3.3.5 ✓ purrr 0.3.4
## ✓ tibble 3.1.6 ✓ dplyr 1.0.7
## ✓ tidyr 1.1.4 ✓ stringr 1.4.0
## ✓ readr 2.1.1 ✓ forcats 0.5.1
## Warning: package 'ggplot2' was built under R version 3.6.2
## Warning: package 'tibble' was built under R version 3.6.2
## Warning: package 'tidyr' was built under R version 3.6.2
## Warning: package 'readr' was built under R version 3.6.2
## Warning: package 'purrr' was built under R version 3.6.2
## Warning: package 'dplyr' was built under R version 3.6.2
## Warning: package 'forcats' was built under R version 3.6.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(splitstackshape)
library(igraph)
## Warning: package 'igraph' was built under R version 3.6.2
##
## Attaching package: 'igraph'
## The following objects are masked from 'package:dplyr':
##
## as_data_frame, groups, union
## The following objects are masked from 'package:purrr':
##
## compose, simplify
## The following object is masked from 'package:tidyr':
##
## crossing
## The following object is masked from 'package:tibble':
##
## as_data_frame
## The following objects are masked from 'package:stats':
##
## decompose, spectrum
## The following object is masked from 'package:base':
##
## union
library(readr)
library(ggplot2)
library(magrittr)
## Warning: package 'magrittr' was built under R version 3.6.2
##
## Attaching package: 'magrittr'
## The following object is masked from 'package:purrr':
##
## set_names
## The following object is masked from 'package:tidyr':
##
## extract
library(htmltools)
## Warning: package 'htmltools' was built under R version 3.6.2
library(networkD3)
library(htmlwidgets)
## Warning: package 'htmlwidgets' was built under R version 3.6.2
##
## Attaching package: 'htmlwidgets'
## The following object is masked from 'package:networkD3':
##
## JS
library(knitr)
## Warning: package 'knitr' was built under R version 3.6.2
spotifytopsongs <- read.csv("/Users/rexchng/Documents/R Code/Educ 747/CSV/spotifytopsongs.csv")
spotifytopsongs_trimmed <- spotifytopsongs %>% select(Artist, Genre) %>% filter(Artist !="")
spotifytopsongs_matrix <- as.matrix(spotifytopsongs_trimmed)
top_genre_counts <- spotifytopsongs_trimmed %>% group_by(`Artist`, `Genre`) %>% summarise(top_genre = n())
## `summarise()` has grouped output by 'Artist'. You can override using the `.groups` argument.
spotifytopsongs_frame <- spotifytopsongs_trimmed %>% left_join(top_genre_counts, by=c("Artist", "Genre"), keep = FALSE)
top_songs <- top_genre_counts %>% select(`Artist`, `Genre`, `top_genre`)
g_top_songs <- graph.data.frame(top_songs)
top_songs_links <- get.edgelist(g_top_songs)
#Conduct a two-mode network visualization
table(duplicated(spotifytopsongs_frame$Artist))
##
## FALSE TRUE
## 184 419
table(duplicated(spotifytopsongs_frame$Genre))
##
## FALSE TRUE
## 50 553
g_top_songs_2 <- as.matrix(g_top_songs)
g_top_songs_3 <- g_top_songs_2[1:table(duplicated(spotifytopsongs_frame$Artist))[1], (table(duplicated(spotifytopsongs_frame$Artist))[1]+1):ncol(g_top_songs_2)]
V(g_top_songs)$type <- V(g_top_songs)$name %in% spotifytopsongs_trimmed$Artist
i <- table(V(g_top_songs)$type)[2]
E(g_top_songs)$weight <- E(g_top_songs)$top_genre
g_top_songs <- simplify(g_top_songs)
V(g_top_songs)$label <- V(g_top_songs)$name
V(g_top_songs)$name <- 1:length(V(g_top_songs))
g_top_song_links <- as.data.frame(cbind(get.edgelist(g_top_songs), E(g_top_songs)$weight))
g_top_song_links$V1 <- as.numeric(as.character(g_top_song_links$V1))
g_top_song_links$V2 <- as.numeric(as.character(g_top_song_links$V2))
g_top_song_links$V3 <- as.numeric(as.character(g_top_song_links$V3))
g_top_song_links[,1:2] <- (g_top_song_links[,1:2]-1)
colnames(g_top_song_links) <- c("source","target","value")
V(g_top_songs)$type <- V(g_top_songs)$name %in% g_top_songs$"name"
table(V(g_top_songs)$name)[2]
## 10
## 1
i <- table(V(g_top_songs)$name)[2]
head(g_top_song_links)
top_songs_centrality <- data.frame(bet=betweenness(g_top_songs, normalized=T, directed = FALSE)/max(betweenness(g_top_songs, normalized=T, directed = FALSE)),eig=evcent(g_top_songs)$vector, degree=degree(g_top_songs, mode="total"))
dim(top_songs_centrality)
## [1] 234 3
top_songs_residuals <- lm(eig~bet, data = top_songs_centrality)$residuals
top_songs_centrality <- transform(top_songs_centrality, res = top_songs_residuals)
rownames(top_songs_centrality)
## [1] "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12"
## [13] "13" "14" "15" "16" "17" "18" "19" "20" "21" "22" "23" "24"
## [25] "25" "26" "27" "28" "29" "30" "31" "32" "33" "34" "35" "36"
## [37] "37" "38" "39" "40" "41" "42" "43" "44" "45" "46" "47" "48"
## [49] "49" "50" "51" "52" "53" "54" "55" "56" "57" "58" "59" "60"
## [61] "61" "62" "63" "64" "65" "66" "67" "68" "69" "70" "71" "72"
## [73] "73" "74" "75" "76" "77" "78" "79" "80" "81" "82" "83" "84"
## [85] "85" "86" "87" "88" "89" "90" "91" "92" "93" "94" "95" "96"
## [97] "97" "98" "99" "100" "101" "102" "103" "104" "105" "106" "107" "108"
## [109] "109" "110" "111" "112" "113" "114" "115" "116" "117" "118" "119" "120"
## [121] "121" "122" "123" "124" "125" "126" "127" "128" "129" "130" "131" "132"
## [133] "133" "134" "135" "136" "137" "138" "139" "140" "141" "142" "143" "144"
## [145] "145" "146" "147" "148" "149" "150" "151" "152" "153" "154" "155" "156"
## [157] "157" "158" "159" "160" "161" "162" "163" "164" "165" "166" "167" "168"
## [169] "169" "170" "171" "172" "173" "174" "175" "176" "177" "178" "179" "180"
## [181] "181" "182" "183" "184" "185" "186" "187" "188" "189" "190" "191" "192"
## [193] "193" "194" "195" "196" "197" "198" "199" "200" "201" "202" "203" "204"
## [205] "205" "206" "207" "208" "209" "210" "211" "212" "213" "214" "215" "216"
## [217] "217" "218" "219" "220" "221" "222" "223" "224" "225" "226" "227" "228"
## [229] "229" "230" "231" "232" "233" "234"
set.seed(670)
l <- layout.fruchterman.reingold(g_top_songs, niter=5000)
V(g_top_songs)$size <- abs((top_songs_centrality$bet)/max(top_songs_centrality$bet))*15
nodes <- V(g_top_songs)$label
x <- quantile(top_songs_centrality$eig, .95)
nodes[which(abs(top_songs_centrality$eig)<(x))]<- NA
summary(top_songs_centrality$eig)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00000 0.00000 0.00000 0.03452 0.04328 1.00000
table(is.na(nodes))
##
## FALSE TRUE
## 12 222
plot(g_top_songs,layout=l,vertex.label=nodes, vertex.label.dist=0.25, vertex.label.color="red",edge.width=1)
title(main="Key Actor Analysis", sub="Key actors weighted by BC, names are top 5% EC", col.main="black", col.sub="black", cex.sub=1.2,cex.main=2,font.sub=2)
nodes<-data.frame(name=c(paste("Artist: ", V(g_top_songs)$label[1:i], sep=""), paste("Genre: ", V(g_top_songs)$label[(i+1):length(V(g_top_songs)$label)], sep="")), size=top_songs_centrality$degree)
nodes$name<-as.character(nodes$name)
The answers to these questions will be in RMarkdown format, but the outputs will be rpubs links. So, please create your own site in rpubs. You can take snapshots of relevant network features and add them to RMarkdown.
netviz <- forceNetwork(Links = g_top_song_links, Nodes = nodes,
Source = 'source', Target = 'target',
NodeID = 'name',
Group = 1,#"groups",
charge = -30,
linkDistance = JS("function(d) { return d.linkDistance; }"),
#JS("function(d){return d.value}"),
linkWidth = JS("function(d) { return Math.sqrt(d.value)*2; }"),
opacity = 0.8,
Value = "value",
Nodesize = 'size',
radiusCalculation = JS("Math.sqrt(d.nodesize*30)+4"),
zoom = T,
fontSize=14,
bounded= F)
HTMLaddons <-
"function(el, x) {
d3.select('body').style('background-color', ' #212f3d ')
d3.selectAll('.legend text').style('fill', 'white')
d3.selectAll('.link').append('svg:title')
.text(function(d) { return 'Grade course: ' + d.value + ', Campus: ' + d.campus ; })
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$g_top_song_links$linkDistance <- (1/g_top_song_links$value)*500
onRender(netviz, HTMLaddons)
```