Colour-Decorated Hypergraph Growth to Q102
Colour-Decorated Hypergraph Growth to Q102
What Rosen closure forces onto a Wolfram-style hypergraph
Start with a bare hypergraph rewriting system in the spirit of the Wolfram Physics Project: featureless atoms, ternary edges, one local rewrite. Now add a single demand -- that the system be closed to efficient causation in Robert Rosen's sense, so that every producer in the system is itself produced by the system. That demand is not free. It forces a chain of structure, each link the only survivor of an obstruction:
- closure needs exactly three functional roles, so edges are ternary (arity 3);
- no discrete labelling can satisfy closure -- every finite decoration is exhaustively obstructed (all 256 binary rules fail; Z2, Z3, ..., Z8 all fail);
- the only continuous composition that closes is a cross product on a 3-vector (Hurwitz);
- and the field must be C, not R -- the self-referential edge needs an isotropic unit vector (v . v = 0), which R^3 has none of and C^3 does, e.g. (1, i, 0)/Sqrt[2].
- no discrete labelling can satisfy closure -- every finite decoration is exhaustively obstructed (all 256 binary rules fail; Z2, Z3, ..., Z8 all fail);
- the only continuous composition that closes is a cross product on a 3-vector (Hurwitz);
- and the field must be C, not R -- the self-referential edge needs an isotropic unit vector (v . v = 0), which R^3 has none of and C^3 does, e.g. (1, i, 0)/Sqrt[2].
So the rule is not a modelling choice -- it is forced: compose(a, b) = conj(a x b) on unit vectors in C^3 (the conjugation is what keeps it SU(3)-equivariant). This notebook runs that forced system. Six seed colours in C^3, the complete ternary topology K6^3, and the one rule. It grows the multiway hypergraph, quotients it exactly by ray-equivalence -- no threshold, no floating point, Gaussian integers throughout -- and closes it under charge conjugation. The colour quotient reaches its fixed point at generation 2 (6 -> 21 -> 51 classes); conjugation closure doubles it to Q102 = Q51 union C(Q51), 102 vertices. Q102 carries the sign data of a real spectral triple of KO-dimension 6 (J^2 = +I and {J, gamma} = 0) -- the same KO-dimension the Standard Model's internal space carries in noncommutative geometry. Deterministic and seed-free: re-evaluating reproduces 102 every time.
This is deliberately not a stock WolframModel, and that is the point. A WolframModel is the bare, pre-closure substrate: featureless atoms, structural pattern rewriting. The colour is not an attribute bolted onto it -- it is what closure does to it. The custom evaluator below is therefore not a workaround but the forced system itself, and the colour algebra it carries is exactly what produces the KO-dimension-6 result that a bare model cannot even state. Evaluate the cells top to bottom.
1. The rewriting rule (exact colour algebra over Z[i]^3)
1. The rewriting rule (exact colour algebra over Z[i]^3)
Each vertex carries a colour: a length-3 vector of Gaussian integers, e.g. {2+I, 1, 3-I}. Two vertices that compose produce a child whose colour is the conjugated cross product of theirs. The gauge quotient identifies vertices whose colour vectors are linearly dependent over C -- exactly, with no threshold, because Wolfram carries Z[i] exactly.
compose[a_, b_] := Conjugate[Cross[a, b]]; (* conj(a x b), exact, unnormalised *)
rayEquivQ[a_, b_] := AllTrue[Cross[a, b], # == 0 &]; (* a ~ b <=> a x b = 0 *)
zeroVecQ[v_] := AllTrue[v, # == 0 &];
rayEquivQ[a_, b_] := AllTrue[Cross[a, b], # == 0 &]; (* a ~ b <=> a x b = 0 *)
zeroVecQ[v_] := AllTrue[v, # == 0 &];
2. Initial colours and the K6^3 seed
2. Initial colours and the K6^3 seed
Six pairwise non-parallel Gaussian-integer rays seed the system. The topology is K6^3: every ordered triple of distinct vertices is a hyperedge (120 of them).
icsBase = {
{2 + I, 1, 3 - I},
{1, 2 + I, 1 - 2 I},
{1 - I, 3, 2 + I},
{3, 1 - I, 1 + 2 I},
{1 + 2 I, 2 - I, 1},
{2, 1 + I, 3}
};
seedEdges = Select[Tuples[Range[6], 3], Length[DeleteDuplicates[#]] == 3 &];
Length[seedEdges]
{2 + I, 1, 3 - I},
{1, 2 + I, 1 - 2 I},
{1 - I, 3, 2 + I},
{3, 1 - I, 1 + 2 I},
{1 + 2 I, 2 - I, 1},
{2, 1 + I, 3}
};
seedEdges = Select[Tuples[Range[6], 3], Length[DeleteDuplicates[#]] == 3 &];
Length[seedEdges]
3. Multiway growth
3. Multiway growth
At each generation, every ternary edge (v1,v2,v3) composes its first two colours into a new vertex w = conj(psi[v1] x psi[v2]) and spawns three daughter edges sharing w. New vertices are cached by their (v1,v2) parent pair, so the multiway is built once and re-used.
buildMultiway[edges_, ics_, depth_] := Module[
{psi, vdepth, nextVid, cache, parents, frontier, allEdges, newF},
psi = <||>; vdepth = <||>;
Do[psi[i] = ics[[i]]; vdepth[i] = 0, {i, Length[ics]}];
nextVid = Length[ics] + 1;
cache = <||>; parents = <||>;
frontier = edges;
allEdges = Prepend[#, 0] & /@ edges; (* {gen, v1, v2, v3} *)
Do[
newF = Reap[
Do[
With[{v1 = e[[1]], v2 = e[[2]], v3 = e[[3]]},
Module[{key = {v1, v2}, w, wv},
If[! KeyExistsQ[cache, key],
w = compose[psi[v1], psi[v2]];
If[! zeroVecQ[w],
psi[nextVid] = w; vdepth[nextVid] = gen + 1;
parents[nextVid] = {v1, v2};
cache[key] = nextVid; nextVid++;
];
];
If[KeyExistsQ[cache, key],
wv = cache[key];
Sow[{wv, v2, v3}]; Sow[{wv, v1, v3}]; Sow[{wv, v1, v2}];
];
]
],
{e, frontier}
]
][[2]];
newF = If[newF === {}, {}, First[newF]];
allEdges = Join[allEdges, Prepend[#, gen + 1] & /@ newF];
frontier = newF;
, {gen, 0, depth - 1}
];
<| "psi" -> psi, "vdepth" -> vdepth, "edges" -> allEdges, "parents" -> parents |>
];
{psi, vdepth, nextVid, cache, parents, frontier, allEdges, newF},
psi = <||>; vdepth = <||>;
Do[psi[i] = ics[[i]]; vdepth[i] = 0, {i, Length[ics]}];
nextVid = Length[ics] + 1;
cache = <||>; parents = <||>;
frontier = edges;
allEdges = Prepend[#, 0] & /@ edges; (* {gen, v1, v2, v3} *)
Do[
newF = Reap[
Do[
With[{v1 = e[[1]], v2 = e[[2]], v3 = e[[3]]},
Module[{key = {v1, v2}, w, wv},
If[! KeyExistsQ[cache, key],
w = compose[psi[v1], psi[v2]];
If[! zeroVecQ[w],
psi[nextVid] = w; vdepth[nextVid] = gen + 1;
parents[nextVid] = {v1, v2};
cache[key] = nextVid; nextVid++;
];
];
If[KeyExistsQ[cache, key],
wv = cache[key];
Sow[{wv, v2, v3}]; Sow[{wv, v1, v3}]; Sow[{wv, v1, v2}];
];
]
],
{e, frontier}
]
][[2]];
newF = If[newF === {}, {}, First[newF]];
allEdges = Join[allEdges, Prepend[#, gen + 1] & /@ newF];
frontier = newF;
, {gen, 0, depth - 1}
];
<| "psi" -> psi, "vdepth" -> vdepth, "edges" -> allEdges, "parents" -> parents |>
];
4. The exact gauge quotient (colour-classes)
4. The exact gauge quotient (colour-classes)
Two raw vertices are identified iff their colour vectors are parallel (Cross == 0, exact). clusterRays returns the class of every vertex; buildSingleSide wraps it with per-generation birth data and an A/B/C tier label (A = seed, B = first-generation, C = deeper).
clusterRays[psi_Association] := Module[{vids, reps, vidToCid},
vids = Sort[Keys[psi]];
reps = {}; (* {repVid, repVec} per class; cid is 1-based *)
vidToCid = <||>;
Do[
Module[{pv = psi[v], fc = 0},
If[! zeroVecQ[pv],
Do[If[rayEquivQ[pv, reps[[c, 2]]], fc = c; Break[]], {c, Length[reps]}];
If[fc > 0, vidToCid[v] = fc,
AppendTo[reps, {v, pv}]; vidToCid[v] = Length[reps]];
];
],
{v, vids}
];
<| "vidToCid" -> vidToCid, "reps" -> reps |>
];
buildSingleSide[edges_, ics_, depth_] := Module[
{mw, cl, v2c, reps, n, qpsi, birth, seedCids, gen1Cids, tier, ce, classEdgeGen},
mw = buildMultiway[edges, ics, depth];
cl = clusterRays[mw["psi"]];
v2c = cl["vidToCid"]; reps = cl["reps"]; n = Length[reps];
qpsi = AssociationThread[Range[n] -> reps[[All, 2]]];
birth = GroupBy[Keys[v2c], v2c, Min[mw["vdepth"] /@ #] &];
seedCids = DeleteDuplicates[v2c /@ Range[Length[ics]]];
gen1Cids = Complement[
DeleteDuplicates[v2c /@ Select[Keys[mw["vdepth"]],
mw["vdepth"][#] == 1 && KeyExistsQ[v2c, #] &]], seedCids];
tier = AssociationThread[Range[n] -> (Which[
MemberQ[seedCids, #], "A", MemberQ[gen1Cids, #], "B", True, "C"] & /@ Range[n])];
ce = Select[mw["edges"], AllTrue[#[[2 ;; 4]], KeyExistsQ[v2c, #] &] &];
classEdgeGen = Merge[((v2c /@ #[[2 ;; 4]]) -> #[[1]]) & /@ ce, Min];
<| "n" -> n, "qpsi" -> qpsi, "tier" -> tier, "birth" -> birth,
"classEdgeGen" -> classEdgeGen, "v2c" -> v2c, "mw" -> mw |>
];
vids = Sort[Keys[psi]];
reps = {}; (* {repVid, repVec} per class; cid is 1-based *)
vidToCid = <||>;
Do[
Module[{pv = psi[v], fc = 0},
If[! zeroVecQ[pv],
Do[If[rayEquivQ[pv, reps[[c, 2]]], fc = c; Break[]], {c, Length[reps]}];
If[fc > 0, vidToCid[v] = fc,
AppendTo[reps, {v, pv}]; vidToCid[v] = Length[reps]];
];
],
{v, vids}
];
<| "vidToCid" -> vidToCid, "reps" -> reps |>
];
buildSingleSide[edges_, ics_, depth_] := Module[
{mw, cl, v2c, reps, n, qpsi, birth, seedCids, gen1Cids, tier, ce, classEdgeGen},
mw = buildMultiway[edges, ics, depth];
cl = clusterRays[mw["psi"]];
v2c = cl["vidToCid"]; reps = cl["reps"]; n = Length[reps];
qpsi = AssociationThread[Range[n] -> reps[[All, 2]]];
birth = GroupBy[Keys[v2c], v2c, Min[mw["vdepth"] /@ #] &];
seedCids = DeleteDuplicates[v2c /@ Range[Length[ics]]];
gen1Cids = Complement[
DeleteDuplicates[v2c /@ Select[Keys[mw["vdepth"]],
mw["vdepth"][#] == 1 && KeyExistsQ[v2c, #] &]], seedCids];
tier = AssociationThread[Range[n] -> (Which[
MemberQ[seedCids, #], "A", MemberQ[gen1Cids, #], "B", True, "C"] & /@ Range[n])];
ce = Select[mw["edges"], AllTrue[#[[2 ;; 4]], KeyExistsQ[v2c, #] &] &];
classEdgeGen = Merge[((v2c /@ #[[2 ;; 4]]) -> #[[1]]) & /@ ce, Min];
<| "n" -> n, "qpsi" -> qpsi, "tier" -> tier, "birth" -> birth,
"classEdgeGen" -> classEdgeGen, "v2c" -> v2c, "mw" -> mw |>
];
5. C-closure: Q51 -> Q102
5. C-closure: Q51 -> Q102
The conjugate multiway is grown from the conjugated initial colours and re-quotiented together with the original. J is the resulting charge-conjugation involution; gamma is the orig/conj grading. For the canonical colours the split is 51 orig + 51 conj + 0 self-conjugate, J is a fixed-point-free involution, and {J, gamma} = 0 -- the sign data of KO-dimension 6.
buildCClosed[edges_, ics_, depth_] := Module[
{mo, mc, offset, psiAll, vdAll, source, cl, v2c, reps, n, qpsi,
clSrc, origin, seedCids, gen1Cids, tier, allRaw, classTriples,
J, gamma, c, c2, cr},
mo = buildMultiway[edges, ics, depth];
mc = buildMultiway[edges, Conjugate /@ ics, depth];
offset = Max[Keys[mo["psi"]]];
psiAll = mo["psi"]; vdAll = mo["vdepth"];
source = AssociationMap["orig" &, Keys[mo["psi"]]];
Do[psiAll[k + offset] = mc["psi"][k];
vdAll[k + offset] = mc["vdepth"][k];
source[k + offset] = "conj", {k, Keys[mc["psi"]]}];
cl = clusterRays[psiAll]; v2c = cl["vidToCid"]; reps = cl["reps"]; n = Length[reps];
qpsi = AssociationThread[Range[n] -> reps[[All, 2]]];
clSrc = GroupBy[Keys[v2c], v2c, Sort[DeleteDuplicates[source /@ #]] &];
origin = AssociationThread[Range[n] -> (Which[
clSrc[#] === {"orig"}, "orig_only",
clSrc[#] === {"conj"}, "conj_only",
True, "both"] & /@ Range[n])];
seedCids = DeleteDuplicates[v2c /@ Range[Length[ics]]];
gen1Cids = Complement[
DeleteDuplicates[v2c /@ Select[Keys[vdAll],
vdAll[#] == 1 && KeyExistsQ[v2c, #] &]], seedCids];
tier = AssociationThread[Range[n] -> (Which[
MemberQ[seedCids, #], "A", MemberQ[gen1Cids, #], "B", True, "C"] & /@ Range[n])];
allRaw = Join[mo["edges"],
({#[[1]], #[[2]] + offset, #[[3]] + offset, #[[4]] + offset}) & /@ mc["edges"]];
classTriples = DeleteDuplicates[
(v2c /@ #[[2 ;; 4]]) & /@ Select[allRaw, AllTrue[#[[2 ;; 4]], KeyExistsQ[v2c, #] &] &]];
J = ConstantArray[0, {n, n}];
Do[cr = Conjugate[reps[[c, 2]]];
Do[If[rayEquivQ[cr, reps[[c2, 2]]], J[[c, c2]] = 1; Break[]], {c2, n}], {c, n}];
gamma = (If[origin[#] === "orig_only", 1, -1]) & /@ Range[n];
<| "n" -> n, "qpsi" -> qpsi, "tier" -> tier, "origin" -> origin,
"classTriples" -> classTriples, "J" -> J, "gamma" -> gamma, "v2c" -> v2c |>
];
{mo, mc, offset, psiAll, vdAll, source, cl, v2c, reps, n, qpsi,
clSrc, origin, seedCids, gen1Cids, tier, allRaw, classTriples,
J, gamma, c, c2, cr},
mo = buildMultiway[edges, ics, depth];
mc = buildMultiway[edges, Conjugate /@ ics, depth];
offset = Max[Keys[mo["psi"]]];
psiAll = mo["psi"]; vdAll = mo["vdepth"];
source = AssociationMap["orig" &, Keys[mo["psi"]]];
Do[psiAll[k + offset] = mc["psi"][k];
vdAll[k + offset] = mc["vdepth"][k];
source[k + offset] = "conj", {k, Keys[mc["psi"]]}];
cl = clusterRays[psiAll]; v2c = cl["vidToCid"]; reps = cl["reps"]; n = Length[reps];
qpsi = AssociationThread[Range[n] -> reps[[All, 2]]];
clSrc = GroupBy[Keys[v2c], v2c, Sort[DeleteDuplicates[source /@ #]] &];
origin = AssociationThread[Range[n] -> (Which[
clSrc[#] === {"orig"}, "orig_only",
clSrc[#] === {"conj"}, "conj_only",
True, "both"] & /@ Range[n])];
seedCids = DeleteDuplicates[v2c /@ Range[Length[ics]]];
gen1Cids = Complement[
DeleteDuplicates[v2c /@ Select[Keys[vdAll],
vdAll[#] == 1 && KeyExistsQ[v2c, #] &]], seedCids];
tier = AssociationThread[Range[n] -> (Which[
MemberQ[seedCids, #], "A", MemberQ[gen1Cids, #], "B", True, "C"] & /@ Range[n])];
allRaw = Join[mo["edges"],
({#[[1]], #[[2]] + offset, #[[3]] + offset, #[[4]] + offset}) & /@ mc["edges"]];
classTriples = DeleteDuplicates[
(v2c /@ #[[2 ;; 4]]) & /@ Select[allRaw, AllTrue[#[[2 ;; 4]], KeyExistsQ[v2c, #] &] &]];
J = ConstantArray[0, {n, n}];
Do[cr = Conjugate[reps[[c, 2]]];
Do[If[rayEquivQ[cr, reps[[c2, 2]]], J[[c, c2]] = 1; Break[]], {c2, n}], {c, n}];
gamma = (If[origin[#] === "orig_only", 1, -1]) & /@ Range[n];
<| "n" -> n, "qpsi" -> qpsi, "tier" -> tier, "origin" -> origin,
"classTriples" -> classTriples, "J" -> J, "gamma" -> gamma, "v2c" -> v2c |>
];
6. Rendering helpers
6. Rendering helpers
Each ternary hyperedge is drawn as a translucent triangle over its three vertices; vertices are coloured discs. A single spring-electrical layout is computed once and reused across every frame, so vertices never jump. No Function Repository dependency.
twoSectionEdges[triples_] := Module[{pairs},
pairs = DeleteDuplicates[Sort /@ Flatten[Subsets[#, {2}] & /@ triples, 1]];
UndirectedEdge[#[[1]], #[[2]]] & /@ pairs];
layoutOf[vertices_, triples_] := Module[{g},
g = Graph[vertices, twoSectionEdges[triples], GraphLayout -> "SpringElectricalEmbedding"];
AssociationThread[VertexList[g] -> GraphEmbedding[g]]];
radiusOf[coord_] := Which[Length[coord] > 200, 0.015, Length[coord] > 70, 0.022, True, 0.030];
tierColor = <|"A" -> RGBColor[0.96, 0.40, 0.36], "B" -> RGBColor[0.28, 0.82, 0.74],
"C" -> RGBColor[0.62, 0.66, 0.78]|>;
originColor = <|"orig_only" -> RGBColor[0.97, 0.52, 0.30], "conj_only" -> RGBColor[0.34, 0.62, 0.97],
"both" -> RGBColor[0.93, 0.86, 0.32]|>;
genColor[g_, maxg_] := ColorData["SunsetColors"][g / Max[maxg, 1]];
hgPlot[triples_, coord_, vcolor_, radius_, label_, size_] := Graphics[{
Opacity[0.05], EdgeForm[None],
Polygon[Lookup[coord, #]] & /@ Select[DeleteDuplicates[Sort /@ triples],
AllTrue[#, KeyExistsQ[coord, #] &] &],
Opacity[1.], PointSize[radius],
{vcolor[#], Point[coord[#]]} & /@ Keys[coord]},
PlotLabel -> Style[label, White, 13], ImageSize -> size, PlotRange -> All,
Background -> GrayLevel[0.08], AspectRatio -> 1];
pairs = DeleteDuplicates[Sort /@ Flatten[Subsets[#, {2}] & /@ triples, 1]];
UndirectedEdge[#[[1]], #[[2]]] & /@ pairs];
layoutOf[vertices_, triples_] := Module[{g},
g = Graph[vertices, twoSectionEdges[triples], GraphLayout -> "SpringElectricalEmbedding"];
AssociationThread[VertexList[g] -> GraphEmbedding[g]]];
radiusOf[coord_] := Which[Length[coord] > 200, 0.015, Length[coord] > 70, 0.022, True, 0.030];
tierColor = <|"A" -> RGBColor[0.96, 0.40, 0.36], "B" -> RGBColor[0.28, 0.82, 0.74],
"C" -> RGBColor[0.62, 0.66, 0.78]|>;
originColor = <|"orig_only" -> RGBColor[0.97, 0.52, 0.30], "conj_only" -> RGBColor[0.34, 0.62, 0.97],
"both" -> RGBColor[0.93, 0.86, 0.32]|>;
genColor[g_, maxg_] := ColorData["SunsetColors"][g / Max[maxg, 1]];
hgPlot[triples_, coord_, vcolor_, radius_, label_, size_] := Graphics[{
Opacity[0.05], EdgeForm[None],
Polygon[Lookup[coord, #]] & /@ Select[DeleteDuplicates[Sort /@ triples],
AllTrue[#, KeyExistsQ[coord, #] &] &],
Opacity[1.], PointSize[radius],
{vcolor[#], Point[coord[#]]} & /@ Keys[coord]},
PlotLabel -> Style[label, White, 13], ImageSize -> size, PlotRange -> All,
Background -> GrayLevel[0.08], AspectRatio -> 1];
7. Build and verify
7. Build and verify
This builds both objects and checks every headline number exactly: the single-side quotient is 51, it closes at generation 2 (6, 21, 51, 51, 51), the closure is 102, and the spectral-triple signs give KO-dimension 6.
ss = buildSingleSide[seedEdges, icsBase, 4];
cc = buildCClosed[seedEdges, icsBase, 4];
growthCurve = Table[Count[Values[ss["birth"]], g_ /; g <= G], {G, 0, 4}];
J = cc["J"]; gamma = cc["gamma"]; nC = cc["n"]; Gmat = DiagonalMatrix[gamma];
j2ok = (J . J === IdentityMatrix[nC]);
permOk = (Total[J, {1}] === ConstantArray[1, nC]) && (Total[J, {2}] === ConstantArray[1, nC]);
commJG = Norm[J . Gmat - Gmat . J, "Frobenius"];
antiJG = Norm[J . Gmat + Gmat . J, "Frobenius"];
nFixed = Tr[J];
originCnt = Counts[Values[cc["origin"]]];
verifyGrid = Grid[{
{"quantity", "value", "expected"},
{"single-side gauge quotient |Q51|", ss["n"], 51},
{"raw single-side vertices", Length[ss["mw"]["psi"]], 456},
{"class growth by generation", growthCurve, {6, 21, 51, 51, 51}},
{"C-closed quotient |Q102|", cc["n"], 102},
{"origin split", Normal[originCnt], "51 orig + 51 conj"},
{"J permutation", permOk, True},
{"J^2 = I", j2ok, True},
{"fixed points of J", nFixed, 0},
{"||{J, gamma}|| (anticommutator)", N[antiJG], 0},
{"KO-dimension", If[j2ok && antiJG == 0, 6, "?"], 6}},
Frame -> All, Alignment -> Left, Background -> {None, {GrayLevel[0.9]}}, Spacings -> {2, 0.8}];
verifyGrid
cc = buildCClosed[seedEdges, icsBase, 4];
growthCurve = Table[Count[Values[ss["birth"]], g_ /; g <= G], {G, 0, 4}];
J = cc["J"]; gamma = cc["gamma"]; nC = cc["n"]; Gmat = DiagonalMatrix[gamma];
j2ok = (J . J === IdentityMatrix[nC]);
permOk = (Total[J, {1}] === ConstantArray[1, nC]) && (Total[J, {2}] === ConstantArray[1, nC]);
commJG = Norm[J . Gmat - Gmat . J, "Frobenius"];
antiJG = Norm[J . Gmat + Gmat . J, "Frobenius"];
nFixed = Tr[J];
originCnt = Counts[Values[cc["origin"]]];
verifyGrid = Grid[{
{"quantity", "value", "expected"},
{"single-side gauge quotient |Q51|", ss["n"], 51},
{"raw single-side vertices", Length[ss["mw"]["psi"]], 456},
{"class growth by generation", growthCurve, {6, 21, 51, 51, 51}},
{"C-closed quotient |Q102|", cc["n"], 102},
{"origin split", Normal[originCnt], "51 orig + 51 conj"},
{"J permutation", permOk, True},
{"J^2 = I", j2ok, True},
{"fixed points of J", nFixed, 0},
{"||{J, gamma}|| (anticommutator)", N[antiJG], 0},
{"KO-dimension", If[j2ok && antiJG == 0, 6, "?"], 6}},
Frame -> All, Alignment -> Left, Background -> {None, {GrayLevel[0.9]}}, Spacings -> {2, 0.8}];
verifyGrid
8. Figures
8. Figures
Compute the shared layouts once (this is the slow step -- the raw multiway has 456 vertices and a few thousand hyperedges).
rawVids = Keys[ss["mw"]["psi"]];
rawTriples = #[[2 ;; 4]] & /@ ss["mw"]["edges"];
rawCoord = layoutOf[rawVids, rawTriples]; rawR = radiusOf[rawCoord];
qVids = Range[ss["n"]];
qTriples = Keys[ss["classEdgeGen"]];
qCoord = layoutOf[qVids, qTriples]; qR = radiusOf[qCoord];
frameAt[G_] := Module[{rv, re, qc, qe},
rv = Select[rawVids, ss["mw"]["vdepth"][#] <= G &];
re = #[[2 ;; 4]] & /@ Select[ss["mw"]["edges"], #[[1]] <= G &];
qc = Select[qVids, ss["birth"][#] <= G &];
qe = Select[qTriples, ss["classEdgeGen"][#] <= G && AllTrue[#, ss["birth"][#] <= G &] &];
GraphicsRow[{
hgPlot[re, KeyTake[rawCoord, rv], (genColor[ss["mw"]["vdepth"][#], 4]) &, rawR,
StringJoin["raw multiway (gen ", ToString[G], ", ", ToString[Length[rv]], " vertices)"], 360],
hgPlot[qe, KeyTake[qCoord, qc], (tierColor[ss["tier"][#]]) &, qR,
StringJoin["gauge quotient (", ToString[Length[qc]], " classes)"], 360]},
ImageSize -> 760, Spacings -> 8]];
rawTriples = #[[2 ;; 4]] & /@ ss["mw"]["edges"];
rawCoord = layoutOf[rawVids, rawTriples]; rawR = radiusOf[rawCoord];
qVids = Range[ss["n"]];
qTriples = Keys[ss["classEdgeGen"]];
qCoord = layoutOf[qVids, qTriples]; qR = radiusOf[qCoord];
frameAt[G_] := Module[{rv, re, qc, qe},
rv = Select[rawVids, ss["mw"]["vdepth"][#] <= G &];
re = #[[2 ;; 4]] & /@ Select[ss["mw"]["edges"], #[[1]] <= G &];
qc = Select[qVids, ss["birth"][#] <= G &];
qe = Select[qTriples, ss["classEdgeGen"][#] <= G && AllTrue[#, ss["birth"][#] <= G &] &];
GraphicsRow[{
hgPlot[re, KeyTake[rawCoord, rv], (genColor[ss["mw"]["vdepth"][#], 4]) &, rawR,
StringJoin["raw multiway (gen ", ToString[G], ", ", ToString[Length[rv]], " vertices)"], 360],
hgPlot[qe, KeyTake[qCoord, qc], (tierColor[ss["tier"][#]]) &, qR,
StringJoin["gauge quotient (", ToString[Length[qc]], " classes)"], 360]},
ImageSize -> 760, Spacings -> 8]];
The growth curve: distinct colour-classes vs generation. The quotient is a fixed point from generation 2 on.
ListLinePlot[Transpose[{Range[0, 4], growthCurve}],
PlotMarkers -> Automatic, Frame -> True, ImageSize -> 440,
FrameLabel -> {"generation", "distinct colour-classes"},
PlotLabel -> "Quotient closes at generation 2 (6 -> 21 -> 51)",
PlotRange -> {{0, 4}, {0, 56}}, GridLines -> Automatic]
PlotMarkers -> Automatic, Frame -> True, ImageSize -> 440,
FrameLabel -> {"generation", "distinct colour-classes"},
PlotLabel -> "Quotient closes at generation 2 (6 -> 21 -> 51)",
PlotRange -> {{0, 4}, {0, 56}}, GridLines -> Automatic]
Side-by-side growth: the raw multiway (left, coloured by generation) explodes into a hairball, while its exact gauge quotient (right, coloured by tier A/B/C) closes at 51. Drag the slider.
Manipulate[frameAt[G], {{G, 4, "generation"}, 0, 4, 1}]
A static strip of all five frames, for the post:
Column[Table[frameAt[G], {G, 0, 4}]]
The climax. Left: Q51, the single-side quotient (tier A/B/C). Right: the charge-conjugation closure Q102 = Q51 union C(Q51), coloured orig vs conj. The two halves are exchanged by the involution J.
ccCoord = layoutOf[Range[cc["n"]], cc["classTriples"]]; ccR = radiusOf[ccCoord];
GraphicsRow[{
hgPlot[qTriples, qCoord, (tierColor[ss["tier"][#]]) &, qR,
"Q51 (single side, tier A/B/C)", 360],
hgPlot[cc["classTriples"], ccCoord, (originColor[cc["origin"][#]]) &, ccR,
"Q102 = Q51 u C(Q51) (orig / conj)", 360]},
ImageSize -> 760, Spacings -> 8]
GraphicsRow[{
hgPlot[qTriples, qCoord, (tierColor[ss["tier"][#]]) &, qR,
"Q51 (single side, tier A/B/C)", 360],
hgPlot[cc["classTriples"], ccCoord, (originColor[cc["origin"][#]]) &, ccR,
"Q102 = Q51 u C(Q51) (orig / conj)", 360]},
ImageSize -> 760, Spacings -> 8]
The KO-dimension summary -- the spectral-triple sign data on Q102:
Grid[{
{"|Q102|", cc["n"]},
{"origin split", Row[Normal[originCnt], " "]},
{"J is a permutation", permOk},
{"J^2 = I", j2ok},
{"fixed points of J", nFixed},
{"||[J, gamma]||", N[commJG]},
{"||{J, gamma}||", N[antiJG]},
{"KO-dimension", If[j2ok && antiJG == 0, "6 (J^2 = +1, J gamma = -gamma J)", "indeterminate"]}},
Frame -> All, Alignment -> Left, Spacings -> {2, 1}]
{"|Q102|", cc["n"]},
{"origin split", Row[Normal[originCnt], " "]},
{"J is a permutation", permOk},
{"J^2 = I", j2ok},
{"fixed points of J", nFixed},
{"||[J, gamma]||", N[commJG]},
{"||{J, gamma}||", N[antiJG]},
{"KO-dimension", If[j2ok && antiJG == 0, "6 (J^2 = +1, J gamma = -gamma J)", "indeterminate"]}},
Frame -> All, Alignment -> Left, Spacings -> {2, 1}]
To export an animated GIF for the Community post, evaluate:
(* Export[FileNameJoin[{NotebookDirectory[], "q102_growth.gif"}],
Table[frameAt[G], {G, 0, 4}], "DisplayDurations" -> 1.1] *)
Table[frameAt[G], {G, 0, 4}], "DisplayDurations" -> 1.1] *)
9. The multiway derivation graph
9. The multiway derivation graph
The panels above lay the hypergraph out by force; this shows its causal structure instead. Every non-seed vertex is produced by composing two parents, so each edge runs from an earlier generation to a later one -- the natural drawing is concentric rings, one per generation. The class graph puts the 6 seeds at the centre generating a ring of 15, then a ring of 30, closing at 51 (node colour = tier A/B/C = gen 0/1/2).
concentricCoords[nodes_, genOf_, radii_] := Module[{byG, coords = <||>},
byG = GroupBy[nodes, genOf];
Do[With[{cl = Sort[byG[g]], r = radii[g]},
MapIndexed[(coords[#1] = r {Cos[2 Pi (#2[[1]] - 1)/Length[cl] + 0.35 g],
Sin[2 Pi (#2[[1]] - 1)/Length[cl] + 0.35 g]}) &, cl]],
{g, Keys[byG]}];
coords];
derivEdges[ss_] := Module[{v2c, parents, vdepth, birth, members, edges, cids},
v2c = ss["v2c"]; parents = ss["mw"]["parents"]; vdepth = ss["mw"]["vdepth"];
birth = ss["birth"]; cids = Range[ss["n"]]; members = GroupBy[Keys[v2c], v2c];
edges = {};
Do[If[birth[c] >= 1,
Module[{cand, w0, pp},
cand = Select[members[c], vdepth[#] == birth[c] && KeyExistsQ[parents, #] &];
If[cand =!= {}, w0 = Min[cand]; pp = parents[w0];
AppendTo[edges, v2c[pp[[1]]] -> c]; AppendTo[edges, v2c[pp[[2]]] -> c]]]],
{c, cids}];
DeleteDuplicates[edges]];
classDAG[ss_] := Module[{cids = Range[ss["n"]], edges, coords, rings},
edges = derivEdges[ss];
coords = concentricCoords[cids, ss["birth"], <|0 -> 0.5, 1 -> 1.6, 2 -> 2.8|>];
rings = {GrayLevel[0.26], Dashing[{0.004, 0.012}],
Circle[{0, 0}, 0.5], Circle[{0, 0}, 1.6], Circle[{0, 0}, 2.8],
GrayLevel[0.5], Dashing[None], Text[Style["gen 0", 9], {0, 0.66}],
Text[Style["gen 1", 9], {0, 1.76}], Text[Style["gen 2", 9], {0, 2.98}]};
Graph[cids, edges, VertexCoordinates -> (coords[#] & /@ cids),
VertexStyle -> (# -> tierColor[ss["tier"][#]] & /@ cids), VertexSize -> 0.17,
EdgeShapeFunction -> ({GrayLevel[0.7], Opacity[0.45], Line[#1]} &),
VertexLabels -> None, ImageSize -> 640, Background -> GrayLevel[0.09], AspectRatio -> 1,
Prolog -> rings,
PlotLabel -> Style["multiway derivation graph (6 seeds -> 15 -> 30 = 51 classes)", White, 14]]];
genHue[g_] := Hue[0.70 (1 - g/4.), 0.85, 1.0];
rawDAG[ss_] := Module[{parents = ss["mw"]["parents"], vdepth = ss["mw"]["vdepth"], nodes, edges, coords},
nodes = Keys[ss["mw"]["psi"]];
edges = DeleteDuplicates[Flatten[
(Function[w, {DirectedEdge[parents[w][[1]], w], DirectedEdge[parents[w][[2]], w]}]) /@ Keys[parents], 1]];
coords = concentricCoords[nodes, vdepth, <|0 -> 0.4, 1 -> 1.15, 2 -> 1.95, 3 -> 2.8, 4 -> 3.65|>];
Graph[nodes, edges, VertexCoordinates -> (coords[#] & /@ nodes),
VertexStyle -> (# -> genHue[vdepth[#]] & /@ nodes), VertexSize -> 0.085,
EdgeShapeFunction -> (Module[{w = #2[[2]]},
{genHue[vdepth[w]], Opacity[0.42], AbsoluteThickness[0.7], Line[#1]}] &),
VertexLabels -> None, ImageSize -> 780, Background -> GrayLevel[0.04], AspectRatio -> 1,
PlotLabel -> Style["raw multiway derivation graph (456 vertices, 5 generations)", White, 14]]];
multiwayClassDAG = classDAG[ss];
multiwayRawDAG = rawDAG[ss];
multiwayClassDAG
byG = GroupBy[nodes, genOf];
Do[With[{cl = Sort[byG[g]], r = radii[g]},
MapIndexed[(coords[#1] = r {Cos[2 Pi (#2[[1]] - 1)/Length[cl] + 0.35 g],
Sin[2 Pi (#2[[1]] - 1)/Length[cl] + 0.35 g]}) &, cl]],
{g, Keys[byG]}];
coords];
derivEdges[ss_] := Module[{v2c, parents, vdepth, birth, members, edges, cids},
v2c = ss["v2c"]; parents = ss["mw"]["parents"]; vdepth = ss["mw"]["vdepth"];
birth = ss["birth"]; cids = Range[ss["n"]]; members = GroupBy[Keys[v2c], v2c];
edges = {};
Do[If[birth[c] >= 1,
Module[{cand, w0, pp},
cand = Select[members[c], vdepth[#] == birth[c] && KeyExistsQ[parents, #] &];
If[cand =!= {}, w0 = Min[cand]; pp = parents[w0];
AppendTo[edges, v2c[pp[[1]]] -> c]; AppendTo[edges, v2c[pp[[2]]] -> c]]]],
{c, cids}];
DeleteDuplicates[edges]];
classDAG[ss_] := Module[{cids = Range[ss["n"]], edges, coords, rings},
edges = derivEdges[ss];
coords = concentricCoords[cids, ss["birth"], <|0 -> 0.5, 1 -> 1.6, 2 -> 2.8|>];
rings = {GrayLevel[0.26], Dashing[{0.004, 0.012}],
Circle[{0, 0}, 0.5], Circle[{0, 0}, 1.6], Circle[{0, 0}, 2.8],
GrayLevel[0.5], Dashing[None], Text[Style["gen 0", 9], {0, 0.66}],
Text[Style["gen 1", 9], {0, 1.76}], Text[Style["gen 2", 9], {0, 2.98}]};
Graph[cids, edges, VertexCoordinates -> (coords[#] & /@ cids),
VertexStyle -> (# -> tierColor[ss["tier"][#]] & /@ cids), VertexSize -> 0.17,
EdgeShapeFunction -> ({GrayLevel[0.7], Opacity[0.45], Line[#1]} &),
VertexLabels -> None, ImageSize -> 640, Background -> GrayLevel[0.09], AspectRatio -> 1,
Prolog -> rings,
PlotLabel -> Style["multiway derivation graph (6 seeds -> 15 -> 30 = 51 classes)", White, 14]]];
genHue[g_] := Hue[0.70 (1 - g/4.), 0.85, 1.0];
rawDAG[ss_] := Module[{parents = ss["mw"]["parents"], vdepth = ss["mw"]["vdepth"], nodes, edges, coords},
nodes = Keys[ss["mw"]["psi"]];
edges = DeleteDuplicates[Flatten[
(Function[w, {DirectedEdge[parents[w][[1]], w], DirectedEdge[parents[w][[2]], w]}]) /@ Keys[parents], 1]];
coords = concentricCoords[nodes, vdepth, <|0 -> 0.4, 1 -> 1.15, 2 -> 1.95, 3 -> 2.8, 4 -> 3.65|>];
Graph[nodes, edges, VertexCoordinates -> (coords[#] & /@ nodes),
VertexStyle -> (# -> genHue[vdepth[#]] & /@ nodes), VertexSize -> 0.085,
EdgeShapeFunction -> (Module[{w = #2[[2]]},
{genHue[vdepth[w]], Opacity[0.42], AbsoluteThickness[0.7], Line[#1]}] &),
VertexLabels -> None, ImageSize -> 780, Background -> GrayLevel[0.04], AspectRatio -> 1,
PlotLabel -> Style["raw multiway derivation graph (456 vertices, 5 generations)", White, 14]]];
multiwayClassDAG = classDAG[ss];
multiwayRawDAG = rawDAG[ss];
multiwayClassDAG
The full raw multiway -- all 456 vertices over 5 generations -- as a derivation mandala (vertices coloured by generation; the inner rings are the seeds and early classes, the outer rings the late, ray-redundant vertices):
multiwayRawDAG
10. The other gauge sectors: weak, generation, spinor
10. The other gauge sectors: weak, generation, spinor
The full Standard Model gauge group [SU(3) x SU(2) x U(1)_Y] x SU(3)_gen is the automorphism group of the decoration functor (Closure Forces Structure, ontology Theorem 4) -- all of it forced by closure, on the possibilistic layer, not by the NCG bridge. This port has so far implemented only the colour layer (-> SU(3)). The other layers ride on the SAME hypergraph as extra fibres; the colour ray-quotient Q51/Q102 is unchanged. Generation composes exactly like colour, so its own ray-quotient is a second, independent Q51 -- the decoupled SU(3) family symmetry. The spinor multiplies the three source signs (the Z2 chirality double-cover). The weak doublet is rotated by an SU(2) element built from the colour cross product -- so the weak sector is driven by colour; this one layer is float (faithful to q24_decoration_v1.compose_weak), not exact. U(1)_Y is the residual phase of the weak doublet, not a separate layer. The panel shows the same colour quotient under three fibres (colour tier, spinor, weak phase) plus generation as its own quotient.
gICs = {{1+I,2,1-I},{2,1-I,1+2 I},{1,3+I,2-I},{3-I,1,2+I},{2+I,1-I,3},{1-2 I,2,1+I}};
epsICs = {1,-1,1,1,-1,1};
wICs = N[{{1,0},{0,1},{1,I}/Sqrt[2],{1,-I}/Sqrt[2],{1,1}/Sqrt[2],{I,1}/Sqrt[2]}];
pauli = {{{0,1},{1,0}}, {{0,-I},{I,0}}, {{1,0},{0,-1}}};
su2Rot[th_, n_] := Cos[th] IdentityMatrix[2] + I Sin[th] Sum[n[[k]] pauli[[k]], {k, 3}];
normC[v_] := With[{nn = Norm[v]}, If[nn < 10.^-14, v, v/nn]];
weakCompose[psi1_, psi2_, w2_] := Module[{p1 = N[psi1], p2 = N[psi2], nc, nr, z, th, R},
nc = Cross[p1, p2]; If[Norm[nc] < 10.^-12, Return[w2]]; nc = nc/Norm[nc];
nr = Re[nc]; If[Norm[nr] < 10.^-12, nr = Im[nc]]; If[Norm[nr] < 10.^-12, Return[w2]]; nr = nr/Norm[nr];
z = Conjugate[p1] . p2; th = If[Abs[z] > 10.^-12, Arg[z], 0.];
R = su2Rot[th, nr]; normC[R . w2]];
buildDecorated[edges_, psiI_, gI_, wI_, epsI_, depth_] := Module[
{psi, g, wd, eps, vdepth, nextVid, cache, frontier, allE, newF},
psi = <||>; g = <||>; wd = <||>; eps = <||>; vdepth = <||>;
Do[psi[i] = psiI[[i]]; g[i] = gI[[i]]; wd[i] = wI[[i]]; eps[i] = epsI[[i]]; vdepth[i] = 0, {i, Length[psiI]}];
nextVid = Length[psiI] + 1; cache = <||>; frontier = edges; allE = Prepend[#, 0] & /@ edges;
Do[
newF = Reap[Do[
With[{v1 = e[[1]], v2 = e[[2]], v3 = e[[3]]},
Module[{key = {v1, v2}, pn, wv},
If[! KeyExistsQ[cache, key],
pn = compose[psi[v1], psi[v2]];
If[! zeroVecQ[pn],
psi[nextVid] = pn; g[nextVid] = compose[g[v1], g[v2]];
wd[nextVid] = weakCompose[psi[v1], psi[v2], wd[v2]];
eps[nextVid] = eps[v1] eps[v2] eps[v3];
vdepth[nextVid] = gen + 1; cache[key] = nextVid; nextVid++]];
If[KeyExistsQ[cache, key], wv = cache[key]; Sow[{wv, v2, v3}]; Sow[{wv, v1, v3}]; Sow[{wv, v1, v2}]]]],
{e, frontier}]][[2]];
newF = If[newF === {}, {}, First[newF]];
allE = Join[allE, Prepend[#, gen + 1] & /@ newF]; frontier = newF,
{gen, 0, depth - 1}];
<| "psi" -> psi, "g" -> g, "w" -> wd, "eps" -> eps, "vdepth" -> vdepth, "edges" -> allE |>];
md = buildDecorated[seedEdges, icsBase, gICs, wICs, epsICs, 4];
colClasses = clusterRays[md["psi"]];
repOf[c_] := colClasses["reps"][[c, 1]];
fiberPanel[coord_, triples_, colorFn_, label_] := Graphics[{
Opacity[0.05], EdgeForm[None],
Polygon[Lookup[coord, #]] & /@ Select[DeleteDuplicates[Sort /@ triples], AllTrue[#, KeyExistsQ[coord, #] &] &],
Opacity[1.], PointSize[0.032],
{colorFn[#], Point[coord[#]]} & /@ Keys[coord]},
PlotLabel -> Style[label, White, 12.5], ImageSize -> 350, Background -> GrayLevel[0.08],
AspectRatio -> 1, PlotRange -> All];
spinColor[c_] := If[md["eps"][repOf[c]] == 1, RGBColor[0.97, 0.55, 0.25], RGBColor[0.30, 0.55, 0.97]];
weakColor[c_] := Module[{w = md["w"][repOf[c]], a, b}, {a, b} = w;
Hue[Mod[Arg[Chop[If[Abs[a] < 10.^-9, b, b Conjugate[a]]]], 2 Pi]/(2 Pi), 0.85, 1.]];
genCl = clusterRays[md["g"]]; gv2c = genCl["vidToCid"]; nGen = Length[genCl["reps"]];
genTriples = DeleteDuplicates[(gv2c /@ #[[2 ;; 4]]) & /@ Select[md["edges"], AllTrue[#[[2 ;; 4]], KeyExistsQ[gv2c, #] &] &]];
genCoord = layoutOf[Range[nGen], genTriples];
genBirth = GroupBy[Keys[gv2c], gv2c, Min[md["vdepth"] /@ #] &];
genColorFn[c_] := tierColor[Switch[genBirth[c], 0, "A", 1, "B", _, "C"]];
sectorPanel = GraphicsGrid[{{
fiberPanel[qCoord, qTriples, (tierColor[ss["tier"][#]]) &, "SU(3)_col (colour quotient, tier A/B/C)"],
fiberPanel[qCoord, qTriples, spinColor, "Z2 spinor (orange +1 / blue -1)"]}, {
fiberPanel[qCoord, qTriples, weakColor, "SU(2)_weak (doublet phase, hue)"],
fiberPanel[genCoord, genTriples, genColorFn, StringJoin["SU(3)_gen (", ToString[nGen], "-class quotient)"]]}},
Spacings -> 6, ImageSize -> 720];
sectorPanel
epsICs = {1,-1,1,1,-1,1};
wICs = N[{{1,0},{0,1},{1,I}/Sqrt[2],{1,-I}/Sqrt[2],{1,1}/Sqrt[2],{I,1}/Sqrt[2]}];
pauli = {{{0,1},{1,0}}, {{0,-I},{I,0}}, {{1,0},{0,-1}}};
su2Rot[th_, n_] := Cos[th] IdentityMatrix[2] + I Sin[th] Sum[n[[k]] pauli[[k]], {k, 3}];
normC[v_] := With[{nn = Norm[v]}, If[nn < 10.^-14, v, v/nn]];
weakCompose[psi1_, psi2_, w2_] := Module[{p1 = N[psi1], p2 = N[psi2], nc, nr, z, th, R},
nc = Cross[p1, p2]; If[Norm[nc] < 10.^-12, Return[w2]]; nc = nc/Norm[nc];
nr = Re[nc]; If[Norm[nr] < 10.^-12, nr = Im[nc]]; If[Norm[nr] < 10.^-12, Return[w2]]; nr = nr/Norm[nr];
z = Conjugate[p1] . p2; th = If[Abs[z] > 10.^-12, Arg[z], 0.];
R = su2Rot[th, nr]; normC[R . w2]];
buildDecorated[edges_, psiI_, gI_, wI_, epsI_, depth_] := Module[
{psi, g, wd, eps, vdepth, nextVid, cache, frontier, allE, newF},
psi = <||>; g = <||>; wd = <||>; eps = <||>; vdepth = <||>;
Do[psi[i] = psiI[[i]]; g[i] = gI[[i]]; wd[i] = wI[[i]]; eps[i] = epsI[[i]]; vdepth[i] = 0, {i, Length[psiI]}];
nextVid = Length[psiI] + 1; cache = <||>; frontier = edges; allE = Prepend[#, 0] & /@ edges;
Do[
newF = Reap[Do[
With[{v1 = e[[1]], v2 = e[[2]], v3 = e[[3]]},
Module[{key = {v1, v2}, pn, wv},
If[! KeyExistsQ[cache, key],
pn = compose[psi[v1], psi[v2]];
If[! zeroVecQ[pn],
psi[nextVid] = pn; g[nextVid] = compose[g[v1], g[v2]];
wd[nextVid] = weakCompose[psi[v1], psi[v2], wd[v2]];
eps[nextVid] = eps[v1] eps[v2] eps[v3];
vdepth[nextVid] = gen + 1; cache[key] = nextVid; nextVid++]];
If[KeyExistsQ[cache, key], wv = cache[key]; Sow[{wv, v2, v3}]; Sow[{wv, v1, v3}]; Sow[{wv, v1, v2}]]]],
{e, frontier}]][[2]];
newF = If[newF === {}, {}, First[newF]];
allE = Join[allE, Prepend[#, gen + 1] & /@ newF]; frontier = newF,
{gen, 0, depth - 1}];
<| "psi" -> psi, "g" -> g, "w" -> wd, "eps" -> eps, "vdepth" -> vdepth, "edges" -> allE |>];
md = buildDecorated[seedEdges, icsBase, gICs, wICs, epsICs, 4];
colClasses = clusterRays[md["psi"]];
repOf[c_] := colClasses["reps"][[c, 1]];
fiberPanel[coord_, triples_, colorFn_, label_] := Graphics[{
Opacity[0.05], EdgeForm[None],
Polygon[Lookup[coord, #]] & /@ Select[DeleteDuplicates[Sort /@ triples], AllTrue[#, KeyExistsQ[coord, #] &] &],
Opacity[1.], PointSize[0.032],
{colorFn[#], Point[coord[#]]} & /@ Keys[coord]},
PlotLabel -> Style[label, White, 12.5], ImageSize -> 350, Background -> GrayLevel[0.08],
AspectRatio -> 1, PlotRange -> All];
spinColor[c_] := If[md["eps"][repOf[c]] == 1, RGBColor[0.97, 0.55, 0.25], RGBColor[0.30, 0.55, 0.97]];
weakColor[c_] := Module[{w = md["w"][repOf[c]], a, b}, {a, b} = w;
Hue[Mod[Arg[Chop[If[Abs[a] < 10.^-9, b, b Conjugate[a]]]], 2 Pi]/(2 Pi), 0.85, 1.]];
genCl = clusterRays[md["g"]]; gv2c = genCl["vidToCid"]; nGen = Length[genCl["reps"]];
genTriples = DeleteDuplicates[(gv2c /@ #[[2 ;; 4]]) & /@ Select[md["edges"], AllTrue[#[[2 ;; 4]], KeyExistsQ[gv2c, #] &] &]];
genCoord = layoutOf[Range[nGen], genTriples];
genBirth = GroupBy[Keys[gv2c], gv2c, Min[md["vdepth"] /@ #] &];
genColorFn[c_] := tierColor[Switch[genBirth[c], 0, "A", 1, "B", _, "C"]];
sectorPanel = GraphicsGrid[{{
fiberPanel[qCoord, qTriples, (tierColor[ss["tier"][#]]) &, "SU(3)_col (colour quotient, tier A/B/C)"],
fiberPanel[qCoord, qTriples, spinColor, "Z2 spinor (orange +1 / blue -1)"]}, {
fiberPanel[qCoord, qTriples, weakColor, "SU(2)_weak (doublet phase, hue)"],
fiberPanel[genCoord, genTriples, genColorFn, StringJoin["SU(3)_gen (", ToString[nGen], "-class quotient)"]]}},
Spacings -> 6, ImageSize -> 720];
sectorPanel
What you are seeing
What you are seeing
The rule is a single line -- compose = conj(a x b) -- yet the orbit under the complete ternary topology is finite and structured. The colour quotient reaches its fixed point almost immediately (generation 2), the conjugation closure doubles it with a clean orig/conj split, and the involution that swaps the halves anticommutes with the orig/conj grading. That last fact is the signature of a real spectral triple of KO-dimension 6 -- the same KO-dimension that the Standard Model's internal geometry carries in noncommutative geometry. Here it falls out of an exact, integer hypergraph rewriting system with no tuning and no floating point.
Everything above is exact and seed-free: re-evaluating the notebook reproduces 102 every time.