tidy_tuesday_20200415

gistfile1.txt

library(tidyverse)
library(gganimate)
library(tidygraph)
library(ggraph)

#Import the data
polls <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-04-14/polls.csv')

#Make an edge list with nodes as artists with an edge drawn each time the same critic votes for the two artists
edge_list <- polls %>%
  select(critic_name, artist, year) %>%
  # here the steps to getting an edge list are from https://stackoverflow.com/questions/34670145/generating-an-edge-list-from-id-and-grouping-vectors
  group_by(critic_name) %>%
  filter(n() >= 2) %>%
  do(data.frame(t(combn(.$artist, 2)), stringsAsFactors = FALSE)) %>%
  ungroup() %>%
  select(- critic_name) %>%
  rename(from = X1, to = X2) %>%
  # here the steps to getting the edge weight are from: https://www.jessesadler.com/post/network-analysis-with-r/
  group_by(from, to) %>%
  summarise(weight = n()) %>% 
  ungroup()
  

# Create graph using tidygraph
graph <- as_tbl_graph(edge_list) %>%
  to_undirected() %>%
  activate(nodes) %>%
  mutate(centrality = centrality_authority()) %>%
  mutate(centrality2 = centrality + .4) %>%
  mutate(group = as.factor(group_edge_betweenness())) %>%
  group_by(group) %>%
  mutate(name_first = last(name, order_by = centrality)) %>%
  ungroup() %>%
  mutate(name_first = ifelse(as.numeric(group) <= 14, name_first, NA)) %>%
  filter(centrality > .01)
  

# plot network using ggraph
graph %>%
ggraph(layout = "kk") + 
  geom_edge_diagonal(aes(alpha = weight), show.legend = FALSE) + 
  geom_node_point(aes(colour = group, 
                      size = centrality + .7)) + 
  geom_node_label(aes(size = centrality + 1, 
                      label = ifelse(name_first == name, name, NA), 
                      colour = group)) +
  theme_graph() + 
  guides(colour = FALSE, size = FALSE) + 
  labs(title = "Network of hiphop artists voted for by the same critics")

ggsave("hiphop_network.png")

#plot constituents of communities
graph %>%
  activate(nodes) %>%
  as.data.frame() %>%
  mutate(group = as.numeric(group)) %>%
  filter(group <= 6) %>%
  mutate(group = as.factor(group)) %>%
  group_by(group) %>%
  top_n(6, centrality) %>%
  ungroup() %>%
  mutate(wrap_name = str_wrap(name, 10)) %>%
  ggplot(aes(x = centrality, y = fct_reorder(wrap_name, centrality), fill = group)) + 
  geom_col() + 
  facet_wrap(~ group, scales = "free", ncol = 3) +
  guides(fill = FALSE) + 
  theme(axis.title.y = element_blank()) + 
  labs(title = "Most central artists in first six clusters")

ggsave("hip_hop_communities.png")