Simple Sim to Understand Preferential Attachment

pa-sim.r

# load packages
library(tidyverse)
library(ggplot2)
library(gganimate)  

# define initialization parameters
the_step <- rep(0, 5)
the_options <- c(1,2,3,4,5)

print(the_options)
the_count <- table(the_options)
the_probs <- table(the_options) / length(the_options)

d <- data.frame(the_step, the_count) %>% mutate(the_probs = Freq / length(the_options))

# run 1000 steps of random option selection based up existing population
set.seed(1234)
for (i in 1:1000) {
  temp_val <- sample(the_options, 1)
  the_options <- c(the_options, temp_val)
  
  the_step <- rep(i, 5)
  the_count <- table(the_options)
  
  temp_data <- data.frame(the_step, the_count) %>% mutate(the_probs = Freq / sum(Freq))

  d <- rbind(d, temp_data)
}

# print(the_options)
# table(the_options) / length(the_options)
# plot(table(the_options))

# reformat probabilities for plotting
percent <- function(x, digits = 1, format = "f", ...) {
  paste0(formatC(100 * x, format = format, digits = digits, ...), "%")
}

d$the_probs_pct <- percent(d$the_probs)

## -------

# line chart of probabilities
ggplot(d, aes(x=the_step, y=the_probs, group=the_options, color=the_options)) +
  geom_line() +
  labs(x="The Options", y="Total", title = "Preferential Attachment Probabilities", 
       subtitle = "Probabilities don't change much after the 175th step") +
  theme_minimal()

# simulation gif
p <- ggplot(d, aes(x=factor(the_options), y=Freq)) +
  geom_bar(stat="identity", fill="steelblue") +
  geom_text(data = d, aes(x=the_options, y=375, label=the_probs_pct), colour="deep pink") +
  geom_text(x=2.25, y=395, label="Probability of Next Agent Selecting This Option:") +
  labs(x="The Options", y="Total", title="Simple Sim to Understand Preferential Attachment",
       subtitle="When an option is selected,\nthe probability of it getting selected again increases.") +
  ylim(0,400) + 
  theme_minimal() +
  transition_states(the_step) +
  ease_aes('linear')

# you need 2x the actual number of states when you have >50 steps
# https://stackoverflow.com/questions/52332967/problem-with-many-50-states-in-gganimate/52352505#52352505
anim <- animate(p, nframes = length(unique(d$the_step)) * 2, fps = 50, end_pause = 500)
# anim_save("pa-sim.gif", anim)

# outcome bar chart
ggplot(tail(d,10), aes(x=reorder(the_options, -Freq), y=Freq)) +
  geom_bar(stat="identity", fill="steelblue") +
  labs(x="The Options", y="Total", title = "Preferential Attachment Process Outcome", 
       subtitle = "Winners tend to win.") +
  theme_minimal()