Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
People in a room giving dollars to random others
library(animation)
library(gganimate)
library(ggplot2)
library(ggthemr)
library(magrittr)
library(tweenr)
library(reshape2)
## Configurable parameters
NUM_PEOPLE = 45
INITIAL_BANK = 45
INTEREST_RATE = 0.1
ROUNDS = 1500
RENT = 1
## Code that uses these parameters to generate animation
give_money <- function(state) {
payment_schedule <- sample(seq_along(state$wallets), replace = TRUE)
for (i in seq_along(state$wallets)) {
available_cash <- state$wallets[i]
payout <- RENT
if (available_cash < payout) {
# have to borrow
their_debt <- state$loans[payment_schedule[i], i]
if (their_debt > 0) {
# if they owe me - settle that first
covered_by_loan <- min(their_debt, payout)
state$loans[payment_schedule[i], i] %<>% { . - covered_by_loan}
payout %<>% { . - covered_by_loan }
}
# if the whole payout is covered - nothing left to do
if (payout > 0) {
if (available_cash < payout) {
# still not enough money!
# if there's still something left to pay for - borrow
loan_amount <- payout - available_cash
state$wallets[i] <- 0
state$wallets[payment_schedule[i]] %<>% { . + available_cash }
state$loans[i, payment_schedule[i]] %<>% { . + loan_amount }
} else {
# finally enough money to pay
state$wallets[i] %<>% { . - payout }
state$wallets[payment_schedule[i]] %<>% { . + payout }
}
}
} else {
# have enough money to pay
state$wallets[i] %<>% { . - payout }
state$wallets[payment_schedule[i]] %<>% { . + payout }
}
}
state
}
pay_back_the_loans <- function(state) {
for (x in seq_len(NROW(state$loans))) {
for (y in seq_len(NCOL(state$loans))) {
# diagonal is always 0
if (y != x) {
debt <- state$loans[x, y]
available_cash <- state$wallets[x]
if (debt > 0 && available_cash > 0) {
payout <- min(available_cash, debt)
state$loans[x, y] %<>% { . - payout }
state$wallets[x] %<>% { . - payout }
}
}
}
}
state
}
charge_interest <- function(state) {
state$loans %<>% { state$loans * (1 + INTEREST_RATE) }
state
}
last_state <- list(
wallets = rep(INITIAL_BANK, NUM_PEOPLE),
loans = matrix(0, NUM_PEOPLE, NUM_PEOPLE)
)
message("Simulation in progress")
simulation <- pbapply::pblapply(seq_len(ROUNDS), function(x) {
# a little hack so that animation starts from initial state
if (x > 1) {
last_state <<- last_state %>%
charge_interest %>%
pay_back_the_loans %>%
give_money
} else { last_state }
})
message("munging data")
wallet_history <- lapply(simulation, `[[`, "wallets") %>%
lapply(., function(x) {
setNames(as.data.frame(lapply(x, identity)), paste0("p", seq_along(x)))
})
wallet_history <- lapply(seq_along(simulation), function(x) {
lapply(seq_len(NUM_PEOPLE), function(y) {
debt <- simulation[[x]]$loans %>% { colSums(.) - rowSums(.) }
data.frame(
cash = simulation[[x]]$wallets[y],
loans = debt[y]
)
}) %>% plyr::rbind.fill(.)
})
plottable <- tween_states(wallet_history, tweenlength = 1, statelength = 1,
ease = c("exponential-in-out"),
nframes = 10)
plottable$player <- as.factor(paste0("p", seq_len(NUM_PEOPLE)))
plottable$debt_free <- (plottable$loans + plottable$cash) >= 0
message("Generating charts")
ggthemr("flat")
p <- ggplot(plottable, aes(frame = .frame, x = player, y = cash+loans, fill = debt_free)) +
geom_bar(stat = "identity", position = "identity") +
guides(fill = FALSE)
animation::ani.options(interval = 1/30)
gganimate(p, "simulation.mp4", title_frame = F, ani.width = 1280, ani.height = 720)
Owner

kirillseva commented Jul 10, 2017

Modified the problem from this post to also include debt. If someone doesn't have the funds to pay during the turn, they have to borrow money from the person they should be giving it to, and pay back with interest. I'll attach the resulting simulation in the next comment.

Owner

kirillseva commented Jul 10, 2017

Can't attach the gif because of the file size, and can't attach an mp4 because of github's limitations. So I'll just post the final screenshot, and I encourage you to try running this gist on your computer to produce an animation yourself.

The situation seems to destabilize fairly fast towards the last 1% of turns, producing an "economic crisis" with someone getting into an unpayable debt pit, and a handful of players becoming "ultra-wealthy", should the debt ever convert to money. Unfortunately, there isn't enough money in the whole game to account for these numbers.
screen shot 2017-07-10 at 12 02 20 am

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment