!__________________________________________________________________ !################################################################## ! ## High/Low Solitaire ## ! 4 Dec 1994 ! John Finn ! ! A boring game of solitaire, which I call High/Low, to show that ! 7 ordinary riffle shuffles, followed by a cut, of a 52-card deck ! are *not* enough to make every permutation equally likely. ! ! We start with a brand new deck of cards, which in America are ! ordered so that if we put the deck face-down on the table, ! we have ! Ace through King of Hearts, ! Ace through King of Clubs, ! King through Ace of Diamonds, ! King through Ace of Spades. ! Hearts and Clubs are thus the High suits, and Diamonds and Spades ! the Low. (Some would term these Yin and Yang, but not according ! to any scheme that I believe would satisfy Georges Osawa, who says ! that tomatoes and eggplants are both extremely yin because of ! their purple color.) ! ! We shuffle the deck of cards 7 times, then cut it, and then start ! removing and revealing each card from the top of the deck, making ! a new pile of them face-up (so if this were all we did, we'd just ! have the deck unchanged after going through it once, except that ! the deck would be lying face-up on the table). ! ! We start the pile for each suit when we discover its ace, and add ! cards of the same suit to each of these 4 piles, according to the ! rule that we must add the cards of each suit in order. ! ! Thus a single pass through the deck is not going to accomplish ! much in the way of completing the 4 piles, so having made this ! pass, we turn the remaining deck back over, and make another pass. ! ! We continue this until we complete either the two high piles ! (hearts & clubs), or the two low piles (diamonds & spades). ! If the high piles get completed first, we call the game a win; ! it's a loss if the low piles get completed first. ! ! If the deck has been thoroughly permuted (by having put the cards ! through a clothes dryer, say), then the lows and highs will be ! equally likely to be first to get completed. Thus our expected ! proportion of wins will be 1/2. ! ! But it turns out that after 7 shuffles and a cut, we are ! significantly more likely to complete the highs before the lows, ! so our proportion of wins will be greater than 1/2. ! ! This program begins by demonstrating a sample game. We see what ! the deck looks like after the shuffles and cut, and then see the ! pile sizes at the end of each pass through the deck, except that ! once one pile is full we look more closely, and see each addition ! to a pile. call SetUp call SampleGame do call GetInput call Reset call Simulate call Report loop !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ !__________________________________________________________________ sub SetUp dim riffle(0), cut(0), deck(0), dingDeck(0), pile(4) declare def suit, suit$, rank, rank$ read hearts, clubs, diamonds, spades data 1,2,3,4 read n, suits, ranks data 52, 4, 13 set zonewidth 10 end sub !------------------------------------------------------------------ !__________________________________________________________________ sub SampleGame call reset let showPiles = 1 call mRiffle(2^7, riffle()) call binomialCut(cut()) call compose(riffle(), cut(), deck()) print "Here's the deck after shuffling and cutting; by number:" for k = 1 to 52 let card = deck(k) print using ">###": str$(card); if int(k/18) = k/18 then print end if next k print ";" print "and by suit and rank:" for k = 1 to 52 let card = deck(k) print using ">###": rank$(rank(card)) & suit$(suit(card)); if int(k/18) = k/18 then print end if next k print print "(Hit any key to see how the game proceeds)."; get key kkk print " OK; here's the game:" print " Highs Lows" print "Hearts", "Clubs", "Diamonds", "Spades" call HighLow if pile(hearts) + pile(clubs) = 26 then print "*Highs win" else print "Lows win" end if end sub !------------------------------------------------------------------ !__________________________________________________________________ sub GetInput input prompt "Number of games: " : games end sub !------------------------------------------------------------------ !__________________________________________________________________ sub Reset mat riffle = zer(n) mat cut = zer(n) mat deck = zer(n) mat dingDeck = zer(n) end sub !------------------------------------------------------------------ !__________________________________________________________________ sub Simulate let showPiles = 0 let wins = 0 let start = time print "..."; for g = 1 to games if int(10*g/games) = 10*g/games then print str$(g); if g < games then print "..."; end if end if call mRiffle(2^7, riffle()) call binomialCut(cut()) call compose(riffle(), cut(), deck()) call HighLow next g let duration = time-start end sub !------------------------------------------------------------------ !__________________________________________________________________ ! HighLow ! ! Plays the game of High/Low, as described in the introductory ! comments. This is greatly complicated here by including options ! to print out the progress of the game if showPiles = 1, in which ! case we print the pile sizes at the end of each pass through the ! deck, or, once one pile is full, as each pile is added to. ! sub HighLow mat dingDeck = deck mat pile = zer let PilesDone = 0 do for k = 1 to n let card = dingDeck(k) if card > 0 then let thisRank = rank(card) let thisSuit = suit(card) if thisRank = pile(thisSuit) + 1 then let dingDeck(k) = 0 let pile(thisSuit) = pile(thisSuit) + 1 if pile(thisSuit) = 13 then let PilesDone = PilesDone + 1 if PilesDone >= 1 and showPiles = 1 then for j = 1 to 4 print pile(j), next j if PilesDone = 1 then print "<--- First pile completed."; end if end if if thisSuit <= 2 then let sisterSuit = 3-thisSuit else let sisterSuit = 7-thisSuit end if if pile(sisterSuit) = 13 then exit do else if showPiles = 1 then print end if end if end if end if next k if showPiles = 1 then for j = 1 to 4 print pile(j), next j print end if loop if pile(hearts) + pile(clubs) = 26 then let wins = wins + 1 end if end sub !------------------------------------------------------------------ !__________________________________________________________________ sub Report print print "Wins = "; str$(wins) & "; "; print "Proportion of wins ="; wins/games print "Time taken = "; duration print end sub !------------------------------------------------------------------ end !################################################################## !__________________________________________________________________ !****************************************************************** ! ** suit(card) ** ! ! The suit of a card in a the standard American deck, counting from ! the top card when the deck is face-down. The standard American ! deck goes ! Ace through King of Hearts, ! Ace through King of Clubs, ! King through Ace of Diamonds, ! King through Ace of Spades, ! ! so we're calling Hearts, Clubs, Diamonds and Spades suits 1,2,3,4. ! def suit(card) let suit = int((card-1)/13) + 1 end def !------------------------------------------------------------------ !__________________________________________________________________ !****************************************************************** ! ** suit$(suit) ** ! Gives the label for each of the 4 suits. ! def suit$(suit) select case suit case 1 let suit$ = "H" case 2 let suit$ = "C" case 3 let suit$ = "D" case 4 let suit$ = "S" end select end def !------------------------------------------------------------------ !__________________________________________________________________ !****************************************************************** ! ** rank(card) ** ! ! The rank of a card in a the standard American deck, counting from ! the top card when the deck is face-down. ! The standard American ! deck goes ! Ace through King of Hearts, ! Ace through King of Clubs, ! King through Ace of Diamonds, ! King through Ace of Spades, ! ! so we're calling Hearts, Clubs, Diamonds and Spades suits 1,2,3,4. ! def rank(card) if card <= 26 then let rank = mod(card-1, 13)+1 else let rank = mod(52-card, 13)+1 end if end def !------------------------------------------------------------------ !__________________________________________________________________ !****************************************************************** ! ** rank$(rank) ** ! ! Gives the label for each rank. ! def rank$(rank) if rank = 1 then let rank$ = "A" else if rank <= 10 then let rank$ = str$(rank) else select case rank case 11 let rank$ = "J" case 12 let rank$ = "Q" case 13 let rank$ = "K" end select end if end def !------------------------------------------------------------------ !__________________________________________________________________ !****************************************************************** ! ** sub mRiffle(m, permutation()) ** ! ! Gives the permutation on n things that you get by rolling a fair ! m-sided die n times, and ...well, and going like this: for a ! 3-shuffle of a deck of 10 cards, suppose we roll ! 1 0 2 1 2 2 1 0 1 1. ! We think of this as indicating the deck cut into 3 packets, ! and then riffled together according to the way the 0's, 1's, ! and 2's are intertwined. If we use 1 to 10 to mean the top card ! down to the bottom card, then the two 0's here are the top two ! cards, i.e. cards 1 and 2, and they've wound up in positions 2 ! and 8. Thus we have ! ! 1 3 (top card) ! 0 1 ! 2 effects the 8 ! 1 permutation 4 ! 2 9 ! 2 10 ! 1 5 ! 0 2 ! 1 6 ! 1 7 ! ! If m = 2^k, this turns out to be equivalent to doing an ordinary ! shuffle k times. ! sub mRiffle(m, permutation()) dim roll(0) let n = size(permutation) mat redim roll(n) for k = 1 to n let roll(k) = int(m*rnd) next k let card = 1 for face = 0 to m-1 for k = 1 to n if roll(k) = face then let permutation(k) = card let card = card + 1 end if next k next face end sub !================================================================== !__________________________________________________________________ !****************************************************************** ! ** sub binomialCut(permutation()) ** ! ! For a deck of 10 cards, say, we get a binomial cut by tossing a ! fair coin 10 times, and letting the number of heads tell where ! to cut the deck. If we get 4 heads, for instance, then the ! permutation is ! ! 5 ! 6 ! 7 ! 8 ! 9 ! 10 ! 1 ! 2 ! 3 ! 4 ! sub binomialCut(permutation()) let n = size(permutation) let heads = 0 for k = 1 to n if rnd < 1/2 then let heads = heads + 1 end if next k let cut = heads for k = 1 to n-cut let permutation(k) = k + cut next k for k = n-cut + 1 to n let permutation(k) = k+cut-n next k end sub !=================================================================== !__________________________________________________________________ !****************************************************************** ! ** sub compose(sigma(), tau(), sigmaThenTau()) ** ! ! Gets the composition of two permutations. ! sub compose(sigma(), tau(), sigmaThenTau()) let n = size(sigma) for k = 1 to n let sigmaThenTau(k) = sigma(tau(k)) next k end sub !=================================================================