(Subscript[SU, 5]) ⊃ (Subscript[SU, 4]) ⊗ (Subscript[U, 1]) A4 Group Orbits & Their Polytope Hulls Using Quaternions

While verifying Koca' s work (et al.)
4 D Polytopes and Their Dual Polytopes of the Coxeter Group Represented by Quaternions

A note about using octonion math for quaternions....

Ignore the extra {0,0,0,0} at the end of these lists. I actually use octonion multiplication indicated by the SmallCircle (∘) below.

This is an 8D construct useful in further work with E8. The key for doing multiplication is to use one of the 480 possible octonions 
with the first (of 7) triads in the Fano plane being (123),  which makes all upper-left quadrant multiplication a quaternion multiplication. 
I do this because my octonion→quaternion multiplication handles symbolics better than the built-in MTM quaternion code.

FYI - I chose φ->(√5-1)/2=0.618... (small golden ratio vs. large 1.618...).

We need to pick an octonion that has the first triad={1,2,3} (i.e. strict quaternion),
and  strict Cayley Dickson construction where  (Subscript[ℯ, 4]) to (Subscript[ℯ, 7]) quadrant multiplication remains within the quadrant.

So we find the one (of 48) with first triad={1,2,3} and the one with Cayley-Dickson construction.

flip=True;
allOcts=Table[setFM[i,flip,0];triads,{i,240}];
fn=position[allOcts,{{1,2,3},{1,4,7},{1,6,5},{2,4,6},{2,5,7},{3,5,4},{3,6,7}}]

(* Koca uses σ and τ for Golden ratios, but I use φ as described in the FYI above. 
This sets up the symbolic relationships. *)
Clear[σ,Φ,τ];
σ=-φ;
τ=Φ=1/φ;

(* This sets the type of octonion split for negative split numbers (where Abs@split selects a triad):
 False implies the first of 4 non-triad imaginary dimensions becomes real (or +1), giving a 1+3I + 1+3I octonion
True implies the first 3 become real, giving a 1+3I + 3+1I octonion **)
split3Real=False;
setFM[(*)85**)fn(**),flip,split=0];
triads
Row@{fanoPlane,fmDispN}

Define the Permutations

(* These are the 15 binary orbit permutations using {0,1}'s *)
perms4D=Flatten[Permutations/@{{1,0,0,0},{1,1,0,0},{1,1,1,0},{1,1,1,1}},1];

{#,perms4D[[#]]}&/@Range@15//MatrixForm

(* Functions to generate positional and ± sign permutations of lists *)
EvenPermutationQ@p_:=Signature@p==-1;
OddPermutationQ@p_:=Signature@p==1;

pm@n_:=Flatten[Outer[List,Sequence@@Table[{-1,1},{n}]],n-1];
pm2@n_:=pm@n/2;

EvenPermutations@p_List:=Module[{(**)i,j(**)},
i=Range@Length@p;
j=Permutations@i;
(j/.Inner[Rule,i,p,List])[[Flatten@Position[j,_?EvenPermutationQ,1,Heads->False]]]];
OddPermutations@p_List:=Module[{(**)i,j(**)},
i=Range@Length@p;
j=Permutations@i;
(j/.Inner[Rule,i,p,List])[[Flatten@Position[j,_?OddPermutationQ,1,Heads->False]]]];

Eperms@in_List:=EvenPermutations[Inner[Times,in,Array[1&,Length@in],List]];
Operms@in_List:=  OddPermutations[Inner[Times,in,Array[1&,Length@in],List]];

(* Quaternion permutations in 3 or 4D Code in 14 types of permutations:
"NoneNoSign",                no permutation of position or sign,
  "None",                      no permutation of position (just ± sign permutations on each position),
  "NoneEsign",                 no permutation of position (just Even ± sign permutations on each position),
  "NoneOsign",                 no permutation of position (just Odd ± sign permutations on each position),
  "AllNoSign",                 all permutations of position and no ± sign permutations (just like Permutations[]),
  "All",                       full set of ± sign and positional permutations,
  "Rotate",                    RightRotations of {(Subscript[ℯ, 1]),(Subscript[ℯ, 2]),(Subscript[ℯ, 3])} with ± permutations on each position (cyclic with sign),
  "NoSign",                    no sign permutations, just RightRotation of positions            (cyclic only),
  "NoSignEpos" & "NoSignOpos", no sign permutations,  Even (or Odd) positional permutations,
  "Epos"       & "Opos",       full set of ± sign and Even (or Odd) positional permutations,
  "Esign"      & "Osign",      ± sign Permutation by count of Even (or Odd) + signs,
  "EsignEpos"  & "EsignOpos" & "OsignEPos"   & "OsignOPos" 
                             ± sign Permutation by count of Even (or Odd) + signs and Even (or Odd) position permutations *)
permRotate@in_List:=Module[{out=in},
Join[{out},(out=RotateRight@out)&/@Range[Length@in-1]]];

perms[in_List,select_List:{},permType_String:"All"]:=Module[{inLength,noSelect, signPerms,permList,outList},
inLength=Length@in;
(* Set noSelect if the permType needs all ± permutations *)
noSelect=permType=="Epos"||permType=="Opos"||permType=="Rotate"||permType=="All"||permType=="None";
(* If the permType contains "NoSign", return Array of +1s,
   If the permType doesn't require selecting Even or Odd sign counts, send all signPerms, 
       otherwise do the Select *)
signPerms=If[StringContainsQ[permType,"NoSign"],Array[1&,inLength],
If[noSelect,pm@inLength,
Select[pm@inLength,If[StringContainsQ[permType,"Osign"],OddQ,EvenQ]@Count[Sign@#,1]&]]];
(* Do the position perms *)
permList=Which[
StringTake[permType,3]=="Non",List,
StringContainsQ[permType,"All"]||permType=="Esign"||permType=="Osign",Permutations,
permType=="Rotate"||permType=="NoSign",permRotate,
(* Eperms and Operms processes all positional permutations of Even or Odd Signature (+1,-1) *)
StringContainsQ[permType,"Epos"],Eperms,
StringContainsQ[permType,"Opos"],Operms]@in;
(* Apply the sign perms and delete duplicates, not using Union due to it sorting, which may not be desired *)
outList=DeleteDuplicates@FullSimplify@Flatten[Table[# permList[[i]]&/@signPerms,{i,Length@permList}],1];
(* Apply the select list if needed *)
outList[[If[select=={},Range@Length@outList,select]]]];

{#,outp=Union@perms[{x,y,z},(*){1,2},**)#],Length@outp}&/@
{"AllNoSign","NoneNoSign","None","NoneEsign","NoneOsign","All","Rotate","NoSign","NoSignEpos","NoSignOpos",
"Epos","Opos","Esign","Osign","EsignEpos","EsignOpos","OsignEpos","OsignOpos"}//MatrixForm

(**)
{#,outp=Union@perms[{x,y,z,w},#],Length@outp}&/@
{"AllNoSign","NoneNoSign","None","NoneEsign","NoneOsign","All","Rotate","NoSign","NoSignEpos","NoSignOpos",
"Epos","Opos","Esign","Osign","EsignEpos","EsignOpos","OsignEpos","OsignOpos"}//MatrixForm

Set up the quaternion basis elements for W(A4)

(* 4D Polytopes and Their Dual Polytopes of the Coxeter Group Represented by Quaternions *)
A4oSet:=(
(* r1,r2,r3,r4,r0 are the generator sequence functions of α1...4, & α0, with  d=aStr<>"@"<>bStr where (d^5)=1 
where exponents of r use the rCycle function *)
R1=aStr="r1@r3";
R2=bStr="r2@r4";
R1R2=dStr=aStr<>"@"<>bStr;

(* Embedding A3 into A4 5 ways with sets of 3 generators *)
in={r1,r2,r3,r4,r0};
A3inA4={in[[;;3]]};
Do[in=RotateLeft[in];AppendTo[A3inA4,in[[;;3]]],4];
inStr=ToString/@in;
A3inA4Str=ToString@#&/@#&/@A3inA4;

(* Set up for doW(in) with α1,α2,α3,α4,α00  eq. 12 *)
α1=-1;
α2=(1/2)(1+(Subscript[ℯ, 1]) +(Subscript[ℯ, 2])+(Subscript[ℯ, 3]));
α3=-(Subscript[ℯ, 1]);
α4=(1/2)((Subscript[ℯ, 1]) -σ (Subscript[ℯ, 2])-τ (Subscript[ℯ, 3]));
α5=α00=-(α1+α2 +α3+α4);

(* W(A4)=prq[I,p,prq[(SuperStar[c]),(SuperStar[switchστ[I]]),c]] ⊕ (SuperStar[prq[I,p,prq[(SuperStar[c]),(SuperStar[switchστ[I]]),c]]])] with p∈I and c∈T', between eq. 13, 14 and 18,19 *)
oc0=( (Subscript[ℯ, 3])-(Subscript[ℯ, 2]))/(Sqrt[2]);

αα=octSimplify[(-σ + (Subscript[ℯ, 2])+τ (Subscript[ℯ, 3]))/2];
ββ=octSimplify@prq[(SuperStar[oc0]),(SuperStar[switchστ[αα]]),oc0];

(* the (Cartan) Schlafli Matrix  eq. 15 *)
csm=csmA4={{2,-1,0,0},{-1,2,-1,0},{0,-1,2,-1},{0,0,-1,2}};

(* Quaternion & Dual basis vectors  eq. 16 *)
Clear[ωω,ω0,ω1,ω2,ω3,ω4];
ωω={ω0,ω1,ω2,ω3,ω4};
O1000Str=ToString[#/.ω0->0,TraditionalForm]&/@Inner[Subtract,RotateLeft[ωω],ωω,List];
O1000Str=ReplacePart[ToString[#/.ω0->0,TraditionalForm]&/@Inner[Subtract,RotateLeft[ωω],ωω,List],4->"(ω4-ω3)/2"];

ω0=0;
ωωRule={
ω1->(-(Sqrt[5])+τ (Subscript[ℯ, 2])-σ (Subscript[ℯ, 3]))/(Sqrt[10]),
ω2->2(τ (Subscript[ℯ, 2])-σ (Subscript[ℯ, 3]))/(Sqrt[10]),
ω3->(-(Sqrt[5])(Subscript[ℯ, 1])+(τ^2) (Subscript[ℯ, 2])-(σ^2) (Subscript[ℯ, 3]))/(Sqrt[10]),
ω4->-2( (Subscript[ℯ, 3])-(Subscript[ℯ, 2]))/(Sqrt[10])(*=-2 oc0/(Sqrt[5])*)};
ωωList=oct2List/@ωω/.ωωRule;
O1000=oct2Quat@#&/@Inner[Subtract,RotateLeft[ωω/.ωωRule],ωω/.ωωRule,List];

(* Λ Quaternion & Dual basis {α0,β0,γ0,ϱ0} which is used in Λ1[[aa1,aa2,aa3,aa4] which drives xxOct[x1,x2,x3,x4] eq. 19, and aωΛ00 after eq. 19 *)
aωΛ0:=αβγϱω=     {aa1 ω1 ,                                       aa2 ω2 ,                                        aa3 ω3,                                                                aa4 ω4};
aωΛ1:={-(aa1 +aa2)ω1,(aa1+aa2+aa3+aa4) ω2 ,         -(aa2+aa3+aa4)ω3,                                                (aa2 +aa3) ω4};
aωΛ2:={-(aa3 +aa4)ω1 ,                                       aa3 ω2 ,       - (aa1+aa2+aa3)ω3,                                                                  aa1 ω4};
aωΛ3:={                    aa4 ω1 ,         -(aa2+aa3+aa4) ω2,                                        aa2 ω3 ,                                            -(aa1 +aa2) ω4};
aωΛ4:={  (aa2 +aa3)ω1 ,          -(aa1+aa2+aa3) ω2,(aa1+aa2+aa3+aa4)ω3,                                            - (aa3 +aa4) ω4};
aωΛOrbit={aωΛ0,aωΛ1,aωΛ2,aωΛ3,aωΛ4}/.{ω1->1,ω2->1,ω3->1,ω4->1};
aωΛ04={aωΛ0,aωΛ1,aωΛ2,aωΛ3,aωΛ4}/.ωωRule;
aωΛ=Total/@aωΛ04;

(* 3D Basis vectors v in terms of ω eq. 21, 22, 25 *)
Clear[v04,v0,v1,v2,v3,v4];
v04={v0,v1,v2,v3,v4};
Ov1000Str=ToString[#/.v0->0,TraditionalForm]&/@Inner[Subtract,RotateLeft[v04],v04,List];

v0=0;
vvRule={
v1->ω1-1 ω4/4,
v2->ω2-2ω4/4,
v3->ω3-3ω4/4,
v4->            ω4/4};
vvList=oct2List/@v04/.vvRule;
Ov1000=oct2Quat@#&/@Inner[Subtract,RotateLeft[v04/.vvRule/.ωωRule],v04/.vvRule/.ωωRule,List];

(* eq. 22 - The vΛ alternate 3D quaternion (p0..4) basis {αv0,βv0,γv0,ϱv0} which is used in vΛ1[[aa1,aa2,aa3,aa4]
 which drives xxOct[x1,x2,x3,x4] and avΛ0 after eq. 19  *)
avΛ0:=αβγϱv= { aa1 v1,                                        aa2 v2,                                     aa3  v3,                      (aa1+2 aa2+3 aa3+4 aa4) v4};
avΛ1:= {                  aa1 v1,                                        aa2 v2,                    (aa3+ aa4) v3,                       (aa1+2 aa2+3 aa3 -   aa4)v4};
avΛ2:= {                   aa1 v1,                     (aa2+ aa3) v2,                                      aa4 v3,                       (aa1+2 aa2-2 aa3 -  aa4)v4};
avΛ3:={ (aa1+ aa2) v1,                                       aa3 v2,                                       aa4 v3,                       (aa1-3 aa2-2 aa3 -  aa4) v4};
avΛ4:={                  aa2 v1,                                        aa3 v2,                                      aa4 v3,                    (4 aa1+3 aa2+2 aa3 +   aa4)v4};
avΛOrbit={avΛ0,avΛ1,avΛ2,avΛ3,avΛ4}/.{v1->1,v2->1,v3->1,v4->1};
avΛ04={avΛ0,avΛ1,avΛ2,avΛ3,avΛ4}/.vvRule/.ωωRule;
avΛ=Total/@avΛ04;

(* 3D basis projections *)
p0=oc0;
p1= p0∘(Subscript[ℯ, 1]);
p2= p0∘(Subscript[ℯ, 2]);
p3= p0∘(Subscript[ℯ, 3]);
(* The following changes to p2 & p3, which generate the Real (Subscript[ℯ, 0]) part of the quaternion basis, 
have eq. 28 pp evaluate to the same prescribed values in O1000 (changing dims 1⟷2),
but it breaks the 3D hulls when compared to A3 constructions in Archimedian/Catalan solids (**)
p2= p0∘(Subscript[ℯ, 3]);
  p3=-p0∘(Subscript[ℯ, 2]);**)
p4:=-(p0/(2(Sqrt[5])))(aa1+2 aa2+3 aa3 +4aa4);

pp:={p0,p1,p2,p3,p4};

(* eq. 25,26 **)
αavpΛ0:=(aa1-aa3)/2;
βavpΛ0:=(aa1+aa3)/2;
γavpΛ0:=(aa1+2 aa2+aa3)/2;
ϱavpΛ0:=1;
αβγϱavpΛ0:={αavpΛ0,βavpΛ0,γavpΛ0,ϱavpΛ0};

avp:=αβγϱavpΛ0 pp[[2;;]];

(*)This is the octonion->quaternion that gets used in avΛ by using αβγϱv **)
αβγϱv0={αv0,βv0,γv0,ϱv0}=oct2Quat@Total[αβγϱv/.vvRule/.ωωRule];

(* This is the normal octonion->quaternion ω basis that gets used in aωΛ *)
αβγϱ0={α0,β0,γ0,ϱ0}=oct2Quat@Total@αβγϱω/.ωωRule);

(* Resolving the {aa1,aa2,aa3} using Weyl orbit weights *)
aa:={aa1,aa2,aa3,aa4};
aRule@orbit_List:=Inner[Rule,aa,PadRight[orbit,4],List];

doW@"A4"
Total@%/.aRule@{1,0,0,0}
oct2List@%
octonion@%

O1000;
(* The function biQuaternion takes a 4D quaternion and creates a (L)eft/(R)ight (and/or split) octonion . 
Here R is {0,0,0,0} due to the input being Real (ℝ).*)
O1000octList=biQuaternion/@%;
O1000oct=octonion/@%;
O1000ListRnd=rndMat[#/.φωRep]&/@%%;
O1000octRnd=octonion/@%%;
checkVertices[O1000oct,True,True,True,True,True,False]

(*  Λ processes 3D orbit specifications.
It defaults to the irregular A3 Icosahedron, on A3, we take default perms as "Osign" *)
Λ[f_,group_(*)String|group_List**):"A3",orbit_List:{1,1,1},permType_String:"Rotate"]:=f[doW@group/.aRule@orbit,permType];

(*  Λ0 defaults to the irregular A3 Icosahedron, on A4, we take default perms as "Osign" *)
ΛnD[Λin_,f_,grp_,orb_List:{1,1,1},permType_String:"Rotate"]:=
Module[{Λinput,ωΛin,vΛin,validΛin,function,group,validGroupName,groupL,orbit,output,octΛinput,octppωω},
print["Λ=",Λin," f=",f," grp=",grp," orb=",orb," perm=",permType];

(* If missing inputs, correct assignments based on patterns *)
(* If Λin is defined correctly it will a Member of the two valid Λin types. 
Otherwise set it to Null because it does not need Λinput options in processing the permutation. *)
ωΛin=MemberQ[aωΛ,Λin];
vΛin=MemberQ[avΛ,Λin];
validΛin=ωΛin||vΛin;

(* If orbit got a 3D default due to lack of inputs, but Λinput indicates it is 4D, change the orbit to 4D. *)
orbit=orb;
If[orbit=={1,1,1}&&validΛin,orbit={1,1,1,1}];
print["orbit=",orbit];

(* If f is a string, it got assigned what is supposed to be a group. *)
group=If[StringQ@f,f,grp];
(* If the group is a valid name, take its length from its rank, otherwise infer it from the orbit length. *)
validGroupName=StringQ@group&&(StringLength@group<2||StringLength@group>3);
groupL=If[validGroupName,ToExpression[StringTake[group,-1]],Length@orbit];
(* If the group is not a valid name, give it a default based on groupL=Length@orbit *)
group=If[!validGroupName,If[groupL==4,"A4","A3"]];
print["group=",group," groupL=",groupL];

(* If it is a valid group, set up the group  *)
If[validGroupName,doW@group];

(* If f is not a valid function, default it to oShow. *)
function=If[!(f===oPerms||f===oE8List||f===oCalc||f===oShow),oShow,f];
print["function=",function];

Λinput=Which[
(* If Λin in a valid 4D group, just set Λinput=Λin. *)
ωΛin,Λin,
vΛin,Λin,
(* If f is a string, it got assigned what is supposed to be a group, so that means Λin=Null.
But if there is a valid group name with length 4 (e.g. A4), we may assign it to avΛ0 *)
StringQ@f&&Length@orbit==4||
(* or if Λin=Null and grp is a valid 4D string, set it to Λinput=avΛ0. *)
Λin===Null&&validGroupName&&groupL==4,avΛ[[1]],
(* It isn't defined, so set it to Null. *)
True,Null];
print["ωΛin=",ωΛin," vΛin=",vΛin," validΛin=",validΛin," Λinput=",Λinput];

(* Generate the permutation pattern(s): 
For 4D vertex generation,
   oct2Quat@Λin is a 4D list of quaternion coefficients.
 It is converted from Λin (which is one of 5 (avΛ0...4) sums of quaternion (octonion) elements, 
   but only after applying the aRule@orbit replacments for aa1...4 

pp[[;;4]] is a scaled list of the first 4 of 5 quaternions  p0...p3, 
      but you can also use aωΛ0...3 and ωω[[;;4]] instead of pp 

If the Λinput is Null, it is either 3D or already processed into an nD list by ΛnD, so treat it as an nD list just to be permuted.
Otherwise it must be a 4D group to be processed with Λinput. *)
output=If[Length@orbit==3||Λinput===Null,
function[doW@group/.aRule@orbit,permType],
(* For 4D, generate the oScaleListOut string that can also be used as input for a call to oScaleListDo. *)
(* The comments switch between quaternion/octonion math to Real *)
octΛinput=oct2List[Λinput/.aRule@orbit];
octppωω=oct2List[Total@If[vΛin,pp[[;;4]],(ωω/.ωωRule)]/.aRule@orbit];
print["octΛinput=",octΛinput," octppωω=",octppωω];
oScaleListIn={
If[doOctΛ,(* Quaternion/Octonion *)
(* If Λinput is in avΛ use pp, otherwise use ωω  *)
{oct2List[octΛinput∘octppωω][[If[doPP3D,2,1];;4]],permType},
(* Real *)
{oct2List[Inner[Times,oct2Quat@Λinput,
(* If Λinput is in avΛ use pp, otherwise use ωω *)
If[vΛin,pp[[;;4]],(ωω/.ωωRule)[[;;4]]],
Plus]/.aRule@orbit][[If[doPP3D,2,1];;4]],permType}]};
(* Process it into vertex permutations that can be fed to hulls3D (after trimming to 3D) or hulls3DPerms up to 8D. *)
(**)print["oScaleListIn=",oScaleListIn];
(* If ΛnD is called from oScaleListDo, this oScaleListOut will be replaced after the Join in oScaleListDo. *)
oScaleListOut=DeleteDuplicates[(*)octSym/@**)Λ[oE8List,Sequence@@First@oScaleListIn][[All,If[doPP3D,2,1];;4]]];
(**)print["oScaleListOut=",oScaleListOut];(**)
(* Output the vertices if it doesn't need to be visualized. *)
If[function=!=oShow,oScaleListOut,
(* Generate the convex hulls of the 3 or 4D vertices *)
TableForm@{Row@{" f=",function," group=",group," orbit=",orbit," perm=",permType},
If[doPP3D,
hulls3D@oScaleListOut,
hulls3DPerms["oScaleListOut",False,,4]]}]];
output];

These are functions involved in generating the Graphics3D visualization of nD orbit hulls using quaternion math for a given group
 (e.g. A3, B3, H3, A4, C4, D4, F4, H4)

(* Using perms (above) to generate solids with octonion (quaternion) orbits as input *)
oE8List[in_List,select_List:{},permType_String:"Rotate"]:=Module[{out},
DeleteDuplicates[
(* Use oScale to scale "in" without having to change the VisibLie_E8 UI.
If the permType "NoneNoSign" indicates it is already a large list or the list is >8  or oScale is not a list just use "in",
    otherwise multiply "in" by oScale (usually an array of 1's. using the correct dimensions 
(e.g. if it a 3D list, take oScale dims 2;;4 otherwise 1;;Length@in *)
out=perms[in 
If[permType=="NoneNoSign"||!ListQ@oScale||Length@in>8,1,
If[Length@in==3,oScale[[2;;4]],oScale[[;;Length@in]]]],select ,permType];
(* Rejoin the permutations output to an 8D oct2List *)
If[Length@#==3,
Join[{0},#,{0,0,0,0}],
Join[#,Array[0&,8-Length@#/. slRep]]]&/@If[permType=="NoneNoSign"||Length@out[[1]]>8,Flatten[out,1],out]]];
oPerms[in_List,select_List:{},permType_String:"Rotate"]:=octonion/@oE8List[in,select,permType];
oCalc[in_List,select_List:{},permType_String:"Rotate"]:=oct2ImQuat@#&/@oPerms[in,select,permType];
oShow[in_List,select_List:{},permType_String:"Rotate"]:=hulls3D[oCalc[in,select,permType]](*)[[1,2,1]]//ColumnForm**)//MatrixForm(**);

Define the SU5 4D Solids

doPP3D=False;
addNullPoints=True;

doW@"A4";

Define the 16 orbits & their duals for A4

Single Ring Orbits

(*) {1,0,0,0} **)
FiveCell=perms4D[[1]];
(*) Negation Dual **)
Dual5Cell=-TriRectified5Cell;
(*) -{0,0,0,1} **)

(*) {0,1,0,0} **)
Rectified5Cell=perms4D[[2]];
(*) Negation Dual **)
DualRectified5Cell=-BiRectified5Cell;
(*) -{0,0,1,0} **)

(*) {0,0,1,0} **)
BiRectified5Cell=perms4D[[3]];
(*) Negation Dual **)
DualBiRectified5Cell=-Rectified5Cell;
(*) -{0,0,1,0} **)

(*) {0,0,0,1} **)
TriRectified5Cell=perms4D[[4]];
(*) Negation Dual **)
DualTriRectified5Cell=-FiveCell;
(*)-{0,0,0,1} **)

Dual Ring Orbits

(* {1,1,0,0} *)
Truncated5Cell =perms4D[[5]];
(*) Negation Dual **)
DualTruncated5Cell=DualTruncated5Cell;
(*)-{0,0,1,1}=**)

(* {1,0,1,0} *)
Cantellated5Cell =perms4D[[6]];
(*) Negation Dual **)
DualCantellated5Cell=-DualCantellated5Cell;
(*)-{1,0,1,0} **)

(*) {1,0,0,1} **)
Runcinated5Cell=perms4D[[7]];
(*) Self Dual **)
DualRuncinated5Cell=-Runcinated5Cell;

(*) {0,1,1,0} **)
BiTruncated5Cell=perms4D[[8]];
(*) Self Dual **)
DualBiTruncated5Cell=-BiTruncated5Cell;

(*) {0,1,0,1} **)
BiCantellated5Cell=perms4D[[9]];
(*) Negation Dual **)
DualBiCantellated5Cell=Cantellated5Cell;
(*)-{0,1,0,1} **)

(*) {0,0,1,1} **)
TriTruncated5Cell=perms4D[[10]];
(*) Negation Dual **)
DualTriTruncated5Cell=-Truncated5Cell;
(*)-{0,0,1,1} **)

Triple Ring Orbits

(*) {1,1,1,0} **)
CantiTruncated5Cell=perms4D[[11]];
(*) Negation Dual **)
DualCantiTruncated5Cell=-CantiRuncinated5Cell;
(*)-{0,1,1,1} **)

(*) {1,1,0,1} **)
RunciTruncated5Cell=perms4D[[12]];
(*) Negation Dual **)
DualRunciTruncated5Cell=-BiCantiTruncated5Cell;
(*)-{1,0,1,1} **)

(*) {1,0,1,1} **)
BiCantiTruncated5Cell=perms4D[[13]];
(*) Negation Dual **)
DualBiCantiTruncated5Cell=-RunciTruncated5Cell;
(*)-{1,1,0,1} **)

(*) Not listed {0,1,1,1} **)
CantiRuncinated5Cell=perms4D[[14]];
(*) Negation Dual **)
DualCantiRuncinated5Cell=-CantiTruncated5Cell;
(*)-{1,1,1,0}  **)

Quad Ring Orbit

(*) {1,1,1,1} **)
OmniTruncated5Cell=perms4D[[15]];
(*) Self Dual **)
DualOmniTruncated5Cell=-OmniTruncated5Cell;

Pre-evaluate multiOrbit 4D Solids

multiOrbitList4D={{},
FiveCell,Rectified5Cell,BiRectified5Cell,TriRectified5Cell,Truncated5Cell,Cantellated5Cell,Runcinated5Cell,BiTruncated5Cell,BiCantellated5Cell,TriTruncated5Cell,CantiTruncated5Cell,RunciTruncated5Cell,BiCantiTruncated5Cell,CantiRuncinated5Cell,OmniTruncated5Cell,

Dual5Cell,DualRectified5Cell,DualBiRectified5Cell,DualTriRectified5Cell,DualTruncated5Cell,DualCantellated5Cell,DualRuncinated5Cell,DualBiTruncated5Cell,DualBiCantellated5Cell,DualTriTruncated5Cell,DualCantiTruncated5Cell,DualRunciTruncated5Cell,DualBiCantiTruncated5Cell,DualCantiRuncinated5Cell,DualOmniTruncated5Cell};

multiOrbitList4DStr= {"None","5-Cell","Rectified 5-Cell","BiRectified 5-Cell","TriRectified 5-Cell","Truncated 5-Cell","Cantellated 5-Cell","Runcinated 5-Cell","BiTruncated 5-Cell","BiCantellated 5-Cell","TriTruncated 5-Cell","CantiTruncated 5-Cell","RunciTruncated 5-Cell","BiCantiTruncated 5-Cell","CantiRuncinated 5-Cell","OmniTruncated 5-Cell",

"Dual 5-Cell","Dual Rectified 5-Cell","Dual BiRectified 5-Cell","Dual TriRectified 5-Cell","Dual Truncated 5-Cell","Dual Cantellated 5-Cell","Dual Runcinated 5-Cell","Dual BiTruncated 5-Cell","Dual BiCantellated 5-Cell","Dual TriTruncated 5-Cell","Dual CantiTruncated 5-Cell","Dual RunciTruncated 5-Cell","Dual BiCantiTruncated 5-Cell","Dual CantiRuncinated 5-Cell","Dual OmniTruncated 5-Cell"};

(**)
If[MemberQ[paneList,"Dynkin"],
(*)doPrint=True;**)
multiOrbitList4DHulls   =Join[{""},(Print["Starting ",#];oScaleListOut=DeleteDuplicates@ΛnD[avΛ[[1]],oCalc,"A4",multiOrbitList4D[[#]],"Osign"];hulls3DPerms["oScaleListOut",False,,(**)1(*)4**)];Row@{combinedHull,overallHull})&/@Range[2,Length@multiOrbitList4D]];
doPrint=False];

showGroups produces this (Subscript[SU, 5]) ⊃ (Subscript[SU, 4]) ⊗ (Subscript[U, 1]) verts ↦ Graphics3D list

getSU4Hull[perm4DNum_,ΛNum_]:=(ΛnD[avΛ[[ΛNum]],oShow,"A4",perms4D[[perm4DNum]],"Osign"];overallHull);
getSU5Hull@orbitNum_:=multiOrbitList4DHulls[[1+orbitNum]];

(* This uses the RepName function from (HyperlinkTemplate[GroupMath, https://arxiv.org/pdf/2011.01764.pdf, https://arxiv.org/pdf/2011.01764.pdf, HyperlinkActionRecycled, HyperlinkActive, , ]) *)
showGroups[in_,mult_:1]:=Module[{(**)allSU4Orbits,uniqueSU4Orbits,SU5sum,SU4sum,SU5net,u1List,orbit,u1(**)},{
SU5sum=getRepNumber[RepName[SU5, mult perms4D[[#]]][[1]]];
allSU4Orbits=Table[Abs/@in[[i,;;3]]/.aRule[mult perms4D[[#]]],{i,5}];
uniqueSU4Orbits=Union@allSU4Orbits;
SU4sum=Total[getRepNumber[RepName[SU4,#][[1]]]&/@uniqueSU4Orbits];
SU5net=SU5sum-SU4sum;
u1List=Table[Round[Total[If[i<5,-1,1]in[[i,4]]/.aRule[mult perms4D[[#]]]]],{i,5}];
Row@{"(Subscript[SU, 5]) O(",Style[Row[mult perms4D[[#]]],Orange],")         (Subscript[SU, 5]) ⊃ (Subscript[SU, 4]) ⊗ (Subscript[U, 1]) ",getSU5Hull@#},
Row@{"(Subscript[SU, 5])-(Subscript[ΣSU, 4])=",Style[SU5sum,Orange],"-",Style[SU4sum,Blue],"=",Style[SU5net,Black]," missing"},
Row@{"ΣU1 ",Style[u1List,Red],"=",Total@u1List},
ColumnForm@Table[
orbit=Abs/@in[[i,;;3]]/.aRule[mult perms4D[[#]]];
u1=Round[Total[If[i<5,-1,1]in[[i,4]]/.aRule[mult perms4D[[#]]]]];
repName=RepName[{SU5,SU4,U1},{mult perms4D[[#]],orbit,u1}];
Row@{"Λ'(",i-1,")  (Subscript[SU, 4]) O(",Style[Row@orbit,Blue],")  ",
Style[repName[[1]],Bold,Orange],"⊃",Style[repName[[2]],Bold,Blue],"⊗",
Style[repName[[3]],Bold,If[ToExpression@Last@repName==u1,Red,Black]],
" verts ↦",getSU4Hull[#,i]},{i,5}]}&/@Range@Length@perms4D];

doPP3D=True;
MatrixForm@Transpose[showGroups[avΛOrbit,#]&/@Range@2]