Fun puzzle from @stanislavfort -- pack a sphere into each corner of the cube and one in the center. Will the center sphere stay wholly contained inside the cube?
In[]:=
ClearAll["Global`*"];​​d=2;(*truedimension*)​​​​norm2[vec_]=Total[vec*vec];​​​​visualize[d_]:=Module{},​​(*vec1,vec2determinetheplaneofoursection*)​​vec1={1}~Join~ConstantArray[0,d-1];​​vec2=Normalize[{0}~Join~ConstantArray[1,d-1]];​​mat={vec1,vec2};​​​​a=1;​​​​as=ConstantArray[a,d-1];​​zeros=ConstantArray[0,d];​​​​(*Radiusofinscribedsphere*)​​R=a
d
-1;​​​​(*Cornerspherespassingthroughthesection*)​​c1={-a}~Join~as;​​c2={a}~Join~as;​​c3={-a}~Join~(-as);​​c4={a}~Join~(-as);​​​​sphere[center_,radius_]:=norm2[{x,y}.mat-center]<=
2
radius
;​​cornerSpheres=sphere[#,a]&/@{c1,c2,c3,c4};​​centerSphere=sphere[zeros,R];​​​​spherePlot=RegionPlot@@{centerSphere}~Join~cornerSpheres,x,-
2
a
d
-a,
2
a
d
+a,y,-
2
a
d
-a,
2
a
d
+a,AspectRatio->1,Frame->False;​​​​{c1,c2,c3,c4}=Tuples{-2a,2a},-2a
d-1
,2a
d-1
;​​cubePlot=Graphics[Line[{c1,c2,c4,c3,c1}]];​​​​ShowspherePlot,cubePlot,PlotRange->-2a
d-1
,2a
d-1
,-2a
d-1
,2a
d-1
​​;​​​​visualize[2]
Out[]=
You can reason that it shouldn’t, as the radius of the center sphere grows with dimension, while distance to the closest wall stays constant. What does the intersection look like?
​
Is it “spiky sphere” as below?
To visualize, pick a 2D section going through opposite edges of the cube as below:
vis dimension
dvis=2;
True dimension
d=3;​​​​norm2[vec_]=Total[vec*vec];
vec1, vec2 determine the plane of our section
vec1={1}~Join~ConstantArray[0,d-1];​​vec2=Normalize[{0}~Join~ConstantArray[1,d-1]];​​mat={vec1,vec2};​​​​as=ConstantArray[a,d-1];​​zeros=0*as;​​zeros=ConstantArray[0,d];​​a=1;
Radius of inscribed sphere
R=a
d
-1;
Corner spheres passing through the section
c1={-a}~Join~as;​​c2={a}~Join~as;​​c3={-a}~Join~(-as);​​c4={a}~Join~(-as);​​​​sphere[center_,radius_]:=norm2[{x,y}.mat-center]<=
2
radius
;​​cornerSpheres=sphere[#,a]&/@{c1,c2,c3,c4};​​centerSphere=sphere[zeros,R];​​​​a=1;​​​​vec1={1}~Join~ConstantArray[0,d-1];​​vec2=Normalize[{0}~Join~ConstantArray[1,d-1]];​​mat={vec1,vec2};​​​​normal=Cross@@mat;​​sphere[center_,radius_]:=And@@{norm2[{x,y,z}-center]<=
2
radius
,normal.{x,y,z}<0};​​cornerSpheres=sphere[#,a]&/@{c1,c2,c3,c4};​​centerSphere=sphere[zeros,R];​​​​halfCube=Graphics3D@Polyhedron[{{-2,-2,-2},{2,-2,-2},{2,-2,2},{-2,-2,2},{2,2,2},{-2,2,2}},{{1,2,3,4},{3,4,6,5},{1,2,5,6},{2,3,5},{1,4,6}}];​​​​c1={-a}~Join~as;​​c2={a}~Join~as;​​c3={-a}~Join~(-as);​​c4={a}~Join~(-as);​​​​c5={a,a,-a};​​c6={-a,a,-a};​​​​sphere[center_,radius_]:=norm2[{x,y}.mat-center]<=
2
radius
;​​cornerSpheres=Sphere[#,a]&/@{c1,c2,c3,c4};​​sideSpheres=Sphere[#,a]&/@{c5};​​centerSphere=Sphere[zeros,R];​​​​regionPlot=Graphics3D[cornerSpheres~Join~{Opacity[1]}~Join~sideSpheres~Join~{Opacity[1],RGBColor[0.57`,0.54`,1],centerSphere}];​​Show[regionPlot,halfCube,PlotRange->{{-2,2},{-2,2},{-2,2}}]​​
Visualizing these sections at for dimensions 2 through 10, you can see the sphere starts to “jut out” at dimension 10

CITE THIS NOTEBOOK

High-dimensional sphere packing doesn't fit in a box​
by Yaroslav Bulatov​
Wolfram Community, STAFF PICKS, November 2, 2023
​https://community.wolfram.com/groups/-/m/t/3059720