(*^ ::[ 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 ^*)