GW2 PvP Division Simulation

# 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