Set: The Game

Creating the Deck

SetState = {Cards to be dealt, cards on the table, crads which have been “setted”}
SetState={CD, CT, CF}

InitializeSetDeck[n_]:= Module[
{SetDeck},
SetDeck=Table[
{i,j,k,m},
{i,1,3},
{j,1,3},
{k,1,3},
{m,1,3}];
SetDeck=Flatten[SetDeck,3];
SetDeck=RandomSample[SetDeck];
{SetDeck[[1;;81-n]],SetDeck[[81+1-n;;81]],{}}
]

(*Here we are testing if 3 cards form a set. (It works for more than 4 properties, if desired.)*)
IsSet[{c1_,c2_,c3_}]:=Module[
{},
Max[Mod[c1+c2+c3,3]]==0
]

FindSet[CT_]:=Module[
{PossibleSets,CheckSet,SetFound,SetPosition},
(* Return a count of the sets and a random set if there is one! *)
(* Returns zero and the empty set if there are no sets *)
PossibleSets=Subsets[CT,{3}];
CheckSet=Map[IsSet,PossibleSets];
CheckSet=Position[CheckSet,True];
If[ CheckSet=={},Return[{0,{}}]];
SetPosition=RandomChoice[CheckSet];
SetFound=Flatten[PossibleSets[[SetPosition]],1];
{Length[CheckSet], SetFound}
]

SetPlay[{CDIn_,CTIn_,CFIn_}]:= Module[
{CD=CDIn, CT=CTIn,CF=CFIn,NumberOfSets,FoundSet,NumberOfCardsLeft,m,NumberOfCardsTable},
(* using FindSet to chase down a set *)
{NumberOfSets,FoundSet}=FindSet[CT];
(* Counting the cards left *)
NumberOfCardsLeft=Length[CD];
(* Termination condition is input is static *)
If[And[NumberOfCardsLeft==0, NumberOfSets==0],Return[{CD,CT,CF}]];
(* *)
m=Min[3,NumberOfCardsLeft];

Switch[NumberOfSets,
0,  CT=Join[CT, Take[CD,m]]; CD=Drop[CD,m],
_, CT=Complement[CT,FoundSet]; 
       CF=Join[CF, FoundSet];
       NumberOfCardsTable= Length[CT] ;
       If[ NumberOfCardsTable<12, CT=Join[CT, Take[CD,m]];CD=Drop[CD,m]]; 
];
{CD,CT,CF} 
]

A) I made the definition cells up above intialization cells.  So that they run before you test anything. 
AB) (* I deleted the ; inn FindSet which was suppressing the output *)
B) There was stray text "http : // www.mathlab.mtu.edu/~struther/Courses/2990/ClassSamples/" in the cell below whicht I deleted.
C) I assigned the intialize deck output to a suitable list of three variables. Stick a ; at the end if you do not want to see the output.
D) I made the computer take one step.  It looks to me as though it took 12 cards from the front of CD and e caradded them to CT. I guess I would make it take three at a time for the play.  It might be that you want to make the InitializeSetDeck command take the 12  cards to start with.
E) Two cells below is a cell that will take a set that is found. Copy the cards to CF and delete the cards from CT. You need to make sure you run the cell immediately below to see the thing  two cells below run.
F) Hope this helps.  Much of this code is already in the SetPlay code.  It would never work with the ";" in the FindSet command.  essentialy the ; was making it never find any sets!

About a million times...

SetPlayRepeat[]:=Module[
{SetGame,CardsRemaining},
{CD,CT,CF}=InitializeSetDeck[12];
SetGame=Do[{CD,CT,CF}=SetPlay[{CD,CT,CF}],{50}];(*This "plays" 50 hands, finding up to 27 sets (81 cards). It is impossible to find more than 27 sets because there are only 81 cards, however, a hand is counted when 3 extra cards are added to the table. In the worst conditions, 49 hands will finish the game.*)
{CDEnd,CTEnd,CFEnd}=Map[Length,{CD,CT,CF}]; (*This counts the number of cards at the end of one game*)
{CDEnd,CTEnd,CFEnd} (*This returns the number of cards in each pile after playing 1 game*)
]

AAS:  I just tested hoiw long it took to run 1000 and got 1 minute .  It flooded one of 4 cores so I am going to run 4 bunches in parallel over night and saved the results. I am going to run 
roughly half an hour at a time.  Inother words

Timing[
Data=Transpose[Table[SetPlayRepeat[],{1000}]][[2]]/3;
]

ListPlot[Data]

Histogram[Data,
{-0.5,6.5,1},
LabelingFunction->Above
]

Saving the Data

Below will save the data to Kimberly Stanke’s home drive. MUST be UNCOMMENTED to run. Increase number in Data(number) by 1 each time this is run.

(*Directory[]
SetDirectory["/home/campus04/kmstanke/COLLEGE/Spring 2012/MA2990"]
Export["Data1.csv",Data]*)

1000 took <2 minutes
5000 took ~6 minutes
10000 took~10 minutes

AAS Data Run on Gossamer overnight

SetDirectory["/home/campus03/struther/Desktop"]
Do[
Tic=AbsoluteTime[];
Timing[
Data=ParallelTable[
Transpose[Table[SetPlayRepeat[],{(10^2)}]][[2]]/3,
{2}];
];
Print[DateList[]];
FileName=ToString[StringForm[ "SetData_``.csv", n]];
Export[FileName,Data],
{n,1,400}]

Import["Fred"]

TestData=Table[
FileName=ToString[
StringForm[ "/home/campus03/struther/Desktop/Link to Courses/2990/SetRuns/SetData_``.csv",n]
];
TestData=Import[FileName],
{n,1,81}];
TestData=Flatten[TestData];
Histogram[TestData,LabelingFunction->Above]

Tallies=Tally[TestData]
PieChart[Tallies[[All,2]],
ChartLabels->Tallies[[All,1]]]

TestData=Import[ "/home/campus03/struther/Desktop/Link to Courses/2990/SetRuns/SetData_23.csv"];
Dimensions[TestData]
Table[
Histogram[TestData[[i]],LabelingFunction->Above],
{i,1,4}]
Histogram[Flatten[TestData],LabelingFunction->Above]

Testing

SampleSize=2200;
Data=Table[
SetDeck=InitializeSetDeck[];
n=3;
CT=Take[SetDeck,n];
FindSet[CT][[1]],
{SampleSize}];
Sort[Tally[Data]]
Histogram[Data]

IsSet[ {{3,2,2,1},{2,2,3,1},{1,3,3,1}}]

{CD,CT,CF}=InitializeSetDeck[12];
Map[Length,{CD,CT,CF}]
FindSet[CT]

{CD,CT,CF}=SetPlay[{CD,CT,CF}];
Map[Length,{CD,CT,CF}]
FindSet[CT]

{CD, CT,CF}=SetPlay[{CD,CT,CF}];
Map[Length,{CD,CT,CF}]

FindSet[CT]

{NumSets, FoundSet}=FindSet[CT]
CT=Complement[CT,FoundSet]
NumTable=Length[CT]
CF=Join[FoundSet,CF]