Simulated War
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
I am quite interested in both Wars with sabres and Sabremetric WARs but the War I am most involved in is the card game. Unfortunately, it is one my six year old favourites and he is quite happy to while away the hours (literally) playing it with anyone pressganged into joining him I must admit that – conscientous objector that I am – whenever a war is underway and my sons attention is elsewhere I try to slip a low card to the top of my pile which has the double attraction of both making it more likely that he wins and speeding up the conclusion of hostilities. However, I thought it might be interesting to see how long games would take without such intervention by attempting to code the process and do a simulation I often use R for analysis towards blog posts and in this instance thought it might be worthwhile showing my code. No doubt there are several improvements that could be suggested . The wiki article does post simulation results but the game I play has a couple of variations making comparisons more interesting The first thing to do is to create a deck (I have used numbers 11 through 14 for JQKA)
# create a regular deck. # All suits are equivalent so there will be four of each number deck <- rep(2:14,4) |
Then a random sample is provided to each player(p1,p2). The first 26 are pretty simple. However, the setdiff function in base R does not seem to handle duplicates so I utilized the package ‘sets’. Even that was a little tricky but as usual the answer to a stackoverflow query set me on the right track
# make results reproducible
# set.seed(1066)
assign("p1", sample(deck,26, replace=FALSE))
diffs <- gset_difference(as.gset(deck), as.gset(p1))
# create vector
p2 <- rep(unlist(diffs), times=gset_memberships(diffs))
# this produces the right cards but in order so randomize
assign("p2", sample(p2,26, replace=FALSE))
p1
# [1] 3 3 6 14 10 13 3 10 12 5 11 8 2 5 8 4 10 5 8 4
# [21] 8 7 7 7 9 14
p2
# [1] 12 6 9 5 9 9 13 4 2 14 4 13 13 6 6 11 7 11 12 2
# [21] 10 3 2 11 12 14 |
In the analysis, I may be interested in the starting conditions of each player’s hand so I need to compute the overall value, the number of aces and – as 2′s trump aces in my variation – dueces. Only one players data is required but I will need to add the result after each game. For now I put in a “N” value
p1Cards <- length(p1) strength <- sum(p1) # 196 total of players is always 416 so p2 has stronger hand aces <- sum(p1==14) # 2 deuces <- sum(p1==2) # 1 result <- "N" game <- data.frame(id=i, strength=strength,aces=aces,deuces=deuces,result=result, stringsAsFactors=FALSE) draw <- c(p1[1],p2[1]) booty <- c() |
Now the game can start as the top card in each players deck is drawn. There are three outcomes. Either one of the players has the higher card and wins the battle or it is a tie – and a war ensues. Here p1 draws a 3 ad p2 a Queen(12) so p2 takes the drawn cards and adds them to the bottom of his deck. Here is the relevant code
if (p2[1]>p1[1]) {
p2 <- c(p2[-1],draw)
p1 <- p1[-1]
} |
Of course the code needs to take account of the occasion when p1′s card is higher. There is also the wrinkle mentioned above where an Ace is trumped by a 2. Open box to see full code
if (p1[1]>p2[1]) {
if (p1[1]==14&p2[1]==2){ # ace(14) vs a 2
p2 <- c(p2[-1],draw)
p1 <- p1[-1]
} else {
p1 <- c(p1[-1],draw)
p2 <- p2[-1]
}
} else if (p2[1]>p1[1]) {
if (p2[1]==14&p1[1]==2){
p1 <- c(p1[-1],draw)
p2 <- p2[-1]
} else {
p2 <- c(p2[-1],draw)
p1 <- p1[-1]
}
} |
The ‘fun’ starts when the cards match – which in this simulation does not occur until their final cards which are both aces. In this scenario, a variation from the wiki version, the matched cards and 3 more cards from each player form a ‘bounty’. The next card in each pack is then compared and the winner takes all 10 cards. If the cards match again the war scenario is repeated until one player proves victorious. There is also the possibility that one of the players runs out of cards and forfeits the game
# keep running until displayed cards do not match
while (p1[1]==p2[1]) {
# need at least 5 cards to play game
if (length(p1)<5|length(p2)<5) {
break
}
# displayed card plus next three from each player
booty <- c(booty,p1[1],p1[2],p1[3],p1[4],p2[1],p2[2],p2[3],p2[4])
# remove these cards from the p1,p2 so that new p1[1] is next shown
p1 <- p1[-(1:4)]
p2 <- p2[-(1:4)]
}
draw <- c(p1[1],p2[1])
if (p1[1]>p2[1]) {
p1 <- c(p1[-1],booty,draw)
p2 <- p2[-1]
} else {
p2 <- c(p2[-1],booty,draw)
p1 <- p1[-1]
} |
This scenario is repeated until one player is out of cards and the game is over. According to the wiki article, there is the possibility of an infinite loop being established so action is required to avoid that circumstance. Here is the relevant code
# keep running total of deck size
p1Cards <- c(p1Cards,length(p1))
# test for game over
if(length(p1)==52|length(p1)==0){
break
}
# avoid infinite loop
if (length(p1Cards) > 5000) {
break
}
# reset for next iteration
booty <- c()
draw <- c(p1[1],p2[1]) |
After each game, I wish to record both the summary details and the trend in deck size
# First calculate result and add to df
if (max(p1Cards)<52) {
p1Cards <- -(p1Cards-52)
game$result = "L"
} else {
game$result = "W"
}
games <- rbind(games,game)
deckSize <- data.frame(i,p1Cards)
deckSizes <- rbind(deckSizes,deckSize) |
The final stage is to simulate this repeatedly – I settled on 1000 – and save the data for subsequent analysis and a future blog post The full code is given below
# Code for replicating War card Game
# Andrew Clark April 01 2012
library(sets)
# make simulation replicable
set.seed(1068)
games <- data.frame(id=numeric(), strength=numeric(),aces=numeric(),deuces=numeric(),result=character())
deckSizes <- data.frame(id=numeric(),details=numeric())
i <- 1
for (i in 1:10) {
# create a regular deck.
# All suits are equivalent so there will be four of each number
deck <- rep(2:14,4)
# make results reproducible - no longer required here
# set.seed(1066)
assign("p1", sample(deck,26, replace=FALSE))
diffs <- gset_difference(as.gset(deck), as.gset(p1))
# create vector
p2 <- rep(unlist(diffs), times=gset_memberships(diffs))
# this produces the right cards but in order so randomize
assign("p2", sample(p2,26, replace=FALSE))
p1
# [1] 3 3 6 14 10 13 3 10 12 5 11 8 2 5 8 4 10 5 8 4
# [21] 8 7 7 7 9 14
p2
# [1] 12 6 9 5 9 9 13 4 2 14 4 13 13 6 6 11 7 11 12 2
# [21] 10 3 2 11 12 14
p1Cards <- length(p1)
strength <- sum(p1) # 196 total of players is always 416 so p2 has stronger hand
aces <- sum(p1==14) # 2
deuces <- sum(p1==2) # 1
result <- "N"
game <- data.frame(id=i, strength=strength,aces=aces,deuces=deuces,result=result, stringsAsFactors=FALSE)
draw <- c(p1[1],p2[1])
booty <- c()
repeat { # for each match of cards
if (p1[1]>p2[1]) {
if (p1[1]==14&p2[1]==2){ # ace(14) vs a 2
p2 <- c(p2[-1],draw)
p1 <- p1[-1]
} else {
p1 <- c(p1[-1],draw)
p2 <- p2[-1]
}
} else if (p2[1]>p1[1]) {
if (p2[1]==14&p1[1]==2){
p1 <- c(p1[-1],draw)
p2 <- p2[-1]
} else {
p2 <- c(p2[-1],draw)
p1 <- p1[-1]
}
} else {
while (p1[1]==p2[1]) {
# need at least 5 cards to play game
if (length(p1)<5|length(p2)<5) {
break
}
# displayed card plus next three from each player
booty <- c(booty,p1[1],p1[2],p1[3],p1[4],p2[1],p2[2],p2[3],p2[4])
# remove these cards from the p1,p2 so that new p1[1] is next shown
p1 <- p1[-(1:4)]
p2 <- p2[-(1:4)]
}
draw <- c(p1[1],p2[1])
if (p1[1]>p2[1]) {
p1 <- c(p1[-1],booty,draw)
p2 <- p2[-1]
} else {
p2 <- c(p2[-1],booty,draw)
p1 <- p1[-1]
}
}
# battle over
# keep running total of deck size
p1Cards <- c(p1Cards,length(p1))
# test for game over
if(length(p1)==52|length(p1)==0){
break
}
# avoid infinite loop
if (length(p1Cards) > 5000) {
break
}
# reset for next iteration
booty <- c()
draw <- c(p1[1],p2[1])
}
# war over
if (max(p1Cards)<52) {
p1Cards <- -(p1Cards-52)
game$result = "L"
} else {
game$result = "W"
}
games <- rbind(games,game)
deckSize <- data.frame(i,p1Cards)
deckSizes <- rbind(deckSizes,deckSize)
}
# save for later analysis
write.table(games,"games1000random.csv")
write.table(deckSizes,"deckSizes1000random.csv") |
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.