Introduction

This is a social network analysis of about 10 people in my own life, built as a modified version of the Facebook Circles workbook from Jimmy Zhenning Xu’s RPubs tutorial. Instead of a simulated Facebook friend graph, the vertices and edges below describe real relationships among people in my household, my extended family, and my friend group.

library(tidyverse)   # data wrangling
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.2.1     ✔ readr     2.2.0
## ✔ forcats   1.0.1     ✔ stringr   1.6.0
## ✔ ggplot2   4.0.3     ✔ tibble    3.3.1
## ✔ lubridate 1.9.5     ✔ tidyr     1.3.2
## ✔ purrr     1.2.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(igraph)      # graph construction and algorithms
## 
## Attaching package: 'igraph'
## 
## The following objects are masked from 'package:lubridate':
## 
##     %--%, union
## 
## 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(kableExtra)  # nicer tables for the report
## 
## Attaching package: 'kableExtra'
## 
## The following object is masked from 'package:dplyr':
## 
##     group_rows
library(scales)       # color/size scaling for the network plot
## 
## Attaching package: 'scales'
## 
## The following object is masked from 'package:purrr':
## 
##     discard
## 
## The following object is masked from 'package:readr':
## 
##     col_factor
library(networkD3)    # interactive D3.js force-directed graphs

Step 1: Building the vertices (people) table

Nine people, each labeled with the group they belong to. “Household” is the five of us who live together — BonusChild joined the household through her relationship with Thing1, and at this point we’ve basically adopted her as family in her own right — “Extended Family” is my sister, and “Friend Group” is three close friends.

vertices <- tibble(
  name  = c("Me", "Husband", "Thing1", "Thing2", "BonusChild",
            "Sister", "Sue", "Wendy", "Cindy"),
  group = c("Household", "Household", "Household", "Household", "Household",
            "Extended Family", "Friend Group", "Friend Group", "Friend Group")
)

vertices %>%
  kable(caption = "People in my network and their group") %>%
  kable_styling(latex_options = "striped")
People in my network and their group
name group
Me Household
Husband Household
Thing1 Household
Thing2 Household
BonusChild Household
Sister Extended Family
Sue Friend Group
Wendy Friend Group
Cindy Friend Group

Step 2: Building the edges (relationship) table

There are a few standard ways to model a household in a social network: a full clique, where every member connects to every other member (accurate for “does everyone know everyone” but inflates triangle counts); a star, where one hub person connects to everyone else and no one else connects directly; or an organic structure, where an edge exists only where a real relationship does. I used the organic approach — that’s why the household isn’t a clique, and why BonusChild connects to Thing1 directly (the relationship that brought her into the household) rather than being wired identically to everyone else. A clique would have flattened that distinction and lost the actual shape of how these relationships formed.

edges <- tribble(
  ~from,         ~to,
  "Me",          "Husband",
  "Me",          "Thing1",
  "Me",          "Thing2",
  "Me",          "BonusChild",
  "Me",          "Sister",
  "Me",          "Sue",
  "Me",          "Wendy",
  "Me",          "Cindy",
  "Sue",         "Wendy",
  "Sue",         "Cindy",
  "Wendy",       "Cindy",
  "Sue",         "BonusChild",
  "Wendy",       "BonusChild",
  "Cindy",       "BonusChild",
  "Sister",      "Husband",
  "Sister",      "Thing1",
  "Sister",      "Thing2",
  "Sister",      "BonusChild",
  "BonusChild",  "Thing1"
)

edges %>%
  kable(caption = "Relationships (edges) in my network") %>%
  kable_styling(latex_options = "striped")
Relationships (edges) in my network
from to
Me Husband
Me Thing1
Me Thing2
Me BonusChild
Me Sister
Me Sue
Me Wendy
Me Cindy
Sue Wendy
Sue Cindy
Wendy Cindy
Sue BonusChild
Wendy BonusChild
Cindy BonusChild
Sister Husband
Sister Thing1
Sister Thing2
Sister BonusChild
BonusChild Thing1

Step 3: Building the graph

my_graph <- graph_from_data_frame(
  d = edges,
  vertices = vertices,
  directed = FALSE
)

my_graph
## IGRAPH 5fd4048 UN-- 9 19 -- 
## + attr: name (v/c), group (v/c)
## + edges from 5fd4048 (vertex names):
##  [1] Me        --Husband    Me        --Thing1     Me        --Thing2    
##  [4] Me        --BonusChild Me        --Sister     Me        --Sue       
##  [7] Me        --Wendy      Me        --Cindy      Sue       --Wendy     
## [10] Sue       --Cindy      Wendy     --Cindy      BonusChild--Sue       
## [13] BonusChild--Wendy      BonusChild--Cindy      Husband   --Sister    
## [16] Thing1    --Sister     Thing2    --Sister     BonusChild--Sister    
## [19] Thing1    --BonusChild
group_colors <- c("Household" = "#1f78b4",
                   "Extended Family" = "#33a02c",
                   "Friend Group" = "#e31a1c")

is_me <- V(my_graph)$name == "Me"

# "Me" is the only person connected to all three groups, so it gets its own
# highlight color and a larger size instead of blending into the Household color
node_colors <- group_colors[V(my_graph)$group]
node_colors[is_me] <- "#ffb400"

node_sizes <- ifelse(is_me, 45, 30)

plot(
  my_graph,
  layout = layout_with_fr(my_graph),
  vertex.color = node_colors,
  vertex.label.color = "black",
  vertex.label.cex = 0.9,
  vertex.size = node_sizes,
  vertex.frame.color = "white",
  edge.color = "grey60",
  main = "My personal network, colored by group"
)
legend("bottomleft",
       legend = c("Me (connects all groups)", names(group_colors)),
       col = c("#ffb400", group_colors),
       pch = 19, bty = "n", cex = 0.8)

Step 4: Graph analysis

1. Finding people in the same group

The tutorial looks for friend pairs who share a birthday. Since I didn’t include birthdays, I instead look for directly-connected pairs who belong to the same group — a proxy for “how much does this relationship stay inside one circle of my life.”

same_group <- as_data_frame(my_graph, what = "edges") %>%
  left_join(vertices, by = c("from" = "name")) %>%
  left_join(vertices, by = c("to" = "name"), suffix = c("_from", "_to")) %>%
  filter(group_from == group_to) %>%
  select(from, to, shared_group = group_from)

same_group %>%
  kable(caption = "Connected pairs who belong to the same group") %>%
  kable_styling(latex_options = "striped")
Connected pairs who belong to the same group
from to shared_group
Me Husband Household
Me Thing1 Household
Me Thing2 Household
Me BonusChild Household
Sue Wendy Friend Group
Sue Cindy Friend Group
Wendy Cindy Friend Group
Thing1 BonusChild Household

2. Counting relationship triangles

triangle_counts <- tibble(
  name = V(my_graph)$name,
  triangle_count = count_triangles(my_graph)
)

triangle_counts %>%
  arrange(desc(triangle_count)) %>%
  kable(caption = "People ranked by how many triangles they're part of") %>%
  kable_styling(latex_options = "striped")
People ranked by how many triangles they’re part of
name triangle_count
Me 11
BonusChild 9
Sue 6
Wendy 6
Cindy 6
Sister 5
Thing1 3
Husband 1
Thing2 1

3. Friends of friends: bridges across groups

Instead of filtering friends-of-friends down to “same school” like the tutorial, I look at the opposite question: which two-hop connections cross group lines? Those are the potential new connections created by whoever is bridging two circles of my life (spoiler: it’s BonusChild, who is the only Household member with Friend Group ties).

edge_list <- as_data_frame(my_graph, what = "edges") %>%
  transmute(a = pmin(from, to), b = pmax(from, to))

friends_of_friends <- edge_list %>%
  rename(a = a, b_mid = b) %>%
  inner_join(edge_list, by = c("b_mid" = "a"), suffix = c("", "_2")) %>%
  rename(b = b) %>%
  filter(a != b) %>%
  anti_join(edge_list, by = c("a", "b")) %>%
  distinct(a, b) %>%
  left_join(vertices, by = c("a" = "name")) %>%
  left_join(vertices, by = c("b" = "name"), suffix = c("_a", "_b")) %>%
  filter(group_a != group_b)
## Warning in inner_join(., edge_list, by = c(b_mid = "a"), suffix = c("", : Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 1 of `x` matches multiple rows in `y`.
## ℹ Row 2 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
##   "many-to-many"` to silence this warning.
friends_of_friends %>%
  kable(caption = "Two-hop connections that cross group lines (potential bridges)") %>%
  kable_styling(latex_options = "striped")
Two-hop connections that cross group lines (potential bridges)
a b group_a group_b
Husband Sue Household Friend Group
Husband Wendy Household Friend Group
Cindy Thing1 Friend Group Household
Cindy Thing2 Friend Group Household
Cindy Sister Friend Group Extended Family

4. Identifying key connectors using PageRank

pr <- page_rank(my_graph, damping = 0.85)$vector

influencers <- tibble(
  name = names(pr),
  pagerank = pr
) %>%
  left_join(vertices, by = "name") %>%
  arrange(desc(pagerank))

influencers %>%
  kable(caption = "People ranked by PageRank (network centrality)", digits = 4) %>%
  kable_styling(latex_options = "striped")
People ranked by PageRank (network centrality)
name pagerank group
Me 0.2017 Household
BonusChild 0.1501 Household
Sister 0.1345 Extended Family
Sue 0.1032 Friend Group
Cindy 0.1032 Friend Group
Wendy 0.1032 Friend Group
Thing1 0.0822 Household
Husband 0.0610 Household
Thing2 0.0610 Household

5. Making it interactive: the same graph in D3.js

group_ids <- c("Household" = 1, "Extended Family" = 2, "Friend Group" = 3)

nodes_d3 <- tibble(
  name = V(my_graph)$name,
  group = V(my_graph)$group,
  # "Me" gets its own group_id (0) so the D3 color scale sets it apart from
  # everyone else, instead of blending into the Household color
  group_id = if_else(name == "Me", 0, group_ids[group]),
  pagerank = pr[V(my_graph)$name]
)

links_d3 <- as_data_frame(my_graph, what = "edges") %>%
  mutate(
    source = match(from, nodes_d3$name) - 1,
    target = match(to, nodes_d3$name) - 1,
    value  = 1
  )

forceNetwork(
  Links = as.data.frame(links_d3),
  Nodes = as.data.frame(nodes_d3),
  Source = "source",
  Target = "target",
  Value = "value",
  NodeID = "name",
  Group = "group_id",
  Nodesize = "pagerank",
  radiusCalculation = JS("Math.sqrt(d.nodesize) * 40 + 6"),
  linkDistance = 130,
  opacity = 0.9,
  zoom = TRUE,
  fontSize = 14,
  bounded = TRUE
)

Interpretation of findings

This network isn’t simulated, so its structure is entirely determined by the relationships I listed, and a few clear patterns fall out:

Conclusion

Rebuilding the tutorial’s workbook around a real, small network made the algorithms easier to sanity-check by hand than the 150-node simulated Facebook graph did — every PageRank score, triangle count, and bridge in the tables above can be traced back to a specific relationship I listed in Step 2. The same code that finds influencers in a 150-person simulated network or a handful of crawled web pages works unchanged on 9 real people, which is the point: the algorithms don’t care what a “node” represents, only how the edges connect them.

References