How can I reduce the time to select three points on sphere to make an equilateral triangle?

Question

I have this code

ClearAll[a, b, r, c];
a = 1;
b = 3;
c = 5;
r = 15; ss = 
 Subsets[{x, y, z} /. 
   Solve[{(x - a)^2 + (y - b)^2 + (z - c)^2 == r^2}, {x, y, z}, 
    Integers], {3}];
list = Timing[
  Select[ss, ( 
    EuclideanDistance[#[[1]], #[[2]]] ==  
      EuclideanDistance[#[[1]], #[[3]]] == 
      EuclideanDistance[#[[3]], #[[2]]] &) ]]

cvgmt · Accepted Answer · 2024-02-09T03:01:11.840

The same way as my previous answer. https://mathematica.stackexchange.com/a/289295/72111

Clear["Global`*"];
a = 1;
b = 3;
c = 5;
r = 15;
pts = {x, y, z} /. 
   Solve[{(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}]; (* The `DistanceMatrix` *)
groups = GatherBy[Flatten[pairs, 1], Last]; (* The distance *)
matrixs = SparseArray[# -> 1, Dimensions@pairs] & /@ Keys /@ groups;
adjgraphs = AdjacencyGraph /@ matrixs;
cycles = 
  FindIsomorphicSubgraph[#, CycleGraph[3], All] & /@ adjgraphs;
triangles = 
   pts[[#]] & /@ VertexList /@ Flatten[cycles]; // AbsoluteTiming

Graphics3D[{RandomColor[], Triangle@#} & /@ triangles]
Sort@list[[2]] == Sort@triangles

True.

How can I reduce the time to select three points on sphere to make an equilateral triangle?

1 Answers1