{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 "" -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 32 "Cliplus for Clifford an d Maple 9" }{TEXT -1 1 "\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1092 "### ###################################################################### ####\n# \+ #\n#DISCLAIMER: \+ #\n# \+ #\n#THERE IS NO WARRANTY FOR THE CLIFFOR D, BIGEBRA, Cliplus, Octonion, GTP #\n#PACKAGES TO THE EXTENT PERM ITTED 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 552 "\nAdditional procedures to accompany CLIFFORD ver . 9 for Maple 9.\n\nThis version of the package contains revised proce dures which can take extra parameter or index: \n\ncliexpand(p,K);\ncl imul[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,p 2,...,pn);\n\nProcedure 'clieval' doesn't require an extra parameter s ince it converts Clifford polynomials expressed in Clifford bases such as `&C`[X] for various forms X and converts to Grassmann basis.\n\nLa st revised: December 1, 2003\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 "re start:" }}{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 1567 "makeclialiases:=proc(a1: :posint,a2::\{symbol,string\}) \n local K,L,i,k,l,makeC libasmon,s,lname,flagindexed;\noptions `Copyright (c) 1995-2004 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescriptio n `Last revised: December 1, 2003`;\n################################# ############\nif not a1>1 then error \"first parameter must be a posit ive integer larger than one\" end if:\nif nargs=2 and not member(a2,\{ 'ordered',\"ordered\"\}) then\n error \"second optional parameter, w hen used, must be 'ordered'\" end if:\n############################### ########\nif type(op(procname),procedure) then\n lname:=`B`;\n f lagindexed:=false:\n else\n lname:=op(procname);\n flagindexed: =true:\nend if:\n#######################################\nL:=[seq(op(c ombinat[choose]([seq(i,i=1..a1)],k)),k=2..a1)];\nmakeClibasmon:=proc(a 1) 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 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 e lse\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 1491 "clibasis:=proc(n::nonnegint,a2::\{posint,sy mbol,string\}) \n local lname,k,fk,eL,L,newbasis,Lsort,l,feve n,flagindexed;\noptions `Copyright (c) 1995-2004 by Rafal Ablamowicz a nd Bertfried Fauser. All rights reserved.`;\ndescription `Last revised : December 1, 2003`;\n#############################################\ni f n=0 then return [Id] end if:\n###################################### #\nif type(op(procname),procedure) then\n lname:=`B`;\n flaginde xed:=false:\n else\n lname:=op(procname);\n flagindexed:=true: \nend if:\n#######################################\neL:=[e||(1..n)];\n L:=map(sort,combinat[powerset](eL));\nLsort:=proc(l1::list,l2::list) i f nops(l1)>nops(l2) then false else true end if end proc:\nL:=sort(L,L sort);\nif nargs=2 then\n if args[2]='even' then\nfeven:=proc(l::lis t) if type(nops(l),even) then true else false end if end proc:\nL:=sel ect(feven,L);\n elif type(args[2],nonnegint) and args[2]<=args[1] th en\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 argumen t must be 'even' or a non negative integer less than or equal to the f irst argument\"\nend if:\nend if:\nnewbasis:=[]:\nfor l in L do\nif no ps(l)=0 then newbasis:=[op(newbasis),Id] elif\n nops(l)=1 then newba sis:=[op(newbasis),op(l)] else\n if flagindexed then \n newbasi s:=[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:\nre turn newbasis\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2248 "cli expand:=proc(a::\{function,cliscalar,clibasmon,climon,clipolynom\}) gl obal B;\n local ind,sol,s,eq,lname,flagindexed;\noptions `Co pyright (c) 1995-2004 by Rafal Ablamowicz and Bertfried Fauser. All ri ghts reserved.`;\ndescription `Last revised: December 1, 2003`;\n##### ########################################\n############################ #####################################################\n### This revise d procedure 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 r eturn #\n### indexed cliprods like &C[K]. Without the extra paramete r, 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 type(a,\{cliscalar,function\}) th en return a end if:\n#######################################\n######## ###############################\nif nargs=1 then\n lname:=`B`;\n \+ flagindexed:=false:\nelif nargs=2 and\ntype(args[2],\{symbol,name,arr ay,matrix,`&*`(numeric,\{name,symbol,matrix,array\})\}) then\n lnam e:=args[2];\n flagindexed:=true:\nelse error \"only one or two argu ments are expected\"\nend if:\n####################################### \nif not type(a,clibasmon) then \n if not flagindexed then \n r eturn expand(map(procname,a))\n else\n return expand(map(procna me,a,lname))\n end if: \nend if:\n################################# ######\nind:=Clifford:-extract(a,'integers'):\nif member(nops(ind),\{0 ,1\}) then return a end if:\nif not Clifford:-reorder(a)=a then \n i f not flagindexed then \n return expand(map(procname,Clifford:-re order(a))) \n else\n return expand(map(procname,Clifford:-reord er(a),lname)) \n end if:\nend if:\ns:=op(ind):\nif not flagindexed t hen \n eq:=`&C`(e||s)=Clifford:-cmul(e||(s));\nelse \n eq:=`&C`[ln ame](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 fla gindexed then \n return expand(map(procname,sol)) \n else\n \+ return expand(map(procname,sol,lname)) \n end if:\nend if:\nend pr oc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2252 "LCbig:=proc(x::\{cliscal ar,clibasmon,climon,clipolynom,cliprod\},\n y::\{cliscalar, clibasmon,climon,clipolynom,cliprod\}) \n local a1,a2,flag,out,l name,flagindexed,S1,S2,f,L;global B:\noptions `Copyright (c) 1995-2004 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndes cription `Last revised: December 1, 2003`;\n########################## ###################\n#######################################\nif nargs =2 then\n lname:=`B`;\n flagindexed:=false:\nelif nargs=3 and \n type(args[3],\{symbol,name,array,matrix,`&*`(numeric,\{symbol,name,arr ay,matrix\})\}) then\n lname:=args[3];\n flagindexed:=true:\nels e 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 val ue 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 err or \"expected '+' 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 er ror \"encountered unexpected type among arguments of LCbig\"\n end i f:\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 de fault B) parameter in LCbig differs from indices encountered in its cl iprod arguments. Found these names as indices of &C: %1\",S2\nend if: \n#####################################\nflag:=false:\nif hastype(x,cl iprod) 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 2231 "RCbig:=proc(x:: \{cliscalar,clibasmon,climon,clipolynom,cliprod\},\n y::\{c liscalar,clibasmon,climon,clipolynom,cliprod\}) \n local a1,a2,f lag,out,lname,flagindexed,S1,S2,f,L;global B:\noptions `Copyright (c) \+ 1995-2004 by Rafal Ablamowicz and Bertfried Fauser. All rights reserve d.`;\ndescription `Last revised: December 1, 2003`;\n################# ############################\n####################################### \nif nargs=2 then\n lname:=`B`;\n flagindexed:=false:\nelif narg s=3 and type(args[3],\{symbol,name,array,matrix,`&*`(numeric,\{symbol, name,array,matrix\})\}) then\n lname:=args[3];\n flagindexed:=tr ue:\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 valu e 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(typ e,L,cliprod);\n L:=remove(type,L,cliprod);\n if L<>\{\} and no t evalb(map(type,L,\{`+`,`*`\})=\{true\}) then\n error \"expect ed '+' 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 \"encou ntered 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,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 RCbig 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:-RC(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 404 "clieval:=proc(a::algebraic) local p; \noptions `Copyright (c) 1995-2004 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: De cember 1, 2003`;\n#############################################\n##### #############\n### Works with `&C` and with `&C`[K]\n################# #\np:=eval(eval(subs(`&C`=`&c`,args[1])));\np:=eval(p):\nreturn Cliffo rd:-displayid(expand(p)) \nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2257 "climul:=proc() local p,p1,lname,flagindexed,S1,S2,L,f,args2, args3,coB;\noptions `Copyright (c) 1995-2004 by Rafal Ablamowicz and B ertfried Fauser. All rights reserved.`;\ndescription `Last revised: De cember 1, 2003`;\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(arg s));\n flagindexed:=true:\n end if:\nelif type(op(procname),pro cedure) then\n lname:=`B`;\n flagindexed:=false:\n args2:= args:\nelse\n lname:=op(procname);\n flagindexed:=true:\n arg s2:=args:\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,\{args2\} ,cliprod);\nif L<>\{\} then\n while L<>\{\} do\n S1:=S1 union se lect(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 received % 1\",L \n end if:\n L:=select(hastype,map(op,L),cliprod);\n e nd do:\n if not evalb(map(type,S1,cliprod)=\{true\}) then\n err or \"encountered unexpected type among arguments of climul\"\n end i f:\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 de fault B) parameter in climul differs from indices encountered in its c liprod arguments. Found these 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],[args2]);\n p:=Clifford:-cmul[lname](op(p));\nen d if:\nif not has([args2],`&C`) then return Clifford:-clisort(p) else \n return cliexpand(p,lname);\nend if:\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3064 "clirev:=proc(a1) local p,lname,flagindexed,S1, S2,L,f;\noptions `Copyright (c) 1995-2004 by Rafal Ablamowicz and Bert fried Fauser. All rights reserved.`;\ndescription `Last revised: Decem ber 1, 2003`;\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 \"on ly one or two arguments are expected\"\nend if:\n##################### ###############################################################\n### S ince many different indices to &C are allowed, we must check if the op tional # \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 select(type,L,cliprod);\n L:=remove(typ e,L,cliprod);\n if L<>\{\} and not evalb(map(type,L,\{`+`,`*`\})= \{true\}) then\n error \"expected '+' or '*' type only in argum ents of clirev but received %1\",L \n end if:\n L:=select(hast ype,map(op,L),cliprod);\n end do:\n if not evalb(map(type,S1,clipr od)=\{true\}) then\n error \"encountered unexpected type among ar guments 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)\} els e S2:=S2 union \{`B`\} end if:\n end do:\nend if:\nif nops(S2)>1 the n\n error \"optional (or default B) parameter in clirev differs from indices encountered in its cliprod arguments. Found these names as in dices 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: #Neede d for ((e1 &C e2) &C e3)\n########################################\n## ## Checking if elements like `&C`(e1we2,e1),that is, unevaluated Cliff ord products\n#### of Grassmann elements are present. That is, when mi xed bases are used. Then, we\n#### apply clieval (to convert to pure G rassmann basis), then apply cliexpand (to\n#### convert back to Cliffo rd basis only) and then re-enter clirev with the revised\n#### argumen t. \n########################################\nif not evalb( map(nops, map(extract, convert(L,set) ))=\{1\}) then\n p:=cliexpand(clieval(ar gs[1]),lname):## convert args[1] to Clifford basis only\n return cli rev(p,lname) \nend if:\nif lname='B' then \n return `&C`(op([seq(L[n ops(L)-i+1],i=1..nops(L))]))\nelse \n return `&C`[lname](op([seq(L[n ops(L)-i+1],i=1..nops(L))]))\nend if:\nend proc:\n" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 1051 "dwedge:=proc(x::\{cliscalar,clibasmon,climon,clip olynom\},\n y::\{cliscalar,clibasmon,climon,clipolynom\}) \+ \n local L,MatF,MatFT,out;\noptions `Copyright (c) 1995-2004 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescri ption `Last revised: December 1, 2003`;\n############################# ################\nL:=[op(procname)];\nif type(L,list(procedure)) then \n error \"index is expected of type name, symbol, or antisymmatrix, e.g., dwedge[K](p1,p2), try ?dwedge for help\"\nend if:\nif not type( L,list(\{matrix,array,name,symbol,`&*`(numeric,\{matrix,array,name,sym bol\})\})) \nthen\nerror \"index must be matrix, array, name, symbol, \+ or `&*`(numeric,\{matrix,array,name,symbol\}\"\nend if:\nif type(L,lis t(\{matrix,array\})) then\n if 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,[ar gs],wedge_to_dwedge,-MatF);\nout:=convert(Clifford:-wedge(op(L)),dwedg e_to_wedge,-MatFT);\nreturn Clifford:-clicollect(out)\nend proc: \n" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 734 "dottedcbasis:=proc() local lname, L;\noptions `Copyright (c) 1995-2004 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: December 1 , 2003`;\n#############################################\n if not typ e(op(procname),procedure) then \n lname:=op(procname);\n else\n error \"this procedure requires an index of type name, symbol, m atrix, array\"\n end if:\n if type(lname,\{matrix,array\}) then\n \+ if not type(lname, antisymmatrix) then\n error \"index is expected to be an antisymmetric matrix or array, or, name or symbol\" \n fi end if:\n L:=Clifford:-cbasis(args); #assign standard undott ed 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 5274 "setup :=proc() local x,y,i,j;\nglobal `convert/wedge_to_dwedge`,`convert/dwe dge_to_wedge`,`&dw`;\noptions `Copyright (c) 1995-2004 by Rafal Ablamo wicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last r evised: December 1, 2003`;\n########################################## ###\n`&dw`:=proc() local coB,nameB,lname,NP,decindex,ARGS,flagdec;glob al F:\noptions `Copyright (c) 1995-2004 by Rafal Ablamowicz and Bertfr ied Fauser. All rights reserved.`;\ndescription `Last revised: Decembe r 1, 2003`;\n#############################################\n########## ###################################################################### ####\n### Works when &dw[''F''] or &dw[''-F''] is entered and F is an \+ antisymmetric matrix\n################################################ ####################################\nflagdec:=true:\nif type(op(procn ame),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 has been assigned an antisymmet ric matrix 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(procname);\n ARGS:=[args];\n if type(lname,`&*`(numeric,na me)) 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 end if:\n flagdec:=false:\ne nd if:\n#######################################\ndecindex:=proc() loca l ARGS,coB,nameB;global F;\nif type([args],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 if type(nameB,`&*`(numeric,name )) then\n coB:=op(select(type,\{op(nameB)\},numeric));\n \+ nameB:=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(sel ect(type,nameB,function));\n ARGS:=op(nameB);\n nameB:=op(0, nameB);\n else\n error \"unable to determine index from or wron g 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\nend if:\nreturn coB,nameB,[ARG S];\nend proc:\n#####################################\nif flagdec then \n coB,nameB,ARGS:=decindex(args);\n lname:=coB*nameB;\nend if:\n NP:=nops(ARGS);\nif member(0,ARGS) then return 0 end if:\nif NP <=1 th en return op(ARGS) end if:\nreturn dwedge[lname](op(ARGS))\nend proc: \n#############################################\n`convert/wedge_to_dwe dge`:=\n proc(x::\{cliscalar,clibasmon,climon,clipolynom\},\n lname ::\{symbol,name,array,matrix,`&*`(numeric,\{name,symbol,matrix,array\} )\}) \n local r1,r2;global B;\noptions `Copyright (c) 1995-2004 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: December 1, 2003`;\n############################### ##############\nif type(lname,\{array,matrix\}) then\n r1,r2:=op(2,e val(lname)):\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:-clie val(subs(`&C`=Clifford:-wedge,Cliplus:-cliexpand(x,-lname)))\nend proc :\n##############################################\n`convert/dwedge_to_ wedge`:=\n proc(x::\{cliscalar,clibasmon,climon,clipolynom\},\n l name::\{symbol,name,array,matrix,`&*`(numeric,\{name,symbol,matrix,arr ay\})\}) \nlocal r1,r2;global B;\noptions `Copyright (c) 1995-2004 by \+ Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescrip tion `Last revised: December 1, 2003`;\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 ar gument must be a square matrix or array\"\n end if:\n if not type( lname,antisymmatrix) then\n error \"second argument must be an an tisymmetric matrix or array\"\n end if:\nend if:\nreturn Cliplus:-cl ieval(subs(`&C`=Clifford:-wedge,Cliplus:-cliexpand(x,-lname)))\nend pr oc:\n#############################################\nparse(\"macro(cmul =Cliplus:-climul)\"); #'cmul' is now extended by 'climul' \npa rse(\"macro(cmulQ=Cliplus:-climul)\"); #'cmulQ' is now extended by 'climul'\nparse(\"macro(`&c`=Cliplus:-climul)\"); #`&c` is now extended by 'climul'\nparse(\"macro(`&cQ`=Cliplus:-climul)\"); \+ #`&cQ` is now extended by 'climul'\nparse(\"macro(reversion=Clipl us:-clirev)\"); #'reversion' is now extended by 'clirev'\nparse(\"m acro(LC=Cliplus:-LCbig)\"); #'LC' is now extended by 'LCbig '\nparse(\"macro(RC=Cliplus:-RCbig)\"); #'RC' is now extend ed by 'RCbig'\n\nconvert(LC,`global`);\nconvert(RC,`global`);\nprintf( \"Cliplus has been loaded. Definitions for type/climon and type/clipol ynom now include &C and &C[K]. Type ?cliprod for help.\\n\");\n#WARNIN G(`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:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 "savelib('Cliplus'):" }}}{EXCHG {PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "" 0 "" {TEXT -1 16 "Revised 11-16-02" } }{PARA 0 "" 0 "" {TEXT -1 0 "" }{MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}}{MARK "1 2 1" 0 }{VIEWOPTS 1 1 0 1 1 1803 1 1 1 1 }{PAGENUMBERS 0 1 2 33 1 1 }