world of tanks Christmas box gambling simulation 2022

#benchmark
start.time <- Sys.time()

library(ggplot2)
library(reshape2)
#multi core
library(future.apply)
# more then 4 workers is slower
plan(multisession, workers = 12)
#################################

ntries <- 100000
#25,28,75,80,
nboxes <- c(200,400,600)
#nboxes <- c(200)
#################################


results_high_tier_prop_table <- as.list(nboxes)
results_low_tier_prop_table  <- as.list(nboxes)
names(results_high_tier_prop_table) <- as.character(nboxes)
names(results_low_tier_prop_table) <- as.character(nboxes)

# old game function only calc high tier prem
# nbig_box number of big boxes
# success_chance, is_safety_mechanic_active, npremium_tank_limit can be changed for the low tier tank calculation

game_simulation <- function(nbig_box, success_chance = 0.024,is_safety_mechanic_active = TRUE, npremium_tank_limit = 30){
  npremium_tank <- 0
  safety_mechanic_counter <- 50 # number of fails until guaranteed tank
  rolls <- runif(nbig_box,0,1) # generate all random number at once is faster
  for (roll in rolls){
    if (roll <= success_chance){ # lucky
      npremium_tank <- npremium_tank + 1
      safety_mechanic_counter <- 50
    } else { #unlucky
      safety_mechanic_counter <- safety_mechanic_counter - 1

    }
    if (isTRUE(is_safety_mechanic_active) & safety_mechanic_counter == 0){ # if very unlucky you get a prem
      npremium_tank <- npremium_tank + 1
      safety_mechanic_counter <- 50
    }
    if (npremium_tank >= npremium_tank_limit){
      break
    }
  }
  return (npremium_tank)

}



#only one of those events can happen at the same time
#skin drop happens independent from those events, we don't care about skin here
events = c("prem_day_1","prem_day_3","prem_day_7","gold_250","gold_500","gold_1000","credit_100k","credit_500k","low_tier_tank","high_tier_tank")
event_chances = c(0.270,0.08,0.025,0.15,0.0494,0.015,0.20,0.070,0.1166,0.024 )

#main simulation
#count all rewards we can get from nbig_box
game_simulation2 <- function(nbig_box){
  npremium_low_tier_tank <- 0
  npremium_high_tier_tank <- 0
  npremium_day <- 0
  ngold <- nbig_box*250
  ncredit <- 0

  safety_mechanic_counter <- 50 # number of fails until guaranteed tank
  rolls <- sample(events, size = nbig_box, replace = TRUE, prob = event_chances)
  for (roll in rolls){
    if (roll == "high_tier_tank") {
      npremium_high_tier_tank <- npremium_high_tier_tank + 1
      safety_mechanic_counter <- 50
    } else {
      safety_mechanic_counter <- safety_mechanic_counter - 1

      if (safety_mechanic_counter == 0){ # if very unlucky you get a prem
        npremium_high_tier_tank <- npremium_high_tier_tank + 1
        safety_mechanic_counter <- 50
      }else if(roll =="prem_day_1"){
        npremium_day <- npremium_day + 1
      }else if(roll =="prem_day_3"){
        npremium_day <- npremium_day + 3
      }else if(roll =="prem_day_7"){
        npremium_day <- npremium_day + 7
      }else if(roll =="gold_250"){
        ngold <- ngold +250
      }else if(roll =="gold_500"){
        ngold <- ngold +500
      }else if(roll =="gold_1000"){
        ngold <- ngold +1000
      }else if(roll =="credit_100k"){
        ncredit <- ncredit+100000
      }else if(roll =="credit_500k"){
        ncredit <- ncredit+500000
      }else if(roll =="low_tier_tank"){
        npremium_low_tier_tank <- npremium_low_tier_tank+1
      }
    }

  }


  result <- list()
  result$npremium_low_tier_tank <- npremium_low_tier_tank
  result$npremium_high_tier_tank <- npremium_high_tier_tank
  result$npremium_day <- npremium_day
  result$ngold <- ngold
  result$ncredit <- ncredit
  return (result)

}


game_simulation_high_tier_tank <- function(nbig_box){
  result <-game_simulation2(nbig_box)
  return (result$npremium_high_tier_tank)
}

game_simulation_low_tier_tank <- function(nbig_box){
  result <-game_simulation2(nbig_box)
  return (result$npremium_low_tier_tank)
}

game_simulation_gold_no_prem <- function(nbig_box){
  result <-game_simulation2(nbig_box)
  return (result$ngold)
}
game_simulation_gold_with_prem <- function(nbig_box){
  result <-game_simulation2(nbig_box)

  ngold <- result$ngold
  ngold <- ngold + max(result$npremium_high_tier_tank-5,0)*(9100+9900+9500+9950+9850)/5
  ngold <- ngold + max(result$npremium_low_tier_tank-5,0)*(750+850+1000+1500+1500)/5
  return (ngold)
}

###############################
#main function
for (z in seq_along(nboxes)){
  nbox <-nboxes[z]
  print(nbox)
  tries <- future_replicate(n=ntries,game_simulation2(nbox))
  tries_mat <-matrix(unlist(tries), ncol=5,byrow=TRUE)
  #print(attributes(tries_mat))
  colnames(tries_mat)<- c("npremium_low_tier_tank","npremium_high_tier_tank","npremium_day","ngold","ncredit")
  #print(tries_mat[1:9,c("npremium_low_tier_tank","npremium_high_tier_tank","npremium_day","ngold")])
  result_high_tier_prop_table <- rep(0,30)
  result_low_tier_prop_table <- rep(0,50)
  #tb <- table(tries) / length(tries) # compute probabilities
  high_tier_prop_table <- prop.table(table(tries_mat[,"npremium_high_tier_tank"]))
  #tb <- rev(cumsum(rev(tb)))
  result_high_tier_prop_table[as.integer(names(high_tier_prop_table)) + 1] <- high_tier_prop_table #tidy up

  results_high_tier_prop_table[[z]] <- result_high_tier_prop_table

  cat(nbox, "npremium_day", mean(tries_mat[,"npremium_day"]),"\n")
  cat(nbox, "ncredit", mean(tries_mat[,"ncredit"]),"\n")
  low_tier_prop_table <- prop.table(table(tries_mat[,"npremium_low_tier_tank"]))
  result_low_tier_prop_table[as.integer(names(low_tier_prop_table)) + 1] <- low_tier_prop_table #tidy up

  results_low_tier_prop_table[[z]] <- result_low_tier_prop_table
}

##########################
#output
print("output")
mat_high_tier <- as.data.frame(do.call(rbind, results_high_tier_prop_table))
names(mat_high_tier) <- as.character(0:(ncol(mat_high_tier) -1))
mat_high_tier <- cbind(rownames(mat_high_tier), mat_high_tier)
names(mat_high_tier)[1] <- "nboxes"
mat_high_tier <- mat_high_tier[1:25]

melted_high_tier <- melt(mat_high_tier, id.vars = "nboxes")
melted_high_tier$nboxes <- factor(melted_high_tier$nboxes, levels = nboxes)


mat_low_tier <- as.data.frame(do.call(rbind, results_low_tier_prop_table))
names(mat_low_tier) <- as.character(0:(ncol(mat_low_tier) -1))
mat_low_tier <- cbind(rownames(mat_low_tier), mat_low_tier)
names(mat_low_tier)[1] <- "nboxes"
mat_low_tier <- mat_low_tier[1:50]
#print(mat_low_tier)
melted_low_tier <- melt(mat_low_tier, id.vars = "nboxes")
melted_low_tier$nboxes <- factor(melted_low_tier$nboxes, levels = nboxes)


#draw
p<-ggplot(data=melted_high_tier, aes(x=variable, y=value, fill=nboxes)) +
  geom_bar(stat="identity", position = "dodge") +
  labs(x = "Number of T8/9 premium", y = "Probability", fill = "Number of Boxes") +
  scale_y_continuous(breaks = seq(0, 1, len = 21))

ggsave("high_tier_premium_tank.png", p)



p<-ggplot(data=melted_low_tier, aes(x=variable, y=value, fill=nboxes)) +
  geom_bar(stat="identity", position = "dodge") +
  labs(x = "Number of low tier premium", y = "Probability", fill = "Number of Boxes") +
  scale_y_continuous(breaks = seq(0, 1, len = 21))

ggsave("low_tier_premium_tank.png", p)

#draw end

for (z in seq_along(nboxes)){
  nbox <-nboxes[z]
  #print(nbox)
  ngold <- future_replicate(n=ntries,game_simulation_gold_with_prem(nbox))
  cat("number of boxes:", nbox, "average gold: ", mean(ngold),"\n")
  }


#benchmarking end
end.time <- Sys.time()
time.taken <- end.time - start.time
time.taken
###