(*^
::[ Information =
"This is a Mathematica Notebook file. It contains ASCII text, and can be
transferred by email, ftp, or other text-file transfer utility. It should
be read or edited using a copy of Mathematica or MathReader. If you
received this as email, use your mail application or copy/paste to save
everything from the line containing (*^ down to the line containing ^*)
into a plain text file. On some systems you may have to give the file a
name ending with ".ma" to allow Mathematica to recognize it as a Notebook.
The line below identifies what version of Mathematica created this file,
but it can be opened using any other version as well.";
FrontEndVersion = "Macintosh Mathematica Notebook Front End Version 2.2";
MacintoshStandardFontEncoding;
fontset = title, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e8, 24, "Times";
fontset = subtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e6, 18, "Times";
fontset = subsubtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, e6, 14, "Times";
fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, a20, 18, "Times";
fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, a15, 14, "Times";
fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, a12, 12, "Times";
fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times";
fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, L-5, 12, "Courier";
fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier";
fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, R65535, L-5, 12, "Courier";
fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5, 12, "Courier";
fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, B65535, L-5, 12, "Courier";
fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, 12, "Courier";
fontset = name, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, 10, "Geneva";
fontset = header, inactive, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = leftheader, inactive, L2, 12, "Times";
fontset = footer, inactive, noKeepOnOnePage, preserveAspect, center, M7, 12, "Times";
fontset = leftfooter, inactive, L2, 12, "Times";
fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Times";
fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 12, "Times";
paletteColors = 128; automaticGrouping; currentKernel;
]
:[font = input; initialization; preserveAspect]
*)
(* The following procedure performs an a-shuffle on a deck of
cards. The variable 'deck' represents the number of cards in
the deck. The 'print' option displays some information such as
the base a number which corresponds to the shuffle. To simulate
k riffle shuffles, set a = 2^k. For more information, consult
the article by Brad Mann or the section on shuffling in
Introduction to Probability, by J. Laurie Snell and Charles M.
Grinstead.
*)
Clear[AShuffle];
AShuffle[a_, deck_, print_] :=
Block[{n = Length[deck],
ndigitbaseanumber = {},
rand,
actualdigits = {},
outputdeck = Table[0, {i, 1, Length[deck]}],
i,
m,
currentdigit,
pointer = 1,
j
},
For[i = 1, i <= n, i++,
rand = Random[Integer, {0, a-1}];
ndigitbaseanumber =
Append[ndigitbaseanumber, rand];
];
If[print,
Print["n digit base a number representing shuffle = ",
ndigitbaseanumber]
];
actualdigits = Union[Sort[ndigitbaseanumber]];
m = Length[actualdigits];
If[print,
Print["digits which occur = ", actualdigits]
];
For[i = 1, i <= m, i++,
currentdigit = actualdigits[[i]];
For[j = 1, j <= n, j++,
If[(ndigitbaseanumber[[j]] == currentdigit),
Block[{},
outputdeck[[j]] =
deck[[pointer]];
pointer++
]
];
];
];
If[print,
Print["deck after shuffling: ", outputdeck]
];
Return[outputdeck]
]
(*
:[font = input; initialization; preserveAspect]
*)
(* The procedure newdeck creates a list which represents
a deck of 4*k cards, in the order in which new decks
arrive from the factory. We assume that there are k cards
in each suit. Hearts and clubs are labelled from
1 to k and from k+1 to 2*k, respectively (with
aces being 1, etc.) and diamonds and spades are
labelled from 3*k+1 to 4*k and from 2*k+1 to 3*k,
respectively. In the two-suit version of this game, one
can use the same procedure, if one thinks of the suits
as being labelled from 1 to 2*k and from 2*k+1 to 4*k. *)
newdeck[k_] := Block[{i},
Return[Join[Table[i, {i, 1, 2*k}],
Table[i, {i, 4*k, 2*k+1, -1}]
]
]
]
(*
:[font = input; initialization; preserveAspect]
*)
(* This procedure simulates the solitaire game Yin & Yang,
and returns True if clubs and hearts win, and False
if diamonds and spades win. The variable 'numcards'
is the number of cards in the deck. We assume that
there are 4 suits of equal size, so numcards must
be a multiple of 4. To print out the piles as they
are being built, set 'print' to True. There is also a
cut built into the game, which is binomially distributed
with parameters 'numcards' and 1/2.
*)
YinYang[deck_, numcards_, print_] :=
Block[{found = False,
which,
internaldeck = deck,
cardsinsuit = numcards/4,
topofpiles = {0,cardsinsuit, 2*cardsinsuit,
3*cardsinsuit
},
currentindex = 0,
localfound = False,
m
},
(* We first perform the cut.
*)
For[m = 1, m <= numcards, m++,
If[(Random[] < .5),
currentindex++
];
];
While[!found,
currentindex++;
(* Update the pointer to the next card
being considered.
*)
If[(currentindex > Length[internaldeck]),
currentindex = 1
];
(* The variable localfound is set to true every time a card is
found which goes on top of one of the piles. If this variable
is True, then no other piles are checked for that card (since
of course the card only goes on one pile).
*)
localfound = False;
(* Check the current card against the tops of
the four piles.
*)
For[i = 1, i <= 4, i++,
(* The first condition in the if statement below
says that we should ignore a pile if it is already full.
*)
If[(!(topofpiles[[i]] == cardsinsuit*i)&&
(internaldeck[[currentindex]] ==
topofpiles[[i]]+1) && !(localfound)),
Block[{},
internaldeck =
Delete[internaldeck, currentindex];
topofpiles[[i]]++;
(* In preparation for an update of the pointer,
we decrement the pointer, since we have removed
a card from the deck. We also set localfound to True.
*)
currentindex--;
localfound = True;
(* If the print option is True, then we print the
list topofpiles.
*)
If[print,
Print[topofpiles]
];
(* Now we check to see if the game is over yet.
*)
If[((topofpiles[[1]] == cardsinsuit)&&
(topofpiles[[2]] == 2*cardsinsuit)),
which = True;
found = True;
];
If[((topofpiles[[3]] == 3*cardsinsuit)&&
(topofpiles[[4]] == 4*cardsinsuit)),
which = False;
found = True;
];
];
];
];
];
If[found,
Return[which]
];
]
(*
:[font = input; initialization; preserveAspect]
*)
(* The procedure below simulates n games of Yin&Yang with
a deck of size numcards. It returns the number of games
in which the first two suits were finished before the
last two suits were finished. It assumes that a new deck
will be shuffled numshuffles times before the game is played.
*)
Clear[YinYangSim];
YinYangSim[n_, numcards_, numshuffles_, print_] :=
Block[{counter = 0,
j},
For[j = 1, j <= n, j++,
If[(YinYang[AShuffle[2^numshuffles,
newdeck[numcards/4],
print
],
numcards,
print
]
),
counter++
];
];
Return[counter];
]
(*
:[font = input; initialization; preserveAspect]
*)
(* Now we simulated two-suit Yin & Yang.
The variable 'deck' is the list representing the deck
of cards. The variable 'numcards' is the number of cards
in the deck (which equals twice the number of cards
in each suit. The variable 'print', if set to True, prints
out certain items while the program is running. There is also a
cut built into the game, which is binomially distributed
with parameters 'numcards' and 1/2. *)
Clear[TwoSuitYinYang];
TwoSuitYinYang[deck_, numcards_, print_] :=
Block[{found = False,
which,
internaldeck = deck,
cardsinsuit = numcards/2,
topofpiles = {0,cardsinsuit},
currentindex = 0,
localfound = False,
i,
m
},
(* We first perform the cut.
*)
For[m = 1, m <= numcards, m++,
If[(Random[] < .5),
currentindex++
];
];
If[print,
Print["deck = ", deck]];
(* The variable 'found' is set to true as soon as one
pile has been finished. The variable 'currentindex'
points to the current card. The variable 'which' is set
to True or False when the game is over, depending upon whether
the first or the second pile, respectively, was completed.
*)
While[!found,
currentindex++;
(* Update the pointer to the next card
being considered.
*)
If[(currentindex > Length[internaldeck]),
currentindex = 1
];
(* The variable localfound is set to true every time a card is
found which goes on top of one of the piles. If this variable
is True, then no other piles are checked for that card (since
of course the card only goes on one pile).
*)
localfound = False;
(* Check the current card against the tops of
the two piles.
*)
For[i = 1, i <= 2, i++,
(* The first condition in the if statement below
says that we should ignore a pile if it is already full.
This never happens in two-suit Yin&Yang, since if one
pile is full, the game is over. However, it does happen
in four-suit Yin&Yang, and I decided the programs would
look more similar if I left this check in.
*)
If[(!(topofpiles[[i]] == cardsinsuit*i)&&
(internaldeck[[currentindex]] ==
topofpiles[[i]]+1) && !(localfound)),
Block[{},
internaldeck =
Delete[internaldeck, currentindex];
topofpiles[[i]]++;
(* In preparation for an update of the pointer,
we decrement the pointer, since we have removed
a card from the deck. We also set localfound to True.
*)
currentindex--;
localfound = True;
(* If the print option is True, then we print the
list topofpiles.
*)
If[print,
Print[topofpiles]
];
(* Now we check to see if the game is over yet.
*)
If[(topofpiles[[1]] == cardsinsuit),
which = True;
found = True;
];
(* The following condition check guarantees that if the above
statement set 'found' to True, then no further changes are
made in either 'found' or 'which.'
*)
If[((topofpiles[[2]] == 2*cardsinsuit)&&
(found == False)),
Block[{},
which = False;
found = True;
]
];
];
];
];
];
If[found,
Return[which]
];
]
(*
:[font = input; initialization; preserveAspect]
*)
(* The following procedure simulates n games of two-suit
Yin & Yang. The variable 'numcards' represents the number
of cards in the suit. The variable 'numshuffles' represents
the number of riffle shuffles to perform before starting
a Yin & Yang game. The variable 'print' should be set to
False if you are running a large number of games.
*)
Clear[TwoSuitYinYangSim];
TwoSuitYinYangSim[n_, numcards_, numshuffles_, print_] :=
Block[{counter = 0,
j
},
(* The reason that the procedure newdeck is given the
input value of numcards/4 below, is that this procedure
was used to create a deck with 4 suits, each with numcards/4,
and with the first two decks in increasing order and the
last two decks in decreasing order. In the present case,
we simply think of the first two suits as one suit, and the
last two suits as one suit.
*)
For[j = 1, j <= n, j++,
If[(TwoSuitYinYang[AShuffle[2^numshuffles,
newdeck[numcards/4],
print
],
numcards,
print
]
),
counter++
];
];
Return[counter];
]
(*
:[font = input; preserveAspect; startGroup]
(* Here is an example of a call which runs 1000 games of
Yin & Yang with a 52-card deck and 7 riffle shuffles. Because
Mathematica is so slow, you should try running a smaller
number of games first, (for example, n = 10) to get an
estimate of the running time.
*)
YinYangSim[1000, 52, 7, False]
;[s]
3:0,0;121,1;132,0;300,-1;
2:2,12,10,Courier,1,12,0,0,0;1,12,10,Courier,3,12,0,0,0;
:[font = output; output; inactive; preserveAspect; endGroup]
632
;[o]
632
^*)