{VERSION 5 0 "IBM INTEL NT" "5.0" }
{USTYLETAB {CSTYLE "Maple Input" -1 0 "Courier" 0 1 255 0 0 1 0 1 0 0 
1 0 0 0 0 1 }{CSTYLE "" -1 256 "" 1 14 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }
{PSTYLE "Normal" -1 0 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 
2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "" 0 256 1 {CSTYLE "
" -1 -1 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }3 0 0 -1 -1 -1 0 0 0 0 0 
0 -1 0 }}
{SECT 0 {EXCHG {PARA 256 "" 0 "" {TEXT 256 102 "This is a new version \+
of GTP (Graded Tensor Product) to work with Cliff7 in Maple 7. Revised
 11-5-2002" }{TEXT -1 1 "\n" }{MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" 
{MPLTEXT 1 0 1092 "###################################################
##########################\n#                                         \+
                                  #\n#DISCLAIMER:                     \+
                                           #\n#                       \+
                                                    #\n#THERE IS NO WA
RRANTY FOR THE CLIFFORD, BIGEBRA, Cli<#>plus, Octonion, GTP  #\n#PACKA
GES TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE  \+
#\n#STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVI
DE THE   #\n#PROGRAM \"AS IS\" WITHOUT WARRANTY OF ANY KIND, EITHER EX
PRESSED OR IMPLIED, #\n#INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WAR
RANTIES OF MERCHANTABILITY   #\n#AND FITNESS FOR A PARTICULAR PURPOSE.
 THE ENTIRE RISK AS TO THE QUALITY    #\n#AND PERFORMANCE OF THE PROGR
AM IS WITH YOU. SHOULD THE PROGRAM PROVE       #\n#DEFECTIVE, YOU ASSU
ME THE COST OF ALL NECESSARY SERVICING, REPAIR OR       #\n#CORRECTION
.                                                                #\n##
######################################################################
#####\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 128 "restart:\n\nGTP:=module
()\nexport grade,gbasis,tensorrank,gradedprod,gprod,cmulB,gcollect;\nl
ocal setup;\noption package,load=setup;\n" }}{PARA 0 "> " 0 "" 
{MPLTEXT 1 0 3280 "setup:=proc() global ScalarTypes,GradedTypes,\n`&t`
,`type/gradedpolynom`,`type/gradedmonom`,`type/gradedeven`,`type/grade
dodd`;\noptions `Copyright 1995-2003 by Rafal Ablamowicz and Bertfried
 Fauser`; \n#define(`&t`,flat,zero=0, multilinear);\nScalarTypes:=\{ma
thfunc,function,numeric,rational,constant,indexed,complex\}:\nGradedTy
pes:=\{tensorprod,gradedmonom,gradedpolynom\}:\n######################
##############################\n###Global definitons:\n###############
#####################################\n`&t`:=proc(a1::\{`*`,`+`,tensor
prod,cliscalar,clibasmon,climon,clipolynom\},\n           a2::\{clisca
lar,clibasmon,climon,clipolynom\}) \nlocal co,a11,a22,p,i;\noptions `C
opyright 1995-2003 by Rafal Ablamowicz and Bertfried Fauser`;\n#######
##############################################################\nif nar
gs<2 then error \"at least two arguments are needed\" end if;\nif narg
s>2 then return `&t`(`&t`(args[1..2]),args[3..nargs]) end if;\nif type
(a1,`+`) then return map(`&t`,a1,a2)\n   elif type(a2,`+`) then return
 map2(`&t`,a1,a2) \nend if;\nif type(a1,`*`) and hastype(a1,tensorprod
) then \n                    a11:=select(type,a1,tensorprod):\n       \+
             co:=remove(type,a1,tensorprod):\n                    retu
rn co*(`&t`(a11,a2)) \nend if;\nif type(a1,`*`) and not hastype(a1,ten
sorprod) then                                           a11:=select(ty
pe,a1,clibasmon):\n                     co:=remove(type,a1,clibasmon):
\n                     return co*(`&t`(a11,a2))\nelif type(a2,`*`) and
 not hastype(a2,tensorprod) then                                      \+
                                a22:=select(type,a2,clibasmon): \n    \+
                   co:=remove(type,a2,clibasmon):\n                   \+
    return co*(`&t`(a1,a22))\nend if;\np:=args[1];\nfor i from 2 to na
rgs do p:='`&t`'(p,args[i]) end do;\nreturn p;\nend proc:\n###########
##############\n`type/gradedpolynom`:=proc(a::\{`*`,`+`,function,algeb
raic\})\noptions `Copyright 1995-2003 by Rafal Ablamowicz and Bertfrie
d Fauser`; \nif type(a,function) then return type(a,tensorprod) end if
;\nif type(a,`*`) then return member(true,map(type,\{op(a)\},tensorpro
d)) end if;\nif type(a,`+`) then return evalb(map(type,\{op(a)\},grade
dpolynom)=\{true\}) end if; \nreturn false;\nend proc:\n##############
########\n`type/gradedmonom`:=proc(a::\{`*`,function,algebraic\})\nopt
ions `Copyright 1995-2003 by Rafal Ablamowicz and Bertfried Fauser`; \+
\nif type(a,function) then return type(a,tensorprod) end if;\nif type(
a,`*`) then return member(true,map(type,\{op(a)\},tensorprod)) end if;
\nreturn false;\nend proc:\n#####################\n`type/gradedeven`:=
proc(a1::\{tensorprod,gradedmonom,gradedpolynom\}) \noptions `Copyrigh
t 1995-2003 by Rafal Ablamowicz and Bertfried Fauser`; \nif type(a1,te
nsorprod) or type(a1,gradedmonom) then\n   if grade(a1)=0 then return \+
true else return false fi end if;\nif map(grade,\{op(a1)\})=\{0\} then
 return true else return false end if;\nend proc:\n###################
#\n`type/gradedodd`:=proc(a1::\{tensorprod,gradedmonom,gradedpolynom\}
) \noptions `Copyright 1995-2003 by Rafal Ablamowicz and Bertfried Fau
ser`; \nif type(a1,tensorprod) or type(a1,gradedmonom) then\n   if gra
de(a1)=1 then return true else return false end if \nend if;\nif map(g
rade,\{op(a1)\})=\{1\} then return true else return false end if;\nend
 proc:\n####################\nend proc:\n" }}{PARA 0 "> " 0 "" 
{MPLTEXT 1 0 560 "grade:=proc(a1::\{cliscalar,clibasmon,climon,tensorp
rod,gradedmonom\}) local g,i,S,r;\noptions `Copyright 1995-2003 by Raf
al Ablamowicz and Bertfried Fauser`; \ng:=proc(a) if type(a,evenelemen
t) then 0 else 1 end if end proc:\nif type(a1,tensorprod) then \n   S:
=[op(a1)]:r:=tensorrank(a1);\n   if r>2 then for i from 1 to r-2 do S:
=map(op,S) end do end if;\n   return add(g(i),i=S) mod 2; \nelif type(
a1,gradedmonom) then return grade(op(select(type,\{op(a1)\},tensorprod
)))\nelif type(a1,\{cliscalar,clibasmon,climon\}) then return g(a1) \n
else return 0 \nend if;\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 
0 536 "gbasis:=proc() local T,res,pair;\noptions `Copyright 1995-2003 \+
by Rafal Ablamowicz and Bertfried Fauser`; \nif not type([args],list(l
ist(\{tensorprod,clibasmon\}))) or nargs<2 then \n   error \"at least \+
two lists with elements of type 'clibasmon' or 'tensorprod' are needed
 as input\" \nend if;\nif nargs>2 then return gbasis(gbasis(args[1],ar
gs[2]),args[3..nargs]) end if;\nT:=combinat[cartprod]([args[1..2]]):\n
res:=[]:\nwhile not T[finished] do\n      pair:=T[nextvalue](): \n    \+
  res:=[op(res),pair[1] &t pair[2]] \nend do:\nreturn res;\nend proc:
\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 530 "tensorrank:=proc(a::algebrai
c) local flag,i,L,S1,S2,a1,r1,S;\noptions `Copyright 1995-2003 by Rafa
l Ablamowicz and Bertfried Fauser`; \na1:=expand(a):\nif type(a1,tenso
rprod) then L:=[op(a1)]:\n   while hastype(L,tensorprod) do L:=map(op,
L) end do;\n   return nops(L)\nend if;\nif type(a1,gradedmonom) then r
eturn procname(select(type,a1,tensorprod)) end if;\nS:=map(procname,\{
op(a1)\});\nif nops(S)=0 then error \"wrong input\" end if;\nif nops(S
)<>1 then \n   error \"tensors of mixed ranks are found in %1\",a \nen
d if;\nreturn op(S);\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 
1886 "gradedprod:=proc() local K,r1,r2,res,gbilinear;\noptions `Copyri
ght 1995-2003 by Rafal Ablamowicz and Bertfried Fauser`; \nif not type
(map(expand,[args[1..2]]),list(\{tensorprod,gradedmonom,gradedpolynom
\})) then\n   error \"first two arguments must be of type 'tensorprod'
, 'gradedmonom', or 'gradedpolynom'\" \nend if;\nif nargs>2 and not ty
pe(map(evalm,[args[3..nargs]]),list(diagmatrix)) \nthen \nerror \"opti
onal arguments must be r square diagonal matrices where r is the rank \+
of tensors in arguments 1 and 2, but instead received at least one non
-diagonal matrix among %0\",args[3..nargs] \nend if;\nprintlevel:=3:\n
r1:=tensorrank(expand(args[1])):r2:=tensorrank(expand(args[2])):\nif r
1=false or r2=false then \n   error \"homogeneous tensors in each argu
ment must be of equal rank\"\nend if;\nif r1<>r2 then \n   error \"ran
ks of tensors are not equal\"\nend if;\nif nargs>2 and not evalb(nargs
-2=r1) then \n   error \"optional arguments, when used, must be %1 squ
are diagonal matrices since %2 is the rank of tensors in arguments 1 a
nd 2\",r1,r1\nend if;\n####defining gbilinear####\ngbilinear:=proc(a1:
:algebraic,a2::algebraic) \n           local S,S1,S2,a11,a22,s,i,L,T,r
es,pair,L1,L2,terms,flag;\na11:=expand(a1):a22:=expand(a2):\nif type(a
11,gradedmonom) then L1:=[a11] else L1:=[op(a11)] end if:\nif type(a22
,gradedmonom) then L2:=[a22] else L2:=[op(a22)] end if:\nS:=\{op(L1),o
p(L2)\};\nT:=combinat[cartprod]([L1,L2]):\nres:=0:terms:=[]:\nif nargs
>2 then flag:=true else flag:=false end if:\nif flag then\n   while no
t T[finished] do\n   pair:=T[nextvalue]():\n   terms:=[op(terms),gprod
(pair[1],pair[2],args[3..nargs])]; \n   res:=res+gprod(pair[1],pair[2]
,args[3..nargs]) \nend do:\nelse\nwhile not T[finished] do\n   pair:=T
[nextvalue]():\n   terms:=[op(terms),gprod(pair[1],pair[2])]; \n   res
:=res+gprod(pair[1],pair[2]) \nend do:\nend if:\nreturn res\nend proc:
\n####end of definition####\nreturn gbilinear(args) \nend proc:\n" }}
{PARA 0 "> " 0 "" {MPLTEXT 1 0 2967 "gprod:=proc(p1::\{tensorprod,grad
edmonom\},p2::\{tensorprod,gradedmonom\}) \nlocal co,le1,le2,trank,m1,
mm1,s1,m2,mm2,s2,f,a,b,i,ab,k,fac,BB,flag;global B;\noptions `Copyrigh
t 1995-2003 by Rafal Ablamowicz and Bertfried Fauser`; \nif nargs=1 th
en \n   error \"two arguments are needed of type 'tensorprod' or 'grad
edmonom' but received only one argument\"\nend if;\nif nargs=2 and not
 assigned(B) then\n   error \"can't handle purely symbolic case: B mus
t be assigned a diagonal matrix or optional parameters must be used\"
\nend if;\nif nargs=2 and assigned(B) and not type(B,diagmatrix) then
\n   error \"when assigned, B must be a diagonal matrix\"\nend if;\nif
 nargs>2 and not type(map(evalm,[args[3..nargs]]),list(matrix)) \nthen
 \n   error \"optional arguments, when used, must be r diagonal matric
es where r is the rank of tensors in arguments 1 and 2, but instead re
ceived %0\",args[3..nargs] \nend if;\nif nargs>2 and not type(map(eval
m,[args[3..nargs]]),list(diagmatrix)) \nthen \n   error \"optional arg
uments, when used, must be r diagonal matrices where r is the rank of \+
tensors in arguments 1 and 2, but instead received at least one non-di
agonal matrix matrices among %0\", args[3..nargs] end if;\nif nargs>2 \+
then BB:=[seq(evalm(args[i]),i=3..nargs)] end if;\nco:=1:\nif type(p1,
`*`) then \n   co:=co*remove(type,p1,tensorprod);\n   m1:=select(type,
p1,tensorprod);\nelse m1:=p1 end \nif;\nif type(p2,`*`) then \n   co:=
co*remove(type,p2,tensorprod);\n   m2:=select(type,p2,tensorprod);\nel
se m2:=p2 \nend if;\nmm1:=[]:s1:=m1:mm2:=[]:s2:=m2:\nwhile type(s1,fun
ction) do mm1:=[op(2,s1),op(mm1)];s1:=op(1,s1); end do;\nmm1:=[s1,op(m
m1)];\nwhile type(s2,function) do mm2:=[op(2,s2),op(mm2)];s2:=op(1,s2)
; end do;\nmm2:=[s2,op(mm2)];\nm1:=map(Clifford:-displayid,[op(mm1)]):
m2:=map(Clifford:-displayid,[op(mm2)]):\n#return (m1,m2);\nle1:=nops([
op(m1)]);le2:=nops([op(m2)]);\nif le1 <> le2 then \n   error \"inputs \+
must be homogeneous tensors of equal rank\"\nend if;\ntrank:=le1:\nif \+
nargs>2 then\n   if trank<>nops(BB) then\nerror \"optional arguments m
ust be %1 diagonal matrices\",trank \nend if;\n   flag:=false:\n   for
 i from 1 to trank while not flag do\n    if linalg[coldim](BB[i])<>li
nalg[rowdim](BB[i]) then\n       flag:=true:\n       error \"one of th
e optional matrices entered is not square\" \n    end if; \n    end do
;\nend if;\na:=array(1..trank,[]):b:=array(1..trank,[]):ab:=array(1..t
rank,[]):\nfor i from 1 to trank do \n      a[i]:=op(i,m1):b[i]:=op(i,
m2):\n      if nargs>2 then ab[i]:=simplify(GTP:-cmulB(a[i],b[i],BB[i]
))\n                 else ab[i]:=simplify(Clifford:-cmul(a[i],b[i])) \+
\n      end if;\n      if type(ab[i],`*`) then \n         co:=co*remov
e(type,ab[i],clibasmon);\n         ab[i]:=select(type,ab[i],clibasmon)
 \n      end if;\nend do;\nf:=array(1..(trank-1),[]):\nfor i from 1 to
 trank-1 do\nif i=1 then f[1]:=(-1)^(grade(a[2])*grade(b[1]))\n   else
 f[i]:=(-1)^(grade(a[i+1])*grade(&t(seq(b[k],k=1..i)))) \nend if:\nend
 do;\nfac:=mul(f[i],i=1..(trank-1)):\nreturn fac*co*(&t(seq(ab[i],i=1.
.trank)))\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 370 "cmulB:=p
roc(x,y,B1::matrix) local xy,Bloc,s;global B;\noptions `Copyright 1995
-2003 by Rafal Ablamowicz and Bertfried Fauser`;\nif assigned(B) then \+
Bloc:=convert(B,mlist);s:=sqrt(nops(Bloc)) \n               else Bloc:
=[] \nend if;\nB:=evalm(B1):\nxy:=x &c y;\nif nops(Bloc)>0 then B:=eva
lm(linalg[matrix](s,s,Bloc)) else B:='B' end if;\nreturn Clifford:-reo
rder(xy);\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 769 "gcollect
:=proc(S::\{tensorprod,gradedmonom,gradedpolynom\},\n               s:
:\{symbol,string\}) \n               local L,gindets,x,r;\noptions `Co
pyright 1995-2003 by Rafal Ablamowicz and Bertfried Fauser`;\nif type(
S,tensorprod) then return S end if;\nL:=select(hastype,\{op(S)\},tenso
rprod);\ngindets:=\{\}:\nfor x in L do \n    if type(x,tensorprod) the
n gindets:=gindets union \{x\} else \n                               g
indets:=gindets union \{select(type,x,tensorprod)\} end if\nend do;\nr
:=map(tensorrank,gindets):\nif nops(r)<>1 then \n   error \"input cont
ains tensors of mixed ranks %0\",op(r) \nend if:\nif nargs=1 then retu
rn collect(S,gindets,factor) elif\n   nargs=2 then return collect(S,gi
ndets,s) else\n   error \"at most two arguments are expected\"\nend if
;\nend proc:\n\n\nend module:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 
0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 13 "savelib(GTP):" }}}
{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "" 0 "" 
{TEXT -1 21 "Cookeville, 11-5-2002" }}}}{MARK "3 0 0" 0 }{VIEWOPTS 1 
1 0 1 1 1803 1 1 1 1 }{PAGENUMBERS 0 1 2 33 1 1 }