{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 "Maple Output" -1 12 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 3 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "Norma l" -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 33 "Cliplus for Clifford an d Maple 11" }{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 555 "\nAdditional procedures to accompany CLIFFORD ver . 11 for Maple 11.\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: December 20, 2007\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 "restart:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 "unprotect('Cliplus'); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 233 "Cliplus:=module()\n########### ##############\nexport makeclialiases,clibasis,cliexpand,LCbig,RCbig,c lieval,climul,clirev,dwedge,dottedcbasis;\n#########################\n local setup;\noption package, load=setup:\n#########################\n " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1551 "makeclialiases:=proc(a1::posi nt,a2::\{symbol,string\}) local K,L,i,k,l,makeClibasmon,s,lname,flagin dexed;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertf ried Fauser. All rights reserved.`;\ndescription `Last revised: Decemb er 20, 2007`;\n#############################################\nif not a 1>1 then error \"first parameter must be a positive integer larger tha n one\" end if:\nif nargs=2 and not member(a2,\{'ordered',\"ordered\" \}) then\n error \"second optional parameter, when used, must be 'or dered'\" end if:\n#######################################\nif type(op( procname),procedure) then\n lname:=`B`;\n flagindexed:=false:\n \+ else\n lname:=op(procname);\n flagindexed:=true:\nend if:\n#### ###################################\nL:=[seq(op(combinat[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:\nif nargs=1 then \n K:=[seq(op(combinat[permute](l)),l=L)];\n if not flagindexed then \n s:=seq(cat(e,op(K[i]))=makeClibasmon(K[i]),i=1..nops(K))\n e lse\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 1481 "clibasis:=proc(n::nonnegint,a2::\{posint,symbol,string\}) local \+ lname,k,fk,eL,L,newbasis,Lsort,l,feven,flagindexed;\noptions `Copyrigh t (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights r eserved.`;\ndescription `Last revised: December 20, 2007`;\n########## ###################################\nif n=0 then return [Id] end if:\n #######################################\nif type(op(procname),procedur e) then\n lname:=`B`;\n flagindexed:=false:\n else\n lname:= op(procname);\n flagindexed:=true:\nend if:\n###################### #################\neL:=[e||(1..n)];\nL:=map(sort,combinat[powerset](eL ));\nLsort:=proc(l1::list,l2::list) if nops(l1)>nops(l2) then false el se true end if end proc:\nL:=sort(L,Lsort);\nif nargs=2 then\n if ar gs[2]='even' then\nfeven:=proc(l::list) if type(nops(l),even) then tru e else false end if end proc:\nL:=select(feven,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 negativ e integer less than or equal to the first argument\"\nend if:\nend if: \nnewbasis:=[]:\nfor l in L do\nif nops(l)=0 then newbasis:=[op(newbas is),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(newbasis),eval(`&C`(op(l)))] \+ \n end if:\n end if: \nend do:\nreturn newbasis\nend proc:\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 2238 "cliexpand:=proc(a::\{function,cli scalar,clibasmon,climon,clipolynom\}) local ind,sol,s,eq,lname,flagind exed; global B;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz \+ and Bertfried Fauser. All rights reserved.`;\ndescription `Last revise d: December 20, 2007`;\n############################################# \n#################################################################### #############\n### This revised procedure can take now optional parame ter of type name, symbol,#\n### matrix, or array so that it could be p assed on to cmul[K]. It will return #\n### indexed cliprods like &C[ K]. Without the extra parameter, default 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 typ e(a,\{cliscalar,function\}) then return a end if:\n################### ####################\n#######################################\nif narg s=1 then\n lname:=`B`;\n flagindexed:=false:\nelif nargs=2 and\n type(args[2],\{symbol,name,array,matrix,`&*`(numeric,\{name,symbol,mat rix,array\})\}) then\n lname:=args[2];\n flagindexed:=true:\nels e error \"only one or two arguments are expected\"\nend if:\n######### ##############################\nif not type(a,clibasmon) then \n if \+ not flagindexed then \n return expand(map(procname,a))\n else\n return expand(map(procname,a,lname))\n end if: \nend if:\n### ####################################\nind:=Clifford:-extract(a,'intege rs'):\nif member(nops(ind),\{0,1\}) then return a end if:\nif not Clif ford:-reorder(a)=a then \n if not flagindexed then \n return ex pand(map(procname,Clifford:-reorder(a))) \n else\n return expan d(map(procname,Clifford:-reorder(a),lname)) \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 Clifford:-maxgrade(a)<4 then return \+ sol \n else \n if not flagindexed then \n return expand(map(p rocname,sol)) \n else\n return expand(map(procname,sol,lname)) \+ \n end if:\nend if:\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2241 "LCbig:=proc(x::\{cliscalar,clibasmon,climon,clipolynom,cliprod\} ,y::\{cliscalar,clibasmon,climon,clipolynom,cliprod\}) \n local \+ a1,a2,flag,out,lname,flagindexed,S1,S2,f,L; global B:\noptions `Copyri ght (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n######## #####################################\n############################### ########\nif nargs=2 then\n lname:=`B`;\n flagindexed:=false:\ne lif nargs=3 and \ntype(args[3],\{symbol,name,array,matrix,`&*`(numeric ,\{symbol,name,array,matrix\})\}) then\n lname:=args[3];\n flagi ndexed:=true:\nelse error \"only two or three arguments are expected\" \nend if:\n########################################################### ##############################\n### Since many different indices to `& C`[K] 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(hastyp e,\{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,cli prod);\n if L<>\{\} and not evalb(map(type,L,\{`+`,`*`\})=\{true\} ) then\n error \"expected '+' or '*' type only in arguments of \+ LCbig but received %1\",L \n end if:\n L:=select(hastype,map(o p,L),cliprod);\n end do:\n if not evalb(map(type,S1,cliprod)=\{tru e\}) then\n error \"encountered unexpected type among arguments o f LCbig\"\n end if:\n S1:=\{seq(op(0,f),f=S1)\};\n for f in S1 d o\n if type(f,indexed) then S2:=S2 union \{op(f)\} else S2:=S2 u nion \{`B`\} end if:\n end do:\nend if:\nif nops(S2)>1 then\n erro r \"optional (or default B) parameter in LCbig differs from indices en countered in its cliprod arguments. 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 e nd 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 2219 "RCbig:=proc(x::\{cliscalar,clibasmon,climon,clipolynom,cliprod\} ,y::\{cliscalar,clibasmon,climon,clipolynom,cliprod\}) \n local \+ a1,a2,flag,out,lname,flagindexed,S1,S2,f,L; global B:\noptions `Copyri ght (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n######## ###################################################################### ######\nif nargs=2 then\n lname:=`B`;\n flagindexed:=false:\neli f nargs=3 and type(args[3],\{symbol,name,array,matrix,`&*`(numeric,\{s ymbol,name,array,matrix\})\}) then\n lname:=args[3];\n flagindex ed:=true:\nelse error \"only two or three arguments are expected\"\nen d if:\n############################################################### #####################\n### Since many different indices to &C are allo wed, 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[1],args[2]\},cl iprod);\nif L<>\{\} then\n while L<>\{\} do\n S1:=S1 union selec t(type,L,cliprod);\n L:=remove(type,L,cliprod);\n if L<>\{\} a nd not evalb(map(type,L,\{`+`,`*`\})=\{true\}) then\n error \"e xpected '+' or '*' type 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(map(type,S1,cliprod)=\{true\}) then\n error \" encountered unexpected 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,index ed) 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 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,clip rod) then a2:=clieval(y); flag:=true; else a2:=y end if:\n############ #########################\nout:=Clifford:-RC(a1,a2,lname);\nif flag th en \n return cliexpand(out,lname)\nelse\n return out\nend if:\nend \+ proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 405 "clieval:=proc(a::algebr aic) local p; \noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz a nd Bertfried Fauser. All rights reserved.`;\ndescription `Last revised : December 20, 2007`;\n#############################################\n ##################\n### Works with `&C` and with `&C`[K]\n############ ######\np:=eval(eval(subs(`&C`=`&c`,args[1])));\np:=eval(p):\nreturn C lifford:-displayid(expand(p)) \nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2258 "climul:=proc() local p,p1,lname,flagindexed,S1,S2,L ,f,args2,args3,coB;\noptions `Copyright (c) 1995-2008 by Rafal Ablamow icz and Bertfried Fauser. All rights reserved.`;\ndescription `Last re vised: December 20, 2007`;\n########################################## ###\n#######################################\nif type([args],listlist) then\n if evalb(op(0,op(args))=`*`) then\n coB,args3:=op(op(ar gs));\n lname:=coB*op(0,args3);\n args2:=op(args3);\n f lagindexed:=true:\n else\n lname:=op(0,op(args));\n args2: =op(op(args));\n flagindexed:=true:\n end if:\nelif type(op(pro cname),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 must check if the optional # \n### par ameter X, whose default value is B, is the same in all arguments. \+ # \n############################################################ ########################\nS2:=\{lname\}:\nS1:=\{\}:\nL:=select(hastype ,\{args2\},cliprod);\nif L<>\{\} then\n while L<>\{\} do\n S1:=S 1 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 '*' type only in arguments of climul but r eceived %1\",L \n end if:\n L:=select(hastype,map(op,L),clipro d);\n end do:\n if not evalb(map(type,S1,cliprod)=\{true\}) then\n error \"encountered unexpected 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 union \{op(f)\} else S2:=S2 union \{`B `\} end if:\n end do:\nend if:\nif nops(S2)>1 then\n error \"optio nal (or default B) parameter in climul differs from indices encountere d in its cliprod arguments. Found these names as indices of &C: %1\",S 2\nend if:\n########################################\nif not flagindex ed then\n p:=map(clieval,[args2]);\n p:=Clifford:-cmul(op(p));\nel se \n p:=map(clieval[lname],[args2]);\n p:=Clifford:-cmul[lname](o p(p));\nend if:\nif not has([args2],`&C`) then return Clifford:-clisor t(p) else\n return cliexpand(p,lname);\nend if:\nend proc:\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 3065 "clirev:=proc(a1) local p,lname,fl agindexed,S1,S2,L,f;\noptions `Copyright (c) 1995-2008 by Rafal Ablamo wicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last r evised: December 20, 2007`;\n######################################### ####\n#######################################\nif type(a1,cliscalar) t hen return a1 end if:\n#######################################\nif nar gs=1 then\n lname:=`B`;\n flagindexed:=false:\nelif nargs=2 and \ntype(args[2],\{symbol,name,array,matrix,`&*`(numeric,\{name,symbol,m atrix,array\})\}) then\n lname:=args[2];\n flagindexed:=true:\ne lse error \"only one or two arguments are expected\"\nend if:\n####### ###################################################################### #######\n### Since many different indices to &C are allowed, we must c heck if the optional # \n### parameter X, whose default value is B, i s 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 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 '*' type \+ only in arguments of clirev 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 \"encountered unexpected \+ type among arguments of clirev\"\n end if:\n S1:=\{seq(op(0,f),f=S 1)\};\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 n ops(S2)>1 then\n error \"optional (or default B) parameter in clirev differs from indices encountered in its cliprod arguments. Found thes e names as indices of &C: %1\",S2\nend if:\n########################## ##############\nif not has([args[1]],`&C`) then return Clifford:-rever sion(args[1],lname) end if:\n######################################## \nif type(args[1],\{`+`,`*`\}) then return map(clirev,args[1],lname) e nd 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, une valuated Clifford products\n#### of Grassmann elements are present. Th at is, when mixed bases are used. Then, we\n#### apply clieval (to con vert to pure Grassmann basis), then apply cliexpand (to\n#### convert \+ back to Clifford basis only) and then re-enter clirev with the revised \n#### argument. \n########################################\nif not ev alb( map(nops,map(extract, convert(L,set) ))=\{1\}) then\n p:=cliexp and(clieval(args[1]),lname):## convert args[1] to Clifford basis only \n return clirev(p,lname) \nend if:\nif lname='B' then \n return ` &C`(op([seq(L[nops(L)-i+1],i=1..nops(L))]))\nelse \n return `&C`[lna me](op([seq(L[nops(L)-i+1],i=1..nops(L))]))\nend if:\nend proc:\n" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 1029 "dwedge:=proc(x::\{cliscalar,cliba smon,climon,clipolynom\},y::\{cliscalar,clibasmon,climon,clipolynom\}) local L,MatF,MatFT,out;\noptions `Copyright (c) 1995-2008 by Rafal Ab lamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `La st revised: December 20, 2007`;\n##################################### ########\nL:=[op(procname)];\nif type(L,list(procedure)) then\n erro r \"index is expected of type name, symbol, or antisymmatrix, e.g., dw edge[K](p1,p2), try ?dwedge for help\"\nend if:\nif not type(L,list(\{ matrix,array,name,symbol,`&*`(numeric,\{matrix,array,name,symbol\})\}) ) \nthen\nerror \"index must be matrix, array, name, symbol, or `&*`(n umeric,\{matrix,array,name,symbol\}\"\nend if:\nif type(L,list(\{matri x,array\})) then\n if not type(L,list(antisymmatrix)) then\n er ror \"matrix or array used for index must be antisymmetric\"\n end i f:\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 Clifford:-clicollect(out)\nend proc: \n" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 735 "dottedcbasis:=proc() local lname,L;\noption s `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Fauser. A ll rights reserved.`;\ndescription `Last revised: December 20, 2007`; \n#############################################\n if not type(op(pro cname),procedure) then \n lname:=op(procname);\n else\n er ror \"this procedure requires an index of type name, symbol, matrix, a rray\"\n end if:\n if type(lname,\{matrix,array\}) then\n if \+ not type(lname, antisymmatrix) then\n error \"index is expecte d to be an antisymmetric matrix or array, or, name or symbol\"\n fi \+ end if:\n L:=Clifford:-cbasis(args); #assign standard undotted Grass mann basis to L\n L:=map(convert,L,wedge_to_dwedge,lname);\n retur n L\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 5278 "setup:=proc() local x,y,i,j; global `convert/wedge_to_dwedge`,`convert/dwedge_to_we dge`,`&dw`;\noptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and \+ Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: D ecember 20, 2007`;\n#############################################\n`&d w`:=proc() local coB,nameB,lname,NP,decindex,ARGS,flagdec;global F:\no ptions `Copyright (c) 1995-2008 by Rafal Ablamowicz and Bertfried Faus er. All rights reserved.`;\ndescription `Last revised: December 20, 20 07`;\n#############################################\n################# ###################################################################\n# ## Works when &dw[''F''] or &dw[''-F''] is entered and F is an antisym metric matrix\n####################################################### #############################\nflagdec:=true:\nif type(op(procname),pr ocedure) 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 has been assigned an antisymmetric mat rix to avoid the following:`);\n return 'procname(args)'\n \+ end if:\n else coB:=1:\n nameB:=`F`:\n lname:=`F`:\n \+ ARGS:=[args]:\n flagdec:=false:\n end if:\nelse lname:=op(pro cname);\n ARGS:=[args];\n if type(lname,`&*`(numeric,name)) th en\n coB:=op(select(type,\{op(lname)\},numeric));\n na meB:=op(select(type,\{op(lname)\},name));\n else\n coB:=1: \n nameB:=lname:\n end if:\n flagdec:=false:\nend if: \n#######################################\ndecindex:=proc() local ARGS ,coB,nameB;global F;\nif type([args],listlist) then\n if type(op(arg s),function) then\n ARGS:=op(op(args));\n coB:=1:\n nam eB:=eval(op(0,op(args)));\n if type(nameB,`&*`(numeric,name)) the n\n coB:=op(select(type,\{op(nameB)\},numeric));\n nam eB:=op(select(type,\{op(nameB)\},name));\n end if:\n elif type( op(args),`&*`(numeric,function)) then\n nameB:=\{op(op(args))\}: \n coB:=op(select(type,nameB,numeric));\n nameB:=op(select(t ype,nameB,function));\n ARGS:=op(nameB);\n nameB:=op(0,nameB );\n else\n error \"unable to determine index from or wrong ind ex, use name in double quotes as in &dw[''F''] or &dw[''-F''] \"\n e nd if:\nelif\n type([args],list) then\n ARGS:=args;\n coB:=1:\n \+ nameB:=`F`; #default name \nelse\n error \"cannot determine argume nts and/or index from: %0\",args\nend if:\nreturn coB,nameB,[ARGS];\ne nd proc:\n#####################################\nif flagdec then \n \+ coB,nameB,ARGS:=decindex(args);\n lname:=coB*nameB;\nend if:\nNP:=no ps(ARGS);\nif member(0,ARGS) then return 0 end if:\nif NP <=1 then ret urn op(ARGS) end if:\nreturn dwedge[lname](op(ARGS))\nend proc:\n##### ########################################\n`convert/wedge_to_dwedge`:= \n proc(x::\{cliscalar,clibasmon,climon,clipolynom\},\n lname::\{sy mbol,name,array,matrix,`&*`(numeric,\{name,symbol,matrix,array\})\}) \+ \n local r1,r2;global B;\noptions `Copyright (c) 1995-2008 by Rafal \+ Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription ` Last revised: December 20, 2007`;\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 end if:\n if not type(lname,a ntisymmatrix) then\n error \"second argument must be an antisymme tric matrix or array\"\n end if: \nend if:\nreturn Cliplus:-clieval( subs(`&C`=Clifford:-wedge,Cliplus:-cliexpand(x,-lname)))\nend proc:\n# #############################################\n`convert/dwedge_to_wedg e`:=\n proc(x::\{cliscalar,clibasmon,climon,clipolynom\},\n lname ::\{symbol,name,array,matrix,`&*`(numeric,\{name,symbol,matrix,array\} )\}) \nlocal r1,r2;global B;\noptions `Copyright (c) 1995-2008 by Rafa l Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 20, 2007`;\n################################# ############\nif type(lname,\{array,matrix\}) then\n r1,r2:=op(2,eva l(args[2])):\n if not evalb(r1=r2) then \n error \"second argum ent must be a square matrix or array\"\n end if:\n if not type(lna me,antisymmatrix) then\n error \"second argument must be an antis ymmetric matrix or array\"\n end if:\nend if:\nreturn Cliplus:-cliev al(subs(`&C`=Clifford:-wedge,Cliplus:-cliexpand(x,-lname)))\nend proc: \n#############################################\nparse(\"macro(cmul=Cl iplus:-climul)\"); #'cmul' is now extended by 'climul' \nparse (\"macro(cmulQ=Cliplus:-climul)\"); #'cmulQ' is now extended by 'climul'\nparse(\"macro(`&c`=Cliplus:-climul)\"); #`&c` is no w 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(\"macr o(LC=Cliplus:-LCbig)\"); #'LC' is now extended by 'LCbig'\n parse(\"macro(RC=Cliplus:-RCbig)\"); #'RC' is now extended \+ by 'RCbig'\n\nconvert(LC,`global`);\nconvert(RC,`global`);\nprintf(\"C liplus has been loaded. Definitions for type/climon and type/clipolyno m now include &C and &C[K]. Type ?cliprod for help.\\n\");\n#WARNING(` definitions for type/climon and type/clipolynom now include &C and &C[ K]. Type ?cliprod for #help.`);\nprotect(Cliplus);\nend proc:" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 "end module:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 8 "libname;" }}{PARA 11 "" 1 "" {XPPMATH 20 "6&Q7C:\\Maple11/Cliffordlib6\"Q/C:\\Maple11/libF$Q1C:\\Ma ple11/SPlibF$Q-C:\\laylinalgF$" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 12 "savelibname;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 "savelib('Cl iplus'):" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#Q7C:\\Maple11/Cliffordlib6 \"" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 28 "march('listdir',libna me[1]);" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#7#7&QAC:\\Maple11/Cliffordl ib\\maple.lib6\"7(\"%2?\"#7\"#?\"#:\"#6\"#YQ)WRITABLEF&\"\"!" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 19 "with(LibraryTools);" }} {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" }}}{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)Define.mF&7(F(F)F*F+\"#9\"#d\"'Q.a\"$$[7&Q+matco mpL.mF&7(F(F)F*F+\"#8F@\"'D#[$\"&=X(7&Q+matcompR.mF&FF\"'VFU\"&^M(7&Q+ matquatL.mF&FF\"'%>'\\\"&9@#7&Q+matquatR.mF&FF\"'3$=&\"&I?#7&Q+matreal L.mF&FF\"'na6\"'9k67&Q+matrealR.mF&FF\"'\")=B\"'Wj6" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "" 0 "" {TEXT -1 30 "R evised December 20, 2007\n\nEnd" }}}}{MARK "7 0 0" 0 }{VIEWOPTS 1 1 0 1 1 1803 1 1 1 1 }{PAGENUMBERS 0 1 2 33 1 1 }