Theoretical background and applications of the files described
below can be found in:

"A UNIPODAL ALGEBRA PACKAGE FOR MATHEMATICA"
Universidad de las Americas
72820 Cholula, Pue. MEXICO
email: sobczyk@udlapvms.pue.udlap.mx

in

Title: ``Clifford Algebras with Numeric and Symbolic Computations''
Editors: Rafal Ablamowicz, Pertti Lounesto, Josep M. Parra
ISBN: 0-8176-3907-1
PUBLISHER: Birkhauser, Boston
YEAR: 1996

The enclosed packages are designed to work with Mathematica.

(*  Power Series Method for Evaluating Structure Equation  *)
(*  A Mathematica Package  *)

(* Calculates p[i]=pqseries[m,i,0] and q[i]^k=pqseries[m,i,k]
   using power series for i=1,2, ... , Length[m]  *)

psi[m_List]:=Product[(a - x[j])^(m[[j]]),{j,Length[m]}]

psi[m_List,i_]:=psi[m]/((a-x[i])^(m[[i]]))

pqseries[m_,i_,k_]:=
Together[Normal[Series[1/psi[m,i],{a,x[i],m[[i]]-(1+k)}]]]*(a-x[i])^k * psi[m,i]

(* Calculates p[i] and q[i] for i=1,2, ... , Length[m]  *)

pqseries[m_List]:=Do[p[i]=pqseries[m,i,0];q[i]=pqseries[m,i,1];Print[i], {i,Length[m]}]

(* Geometric Algebra G[1,C] with basis {1,u} over C *)

Off[General::spell1]
Off[General::spell]
Unprotect[Power,Times]

u*u=1

u^(n_):=If[Mod[n,2]==0,1,u,HoldForm[u^n]]

Protect[Power,Times]

(*  *)

(* Special operations *)

dtb[a_]:=Distribute[a]
cll[a_]:=Collect[a,u]
epd[a_]:=Expand[a]
sim[a_]:=Simplify[a]
rat[a_]:=Rationalize[a]

(* Sample function and geometric numbers *)

a=a0+a1 u
b=b0+b1 u
c=c0+c1 u
d=d0+d1 u
x=x0+x1 u

(* Geometric variables *)

w = w0 + w1 u
w$ = w0 - w1 u ;

(* Vector derivatives *)

dd[w_] := cll[epd[D[w, w0] ]]
dir[w_,a_]:= cll[epd[csp[a] D[w, w0] + csp[a u] D[w,w1]]]

(* Elementary Geometric Functions *)

cvp[a_]:= a - csp[a] 
csp[a_]:= epd[a] /. u -> 0
rvs[a_]:=2 csp[a]-a

con[a_ + b_]:= con[a]+con[b]
con[a_ b_]:=con[a] con[b]
con[a_]:=Conjugate[a] /; NumberQ[a]
con[a_]:=a /; !NumberQ[a]

re[a_]:=cll[1/2(a+con[a])]
im[a_]:=cll[I/2(con[a]-a)]

vp[a_]:=1/2(cll[cvp[a]+con[cvp[a]]])
bp[a_]:=1/2(cll[cvp[a]-con[cvp[a]]])
sp[a_]:=1/2(cll[csp[a]+con[csp[a]]])
tp[a_]:=1/2(cll[csp[a]-con[csp[a]]]);

sti[a_,b_]:= csp[a rvs[b]]
sti[a_]:=sti[a,a]
csmag[a_]:= Sqrt[sti[a,a]]
csmag[a_,b_]:=Sqrt[sti[a,b]]
mag[a_]:=Sqrt[csp[a con[a]]]

(*     *)

up=1/2 (1+u)
un=1/2 (1-u)
upp[x_]:=csp[x]+D[x,u]
unn[x_]:=csp[x]-D[x,u]

exp[a_]:=cll[Exp[upp[a]] up+Exp[unn[a]] un]
sinh[a_]:=cll[Sinh[upp[a]] up+Sinh[unn[a]] un]
cosh[a_]:=cll[Cosh[upp[a]] up+Cosh[unn[a]] un]
log[a_]:=cll[Log[upp[a]] up+Log[unn[a]] un]

root[a_,n_,i_,j_]:=cll[epd[exp[log[a]/n] exp[2 Pi I (i+j u)/n]]]
root[a_,n_,i_]:=root[a,n,i,0]
root[a_,n_]:=root[a,n,0,0]
root[a_]:=root[a,2,0,0]

power[w_,a_]:=cll[epd[exp[cll[a log[w]]]]];

(* SOLUTIONS OF CUBIC EQUATION   June 1995 *)
			
(* Solution of Cubic Equation: x0^3 + p2 x0^2 + p1 x0 + p0 = 0 *)
(* Equivalent to (x-a0)^3=b where x=x0+b1 u, b=b0+b1 u   *)

a0:= -p2/3
b0:= (-108*p0 + 36*p1*p2 - 8*p2^3)/27

b1:=4*( p0^2+(4*p1^3)/27-(2*p0*p1*p2)/3- (p1^2*p2^2)/27+(4*p0*p2^3)/27 )^(1/2)

r:= 1/9 (4 p2^2-12 p1)

f[x_] := x^3 + p2*x^2 + p1*x + p0

x0[k_]:=1/2 N[2 a0+(root[b0+b1,3,k]+r/root[b0+b1,3,k])]

rootf[j_,k_] := csp[a0 + sim[rat[N[root[b0 + b1*u, 3,j, k]]]]]

f[k1_,k2_]:=Chop[f[x0[k1,k2]]]

roots:={x0[0],x0[1],x0[2]}

