Octonions

Introduction

Since there are 480 permutations of octonions with unique multiplication tables, it is necessary to be able to intialize the math with a specific octonion (and its multiplication table). The section on “The 480 Octonions” sets up these permutations. The construction of the 480 octonion sets of 7 triples uses converted C source code from Donald Chesley of Davidson Laboratories, Stevens Institute of Technology. This code takes some time, so for the most part, I simply hard coded the results.

With 480 possible math tables, it is convenient to have a method to organize and index the octonions. Since they are well known to be related to the 240 vertices of E8, I use group theory and its deep connection to binary logic and particle physics as an organizing principle. This is outlined in the setion “Indexing the Octonions”.

The E8 vertices can easily be constructed from the (2^8)=256 Clifford algebra (Cl(0,8) also related to the Pascal triangle. Sometimes, the 8 excluded "generator" vertices are added when reference is made to its 248 E8 "dimensions". The 8 "anti-generators" complete the 256. These are the Permutations@{±1,0,0,0,0,0,0,0}. The E8 symmetries found in group theory are also found in particle physics. For example, the idea of an "anti-particle" is the negation of the E8 vertex or inverting binary 0↔1). The idea of left/right symmetry is related to the L/R and Up/Down particle spins. The 112 integer (and 128 half-integer) E8 vertices are related to the boson (and fermions) respectively. To reach the doubling of the 512=480+32 “excluded” octonion permutations, I added what I call a 9th “flip” bit parameter. Please see my website for more detail on this.

So indexing the octonions is as simple as providing a numeric reference to the valid 8-bitwise patterns and a flip-bit=True/False flag. The function pTriad[p_,flip_] sets the values used in getTriads[invMask_,altMask_,fPi_,sm_] which defines the 7 sets of triples (triads) of a unique octonion.

Once you have the octonion triads, you need to generate the multiplication table (and do the octonion math). This is done in the next section “The multiplication tables”.

The function fM[triads_] creates the table, but the actual symbolic octonion multiplication is done with SmallCircle. For exampe the associator is (a∘b)∘c - a∘(b∘c), where a, b, and c are one of {(Subscript[ℯ, 1]),(Subscript[ℯ, 2]),(Subscript[ℯ, 3]),(Subscript[ℯ, 4]),(Subscript[ℯ, 5]),(Subscript[ℯ, 6]),(Subscript[ℯ, 7])}. Mathematica uses I,J, and K=IJ in their Quaternion logic, so I also provide for using those symbolic references (adding L for Octonions, of course), by setting IJKLstyle=True/False and chkOctStyle to modify the logic. You can feed a real 8 dimensional vector (array) to "octonion" and it sets up for the 8D math of octonions.

The next section “Linking Quaternions to Octonions” sets up the logic to take the Mathematica Quaternion functions and use the Cayley-Dickson doubling procedure to create “Octonion” functions. This means calls using “Octonion” take either a list of two valid Mathematica Quaternions or a real 8 dimensional vector (array) that is converted to two Quaternions (with cayleyDicksonOct=True). If cayleyDicksonOct=False and a real array is used, then it uses only the “octonion” logic (as defined by the selected multiplication table).

The next section "Define the tests” sets up for testing the math between Mathematica Quaternions and "Octonion" functions" against more generically defined “octonion” logic.
**please note case sensitivity here

The output of the last section “The tests” shows that the logic works as it should. Notice that when we use IJKL symbols w/o also using cayleyDicksonOct, the multiplication does not simplify down as much as others. This is due to “octonion” multiplications tables being defined using {(Subscript[ℯ, 1]),(Subscript[ℯ, 2]),(Subscript[ℯ, 3]),(Subscript[ℯ, 4]),(Subscript[ℯ, 5]),(Subscript[ℯ, 6]),(Subscript[ℯ, 7])}.
Also notice what happens when using cayleyDicksonOct math on a selected octonion multiplication table that doesn’t have the assummed Mathematica Quaternions in both Cayley-Dickson doubled form {(Subscript[ℯ, 3])=K=IJ=(Subscript[ℯ, 1])∘(Subscript[ℯ, 2])} and {(Subscript[ℯ, 6])=JL=(Subscript[ℯ, 2])∘(Subscript[ℯ, 4])}. It does NOT test True unless also using the IJKL logic (of the Mathematica Quaternions).

Initialization

General functions

<<"Quaternions`"

(* Customized Common Functions *)
first@in_:=If[Length@in==0,in,First@in];
position[x_,y_]:=first@Flatten@Position[x,y,1,Heads->False];

(* This is the bitwise order ((2^n) value) of the quantum parameters *)
(* based on symmetries of E8 and extended Standard Model physics-seehttp://theoryofeverything.org *)
(* {(2^7)->a,(2^6)->p,(2^4)->cc,(2^2)->ss,(2^0)->gg} *)
bOrd={7,6,4,2,0};
bStr="0apccssgg";

bitPerm=Permutations@Range@3;
(* {1,2,3} order with g1=B/F, pType, anti based on bOrd {a,p,cc,ss,gg} *)
bitOrd={5,2,1};
(* order determined to produce a symmetric Dynkin construction pattern with g1=B/F, pType, anti *)
bP=1;

(* return (2^(n-1)) if that bit is set *)
fB[p_,bit_]:=BitAnd[Abs@p,bit];
(* return 1 if bit=(2^(n-1)) is set in p *)
fBit[p_,bit_]:=fB[p,bit]/bit;
(* extract specific bits that are set in particle p *)
extBit[p_,bOrdNum_,bOrdShift_]:=fBit[p,(2^(bOrd[[bOrdNum]]+bOrdShift))]
aB@p_:=extBit[p,1,0];
pB@p_:=extBit[p,2,0];
c0B@p_:=extBit[p,3,0];
c1B@p_:=extBit[p,3,1];
s0B@p_:=extBit[p,4,0];
s1B@p_:=extBit[p,4,1];
g0B@p_:=extBit[p,5,0];
g1B@p_:=extBit[p,5,1];

The 480 Octonions

triple35Lst =Subsets[Range@7,{3}]

fano30Lst={{1,10,15,21,24,28,29},{1,10,15,22,23,27,30},{1,11,14,20,25,28,29},{1,11,14,22,23,26,31},{1,12,13,20,25,27,30},{1,12,13,21,24,26,31},{2,7,15,18,24,28,32},{2,7,15,19,23,27,33},{2,8,14,17,25,28,32},{2,8,14,19,23,26,34},{2,9,13,17,25,27,33},{2,9,13,18,24,26,34},{3,6,15,18,22,30,32},{3,6,15,19,21,29,33},{3,8,12,16,25,30,32},{3,8,12,19,21,26,35},{3,9,11,16,25,29,33},{3,9,11,18,22,26,35},{4,6,14,17,22,31,32},{4,6,14,19,20,29,34},{4,7,12,16,24,31,32},{4,7,12,19,20,27,35},{4,9,10,16,24,29,34},{4,9,10,17,22,27,35},{5,6,13,17,21,31,33},{5,6,13,18,20,30,34},{5,7,11,16,23,31,33},{5,7,11,18,20,28,35},{5,8,10,16,23,30,34},{5,8,10,17,21,28,35}};

(* the actual 30 canonical sets of 7 Fano triples *)
fano30Triads=triple35Lst[[#]]&/@fano30Lst

(* this identifies values of sm used to generate the sign masks manually,
This is also linked to C8/D8 Fano plane index pairs that are members of the same set.
It is constructed in a left/right pattern of subtracting (or adding the reverse of) Range@3 from 8 *)
rightSM={1};
AppendTo[rightSM,rightSM[[#]]-#+4]&/@Range@3;
rightSM

leftSM=Complement[Range@8,rightSM]

(* manual creation of fano240 and inverse
base list - L/R reverse of 4 each *)
m1=(rightSM-1)8;
m2={1,-1,1,-1};

fanoMasks=Flatten[Join[Table[ToUpperCase@IntegerString[Flatten[Join[
{0+m2[[i]](#-i)+m1[[i]]+If[i==3&&#<3||i==2&&#>2,4,0]},
{7+m2[[i]](i-#)+m1[[i]]-If[i==3&&#<3||i==2&&#>2,4,0]}],1],16,2],{i,4}]],1]&/@Range@4;

(* base and base+/-8 *)
fanoMasks=Join[fanoMasks,Table[ToUpperCase@IntegerString[FromDigits[fanoMasks[[#,i]],16]+Flatten[8{1,1}#&/@{1,-1,-1,1}][[i]],16,2],{i,8}]&/@Range@4];
%//MatrixForm

maskList={5,8,4,3,7,6,3,2,6,5,1,4,6,7,3,3,8,6,3,1,6,6,2,3,5,8,4,3,7,6};

fano240=fanoMasks[[#]]&/@maskList

fanoInv=Table[ToUpperCase@IntegerString[(2^7)-1-FromDigits[#[[i]],16],16,2],{i,8}]&/@fano240

Indexing the Octonions

(* based on symmetries of E8 and extended Standard Model physics - see http://theoryofeverything.org *)

(* This is part of logic that corrects 240 of the Fano plane mnemonic node positions -
this also splits the 480 Fano permutations into 2 sets of 240 E8 aligned nodes 
**)
flipFano={
{{2,3},{1,3,6,4},{2,5}},
{{2,4},{8,11},{9,7,10,12}},
{{2,5},{14,16,17,18},{13,15}},
{{2,6},{22,24},{19,20,21,23}},
(* flipSwitch=28 being moved to third list to fix color coding and indexing *)
{{2,7},{25,27,30},{26,29,28}}};
flipSwitch=28;

(* these are fPi index pairs that split C8 and D8 groups in particle assignments - 
they always show up in flipped and non-flipped pairs that alternate flipFano #2 & #3 in sequence,
it also has rightSM==Union[maskList[[#]]&/@Flatten@c8Pairs] and 
leftSM==Union[maskList[[#]]&/@Flatten@d8Pairs] *)
d8Pairs={{1,2},{4,7},{8,10},{15,16},{17,19},{23,24},{25,26}(**),{28}(**)};
c8Pairs={{3,5},{6,9},{11,12},{13,14},{18,20},{21,22},{27,29},{(*)28,**)30}};

fpC8=Flatten@flipFano[[All,2]]

fpD8=Flatten@flipFano[[All,3]]

pairClr@fPi_:=If[MemberQ[Flatten@c8Pairs,fPi],Blue,Red];

(* get and flatten the triads and fix (flip indices) if needed *)
smCnv@altMask_:=If[altMask,leftSM,rightSM];
hexMask[invMask_,altMask_,fPi_,sm_]:=If[invMask,fanoInv,fano240][[fPi,smCnv[altMask][[sm]]]];
binMask[invMask_,altMask_,fPi_,sm_]:=Reverse[IntegerDigits[FromDigits[hexMask[invMask,altMask,fPi,sm],16],2,7]];

(* display triads and flattened/fixed triad list from particle index p *)
pTriad[p_,flip_]:=(
invMask=If[aB@p==1,True,False];
altMask=If[pB@p==1,True,False];
sm=1+(2^1)s1B@p+s0B@p;
fpC=(2^1)c1B@p+c0B@p;
fpG=(2^1)g1B@p+g0B@p;
(* gives D8 on Fano aligned nodes, C8 when False *)
d8Q:=invMask!=altMask;
doD8:=flip&&d8Q||!flip&&!d8Q;
(* defines the 32=512-480 excluded Fano permutations logic, synonomous with E8 excluded *)
excFanoQ:=fpC==0&&fpG==0;
(* fPi=Fano plane index to fano30Lst *)
fPi=If[doD8,fpD8,fpC8][[If[excFanoQ,1,0]+(2^2)fB[fpC,2]+(2^2)fB[fpC,1]+fB[fpG,2]+fB[fpG,1]]];
{invMask,altMask,fPi,sm,fpC,fpG});

(* set up for finding the octonions for the pBit #1 (of 256) with "flip" bit True *)
pTriad[1,True]

(* get the triads *)
getTriads[invMask_,altMask_,fPi_,sm_]:=Module[{c,d,e},
flatFanoStyled=flatFano=Join[Drop[Drop[Take[Flatten[triads=(c=fano30Triads[[fPi,#]];
If[binMask[invMask,altMask,fPi,sm][[#]]==1,c[[2;;]]=RotateRight@Rest@c];c)&/@Range@7],9],{7}],{4}],{8}];
(* need to fix 240 (of 480) unaligned node positions from flatFano logic for proper Fano plane alignment *)
(* also correct for 30 being moved to third list to fix color coding *)
If[MemberQ[#[[If[fPi==flipSwitch,3,2]]],fPi]&&invMask==altMask||MemberQ[#[[If[fPi==flipSwitch,2,3]]],fPi]&&invMask!=altMask,
d=position[flatFano,#[[1,1]]];e=position[flatFano,#[[1,2]]];
flatFanoStyled[[d]]=Style[#[[1,2]],pairClr@fPi,Bold];flatFanoStyled[[e]]=Style[#[[1,1]],pairClr@fPi,Bold];
flatFano[[d]]=#[[1,2]];flatFano[[e]]=#[[1,1]]]&/@flipFano;
(* need to change circular arrow direction on flip in first triad - 
now with latest flipFano, all flips are in the first triad *)
firstFlipSign=If[First@triads==flatFano[[;;3]],-1,1];
{triads,flatFanoStyled,flatFano,firstFlipSign}];

getTriads[invMask,altMask,fPi,sm]

The multiplication tables

(* basis for generating the 8x8 fano multiplication tables *)
fanoMult[triads_,sign_]:=(
(* init Fano multiplication and sign tables *)
fMult=Array[8&,{8,8}];
fSign=1-2IdentityMatrix@8;
(fMult[[8,#]]=fMult[[#,8]]=#;
fSign[[8,#]]=fSign[[#,8]]=1)&/@Range@8;
(* generate {fMult,fSign} *)
Do[sgn=If[BitAnd[sign,(2^(i-1))]≠0,1,-1];
fMult[[triads[[i,1+Mod[j-1,3]]],triads[[i,1+Mod[j+0,3]]]]]=triads[[i,1+Mod[j+1,3]]];
fSign[[triads[[i,1+Mod[j-1,3]]],triads[[i,1+Mod[j+0,3]]]]]=sgn;
fMult[[triads[[i,1+Mod[j+0,3]]],triads[[i,1+Mod[j-1,3]]]]]=triads[[i,1+Mod[j+1,3]]];
fSign[[triads[[i,1+Mod[j+0,3]]],triads[[i,1+Mod[j-1,3]]]]]=-sgn,{i,7},{j,3}];{fMult,fSign});

(* normal and styled 0 based 7D cross product Octonion mulitplication tables - depending on input *)
fM[triads_,sign_]:=(fanoMult[triads,sign];
(* get the matrix and fix diagonals *)
fm=Table[If[i==j,If[i==8,1,-1],fSign[[i,j]] fMult[[i,j]]],{i,8},{j,8}];
(* move 8th row/column to 1st (or 0th) *)
fm=Transpose@Join[{RotateRight@fm[[8]]},Table[RotateRight@fm[[i]],{i,7}]]);

fM@triads_:=fM[triads,0];

(* multiplication matrix *)
fM@triads//MatrixForm

(* quaternion and octonian multiplication (Subscript[ℯ, n])∘(Subscript[ℯ, n]) *)
(* from http://demonstrations.wolfram.com/OctonionsAndTheFanoPlaneMnemonic *)
SmallCircle[(Subscript[ℯ, 0]),(Subscript[ℯ, 0])]:=1;
SmallCircle[a_,(Subscript[ℯ, 0])]:=a;
SmallCircle[(Subscript[ℯ, 0]),b_]:=b;

SmallCircle[(Subscript[ℯ, i_Integer]),(Subscript[ℯ, i_Integer])]:=-1;

SmallCircle[a_?NumericQ,b_?NumericQ]:=a b;
SmallCircle[a_?NumericQ,(Subscript[ℯ, b_])]:=a (Subscript[ℯ, b]);
SmallCircle[(Subscript[ℯ, a_]),b_?NumericQ]:=b (Subscript[ℯ, a]);
SmallCircle[(a_?NumericQ b_),c_]:=a b∘c;
SmallCircle[a_,(b_?NumericQ c_)]:=b a∘c;

SmallCircle[a_List,b_]:=SmallCircle[#,b]&/@a;
SmallCircle[a_,b_List]:=SmallCircle[a,#]&/@b;

(ep:SmallCircle[a_Plus,b_]):=Block[{SmallCircle},Distribute@ep];
(ep:SmallCircle[a_,b_Plus]):=Block[{SmallCircle},Distribute@ep];

SmallCircle[a_Times, (Subscript[ℯ, b_])] := Select[a,NumericQ] SmallCircle[Select[a,!NumericQ@#&],(Subscript[ℯ, b])];
SmallCircle[(Subscript[ℯ, a_]), b_Times] := Select[b,NumericQ] SmallCircle[(Subscript[ℯ, a]),Select[b,!NumericQ@#&]];

(* This is the multiplication table definition *)
SmallCircle[(Subscript[ℯ, i_Integer]),(Subscript[ℯ, j_Integer])]/; i!=j:=Sign@fm[[1+Mod[i,8],1+Mod[j,8]]] (Subscript[ℯ, Abs@fm[[1+Mod[i,8],1+Mod[j,8]]]]);

associator[(Subscript[ℯ, a_]),(Subscript[ℯ, b_]),(Subscript[ℯ, c_])]:=Expand[SmallCircle[SmallCircle[(Subscript[ℯ, a]),(Subscript[ℯ, b])],(Subscript[ℯ, c])]-SmallCircle[(Subscript[ℯ, a]),SmallCircle[(Subscript[ℯ, b]),(Subscript[ℯ, c])]]];
associator[a_Integer,b_Integer,c_Integer]:=associator[(Subscript[ℯ, a]),(Subscript[ℯ, b]),(Subscript[ℯ, c])];

octonion@p_:=Total[p Join[{1},octImag]];

commutator[x_,y_]:=Simplify@Chop[x∘y-y∘x];
derivation[x_, y_][a_]:= commutator[commutator[x,y], a] - 3 ((x∘y)∘a - x∘(y∘a));
derMatrix[x_, y_] := Table[Coefficient[derivation[x, y][octImag[[i]]],octImag[[j]]], {j,1,7}, {i,  1, 7}];
derVector[x_, y_] := derMatrix[x, y]//Flatten;

octconjugate@p_:=Total[p Join[{1},-octImag]];
octConjugatePattern:(SuperStar[p_]):=octconjugate@p;

octRe@p_:=Simplify@Chop@((octonion@p+(SuperStar[p]))/2);
octIm@p_:=Simplify@Chop@((octonion@p-(SuperStar[p]))/2);

octAbs@p_:= Total@{octonion@p∘(SuperStar[p])};
octNorm@p_:= (Sqrt[octAbs@p]);
octDiv@p_:=Simplify@((SuperStar[p])/(octAbs@p));

(* perform octonion math on quantum bit 1-256 indexes (related to E8 and SM *)
setFM[p_,flip_]:=fM@First[getTriads@@({invMask,altMask,fPi,sm,fpC,fpG}=pTriad[p,flip])[[;;4]]];
CircleDot[a_,b_]:=(setFM[a,True];
SmallCircle[octonion@IntegerDigits[a,2,8],octonion@IntegerDigits[b,2,8]]);

oct={(Subscript[ℯ, 1]),(Subscript[ℯ, 2]),(Subscript[ℯ, 3]),(Subscript[ℯ, 4]),(Subscript[ℯ, 5]),(Subscript[ℯ, 6]),(Subscript[ℯ, 7]),(Subscript[ℯ, 0])};
pmOct=Join[-oct,oct,{-1,0,1}];

(* option to use Mathematica IJK quaternion style for octonions *)
octIJKL:={I,𝕛,𝕜,𝕝,I 𝕝,𝕛 𝕝,𝕜 𝕝,(Subscript[ℯ, 0])};
pmOctIJKL:=Join[-octIJKL,octIJKL,{-1,0,1}];

(* option to use Mathematica IJK quaternion style for octonions *)
IJKLstyle=(*)True**)False(**);
chkOctStyle:=If[IJKLstyle,𝕛=.;J=.;(**)𝕜=.;K=.;(*)𝕜=K=I J;**)𝕝=.;L=.,𝕛=J=(Subscript[ℯ, 2]);𝕜=K=(Subscript[ℯ, 3]);𝕝=(*L=*)(Subscript[ℯ, 4]);];
chkOctStyle;

octImag:=Most@If[IJKLstyle,octIJKL,oct];

octPM:=If[IJKLstyle,pmOctIJKL,pmOct];
pmChk@p_:=If[MemberQ[pmOct,p],pmOct,pmOctIJKL];
posChk@p_:=position[pmChk@p,p];
fanoChk@p_:=octPM[[posChk@p]];

(* display the multiplication tables *)
fmTable@f_:=Table[Style[ReleaseHold@f,If[i==1||j==1||i==j,Red,Black]],{i,8},{j,8}];
fmDispN:=MatrixForm@ReplacePart[fmTable@Hold[fm[[i,j]]],{1,1}->"0↦1"];
fmDispℯ:=MatrixForm@fmTable@Hold[fanoChk[(Subscript[ℯ, i-1])∘(Subscript[ℯ, j-1])]];

fmDispN

fmDispℯ

Testing Octonion math

Linking Quaternions to Octonions

cayleyDicksonOct=True;

𝕛=.;J=.;(**)𝕜=.;K=.;

(* include CircleDot *)
octIJKL:={I,J,K,L,I∘L,J∘L,K∘L,(Subscript[ℯ, 0])};
(* include K as unique **)
chkOctStyle:=If[IJKLstyle,𝕛=.;J=.;(**)𝕜=.;K=.;(*)𝕜=K=I J;**)𝕝=.;L=.,J=(Subscript[ℯ, 2]);K=(Subscript[ℯ, 3]);L=(Subscript[ℯ, 4]);];

(* Takes a input of 1 or 2 quaternions (as a list or individually) or a list of 4 or 8 
and turns them into computable symbolic octonions 
this only works Fano multiplication fPi=1, sm=3(or 7?), invMask=False - otherwise it defers to the (lowercase) octonion functions *)
Octonion@in_:=If[QuaternionQ@in,
If[Length@J==0||Length@#<3,#,Re@#[[1]]+Im@#[[1]]∘(Subscript[ℯ, 1])+#[[2;;]]](**)∘(**)L&@FromQuaternion@in,
If[ListQ@in,
If[Length@in==2&&QuaternionQ@First@in&&QuaternionQ@Last@in,
If[Length@J==0||Length@#<3,#,Re@#[[1]]+Im@#[[1]]∘(Subscript[ℯ, 1])+#[[2;;]]]&@FromQuaternion@First@in+Octonion@Last@in,
If[Length@in==4,Octonion@Quaternion[##]&@@in,
If[Length@in==8,If[cayleyDicksonOct,Octonion[{Quaternion@@in[[;;4]],Quaternion@@in[[5;;]]}],
octonion@in]]]]]];

Define the tests

testCayley[p_,flip_]:=Column[{fM@First[getTriads@@pTriad[p,flip][[;;4]]];triads,
fmDispℯ,octRe@Array[3&,8]==3&&FullSimplify[Array[1&,8]∘Array[2&,8]==If[IJKLstyle,
4((-3+I)+J+K+(1+I)∘L+J∘L+K∘L),
4(-3+(Subscript[ℯ, 1])+(Subscript[ℯ, 2])+(Subscript[ℯ, 3])+(Subscript[ℯ, 4])+(Subscript[ℯ, 5])+(Subscript[ℯ, 6])+(Subscript[ℯ, 7]))]]}];

chkOctStyle
octImag:=Most@If[IJKLstyle,octIJKL,oct];
octImag

Octonion[in1_,in2_]:=Octonion[{in1,in2}];

octConjugate[in1_,in2_]:=Octonion[Conjugate@in1,-in2]

octConjugate[Quaternion[1,1,1,1],Quaternion[2,2,2,2]]

octConjugate@in_List:=octConjugate[Quaternion@@in[[;;4]],Quaternion@@in[[5;;]]]

octConjugate@Range@8

octConjugatePattern:(SuperStar[in_]):=If[Length@in==2&&QuaternionQ@First@in&&QuaternionQ@Last@in,octConjugate[First@in,Last@in],
If[Length@in==8,
If[cayleyDicksonOct,octConjugate@in,octconjugate@in],
Conjugate@in]]

octAbs@p_:= Total@{Octonion@p∘(SuperStar[p])};

octRe@p_:=Simplify@((Octonion@p+(SuperStar[p]))/2)

octIm@p_:=Simplify@((Octonion@p-(SuperStar[p]))/2)

FromQuaternion@Quaternion[1,1,1,1]

FromQuaternion[Quaternion[1,1,1,1]\[Conjugate]]

Octonion[Conjugate@Quaternion[1,1,1,1],-Quaternion[1,1,1,1]]

SmallCircle[in1_List,in2_List]:=If[cayleyDicksonOct,
Module[{a,b,c,d},
a=Quaternion@@in1[[;;4]];b=Quaternion@@in1[[5;;]];
c=Quaternion@@in2[[;;4]];d=Quaternion@@in2[[5;;]];
Octonion[a**c-(SuperStar[d])**b,d**a+b**(SuperStar[c])]],
octonion@in1∘octonion@in2];

The tests

#69 (not “flipped”) octonion indexes to E8 # 81 and is a valid Cayley-Dickson Octonion based on Mathematica defined Quaternions

IJKLstyle=True;chkOctStyle
cayleyDicksonOct=False;
testCayley[69,False]

IJKLstyle=True;chkOctStyle
cayleyDicksonOct=True;
testCayley[69,False]

IJKLstyle=False;chkOctStyle
cayleyDicksonOct=False;
testCayley[69,False]

IJKLstyle=False;chkOctStyle
cayleyDicksonOct=True;
testCayley[69,False]

some general octonion math dependant on the above multiplication table

Array[1&,8]∘Array[2&,8]

octonion@Array[1&,8]∘octonion@Array[2&,8]//FullSimplify

Octonion@Array[1&,8]∘ Octonion@Array[2&,8]//FullSimplify

(SuperStar[Array[1&,8]])

octNorm@Array[1&,8]∘octNorm@Array[2&,8]

octRe@Array[3&,8]

octIm@Array[3&,8]

#73 (“flipped”) octonion indexes to E8 # 216 and is not a valid Cayley-Dickson Octonion based on Mathematica defined Quaternions

IJKLstyle=True;chkOctStyle
cayleyDicksonOct=False;
testCayley[73,True]

IJKLstyle=True;chkOctStyle
cayleyDicksonOct=True;
testCayley[73,True]

IJKLstyle=False;chkOctStyle
cayleyDicksonOct=False;
testCayley[73,True]

IJKLstyle=False;chkOctStyle
cayleyDicksonOct=True;
testCayley[73,True]

some general octonion math ependant on the above multiplication table

Array[1&,8]∘Array[2&,8]

octonion@Array[1&,8]∘octonion@Array[2&,8]//FullSimplify

Octonion@Array[1&,8]∘ Octonion@Array[2&,8]//FullSimplify

(SuperStar[Array[1&,8]])

octNorm@Array[1&,8]∘octNorm@Array[2&,8]

octRe@Array[3&,8]

octIm@Array[3&,8]