!__________________________________________________________________
!##################################################################
! ## 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
!=================================================================