{VERSION 4 0 "IBM INTEL NT" "4.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 "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 "" 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 6" }{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, Cli<#>plus, 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 . 6 for Maple 6.\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: October 20, 2002\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 234 "Cliplus:=module()\n############### ##########\nexport makeclialiases,clibasis,cliexpand,LCbig,RCbig,cliev al,climul,clirev,\ndwedge,dottedcbasis;\n#########################\nlo cal 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,makeClibasmo n,s,lname,flagindexed;\noptions `Copyright (c) 1995-2003 by Rafal Abla mowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: November 1, 2002`;\n######################################## #####\nif not a1>1 then error \"first parameter must be a positive int eger larger than one\" end if:\nif nargs=2 and not member(a2,\{'ordere d',\"ordered\"\}) then\n error \"second optional parameter, when use d, must be 'ordered'\" 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#######################################\nL:=[seq(op(combina t[choose]([seq(i,i=1..a1)],k)),k=2..a1)];\nmakeClibasmon:=proc(a1) loc al 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 f lagindexed 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],ln ame),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 1491 "clibasis:=proc(n::nonnegint,a2::\{posint,symbol,s tring\}) \n local lname,k,fk,eL,L,newbasis,Lsort,l,feven,flag indexed;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Ber tfried Fauser. All rights reserved.`;\ndescription `Last revised: Nove mber 1, 2002`;\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 2248 "cliexpand :=proc(a::\{function,cliscalar,clibasmon,climon,clipolynom\}) global B ;\n local ind,sol,s,eq,lname,flagindexed;\noptions `Copyrigh t (c) 1995-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights r eserved.`;\ndescription `Last revised: November 1, 2002`;\n########### ##################################\n################################## ###############################################\n### This revised proc edure can take now optional parameter of type name, symbol,#\n### matr ix, 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, def ault 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 ret urn a end if:\n#######################################\n############## #########################\nif nargs=1 then\n lname:=`B`;\n flagi ndexed:=false:\nelif nargs=2 and\ntype(args[2],\{symbol,name,array,mat rix,`&*`(numeric,\{name,symbol,matrix,array\})\}) then\n lname:=arg s[2];\n flagindexed:=true:\nelse error \"only one or two arguments \+ are expected\"\nend if:\n#######################################\nif n ot type(a,clibasmon) then \n if not flagindexed then \n return \+ expand(map(procname,a))\n else\n return expand(map(procname,a,l name))\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 if not \+ flagindexed then \n return expand(map(procname,Clifford:-reorder( a))) \n else\n return expand(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 Cl ifford:-maxgrade(a)<4 then return sol \n else \n if not flagindexe d then \n return expand(map(procname,sol)) \n else\n retur n expand(map(procname,sol,lname)) \n end if:\nend if:\nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2252 "LCbig:=proc(x::\{cliscalar,clib asmon,climon,clipolynom,cliprod\},\n y::\{cliscalar,clibasm on,climon,clipolynom,cliprod\}) \n local a1,a2,flag,out,lname,fl agindexed,S1,S2,f,L;global B:\noptions `Copyright (c) 1995-2003 by Raf al Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescriptio n `Last revised: November 1, 2002`;\n################################# ############\n#######################################\nif nargs=2 then \n lname:=`B`;\n flagindexed:=false:\nelif nargs=3 and \ntype(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`[K] 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:=\{lname\}:\nS1:=\{\}:\nL:=select(hastype,\{args[1],args[2]\},cli prod);\nif L<>\{\} then\n while L<>\{\} do\n S1:=S1 union select (type,L,cliprod);\n L:=remove(type,L,cliprod);\n if L<>\{\} an d not evalb(map(type,L,\{`+`,`*`\})=\{true\}) then\n error \"ex pected '+' 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 \"e ncountered 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,indexe d) then S2:=S2 union \{op(f)\} else S2:=S2 union \{`B`\} end if:\n e nd do:\nend if:\nif nops(S2)>1 then\n error \"optional (or default B ) parameter in LCbig differs from indices encountered in its cliprod a rguments. Found these names as indices of &C: %1\",S2\nend if:\n###### ###############################\nflag:=false:\nif hastype(x,cliprod) t hen a1:=clieval(x); flag:=true; else a1:=x end if:\nif hastype(y,clipr od) then a2:=clieval(y); flag:=true; else a2:=y end if:\n############# ########################\nout:=Clifford:-LC(a1,a2,lname);\nif flag the n \n return cliexpand(out,lname)\nelse\n return out\nend if:\nend p roc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2231 "RCbig:=proc(x::\{clisca lar,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 `Copyright (c) 1995-200 3 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\nde scription `Last revised: November 1, 2002`;\n######################### ####################\n#######################################\nif narg s=2 then\n lname:=`B`;\n flagindexed:=false:\nelif nargs=3 and t ype(args[3],\{symbol,name,array,matrix,`&*`(numeric,\{symbol,name,arra y,matrix\})\}) 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 ch eck 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,clipr od);\n L:=remove(type,L,cliprod);\n if L<>\{\} and not evalb(m ap(type,L,\{`+`,`*`\})=\{true\}) then\n error \"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 e valb(map(type,S1,cliprod)=\{true\}) then\n error \"encountered un expected 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:=S 2 union \{op(f)\} else S2:=S2 union \{`B`\} end if:\n end do:\nend i f:\nif nops(S2)>1 then\n error \"optional (or default B) parameter i n RCbig differs from indices encountered in its cliprod arguments. Fou nd these names as indices of &C: %1\",S2\nend if:\n################### ##################\nflag:=false:\nif hastype(x,cliprod) then a1:=cliev al(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-2003 by Rafal Ablamowicz and Bertfrie d Fauser. All rights reserved.`;\ndescription `Last revised: November \+ 1, 2002`;\n#############################################\n############ ######\n### Works with `&C` and with `&C`[K]\n##################\np:=e val(eval(subs(`&C`=`&c`,args[1])));\np:=eval(p):\nreturn Clifford:-dis playid(expand(p)) \nend proc:\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2257 "climul:=proc() local p,p1,lname,flagindexed,S1,S2,L,f,args2,args 3,coB;\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertf ried Fauser. All rights reserved.`;\ndescription `Last revised: Novemb er 1, 2002`;\n#############################################\n######### ##############################\nif type([args],listlist) then\n if e valb(op(0,op(args))=`*`) then\n coB,args3:=op(op(args));\n l name:=coB*op(0,args3);\n args2:=op(args3);\n flagindexed:=tr ue:\n else\n lname:=op(0,op(args));\n args2:=op(op(args)); \n flagindexed:=true:\n end if:\nelif type(op(procname),procedu re) 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### parameter X, whos e default value is B, is the same in all arguments. # \n#### ###################################################################### ##########\nS2:=\{lname\}:\nS1:=\{\}:\nL:=select(hastype,\{args2\},cli prod);\nif L<>\{\} then\n while L<>\{\} do\n S1:=S1 union select (type,L,cliprod);\n L:=remove(type,L,cliprod);\n if L<>\{\} an d not evalb(map(type,L,\{`+`,`*`\})=\{true\}) then\n error \"ex pected '+' or '*' type 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(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,inde xed) 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 climul differs from indices encountered in its clipro d 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));\nend if: \nif not has([args2],`&C`) then return Clifford:-clisort(p) else\n r eturn 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-2003 by Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last revised: November 1 , 2002`;\n#############################################\n############# ##########################\nif type(a1,cliscalar) then return a1 end i f:\n#######################################\nif nargs=1 then\n lnam e:=`B`;\n flagindexed:=false:\nelif nargs=2 and\ntype(args[2],\{sym bol,name,array,matrix,`&*`(numeric,\{name,symbol,matrix,array\})\}) th en\n lname:=args[2];\n flagindexed:=true:\nelse error \"only one or two arguments are expected\"\nend if:\n########################### #########################################################\n### Since m any different indices to &C are allowed, we must check if the optional # \n### parameter X, whose default value is B, is the same in all ar guments. # \n############################################### #####################################\nS2:=\{lname\}:\nS1:=\{\}:\nL:=s elect(hastype,\{args\},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 \+ 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)=\{tr ue\}) then\n error \"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 er ror \"optional (or default B) parameter in clirev differs from indices encountered in its cliprod arguments. Found these names as indices of &C: %1\",S2\nend if:\n########################################\nif no t has([args[1]],`&C`) then return Clifford:-reversion(args[1],lname) e nd if:\n########################################\nif type(args[1],\{`+ `,`*`\}) then return map(clirev,args[1],lname) end if:\n############## ##########################\nif not type(args[1],cliprod) then return a rgs[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#### Check ing if elements like `&C`(e1we2,e1),that is, unevaluated Clifford prod ucts\n#### of Grassmann elements are present. That is, when mixed base s 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-enter clirev with the revised\n#### argument. \n### #####################################\nif not evalb( map(nops,map(extr act, convert(L,set) ))=\{1\}) then\n p:=cliexpand(clieval(args[1]),l name):## convert args[1] to Clifford basis only\n return clirev(p,ln ame) \nend if:\nif lname='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 1051 "dwedge:=proc(x::\{cliscalar,clibasmon,climon,clipol ynom\},\n y::\{cliscalar,clibasmon,climon,clipolynom\}) \n local L,MatF,MatFT,out;\noptions `Copyright (c) 1995-2003 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: November 1, 2002`;\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,l ist(\{matrix,array,name,symbol,`&*`(numeric,\{matrix,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(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_t o_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-2003 by Rafal Ablamowicz and Bertfried \+ Fauser. All rights reserved.`;\ndescription `Last revised: November 1, 2002`;\n#############################################\n if not type (op(procname),procedure) then \n lname:=op(procname);\n else\n \+ error \"this procedure requires an index of type name, symbol, ma trix, 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 5216 "setup :=proc() local x,y,i,j;\nglobal `convert/wedge_to_dwedge`,`convert/dwe dge_to_wedge`,`&dw`;\noptions `Copyright (c) 1995-2003 by Rafal Ablamo wicz and Bertfried Fauser. All rights reserved.`;\ndescription `Last r evised: November 1, 2002`;\n########################################## ###\n`&dw`:=proc() local coB,nameB,lname,NP,decindex,ARGS,flagdec;glob al F:\noptions `Copyright (c) 1995-2003 by Rafal Ablamowicz and Bertfr ied Fauser. All rights reserved.`;\ndescription `Last revised: Novembe r 1, 2002`;\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-2003 by R afal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescript ion `Last revised: November 1, 2002`;\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-2003 by \+ Rafal Ablamowicz and Bertfried Fauser. All rights reserved.`;\ndescrip tion `Last revised: November 1, 2002`;\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#############################################\nmacro(Clifford:-cm ul=Cliplus:-climul); #'cmul' is now extended by 'climul' \nmac ro(Clifford:-cmulQ=Cliplus:-climul); #'cmulQ' is now extended b y 'climul'\nmacro(`&c`=Cliplus:-climul); #`&c` is now extended by 'climul'\nmacro(`&cQ`=Cliplus:-climul); #`&cQ` is now exten ded by 'climul'\nmacro(Clifford:-reversion=Cliplus:-clirev); #'reve rsion' is now extended by 'clirev'\nmacro(Clifford:-LC=Cliplus:-LCbig) ; #'LC' is now extended by 'LCbig'\nmacro(Clifford:-RC=Clip lus:-RCbig); #'RC' is now extended by 'RCbig'\nprintf(\"Cli plus has been loaded. Definitions for type/climon and type/clipolynom \+ now include &C and &C[K]. Type ?cliprod for help.\\n\");\n#WARNING(`de finitions 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'):" }}{PARA 6 "" 1 "" {TEXT -1 122 " Cliplus has been loaded. Definitions for type/climon and type/clipolyn om now include &C and &C[K]. Type ?cliprod for help." }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "" 0 "" {TEXT -1 16 "Revised 1 0-20-02" }}{PARA 0 "" 0 "" {TEXT -1 0 "" }{MPLTEXT 1 0 0 "" }}}}{MARK "0 1 0" 1092 }{VIEWOPTS 1 1 0 1 1 1803 1 1 1 1 }{PAGENUMBERS 0 1 2 33 1 1 }