Set: The Game

InitializeSetDeck[n_,d_]:= Module[
(*n is cards on the table, d is cards dropped from the deck (for missing configurations)*)
{SetDeck},
SetDeck=Table[
{i,j,k,m},
{i,1,3},
{j,1,3},
{k,1,3},
{m,1,3}];
SetDeck=Drop[Flatten[SetDeck,3],d];
SetDeck=RandomSample[SetDeck];
{SetDeck[[1;;(81-d)-n]],SetDeck[[(81-d)+1-n;;(81-d)]],{}}
]

(*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}
]

FindPopularSet[CT_]:=Module[
{PossibleSets,CheckSet,SetFound,SetPosition,MostPopular,HowPopular,SetPopular,Counts,WherePopular,PopularSetFound},
(* Return a count of the sets and the most popular set (or a random set of the most popular, if tied) 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,{}}]];
HowPopular=Tally[Flatten[PossibleSets[[Flatten[CheckSet]]],1]];
Counts=Flatten[HowPopular[[All,2]]];
WherePopular=Flatten[Position[Counts,Max[Counts]]];
WherePopular=RandomChoice[{WherePopular}];
HowPopular=RandomChoice[HowPopular[[WherePopular,1]]];
SetFound=Position[PossibleSets,HowPopular];
PopularSetFound=SetFound[[All,1]];
CheckSet=Flatten[CheckSet];
SetPosition=Intersection[CheckSet,PopularSetFound];
SetPosition=RandomChoice[SetPosition];
SetFound=PossibleSets[[SetPosition]];
{Length[CheckSet],SetFound}
]

FindRejectSet[CT_]:=Module[
{PossibleSets,CheckSet,SetFound,SetPosition,MostPopular,HowPopular,SetPopular,Counts,WherePopular,PopularSetFound},
(* Return a count of the sets and the most popular set (or a random set of the most popular, if tied) 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,{}}]];
HowPopular=Tally[Flatten[PossibleSets[[Flatten[CheckSet]]],1]];
Counts=Flatten[HowPopular[[All,2]]];
WherePopular=Flatten[Position[Counts,Min[Counts]]];
WherePopular=RandomChoice[{WherePopular}];
HowPopular=RandomChoice[HowPopular[[WherePopular,1]]];
SetFound=Position[PossibleSets,HowPopular];
PopularSetFound=SetFound[[All,1]];
CheckSet=Flatten[CheckSet];
SetPosition=Intersection[CheckSet,PopularSetFound];
SetPosition=RandomChoice[SetPosition];
SetFound=PossibleSets[[SetPosition]];
{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} 
]

PopularSetPlay[{CDIn_,CTIn_,CFIn_}]:= Module[
{CD=CDIn, CT=CTIn,CF=CFIn,NumberOfSets,FoundSet,NumberOfCardsLeft,m,NumberOfCardsTable},
(* using FindSet to chase down a set *)
{NumberOfSets,FoundSet}=FindPopularSet[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} 
]

RejectSetPlay[{CDIn_,CTIn_,CFIn_}]:= Module[
{CD=CDIn, CT=CTIn,CF=CFIn,NumberOfSets,FoundSet,NumberOfCardsLeft,m,NumberOfCardsTable},
(* using FindSet to chase down a set *)
{NumberOfSets,FoundSet}=FindRejectSet[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} 
]

About a million times...

SetPlayRepeat[]:=Module[
{SetGame,CardsRemaining},
{CD,CT,CF}=InitializeSetDeck[12,0];
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*)
(* Added this line AAS March 14th to save special configs for Stefan *)
If[CTEnd==18, PutAppend[CT,"18.txt"]; Print["Got One"]];
{CDEnd,CTEnd,CFEnd} (*This returns the number of cards in each pile after playing 1 game*)
]

PopularSetPlayRepeat[]:=Module[
{SetGame,CardsRemaining},
{CD,CT,CF}=InitializeSetDeck[12,0];
SetGame=Do[{CD,CT,CF}=PopularSetPlay[{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*)
(* Added this line AAS March 14th to save special configs for Stefan *)
If[CTEnd==18, PutAppend[CT,"18.txt"]; Print["Got One"]];
{CDEnd,CTEnd,CFEnd} (*This returns the number of cards in each pile after playing 1 game*)
]

RejectSetPlayRepeat[]:=Module[
{SetGame,CardsRemaining},
{CD,CT,CF}=InitializeSetDeck[12,0];
SetGame=Do[{CD,CT,CF}=RejectSetPlay[{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*)
(* Added this line AAS March 14th to save special configs for Stefan *)
If[CTEnd==18, PutAppend[CT,"18.txt"]; Print["Got One"]];
{CDEnd,CTEnd,CFEnd} (*This returns the number of cards in each pile after playing 1 game*)
]

MissingOneSetPlayRepeat[]:=Module[
{SetGame,CardsRemaining},
{CD,CT,CF}=InitializeSetDeck[12,1];
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*)
(* Added this line AAS March 14th to save special configs for Stefan *)
If[CTEnd>18, PutAppend[CT,"18.txt"]; Print["Got One"]];
{CDEnd,CTEnd,CFEnd} (*This returns the number of cards in each pile after playing 1 game*)
]

MissingOnePopularSetPlayRepeat[]:=Module[
{SetGame,CardsRemaining},
{CD,CT,CF}=InitializeSetDeck[12,1];
SetGame=Do[{CD,CT,CF}=PopularSetPlay[{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*)
(* Added this line AAS March 14th to save special configs for Stefan *)
If[CTEnd>18, PutAppend[CT,"18.txt"]; Print["Got One"]];
{CDEnd,CTEnd,CFEnd} (*This returns the number of cards in each pile after playing 1 game*)
]

MissingOneRejectSetPlayRepeat[]:=Module[
{SetGame,CardsRemaining},
{CD,CT,CF}=InitializeSetDeck[12,1];
SetGame=Do[{CD,CT,CF}=RejectSetPlay[{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*)
(* Added this line AAS March 14th to save special configs for Stefan *)
If[CTEnd>18, PutAppend[CT,"18.txt"]; Print["Got One"]];
{CDEnd,CTEnd,CFEnd} (*This returns the number of cards in each pile after playing 1 game*)
]

MissingTwoSetPlayRepeat[]:=Module[
{SetGame,CardsRemaining},
{CD,CT,CF}=InitializeSetDeck[12,2];
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*)
(* Added this line AAS March 14th to save special configs for Stefan *)
If[CTEnd>18, PutAppend[CT,"18.txt"]; Print["Got One"]];
{CDEnd,CTEnd,CFEnd} (*This returns the number of cards in each pile after playing 1 game*)
]

MissingTwoPopularSetPlayRepeat[]:=Module[
{SetGame,CardsRemaining},
{CD,CT,CF}=InitializeSetDeck[12,2];
SetGame=Do[{CD,CT,CF}=PopularSetPlay[{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*)
(* Added this line AAS March 14th to save special configs for Stefan *)
If[CTEnd>18, PutAppend[CT,"18.txt"]; Print["Got One"]];
{CDEnd,CTEnd,CFEnd} (*This returns the number of cards in each pile after playing 1 game*)
]

MissingTwoRejectSetPlayRepeat[]:=Module[
{SetGame,CardsRemaining},
{CD,CT,CF}=InitializeSetDeck[12,2];
SetGame=Do[{CD,CT,CF}=RejectSetPlay[{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*)
(* Added this line AAS March 14th to save special configs for Stefan *)
If[CTEnd>18, PutAppend[CT,"18.txt"]; Print["Got One"]];
{CDEnd,CTEnd,CFEnd} (*This returns the number of cards in each pile after playing 1 game*)
]

Generating Data

(**Directory must be set!!**)
SetDirectory["/home/campus03/struther/Desktop/Link to Courses/2990/SET/April12"]

(* Catch up for the missing data set *)
(*Do[
Data9=Transpose[Table[MissingTwoRejectSetPlayRepeat[],{(10^4)}]][[2]];
FileName9=ToString[StringForm[ "79RejectChoice_``.csv", n]];
Print[DateList[]];
Export[FileName9,Data9],
{n,1,10}]*)

(* Restarting main run *)
Do[
Data1=Transpose[Table[SetPlayRepeat[],{(10^4)}]][[2]]/3;
FileName1=ToString[StringForm[ "81RandomChoice_``.csv", n]];

Data2=Transpose[Table[PopularSetPlayRepeat[],{(10^4)}]][[2]]/3;
FileName2=ToString[StringForm[ "81PopularChoice_``.csv", n]];

Data3=Transpose[Table[RejectSetPlayRepeat[],{(10^4)}]][[2]]/3;
FileName3=ToString[StringForm[ "81RejectChoice_``.csv", n]];

Data4=Transpose[Table[MissingOneSetPlayRepeat[],{(10^4)}]][[2]];
FileName4=ToString[StringForm[ "80RandomChoice_``.csv", n]];

Data5=Transpose[Table[MissingOnePopularSetPlayRepeat[],{(10^4)}]][[2]];
FileName5=ToString[StringForm[ "80PopularChoice_``.csv", n]];

Data6=Transpose[Table[MissingOneRejectSetPlayRepeat[],{(10^4)}]][[2]];
FileName6=ToString[StringForm[ "80RejectChoice_``.csv", n]];

Data7=Transpose[Table[MissingTwoSetPlayRepeat[],{(10^4)}]][[2]];
FileName7=ToString[StringForm[ "79RandomChoice_``.csv", n]];

Data8=Transpose[Table[MissingTwoPopularSetPlayRepeat[],{(10^4)}]][[2]];
FileName8=ToString[StringForm[ "79PopularChoice_``.csv", n]];

Data9=Transpose[Table[MissingTwoRejectSetPlayRepeat[],{(10^4)}]][[2]];
FileName9=ToString[StringForm[ "79RejectChoice_``.csv", n]];

Print[DateList[]];

Export[FileName1,Data1];
Export[FileName2,Data2];
Export[FileName3,Data3];
Export[FileName4,Data4];
Export[FileName5,Data5];
Export[FileName6,Data6];
Export[FileName7,Data7];
Export[FileName7,Data7];
Export[FileName8,Data8];
Export[FileName9,Data9],
{n,95,40000}]