{VERSION 6 0 "IBM INTEL NT" "6.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 "2D Math" -1 2 "Times" 0 1 0 0 0 0 0 0 2 0 0 0 0 0 0 1 }{CSTYLE "2D Output" 2 20 "" 0 1 0 0 255 1 0 0 0 0 0 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 "Maple Output" -1 11 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "" 11 12 1 {CSTYLE "" -1 -1 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }1 0 0 -1 -1 -1 0 0 0 0 0 0 -1 0 }{PSTYLE "Normal" -1 256 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 1 0 0 0 0 1 0 1 0 2 2 0 1 }} {SECT 0 {EXCHG {PARA 256 "" 0 "" {TEXT 256 109 "This is a new version \+ of GTP (Graded Tensor Product) to work with CLIFFORD 11 in Maple 11. R evised 12-20-2007" }{TEXT -1 1 "\n" }{MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1092 "############################################## ###############################\n# \+ #\n#DISCLAIMER: \+ #\n# \+ #\n#THERE IS \+ NO WARRANTY FOR THE CLIFFORD, BIGEBRA, Cliplus, Octonion, GTP #\n# PACKAGES TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERW ISE #\n#STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES \+ PROVIDE THE #\n#PROGRAM \"AS IS\" WITHOUT WARRANTY OF ANY KIND, EITH ER EXPRESSED OR IMPLIED, #\n#INCLUDING, BUT NOT LIMITED TO, THE IMPLIE D WARRANTIES OF MERCHANTABILITY #\n#AND FITNESS FOR A PARTICULAR PUR POSE. THE ENTIRE RISK AS TO THE QUALITY #\n#AND PERFORMANCE OF THE \+ PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE #\n#DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR #\n#CORRE CTION. \+ #\n################################################################### ##########\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 128 "restart:\n\nGTP:=m odule()\nexport grade,gbasis,tensorrank,gradedprod,gprod,cmulB,gcollec t;\nlocal setup;\noption package,load=setup;\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3227 "setup:=proc() global ScalarTypes,GradedTypes,\n`&t` ,`type/gradedpolynom`,`type/gradedmonom`,`type/gradedeven`,`type/grade dodd`;\noptions `Copyright 1995-2008 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-2008 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 \n a11:=select(type,a1,clibasmon) :\n co:=remove(type,a1,clibasmon):\n \+ return co*(`&t`(a11,a2))\nelif type(a2,`*`) and not hasty pe(a2,tensorprod) then \n a22:=select(type,a2,c libasmon): \n co:=remove(type,a2,clibasmon):\n \+ return co*(`&t`(a1,a22))\nend if;\np:=args[1]; \nfor i from 2 to nargs do p:='`&t`'(p,args[i]) end do;\nreturn p;\nen d proc:\n#########################\n`type/gradedpolynom`:=proc(a::\{`* `,`+`,function,algebraic\})\noptions `Copyright 1995-2008 by Rafal Abl amowicz 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;\nif type(a,`+`) then return evalb(map( type,\{op(a)\},gradedpolynom)=\{true\}) end if; \nreturn false;\nend p roc:\n######################\n`type/gradedmonom`:=proc(a::\{`*`,functi on,algebraic\})\noptions `Copyright 1995-2008 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)\},t ensorprod)) end if;\nreturn false;\nend proc:\n#####################\n `type/gradedeven`:=proc(a1::\{tensorprod,gradedmonom,gradedpolynom\}) \+ \noptions `Copyright 1995-2008 by Rafal Ablamowicz and Bertfried Fause r`; \nif type(a1,tensorprod) or type(a1,gradedmonom) then\n if grade (a1)=0 then return true else return false fi end if;\nif map(grade,\{o p(a1)\})=\{0\} then return true else return false end if;\nend proc:\n ####################\n`type/gradedodd`:=proc(a1::\{tensorprod,gradedmo nom,gradedpolynom\}) \noptions `Copyright 1995-2008 by Rafal Ablamowic z and Bertfried Fauser`; \nif type(a1,tensorprod) or type(a1,gradedmon om) then\n if grade(a1)=1 then return true else return false end if \+ \nend if;\nif map(grade,\{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,cl imon,tensorprod,gradedmonom\}) local g,i,S,r;\noptions `Copyright 1995 -2008 by Rafal Ablamowicz and Bertfried Fauser`; \ng:=proc(a) if type( a,evenelement) 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 re turn g(a1) \nelse return 0 \nend if;\nend proc:\n" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 536 "gbasis:=proc() local T,res,pair;\noptions `Copyrig ht 1995-2008 by Rafal Ablamowicz and Bertfried Fauser`; \nif not type( [args],list(list(\{tensorprod,clibasmon\}))) or nargs<2 then \n erro r \"at least two lists with elements of type 'clibasmon' or 'tensorpro d' are needed as input\" \nend if;\nif nargs>2 then return gbasis(gbas is(args[1],args[2]),args[3..nargs]) end if;\nT:=combinat[cartprod]([ar gs[1..2]]):\nres:=[]:\nwhile not T[finished] do\n pair:=T[nextval ue](): \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::algebraic) local flag,i,L,S1,S2,a1,r1,S;\noptions `Copyright 1995- 2008 by Rafal Ablamowicz and Bertfried Fauser`; \na1:=expand(a):\nif t ype(a1,tensorprod) then L:=[op(a1)]:\n while hastype(L,tensorprod) d o L:=map(op,L) end do;\n return nops(L)\nend if;\nif type(a1,gradedm onom) then return 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 \nend if;\nreturn op(S);\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1886 "gradedprod:=proc() local K,r1,r2,res,gbilinear;\nop tions `Copyright 1995-2008 by Rafal Ablamowicz and Bertfried Fauser`; \+ \nif not type(map(expand,[args[1..2]]),list(\{tensorprod,gradedmonom,g radedpolynom\})) then\n error \"first two arguments must be of type \+ 'tensorprod', 'gradedmonom', or 'gradedpolynom'\" \nend if;\nif nargs> 2 and not type(map(evalm,[args[3..nargs]]),list(diagmatrix)) \nthen \n error \"optional arguments must be r square diagonal matrices where r \+ is the rank of tensors in arguments 1 and 2, but instead received at l east one non-diagonal matrix among %0\",args[3..nargs] \nend if;\nprin tlevel:=3:\nr1:=tensorrank(expand(args[1])):r2:=tensorrank(expand(args [2])):\nif r1=false or r2=false then \n error \"homogeneous tensors \+ in each argument must be of equal rank\"\nend if;\nif r1<>r2 then \n \+ error \"ranks of tensors are not equal\"\nend if;\nif nargs>2 and not evalb(nargs-2=r1) then \n error \"optional arguments, when used, mu st be %1 square diagonal matrices since %2 is the rank of tensors in a rguments 1 and 2\",r1,r1\nend if;\n####defining gbilinear####\ngbiline ar:=proc(a1::algebraic,a2::algebraic) \n local S,S1,S2,a11,a 22,s,i,L,T,res,pair,L1,L2,terms,flag;\na11:=expand(a1):a22:=expand(a2) :\nif type(a11,gradedmonom) then L1:=[a11] else L1:=[op(a11)] end if: \nif type(a22,gradedmonom) then L2:=[a22] else L2:=[op(a22)] end if:\n S:=\{op(L1),op(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 not T[finished] do\n pair:=T[nextvalue]():\n terms:=[op (terms),gprod(pair[1],pair[2],args[3..nargs])]; \n res:=res+gprod(pa ir[1],pair[2],args[3..nargs]) \nend do:\nelse\nwhile not T[finished] d o\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 r es\nend proc:\n####end of definition####\nreturn gbilinear(args) \nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2967 "gprod:=proc(p1::\{ten sorprod,gradedmonom\},p2::\{tensorprod,gradedmonom\}) \nlocal co,le1,l e2,trank,m1,mm1,s1,m2,mm2,s2,f,a,b,i,ab,k,fac,BB,flag;global B;\noptio ns `Copyright 1995-2008 by Rafal Ablamowicz and Bertfried Fauser`; \ni f nargs=1 then \n error \"two arguments are needed of type 'tensorpr od' or 'gradedmonom' but received only one argument\"\nend if;\nif nar gs=2 and not assigned(B) then\n error \"can't handle purely symbolic case: B must be assigned a diagonal matrix or optional parameters mus t be used\"\nend if;\nif nargs=2 and assigned(B) and not type(B,diagma trix) then\n error \"when assigned, B must be a diagonal matrix\"\ne nd if;\nif nargs>2 and not type(map(evalm,[args[3..nargs]]),list(matri x)) \nthen \n error \"optional arguments, when used, must be r diago nal matrices where r is the rank of tensors in arguments 1 and 2, but \+ instead received %0\",args[3..nargs] \nend if;\nif nargs>2 and not typ e(map(evalm,[args[3..nargs]]),list(diagmatrix)) \nthen \n error \"op tional arguments, when used, must be r diagonal matrices where r is th e rank of tensors in arguments 1 and 2, but instead received at least \+ one non-diagonal matrix matrices among %0\", args[3..nargs] end if;\ni f nargs>2 then BB:=[seq(evalm(args[i]),i=3..nargs)] end if;\nco:=1:\ni f type(p1,`*`) then \n co:=co*remove(type,p1,tensorprod);\n m1:=se lect(type,p1,tensorprod);\nelse m1:=p1 end \nif;\nif type(p2,`*`) then \n co:=co*remove(type,p2,tensorprod);\n m2:=select(type,p2,tensor prod);\nelse m2:=p2 \nend if;\nmm1:=[]:s1:=m1:mm2:=[]:s2:=m2:\nwhile t ype(s1,function) do mm1:=[op(2,s1),op(mm1)];s1:=op(1,s1); end do;\nmm1 :=[s1,op(mm1)];\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);\nl e1:=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 a rguments must be %1 diagonal matrices\",trank \nend if;\n flag:=fals e:\n for i from 1 to trank while not flag do\n if linalg[coldim]( BB[i])<>linalg[rowdim](BB[i]) then\n flag:=true:\n error \+ \"one of the 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..trank,[]):\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 c o:=co*remove(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)))) \ne nd 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:=proc(x,y,B1::matrix) local xy,Bloc,s;global B;\noptions `C opyright 1995-2008 by Rafal Ablamowicz and Bertfried Fauser`;\nif assi gned(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:=evalm(linalg[matrix](s,s,Bloc)) else B:='B' end if;\nreturn \+ Clifford:-reorder(xy);\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 767 "gcollect:=proc(S::\{tensorprod,gradedmonom,gradedpolynom\},\n \+ s::\{symbol,string\}) \n local L,gindets,x,r; \noptions `Copyright 1995-2008 by Rafal Ablamowicz and Bertfried Fause r`;\nif type(S,tensorprod) then return S end if;\nL:=select(hastype,\{ op(S)\},tensorprod);\ngindets:=\{\}:\nfor x in L do \n if type(x,te nsorprod) then gindets:=gindets union \{x\} else \n \+ gindets:=gindets union \{select(type,x,tensorprod)\} end i f\nend do;\nr:=map(tensorrank,gindets):\nif nops(r)<>1 then \n error \"input contains tensors of mixed ranks %0\",op(r) \nend if:\nif narg s=1 then return collect(S,gindets,factor) elif\n nargs=2 then return collect(S,gindets,s) else\n error \"at most two arguments are expec ted\"\nend if;\nend proc:\nend module:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 11 "libname [1];" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#Q7C:\\Maple11/Cliffordlib6\"" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 13 "savelib(GTP):" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 19 "with(LibraryTools);" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#72%1ActivationModuleG%1AddFromDirectoryG%'AuthorG% 'BrowseG%3BuildFromDirectoryG%/ConvertVersionG%'CreateG%'DeleteG%,Find LibraryG%,PrefixMatchG%)PriorityG%%SaveG%-ShowContentsG%*TimestampG%4U pdateFromDirectoryG%*WriteModeG" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 25 "ShowContents(libname[1]);" }}{PARA 12 "" 1 "" {XPPMATH 20 "6#7 /7&Q*Bigebra.m6\"7(\"%2?\"#7\"#?\"#:\"#\"#\\\"'Ywc\"$ x$7&Q/code_support.mF&7(F(F)F*F+\"#X\"#J\"'K5f\"$w%7&Q)Define.mF&7(F(F )F*F+\"#9\"#d\"'Q.a\"$$[7&Q>P.mF&7(F(F)F*F+\"#`\"#@\"'%Q8'\"$\"G7&Q& GfG.mF&7(F(F)F*F+\"#^\"\"*\"'&e,'\"$:(7&Q+matcompL.mF&7(F(F)F*F+\"#8FG \"'D#[$\"&=X(7&Q+matcompR.mF&Fen\"'VFU\"&^M(7&Q+matquatL.mF&Fen\"'%>' \\\"&9@#7&Q+matquatR.mF&Fen\"'3$=&\"&I?#7&Q+matrealL.mF&Fen\"'na6\"'9k 67&Q+matrealR.mF&Fen\"'\")=B\"'Wj6" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "restart :with(GTP);" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#7)%&cmulBG%'gbasisG%)gc ollectG%&gprodG%&gradeG%+gradedprodG%+tensorrankG" }}}{EXCHG {PARA 0 " > " 0 "" {MPLTEXT 1 0 39 "with(LibraryTools);\nwith(code_support);" }} {PARA 11 "" 1 "" {XPPMATH 20 "6#72%1ActivationModuleG%1AddFromDirector yG%'AuthorG%'BrowseG%3BuildFromDirectoryG%/ConvertVersionG%'CreateG%'D eleteG%,FindLibraryG%,PrefixMatchG%)PriorityG%%SaveG%-ShowContentsG%*T imestampG%4UpdateFromDirectoryG%*WriteModeG" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%!G" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%inModule~code_c upport~ver.~1.03~for~CLIFFORD~et~al.~for~Maple~11G" }}{PARA 11 "" 1 " " {XPPMATH 20 "6#%apCopyright~(c)~2002-2008~by~Rafal~Ablamowicz~and~Be rtfried~Fauser.~All~rights~reserved.G" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%@Last~revised:~December~20,~2007G" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#%!G" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#7-%/NamesInLibraryG%1change_ helpfilesG%,change_nameG%*copy_fileG%)get_TEXTG%(get_dirG%1insert_help pagesG%)makeLISTG%+modifyLISTG%0replace_in_fileG%&splitG" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 25 "ShowContents(libname[1]);" }}{PARA 12 "" 1 "" {XPPMATH 20 "6#7/7&Q*Bigebra.m6\"7(\"%2?\"#7\"#?\"#:\"#\"#\\\"'Ywc\"$x$7&Q/code_support.mF&7(F(F)F*F+\"#X\"#J\" 'K5f\"$w%7&Q)Define.mF&7(F(F)F*F+\"#9\"#d\"'Q.a\"$$[7&Q>P.mF&7(F(F)F *F+\"#`\"#@\"'%Q8'\"$\"G7&Q&GfG.mF&7(F(F)F*F+\"#^\"\"*\"'&e,'\"$:(7&Q+ matcompL.mF&7(F(F)F*F+\"#8FG\"'D#[$\"&=X(7&Q+matcompR.mF&Fen\"'VFU\"&^ M(7&Q+matquatL.mF&Fen\"'%>'\\\"&9@#7&Q+matquatR.mF&Fen\"'3$=&\"&I?#7&Q +matrealL.mF&Fen\"'na6\"'9k67&Q+matrealR.mF&Fen\"'\")=B\"'Wj6" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 " " {MPLTEXT 1 0 27 "NamesInLibrary(libname[1]);" }}{PARA 11 "" 1 "" {XPPMATH 20 "6/Q*Bigebra.m6\"Q+Clifford.mF$Q*Cliplus.mF$Q)Define.mF$Q& GTP.mF$Q&GfG.mF$Q/code_support.mF$Q+matcompL.mF$Q+matcompR.mF$Q+matqua tL.mF$Q+matquatR.mF$Q+matrealL.mF$Q+matrealR.mF$" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "" 0 "" {TEXT -1 31 "Last \+ revised: December 20, 2007" }}}}{MARK "12 0 0" 0 }{VIEWOPTS 1 1 0 1 1 1803 1 1 1 1 }{PAGENUMBERS 0 1 2 33 1 1 }