Kepler Conjecture

Author

Eric W. Weisstein
August 13, 2003

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PackingProblems/KeplerConjecture.nb.

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

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

Initialization

<<Graphics`Shapes`;

Graphics

sphere=Sphere[1,10,10];
sphere=Sphere[];
cubic=With[{s=Sqrt[3],h=2Sqrt[2/3]},
{
		Table[TranslateShape[sphere,{-2/Sqrt[3]Cos[2Pi (i+1/4)/3],-2/Sqrt[3]Sin[2Pi (i+1/4)/3],h}],{i,3}],
		sphere,
		Table[TranslateShape[sphere,2{Cos[2Pi i/6],Sin[2Pi i/6],0}],{i,6}],
		Table[TranslateShape[sphere,{2/Sqrt[3]Cos[2Pi (i+1/4)/3],2/Sqrt[3]Sin[2Pi (i+1/4)/3],-h}],{i,3}]
}];

hex=With[{s=Sqrt[3],h=2Sqrt[2/3]},{
		Table[TranslateShape[sphere,{2/Sqrt[3]Cos[2Pi (i+1/4)/3],2/Sqrt[3]Sin[2Pi (i+1/4)/3],h}],{i,3}],
		sphere,
		Table[TranslateShape[sphere,2{Cos[2Pi i/6],Sin[2Pi i/6],0}],{i,6}],
		Table[TranslateShape[sphere,{2/Sqrt[3]Cos[2Pi (i+1/4)/3],2/Sqrt[3]Sin[2Pi (i+1/4)/3],-h}],{i,3}]
}];

Show[GraphicsArray[Graphics3D[#,Boxed->False]&/@{cubic,hex}],
GraphicsSpacing->-.2]