Generating the 120 - cell (J) (600) from Coxeter - Dynkin Quaternions

While verifying Koca's  work (et al.)
(HyperlinkTemplate[Quaternionic representation of snub 24-cell and its dual polytope derived from E8 root system, https://www.sciencedirect.com/science/article/pii/S0024379510005173, https://www.sciencedirect.com/science/article/pii/S0024379510005173, HyperlinkActionRecycled, HyperlinkActive, , ])

and Table 3 in Mamone's work  (et al.)
(HyperlinkTemplate[Orientational Sampling Schemes Based on Four Dimensional Polytopes, https://www.mdpi.com/2073-8994/2/3/1423, https://www.mdpi.com/2073-8994/2/3/1423, HyperlinkActionRecycled, HyperlinkActive, , ])

In generating these polytopes, we use:
* The parent (1000) and TriRectified (0001)  Weyl orbits of D4 generates the self-dual 24-cell T (24) and its alternate form T’.
        * T is a 4D octahedron (16-cell (8)) and 4D cube (8-cell (16) with a 3D hull of the cuboctahedron (see also parent & TriRectified BC4 Weyl orbits).
        * T’ is a set of 3 orbits (8 ea) of 2 component (vector) quaternions with a 3D hull of the rhombic dodecahedron.
        * From T (& T’) we take the any one vertex to define c (& c’=cp). Here c’ is used in the generation of A from A’.
* The parent Weyl orbit (1000) of A4 generates the 5-cell (A) (5) via an alternate form (A’) from Koca’s work, where A=c’∘A’.  
        * Note: Since Mamone identifies the 5-cell as S (but Koca uses S for the (S)nub 24-cell which we use here, the 5-cell is identified with A.
        * This is a 4D tetrahedron generated from my function ΛA4[Λ_,orbits_].
* The parent Weyl orbit (1000) of H4 generates the  600-cell I (120) via an alternate form I’.  
        * The snub Weyl orbit (0000) of H4 generates the vertices of the snub 24-cell or S=I-T (96), with alternate S’=I’-T’.  
        * From S (& S’) we take the any one vertex (we use the 8th of 96 with only 48 satisfying Koca’s  constraint of p∈I where (p^5)=±1)  to define α (& β). Here (α^(0-4)) can be used in the generation of I (& I’) as I=(α^(0-4))∘T , with I’=(α^(0-4))∘T'.
* The TriRectified Weyl orbit (0001) of H4 generates the 120-cell J (600) via the alternate form J’.
        * There are several paths to generate J’, using either A’∘I’ or A’∘((α^(0-4))∘T') or as in Koca’s eq. 15   J'=(∑_(i,j=0)^4)⊕(α^i)∘(T∘(β^j)) , where A=(∑_(i=0)^4)⊕(α^i)∘(β^i) , with β= (SuperDagger[(OverBar[p])]).
         * There are several paths to generate J, using either A’∘I   or A’∘((α^(0-4))∘T ) or as in Koca’s eq. 15    J=(∑_(i,j=0)^4)⊕(α^i)∘(T'∘(β^j))  or equivalently by Mamone’s Table 3 explanation.

But in the end, J is the quaternion multiplication product of 3 lists of quaternions p∘r∘q or from Koca [p,q]:r using my prq[p_,r_,q_] function, which also handles lists of quaternions.
So the construction recipe is as follows:
       Selected vertices:
       c=T[[12]];   c’=T’[[12]];
       α=S[[8]];    β=S’[[8]];
       
       A4 5-cells:
       A’=(-((√5)/2)) ΛA4[{0...4},{1,0,0,0}];
       A=(SuperStar[prq[c', 1,A']]);  (* note the conjugation  *)
       
       H4 600-cells:
       I= prq[(α^(0-4)),1,T];
       I’= prq[(α^(0-4)),1,T’] ;
       
       H4 (S)nub 24-cells:
       S=I-T; 
       S’=I’-T’;
       
       H4 120-cells:
       J’= prq[A’,1,I’] or prq[A’,(α^(0-4)),T’];
       J=  prq[A’ ,1,I ] or prq[A’,(α^(0-4)),T ];

BTW - 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}

Below is the 24-cell referred to in Table 3 of Mamone’ work. His referenced single vertex {(1/(Sqrt[2])),(1/(Sqrt[2])),0,0} being the 24th  element of T’ in the construction of his Table 3.
We can use the D4 Weyl group generator or simply take the list of D4 vertices indexed (d4) as a subset of E8 (done here).

d4

Tp=octonion[pE8@#/(Sqrt[2])]&/@%
(* Rounded numeric *)
TpRnd=rndOct/@%;
(* Octonion list form *)
TpList=N[oct2List@#/.φωRep]&/@%;

hulls3DPerms["TpList",False,,1];
{overallHull,combinedHull}

The “other” 24-cell (rows 1-3 of the  WP unit radius table) is T made from the tesseract and 16-cell.

checkVertices[T,True,False,True,True,True,False]

(* We use Numeric lists for speed, since we don't show the symbolic Norms *)
hulls3DPerms["Tlist",False,,1];{overallHull,combinedHull}

We generate A’ using the results of my ΛA4 Weyl orbit function and scaling the result by -((√5)/2) and then generate the origin-centered unit-radius 5-cell (WP) A=(SuperStar[prq[c', 1,A']]). 
While not being called out explicitly in Koca’s paper(s), A can be found in the description before eq.  15 with J=(∑_(i=0)^4)⊕(α^i)∘((OverBar[α])^(†i))∘c'∘I, where A=(∑_(i=0)^4)⊕(α^i)∘((OverBar[α])^(†i)).
The function ΛA4 takes in a list of {Λ(n=0...4)} to be summed and the Coxeter-Dynkin orbit {1,0,0,0}. The {0,1,4,2,3} is 0-4 ordered so these results are consistent with WP article coordinate lists. 
Specifically, that list refers to the A4 Weyl group Λ(n=0...4) in the ω dual basis from Koca’s papers. 
The function biQuaternion takes a 4D quaternion and creates a (L)eft/(R)ight octonion. Here R is {0,0,0,0} due to the input being Real (ℝ).

ΛA4[{0,1,4,2,3},{1,0,0,0}]

ApList=oct2List@biQuaternion[-((Sqrt[5])/2)#]&/@%[[1,1]];
Ap=octSimplify@octonion/@%;
checkVertices[%,True,True,True,True,True,False]

hulls3DPerms["ApList",False,,4];{overallHull,combinedHull}

(* 12th element of T' *)
cp=Tp[[12]]

(* Simplify quaternion multiplication using p∘r∘q which also handles lists,
   We scale up/down by 4 for symbolic clarity. *)
4oct2Quat@#&/@Flatten@prq[cp,1,Ap];
(* φωRep replaces the symbolic forms φ->((Sqrt[5])-1)/2, also note the conjugation using ^* *)
A=(1/4)(SuperStar[octonion[biQuaternion[#/.φωRep]]])&/@%;
Alist=oct2List/@%;
checkVertices[%%,True,False,True,True,True,False]

hulls3DPerms["Alist",False,,4]
addNullPoints=False;

The quaternion 600-cell per WP coordinates (I in Table 3 of the referenced paper) and in Koca’s  work with I=(∑_(j=0)^4)⊕(α^j)∘T:

(* Generating S:
By Koca's eq. 11 S=I-T=(∑_(i=1)^4)⊕(α^i)∘T as well as from eq. 4.3 in (HyperlinkTemplate[a later Koca paper 1106.3433, https://arxiv.org/abs/1106.3433v2, https://arxiv.org/abs/1106.3433v2, HyperlinkActionRecycled, HyperlinkActive, , ]). Here τ=1/φ and σ=-φ. 
Note: This value of φ is the small golden ratio=((Sqrt[5])-1)/2=0.618... not ((Sqrt[5])+1)/2=1.618... *)
Slist=αList=biQuaternion/@perms[{-σ,1,τ,0},"OsignOpos"]/2;
Length@%

αListOct=octonion@oct2List/@%%;
α=αListOct[[8]]

(* Create a list of exponentiated α's:
(α^(n=0...4))  *)
octExpα=octSimplify@#&/@(octExp[α,#]&/@Range[0,4])
checkVertices[%,True,True,True,True,False,False]

(* Generating S': 
By Koca's text after eq. 15 S'=I'-T'=(∑_(i=1)^4)⊕(α^i)∘((OverBar[α])^(†i))∘T', as well as from the text after eq. 4.3 in (HyperlinkTemplate[a later Koca paper 1106.3433, https://arxiv.org/abs/1106.3433v2, https://arxiv.org/abs/1106.3433v2, HyperlinkActionRecycled, HyperlinkActive, , ]) using (OverTilde[S])=(φ⟷τ),
     which is the same operation described for the (SuperDagger[dagger])notation. This equation and description of:
  I'=(OverTilde[I])=T⊕(OverTilde[S]) seems incorrect with a 1 (not(Sqrt[5])) in the 2nd permutation term because it does not match S'=(∑_(i=1)^4)⊕(α^i)∘((OverBar[α])^(†i))∘T'. *)
SpList=βList=biQuaternion/@perms[{-τ,(Sqrt[5]),σ,0},"ESignEpos"]/(Sqrt[8]);
Length@%

βListOct=octonion@oct2List/@%%;
β=βListOct[[8]]

(* Create a list of exponentiated β's:
(β^(n=0...4))  *)
octExpβ=octSimplify@octExp[β,#]&/@Range[0,4];
checkVertices[%,True,False,True,True,False,False]

Show A=(∑_(i=0)^4)⊕(α^i)∘((OverBar[α])^(†i)):

(* Generate ((OverBar[α])^(†i=0...4)) where the function switchστ performs the (φ⟷τ)(SuperDagger[dagger]) operation *)
expαSW=octSimplify@octExp[switchστ@(SuperStar[α]),#]&/@Range[0,4];
(* Generate (∑_(i=0)^4)⊕(α^i)∘((OverBar[α])^(†i)) *)
altA=octSimplify@prq[octExpα[[#]],1,expαSW[[#]]]&/@Range[1,5];
checkVertices[%,True,False,True,True,False,False]

Sort[oct2List/@rndOct/@A]==Sort[oct2List/@rndOct/@altA]

(* I(120) using T(24),
   Quaternion multiplication using p∘r∘q which also handles lists
FYI - Since I is a Mathematica Global variable for the (I)maginary, we ad Φ to the name.  *)
IΦ=octSimplify/@Flatten@prq[octExpα,1,T];
IΦRnd=rndOct/@%;
IΦList=oct2List@#&/@%%;
hulls3DPerms["IΦList",False,,1]

Ip=Flatten@prq[octExpα,1,Tp];
IpRnd=rndOct/@%;
IpList=oct2List@#&/@%%;
hulls3DPerms["IpList",False,,1];overallHull

(* Show that I' and c'∘I have 24 common vertices which are T' *)
Select[position[IpRnd,rndOct[cp∘#]]&/@IΦRnd,NumericQ@#&]
Sort@IpRnd[[%]]==Sort[rndOct/@Tp]
Sort@IpRnd[[%%]]==Sort@TpRnd

These T’ vertices are listed in the middle column (3) of the  WP unit radius table. It is interesting to note that these 24 T’ vertices are  part of the dual snub 24-cell that relate to 8 of the tetrahedrons that define the 120-cell’s outer convex hull (chamfered dodecahedron) pentagons. Eight of 24 vertices are the peak vertex of one cell where three kites merge and that vertex is one of five pentagon vertices. Two other pentagon vertices are the ends of the kite wings from only one of the three merging kites. See the graphic below (with a slight rotation in 3D).

;

As part creating J we take “all possible quaternion products of the 5 vertices of the hypertetrahedron S(now A) and the 120 vertices of the hypericosahedron I”. If we use A’ & I’ instead of A & I, this operation produces the J’ (or Jp), to which I refer to on the 120-cell Article Talk page. 

Below that is the absolute valued vertex permutation tally list for J’ (in bot symbolic and numeric forms). Please note: rows 1,2, & 5 of the permutation list contains the 5-cell and the 600-cell as described in rows 1-3 of the first column in the WP unit radius table. 

Below that is the  480 vertex diminished J’ created by removing  I 600-cell vertices.

(*  J'=prq[A',1,I'] (**)
Jp=Flatten@prq[Ap,1,Ip];**)

(* or prq[A',(α^(0-4)),T'] **)
Jp=octSimplify/@Flatten@prq[Ap,octExpα,Tp];(**)

JpList=oct2List/@Jp;Length@Jp

hulls3DPerms["JpList",False,,1]

tallyGroupPerms[Jp,2]

diminishedJp=Complement[JpList,IΦList];
Length@%

hulls3DPerms["diminishedJp",False,,1]

Finally as described in the last row of Mamone’s table 3 and Koca’s text before eq.  15 with J=(∑_(i=0)^4)⊕(α^i)∘((OverBar[α])^(†i))∘c'∘I, where A=(∑_(i=0)^4)⊕(α^i)∘((OverBar[α])^(†i)) and I=(∑_(j=0)^4)⊕(α^j)∘T, the octonion→quaternion multiplication of c’ (or any other T’ vertex) against A∘I produces the normal (J) 600-cell. Alternatively, instead of using c’∘A∘I, using A’ ∘I, produces the same results.

Below that is the  absolute valued vertex permutation tally list.

(* J=prq[A',1,I] (**)
J=Flatten@prq[Ap,1,IΦ];**)

(* or prq[A',(α^(0-4)),T] **)
J=octSimplify/@Flatten@prq[Ap,octExpα,T];(**)

JList=oct2List/@J;
Length@%

hulls3DPerms["JList",False,,1]
{overallHull,combinedHull};

tallyGroupPerms[J,(Sqrt[8])]
JtallyPermList=tallyPermList;

Below is the code that generates the 480 vertex dimished J and the ± valued vertex list for a  diminished J  permutation list sorted by absolute values.

Below that is shown the tallied permutation list  in both  symbolic and numeric list form.

Below that is the visualization of the convex hulls of the diminished J, created by removing all vertices of the quaternion product of c'∘I from J.

Below that is the permutation list of the  diminished J, along with a highlighed in red set of differences from the J  vertices.

diminishedJ=oct2List/@octSimplify/@Complement[rndOct/@JList,rndOct/@IpList];
Length@%

{Partition[Sort[oct2Quat@rndOct@#&/@diminishedJ,Abs@#1>Abs@#2&],UpTo@80]}//TableForm

hulls3DPerms["diminishedJ",False,,1]

JtallyPermList/.{24->Style["24->0",Red],64->Style["64->32",Red]}//MatrixForm