3
$\begingroup$

I'm looking for an elegant way to visualize the following problem -- allegedly, if you put $2^d$ spheres in the corners of the $d$-dimensional cube and inscribe a sphere in the center, for $d>9$, the inscribed sphere will "poke out" from the sides of the cube. It would be neat to see what that looks like.

$\endgroup$
6
  • $\begingroup$ I think there is no way to visualize it at all. That's life. $\endgroup$
    – user64494
    Commented Sep 8, 2022 at 4:57
  • $\begingroup$ We can use d-spaces and project the d-dimensional object to three dimension $\endgroup$
    – cvgmt
    Commented Sep 8, 2022 at 5:03
  • $\begingroup$ @cvgmt: Let us consider two non-parallel straight lines in $\mathbb R^3$ which do not intersect and their projection onto a plane in general position. We will see two intersecting straight lines. $\endgroup$
    – user64494
    Commented Sep 8, 2022 at 8:24
  • $\begingroup$ @user64494 Project the 3D object to 2D for EVERY direction,just as we use the 2D computer screen to display 3D object. $\endgroup$
    – cvgmt
    Commented Sep 8, 2022 at 8:27
  • $\begingroup$ @cvgmt: "Project the 3D object to 2D for EVERY direction" is impossible to realize. $\endgroup$
    – user64494
    Commented Nov 2, 2023 at 6:21

1 Answer 1

3
$\begingroup$

Ended up coming back to this problem to visualize the section going through opposing edges of the (hyper)cube

enter image description here

ClearAll["Global`*"];
d = 2; (* true dimension *)

norm2[vec_] = Total[vec*vec];

visualize[d_] := Module[{},
   (* 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};
   
   a = 1;
   
   as = ConstantArray[a, d - 1];
   zeros = ConstantArray[0, d];
   
   (* Radius of inscribed sphere *)
   R = a (Sqrt[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] <= radius^2;
   cornerSpheres = sphere[#, a] & /@ {c1, c2, c3, c4};
   centerSphere = sphere[zeros, R];
   
   spherePlot = 
    RegionPlot @@ {{centerSphere}~Join~
       cornerSpheres, {x, -Sqrt[a^2 d] - a, 
       Sqrt[a^2 d] + a}, {y, -Sqrt[a^2 d] - a, Sqrt[a^2 d] + a}, 
      AspectRatio -> 1, Frame -> False};
   
   {c1, c2, c3, c4} = 
    Tuples[{{-2 a, 2 a}, {-2 a Sqrt[d - 1], 2 a Sqrt[d - 1]}}];
   cubePlot = Graphics[Line[{c1, c2, c4, c3, c1}]];
   
   Show[spherePlot, cubePlot, 
    PlotRange -> {{-2 a Sqrt[d - 1], 
       2 a Sqrt[d - 1]}, {-2 a Sqrt[d - 1], 2 a Sqrt[d - 1]}}]
   ];

pics = Table[visualize[d], {d, 2, 10}];
grid = Partition[pics, 3];
GraphicsGrid[grid, Spacings -> {0, 0}]

In high-dimensions, the corners of the cube are much more pointy, there's much more slack left over between packed sphere and edges. For $d=10$, the you can see that center inscribed sphere sticks out of the cube sides.

enter image description here

Notebook

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.