jldugger · July 9, 2017 21:33 · Jul 9, 2017
diff --git a/gistfile1.txt b/gistfile1.txt
@@ -0,0 +1,76 @@
+library(tidyverse)
+library(gganimate)
+
+NUMPLAYERS = 45
+ROUNDS = 5000
+INITWEALTH = 45
+
+#initialize the bank
+#columns wealths of the NUMPLAYERS players
+#rows show wealths of each of the ROUNDS ticks of the clocks
+bank = matrix(0, nrow = ROUNDS, ncol = NUMPLAYERS)
+
+for (i in 1:NUMPLAYERS)
+  bank[1,i] = i*2 
+
+#execute trades and update the ledger 
+for (i in 2:ROUNDS) {
+
+  get_recipient = function(player) {
+    a <- sample(setdiff(1:NUMPLAYERS, player), 1)
+
+    b <- sample(setdiff(1:NUMPLAYERS, player), 1)
+
+    if (bank[i - 1,a] < bank[i - 1,b]) { a } else { b }
+  }
+
+
+  #every player with wealth chooses another person to receive a buck
+  recipients = sapply(which(bank[i - 1,] > 0), get_recipient)
+
+  #table of the dollars owed each person
+  count_table = table(recipients)
+
+  #get the indices of the people owed money
+  indices = as.integer(names(count_table))
+
+  #everyone gives up a dollar, unless they are at zero
+  bank[i,] = ifelse(bank[i - 1,] > 0, bank[i - 1,] - 1, bank[i - 1,])
+
+  #selected people receive dollars
+  bank[i, indices] = bank[i, indices] + count_table
+}
+
+####################Animate it
+#Make a suitable long data frame
+df = as.data.frame(bank)
+names(df) = 1:NUMPLAYERS
+df = df %>%
+  mutate(frame = 1:ROUNDS) %>%
+  gather(person, wealth, 1:NUMPLAYERS) %>%
+  mutate(person = as.numeric(person)) %>%
+  arrange(frame) %>%
+  group_by(frame) %>%
+  mutate(rank = rank(wealth, ties.method = "random")) %>%
+  ungroup() %>%
+  gather(histtype,playerid,c(person,rank)) %>%
+  mutate(histtype = sprintf("Ordered by %s", histtype))
+
+p <- ggplot(df, aes(x = playerid, y = wealth, frame = frame, fill=histtype)) +
+  theme_minimal() +
+  theme(panel.grid.major.x = element_blank(),
+        panel.grid.minor = element_blank()) +
+  geom_rect(aes( xmin = playerid - .4, xmax = playerid +.4, ymin = 0, ymax = wealth)) +
+  scale_x_continuous(breaks = 1:NUMPLAYERS) +
+  coord_cartesian(xlim = c(0, NUMPLAYERS), y = c(0, 5 * INITWEALTH)) +
+  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
+  labs(x='players',y='dollars') +
+  facet_wrap( ~ histtype,ncol=1) +
+  theme(legend.position = "none")
+p
+
+#set options for the animation package. Need ImageMagick installed on your computer
+animation::ani.options(nmax = ROUNDS, convert = '/usr/bin/convert')
+
+#save the movie
+gganimate(p, "dollar_stacked.mp4", interval = .01)
diff --git a/two_choice_imbalanced.R b/two_choice_imbalanced.R
@@ -0,0 +1,76 @@
+library(tidyverse)
+library(gganimate)
+
+NUMPLAYERS = 45
+ROUNDS = 5000
+INITWEALTH = 45
+
+#initialize the bank
+#columns wealths of the NUMPLAYERS players
+#rows show wealths of each of the ROUNDS ticks of the clocks
+bank = matrix(0, nrow = ROUNDS, ncol = NUMPLAYERS)
+
+for (i in 1:NUMPLAYERS)
+  bank[1,i] = i*2 
+
+#execute trades and update the ledger 
+for (i in 2:ROUNDS) {
+
+  get_recipient = function(player) {
+    a <- sample(setdiff(1:NUMPLAYERS, player), 1)
+
+    b <- sample(setdiff(1:NUMPLAYERS, player), 1)
+
+    if (bank[i - 1,a] < bank[i - 1,b]) { a } else { b }
+  }
+
+
+  #every player with wealth chooses another person to receive a buck
+  recipients = sapply(which(bank[i - 1,] > 0), get_recipient)
+
+  #table of the dollars owed each person
+  count_table = table(recipients)
+
+  #get the indices of the people owed money
+  indices = as.integer(names(count_table))
+
+  #everyone gives up a dollar, unless they are at zero
+  bank[i,] = ifelse(bank[i - 1,] > 0, bank[i - 1,] - 1, bank[i - 1,])
+
+  #selected people receive dollars
+  bank[i, indices] = bank[i, indices] + count_table
+}
+
+####################Animate it
+#Make a suitable long data frame
+df = as.data.frame(bank)
+names(df) = 1:NUMPLAYERS
+df = df %>%
+  mutate(frame = 1:ROUNDS) %>%
+  gather(person, wealth, 1:NUMPLAYERS) %>%
+  mutate(person = as.numeric(person)) %>%
+  arrange(frame) %>%
+  group_by(frame) %>%
+  mutate(rank = rank(wealth, ties.method = "random")) %>%
+  ungroup() %>%
+  gather(histtype,playerid,c(person,rank)) %>%
+  mutate(histtype = sprintf("Ordered by %s", histtype))
+
+p <- ggplot(df, aes(x = playerid, y = wealth, frame = frame, fill=histtype)) +
+  theme_minimal() +
+  theme(panel.grid.major.x = element_blank(),
+        panel.grid.minor = element_blank()) +
+  geom_rect(aes( xmin = playerid - .4, xmax = playerid +.4, ymin = 0, ymax = wealth)) +
+  scale_x_continuous(breaks = 1:NUMPLAYERS) +
+  coord_cartesian(xlim = c(0, NUMPLAYERS), y = c(0, 5 * INITWEALTH)) +
+  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
+  labs(x='players',y='dollars') +
+  facet_wrap( ~ histtype,ncol=1) +
+  theme(legend.position = "none")
+p
+
+#set options for the animation package. Need ImageMagick installed on your computer
+animation::ani.options(nmax = ROUNDS, convert = '/usr/bin/convert')
+
+#save the movie
+gganimate(p, "dollar_stacked.mp4", interval = .01)
No results found