Cube Dissection

Author

Eric W. Weisstein
December 22, 2010

This notebook downloaded from http://mathworld.wolfram.com/notebooks/RecreationalMath/CubeDissection.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/CubeDissection.html.

©2010 Wolfram Research, Inc. except for portions noted otherwise

Initialization

cube[x_,y_,z_]:=cube[{x,y,z}]
cube[ctr_List,a_:1.]:=Module[{off=Table[ctr,{4}],h=.5 a},
  {
  Polygon[off+{{-h,-h,-h},{-h,h,-h},{h,h,-h},{h,-h,-h}}], (* bottom *)
  Polygon[off+{{-h,-h,h},{-h,h,h},{h,h,h},{h,-h,h}}],     (* top *)
  Polygon[off+{{-h,-h,-h},{-h,h,-h},{-h,h,h},{-h,-h,h}}], (* sides *)
  Polygon[off+{{h,-h,-h},{h,h,-h},{h,h,h},{h,-h,h}}],
  Polygon[off+{{-h,-h,-h},{h,-h,-h},{h,-h,h},{-h,-h,h}}],
  Polygon[off+{{-h,h,-h},{h,h,-h},{h,h,h},{-h,h,h}}]
  }
]

Polycube[1,1]:=cube[0,0,0]
Polycube[2,1]:={cube[0,0,0],cube[1,0,0]}
Polycube[3,1]:=Table[cube[i,0,0],{i,3}]
Polycube[3,2]:={cube[0,0,0],cube[1,0,0],cube[1,0,1]}
Polycube[4,1]:=Table[cube[i,0,0],{i,4}]
Polycube[4,8]:=Table[cube[i,j,0],{i,0,1},{j,0,1}]
Polycube[4,i_]:=Soma[i]

Polycubes[1]:=1
Polycubes[2]:=1
Polycubes[3]:=2
Polycubes[4]:=8
Polycubes[5]:=29

PolyCubeList[n_]:=Table[
  Show[Graphics3D[PolyCube[n,i]],Boxed->False,AspectRatio->1,DisplayFunction->Identity],
  {i,Polycubes[n]}]

Soma[1]:={cube[0,0,0],cube[1,0,0],cube[1,0,1]}
Soma[2]:={cube[0,0,0],cube[1,0,0],cube[2,0,0],cube[2,0,1]}
Soma[3]:={cube[0,0,0],cube[1,0,0],cube[2,0,0],cube[1,0,1]}
Soma[4]:={cube[0,0,0],cube[1,0,0],cube[1,0,1],cube[2,0,1]}
Soma[5]:={cube[0,0,0],cube[1,0,0],cube[1,1,0],cube[1,0,1]}
Soma[6]:={cube[0,0,0],cube[0,0,1],cube[1,0,0],cube[1,1,0]}
Soma[7]:={cube[0,0,0],cube[1,0,0],cube[1,1,0],cube[1,1,1]}

Steinhaus[1]:={cube[0,0,0],cube[1,0,0],cube[0,1,0],cube[0,1,1],cube[-1,1,1]}
Steinhaus[2]:={cube[0,0,0],cube[1,0,0],cube[2,0,0],cube[2,1,0],cube[2,1,1]}
Steinhaus[3]:={cube[0,0,0],cube[1,0,0],cube[1,1,0],cube[2,0,0],cube[0,0,1]}
Steinhaus[4]:=Soma[6]
Steinhaus[5]:=Soma[2]
Steinhaus[6]:=Soma[7]

Steinhaus Dissection

Do[
	WriteLiveForm["steinha"<>ToString[i]<>".m",
		Graphics3D[Steinhaus[i],Boxed->False,AspectRatio->1]],
	{i,6}]

Show[GraphicsArray[partition[Table[Show[Graphics3D[Steinhaus[i]],Boxed->False,AspectRatio->1,DisplayFunction->Identity],{i,6}],3]],DisplayFunction->$DisplayFunction]

Table[Show[Graphics3D[Steinhaus[i]],Boxed->False,AspectRatio->1],{i,6}]