initializations

Card colors, extracted from one of Todd Mateer’s original images:

im=;

redColor=RGBColor[Sequence@@PixelValue[im,{100,400}]];
orangeColor=RGBColor[Sequence@@PixelValue[im,{300,400}]];
yellowColor=RGBColor[Sequence@@PixelValue[im,{500,400}]];
greenColor=RGBColor[Sequence@@PixelValue[im,{700,400}]];
blueColor=RGBColor[Sequence@@PixelValue[im,{250,180}]];
pinkColor=RGBColor[Sequence@@PixelValue[im,{450,180}]];
purpleColor=RGBColor[Sequence@@PixelValue[im,{650,180}]];

While we have the image above in sight, let’s make note of the numbers on each card:

redNos=Range[8,15];
orangeNos={4,5,6,7,12,13,14,15};
yellowNos={2,3,6,7,10,11,14,15};
greenNos={1,3,5,7,9,11,13,15};
blueNos={1,2,4,7,9,10,12,15};
pinkNos={1,2,5,6,8,11,12,15};
purpleNos={1,3,4,6,8,10,13,15};

Draw a tab with lower left corner at pt:

simpleTab[pt_]:=Map[pt+#&,{{0,0},{0,1},{1,1},{1,0},{0,0}}]

Here are the tab anchor points for each card:

redTabPts={{-2,2},{-1,2},{0,2},{1,2},{2,1},{2,0},{2,-1},{2,-2}};
orangeTabPts={{-2,2},{-1,2},{0,2},{1,2},{1,-3},{0,-3},{-1,-3},{-2,-3}};
yellowTabPts={{-2,2},{-1,2},{2,1},{2,0},{1,-3},{0,-3},{-3,-2},{-3,-1}};
greenTabPts={{-2,2},{0,2},{2,1},{2,-1},{1,-3},{-1,-3},{-3,-2},{-3,0}};
blueTabPts={{-2,2},{1,2},{2,0},{2,-1},{1,-3},{-2,-3},{-3,-1},{-3,0}};
pinkTabPts={{-2,2},{1,2},{2,1},{2,-2},{0,-3},{-1,-3},{-3,-1},{-3,0}};
purpleTabPts={{-2,2},{0,2},{2,0},{2,-2},{0,-3},{-2,-3},{-3,-2},{-3,0}};

Here are the basic cards (no numbers written on them, no tab-holes):

redCardSimple={
{redColor,EdgeForm[Black],Polygon[{{-2,-2},{-2,2},{2,2},{2,-2},{-2,-2}}]},
{redColor,EdgeForm[Black],Polygon[simpleTab[#]]}&/@redTabPts
};

orangeCardSimple={
{orangeColor,EdgeForm[Black],Polygon[{{-2,-2},{-2,2},{2,2},{2,-2},{-2,-2}}]},
{orangeColor,EdgeForm[Black],Polygon[simpleTab[#]]}&/@orangeTabPts
};

yellowCardSimple={
{yellowColor,EdgeForm[Black],Polygon[{{-2,-2},{-2,2},{2,2},{2,-2},{-2,-2}}]},
{yellowColor,EdgeForm[Black],Polygon[simpleTab[#]]}&/@yellowTabPts
};

greenCardSimple={
{greenColor,EdgeForm[Black],Polygon[{{-2,-2},{-2,2},{2,2},{2,-2},{-2,-2}}]},
{greenColor,EdgeForm[Black],Polygon[simpleTab[#]]}&/@greenTabPts
};

blueCardSimple={
{blueColor,EdgeForm[Black],Polygon[{{-2,-2},{-2,2},{2,2},{2,-2},{-2,-2}}]},
{blueColor,EdgeForm[Black],Polygon[simpleTab[#]]}&/@blueTabPts
};

pinkCardSimple={
{pinkColor,EdgeForm[Black],Polygon[{{-2,-2},{-2,2},{2,2},{2,-2},{-2,-2}}]},
{pinkColor,EdgeForm[Black],Polygon[simpleTab[#]]}&/@pinkTabPts
};

purpleCardSimple={
{purpleColor,EdgeForm[Black],Polygon[{{-2,-2},{-2,2},{2,2},{2,-2},{-2,-2}}]},
{purpleColor,EdgeForm[Black],Polygon[simpleTab[#]]}&/@purpleTabPts
};

Here is the base card:

allCornerPts={{-3,2},{-2,2},{-1,2},{0,2},{1,2},{2,2},{2,1},{2,0},{2,-1},{2,-2},{2,-3},{1,-3},{0,-3},{-1,-3},{-2,-3},{-3,-3},{-3,-2},{-3,-1},{-3,0},{-3,1}};
numberedCornerPts={{-2,2},{-1,2},{0,2},{1,2},{2,1},{2,0},{2,-1},{2,-2},{1,-3},{0,-3},{-1,-3},{-2,-3},{-3,-2},{-3,-1},{-3,0},{-3,1}};

baseCard=Line[simpleTab[#]]&/@allCornerPts;

Here is a command to produce a labeled version (showing the numbers) for the front face of each card:

Clear[labeledCard];
labeledCard[card_,label_,fs_,ops___Rule]:=Graphics[{card,
Text[Grid[Partition[Style[#,fs,FontFamily->"Helvetica"]&/@label,4],ops,Spacings->{2,1.5},ItemSize->{Automatic,4}],{0,0}]
},PlotRange->3.1]

Build the tabs (with tab holes) on each card:

redTab[pt_]:=Map[pt+#&,{{0,0},{0,(12/13)},{(1/13),(12/13)},{(3/13),(12/13)},{(3/13),(10/13)},{(1/13),(10/13)},{(1/13),(12/13)},{0,(12/13)},{0,1},{1,1},{1,0},{0,0}}]

orangeTab[pt_]:=Map[pt+#&,{{0,0},{0,(12/13)},{(4/13),(12/13)},{(6/13),(12/13)},{(6/13),(10/13)},{(4/13),(10/13)},{(4/13),(12/13)},{0,(12/13)},{0,1},{1,1},{1,0},{0,0}}]

yellowTab[pt_]:=Map[pt+#&,{{0,0},{0,(12/13)},{(7/13),(12/13)},{(9/13),(12/13)},{(9/13),(10/13)},{(7/13),(10/13)},{(7/13),(12/13)},{0,(12/13)},{0,1},{1,1},{1,0},{0,0}}]

greenTab[pt_]:=Map[pt+#&,{{0,0},{0,(12/13)},{(10/13),(12/13)},{(12/13),(12/13)},{(12/13),(10/13)},{(10/13),(10/13)},{(10/13),(12/13)},{0,(12/13)},{0,1},{1,1},{1,0},{0,0}}]

blueTab[pt_]:=Map[pt+#&,{{0,0},{0,(9/13)},{(10/13),(9/13)},{(12/13),(9/13)},{(12/13),(7/13)},{(10/13),(7/13)},{(10/13),(9/13)},{0,(9/13)},{0,1},{1,1},{1,0},{0,0}}]

pinkTab[pt_]:=Map[pt+#&,{{0,0},{0,(6/13)},{(10/13),(6/13)},{(12/13),(6/13)},{(12/13),(4/13)},{(10/13),(4/13)},{(10/13),(6/13)},{0,(6/13)},{0,1},{1,1},{1,0},{0,0}}]

purpleTab[pt_]:=Map[pt+#&,{{0,0},{0,(3/13)},{(10/13),(3/13)},{(12/13),(3/13)},{(12/13),(1/13)},{(10/13),(1/13)},{(10/13),(3/13)},{0,(3/13)},{0,1},{1,1},{1,0},{0,0}}]

reTab[pt_]:={
{redColor,Polygon[redTab[pt]]},
Line[Take[redTab[pt],3;;7]],Line[Drop[redTab[pt],2;;8]]}

orTab[pt_]:={
{orangeColor,Polygon[orangeTab[pt]]},
Line[Take[orangeTab[pt],3;;7]],Line[Drop[orangeTab[pt],2;;8]]}

yeTab[pt_]:={
{yellowColor,Polygon[yellowTab[pt]]},
Line[Take[yellowTab[pt],3;;7]],Line[Drop[yellowTab[pt],2;;8]]}

grTab[pt_]:={
{greenColor,Polygon[greenTab[pt]]},
Line[Take[greenTab[pt],3;;7]],Line[Drop[greenTab[pt],2;;8]]}

blTab[pt_]:={
{blueColor,Polygon[blueTab[pt]]},
Line[Take[blueTab[pt],3;;7]],Line[Drop[blueTab[pt],2;;8]]}

piTab[pt_]:={
{pinkColor,Polygon[pinkTab[pt]]},
Line[Take[pinkTab[pt],3;;7]],Line[Drop[pinkTab[pt],2;;8]]}

puTab[pt_]:={
{purpleColor,Polygon[purpleTab[pt]]},
Line[Take[purpleTab[pt],3;;7]],Line[Drop[purpleTab[pt],2;;8]]}

Finally, the complete cards:

redCard={
{redColor,EdgeForm[Black],Polygon[{{-2,-2},{-2,2},{2,2},{2,-2},{-2,-2}}]},
reTab/@redTabPts
};

orangeCard={
{orangeColor,EdgeForm[Black],Polygon[{{-2,-2},{-2,2},{2,2},{2,-2},{-2,-2}}]},
orTab/@orangeTabPts
};

yellowCard={
{yellowColor,EdgeForm[Black],Polygon[{{-2,-2},{-2,2},{2,2},{2,-2},{-2,-2}}]},
yeTab/@yellowTabPts
};

greenCard={
{greenColor,EdgeForm[Black],Polygon[{{-2,-2},{-2,2},{2,2},{2,-2},{-2,-2}}]},
grTab/@greenTabPts
};

blueCard={
{blueColor,EdgeForm[Black],Polygon[{{-2,-2},{-2,2},{2,2},{2,-2},{-2,-2}}]},
blTab/@blueTabPts
};

pinkCard={
{pinkColor,EdgeForm[Black],Polygon[{{-2,-2},{-2,2},{2,2},{2,-2},{-2,-2}}]},
piTab/@pinkTabPts
};

purpleCard={
{purpleColor,EdgeForm[Black],Polygon[{{-2,-2},{-2,2},{2,2},{2,-2},{-2,-2}}]},
puTab/@purpleTabPts
};

Here’s how to flip a card across the diagonal that runs from upper left to lower right:

flip[card_]:=GeometricTransformation[card,ReflectionTransform[{1,1}]]

Playable Game

This demonstration accompanies the article “A magic trick based on the Hamming code,” by Todd Mateer, which appeared in Math Horizons 21 (2), Nov. 2013, pp 9-11. This was coded in Mathematica by Bruce Torrence. Enjoy!

Manipulate[Graphics[cardList,ImageSize->630],
{{cardList,{baseCard}},ControlType->None},
Button["clear all",cardList={baseCard}],
Button["remove last card",If[Length[cardList]>1,cardList=Most[cardList]]],
Row[{
Column[{
Graphics[labeledCard[redCardSimple,redNos,10,Spacings->{.2,1.5},ItemSize->{Automatic,2}]],
Button["yes",AppendTo[cardList,redCard]],
Button["no",AppendTo[cardList,flip[redCard]]]
}],
Column[{
Graphics[labeledCard[orangeCardSimple,orangeNos,10,Spacings->{.2,1.5},ItemSize->{Automatic,2}]],
Button["yes",AppendTo[cardList,orangeCard]],
Button["no",AppendTo[cardList,flip[orangeCard]]]
}],
Column[{
Graphics[labeledCard[yellowCardSimple,yellowNos,10,Spacings->{.2,1.5},ItemSize->{Automatic,2}]],
Button["yes",AppendTo[cardList,yellowCard]],
Button["no",AppendTo[cardList,flip[yellowCard]]]
}],
Column[{
Graphics[labeledCard[greenCardSimple,greenNos,10,Spacings->{.2,1.5},ItemSize->{Automatic,2}]],
Button["yes",AppendTo[cardList,greenCard]],
Button["no",AppendTo[cardList,flip[greenCard]]]
}],
Column[{
Graphics[labeledCard[blueCardSimple,blueNos,10,Spacings->{.2,1.5},ItemSize->{Automatic,2}]],
Button["yes",AppendTo[cardList,blueCard]],
Button["no",AppendTo[cardList,flip[blueCard]]]
}],
Column[{
Graphics[labeledCard[pinkCardSimple,pinkNos,10,Spacings->{.2,1.5},ItemSize->{Automatic,2}]],
Button["yes",AppendTo[cardList,pinkCard]],
Button["no",AppendTo[cardList,flip[pinkCard]]]
}],
Column[{
Graphics[labeledCard[purpleCardSimple,purpleNos,10,Spacings->{.2,1.5},ItemSize->{Automatic,2}]],
Button["yes",AppendTo[cardList,purpleCard]],
Button["no",AppendTo[cardList,flip[purpleCard]]]
}]
}],SaveDefinitions->True
]