{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 "Text Output" -1 2 1 {CSTYLE "" -1 -1 "Courier" 1 10 0 0 255 1 0 0 0 0 0 1 3 0 3 0 }1 0 0 -1 -1 -1 0 0 0 0 0 0 -1 0 }{PSTYLE "" 2 6 1 {CSTYLE "" -1 -1 "" 0 1 0 0 0 0 0 0 0 0 0 0 2 0 0 0 }0 0 0 -1 -1 -1 0 0 0 0 0 0 -1 0 }{PSTYLE "Maple Output" 0 11 1 {CSTYLE "" -1 -1 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }3 3 0 -1 -1 -1 0 0 0 0 0 0 -1 0 }{PSTYLE "Normal" -1 256 1 {CSTYLE "" -1 -1 "Ti mes" 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 33 "Cliplus for Clifford an d Maple 10" }{TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1092 "## ###################################################################### #####\n# \+ #\n#DISCLAIMER: \+ #\n# \+ #\n#THERE IS NO WARRANTY FOR THE CLIFFO RD, BIGEBRA, Cliplus, Octonion, GTP #\n#PACKAGES TO THE EXTENT PER MITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE #\n#STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE #\n#PROGRAM \+ \"AS IS\" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, # \n#INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTAB ILITY #\n#AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS T O THE QUALITY #\n#AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOUL D THE PROGRAM PROVE #\n#DEFECTIVE, YOU ASSUME THE COST OF ALL NE CESSARY SERVICING, REPAIR OR #\n#CORRECTION. \+ #\n####################### ######################################################\n" }}{PARA 0 " " 0 "" {TEXT -1 551 "\nAdditional procedures to accompany CLIFFORD ver . 10 for Maple 10.\n\nThis version of the package contains revised pro cedures which can take extra parameter or index: \n\ncliexpand(p,K);\n climul[K](p1,p2,...,pn)\nclirev(p,K);\nmakeclialiases[K](n);\nclibasis [K](n);\ndwedge(p1,p2,...,pn);\ndwedge[K1,K2](p1,p2,...,pn);\n`&dw`(p1 ,p2,...,pn);\n\nProcedure 'clieval' doesn't require an extra parameter since it converts Clifford polynomials expressed in Clifford bases su ch as `&C`[X] for various forms X and converts to Grassmann basis.\n\n Last revised: July 22, 2006\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 "res tart:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 "unprotect('Cliplus');" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 241 "Cliplus:=module()\n############### ##########\nexport makeclialiases,clibasis,cliexpand,LCbig,RCbig,cliev al,climul,clirev,\n dwedge,dottedcbasis;\n###################### ###\nlocal setup;\noption package, load=setup:\n###################### ###\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1564 "makeclialiases:=proc(a1: :posint,a2::\{symbol,string\}) \n local K,L,i,k,l,makeC libasmon,s,lname,flagindexed;\noptions `Copyright (c) 1995-2006 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescriptio n `Last revised: July 22, 2006`;\n#################################### #########\nif not a1>1 then error \"first parameter must be a positive integer larger than one\" end if:\nif nargs=2 and not member(a2,\{'or dered',\"ordered\"\}) then\n error \"second optional parameter, when used, must be 'ordered'\" end if:\n################################## #####\nif type(op(procname),procedure) then\n lname:=`B`;\n flag indexed:=false:\n else\n lname:=op(procname);\n flagindexed:=tr ue:\nend if:\n#######################################\nL:=[seq(op(comb inat[choose]([seq(i,i=1..a1)],k)),k=2..a1)];\nmakeClibasmon:=proc(a1) \+ local s,i;\n if nops(a1)=1 then return cat(e,op(a1)) end if:\n if nargs=1 then \n s:=`&C`(e||( op(a1)));\n else\n s:=`&C`[args[2]](e|| (op(a1)));\n end if:\n return s\nend proc:\n if nargs=1 then \n K:=[seq(op(combinat[permute](l)),l=L)];\n if no t flagindexed then\n s:=seq(cat(e,op(K[i]))=makeClibasmon(K[i]),i =1..nops(K))\n else\n s:=seq(cat(e,op(K[i]))=makeClibasmon(K[i] ,lname),i=1..nops(K))\n end if:\nelse\n if not flagindexed then\n \+ s:=seq(cat(e,op(L[i]))=makeClibasmon(L[i]),i=1..nops(L))\n else \n s:=seq(cat(e,op(L[i]))=makeClibasmon(L[i],lname),i=1..nops(L)) \n end if:\nend if:\nreturn 'alias'(s)\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1488 "clibasis:=proc(n::nonnegint,a2::\{posint,symbo l,string\}) \n local lname,k,fk,eL,L,newbasis,Lsort,l,feven,f lagindexed;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and \+ Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: J uly 22, 2006`;\n#############################################\nif n=0 \+ then return [Id] end if:\n#######################################\nif \+ type(op(procname),procedure) then\n lname:=`B`;\n flagindexed:=f alse:\n else\n lname:=op(procname);\n flagindexed:=true:\nend i f:\n#######################################\neL:=[e||(1..n)];\nL:=map( sort,combinat[powerset](eL));\nLsort:=proc(l1::list,l2::list) if nops( l1)>nops(l2) then false else true end if end proc:\nL:=sort(L,Lsort); \nif nargs=2 then\n if args[2]='even' then\nfeven:=proc(l::list) if \+ type(nops(l),even) then true else false end if end proc:\nL:=select(fe ven,L);\n elif type(args[2],nonnegint) and args[2]<=args[1] then\nk: =args[2];\nfk:=proc(l::list,k::nonnegint) if nops(l)=k then true else \+ false fi end;\nL:=select(fk,L,k)\n else error \"second argument must be 'even' or a non negative integer less than or equal to the first a rgument\"\nend if:\nend if:\nnewbasis:=[]:\nfor l in L do\nif nops(l)= 0 then newbasis:=[op(newbasis),Id] elif\n nops(l)=1 then newbasis:=[ op(newbasis),op(l)] else\n if flagindexed then \n newbasis:=[op (newbasis),eval(`&C`[lname](op(l)))]\n else\n newbasis:=[op(new basis),eval(`&C`(op(l)))] \n end if:\n end if: \nend do:\nreturn n ewbasis\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2245 "cliexpand :=proc(a::\{function,cliscalar,clibasmon,climon,clipolynom\}) global B ;\n local ind,sol,s,eq,lname,flagindexed;\noptions `Copyrigh t (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights r eserved.`;\ndescription `Last revised: July 22, 2006`;\n############## ###############################\n##################################### ############################################\n### This revised procedu re can take now optional parameter of type name, symbol,#\n### matrix, or array so that it could be passed on to cmul[K]. It will return # \n### indexed cliprods like &C[K]. Without the extra parameter, defaul t form B is #\n### used. Thus, &C[B] means the same thing as &C but is of indexed type while #\n### &C is not. \+ # \+ ########################################################## #######################\nif type(a,\{cliscalar,function\}) then return a end if:\n#######################################\n################# ######################\nif nargs=1 then\n lname:=`B`;\n flaginde xed:=false:\nelif nargs=2 and\ntype(args[2],\{symbol,name,array,matrix ,`&*`(numeric,\{name,symbol,matrix,array\})\}) then\n lname:=args[2 ];\n flagindexed:=true:\nelse error \"only one or two arguments are expected\"\nend if:\n#######################################\nif not \+ type(a,clibasmon) then \n if not flagindexed then \n return exp and(map(procname,a))\n else\n return expand(map(procname,a,lnam e))\n end if: \nend if:\n#######################################\ni nd:=Clifford:-extract(a,'integers'):\nif member(nops(ind),\{0,1\}) the n return a end if:\nif not Clifford:-reorder(a)=a then \n if not fla gindexed then \n return expand(map(procname,Clifford:-reorder(a)) ) \n else\n return expand(map(procname,Clifford:-reorder(a),lna me)) \n end if:\nend if:\ns:=op(ind):\nif not flagindexed then \n \+ eq:=`&C`(e||s)=Clifford:-cmul(e||(s));\nelse \n eq:=`&C`[lname](e||s )=Clifford:-cmul[lname](e||(s));\nend if:\nsol:=solve(eq,a);\nif Cliff ord:-maxgrade(a)<4 then return sol \n else \n if not flagindexed t hen \n return expand(map(procname,sol)) \n else\n return e xpand(map(procname,sol,lname)) \n end if:\nend if:\nend proc:\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 2249 "LCbig:=proc(x::\{cliscalar,clibas mon,climon,clipolynom,cliprod\},\n y::\{cliscalar,clibasmon ,climon,clipolynom,cliprod\}) \n local a1,a2,flag,out,lname,flag indexed,S1,S2,f,L;global B:\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription \+ `Last revised: July 22, 2006`;\n###################################### #######\n#######################################\nif nargs=2 then\n \+ lname:=`B`;\n flagindexed:=false:\nelif nargs=3 and \ntype(args[3] ,\{symbol,name,array,matrix,`&*`(numeric,\{symbol,name,array,matrix\}) \}) then\n lname:=args[3];\n flagindexed:=true:\nelse error \"on ly two or three arguments are expected\"\nend if:\n################### ###################################################################### \n### Since many different indices to `&C`[K] are allowed, we must che ck if the optional # \n### parameter X, whose default value is B, is \+ the same in all arguments. # \n######################## #################################################################\nS2: =\{lname\}:\nS1:=\{\}:\nL:=select(hastype,\{args[1],args[2]\},cliprod) ;\nif L<>\{\} then\n while L<>\{\} do\n S1:=S1 union select(type ,L,cliprod);\n L:=remove(type,L,cliprod);\n if L<>\{\} and not evalb(map(type,L,\{`+`,`*`\})=\{true\}) then\n error \"expecte d '+' or '*' type only in arguments of LCbig but received %1\",L \n \+ end if:\n L:=select(hastype,map(op,L),cliprod);\n end do:\n \+ if not evalb(map(type,S1,cliprod)=\{true\}) then\n error \"encoun tered unexpected type among arguments of LCbig\"\n end if:\n S1:= \{seq(op(0,f),f=S1)\};\n for f in S1 do\n if type(f,indexed) t hen S2:=S2 union \{op(f)\} else S2:=S2 union \{`B`\} end if:\n end d o:\nend if:\nif nops(S2)>1 then\n error \"optional (or default B) pa rameter in LCbig differs from indices encountered in its cliprod argum ents. Found these names as indices of &C: %1\",S2\nend if:\n########## ###########################\nflag:=false:\nif hastype(x,cliprod) then \+ a1:=clieval(x); flag:=true; else a1:=x end if:\nif hastype(y,cliprod) \+ then a2:=clieval(y); flag:=true; else a2:=y end if:\n################# ####################\nout:=Clifford:-LC(a1,a2,lname);\nif flag then \+ \n return cliexpand(out,lname)\nelse\n return out\nend if:\nend proc :\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2228 "RCbig:=proc(x::\{cliscalar ,clibasmon,climon,clipolynom,cliprod\},\n y::\{cliscalar,cl ibasmon,climon,clipolynom,cliprod\}) \n local a1,a2,flag,out,lna me,flagindexed,S1,S2,f,L;global B:\noptions `Copyright (c) 1995-2006 b y Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescr iption `Last revised: July 22, 2006`;\n############################### ##############\n#######################################\nif nargs=2 th en\n lname:=`B`;\n flagindexed:=false:\nelif nargs=3 and type(ar gs[3],\{symbol,name,array,matrix,`&*`(numeric,\{symbol,name,array,matr ix\})\}) then\n lname:=args[3];\n flagindexed:=true:\nelse error \"only two or three arguments are expected\"\nend if:\n############## ###################################################################### \n### Since many different indices to &C are allowed, we must check if the optional # \n### parameter X, whose default value is B, is the s ame in all arguments. # \n################################## ##################################################\nS2:=\{lname\}:\nS1 :=\{\}:\nL:=select(hastype,\{args[1],args[2]\},cliprod);\nif L<>\{\} t hen\n while L<>\{\} do\n S1:=S1 union select(type,L,cliprod);\n \+ L:=remove(type,L,cliprod);\n if L<>\{\} and not evalb(map(type ,L,\{`+`,`*`\})=\{true\}) then\n error \"expected '+' or '*' ty pe only in arguments of RCbig but received %1\",L \n end if:\n \+ L:=select(hastype,map(op,L),cliprod);\n end do:\n if not evalb(ma p(type,S1,cliprod)=\{true\}) then\n error \"encountered unexpecte d type among arguments of RCbig\"\n end if:\n S1:=\{seq(op(0,f),f= S1)\};\n for f in S1 do\n if type(f,indexed) then S2:=S2 union \{op(f)\} else S2:=S2 union \{`B`\} end if:\n end do:\nend if:\nif \+ nops(S2)>1 then\n error \"optional (or default B) parameter in RCbig differs from indices encountered in its cliprod arguments. Found thes e names as indices of &C: %1\",S2\nend if:\n########################## ###########\nflag:=false:\nif hastype(x,cliprod) then a1:=clieval(x); \+ flag:=true; else a1:=x end if:\nif hastype(y,cliprod) then a2:=clieval (y); flag:=true; else a2:=y end if:\n################################# ####\nout:=Clifford:-RC(a1,a2,lname);\nif flag then \n return cliexp and(out,lname)\nelse\n return out\nend if:\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 401 "clieval:=proc(a::algebraic) local p; \noptio ns `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. \+ All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n## ###########################################\n##################\n### W orks with `&C` and with `&C`[K]\n##################\np:=eval(eval(subs (`&C`=`&c`,args[1])));\np:=eval(p):\nreturn Clifford:-displayid(expand (p)) \nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2254 "climul:=pro c() local p,p1,lname,flagindexed,S1,S2,L,f,args2,args3,coB;\noptions ` Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All \+ rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n###### #######################################\n############################# ##########\nif type([args],listlist) then\n if evalb(op(0,op(args))= `*`) then\n coB,args3:=op(op(args));\n lname:=coB*op(0,args3 );\n args2:=op(args3);\n flagindexed:=true:\n else\n \+ lname:=op(0,op(args));\n args2:=op(op(args));\n flagindexed: =true:\n end if:\nelif type(op(procname),procedure) then\n lname :=`B`;\n flagindexed:=false:\n args2:=args:\nelse\n lname:= op(procname);\n flagindexed:=true:\n args2:=args:\nend if:\n#### ###################################################################### ##########\n### Since many different indices to &C are allowed, we mus t check if the optional # \n### parameter X, whose default value is B , is the same in all arguments. # \n######################## ############################################################\nS2:=\{ln ame\}:\nS1:=\{\}:\nL:=select(hastype,\{args2\},cliprod);\nif L<>\{\} t hen\n while L<>\{\} do\n S1:=S1 union select(type,L,cliprod);\n \+ L:=remove(type,L,cliprod);\n if L<>\{\} and not evalb(map(type ,L,\{`+`,`*`\})=\{true\}) then\n error \"expected '+' or '*' ty pe only in arguments of climul but received %1\",L \n end if:\n \+ L:=select(hastype,map(op,L),cliprod);\n end do:\n if not evalb(m ap(type,S1,cliprod)=\{true\}) then\n error \"encountered unexpect ed type among arguments of climul\"\n end if:\n S1:=\{seq(op(0,f), f=S1)\};\n for f in S1 do\n if type(f,indexed) then S2:=S2 uni on \{op(f)\} else S2:=S2 union \{`B`\} end if:\n end do:\nend if:\ni f nops(S2)>1 then\n error \"optional (or default B) parameter in cli mul differs from indices encountered in its cliprod arguments. Found t hese names as indices of &C: %1\",S2\nend if:\n####################### #################\nif not flagindexed then\n p:=map(clieval,[args2]) ;\n p:=Clifford:-cmul(op(p));\nelse \n p:=map(clieval[lname],[args 2]);\n p:=Clifford:-cmul[lname](op(p));\nend if:\nif not has([args2] ,`&C`) then return Clifford:-clisort(p) else\n return cliexpand(p,ln ame);\nend if:\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3061 "cl irev:=proc(a1) local p,lname,flagindexed,S1,S2,L,f;\noptions `Copyrigh t (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights r eserved.`;\ndescription `Last revised: July 22, 2006`;\n############## ###############################\n##################################### ##\nif type(a1,cliscalar) then return a1 end if:\n#################### ###################\nif nargs=1 then\n lname:=`B`;\n flagindexed :=false:\nelif nargs=2 and\ntype(args[2],\{symbol,name,array,matrix,`& *`(numeric,\{name,symbol,matrix,array\})\}) then\n lname:=args[2]; \n flagindexed:=true:\nelse error \"only one or two arguments are e xpected\"\nend if:\n################################################## ##################################\n### Since many different indices t o &C are allowed, we must check if the optional # \n### parameter X, \+ whose default value is B, is the same in all arguments. # \n ###################################################################### ##############\nS2:=\{lname\}:\nS1:=\{\}:\nL:=select(hastype,\{args\}, cliprod);\nif L<>\{\} then\n while L<>\{\} do\n S1:=S1 union sel ect(type,L,cliprod);\n L:=remove(type,L,cliprod);\n if L<>\{\} and not evalb(map(type,L,\{`+`,`*`\})=\{true\}) then\n error \+ \"expected '+' or '*' type only in arguments of clirev but received %1 \",L \n end if:\n L:=select(hastype,map(op,L),cliprod);\n en d do:\n if not evalb(map(type,S1,cliprod)=\{true\}) then\n erro r \"encountered unexpected type among arguments of clirev\"\n end if :\n S1:=\{seq(op(0,f),f=S1)\};\n for f in S1 do\n if type(f, indexed) then S2:=S2 union \{op(f)\} else S2:=S2 union \{`B`\} end if: \n end do:\nend if:\nif nops(S2)>1 then\n error \"optional (or def ault B) parameter in clirev differs from indices encountered in its cl iprod arguments. Found these names as indices of &C: %1\",S2\nend if: \n########################################\nif not has([args[1]],`&C`) then return Clifford:-reversion(args[1],lname) end if:\n############# ###########################\nif type(args[1],\{`+`,`*`\}) then return \+ map(clirev,args[1],lname) end if:\n################################### #####\nif not type(args[1],cliprod) then return args[1] end if:\n##### ###################################\nL:=[op(args[1])];\nwhile hastype( L,cliprod) do L:=map(op,L) end do: #Needed for ((e1 &C e2) &C e3)\n### #####################################\n#### Checking if elements like \+ `&C`(e1we2,e1),that is, unevaluated Clifford products\n#### of Grassma nn elements are present. That is, when mixed bases are used. Then, we \n#### apply clieval (to convert to pure Grassmann basis), then apply \+ cliexpand (to\n#### convert back to Clifford basis only) and then re-e nter clirev with the revised\n#### argument. \n####################### #################\nif not evalb( map(nops,map(extract, convert(L,set) \+ ))=\{1\}) then\n p:=cliexpand(clieval(args[1]),lname):## convert arg s[1] to Clifford basis only\n return clirev(p,lname) \nend if:\nif l name='B' then \n return `&C`(op([seq(L[nops(L)-i+1],i=1..nops(L))])) \nelse \n return `&C`[lname](op([seq(L[nops(L)-i+1],i=1..nops(L))])) \nend if:\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1048 "dwedge: =proc(x::\{cliscalar,clibasmon,climon,clipolynom\},\n y:: \{cliscalar,clibasmon,climon,clipolynom\}) \n local L,MatF,MatF T,out;\noptions `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertf ried Fauser. All rights reserved.`;\ndescription `Last revised: July 2 2, 2006`;\n#############################################\nL:=[op(procn ame)];\nif type(L,list(procedure)) then\n error \"index is expected \+ of type name, symbol, or antisymmatrix, e.g., dwedge[K](p1,p2), try ?d wedge for help\"\nend if:\nif not type(L,list(\{matrix,array,name,symb ol,`&*`(numeric,\{matrix,array,name,symbol\})\})) \nthen\nerror \"inde x must be matrix, array, name, symbol, or `&*`(numeric,\{matrix,array, name,symbol\}\"\nend if:\nif type(L,list(\{matrix,array\})) then\n i f not type(L,list(antisymmatrix)) then\n error \"matrix or array \+ used for index must be antisymmetric\"\n end if:\nend if:\nMatF:=op( L):\nMatFT:=-MatF:\nL:=map(convert,[args],wedge_to_dwedge,-MatF);\nout :=convert(Clifford:-wedge(op(L)),dwedge_to_wedge,-MatFT);\nreturn Clif ford:-clicollect(out)\nend proc: \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 731 "dottedcbasis:=proc() local lname,L;\noptions `Copyright (c) 1995- 2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`; \ndescription `Last revised: July 22, 2006`;\n######################## #####################\n if not type(op(procname),procedure) then \n \+ lname:=op(procname);\n else\n error \"this procedure requi res an index of type name, symbol, matrix, array\"\n end if:\n if \+ type(lname,\{matrix,array\}) then\n if not type(lname, antisymmat rix) then\n error \"index is expected to be an antisymmetric m atrix or array, or, name or symbol\"\n fi end if:\n L:=Clifford:-c basis(args); #assign standard undotted Grassmann basis to L\n L:=map (convert,L,wedge_to_dwedge,lname);\n return L\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 5262 "setup:=proc() local x,y,i,j;\nglobal `c onvert/wedge_to_dwedge`,`convert/dwedge_to_wedge`,`&dw`;\noptions `Cop yright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rig hts reserved.`;\ndescription `Last revised: July 22, 2006`;\n######### ####################################\n`&dw`:=proc() local coB,nameB,ln ame,NP,decindex,ARGS,flagdec;global F:\noptions `Copyright (c) 1995-20 06 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nd escription `Last revised: July 22, 2006`;\n########################### ##################\n################################################## ##################################\n### Works when &dw[''F''] or &dw[' '-F''] is entered and F is an antisymmetric matrix\n################## ##################################################################\nfl agdec:=true:\nif type(op(procname),procedure) then\n if type([args], listlist) then\n if type(op(args),array) then\n WARNING(` enclose index in double quotes as in &dw[''F''] or &c[''-F''] when F h as been assigned an antisymmetric matrix to avoid the following:`);\n \+ return 'procname(args)'\n end if:\n else coB:=1:\n n ameB:=`F`:\n lname:=`F`:\n ARGS:=[args]:\n flagdec:= false:\n end if:\nelse lname:=op(procname);\n ARGS:=[args];\n \+ if type(lname,`&*`(numeric,name)) then\n coB:=op(select(type, \{op(lname)\},numeric));\n nameB:=op(select(type,\{op(lname)\} ,name));\n else\n coB:=1:\n nameB:=lname:\n en d if:\n flagdec:=false:\nend if:\n################################ #######\ndecindex:=proc() local ARGS,coB,nameB;global F;\nif type([arg s],listlist) then\n if type(op(args),function) then\n ARGS:=op( op(args));\n coB:=1:\n nameB:=eval(op(0,op(args)));\n i f type(nameB,`&*`(numeric,name)) then\n coB:=op(select(type,\{ op(nameB)\},numeric));\n nameB:=op(select(type,\{op(nameB)\},n ame));\n end if:\n elif type(op(args),`&*`(numeric,function)) t hen\n nameB:=\{op(op(args))\}:\n coB:=op(select(type,nameB,n umeric));\n nameB:=op(select(type,nameB,function));\n ARGS:= op(nameB);\n nameB:=op(0,nameB);\n else\n error \"unable t o determine index from or wrong index, use name in double quotes as in &dw[''F''] or &dw[''-F''] \"\n end if:\nelif\n type([args],list) \+ then\n ARGS:=args;\n coB:=1:\n nameB:=`F`; #default name \nelse \n error \"cannot determine arguments and/or index from: %0\",args\n end if:\nreturn coB,nameB,[ARGS];\nend proc:\n######################## #############\nif flagdec then \n coB,nameB,ARGS:=decindex(args);\n \+ lname:=coB*nameB;\nend if:\nNP:=nops(ARGS);\nif member(0,ARGS) then \+ return 0 end if:\nif NP <=1 then return op(ARGS) end if:\nreturn dwedg e[lname](op(ARGS))\nend proc:\n####################################### ######\n`convert/wedge_to_dwedge`:=\n proc(x::\{cliscalar,clibasmon,c limon,clipolynom\},\n lname::\{symbol,name,array,matrix,`&*`(numeric ,\{name,symbol,matrix,array\})\}) \n local r1,r2;global B;\noptions \+ `Copyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: July 22, 2006`;\n##### ########################################\nif type(lname,\{array,matrix \}) then\n r1,r2:=op(2,eval(lname)):\n if not evalb(r1=r2) then \n error \"second argument must be a square matrix or array\"\n e nd if:\n if not type(lname,antisymmatrix) then\n error \"second argument must be an antisymmetric matrix or array\"\n end if: \nend if:\nreturn Cliplus:-clieval(subs(`&C`=Clifford:-wedge,Cliplus:-cliex pand(x,-lname)))\nend proc:\n######################################### #####\n`convert/dwedge_to_wedge`:=\n proc(x::\{cliscalar,clibasmon,c limon,clipolynom\},\n lname::\{symbol,name,array,matrix,`&*`(numeri c,\{name,symbol,matrix,array\})\}) \nlocal r1,r2;global B;\noptions `C opyright (c) 1995-2006 by Rafal Ablamowicz and Bertfried Fauser. All r ights reserved.`;\ndescription `Last revised: July 22, 2006`;\n####### ######################################\nif type(lname,\{array,matrix\} ) then\n r1,r2:=op(2,eval(args[2])):\n if not evalb(r1=r2) then \n error \"second argument must be a square matrix or array\"\n e nd if:\n if not type(lname,antisymmatrix) then\n error \"second argument must be an antisymmetric matrix or array\"\n end if:\nend \+ if:\nreturn Cliplus:-clieval(subs(`&C`=Clifford:-wedge,Cliplus:-cliexp and(x,-lname)))\nend proc:\n########################################## ###\nparse(\"macro(cmul=Cliplus:-climul)\"); #'cmul' is now ex tended by 'climul' \nparse(\"macro(cmulQ=Cliplus:-climul)\"); # 'cmulQ' is now extended by 'climul'\nparse(\"macro(`&c`=Cliplus:-climu l)\"); #`&c` is now extended by 'climul'\nparse(\"macro(`&cQ`= Cliplus:-climul)\"); #`&cQ` is now extended by 'climul'\nparse( \"macro(reversion=Cliplus:-clirev)\"); #'reversion' is now extended by 'clirev'\nparse(\"macro(LC=Cliplus:-LCbig)\"); #'LC' is now extended by 'LCbig'\nparse(\"macro(RC=Cliplus:-RCbig)\"); \+ #'RC' is now extended by 'RCbig'\n\nconvert(LC,`global`);\nconvert (RC,`global`);\nprintf(\"Cliplus has been loaded. Definitions for type /climon and type/clipolynom now include &C and &C[K]. Type ?cliprod fo r help.\\n\");\n#WARNING(`definitions for type/climon and type/clipoly nom now include &C and &C[K]. Type ?cliprod for #help.`);\nprotect(Cli plus);\nend proc:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 11 "end module:" }}{PARA 6 "" 1 "" {TEXT -1 122 "C liplus has been loaded. Definitions for type/climon and type/clipolyno m now include &C and &C[K]. Type ?cliprod for help." }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 8 "libname;" }}{PARA 11 "" 1 "" {XPPMATH 20 " 6$Q/C:\\Maple10/lib6\"Q7C:\\Maple10/CliffordlibF$" }}}{EXCHG {PARA 0 " > " 0 "" {MPLTEXT 1 0 12 "savelibname;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 "savelib('Cliplus'):" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#Q7C:\\M aple10/Cliffordlib6\"" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 28 "ma rch('listdir',libname[2]);" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#7#7&QAC: \\Maple10/Cliffordlib\\maple.lib6\"7(\"%1?\"\"'\"#@F*\"#L\"#;Q)WRITABL EF&\"\"!" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "" 0 "" {TEXT -1 21 "Revised July 22, 2006" }{MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}}{MARK "4 1 1" 0 }{VIEWOPTS 1 1 0 1 1 1803 1 1 1 1 }{PAGENUMBERS 0 1 2 33 1 1 }