Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- # Model how many games it takes to advance through a given tier.
- library(rmarkdown)
- library(ggplot2)
- library(plyr)
- library(tidyr)
- library(dplyr)
- library(data.table)
- library(parallel)
- setwd('C:\\Users\\admin\\Documents\\GW2math')
- set.seed(420) # Set the random seed so results can be duplicated
- options(stringsAsFactors = FALSE)
- # Rules/Specs
- rules <- data.frame(
- div = c('Amber', 'Emerald', 'Sapphire', 'Ruby', 'Diamond', 'Legendary'),
- pips = c(3, 4, 5, 5, 5, 5),
- tiers = c(5, 5, 5, 6, 7, 5),
- losePip = c(0, 1, 1, 1, 1, 1),
- loseTier = c(0, 0, 0, 1, 1, 1),
- color = c( 'darkorange', 'forestgreen', 'dodgerblue',
- 'firebrick3', 'darkgrey', 'gray15'))
- #Function starts here
- simulateRun <- function(div, winRate, simNo, maxGames = 500){
- div <- rules[rules$div == div,]
- # Initialize the variables
- winStrk <- 0
- lossStrk <- 0
- pipNum <- 0
- tierNum <- 1
- totWins <- 0
- totLosses <- 0
- totGames <- 0
- while((pipNum < div$pips & tierNum == div$tiers) | tierNum < div$tiers){
- # Sanity checks
- if(winStrk != 0 & lossStrk != 0){
- stop('Failed a sanity check')
- }
- # Roll to see if you won the game
- winRoll <- runif(1)
- wonGame <- ifelse(winRoll <= winRate, 1, 0)
- if(wonGame==1){ # Did you win?
- totWins <- totWins + 1 # Increment the win count
- winStrk <- winStrk + 1 # Increment win streak
- # Add a bonus pip
- pipBonus <- ifelse(winStrk >=3 | lossStrk >= 3, 1, 0)
- lossStrk <- 0 # Reset the loss streak
- if(pipNum + 1 + pipBonus < div$pips){ # Didn't max out the tier
- pipNum <- pipNum + 1 + pipBonus # Just add the pips
- } else if(pipNum + 1 + pipBonus == div$pips) {
- # Did max out the tier
- # Start at 0 pips in the new tier, add bonus if any
- pipNum <- 0
- tierNum <- tierNum + 1 # Increment the tier
- } else if(pipNum + 1 + pipBonus > div$pips) {
- # Maxed out + 1
- pipNum <- 1
- tierNum <- tierNum + 1
- }
- } else { # Did you lose?
- totLosses <- totLosses + 1 # Increment the total losses
- lossStrk <- lossStrk + 1 # Increment loss streak
- winStrk <- 0 # Reset win streak
- # Decrement the pip if you can lose pips,
- # but only go down a tier if legal
- if(!div$losePip){
- # Can't lose pips, do nothing
- } else if(pipNum != 0){
- # Simple if you're not at the start of a tier
- pipNum <- pipNum - 1
- } else if(pipNum == 0 & (tierNum == 1 | !div$loseTier)){
- # Can't go down a division, do nothing
- } else if(pipNum == 0 & div$loseTier){
- # Go back to 1 missing pip on prior tier if possible
- pipNum <- div$pips - 1
- # Decrement the tier if possible
- tierNum <- tierNum - 1
- } else {
- stop('Pips/Tiers are messed up')
- }
- }
- # Increment the number of games played
- totGames <- totGames + 1
- # Test to see if this division is maxed
- if(tierNum > div$tiers){
- return(data.frame(
- div = div$div,
- wr = winRate,
- simNo = simNo,
- totGames = totGames,
- totWins = totWins,
- totLosses = totLosses,
- complete = 1))
- } else if(totGames >= maxGames){ # You died of old age
- return(data.frame(
- div = div$div,
- wr = winRate,
- simNo = simNo,
- totGames = totGames,
- totWins = totWins,
- totLosses = totLosses,
- complete = 0))
- }
- } # While loop ends here
- }
- # Simulate an assload of games.
- # The time it takes to simulate depends on the total number of games which
- # is a function of the number of simulations for each divison*winRate combo
- # but also how low the win rate starts out at, as it will take longer to reach
- # either the cap (maxGames) or complete the tier.
- # Benchmarks on a 4770K:
- # 10 sims * seq(0,1,10) = 6000 sims = 1,322,343 in 22.22 secs = 59511.39/s
- # 30 sims * seq(0.5,1,20) = 108000 sims = 7,026,476 in 119.9 secs = 58602.8/s
- nSim <- 20 # Number of simulations to run
- results <- expand.grid( # Create a set of pairs to run (simplifies clusterMap)
- div = rules$div, # Unique combinations of division and...
- wr = seq(0.50, 1, length.out=25),
- simNo = 1:nSim) %>% # win rates...
- arrange(div, wr, simNo) %>% data.table # Order and convert to a data.table
- setkey(results, div, wr, simNo)
- nrow(results) * nSim # Total number of simulations
- # Export the data and functions
- stopCluster(cl) # Stop cluster if it exists
- cl <- makeCluster(8) # Create a cluster with 2x Physical cores
- clusterExport(cl, c('rules', 'results', 'simulateRun', '%>%', 'ldply'))
- simTimeStart <- Sys.time()
- simResults <- clusterMap(cl, function(div, wr, nSim){ # Simualte on each pair
- lapply(1:nSim, function(x){ # Simulate nSims times
- # Use the specified division/win rate
- simulateRun(div = div, winRate = wr, simNo = x)
- }) %>% ldply
- }, div = results$div, wr = results$wr, nSim = nSim) %>% ldply %>% data.table
- setkey(simResults, div, wr, simNo)
- simTimeEnd <- Sys.time()
- print(sprintf('Simulated %s games in %s minutes',
- sum(simResults$totGames),
- round(difftime(simTimeEnd, simTimeStart, units = 'mins'), 2)))
- # Combine the two sets and calculate some summary statistics
- results <- results[simResults, nomatch=0] # Join the two sets
- glimpse(results)
- summary(results)
- # Check that the number of minimum games is reasonable
- results %>%
- group_by(div) %>%
- filter(complete==1) %>%
- summarise(minWins=min(totGames))
- write.csv(results, paste0(
- 'Sim_results_',strftime(Sys.time(), '%m%d%y_%H%M%S'), '.csv'))
- # Summarise the data by division and win rate
- resGrp <- results %>%
- group_by(div, wr) %>%
- summarise(
- medGames = median(totGames),
- maxGames = max(totGames),
- minGames = min(totGames),
- meanGames = mean(totGames),
- sdGames = sd(totGames),
- uclGames = mean(totGames)+1.96*sd(totGames),
- LclGames = mean(totGames)-1.96*sd(totGames))
- resGrp
- # Number of games by win rate
- win_game_Plot <- ggplot(resGrp,
- aes(x = wr, y = medGames, fill = div, color = div, group = div)) +
- geom_line(size = 2) +
- facet_wrap(~div, scale='free') +
- scale_color_manual(values = rules$color) +
- ggtitle('Median Number of Games Needed to Rank Out of a Tier by Win Probability (Max 500 Tries)') +
- xlab('Probability of Winning') +
- ylab('Median Number of Games') +
- theme_bw()
- win_game_Plot
- # Stacked Area Chart
- stack_wins <- ggplot(resGrp,
- aes(x = wr, y = medGames, fill = div, group = div)) +
- geom_area(position = 'stack') +
- ggtitle('Median Number of Games Needed to Finish All Divisions by Win Probability') +
- xlab('Probability of Winning') +
- ylab('Median Number of Games') +
- scale_x_continuous(breaks = seq(0.45,1.0,0.05), limits = c(0.45,1)) +
- scale_fill_manual(values = rules$color) +
- theme_bw()
- stack_wins
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement