{VERSION 5 0 "IBM INTEL NT" "5.0" } {USTYLETAB {CSTYLE "Maple Input" -1 0 "Courier" 0 1 255 0 0 1 0 1 0 0 1 0 0 0 0 1 }{CSTYLE "" -1 256 "" 1 14 0 0 0 0 0 1 0 0 0 0 0 0 0 0 } {PSTYLE "Normal" -1 0 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }{PSTYLE "" 0 256 1 {CSTYLE " " -1 -1 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }3 0 0 -1 -1 -1 0 0 0 0 0 0 -1 0 }} {SECT 0 {EXCHG {PARA 256 "" 0 "" {TEXT 256 32 "Cliplus for Clifford an d Maple 8" }{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 554 "\nAdditional procedures to accompany CLIFFORD ver . 8 for Maple 8.\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: November 16, 2002\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " restart:" }}{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,cli eval,climul,clirev,\n dwedge,dottedcbasis;\n#################### #####\nlocal setup;\noption package, load=setup:\n#################### #####\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1568 "makeclialiases:=proc(a 1::posint,a2::\{symbol,string\}) \n local K,L,i,k,l,mak eClibasmon,s,lname,flagindexed;\noptions `Copyright (c) 1995-2003 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: November 16, 2002`;\n############################## ###############\nif not a1>1 then error \"first parameter must be a po sitive integer larger than one\" end if:\nif nargs=2 and not member(a2 ,\{'ordered',\"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 \+ flagindexed:=false:\n else\n lname:=op(procname);\n flagindex ed:=true:\nend if:\n#######################################\nL:=[seq(o p(combinat[choose]([seq(i,i=1..a1)],k)),k=2..a1)];\nmakeClibasmon:=pro c(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 p roc:\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]))=makeClibasmo n(K[i],lname),i=1..nops(K))\n end if:\nelse\n if not flagindexed t hen\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..no ps(L))\n end if:\nend if:\nreturn 'alias'(s)\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1492 "clibasis:=proc(n::nonnegint,a2::\{posin t,symbol,string\}) \n local lname,k,fk,eL,L,newbasis,Lsort,l, feven,flagindexed;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowi cz and Bertfried Fauser. All rights reserved.`;\ndescription `Last rev ised: November 16, 2002`;\n########################################### ##\nif n=0 then return [Id] end if:\n################################# ######\nif type(op(procname),procedure) then\n lname:=`B`;\n fla gindexed:=false:\n else\n lname:=op(procname);\n flagindexed:=t rue:\nend if:\n#######################################\neL:=[e||(1..n) ];\nL:=map(sort,combinat[powerset](eL));\nLsort:=proc(l1::list,l2::lis t) 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(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 arg ument must be 'even' or a non negative integer less than or equal to t he first argument\"\nend if:\nend if:\nnewbasis:=[]:\nfor l in L do\ni f nops(l)=0 then newbasis:=[op(newbasis),Id] elif\n nops(l)=1 then n ewbasis:=[op(newbasis),op(l)] else\n if flagindexed then \n new basis:=[op(newbasis),eval(`&C`[lname](op(l)))]\n else\n newbasi s:=[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 2249 "cliexpand:=proc(a::\{function,cliscalar,clibasmon,climon,clipolynom\} ) global B;\n local ind,sol,s,eq,lname,flagindexed;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. Al l rights reserved.`;\ndescription `Last revised: November 16, 2002`;\n #############################################\n####################### ##########################################################\n### This r evised 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 w ill return #\n### indexed cliprods like &C[K]. Without the extra par ameter, default form B is #\n### used. Thus, &C[B] means the same thin g 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 flagindexed:=false:\nelif nargs=2 and\ntype(args[2],\{symbol,na me,array,matrix,`&*`(numeric,\{name,symbol,matrix,array\})\}) then\n \+ lname:=args[2];\n flagindexed:=true:\nelse error \"only one or tw o 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,'integers'):\nif member(nops(in d),\{0,1\}) then return a end if:\nif not Clifford:-reorder(a)=a then \+ \n if not flagindexed then \n return expand(map(procname,Cliffo rd:-reorder(a))) \n else\n return expand(map(procname,Clifford: -reorder(a),lname)) \n end if:\nend if:\ns:=op(ind):\nif not flagind exed 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(e q,a);\nif Clifford:-maxgrade(a)<4 then return sol \n else \n if no t flagindexed then \n return expand(map(procname,sol)) \n else \n return expand(map(procname,sol,lname)) \n end if:\nend if:\n end proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2253 "LCbig:=proc(x::\{c liscalar,clibasmon,climon,clipolynom,cliprod\},\n y::\{clis calar,clibasmon,climon,clipolynom,cliprod\}) \n local a1,a2,flag ,out,lname,flagindexed,S1,S2,f,L;global B:\noptions `Copyright (c) 199 5-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.` ;\ndescription `Last revised: November 16, 2002`;\n################### ##########################\n#######################################\ni f nargs=2 then\n lname:=`B`;\n flagindexed:=false:\nelif nargs=3 and \ntype(args[3],\{symbol,name,array,matrix,`&*`(numeric,\{symbol,n ame,array,matrix\})\}) then\n lname:=args[3];\n flagindexed:=tru e:\nelse error \"only two or three arguments are expected\"\nend if:\n ###################################################################### ###################\n### Since many different indices to `&C`[K] are a llowed, we must check if the optional # \n### parameter X, whose defa ult 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:=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 LCbig but re ceived %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 LCbig\"\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 LCbig differs from indices encountered in its cliprod arguments. Found these names as indices of &C: %1\",S2\ne nd if:\n#####################################\nflag:=false:\nif hastyp e(x,cliprod) then a1:=clieval(x); flag:=true; else a1:=x end if:\nif h astype(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 2232 "RCbig:= proc(x::\{cliscalar,clibasmon,climon,clipolynom,cliprod\},\n \+ 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-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: November 16, 2002`;\n######## #####################################\n############################### ########\nif nargs=2 then\n lname:=`B`;\n flagindexed:=false:\ne lif nargs=3 and type(args[3],\{symbol,name,array,matrix,`&*`(numeric, \{symbol,name,array,matrix\})\}) then\n lname:=args[3];\n flagin dexed:=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 def ault 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 err or \"expected '+' 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 er ror \"encountered unexpected type among arguments of RCbig\"\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 RCbig 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:-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 405 "clieval:=proc(a: :algebraic) local p; \noptions `Copyright (c) 1995-2003 by Rafal Ablam owicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last \+ revised: November 16, 2002`;\n######################################## #####\n##################\n### Works with `&C` and with `&C`[K]\n##### #############\np:=eval(eval(subs(`&C`=`&c`,args[1])));\np:=eval(p):\nr eturn Clifford:-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-2003 by Rafal Ablam owicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last \+ revised: November 16, 2002`;\n######################################## #####\n#######################################\nif type([args],listlis t) 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 args 2:=op(op(args));\n flagindexed:=true:\n end if:\nelif type(op(p rocname),procedure) then\n lname:=`B`;\n flagindexed:=false:\n args2:=args:\nelse\n lname:=op(procname);\n flagindexed:=tr ue:\n args2:=args:\nend if:\n###################################### ##############################################\n### Since many differe nt indices to &C are allowed, we must check if the optional # \n### p arameter X, whose default value is B, is the same in all arguments. \+ # \n########################################################## ##########################\nS2:=\{lname\}:\nS1:=\{\}:\nL:=select(hasty pe,\{args2\},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 climul but received %1\",L \n end if:\n L:=select(hastype,map(op,L),clip rod);\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 \"opt ional (or default B) parameter in climul differs from indices encounte red in its cliprod arguments. Found these names as indices of &C: %1\" ,S2\nend if:\n########################################\nif not flagind exed then\n p:=map(clieval,[args2]);\n p:=Clifford:-cmul(op(p));\n else \n p:=map(clieval[lname],[args2]);\n p:=Clifford:-cmul[lname] (op(p));\nend if:\nif not has([args2],`&C`) then return Clifford:-clis ort(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-2003 by Rafal Ablamo wicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last r evised: November 16, 2002`;\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 1052 "dwedge:=proc(x::\{cliscalar,cliba smon,climon,clipolynom\},\n y::\{cliscalar,clibasmon,climo n,clipolynom\}) \n local L,MatF,MatFT,out;\noptions `Copyright \+ (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights res erved.`;\ndescription `Last revised: November 16, 2002`;\n############ #################################\nL:=[op(procname)];\nif type(L,list( procedure)) then\n error \"index is expected of type name, symbol, o r antisymmatrix, e.g., dwedge[K](p1,p2), try ?dwedge for help\"\nend i f:\nif not type(L,list(\{matrix,array,name,symbol,`&*`(numeric,\{matri x,array,name,symbol\})\})) \nthen\nerror \"index must be matrix, array , name, symbol, or `&*`(numeric,\{matrix,array,name,symbol\}\"\nend if :\nif type(L,list(\{matrix,array\})) then\n if not type(L,list(antis ymmatrix)) 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:-wed ge(op(L)),dwedge_to_wedge,-MatFT);\nreturn Clifford:-clicollect(out)\n end proc: \n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 735 "dottedcbasis:=proc () local lname,L;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowic z and Bertfried Fauser. All rights reserved.`;\ndescription `Last revi sed: November 16, 2002`;\n############################################ #\n if not type(op(procname),procedure) then \n lname:=op(procn ame);\n else\n error \"this procedure requires an index of type name, symbol, matrix, 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 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 5278 "setup:=proc() local x,y,i,j;\nglobal `convert/wedge _to_dwedge`,`convert/dwedge_to_wedge`,`&dw`;\noptions `Copyright (c) 1 995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved .`;\ndescription `Last revised: November 16, 2002`;\n################# ############################\n`&dw`:=proc() local coB,nameB,lname,NP,d ecindex,ARGS,flagdec;global F:\noptions `Copyright (c) 1995-2003 by Ra fal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescripti on `Last revised: November 16, 2002`;\n############################### ##############\n###################################################### ##############################\n### Works when &dw[''F''] or &dw[''-F' '] is entered and F is an antisymmetric matrix\n###################### ##############################################################\nflagde c:=true:\nif type(op(procname),procedure) then\n if type([args],list list) then\n if type(op(args),array) then\n WARNING(`encl ose index in double quotes as in &dw[''F''] or &c[''-F''] when F has b een assigned an antisymmetric 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:=fals e:\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)\},nam e));\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],l istlist) then\n if type(op(args),function) then\n ARGS:=op(op(a rgs));\n coB:=1:\n nameB:=eval(op(0,op(args)));\n if ty pe(nameB,`&*`(numeric,name)) then\n coB:=op(select(type,\{op(n ameB)\},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,nume ric));\n nameB:=op(select(type,nameB,function));\n ARGS:=op( nameB);\n nameB:=op(0,nameB);\n else\n error \"unable to d etermine index from or wrong index, use name in double quotes as in &d w[''F''] or &dw[''-F''] \"\n end if:\nelif\n type([args],list) the n\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,[ARGS];\nend proc:\n############################ #########\nif flagdec then \n coB,nameB,ARGS:=decindex(args);\n ln ame:=coB*nameB;\nend if:\nNP:=nops(ARGS);\nif member(0,ARGS) then retu rn 0 end if:\nif NP <=1 then return op(ARGS) end if:\nreturn dwedge[ln ame](op(ARGS))\nend proc:\n########################################### ##\n`convert/wedge_to_dwedge`:=\n proc(x::\{cliscalar,clibasmon,climo n,clipolynom\},\n lname::\{symbol,name,array,matrix,`&*`(numeric,\{n ame,symbol,matrix,array\})\}) \n local r1,r2;global B;\noptions `Cop yright (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rig hts reserved.`;\ndescription `Last revised: November 16, 2002`;\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-2003 by Rafal Ablamowicz and Bertfried Fauser. All r ights reserved.`;\ndescription `Last revised: November 16, 2002`;\n### ##########################################\nif type(lname,\{array,matr ix\}) then\n r1,r2:=op(2,eval(args[2])):\n if not evalb(r1=r2) the n \n error \"second argument must be a square matrix or array\"\n end if:\n if not type(lname,antisymmatrix) then\n error \"se cond argument must be an antisymmetric matrix or array\"\n end if:\n end if:\nreturn Cliplus:-clieval(subs(`&C`=Clifford:-wedge,Cliplus:-cl iexpand(x,-lname)))\nend proc:\n###################################### #######\nparse(\"macro(cmul=Cliplus:-climul)\"); #'cmul' is no w extended by 'climul' \nparse(\"macro(cmulQ=Cliplus:-climul)\"); \+ #'cmulQ' is now extended by 'climul'\nparse(\"macro(`&c`=Cliplus:-c limul)\"); #`&c` is now extended by 'climul'\nparse(\"macro(`& cQ`=Cliplus:-climul)\"); #`&cQ` is now extended by 'climul'\npa rse(\"macro(reversion=Cliplus:-clirev)\"); #'reversion' is now exte nded 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`);\ncon vert(RC,`global`);\nprintf(\"Cliplus has been loaded. Definitions for \+ type/climon and type/clipolynom now include &C and &C[K]. Type ?clipro d for help.\\n\");\n#WARNING(`definitions for type/climon and type/cli polynom 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('Cliplu s'):" }}}{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 }