0
$\begingroup$

To make it simple, I have generated a list where sub-lists are vertex coordinates of regular or non-regular polytope. For example, here's a list that can be generated:

 ptsOrbit[w_] := 
  Module[{liste = rfcart[w]}, 
   Table[orbit[{liste[[i]]}], {i, 1, Length@liste}]];

 ptsOrbit[3]

 {{{1/2, 1/2, 1/2}, {1/6, 1/6, -(5/6)}, {1/6, -(5/6), 1/6}, {-(5/6), 1/
   6, 1/6}}, {{5/9, 5/9, 2/9}, {5/9, 2/9, 5/9}, {1/3, 1/
   3, -(2/3)}, {2/9, 5/9, 5/9}, {2/9, -(1/9), -(7/9)}, {1/3, -(2/3), 
   1/3}, {-(1/9), 2/9, -(7/9)}, {2/9, -(7/9), -(1/9)}, {-(2/3), 1/3, 
   1/3}, {-(1/9), -(7/9), 2/9}, {-(7/9), 2/
   9, -(1/9)}, {-(7/9), -(1/9), 2/9}}, {{11/18, 11/18, -(1/18)}, {11/
   18, -(1/18), 11/18}, {1/2, 1/2, -(1/2)}, {-(1/18), 11/18, 11/
   18}, {5/18, -(7/18), -(13/18)}, {1/2, -(1/2), 1/2}, {-(7/18), 5/
   18, -(13/18)}, {5/18, -(13/18), -(7/18)}, {-(1/2), 1/2, 1/
   2}, {-(7/18), -(13/18), 5/18}, {-(13/18), 5/
   18, -(7/18)}, {-(13/18), -(7/18), 5/18}}, {{2/3, 2/3, -(1/3)}, {2/
   3, -(1/3), 2/3}, {-(1/3), 2/3, 2/3}, {1/
   3, -(2/3), -(2/3)}, {-(2/3), 1/3, -(2/3)}, {-(2/3), -(2/3), 1/
   3}}, {{11/18, 5/18, 5/18}, {5/18, 11/18, 5/18}, {7/18, 1/
   18, -(11/18)}, {5/18, 5/18, 11/18}, {1/18, 7/18, -(11/18)}, {7/
   18, -(11/18), 1/18}, {-(1/18), -(1/18), -(13/18)}, {1/18, -(11/18),
    7/18}, {-(11/18), 7/18, 1/
   18}, {-(1/18), -(13/18), -(1/18)}, {-(11/18), 1/18, 7/
   18}, {-(13/18), -(1/18), -(1/18)}}, {{2/3, 1/3, 0}, {1/3, 2/3, 
   0}, {2/3, 0, 1/3}, {5/9, 2/9, -(4/9)}, {1/3, 0, 2/3}, {2/9, 5/
   9, -(4/9)}, {0, 2/3, 1/3}, {4/9, -(2/9), -(5/9)}, {5/9, -(4/9), 2/
   9}, {0, 1/3, 2/3}, {0, -(1/3), -(2/3)}, {2/9, -(4/9), 5/
   9}, {-(2/9), 4/9, -(5/9)}, {4/9, -(5/9), -(2/9)}, {-(4/9), 5/9, 2/
   9}, {-(1/3), 0, -(2/3)}, {0, -(2/3), -(1/3)}, {-(4/9), 2/9, 5/
   9}, {-(2/9), -(5/9), 4/9}, {-(5/9), 4/9, -(2/9)}, {-(1/3), -(2/3), 
   0}, {-(2/3), 0, -(1/3)}, {-(5/9), -(2/9), 4/9}, {-(2/3), -(1/3), 
   0}}, {{13/18, 7/18, -(5/18)}, {7/18, 13/18, -(5/18)}, {13/
   18, -(5/18), 7/18}, {7/18, -(5/18), 13/18}, {-(5/18), 13/18, 7/
   18}, {1/2, -(1/2), -(1/2)}, {-(5/18), 7/18, 13/18}, {1/
   18, -(11/18), -(11/18)}, {-(1/2), 1/2, -(1/2)}, {-(11/18), 1/
   18, -(11/18)}, {-(1/2), -(1/2), 1/2}, {-(11/18), -(11/18), 1/
   18}}, {{13/18, 1/18, 1/18}, {1/18, 13/18, 1/18}, {11/
   18, -(1/18), -(7/18)}, {1/18, 1/18, 13/18}, {-(1/18), 11/
   18, -(7/18)}, {11/
   18, -(7/18), -(1/18)}, {-(5/18), -(5/18), -(11/18)}, {-(1/18), -(7/
    18), 11/18}, {-(7/18), 11/
   18, -(1/18)}, {-(5/18), -(11/18), -(5/18)}, {-(7/18), -(1/18), 11/
   18}, {-(11/18), -(5/18), -(5/18)}}, {{7/9, 1/9, -(2/9)}, {1/9, 7/
   9, -(2/9)}, {7/9, -(2/9), 1/9}, {1/9, -(2/9), 7/9}, {-(2/9), 7/9, 
   1/9}, {2/3, -(1/3), -(1/3)}, {-(2/9), 1/9, 7/
   9}, {-(2/9), -(5/9), -(5/9)}, {-(1/3), 2/
   3, -(1/3)}, {-(5/9), -(2/9), -(5/9)}, {-(1/3), -(1/3), 2/
   3}, {-(5/9), -(5/9), -(2/9)}}, {{5/6, -(1/6), -(1/6)}, {-(1/6), 5/
   6, -(1/6)}, {-(1/6), -(1/6), 5/6}, {-(1/2), -(1/2), -(1/2)}}, {{1/
   3, 1/3, 1/3}, {1/9, 1/9, -(5/9)}, {1/9, -(5/9), 1/9}, {-(5/9), 1/9,
    1/9}}, {{7/18, 7/18, 1/18}, {7/18, 1/18, 7/18}, {5/18, 5/
   18, -(7/18)}, {1/18, 7/18, 7/18}, {1/6, -(1/6), -(1/2)}, {5/
   18, -(7/18), 5/18}, {-(1/6), 1/6, -(1/2)}, {1/
   6, -(1/2), -(1/6)}, {-(7/18), 5/18, 5/18}, {-(1/6), -(1/2), 1/
   6}, {-(1/2), 1/6, -(1/6)}, {-(1/2), -(1/6), 1/6}}, {{4/9, 4/
   9, -(2/9)}, {4/9, -(2/9), 4/9}, {-(2/9), 4/9, 4/9}, {2/
   9, -(4/9), -(4/9)}, {-(4/9), 2/9, -(4/9)}, {-(4/9), -(4/9), 2/
   9}}, {{4/9, 1/9, 1/9}, {1/9, 4/9, 1/9}, {1/3, 0, -(1/3)}, {1/9, 1/
   9, 4/9}, {0, 1/3, -(1/3)}, {1/3, -(1/3), 
   0}, {-(1/9), -(1/9), -(4/9)}, {0, -(1/3), 1/3}, {-(1/3), 1/3, 
   0}, {-(1/9), -(4/9), -(1/9)}, {-(1/3), 0, 1/
   3}, {-(4/9), -(1/9), -(1/9)}}, {{1/2, 1/6, -(1/6)}, {1/6, 1/
   2, -(1/6)}, {1/2, -(1/6), 1/6}, {1/6, -(1/6), 1/2}, {-(1/6), 1/2, 
   1/6}, {7/18, -(5/18), -(5/18)}, {-(1/6), 1/6, 1/
   2}, {-(1/18), -(7/18), -(7/18)}, {-(5/18), 7/
   18, -(5/18)}, {-(7/18), -(1/18), -(7/18)}, {-(5/18), -(5/18), 7/
   18}, {-(7/18), -(7/18), -(1/18)}}, {{5/9, -(1/9), -(1/9)}, {-(1/9),
    5/9, -(1/9)}, {-(1/9), -(1/9), 5/
   9}, {-(1/3), -(1/3), -(1/3)}}, {{1/6, 1/6, 1/6}, {1/18, 1/
   18, -(5/18)}, {1/18, -(5/18), 1/18}, {-(5/18), 1/18, 1/18}}, {{2/9,
    2/9, -(1/9)}, {2/9, -(1/9), 2/9}, {-(1/9), 2/9, 2/9}, {1/
   9, -(2/9), -(2/9)}, {-(2/9), 1/9, -(2/9)}, {-(2/9), -(2/9), 1/
   9}}, {{5/18, -(1/18), -(1/18)}, {-(1/18), 5/
   18, -(1/18)}, {-(1/18), -(1/18), 5/
   18}, {-(1/6), -(1/6), -(1/6)}}, {{0, 0, 0}}}

Now, from every sub-list there is, I would like to create the edges of the polytope. But my main issue is that my code is only considering regular polytopes:

Lines[w_] := 
  Table[Graphics3D[{With[{pts = ptsOrbit[w]}, {Table[
        If[N@EuclideanDistance[pts[[k]][[i]], pts[[k]][[j]]] == 
          Min@DeleteCases[
            Flatten@
             Table[EuclideanDistance[pts[[k]][[i]], 
               pts[[k]][[j]]], {i, 1, Length@pts[[k]]}, {j, 1, 
               Length@pts[[k]]}], 0], 
         Line[{pts[[k]][[i]], pts[[k]][[j]]}]], {i, 
         Length@pts[[k]]}, {j, Length@pts[[k]]}], PointSize[0.015], 
       Point@pts[[k]]}]}, Boxed -> False], {k, 1, 
    Length@ptsOrbit[w]}];

So the result is incomplete. Any advice or idea to help me consider non-regular polytopes?

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.