Simulating the card game War with $m$ suits and $n$ values

Question

I am trying to simulate the card game War to find approximations to the stopping time distribution for different types of decks, and study conditional probabilities of winning given a certain deck. (Maybe 3, 5, or 20 suits instead of the conventional 4).

This problem is fairly recursive, because if a War occurs, and it ends with a tie, there is another war. A war starts when two competing cards are equal in value.

I am pretty sure that the comparison function needs to be fixed the most. I can't seem to get to Mathematica reassign the variables within the function.

Here is the code I wrote so far:

        messageHandler = If[Last[#],Abort[]] & ;Internal`AddHandler["Message", messageHandler];$Messages = {};$Post = Function[Null, Unevaluated@# /. $Aborted -> Null, HoldAllComplete];
    Deck[suits_, values_] := 
      RandomSample[
        Flatten[
          Table[
            Table[{suit, value}, {value, 1, values}],
            {suit, 1, suits}
          ],
        1
      ]
    ];

    comparisonFunction[consecutiveWars_,increment_,battleAmount_,warAmount_,list1_,list2_]:=
Which[list1[[increment,2]]<list2[[increment,2]],consecutiveWars=0;

list1=RandomSample[Join[list1,list2[[1;;increment]]]];
list2=Drop[list2,increment],list1[[increment,2]]>list2[[increment,2]],consecutiveWars=0;
list2=RandomSample[Join[list2,list1[[1;;increment]]]];
    list1=Drop[list1,increment],list1[[increment,2]]==list2[[increment,2]],consecutiveWars=consecutiveWars + 1;
    increment=consecutiveWars*warAmount;
    comparisonFunction[consecutiveWars,increment,battleAmount,warAmount,list1,list2]];
    commenceWarCardGame[consecutiveWars_,increment_,battleAmount_,warAmount_,list1_,list2_]:=
untilCount=0;minimumHandLength=Min[Length[list1],Length[list2]];
Until[minimumHandLength <= 0||untilCount==maximumStoppingTime,minimumHandLength=Min[Length[list1],Length[list2]];
comparisonFunction[consecutiveWars,increment,battleAmount,warAmount,list1,list2];untilCount++]

    warGameSimulation[consecutiveWars_,suits_,values_,battleAmount_,warAmount_,maximumStoppingTime_]:=
(deck=Deck[suits,values];
If[EvenQ[Length[deck]]==True,player1Hand=deck[[1;;Length[deck]/2]];
player2Hand=deck[[Length[deck]/2+1;;Length[deck]]];
commmenceWarCardGame[consecutiveWars, suits, values, battleAmount, warAmount, maximumStoppingTime],Print["Deck length is not even."]])

The first line is just to help ignore error messages. It is not related to the actual game simulation. The second line generates a random deck with $m-suits$ and $n-values$. The comparison function compares the value of the cards to presented by the players, then is supposed to add the cards to the winner, while taking them away from the loser. The commenceWarCardGame is supposed to run the program until the cards runs out or the stopping time takes too long. The last function just puts them all together, checks if the deck can be split evenly. Then commences the game if it can be split evenly.

In real life, the card game is a game of elimination. Once one player has all of the cards or at least one of the players cannot play anymore, the game is over.

It was mentioned in the comments that I cannot put a function inside of a function like I tried to do for the comparison function.

Answer 1

This isn't so much an answer as pedagogy.

The main reason you can't get your commenceWarCardGame to work is because most of the code in that block isn't part of the definition. Try this:

?? commenceWarCardGame

You'll see that only the untilCount = 0 bit made it into the definition. In Mathematica, semi-colons are syntactic sugar for CompoundExpression, and they are very low precedence. So, your SetDelayed is actually just one of many expressions in the larger block instead of being the top-level expression that contains all of the following block.

It also seems like you're taking a very imperative approach (although I honestly don't grok your strategy). But the game of war can be seen as just repeatedly applying an operation to some data structures. The data structures are primarily just the hands, i.e. lists of cards. But because of the tie-battle scenario, we would also need to add a structure to hold the cards in contention. You might call that the pot, and so the main function signature might look like

War[pot_, hands_] := ...

What this function does is do some comparison with the lead cards and then append the lead and pot cards to the end of one of the hands. You can use recursion (so War will show up on the right hand side), and you'll need a terminal case.

The terminal case will be when there's only one non-empty hand. You'll need a case for handling a tie for best card, and you'll need a case for handling uncontested best card. The terminal case can be done by just inspecting the hands. The contested case will move all first&second cards to the pot and try again with the third cards. The uncontested case needs to determine which hand's first card won and move all first cards & pot cards to that hand's tail.

Putting it together

Deck[suits_, values_?(AllTrue[NonNegative])] := Tuples[{suits, values}]

Tuples is simpler than your nested tables. I'm making sure that all values/denominations are non-negative, because later on I'll need to do some sorting and ordering for empty-hand cases, and I want to use -1 for the value of the "null" card.

standardDeck = Deck[{"hearts", "spades", "diamonds", "clubs"}, Range[13]]

No need to mess with Jack, Queen, King, and Ace, but if you want a nice mapping to the "real" values, you can add that.

DealDeck[deck_, handCount_] := 
  Take[Partition[RandomSample[deck], Quotient[Length@deck, handCount]], handCount];

This randomizes and creates a number of equally sized hands. Leftover cards are just not used. The extra Take is there to handle the degenerate case where the hand size would end up being 1 card, and so the partitioning could create too many hands.

Now we get to the meat.

Here is the terminal case:

War[pot_, hands_] := 
  Insert[
    hands, 
    Splice[pot], 
    {FirstPosition[hands, {{__} ..}, {1}][[1]], -1}] /; 
Count[hands, {}] + 1 >= Length[hands]

We need to choose the final representation when the game is over. I decided just return all of then hands. All but one will be empty. But we need to handle the pot, because it's possible that one of the contested battles depleted some hands, and those cards need to go to the winner. The condition is simply that there is only one non-empty hand, which is equivalent to there being a number of {} hands equal to one less than the total number of hands.

At this point, I find it easier to handle the contested case, because we just move stuff to the pot and recurse.

War[pot_, hands_] :=
  With[
    {newPot = RandomSample[Join[pot, Flatten[Take[hands, All, UpTo[2]], 1]]]},
    War[newPot, Drop[#, UpTo[2]] & /@ hands]] /; 
1 < Length[MaximalBy[DeleteCases[hands, {}][[All, 1]], Last]]

Suits don't matter, so we just compare the Last of the first cards. We need to be careful about empty hands, though. We'll just ignore them for this check. So, in the tied-for-max card, we just "slice off" the first two cards in every hand (using UpTo to avoid errors with short hands), randomize them, put them into the pot, and recurse with the remaining tails of the hands.

Now we need to handle the uncontested case.

War[pot_, hands_] :=
  With[
    {newPot = RandomSample[Join[pot, Flatten[Take[hands, All, UpTo[1]], 1]]],
     maxHandPosition = OrderingBy[Flatten[Take[hands /. {} -> {{Null, -1}}, All, 1], 1], Last, -1]},
    War[{}, Insert[Drop[#, UpTo[1]] & /@ hands, Splice[newPot], {maxHandPosition[[1]], -1}]]]

There's a lot to unpack, but basically we find the index of the winning hand (taking care to not just ignore empty hands this time, because that could change the indexing) and put the won cards at the end of that winning hand.

Let's actually add a convenience definition:

War[hands_] := War[{}, hands]

Now we're ready to try it out. I'll specify a random seed so you can reproduce the result, and I'll use a small deck to save space.

SeedRandom[17];
testHands = DealDeck[Deck[{"hearts", "spades", "diamonds", "clubs"}, Range[4]], 3];
War[testHands]

{{{"hearts", 1}, {"spades", 1}, {"hearts", 4}, {"diamonds", 1}, {"clubs", 1}, {"hearts", 2}, {"clubs", 4}, {"diamonds", 3}, {"diamonds", 4}, {"spades", 2}, {"spades", 3}, {"spades", 4}, {"clubs", 3}, {"diamonds", 2}, {"hearts", 3}}, {}, {}}

So, with those three starting hands, the first player won.

In the following case, the second player won:

SeedRandom[19];
testHands = DealDeck[Deck[{"hearts", "spades", "diamonds", "clubs"}, Range[4]], 3];
War[testHands]

{{}, {{"spades", 2}, {"spades", 4}, {"clubs", 3}, {"diamonds", 4}, {"hearts", 1}, {"hearts", 4}, {"diamonds", 3}, {"clubs", 2}, {"spades", 1}, {"diamonds", 2}, {"spades", 3}, {"clubs", 4}, {"hearts", 2}, {"clubs", 1}, {"diamonds", 1}}, {}}

There is a possible weird scenario if none of the players battling in a tie scenario has sufficient cards. The first player will win in that case regardless. Probably should update the terminal case to handle that...

Answer 2

Here is a link to some code I wrote to simulate the game. No guarantees. FWIW, it shows a tally of lengths of games for various shuffled decks. Some of these lead to games without ends.

https://www.dropbox.com/s/86pvkd48373l2lh/for%20StackExchange.nb?dl=0