{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 "fixed" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 257 "fixed" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 258 "fix ed" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }{CSTYLE "" -1 259 "fixed" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }{PSTYLE "Normal" -1 0 1 {CSTYLE "" -1 -1 " " 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 }0 0 0 -1 -1 -1 0 0 0 0 0 0 -1 0 } {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 "Headi ng 1" 0 3 1 {CSTYLE "" -1 -1 "" 1 18 0 0 0 0 0 1 0 0 0 0 0 0 0 0 }1 0 0 0 8 4 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 "W arning" 2 7 1 {CSTYLE "" -1 -1 "" 0 1 0 0 255 1 0 0 0 0 0 0 1 0 0 0 } 0 0 0 -1 -1 -1 0 0 0 0 0 0 -1 0 }{PSTYLE "Maple Output" 0 11 1 {CSTYLE "" -1 -1 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }3 3 0 -1 -1 -1 0 0 0 0 0 0 -1 0 }{PSTYLE "" 11 12 1 {CSTYLE "" -1 -1 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }1 0 0 -1 -1 -1 0 0 0 0 0 0 -1 0 }{PSTYLE "List Item " 0 14 1 {CSTYLE "" -1 -1 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 }0 0 0 -1 3 3 0 0 0 0 0 0 14 5 }{PSTYLE "" 3 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 -1 19 "Bigebra_M9_1.01.mws" }} {PARA 0 "" 0 "" {TEXT -1 154 "Authors: Rafal Ablamowicz, Tennessee Te ch University, Cookeville TN, U.S.A\n Bertfried Faus er, University of Konstanz, Konstanz, Germany" }}{PARA 0 "" 0 "" {TEXT -1 41 "URL: http://math.tntech.edu/rafal/" }}{PARA 0 "" 0 "" {TEXT -1 76 "copyright (c) 1999-2004 by R. Ablamowicz and B. Faus er, all rights reserved." }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}{PARA 0 " " 0 "" {TEXT -1 106 "This file may be distributed and used for noncome rcial purpose unless the copyright remark is not removed." }}{PARA 0 " " 0 "" {TEXT -1 0 "" }}{PARA 0 "" 0 "" {TEXT -1 94 "This is the file B igebra_code.1.01.mws which contains the code of the recent Bigebra pac kage.\n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1092 "###################### #######################################################\n# \+ #\n#DIS CLAIMER: \+ #\n# \+ #\n#THERE IS NO WARRANTY FOR THE CLIFFORD, BIGEBRA, Cliplus , Octonion, GTP #\n#PACKAGES TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE #\n#STATED IN WRITING THE COPYRIGHT HOLDE RS AND/OR OTHER PARTIES PROVIDE THE #\n#PROGRAM \"AS IS\" WITHOUT WA RRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, #\n#INCLUDING, BUT NO T LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY #\n#AND FITN ESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY #\n #AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE \+ #\n#DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, R EPAIR OR #\n#CORRECTION. \+ #\n########################################### ##################################\n" }{TEXT -1 0 "" }}{PARA 0 "" 0 " " {TEXT 256 666 "###\n### Bigebra_M9_1.01.mws of Dec#-16-99 -- Oct-1 0-2002 BF/RA - Ported to Maple 9 on December 1, 2003\n###\n### VERSIO N 0.01 \n### \n### Copyright Rafal Ablamowicz(\247) & Bertfried Fauser(*)\n###\n### (\247) Department o f Mathematics, Box 5054\n### Tennessee Technological University\n ### Cookeville, TN 38505 \n### U.S.A.\n### rablamowicz@ tntech.edu\n### http://math.tntech.edu/rafal/\n###\n### (*) Univ ersit\"at Konstanz\n### Fachbereich Physik\n### Fach M678\n# ## 78457 Konstanz\n### Germany\n### Bertfried.Fauser@un i-konstanz.de\n### http://kaluza.physik.uni-konstanz.de/~fauser/ \+ \n###\n" }}{PARA 0 "" 0 "" {TEXT 259 518 "\n###\n### (c) Copyrig ht: Rafal Ablamowicz, Bertfried Fauser. All rights reserved.\n###\n### This software may be used by non profit organisations, in educat iion \n### and research, provided it is distrubuted with full sou rce and this header.\n### Commercial distribution need explicite \+ permission by the copyright holder.\n### It is prohibited to tran slate this software into other languages etc. \n###\n###\n### DISCLAI MER:\n###\n### This software comes as-is and without any guaratee. Us ing this software" }}{PARA 0 "" 0 "" {TEXT 257 154 "### may result in miscomputation, damages of your system or computer at your\n### risk . The autors do not take any responsibility. Nevertheless they made" } }{PARA 0 "" 0 "" {TEXT 258 60 "### any effort to provide useful and v aluabe code.\n###\n###\n" }}{PARA 0 "" 0 "" {TEXT -1 2 " " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 11 "res tart: \n\n" }{TEXT -1 263 "We start by defining a new module Bigebra w hich has the option package. Important things are\n-- The package is \+ executed on startup when loaded like any Maple code.\n-- Types have t o be made globaly available, hence they have to be defined in the star tup routine." }}{PARA 14 "" 0 "" {TEXT -1 0 "" }}{PARA 14 "> " 0 "" {MPLTEXT 1 0 29455 "Bigebra:=module()\n export `&gco`,`&gco_pl`,`&gc o_d`,make_BI_Id,`&cco`,\n gco_unit,switch,gswitch,peek,poke, `&v`,meet,\n tcollect,pairing,bracket,contract,gantipode,\n \+ `&map`,mapop,mapop2,tsolve1,EV,\n linop,op2mat,lis ts2mat,linop2,op2mat2,lists2mat2,\n VERSION,drop_t,remove_eq ,\n hodge,eps; \n global dim_V,`type/tensorbasmonom`, `type /tensormonom`, `type/tensorpolynom`;\n local gco_monom,gpl_co_monom ,gpl_co_monom2,co_d_monom,gco_d_monom,cco_monom, #F,\n init,e xit;\n # co_dec_monom2,co_map_monoms,co_map_monoms_t,co_tensor ,co_prod,cco_prod\n option package,\n load=init,\n un load=exit,\n `Copyright (c) Ablamowicz, Fauser 1999-2004. All \+ rights reserved.`; \n init:=proc()\n option `Copyright (c) Ablamo wicz, Fauser 1999-2004. All rights reserved.`;\n \n\n ################ ##################################################################\n # \+ #\n # predefine certain settings \+ #\n # \+ #\n ########################## ########################################################\n \n\n de fine(`&t`,flat,multilinear,domain=cliscalar): # predefine the tensor p roduct\n printf(\"Increase verbosity by infolevel[`function`]=val \+ -- use online help > ?Bigebra[help]\\n\");\n\n \n #################### ##############################################################\n # \+ \+ #\n # export types to toplevel namespace (polution, bahhh) \+ #\n # \+ #\n ############################## ####################################################\n ##\n ## No IN IT-1.\n ##\n `type/tensorbasmonom`:=proc(p)\n option `Copyright \+ (c) Ablamowicz, Fauser 1999-2004. All rights reserved.`; \n evalb (`&t`=op(0,p))\n end proc: # type/tensorbasmonom\n\n ##\n ## No INI T-2.\n ##\n `type/tensormonom`:=proc(p)\n option `Copyright (c) \+ Ablamowicz, Fauser 1999-2004. All rights reserved.`; \n if type(p ,`tensorbasmonom`) then return true fi; \n if type(p,`*`) and 1<>s elect(type,p,`tensorbasmonom`) then\n true;\n else\n f alse \n fi;\n end proc: # type/tensormonom\n\n ##\n ## No INIT- 3.\n ##\n `type/tensorpolynom`:=proc(p) \n option `Copyright (c) Ablamowicz, Fauser 1999-2004. All rights reserved.`; \n if type( p,`tensormonom`) then return true fi:\n if type(p,`+`) then \n \+ return evalb(map(type,\{op(p)\},tensormonom)=\{true\})\n else\n return false;\n fi\n end proc: # type/tensorpolynom\n ### ###################################################################### ########\nend proc: ### init\n\nexit:=proc()\n return \"Nice to have served you, .... hope to see you again!\";\nend proc; # exit \n\n\n ###################################################################### #############\n# \+ #\n# Here follow local functions \+ #\n# \+ #\n########## ###################################################################### ###\n\n##\n## No LOC-1. Grassmann product for points (vectors)\n##\ng co_monom:=proc(x,name)\n local fun,a,list1,list2,du1,du2,NL,NP,NR,vz ,i,j;\n global _CLIENV;\n option `Copyright (c) Ablamowicz, Fauser 1999-2004. All rights reserved.`;\n list1:=Clifford:-extract(x,inte gers):\n NL:=nops(list1);\n fun:=proc(a1) a1 end:\n for i from 1 to NL do\n fun(i):=list1[i];\n od:\n a:=[seq(i,i=1..NL)]:\n \+ list2:=[a]:\n for i in a do\n list2 := [op(subs(i = NULL,list2) ), op(list2)]:\n od:\n NP:=nops(list2)+1; ## added 1 here\n add ((_CLIENV[_QDEF_PREFACTOR])^(add(list2[i][j]-j,j=1..nops(list2[i])))* \+ \n `name`(Clifford:-makeclibasmon(map(fun,list2[i])),\n \+ Clifford:-makeclibasmon(map(fun,list2[NP-i]))),i=1..NP-1);\nend pro c: ### gco_monom\n\n\n##\n## No LOC-2. dotted Grassmann co-product on \+ Clifford polynoms \n##\n## (wrapper only)\n##\n############ ############################################\n## Changed matF to F and matFM to -F by Rafal/12-25-2001\n#################################### ####################\n`gco_d_monom`:=proc(x) \n local u;\n global \+ F,`convert/dwedge_to_wedge`,`convert/wedge_to_dwedge`; \n option `Co pyright (c) R. Ablamowicz, B. Fauser 1999-2004. All rights reserved.`; \n u := proc (z) convert(z,wedge_to_dwedge,F) end; \n mapop(mapo p(`&gco`(convert(x,dwedge_to_wedge,-F)),1,u),2,u) \nend:\n\n\n##\n## N o LOC-3. Grassmann co-product of hyperplanes \n##\ngpl_co_monom:=proc (x,name)\n local b,NL;\n global _CLIENV,dim_V;\n option `Copyrig ht (c) Ablamowicz, Fauser 1999-2004. All rights reserved.`;\n b:=&gc o(Clifford:-makeclibasmon([seq(i,i=1..dim_V)]));\n NL:=nops(Clifford :-extract(x));\n (-1)^((dim_V-1)*NL)*&map(name(b,x),2,Clifford:-wedg e);\nend proc: ### gpl_co_monom\n\n\n##\n## No LOC-4. Grassmann co-pro duct of hyperplanes ver2 (not in use) \n##\ngpl_co_monom2:=proc(x,name )\n local b,NL;\n global _CLIENV,dim_V;\n option `Copyright (c) \+ Ablamowicz, Fauser 1999-2004. All rights reserved.`;\n b:=&gco(Cliff ord:-makeclibasmon([seq(i,i=1..dim_V)]));\n NL:=nops(Clifford:-extra ct(x));\n &map(name(x,b),1,Clifford:-wedge);\nend proc: ### gpl_co_m onom2\n\n\n##\n## No LOC-4.\n##\ncco_monom:=proc(x)\n global BI_Id;\n local i,cf,term,res,a,b,lst,k;\n option `Copyright (c) Ablamowicz, \+ Fauser 1999-2004. All rights reserved.`;\n if type(x,clibasmon) then \n if x = Id then \n return add(BI_Id[i][1]*&t(BI_Id[i][2],BI_ Id[i][3]),i=1..nops(BI_Id));\n else\n res:=0:\n lst:=[op( &gco(x,1))];\n for k in lst do\n a,b:=peek(k,1);\n \+ res:=res+add(BI_Id[i][1]*&t(a,BI_Id[i][2],BI_Id[i][3],op(b)),i=1..nops (BI_Id)); \n od;\n return &map(&map(res,3,Clifford:-wedge),1 ,Clifford:-wedge);\n fi;\n elif type(x,climon) then\n cf,term:= select(type,x,`cliscalar`),remove(type,x,`cliscalar`);\n return exp and(cf*procname(term));\n elif type(x,clipolynom) then\n return ma p(procname,x); \n else\n error \"received unknown type in cco_m onom to process\";\n fi;\nend proc: # cco_monom\n\n\n################ ###################################################################\n# \+ #\n# Here follow exported function \+ #\n# \+ #\n########################## #########################################################\n\n##\n## No PACK-1.\n##\n`&gco`:=proc(x,i) \n local co,term,xx,a,b,c;\n optio n `Copyright (c) Ablamowicz, Fauser 1999-2004. All rights reserved.`; \n if type(x,clibasmon) then\n return gco_monom(x,`&t`);\n eli f type(x,climon) then\n co,term:=select(type,x,cliscalar),remove(t ype,x,cliscalar);\n return expand(co*gco_monom(term,`&t`));\n el if type(x,clipolynom) then\n return expand(map('procname',x));\n \+ elif type(x,tensorbasmonom) then\n if nops([op(x)]) = 1 then\n \+ return gco_monom(op(x),`&t`);\n fi;\n xx:=op(x);\n a:= xx[1..i-1];\n b:=xx[i];\n c:=xx[i+1..nops([xx])];\n return &t(a,gco_monom(b,`&t`),c);\n elif type(x,tensormonom) then\n co ,term:=remove(type,x,tensorbasmonom),select(type,x,tensorbasmonom);\n \+ return expand(co*procname(term,i));\n elif type(x,tensorpolynom) then\n return map('procname',x,i)\n else error \"wrong type in \+ &gco\"\n fi:\nend proc: ### &gco\n\n\n##\n## No PACK-2. meet (defini tion 1)\n##\n`&v`:=proc(x,y)\n local xx,res,lst,var_i,v1,v2;\n optio n `Copyright (c) Ablamowicz, Fauser 1999-2004. All rights reserved.`; \+ \n xx:=&gco(x,1);\n if op(0,xx) = `+` then\n lst:=[op(xx )];\n else\n lst:=[xx];\n fi;\n res:=0;\n for var_i in lst do\n v1,v2:=peek(var_i,1);\n res := res + v1*bracket(Clifford:-wedge (y,op(v2)));\n od;\n res;\nend proc: # &v\n\n\n##\n## No PACK-3. me et (definition 2)\n##\nmeet:=proc(x,y)\n local yy,res,lst,var_i,v1,v2 ;\n option `Copyright (c) Ablamowicz, Fauser 1999-2004. All rights re served.`;\n yy:=&gco(y,1);\n if op(0,yy) = `+` then\n lst:=[op(yy )];\n else\n lst:=[yy];\n fi;\n res:=0;\n for var_i in [op(yy)] do\n v1,v2:=peek(var_i,1);\n res := res + bracket(Clifford:-wed ge(v1,x))*op(v2);\n od;\n res;\nend proc: # meet\n\n\n##\n## No PACK -4. Grassmann co-product of hyperplanes (Pluecker coordinates)\n##\n` &gco_pl`:=proc(x,i) \n local co,term,xx,a,b,c;\n option `Copyright (c) R. Ablamowicz, B. Fauser 1999-2004. All rights reserved.`;\n\n \+ if type(x,clibasmon) then\n return gpl_co_monom(x,`&t`);\n elif \+ type(x,climon) then\n co,term:=select(type,x,'cliscalar'),remove(t ype,x,'cliscalar');\n return expand(co*gpl_co_monom(term,`&t`));\n elif type(x,clipolynom) then\n return expand(map('procname',x)) ;\n elif type(x,tensorbasmonom) then\n if nops([op(x)]) = 1 then \n return gpl_co_monom(op(x),`&t`);\n fi;\n xx:=op(x);\n a:=xx[1..i-1];\n b:=xx[i];\n c:=xx[i+1..nops([xx])];\n \+ return &t(a,gpl_co_monom(b,`&t`),c);\n elif type(x,tensormonom) th en\n co,term:=remove(type,x,tensorbasmonom),select(type,x,tensorba smonom);\n return expand(co*procname(term,i));\n elif type(x,ten sorpolynom) then\n return map('procname',x,i)\n elif x=0 then\n \+ return 0\n else error \"wrong type in &gpl_co\"\n fi:\nend proc : ### &gpl_co\n\n##\n## No PACK-5. dotted Grassmann co-product compute d in the undotted basis\n##\n`&gco_d`:=proc(x, i) \n local co, term, xx, a, b, c; \n option `Copyright (c) R. Ablamowicz, B. Fauser 1999 -2004. All rights reserved.`; \n \n### ===> CAUTION THIS MIGHT NOT WOR K <=== ###\n if not type(&C(e1,e2),cliprod) then \n WARNING(`Nee d to load Cliplus.....`); \n with(Cliplus): \n fi; \n### ===> < ===\n\n if type(x,clibasmon) then \n return gco_d_monom(x,`&t`) \+ \n elif type(x,climon) then \n co, term := select(type,x,cliscal ar), remove(type,x,cliscalar); \n return expand(co*gco_d_monom(ter m,`&t`)) \n elif type(x,clipolynom) then \n return expand(map('p rocname',x)) \n elif type(x,tensorbasmonom) then \n if nops([op( x)]) = 1 then \n return gco_d_monom(op(x),`&t`) \n fi; \n \+ xx := op(x); \n a := xx[1 .. i-1]; \n b := xx[i]; \n c : = xx[i+1 .. nops([xx])]; \n return `&t`(a,gco_d_monom(b,`&t`),c) \+ \n elif type(x,tensormonom) then \n co, term := remove(type,x,te nsorbasmonom), select(type,x,tensorbasmonom); \n return expand(co* procname(term,i)) \n elif type(x,tensorpolynom) then \n return m ap('procname',x,i) \n else error \"wrong type in &gco_d\" \n fi \+ \nend proc: # &gco_d\n\n\n##\n## No PACK-6. Precompute clifford copro duct for unit \n##\nmake_BI_Id:=proc()\n global dim_V,B,BI,BI_Id;\n \+ local n,m,i,bas,res;\n option `Copyright (c) Ablamowicz, Fauser 1999- 2004. All rights reserved.`;\n if evalb(dim_V='dim_V') then\n ERRO R(`global variable dim_V must be assigned`);\n else\n if not type( BI,matrix) then\n BI:=linalg[matrix](dim_V,dim_V):\n fi;\n \+ res:=[]:\n for i from 0 to dim_V do\n bas:=Clifford:-cbasis(di m_V,i);\n res:=[op(res),\n seq(seq([Clifford:-scalarpa rt(\n Clifford:-LC(bas[n],bas[m],BI)),bas[n],bas[m]],n= 1..nops(bas)),m=1..nops(bas))]; \n od:\n BI_Id:=res;\n add(BI _Id[i][1]*&t(BI_Id[i][2],BI_Id[i][3]),i=1..nops(BI_Id));\n fi;\nend p roc: # make_BI_Id()\n\n\n##\n## No PACK-7. Clifford coproduct\n##\n`& cco`:=proc(x,i) \n local la,ars,func,co,term,res,j,xx,a,b,c,bl,aa,ff ,p,L;\n option `Copyright (c) Ablamowicz, Fauser 1999-2004. All righ ts reserved.`;\n if type(x,\{clipolynom,climon,clibasmon\}) then\n \+ return cco_monom(x);\n elif type(x,tensorbasmonom) then\n if \+ nops([op(x)]) = 1 then\n return cco_monom(op(x));\n fi;\n \+ xx:=op(x);\n a:=xx[1..i-1];\n b:=xx[i];\n c:=xx[i+1..nop s([xx])];\n return &t(a,cco_monom(b),c); \n elif type(x,tensormo nom) then\n co,term := select(type,x,cliscalar),remove(type,x,clis calar);\n return expand(co*procname(term,i))\n elif type(x,tenso rpolynom) then\n L:=[op(x)]:\n return add(procname(m,i),m=L)\n elif x=0 then return 0 \n else error \"Wrong type in &cco\"\n \+ fi:\nend proc: # &cco\n\n\n##\n## No PACK-8. Grassmann counit\n##\ngc o_unit:=proc(x,i)\n local a,b,cf,term;\n option `Copyright (c) Ablam owicz, Fauser 1999-2004. All rights reserved.`;\n if type(x,tensorbas monom) then\n if nops([op(x)]) = 1 then\n return Clifford:-sca larpart(op(x))*Id;\n else\n a,b:=peek(x,i);\n return Clif ford:-scalarpart(a)*b;\n fi;\n elif type(x,tensormonom) then\n \+ cf,term:=select(type,x,`cliscalar`),remove(type,x,`cliscalar`);\n r eturn cf*gco_unit(term,i);\n elif type(x,tensorpolynom) then\n map (gco_unit,x,i);\n elif\n type(x,clibasmon) then\n return Clif ford:-scalarpart(x)*Id;\n elif x=0 then\n return 0;\n else\n e rror \"Wrong type in gco_unit, can process only tensorpolynoms\";\n f i; \nend proc: # gco_unit\n\n\n##\n## No PACK-9. switch\n##\nswitch: =proc(x,i)\n local cf,term,a,L,res,n1,n2,b,res2;\n option `Copyright (c) Ablamowicz, Fauser 1999-2004. All rights reserved.`;\n if type(x ,tensorbasmonom) then\n L:=op(x);\n a:=L[i];\n b:=L[i+1];\n \+ return &t(L[1..i-1],b,a,L[i+2..nops([L])]);\n elif type(x,tensormon om) then\n cf,term:=select(type,x,'cliscalar'),remove(type,x,`clisc alar`);\n return expand(cf*procname(term,i));\n elif type(x,`+`) t hen\n map(procname,expand(x),i);\n else\n error \"Wrong type in switch\";\n fi;\nend proc: # switch\n\n\n##\n## No PACK-10. gswitch \n##\ngswitch:=proc(x,i)\n local cf,term,a,L,res,n1,n2,b,res2;global \+ _CLIENV;\n option `Copyright (c) Ablamowicz, Fauser 1999/02. All righ ts reserved.`;\n if type(x,tensorbasmonom) then\n L:=op(x);\n a :=L[i];\n b:=L[i+1];\n return (_CLIENV[_QDEF_PREFACTOR])^(nops(C lifford[extract](a))*\n nops(Clifford[extract](b)))*&t(L[1.. i-1],b,a,L[i+2..nops([L])]);\n elif type(x,tensormonom) then\n cf, term:=select(type,x,'cliscalar'),remove(type,x,`cliscalar`);\n retu rn expand(cf*gswitch(term,i));\n elif type(x,`+`) then\n map(gswit ch,expand(x),i);\n elif x=0 then\n return 0\n else\n error \"W rong type in gswitch\";\n fi;\nend proc: # gswitch\n\n\n##\n## No PAC K-11. peek\n##\npeek:=proc(x,i)\n local a,b,L,cf,term;\n option `Co pyright (c) Ablamowicz, Fauser 1999-2004. All rights reserved.`;\n if type(x,tensorbasmonom) then\n L:=op(x);\n if nops([L]) = 1 then \n return L,&t(Id);\n else\n a:=op(i,[L]);\n b:=&t(L [1..i-1],L[i+1..nops([L])]);\n return a,b;\n fi;\n elif type( x,tensormonom) then\n cf,term:=select(type,x,`cliscalar`),remove(ty pe,x,`cliscalar`);\n a,b:=procname(term,i);\n return cf*a,b;\n \+ elif type(x,tensorpolynom) then\n L:=op(x):\n return seq([peek(t erm,i)],term=L);\n else \n error \"wrong type, only tensorbasmonom and tensormonom allowed in peek\"\n fi:\nend proc: # peek\n\n\n##\n# # No PACK-12. poke\n##\npoke:=proc(x,y,i)\n local L,co,term,a,b;\n \+ option `Copyright (c) Ablamowicz, Fauser 1999-2004. All rights reserve d.`;\n if type(y,\{clibasmon,climon,clipolynom\}) then\n if type(x ,tensorbasmonom) then\n if nops([op(x)]) = 1 then\n if i = 1 then\n return tcollect(&t(y,op(x)));\n else\n \+ return tcollect(&t(op(x),y));\n fi;\n else \n L :=op(x):\n a:=L[1..i-1];\n b:=L[i..nops([L])];\n \+ return tcollect(&t(a,y,b));\n fi;\n elif type(x,tensormonom) t hen\n co,term:=select(type,x,`cliscalar`),remove(type,x,`cliscala r`):\n return co*procname(term,y,i)\n elif type(x,tensorpolyno m) then\n L:=op(x);\n return add(procname(term,y,i),term=L); \n elif type(x,\{clibasmon,climon,clipolynom\}) then\n if i=1 \+ then \n return &t(y,x) \n else \n return &t(x,y) \+ \n fi:\n else\n error \"unknown type in poke\"\n fi:\n else \n error \"second argument in poke must be a clipolynom\"\n \+ fi:\nend proc: # poke\n\n\n##\n## No PACK-13. tcollect\n##\ntcollect :=proc(x)\n option `Copyright (c) Ablamowicz, Fauser 1999-2004. All r ights reserved.`;\n collect(x,`&t`);\nend proc: # tcollect\n\n\n##\n# # No PACK-14. pairing\n##\npairing:=proc(x,y)\n option `Copyright (c ) Ablamowicz, Fauser 1999-2004. All rights reserved.`;\n if nargs=3 t hen \n Clifford:-scalarpart(Clifford:-LC(x,y,args[3]))\n else\n \+ Clifford:-scalarpart(Clifford:-LC(x,y))\n fi\nend proc: # pairing\n \n\n##\n## No PACK-15. contract\n##\ncontract:=proc(x,i,f)\n local n ,a,b,t,cf,term;\n option `Copyright (c) Ablamowicz, Fauser 1999-2004. All rights reserved.`;\n if type(x,tensorbasmonom) then\n if nops ([op(x)]) <= 1 then\n error \"Tensor with two args at least neede d\";\n elif nops([op(x)]) = 2 then\n return f(op(x));\n fi; \n a,t:=peek(x,i);\n b,t:=peek(t,i);\n return f(a,b)*t;\n el if type(x,tensormonom) then\n cf,term:=select(type,x,`cliscalar`),r emove(type,x,`cliscalar`);\n return cf*procname(term,i,f);\n elif \+ type(x,tensorpolynom) then\n map(procname,x,i,f);\n elif x=0 then \+ \n return 0;\n else\n error \"Wrong type in contract, can proce ss only tensorpolynoms of grade higher than two\";\n fi; \nend proc : # contract\n\n\n##\n## No PACK-16. bracket\n##\nbracket:=proc()\n \+ global dim_V;\n option `Copyright (c) Ablamowicz, Fauser 1999-2004. A ll rights reserved.`; \n coeff(Clifford:-wedge(args),Clifford:-we dge(seq(cat(e,i),i=1..dim_V)));\nend proc: # bracket\n\n\n##\n## No PA CK-17. gantipode\n##\ngantipode:=proc(x,i)\n local n,a,b,cf,term;\n \+ global _CLIENV;\n option `Copyright (c) Ablamowicz, Fauser 1999-2004 . All rights reserved.`;\n if type(x,tensorbasmonom) then\n if nop s([op(x)]) = 1 then\n n:=nops(Clifford:-extract(op(x)));\n r eturn _CLIENV[_QDEF_PREFACTOR]^(n)*x;\n fi;\n a,b:=peek(x,i);\n \+ n:=nops(Clifford:-extract(a));\n return poke(b,_CLIENV[_QDEF_P REFACTOR]^(n)*a,i);\n elif type(x,tensormonom) then\n cf,term:=sel ect(type,x,`cliscalar`),remove(type,x,`cliscalar`);\n return cf*pro cname(term,i);\n elif type(x,tensorpolynom) then\n map(procname,x, i);\n elif type(x,\{clibasmon,climon,clipolynom\}) then\n return C lifford:-gradeinv(x);\n elif x=0 then\n return 0;\n else\n err or \"Wrong type in gantipode, can process only clipolynoms and tensorp olynoms\";\n fi; \nend proc: # gantipode\n\n\n##\n## No PACK-18. & map\n##\n`&map`:=proc(x,i,f)\n local cf,term,L,a,b,ARGS;\n option `C opyright (c) Ablamowicz, Fauser 1999-2004. All rights reserved.`;\n i f nargs >3 then ARGS:=args[4..-1] else ARGS:=NULL fi;\n if type(x,ten sorbasmonom) then\n L:=op(x):\n a:=L[1..i-1]:\n b:=L[i+2..nop s([L])];\n `&t`(a,Clifford:-displayid(f(L[i],L[i+1],ARGS)),b);\n e lif type(x,tensormonom) then\n cf,term:=remove(type,x,`tensorbasmon om`),select(type,x,`tensorbasmonom`);\n return cf*&map(term,i,f,ARG S);\n elif type(x,`+`) then\n map(`&map`,expand(x),i,f,ARGS);\n e lif x=0 then \n return 0\n else\n error \"Wrong type in &map\"; \n fi;\nend proc: # &map\n\n\n##\n## No PACK-19. mapop\n##\nmapop:=p roc(x,i,LinOp)\n local L,a,b,c,cf,term,ARGS; \n option `Copyright ( c) Ablamowicz, Fauser 1999-2004. All rights reserved.`;\n if nargs >3 then ARGS:=args[4..-1] else ARGS:=NULL fi;\n if type(x,tensorbasmono m) then\n L:=[op(x)];\n if 1=nops(L) then \n return &t(LinO p(op(x),ARGS)) \n else\n a:=L[1..i-1];\n b:= LinOp(L[i],A RGS);\n c:=L[i+1..-1];\n if a=[] then a:=[] fi;\n if c= [] then c:=[] fi;\n return &t(op(a),b,op(c));\n fi; \n elif \+ type(x,tensormonom) then\n cf,term:=select(type,x,`cliscalar`),remo ve(type,x,`cliscalar`);\n return cf*procname(term,i,LinOp,ARGS); \+ \n elif type(x,tensorpolynom) then\n return map(procname,x,i,LinO p,ARGS); \n elif type(x,\{clibasmon,climon,clipolynom\}) then\n r eturn LinOp(x,ARGS)\n elif x=0 then \n return 0\n else\n error \"Unknown type in mapop, cannot process %1\",x;\n end if;\nend proc: # mapop\n\n\n##\n## No PACK-20. mapop2\n##\nmapop2:=proc(x,i,LinOp2) \n local L,a,cf,term;\n option `Copyright (c) Ablamowicz, Fauser 199 9-2004. All rights reserved.`;\n if type(x,tensorbasmonom) then\n \+ L:=op(x);\n if nops([L]) < 2 then \n ERROR(`mapop2 needs at le ast a two-tensor as input`);\n elif nops([L]) = 2 then\n RETUR N(LinOp2(x))\n fi; \n a:=LinOp2(&t(L[i],L[i+1]));\n return &t(L [1..i-1],a,L[i+2..nops([L])]); \n elif type(x,tensormonom) then\n \+ cf,term:=remove(type,x,`tensorbasmonom`),select(type,x,`tensorbasmonom `);\n return cf*procname(term,i,LinOp2); \n elif type(x,tensorp olynom) then\n return map(procname,x,i,LinOp2); \n else\n ERRO R(`Unknown type in mapop2, cannot process`,x);\n fi\nend proc: # mapo p2\n\n\n##\n## No PACK-21. tsolve1\n##\ntsolve1:=proc(eq,indet,covecto rs)\n local i,TT,vec,CV,co_vec,vars,sol,sys,tmp_eq;\n option `Copyri ght (c) Ablamowicz, Fauser 1999-2004. All rights reserved.`;\n if typ e(indet,list) then\n vars:=convert(indet,set);\n else\n vars:=s elect(type,indets(indet),indexed);\n fi;\n if type(covectors,list) t hen\n CV:=convert(covectors,set);\n else\n CV:=select(type,inde ts(covectors),indexed);\n fi;\n sys:=\{\}:\n for i from 1 to nops(C V) do\n tmp_eq:=coeff(eq,CV[i]);\n TT:=Clifford:-cliterms(tmp_eq );\n sys:=sys union \{coeffs(tmp_eq,TT)\};\n od:\n sol:=[solve(sy s,vars)];\n return sol; \n end proc: # tsolve1\n\n\n##\n## No PACK-2 2. EV (eval)\n##\nEV:=proc(x,y)\n local cf,term,lst,i,n;\n option ` Copyright (c) Ablamowicz, Fauser 1999-2004. All rights reserved.`;\n \+ if x=0 or y=0 then RETURN(0) fi;\n if type(x,clibasmon) then\n if \+ type(y,clibasmon) then\n if Clifford:-extract(x,`integers`) = Cli fford:-extract(y,`integers`) then\n return 1;\n else\n \+ return 0;\n fi;\n elif type(y,climon) then\n cf,term: =select(type,y,`cliscalar`),remove(type,y,`cliscalar`);\n return \+ cf*procname(x,term);\n elif type(y,clipolynom) then\n lst:=[op (y)]:\n return add(procname(x,lst[i]),i=1..nops(lst));\n else \n ERROR(`Wrong type in EV`);\n fi;\n elif type(x,climon) the n\n cf,term:=select(type,x,`cliscalar`),remove(type,x,`cliscalar`); \n return cf*procname(term,y);\n elif type(x,clipolynom) then\n \+ return map(procname,x,y);\n else\n ERROR(`Wrong type in EV`);\n \+ fi; \nend proc: # EV\n\n\n##\n## No PACK-23. linop\n##\nlinop:=proc(x ,R)\n local bas,i,j;\n global dim_V;\n option `Copyright (c) Ablamo wicz, Fauser 1999-2004. All rights reserved.`;\n bas:=Clifford:-cbasi s(dim_V);\n Clifford:-clicollect(simplify(add(add(R[i,j]*EV(bas[j],x) *bas[i],i=1..2^dim_V),j=1..2^dim_V))); \nend proc: # linop\n\n\n##\n# # No PACK-23. op2mat\n##\nop2mat:=proc(fkt)\n option `Copyright (c) \+ Ablamowicz, Fauser 1999-2004. All rights reserved.`;\n global dim_V; \n local i,j,bas,ARGS;\n if nargs >1 then ARGS:=args[2..-1] else ARG S:=NULL fi;\n bas:=Clifford:-cbasis(dim_V):\n linalg[matrix](2^dim_V ,2^dim_V,(i,j)->EV(bas[i],fkt(bas[j],ARGS)));\nend proc:\n\n\n##\n## N o PACK-23. lists2mat\n##\nlists2mat:=proc(lst1,lst2)\n option `Copyr ight (c) Ablamowicz, Fauser 1999-2004. All rights reserved.`;\n globa l dim_V;\n local i,j,bas;\n linalg[matrix](2^dim_V,2^dim_V,(i,j)->EV (lst1[i],lst2[j]));\nend proc:\n\n##\n## No PACK-24. linop2\n##\nlino p2:=proc(x,MAT)\n local res,co,erg1,erg2,bas,i,j,a,b,lst,terms,tr_tab le;\n global dim_V;\n option `Copyright (c) Ablamowicz, Fauser 1999- 2004. All rights reserved.`; \n bas:=Clifford:-cbasis(dim_V);\n tr_table:=table([seq(bas[i]=i,i=1..2^dim_V)]):\n if type(x,tensormo nom) then\n lst:=[x]:\n elif type(x,tensorpolynom) then\n lst:= [op(x)]:\n else\n ERROR(`assumes first argument to be a 2-tensor`) ;\n fi;\n res:=0:\n for terms in lst do\n erg1,erg2 := peek(term s,1);\n if type(erg1,clibasmon) then\n co:=1;\n else\n \+ co,erg1:=select(type,erg1,cliscalar),remove(type,x,`cliscalar`);\n \+ fi; \n a:=tr_table[erg1]:\n b:=tr_table[op(erg2)]:\n for i f rom 1 to 2^dim_V do\n for j from 1 to 2^dim_V do\n res := res \+ + co*&t(bas[i],bas[j])*MAT[4*(i-1)+j,4*(a-1)+b];\n od:od: \n od: \n res;\nend proc: # linop2\n\n##\n## No PACK-25. op2mat2\n##\nop2ma t2:=proc(fkt)\n option `Copyright (c) Ablamowicz, Fauser 1999-2004. A ll rights reserved.`;\n global dim_V;\n local i,j,p,q,bas,mat,ARGS; \n if nargs >1 then ARGS:=args[2..-1] else ARGS:=NULL fi;\n bas:=Cli fford:-cbasis(dim_V):\n mat:=linalg[matrix](4^dim_V,4^dim_V):\n for \+ i from 1 to 2^dim_V do\n for j from 1 to 2^dim_V do\n for p from 1 t o 2^dim_V do\n for q from 1 to 2^dim_V do \n mat[(p-1)*2^dim_V+q,( i-1)*2^dim_V+j]:=contract(contract(&t(fkt(&t(bas[q],bas[p]),ARGS),bas[ i],bas[j]),2,EV),1,EV):\n od:od:od:od:\n evalm(mat); \nend proc:\n\n ##\n## No PACK-26. lists2mat2\n##\nlists2mat2:=proc(source,target)\n \+ option `Copyright (c) Ablamowicz, Fauser 1999-2004. All rights reserv ed.`;\n global dim_V;\n local i,j,p,q,bas,mat,ARGS;\n if nargs >1 t hen ARGS:=args[2..-1] else ARGS:=NULL fi;\n mat:=linalg[matrix](4^dim _V,4^dim_V):\n for i from 1 to 4^dim_V do\n for j from 1 to 4^dim_V \+ do\n mat[i,j]:=contract(contract(&t(switch(source[i],1),target[j]), 2,EV),1,EV):\n od:od:\n evalm(mat); \nend proc:\n\n\n##\n## No PACK- 27. VERSION\n##\nVERSION:=proc()\n option `Copyright (c) Ablamowic z, Fauser 1999-2004. All rights reserved.`; \n printf(`<=========== ==================================================>\\n`);\n printf( ` \260\260Bi-Gebra Package VERSION 1.01 for Clifford version 9\260 \260\\n`);\n printf(` by Rafal Ablamowicz(\247) and Bertfried Fa user(*)\\n`);\n printf(` (c) Dec-16-99 / Nov-16-2002 / Dec-1-20 03\\n`);\n printf(` Available from http://math.tntech.edu/rafal/ \\n`);\n printf(` \\ n`);\n printf(` (\247) Department of Mathematics, Box 5054 \+ \\n`);\n printf(` Tennessee Technological University \\ n`);\n printf(` Cookeville, TN 38505, U.S.A. \\n` );\n printf(` Email: rablamowicz@tntech.edu \\n`); \n printf(` URL: http://math.tntech.edu/rafal/\\n`);\n pr intf(` (*) Universit\"at Konstanz \\n`);\n pri ntf(` Fachbereich Physik, Fach M678 \\n`);\n print f(` 78457 Konstanz, Germany \\n`);\n printf( ` Email: Bertfried.Fauser@uni-konstanz.de \\n`);\n printf(` \+ URL: http://clifford.physik.uni-konstanz.de/~fauser/\\n`);\n \+ printf(` \\n`);\n pr intf(`Online help available with: \\n`);\n print f(` > ?Bigebra \\n`);\n prin tf(` or use 'help' menue and search for topics \\n\\n`);\n p rintf(`Copyright (c) Rafal Ablamowicz, Bertfried Fauser 1999-2004.\\n` );\n printf(` All rights reserved. See also > ?Bigebra [help]\\n\\n`);\n printf(` BUG-REPORTS to Bertfried Fauser \+ \\n`);\n printf(`<============================================= ================>\\n`);\nend proc: # VERSION\n\n\n##\n## No PACK-28. \+ drop_t\n##\ndrop_t:=proc(x)\n option `Copyright (c) Ablamowicz, Fause r 1999-2004. All rights reserved.`; \n local null;\n null:=proc(x) x ; end:\n eval(subs(`&t`=null,x));\nend proc:\n\n\n##\n## No PACK-29. \+ remove_eq\n##\nremove_eq:=proc(x)\n option `Copyright (c) Ablamowicz , Fauser 1999-2004. All rights reserved.`; \n if evalb(x) then ; else x; fi;\nend proc: # remove_eq\n\n\n################################## ##############################################\n# \+ #\n# beta fu nctions # \n# \+ #\n######################################################## ########################\n##\n## No BETA-1.\n##\n## Not available yet \n##\nhodge:=proc(x,i)\n local sign,idx,newidx,k,L,a,cf,term;\n glob al dim_V;\n option `Copyright (c) Ablamowicz, Fauser 1999-2004. All r ights reserved.`;\n if type(x,tensorbasmonom) then\n L:=op(x);\n \+ if nops([L]) = 1 then\n return &t(Clifford:-LC(L,Clifford:-wedg e(seq(e||k,k=1..dim_V))));\n else\n a:=Clifford:-LC(L[i],&w(se q(e||k,k=1..dim_V))); \n return &t(L[1..i-1],a,L[i+1..nops([L])]) ;\n fi \n elif type(x,tensormonom) then\n cf,term:=select(type, x,`cliscalar`),remove(type,x,`cliscalar`);\n return cf*procname(ter m,i); \n elif type(x,tensorpolynom) then\n return map(procname, x,i); \n elif type(x,`clibasmon`) or type(x,`climon`) or type(x,`cli polynom`) then\n return Clifford:-LC(x,Clifford:-wedge(seq(e||k,k=1 ..dim_V)));\n else\n ERROR(`No known type, cannot process`,x);\n \+ fi\nend:\n\n\n######################################################## ########################\n# \+ #\n# unused functions for compatib ility reasons only #\n# \+ #\n######## ###################################################################### ##\n##\n## No COMPAT-1. eps ==> use EV(x,y)\n##\neps:=proc(x,i)\n \+ local cf,term,lst,n;\n option `Copyright (c) Ablamowicz, Fauser 1999- 2004. All rights reserved.`;\n if type(x,clibasmon) then\n lst:=Cl ifford:-extract(x,`integers`);\n n:=nops(lst);\n if lst = i then \n return 1;\n else\n return 0;\n fi;\n elif type(x,c limon) then\n cf:=select(type,x,`cliscalar`);\n if nops([cf]) > \+ 1 then\n cf := map(`*`,cf);\n fi;\n term:=x/cf;\n return cf*procname(term,i);\n else\n map(procname,x,i);\n fi; \nend pro c: # eps\n\nend module:\n# Bigebra\n\nlibname[1];\nsavelib(Bigebra);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 "restart:with(Clifford):with(Bigeb ra);" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#Q6C:\\Maple9/Cliffordlib6\"" } }{PARA 7 "" 1 "" {TEXT -1 71 "Warning, the protected name version has \+ been redefined and unprotected\n" }}{PARA 6 "" 1 "" {TEXT -1 83 "Incre ase verbosity by infolevel[`function`]=val -- use online help > ?Bigeb ra[help]" }}{PARA 12 "" 1 "" {XPPMATH 20 "6#7C%%&ccoG%%&gcoG%'&gco_dG% (&gco_plG%%&mapG%#&vG%#EVG%(VERSIONG%(bracketG%)contractG%'drop_tG%$ep sG%*gantipodeG%)gco_unitG%(gswitchG%&hodgeG%&linopG%'linop2G%*lists2ma tG%+lists2mat2G%+make_BI_IdG%&mapopG%'mapop2G%%meetG%'op2matG%(op2mat2 G%(pairingG%%peekG%%pokeG%*remove_eqG%'switchG%)tcollectG%(tsolve1G" } }}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 67 "#march('list',libname[1]); \n#march('delete',libname[1],`Bigebra.m`);" }}}}{MARK "3" 0 } {VIEWOPTS 1 1 0 1 1 1803 1 1 1 1 }{PAGENUMBERS 0 1 2 33 1 1 }