Skip to content

Instantly share code, notes, and snippets.

@FrankRuns
Created Dec 29, 2020
Embed
What would you like to do?
Simple Sim to Understand Preferential Attachment
# 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()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment