Zeon Inverses & Roots

G. Stacey Staples 
2016

Use CircleMinus for commutative null-square product  (over ((Subscript[Cl, n])^nil))    
 x⊖y is entered by typing x[ESC]c-[ESC]y

Quit[] (* Quit the kernel and start from scratch *)

<<CliffMath2014a`
<<CliffSymNil2014a`

Code

ZInverse[u_]:=Module[{a,b,β,inv},
a=GradeKPart[u,0];
b=u-a//ClExpand;
β=Expand[-(a^(-2))b];
inv=(a^(-1));
While[Grade[β]>0,
inv=inv+β;
β=ClNilExpand[(-(a^(-1))b)⊖β];
];
Return[inv];
];

MaxGenerator[u_+v_]:=Max[{MaxGenerator[u],MaxGenerator[v]}];
MaxGenerator[(Subscript[e, a_])]:=Max[a];
MaxGenerator[x_]:=0/;(FreeQ[x,(Subscript[e, _])]);
MaxGenerator[x_ (Subscript[e, a_])]:=Max[a]/;(FreeQ[x,(Subscript[e, _])]);

(*Need code to extract terms with indices containing MaxGenerator...*)
ZExtract[x_ (Subscript[e, a_]),n_]:=Expand[x ZExtract[(Subscript[e, a]),n]]/;(FreeQ[x,(Subscript[e, _])]);ZExtract[(Subscript[e, a_]),n_]:=If[Length[Intersection[a,{n}]]==1,If[Length[a]>1,(Subscript[e, Complement[a,{n}]]),1],0];
ZExtract[u_+v_,n_]:=ZExtract[u,n]+ZExtract[v,n];
ZExtract[x_,n_]:=0/;(FreeQ[x,(Subscript[e, _])]);

ZDecomp[u_]:=Module[{ψ,ω,n},
n=MaxGenerator[u];
ψ=ZExtract[u,n];
ω=u-ClNilExpand[(Subscript[e, {n}])⊖ψ];
Return[{ω,ψ}]];


ZSqRoot[u_]:=If[MaxGenerator[u]==0,(u^(1/2)),ClNilExpand[ZSqRoot[ZDecomp[u][[1]]]+ClNilExpand[(Subscript[e, {MaxGenerator[u]}])⊖Expand[(1/2)ZInverse[ZSqRoot[ZDecomp[u][[1]]]]]⊖ZDecomp[u][[2]]]]];

ZKthRoot[u_,k_]:=If[MaxGenerator[u]==0,(u^(1/k)),Expand[ClNilExpand[ZKthRoot[ZDecomp[u][[1]],k]]+ClNilExpand[(Subscript[e, {MaxGenerator[u]}])⊖Expand[(1/k)ClNilPower[ZInverse[ZKthRoot[ZDecomp[u][[1]],k]],k-1]]⊖ZDecomp[u][[2]]]]];

(* Alternative method 1 *)
KthRoot[u_,k_]:=Module[{j,ell,coeffs},
(Subscript[a, 0])=GradeKPart[u,0];
β=u-(Subscript[a, 0]);
Sum[(((Subscript[a, 0])^(-j+1/k))/(j!))Sum[Expand[((StirlingS1[j,ell])/(k^ell))ClNilExpand[ClNilPower[β,j]]],{ell,0,j}],{j,0,MaxIndex}]]

(* Summing products of coefficents over partitions of a fixed multi-index*)
partsum[β_,multi_,j_]:=Coefficient[Simplify[ClNilPower[β,j]/j!],(Subscript[e, multi])]

(* Compute the coefficient of (Subscript[ζ, I]) in the kth root of an invertible elemeny *)
KthRootZeonCoefficient[u_,multi_,k_]:=Module[{a, j, ell,β},
a=GradeKPart[u,0];
β=u-a;
Return[Sum[(a^(-j+1/k))Sum[((StirlingS1[j,ell])/(k^ell))partsum[β,multi,j],{ell,0,j}],{j,1,Length[multi]}]]];

Numerical Examples

SetSignature[5,0]

B=2-13(Subscript[e, {1,2,4,5}])

u=ZInverse[B]

ClNilExpand[u⊖B]

b2=13(Subscript[e, {1,2}])+(1/2)(Subscript[e, {4,5}]);
b3=13(Subscript[e, {1}])+(Subscript[e, {2}])+(1/6)(Subscript[e, {4,5}]);
b4=13(Subscript[e, {1}])+(Subscript[e, {2}])+(1/24)(Subscript[e, {4}])+(Subscript[e, {5}]);

ClNilPower[b2,2]

ClNilPower[b3,3]

ClNilPower[b4,4]

SetSignature[3,0]

X=Prepend[(ClBasis/.{e->a})[[2;;]],(Subscript[a, 0])].ClBasis

For[k=2,k≤12,k++,
(Subscript[Z, k])=Simplify[ZKthRoot[X,k]];
Print[k,"th root: ",(Subscript[Z, k])];]

(* Verify the roots *)
For[k=2,k≤12,k++,
Print[k,"th power of ",k,"th root: ",ClNilPower[(Subscript[Z, k]),k]];]

(* Compute & verify the inverse of X *)
Print[Y=ZInverse[X]];
ClNilExpand[X⊖Y]

(* Zeon square root *)
w=ZSqRoot[3-5(Subscript[e, {1}])]

w⊖w//ClNilExpand

Print["(v1^2) = ",v1⊖v1//ClNilExpand//NilOut];
Print["(v2^2) = ",v2⊖v2//ClNilExpand//NilOut];
Print["(v3^2) = ",v3⊖v3//ClNilExpand//NilOut];
Print["(v4^2) = ",v4⊖v4//ClNilExpand//NilOut];
Print["(v5^2) = ",v5⊖v5//ClNilExpand//NilOut];

SetSignature[5,0]

v1=Random[Integer,{-2,3} ]+Sum[Random[Integer,{-2,2} ](Subscript[e, {i}]),{i,1,5}];
v2=Random[Integer,{-2,3} ]+Sum[Random[Integer,{-2,2} ](Subscript[e, {i}]),{i,1,5}];
v3=Random[Integer,{-2,3} ]+Sum[Random[Integer,{-2,2} ](Subscript[e, {i}]),{i,1,5}];
v4=(((Random[Integer,{-3,3} ]))^2)+Expand[2Sum[Random[Integer,{-2,2} ]ClBasis[[i]],{i,2,32}]];
v5=Random[Integer,{-2,3} ]+Sum[Random[Integer,{-2,2} ]ClBasis[[i]],{i,1,32}];

Print["v1 = ",v1];
Print["v2 = ",v2];
Print["v3 = ",v3];
Print["v4 = ",v4];
Print["v5 = ",v5];

Print["(Subscript[z, 1]) = ",v1⊖v1//ClNilExpand//NilOut];
Print["(Subscript[z, 2]) = ",v2⊖v2//ClNilExpand//NilOut];
Print["(Subscript[z, 4]) = ",v4//NilOut];
Print["(Subscript[z, 5]) = ",v5⊖v5//ClNilExpand//NilOut];

(*Compute coefficient of (Subscript[e, {2,3,4}]) in the 7th root of (Subscript[v, 5])*)
Expand[KthRootZeonCoefficient[v5,{2,3,4},7]]

(* Compare *)
ZKthRoot[v5,7]

(* Regroup by basis blade *)
Collect[ZKthRoot[v5,7],(Subscript[e, _])]

Symbolic κth root formulas: n 1 to 5

κ=Symbol["κ"];
For[n=1,n≤5,n++,
SetSignature[n,0];
Print["n = ",n];
Print["α = ",(X=Prepend[(ClBasis/.{e->a})[[2;;]],(Subscript[a, 0])].ClBasis)//NilOut];
Print["Principal κth root: (α^(1/κ)) = ",Collect[Expand[KthRoot[X,κ]],(Subscript[e, _])]//NilOut];
Print["-------"];]

Numerical kth root formulas -- n: 1 to 4 and k:  2 to 10

For[n=1,n≤4,n++,
SetSignature[n,0];
Print["n = ",n];
Print["α = ",(X=Prepend[(ClBasis/.{e->a})[[2;;]],(Subscript[a, 0])].ClBasis)//NilOut];
Print["kth roots: "];
For[k=2,k≤10,k++,
Print["Principal ",k,"th root: (α^(1/k)) = ",Collect[Expand[KthRoot[X,k]],(Subscript[e, _])]//NilOut];
Print[""];]
Print["-------"];]

References

L. Dollar. Square and Kth Root Properties of Zeons, M.S. Thesis, Southern Illinois University Edwardsville, In progress, 2016.
L. Dollar, G.S. Staples. Zeon Roots, Preprint, 2016.