# How can I get all squares on this sphere so that its coordinates are integer numbers?

I have the sphere (x-2)^2 + (y-4)^2 + (z-6)^2 = 15^2. I want to select all squares on this sphere so that its coordiantes are twelve different integer numbers like this {-8, 15, 8}, {-3, 6, 20}, {12, 9, 16}, {7, 18, 4}. I tried

ClearAll[a, b, r, c];
a = 2;
b = 4;
c = 6;
r = 15; ss =
Subsets[{x, y, z} /.
Solve[{(x - a)^2 + (y - b)^2 + (z - c)^2 == r^2}, {x, y, z},
Integers], {4}];


How can I find four points on a sphere to make a square?

UPDATE

ClearAll[a, b, r, c];
a = 2;
b = 4;
c = 6;
r = 15;
ss = Subsets[{x, y, z} /.
Solve[{(x \[Minus] a)^2 + (y \[Minus] b)^2 + (z \[Minus] c)^2 ==
r^2}, {x, y, z}, Integers], {2}];
k = Select[ss, EuclideanDistance[#[[1]], #[[2]]] == 2 r &]


{{{-13, 4, 6}, {17, 4, 6}}, {{-12, -1, 4}, {16, 9, 8}}, {{-12, -1, 8}, {16, 9, 4}}, {{-12, 2, 1}, {16, 6, 11}}, {{-12, 2, 11}, {16, 6, 1}}, {{-12, 6, 1}, {16, 2, 11}}, {{-12, 6, 11}, {16, 2, 1}}, {{-12, 9, 4}, {16, -1, 8}}, {{-12, 9, 8}, {16, -1, 4}}, {{-10, -5, 6}, {14, 13, 6}}, {{-10, 4, -3}, {14, 4, 15}}, {{-10, 4, 15}, {14, 4, -3}}, {{-10, 13, 6}, {14, -5, 6}}, {{-9, -6, 4}, {13, 14, 8}}, {{-9, -6, 8}, {13, 14, 4}}, {{-9, 2, -4}, {13, 6, 16}}, {{-9, 2, 16}, {13, 6, -4}}, {{-9, 6, -4}, {13, 2, 16}}, {{-9, 6, 16}, {13, 2, -4}}, {{-9, 14, 4}, {13, -6, 8}}, {{-9, 14, 8}, {13, -6, 4}}, {{-8, -7, 4}, {12, 15, 8}}, {{-8, -7, 8}, {12, 15, 4}}, {{-8, -6, 1}, {12, 14, 11}}, {{-8, -6, 11}, {12, 14, 1}}, {{-8, -1, -4}, {12, 9, 16}}, {{-8, -1, 16}, {12, 9, -4}}, {{-8, 2, -5}, {12, 6, 17}}, {{-8, 2, 17}, {12, 6, -5}}, {{-8, 6, -5}, {12, 2, 17}}, {{-8, 6, 17}, {12, 2, -5}}, {{-8, 9, -4}, {12, -1, 16}}, {{-8, 9, 16}, {12, -1, -4}}, {{-8, 14, 1}, {12, -6, 11}}, {{-8, 14, 11}, {12, -6, 1}}, {{-8, 15, 4}, {12, -7, 8}}, {{-8, 15, 8}, {12, -7, 4}}, {{-7, -8, 6}, {11, 16, 6}}, {{-7, 4, -6}, {11, 4, 18}}, {{-7, 4, 18}, {11, 4, -6}}, {{-7, 16, 6}, {11, -8, 6}}, {{-3, -10, 4}, {7, 18, 8}}, {{-3, -10, 8}, {7, 18, 4}}, {{-3, -6, -4}, {7, 14, 16}}, {{-3, -6, 16}, {7, 14, -4}}, {{-3, 2, -8}, {7, 6, 20}}, {{-3, 2, 20}, {7, 6, -8}}, {{-3, 6, -8}, {7, 2, 20}}, {{-3, 6, 20}, {7, 2, -8}}, {{-3, 14, -4}, {7, -6, 16}}, {{-3, 14, 16}, {7, -6, -4}}, {{-3, 18, 4}, {7, -10, 8}}, {{-3, 18, 8}, {7, -10, 4}}, {{0, -10, 1}, {4, 18, 11}}, {{0, -10, 11}, {4, 18, 1}}, {{0, -7, -4}, {4, 15, 16}}, {{0, -7, 16}, {4, 15, -4}}, {{0, -6, -5}, {4, 14, 17}}, {{0, -6, 17}, {4, 14, -5}}, {{0, -1, -8}, {4, 9, 20}}, {{0, -1, 20}, {4, 9, -8}}, {{0, 9, -8}, {4, -1, 20}}, {{0, 9, 20}, {4, -1, -8}}, {{0, 14, -5}, {4, -6, 17}}, {{0, 14, 17}, {4, -6, -5}}, {{0, 15, -4}, {4, -7, 16}}, {{0, 15, 16}, {4, -7, -4}}, {{0, 18, 1}, {4, -10, 11}}, {{0, 18, 11}, {4, -10, 1}}, {{2, -11, 6}, {2, 19, 6}}, {{2, -8, -3}, {2, 16, 15}}, {{2, -8, 15}, {2, 16, -3}}, {{2, -5, -6}, {2, 13, 18}}, {{2, -5, 18}, {2, 13, -6}}, {{2, 4, -9}, {2, 4, 21}}}

I think, we can select two elements of k so that two this elements perpendicular to.

With Maple, I get the result

{[[-12, -1, 4], [-9, 14, 8], [0, 9, 20], [-3, -6, 16]], [[-12, -1, 8] , [-9, 14, 4], [0, 9, -8], [-3, -6, -4]], [[-12, -1, 8], [-8, 14, 11] , [4, 9, 20], [0, -6, 17]], [[-12, 2, 1], [-9, 6, 16], [0, 18, 11], [- 3, 14, -4]], [[-12, 2, 1], [-8, -1, 16], [4, -10, 11], [0, -7, -4]], [ [-12, 2, 11], [-9, 6, -4], [0, 18, 1], [-3, 14, 16]], [[-12, 2, 11], [ -8, -1, -4], [4, -10, 1], [0, -7, 16]], [[-12, 6, 1], [-9, 2, 16], [0 , -10, 11], [-3, -6, -4]], [[-12, 6, 1], [-8, 9, 16], [4, 18, 11], [0 , 15, -4]], [[-12, 6, 11], [-9, 2, -4], [0, -10, 1], [-3, -6, 16]], [[ -12, 6, 11], [-8, 9, -4], [4, 18, 1], [0, 15, 16]], [[-12, 9, 4], [-9 , -6, 8], [0, -1, 20], [-3, 14, 16]], [[-12, 9, 8], [-9, -6, 4], [0, - 1, -8], [-3, 14, -4]], [[-12, 9, 8], [-8, -6, 11], [4, -1, 20], [0, 14 , 17]], [[-9, 2, -4], [0, -10, 11], [13, 6, 16], [4, 18, 1]], [[-9, 2 , 16], [0, -10, 1], [13, 6, -4], [4, 18, 11]], [[-9, 6, -4], [0, 18, 11], [13, 2, 16], [4, -10, 1]], [[-9, 6, 16], [0, 18, 1], [13, 2, -4] , [4, -10, 11]], [[-8, -7, 8], [-3, 2, 20], [12, -1, 16], [7, -10, 4]] , [[-8, -6, 11], [-3, 6, 20], [12, 2, 17], [7, -10, 8]], [[-8, -1, -4] , [-3, 18, 4], [12, 9, 16], [7, -10, 8]], [[-8, -1, -4], [0, 18, 1], [ 12, 9, 16], [4, -10, 11]], [[-8, -1, 16], [-3, -10, 4], [12, -7, 8], [ 7, 2, 20]], [[-8, -1, 16], [-3, 18, 8], [12, 9, -4], [7, -10, 4]], [[- 8, -1, 16], [0, 18, 11], [12, 9, -4], [4, -10, 1]], [[-8, 2, -5], [-3 , 18, 8], [12, 6, 17], [7, -10, 4]], [[-8, 2, 17], [-3, -10, 8], [12, -6, 11], [7, 6, 20]], [[-8, 2, 17], [-3, 18, 4], [12, 6, -5], [7, -10 , 8]], [[-8, 6, -5], [-3, -10, 8], [12, 2, 17], [7, 18, 4]], [[-8, 6, 17], [-3, -10, 4], [12, 2, -5], [7, 18, 8]], [[-8, 6, 17], [-3, 18, 8] , [12, 14, 11], [7, 2, 20]], [[-8, 9, -4], [-3, -10, 4], [12, -1, 16] , [7, 18, 8]], [[-8, 9, -4], [0, -10, 1], [12, -1, 16], [4, 18, 11]], [[-8, 9, 16], [-3, -10, 8], [12, -1, -4], [7, 18, 4]], [[-8, 9, 16], [ -3, 18, 4], [12, 15, 8], [7, 6, 20]], [[-8, 9, 16], [0, -10, 11], [12 , -1, -4], [4, 18, 1]], [[-8, 14, 11], [-3, 2, 20], [12, 6, 17], [7, 18, 8]], [[-8, 15, 8], [-3, 6, 20], [12, 9, 16], [7, 18, 4]], [[0, -1 , 20], [4, 14, 17], [16, 9, 8], [12, -6, 11]], [[0, 9, 20], [4, -6, 17 ], [16, -1, 8], [12, 14, 11]]}

• a = 1; b = 2; c = 5; or a = 2; b = 4; c = 6;? Somewhat related: mathematica.stackexchange.com/q/181239/1871 Commented Aug 18, 2023 at 0:29
• I wonder if PowersRepresentations can be used here in a neat way (after shifting sphere to the origin)? Edit: after reading the link from @xzczd, I definitely think you should explore PowersRepresentations as it just seems very natural to use here for finding integer valued coordinates on a spherical surface
– ydd
Commented Aug 18, 2023 at 1:49
• @xzczd I am trying. Thanks for your comment. Commented Aug 18, 2023 at 3:52
• I retract my last comment (now deleted). If all the squares are needed, the method under your previous question is not enough. Commented Aug 18, 2023 at 4:54
• I may have misunderstood the question. From the code provided I had thought it was to find integer triples on the sphere surface. But reading again it seems the idea is to find quartets of those triples that give a square (hence of necessity are coplanar). Commented Aug 18, 2023 at 18:27

• For four points {p1,p2,p3,p4} on the sphere, if exist two segments bisect each other (p1 + p2)/2 ==( p3 + p4)/2 and perpendicularly (p1 - p2) . (p3 - p4) == 0, then {p1,p2,p3,p4} build a square.
Clear[test0,test];
test0[{p1_, p2_, p3_,
p4_}] := (p1 + p2 == p3 + p4 && (p1 - p2) . (p3 - p4) == 0);
test[{p1_, p2_, p3_, p4_}] :=
test0[{p1, p2, p3, p4}] || test0[{p1, p3, p2, p4}] ||
test0[{p1, p4, p2, p3}]

ClearAll[a, b, r, c,ss];
a = 2;
b = 4;
c = 6;
r = 15;
ss =
Subsets[{x, y, z} /.
Solve[{(x - a)^2 + (y - b)^2 + (z - c)^2 == r^2}, {x, y, z},
Integers], {4}];
squares = Pick[ss, test /@ ss];
squaresPoints = (Polygon /@ (ConvexHullRegion /@ squares)[[;; ,
1]])[[;; , 1]]

Graphics3D[{Polygon /@ RandomSample[squaresPoints, 5], Opacity[.2],
Ball[{2, 4, 6}, 15]}, Boxed -> False]


• The 327 squares are different.
Outer[Boole@RegionEqual[#1, #2] &, Polygon /@ squaresPoints,
Polygon /@ squaresPoints] == IdentityMatrix[Length@squaresPoints]


True

• If we want the twelve different integer numbers,we can select it from the 327 squares. There are only 40 such squares.
list=Select[squaresPoints, Length@*Union @@ # == 12 &]

 {{{-12, -1, 4}, {-9, 14, 8}, {0, 9, 20}, {-3, -6, 16}}, {{-12, -1,
8}, {-9, 14, 4}, {0, 9, -8}, {-3, -6, -4}}, {{-12, -1, 8}, {-8, 14,
11}, {4, 9, 20}, {0, -6, 17}}, {{-3, 14, -4}, {-12, 2, 1}, {-9, 6,
16}, {0, 18, 11}}, {{-12, 2, 1}, {-8, -1, 16}, {4, -10,
11}, {0, -7, -4}}, {{0, 18, 1}, {-3, 14, 16}, {-12, 2, 11}, {-9,
6, -4}}, {{0, -7, 16}, {-12, 2, 11}, {-8, -1, -4}, {4, -10,
1}}, {{-12, 6, 1}, {-9, 2, 16}, {0, -10, 11}, {-3, -6, -4}}, {{0,
15, -4}, {-12, 6, 1}, {-8, 9, 16}, {4, 18, 11}}, {{-3, -6,
16}, {-12, 6, 11}, {-9, 2, -4}, {0, -10, 1}}, {{0, 15, 16}, {-12,
6, 11}, {-8, 9, -4}, {4, 18, 1}}, {{-3, 14, 16}, {-12, 9,
4}, {-9, -6, 8}, {0, -1, 20}}, {{-12, 9, 8}, {-9, -6,
4}, {0, -1, -8}, {-3, 14, -4}}, {{-12, 9, 8}, {-8, -6, 11}, {4, -1,
20}, {0, 14, 17}}, {{-9, 2, -4}, {0, -10, 11}, {13, 6, 16}, {4,
18, 1}}, {{-9, 2, 16}, {0, -10, 1}, {13, 6, -4}, {4, 18,
11}}, {{13, 2, 16}, {4, -10, 1}, {-9, 6, -4}, {0, 18, 11}}, {{-9,
6, 16}, {0, 18, 1}, {13, 2, -4}, {4, -10, 11}}, {{7, -10,
4}, {-8, -7, 8}, {-3, 2, 20}, {12, -1, 16}}, {{-8, -6, 11}, {-3, 6,
20}, {12, 2, 17}, {7, -10, 8}}, {{7, -10, 8}, {-8, -1, -4}, {-3,
18, 4}, {12, 9, 16}}, {{-8, -1, -4}, {0, 18, 1}, {12, 9,
16}, {4, -10, 11}}, {{-8, -1, 16}, {-3, -10, 4}, {12, -7, 8}, {7,
2, 20}}, {{7, -10, 4}, {-8, -1, 16}, {-3, 18, 8}, {12,
9, -4}}, {{4, -10, 1}, {-8, -1, 16}, {0, 18, 11}, {12,
9, -4}}, {{-8, 2, -5}, {-3, 18, 8}, {12, 6, 17}, {7, -10,
4}}, {{12, -6, 11}, {7, 6, 20}, {-8, 2, 17}, {-3, -10, 8}}, {{-8,
2, 17}, {-3, 18, 4}, {12, 6, -5}, {7, -10, 8}}, {{-8,
6, -5}, {-3, -10, 8}, {12, 2, 17}, {7, 18, 4}}, {{-8, 6,
17}, {-3, -10, 4}, {12, 2, -5}, {7, 18, 8}}, {{-8, 6, 17}, {-3, 18,
8}, {12, 14, 11}, {7, 2, 20}}, {{-8, 9, -4}, {-3, -10,
4}, {12, -1, 16}, {7, 18, 8}}, {{4, 18, 11}, {-8, 9, -4}, {0, -10,
1}, {12, -1, 16}}, {{-8, 9, 16}, {-3, -10, 8}, {12, -1, -4}, {7,
18, 4}}, {{-8, 9, 16}, {-3, 18, 4}, {12, 15, 8}, {7, 6, 20}}, {{4,
18, 1}, {-8, 9, 16}, {0, -10, 11}, {12, -1, -4}}, {{12, 6, 17}, {7,
18, 8}, {-8, 14, 11}, {-3, 2, 20}}, {{7, 18, 4}, {-8, 15, 8}, {-3,
6, 20}, {12, 9, 16}}, {{16, 9, 8}, {12, -6, 11}, {0, -1, 20}, {4,
14, 17}}, {{0, 9, 20}, {4, -6, 17}, {16, -1, 8}, {12, 14, 11}}}

Graphics3D[{EdgeForm[Thin], FaceForm[RandomColor[]], Polygon[#]} & /@
list, Boxed -> False]


• Check the result.
pts = {{-8, 15, 8}, {-3, 6, 20}, {12, 9, 16}, {7, 18, 4}};
MemberQ[Sort /@ list, Sort@pts]


True.

• Your results seems biger than Maple's results. I think, square ABCD and DCBA is one. Commented Aug 18, 2023 at 14:51
• Please note the order of vertices of square pts = {pa, pb, pc, pd} = {{-13, 4, 6}, {2, -11, 6}, {2, 19, 6}, {17, 4, 6}} pts // Polygon // Graphics3D Commented Aug 18, 2023 at 15:10
• I want to select all squares on this sphere so that its coordiantes are twelve different integer numbers. Commented Aug 18, 2023 at 15:12
• @Laurenso I have check the 327 squaresPoints,they are different. Commented Aug 18, 2023 at 15:41
Clear["Global*"];
{a, b, c} = {2, 4, 6};
r = 15;
pts = SolveValues[{(x - a)^2 + (y - b)^2 + (z - c)^2 == r^2}, {x, y,
z}, Integers];
pairs = Table[{i,
j} -> (pts[[i]] - pts[[j]]) . (pts[[i]] - pts[[j]]), {i,
Length@pts}, {j, Length@pts}];
groups = GatherBy[Flatten[pairs, 1], Last];
matrixs = SparseArray[# -> 1, Dimensions@pairs] & /@ Keys /@ groups;
cycles =
FindIsomorphicSubgraph[#, CycleGraph[4], All] & /@ adjgraphs;
test0[{p1_, p2_, p3_,
p4_}] := (p1 + p2 == p3 + p4 && (p1 - p2) . (p3 - p4) == 0);
test[{p1_, p2_, p3_, p4_}] :=
test0[{p1, p2, p3, p4}] || test0[{p1, p3, p2, p4}] ||
test0[{p1, p4, p2, p3}];
squares =
Flatten[Table[
Pick[pts[[#]] & /@ VertexList /@ cycles[[i]],
test@pts[[#]] & /@ VertexList /@ cycles[[i]]], {i,
Length@cycles}] /. {} -> Nothing, 1];
list = Select[squares, Length@*Union @@ # == 12 &];
Graphics3D[{EdgeForm[Thin], FaceForm[RandomColor[]], Polygon[#]} & /@
list, Boxed -> False]


Definitely a task for PowersRepresentations.

First find triples of nonnegatives with squares summing to 15^2.

nnvals = PowersRepresentations[15^2, 3, 2]

(* Out[35]= {{0, 0, 15}, {0, 9, 12}, {2, 5, 14}, {2, 10, 11}, {5, 10, 10}} *)


Now allow plus/minus signs.

signs = Tuples[{-1, 1}, {3}];
alltriples = Union[Flatten[Outer[Times, signs, nnvals, 1], 1]]

(* Out[38]= {{-5, -10, -10}, {-5, -10, 10}, {-5, 10, -10}, {-5, 10,
10}, {-2, -10, -11}, {-2, -10, 11}, {-2, -5, -14}, {-2, -5,
14}, {-2, 5, -14}, {-2, 5, 14}, {-2, 10, -11}, {-2, 10,
11}, {0, -9, -12}, {0, -9, 12}, {0, 0, -15}, {0, 0, 15}, {0,
9, -12}, {0, 9, 12}, {2, -10, -11}, {2, -10,
11}, {2, -5, -14}, {2, -5, 14}, {2, 5, -14}, {2, 5, 14}, {2,
10, -11}, {2, 10, 11}, {5, -10, -10}, {5, -10, 10}, {5,
10, -10}, {5, 10, 10}} *)


Take all distinct permutations, and then add the offsets (2,4,6) in this example).

permuted = Union[Flatten[Map[Permutations, alltriples], 1]];
offsets = {2, 4, 6};
triples = Sort[Map[# + {2, 4, 6} &, permuted]]

Out[46]= {{-13, 4, 6}, {-12, -1, 4}, {-12, -1, 8}, {-12, 2, 1}, {-12,
2, 11}, {-12, 6, 1}, {-12, 6, 11}, {-12, 9, 4}, {-12, 9,
8}, {-10, -5, 6}, {-10, 4, -3}, {-10, 4, 15}, {-10, 13, 6}, {-9, -6,
4}, {-9, -6, 8}, {-9, 2, -4}, {-9, 2, 16}, {-9, 6, -4}, {-9, 6,
16}, {-9, 14, 4}, {-9, 14, 8}, {-8, -7, 4}, {-8, -7, 8}, {-8, -6,
1}, {-8, -6, 11}, {-8, -1, -4}, {-8, -1, 16}, {-8, 2, -5}, {-8, 2,
17}, {-8, 6, -5}, {-8, 6, 17}, {-8, 9, -4}, {-8, 9, 16}, {-8, 14,
1}, {-8, 14, 11}, {-8, 15, 4}, {-8, 15, 8}, {-7, -8, 6}, {-7,
4, -6}, {-7, 4, 18}, {-7, 16, 6}, {-3, -10, 4}, {-3, -10,
8}, {-3, -6, -4}, {-3, -6, 16}, {-3, 2, -8}, {-3, 2, 20}, {-3,
6, -8}, {-3, 6, 20}, {-3, 14, -4}, {-3, 14, 16}, {-3, 18, 4}, {-3,
18, 8}, {0, -10, 1}, {0, -10, 11}, {0, -7, -4}, {0, -7,
16}, {0, -6, -5}, {0, -6, 17}, {0, -1, -8}, {0, -1, 20}, {0,
9, -8}, {0, 9, 20}, {0, 14, -5}, {0, 14, 17}, {0, 15, -4}, {0, 15,
16}, {0, 18, 1}, {0, 18, 11}, {2, -11, 6}, {2, -8, -3}, {2, -8,
15}, {2, -5, -6}, {2, -5, 18}, {2, 4, -9}, {2, 4, 21}, {2,
13, -6}, {2, 13, 18}, {2, 16, -3}, {2, 16, 15}, {2, 19, 6}, {4, -10,
1}, {4, -10, 11}, {4, -7, -4}, {4, -7, 16}, {4, -6, -5}, {4, -6,
17}, {4, -1, -8}, {4, -1, 20}, {4, 9, -8}, {4, 9, 20}, {4,
14, -5}, {4, 14, 17}, {4, 15, -4}, {4, 15, 16}, {4, 18, 1}, {4, 18,
11}, {7, -10, 4}, {7, -10, 8}, {7, -6, -4}, {7, -6, 16}, {7,
2, -8}, {7, 2, 20}, {7, 6, -8}, {7, 6, 20}, {7, 14, -4}, {7, 14,
16}, {7, 18, 4}, {7, 18, 8}, {11, -8, 6}, {11, 4, -6}, {11, 4,
18}, {11, 16, 6}, {12, -7, 4}, {12, -7, 8}, {12, -6, 1}, {12, -6,
11}, {12, -1, -4}, {12, -1, 16}, {12, 2, -5}, {12, 2, 17}, {12,
6, -5}, {12, 6, 17}, {12, 9, -4}, {12, 9, 16}, {12, 14, 1}, {12, 14,
11}, {12, 15, 4}, {12, 15, 8}, {13, -6, 4}, {13, -6, 8}, {13,
2, -4}, {13, 2, 16}, {13, 6, -4}, {13, 6, 16}, {13, 14, 4}, {13, 14,
8}, {14, -5, 6}, {14, 4, -3}, {14, 4, 15}, {14, 13, 6}, {16, -1,
4}, {16, -1, 8}, {16, 2, 1}, {16, 2, 11}, {16, 6, 1}, {16, 6,
11}, {16, 9, 4}, {16, 9, 8}, {17, 4, 6}} *)

• Only solve a = 2; b = 4; c = 6; r = 15; SolveValues[{(x - a)^2 + (y - b)^2 + (z - c)^2 == r^2}, {x, y, z}, Integers]` Commented Aug 19, 2023 at 0:03
• This doesn't answer the question… As mentioned in the question, OP wants to "find four points on a sphere to make a square. " (Update: oh, you've already noticed this in the comment under the question. ) Commented Aug 19, 2023 at 0:21