This notebook contains additional material to the Mathematica GuideBooks  (Springer-Verlag, New York, 2004) http://www.MathematicaGuideBooks.org . It uses the stylesheet of the Mathematica GuideBooks, which is embedded.

Symbolics Volume, Chapter 1

Consider the implicit equation (∑_(k=1)^(d+1))(Subscript[x, k]^2)=1 of a dD sphere in (ℝ^(d+1)). For a fixed prime p, find integer solutions (Subscript[x, k]) for (∑_(k=1)^(d+1))(Subscript[x, k]^2)=1 mod p. Symmetrize the resulting solution points {(Subscript[x, 1]),(Subscript[x, 2]),…,(Subscript[x, d+1])} with respect to the origin, then map them to the unit sphere and visualize them [✶].

spherePoints[d_Integer?(# > 1&), p_Integer?PrimeQ] := 
Module[{x, k, ffp, sffp},
(* return only explicit points *)
Developer`SetSystemOptions["ReduceOptions" -> 
                            {"DiscreteSolutionBound" -> 10^5}];
(* solve implicit sphere equation over F_p *)
ffp = Reduce[Sum[x[i]^2, {i, d}] == 1 + (* any integer k *) k p &&
              (* solutions in F_p only *)
              And @@ Table[0 <= x[i] <= p - 1, {i, d}] && 
              Element[k, Integers] && Element[Table[x[i], {i, d}], Integers], 
              Table[x[i], {i, d}], Backsubstitution -> True];
(* symmetrize ± *)
sffp = Map[If[# <= (p - 1)/2, #, # - p]&, 
           Table[x[i], {i, d}] /. {ToRules[ffp]}, {-1}];
(* map points to unit sphere *) #/Sqrt[#.#]& /@ sffp]

For points in 2D, we obtain regular ngons and some other symmetric arrangements of vertices. Here are a few examples shown.

Show[GraphicsArray[
 Table[Graphics[{PointSize[0.02], Point /@ spherePoints[2, Prime[k]]},
                AspectRatio -> Automatic, Frame -> True, FrameTicks -> False,
                PlotRange -> 1.1 {{-1, 1}, {-1, 1}}], {k, 2, 7}]]]

For points in 3D, we obtain the following point sets for small primes.

Show[GraphicsArray[
 Table[Graphics3D[{PointSize[0.01], Point /@ spherePoints[3, Prime[k]]},
                Boxed -> True,
                PlotRange -> 1.1 {{-1, 1}, {-1, 1}, {-1, 1}}], {k, 2, 7}]]]

Here are the projected points for the 3D case for some larger primes.

Show[GraphicsArray[#]]& /@
Partition[
 Table[Graphics[{PointSize[0.01], Point[Most[#]]& /@ spherePoints[3, Prime[k]]},
                AspectRatio -> Automatic, Frame -> True, FrameTicks -> False,
                PlotRange -> 1.1 {{-1, 1}, {-1, 1}}], {k, 8, 19}], 6]