Network analysis in a connected graph. Building a social network for most influential post authors based on post and replies https://www.coursera.org/learn/applying-data-analytics-business-in-marketing/lecture/7FPYu/network-analysis-with-r-part-2

bogleheads-network.R

# Network Analysis with R
# https://www.coursera.org/learn/applying-data-analytics-business-in-marketing/lecture/7FPYu/network-analysis-with-r-part-2

# Create a method in R to extract all posts listed on https://bogleheads.org and return their Author, Title, and Url.
# 
# For example, the first result in the list might be:
#   Title: Helping elderly parents with diminishing mental capacity
# Author: yakk0
# Url: https://www.bogleheads.org/forum/viewtopic.php?f=2&t=413715&newpost=7484050


# Load the rvest package
library(rvest)
library(igraph)
library(ggplot2)
library(tibble)

# Define the function
extract_posts <- function() {
  # Set the user_agent for web requests.
  httr::set_config(httr::user_agent("Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/116.0.0.0 Safari/537.36"))
  
  # Read the html structure of the web page
  html <- read_html("https://bogleheads.org/")
  
  # Create an empty list to store the results
  results <- list()
  
  # Find the posts_table element
  posts_table <- html_node(html, "#posts_table")
  
  # Find all the td elements with the style "vertical-align:baseline;" within the posts_table
  posts <- html_nodes(posts_table, "tr[style='vertical-align:baseline;']")
  
  # Loop through each post element
  for (i in 1:length(posts)) {
    # Extract the post url and title from the third td element
    post_url <- html_attr(html_node(posts[i], "td:nth-child(3) a"), "href")
    post_title <- html_text(html_node(posts[i], "td:nth-child(3) a"))
    
    # Extract the post author from the next td element with the style "white-space:nowrap;"
    post_author <- html_text(html_node(posts[i], "td[style='white-space:nowrap;']"))
    
    # Trim leading and trailing whitespace from the values
    post_url <- trimws(post_url)
    post_title <- trimws(post_title)
    post_author <- trimws(post_author)
    
    # Add the extracted information to the results list
    results[[i]] <- list(
      url = post_url,
      title = post_title,
      author = post_author
    )
  }
  
  # Return the results list
  return(results)
}

# Define the function
extract_usernames <- function(post_url) {
  # Read the html structure of the web page
  html <- read_html(post_url)
  
  # Create an empty list to store the results
  usernames <- list()
  
  # Find all the elements that have the class "username"
  posts <- html_nodes(html, ".username")
  
  # Loop through each post element
  for (i in 1:length(posts)) {
    # Extract the username
    username <- html_text(posts[i])
    
    # Trim leading and trailing whitespace from the username
    username <- trimws(username)
    
    # Add the extracted username to the usernames list
    usernames[[i]] <- username
  }
  
  # Remove duplicates from the usernames list
  usernames <- unique(usernames)
  
  # Remove the first username from the list
  if (length(usernames) > 0) {
    usernames <- usernames[-1]
  }
  
  # Return the usernames list
  return(usernames)
}

# Each reply can be represented as a directed edge in a graph that connects *from* the reply username *to* the original author of the post.
create_graph <- function(posts = extract_posts(), max = 999) {
  # Create an empty dataframe to store the edges of the graph
  edges <- data.frame(from = character(), to = character())
  
  max_count <- min(length(posts), max)
  
  # Loop through each post
  for (i in 1:max_count) {
    # Get the author of the post
    post_author <- posts[[i]]$author
    
    print(paste(i, '/', max_count, ' Analyzing post ', posts[[i]]$url))
    
    # Call the extract_usernames function to get the list of usernames that posted a reply to this post
    usernames <- extract_usernames(posts[[i]]$url)
    
    # Loop through each username
    if (length(usernames) > 0) {
      for (j in 1:length(usernames)) {
        #print(paste0('Author: ', post_author, ' ', Reply: ', usernames[[j]]))
        # Add a new edge to the dataframe
        edges <- rbind(edges, data.frame(from = usernames[[j]], to = post_author))
      }
    }
  }
  
  # Return the dataframe
  return(edges)
}

# Call the extract_posts function to get the list of posts
posts <- extract_posts()

# Create the list of edges in the graph based upon post author and replying users.
edges <- create_graph(posts)

# Build a directed graph.
graph <- graph_from_data_frame(edges, directed = T)

# Note, the first number 566 represents the number of post authors. The second number is the number of edges (or post replies).
#IGRAPH 8cf23d1 DN-- 566 807 -- 
#  + attr: name (v/c)
#+ edges from 8cf23d1 (vertex names):
#  [1] jebmke            ->yakk0      littlebird        ->yakk0      123               ->yakk0      Diluted Waters    ->yakk0    

# Calculate degree centrality for all "in" connections to each post author.
deg <- degree(graph, mode = 'in')

# Sort by degree centrality in descending order.
deg <- deg %>% sort(decreasing = T)

# Display the top 6 most popular post authors with the most influence (i.e., post replies).
head(deg)
# Heian  InvestorNewb      Chris333 Artful Dodger        frose2       JSPECO9 
# 43            43            40            38            36            34 

# Show the number of nodes (posts).
gorder(graph)

n = 20

# Identify the top N most influential post authors.
top20 <- head(deg, n)

# Convert the named numeric vector top20 into a dataframe for plotting.
data <- enframe(top20, name = 'username', value='reply_count')

# Draw a chart of the most influential post authors.
ggplot(
  data = data,
  aes(x = reply_count, y = reorder(username, reply_count))) +
  geom_col() +
  theme_classic() + 
  xlab('Number of replies by other users') +
  ylab('Author')

# Draw a network graph of all users.
plot(
  graph,
  layout = layout_with_fr(graph),
  main = 'Post reply network graph of all users',
  edge.arrow.size = 0.15,
  edge.color = '#BBDFFF',
  vertex.label = NA,
  vertex.color = '#20DFFF',
  vertex.frame.color = '#008FFF',
  vertex.size = 0.2
)

# The graph is a bit too complex, let's narrow it down to authors within the largest connected component.
# Find the connected components of the graph.
gc <- igraph::components(graph)

# Delete users that are outside the largest connected component.
graph_filtered <- delete_vertices(graph, gc$membership != which.max(gc$csize))

# Calculate in-degrees within the filtered graph.
filtered_deg_in <- degree(graph_filtered, mode = 'in')
vertex_size <- pmax(pmin(filtered_deg_in * 0.08, 6), 0.3)

top_authors <- names(head(sort(filtered_deg_in, decreasing = TRUE), n))

plot(
  graph_filtered,
  layout = layout_with_fr(graph_filtered),
  main = 'Top authors within the largest connected component',
  edge.arrow.size = 0.15,
  edge.color = '#BBDFFF',
  vertex.label = ifelse(
    names(filtered_deg_in) %in% top_authors,
    V(graph_filtered)$name, NA
  ),
  vertex.label.framily = 'sans-serif',
  vertex.label.cex = 0.8,
  vertex.label.color = '#000000',
  vertex.color = '#20DFFF',
  vertex.frame.color = '#008FFF',
  vertex.size = vertex_size
)

Top 20 Most Influential Authors

Top Authors Within the Largest Connected Component

Top 100 Most Influential Authors