Список всех интересных участков тетраэдра

Обновление ответа, 22/12 : Используя наблюдение Питера Шора , что существует гомоморфизм между отдельными секциями и перестановками объектов на кубе, перечислите все такие перестановки, представив группу симметрий куба как подгруппу SymmetricGroup [8] и используя GroupElements / Permute, найти назначения центроидов с помощью SAT-решателя Mathematica, выбрать наборы точек с различными сингулярными значениями, немного больше деталей и полный код приведен здесь

Вопрос

Интересный 2D-разрез - это плоскость, которая проходит через центр обычного 3D симплекс и две другие точки, каждая из которых является центроидом некоторого непустого подмножества вершин. Он определяется двумя подмножествами вершин. Например, {{1}, {1,2}} дает плоскость, определяемую тремя точками - центром тетраэдра, первой вершиной, и среднее значение первой и второй вершин.

Интересный набор секций - это набор, в котором никакие две секции не определяют одну и ту же плоскость при изменении названия вершины. Например, набор {{{1}, {2}}, {{3}, {4}}} не интересен. Есть ли эффективный подход к поиску интересного набора интересных разделов? Мне нужно что-то, что могло бы обобщить аналогичную проблему для трехмерных сечений симплексного 7D-графика и закончить в одночасье.

Моя попытка подхода приведена ниже. Одна из проблем заключается в том, что если вы проигнорируете геометрию, некоторые эквивалентные разделы будут сохранены, поэтому я получаю 10 разделов вместо 3. Более серьезная проблема заключается в том, что я использовал грубую силу, и он определенно не масштабируется и (требуется 10 ^ 17 сравнения для 7D симплекса)

_{(источник: yaroslavvb.com )}

Вот код Mathematica для создания изображения выше.

entropy[vec_] := Total[Table[p Log[p], {p, vec}]];
hadamard = KroneckerProduct @@ Table[{{1, 1}, {1, -1}}, {2}];
(* rows of hadamard matrix give simplex vertex coordinates *)

vertices = hadamard;
invHad = Inverse[hadamard];
m = {m1, m2, m3, m4};
vs = Range[4];

(* take a set of vertex averages, generate all combinations arising \
from labeling of vertices *)
vertexPermutations[set_] := (
   newSets = set /. Thread[vs -> #] & /@ Permutations[vs];
   Map[Sort, newSets, {2}]
   );
(* anchors used to define a section plane *)

sectionAnchors = Subsets[{1, 2, 3, 4}, {1, 3}];
(* all sets of anchor combinations with centroid anchor always \
included *)
anchorSets = Subsets[sectionAnchors, {2}];
anchorSets = Prepend[#, {1, 2, 3, 4}] & /@ anchorSets;
anchorSets = Map[Sort, anchorSets, {2}];
setEquivalent[set1_, set2_] := MemberQ[vertexPermutations[set1], set2];
equivalenceMatrix = 
  Table[Boole[setEquivalent[set1, set2]], {set1, anchorSets}, {set2, 
    anchorSets}];
Needs["GraphUtilities`"];
(* Representatives of "vertex-relabeling" equivalence classes of \
ancher sets *)
reps = First /@ StrongComponents[equivalenceMatrix];

average[verts_] := Total[vertices[[#]] & /@ verts]/Length[verts];
makeSection2D[vars_, {p0_, p1_, p2_}] := Module[{},
   v1 = p1 - p0 // Normalize;
   v2 = p2 - p0;
   v2 = v2 - (v1.v2) v1 // Normalize;
   Thread[vars -> (p0 + v1 x + v2 y)]
   ];

plotSection2D[f_, pointset_] := (
   simplex = 
    Graphics3D[{Yellow, Opacity[.2], 
      GraphicsComplex[Transpose@Rest@hadamard, 
       Polygon[Subsets[{1, 2, 3, 4}, {3}]]]}];
   anchors = average /@ pointset;
   section = makeSection2D[m, anchors];
   rf = Function @@ ({{x, y, z, u, v}, 
       And @@ Thread[invHad.{1, x, y, z} > 0]});
   mf = Function @@ {{p1, p2, p3, x, y}, f[invHad.m /. section]};
   sectionPlot = 
    ParametricPlot3D @@ {Rest[m] /. section, {x, -3, 3}, {y, -3, 3}, 
      RegionFunction -> rf, MeshFunctions -> {mf}};
   anchorPlot = Graphics3D[Sphere[Rest[#], .05] & /@ anchors];
   Show[simplex, sectionPlot, anchorPlot]
   );
plots = Table[
   plotSection2D[entropy, anchorSets[[rep]]], {rep, reps}];
GraphicsGrid[Partition[plots, 3]]