{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 "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 "M aple 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 21 "Bigebra_code.1.01.mws" } }{PARA 0 "" 0 "" {TEXT -1 154 "Authors: Rafal Ablamowicz, Tennessee T ech University, Cookeville TN, U.S.A\n Bertfried Fau ser, 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-2003 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, Cli<#>p lus, 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 629 "###\n### Bigebra_code.1.01.mws of Dec#-16-99 -- Oct -10-2002 BF/RA.\n###\n### VERSION 0.01 \n### \n### Copyright Rafal Ablamowicz(\247) & Bertfried Fauser( *)\n###\n### (\247) Department of Mathematics, Box 5054\n### Ten nessee Technological University\n### Cookeville, TN 38505 \n### \+ U.S.A.\n### rablamowicz@tntech.edu\n### http://math.tnte ch.edu/rafal/\n###\n### (*) Universit\"at Konstanz\n### Fachbere ich Physik\n### Fach M678\n### 78457 Konstanz\n### Germ any\n### Bertfried.Fauser@uni-konstanz.de\n### http://kaluza .physik.uni-konstanz.de/~fauser/ \n###\n" }}{PARA 0 "" 0 "" {TEXT 259 518 "\n###\n### (c) Copyright: Rafal Ablamowicz, Bertfried \+ Fauser. All rights reserved.\n###\n### This software may be used \+ by non profit organisations, in educatiion \n### and research, pr ovided it is distrubuted with full source and this header.\n### C ommercial distribution need explicite permission by the copyright hold er.\n### It is prohibited to translate this software into other l anguages etc. \n###\n###\n### DISCLAIMER:\n###\n### This software co mes as-is and without any guaratee. Using 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 res ponsibility. Nevertheless they made" }}{PARA 0 "" 0 "" {TEXT 258 60 "# ## any effort to provide useful and valuabe code.\n###\n###\n" }} {PARA 0 "" 0 "" {TEXT -1 2 " " }}{PARA 0 "" 0 "" {TEXT -1 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 11 "restart: \n\n" }{TEXT -1 263 "We start by defining a new module Bigebra which has the option pa ckage. Important things are\n-- The package is executed on startup wh en loaded like any Maple code.\n-- Types have to be made globaly avai lable, hence they have to be defined in the startup routine." }}{PARA 14 "" 0 "" {TEXT -1 0 "" }}{PARA 14 "> " 0 "" {MPLTEXT 1 0 29453 "Bige bra:=module()\n export `&gco`,`&gco_pl`,`&gco_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,lists2mat,linop2,op2mat2,l ists2mat2,\n VERSION,drop_t,remove_eq,\n hodge,eps ; \n global dim_V,`type/tensorbasmonom`, `type/tensormonom`, `type/te nsorpolynom`;\n local gco_monom,gpl_co_monom,gpl_co_monom2,co_d_mon om,gco_d_monom,cco_monom, #F,\n init,exit;\n # co_dec _monom2,co_map_monoms,co_map_monoms_t,co_tensor,co_prod,cco_prod\n op tion package,\n load=init,\n unload=exit,\n `C opyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`; \n \n\n\n init:=proc()\n option `Copyright (c) Ablamowicz, Fauser 199 9-2003. All rights reserved.`;\n \n \n ############################### ###################################################\n # \+ #\n # predefine certain settings \+ #\n # \+ #\n ######################################### #########################################\n \n\n define(`&t`,flat, multilinear,domain=cliscalar): # predefine the tensor product\n pr intf(\"Increase verbosity by infolevel[`function`]=val -- use online h elp > ?Bigebra[help]\\n\");\n\n \n ################################### ###############################################\n # \+ #\n # exp ort types to toplevel namespace (polution, bahhh) \+ #\n # \+ #\n ############################################# #####################################\n ##\n ## No INIT-1.\n ##\n \+ `type/tensorbasmonom`:=proc(p)\n option `Copyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`; \n evalb(`&t`=op(0,p)) \n end proc: # type/tensorbasmonom\n\n ##\n ## No INIT-2.\n ##\n \+ `type/tensormonom`:=proc(p)\n option `Copyright (c) Ablamowicz, Fa user 1999-2003. All rights reserved.`; \n if type(p,`tensorbasmon om`) then return true fi; \n if type(p,`*`) and 1<>select(type,p,` tensorbasmonom`) then\n true;\n else\n false \n fi ;\n end proc: # type/tensormonom\n\n ##\n ## No INIT-3.\n ##\n `t ype/tensorpolynom`:=proc(p) \n option `Copyright (c) Ablamowicz, F auser 1999-2003. All rights reserved.`; \n if type(p,`tensormonom `) then return true fi:\n if type(p,`+`) then \n return eval b(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##\ngco_monom:=pro c(x,name)\n local fun,a,list1,list2,du1,du2,NL,NP,NR,vz,i,j;\n glo bal _CLIENV;\n option `Copyright (c) Ablamowicz, Fauser 1999-2003. A ll rights reserved.`;\n list1:=Clifford:-extract(x,integers):\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[_Q DEF_PREFACTOR])^(add(list2[i][j]-j,j=1..nops(list2[i])))* \n `nam e`(Clifford:-makeclibasmon(map(fun,list2[i])),\n Clifford: -makeclibasmon(map(fun,list2[NP-i]))),i=1..NP-1);\nend proc: ### gco_m onom\n\n\n##\n## No LOC-2. dotted Grassmann co-product on Clifford pol ynoms \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/d wedge_to_wedge`,`convert/wedge_to_dwedge`; \n option `Copyright (c) \+ R. Ablamowicz, B. Fauser 1999-2003. All rights reserved.`; \n u := \+ proc (z) convert(z,wedge_to_dwedge,F) end; \n mapop(mapop(`&gco`(con vert(x,dwedge_to_wedge,-F)),1,u),2,u) \nend:\n\n\n##\n## No LOC-3. Gr assmann co-product of hyperplanes \n##\ngpl_co_monom:=proc(x,name)\n \+ local b,NL;\n global _CLIENV,dim_V;\n option `Copyright (c) Ablam owicz, Fauser 1999-2003. All rights reserved.`;\n b:=&gco(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:-wedge);\nend pro c: ### gpl_co_monom\n\n\n##\n## No LOC-4. Grassmann co-product of hype rplanes 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-2003. All rights reserved.`;\n b:=&gco(Clifford:-makecli basmon([seq(i,i=1..dim_V)]));\n NL:=nops(Clifford:-extract(x));\n \+ &map(name(x,b),1,Clifford:-wedge);\nend proc: ### gpl_co_monom2\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- 2003. 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:-w edge);\n fi;\n elif type(x,climon) then\n cf,term:=select(type, x,`cliscalar`),remove(type,x,`cliscalar`);\n return expand(cf*procn ame(term));\n elif type(x,clipolynom) then\n return map(procname,x ); \n else\n ERROR(`received unknown type in cco_monom to proce ss`);\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 option `Copyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`;\n if type( x,clibasmon) then\n return gco_monom(x,`&t`);\n elif type(x,clim on) then\n co,term:=select(type,x,cliscalar),remove(type,x,cliscal ar);\n return expand(co*gco_monom(term,`&t`));\n elif type(x,cli polynom) then\n return expand(map('procname',x));\n elif type(x, tensorbasmonom) then\n if nops([op(x)]) = 1 then\n return gc o_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_mon om(b,`&t`),c);\n elif type(x,tensormonom) then\n co,term:=remove (type,x,tensorbasmonom),select(type,x,tensorbasmonom);\n return ex pand(co*procname(term,i));\n elif type(x,tensorpolynom) then\n r eturn map('procname',x,i)\n else ERROR(`wrong type in &gco`)\n fi: \nend proc: ### &gco\n\n\n##\n## No PACK-2. meet (definition 1)\n##\n` &v`:=proc(x,y)\n local xx,res,lst,var_i,v1,v2;\n option `Copyright ( c) Ablamowicz, Fauser 1999-2003. All rights reserved.`; \n x x:=&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:=pee k(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. meet (definition 2)\n##\nmeet:=proc(x,y)\n local yy,res,lst,var_i,v1,v2;\n option `C opyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`;\n y y:=&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:-wedge(v1,x))*op(v 2);\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. Ablamo wicz, B. Fauser 1999-2003. All rights reserved.`;\n\n if type(x,clib asmon) then\n return gpl_co_monom(x,`&t`);\n elif type(x,climon) then\n co,term:=select(type,x,'cliscalar'),remove(type,x,'cliscal ar');\n return expand(co*gpl_co_monom(term,`&t`));\n elif type(x ,clipolynom) then\n return expand(map('procname',x));\n elif typ e(x,tensorbasmonom) then\n if nops([op(x)]) = 1 then\n retur n 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) then\n co,te rm:=remove(type,x,tensorbasmonom),select(type,x,tensorbasmonom);\n \+ return expand(co*procname(term,i));\n elif type(x,tensorpolynom) th en\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 computed in the undott ed 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-2003. All rig hts reserved.`; \n \n### ===> CAUTION THIS MIGHT NOT WORK <=== ###\n \+ if not type(&C(e1,e2),cliprod) then \n WARNING(`Need to load Clip lus.....`); \n with(Cliplus): \n fi; \n### ===> <===\n\n if t ype(x,clibasmon) then \n return gco_d_monom(x,`&t`) \n elif type (x,climon) then \n co, term := select(type,x,cliscalar), remove(ty pe,x,cliscalar); \n return expand(co*gco_d_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 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 .. n ops([xx])]; \n return `&t`(a,gco_d_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_d`) \n fi \nend proc: # & gco_d\n\n\n##\n## No PACK-6. Precompute clifford coproduct for unit \+ \n##\nmake_BI_Id:=proc()\n global dim_V,B,BI,BI_Id;\n local n,m,i,ba s,res;\n option `Copyright (c) Ablamowicz, Fauser 1999-2003. All righ ts reserved.`;\n if evalb(dim_V='dim_V') then\n ERROR(`global vari able dim_V must be assigned`);\n else\n if not type(BI,matrix) the n\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(dim_V,i);\n \+ res:=[op(res),\n seq(seq([Clifford:-scalarpart(\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(B I_Id[i][2],BI_Id[i][3]),i=1..nops(BI_Id));\n fi;\nend proc: # 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 opti on `Copyright (c) Ablamowicz, Fauser 1999-2003. All rights 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..nops([xx])];\n \+ return &t(a,cco_monom(b),c); \n elif type(x,tensormonom) then\n \+ co,term := select(type,x,cliscalar),remove(type,x,cliscalar);\n \+ return expand(co*procname(term,i))\n elif type(x,tensorpolynom) then \n L:=[op(x)]:\n return add(procname(m,i),m=L)\n elif x=0 th en return 0 \n else ERROR(`wrong type in &cco`)\n fi:\nend proc: \+ # &cco\n\n\n##\n## No PACK-8. Grassmann counit\n##\ngco_unit:=proc(x, i)\n local a,b,cf,term;\n option `Copyright (c) Ablamowicz, Fauser 1 999-2003. All rights reserved.`;\n if type(x,tensorbasmonom) then\n \+ if nops([op(x)]) = 1 then\n return Clifford:-scalarpart(op(x))* Id;\n else\n a,b:=peek(x,i);\n return Clifford:-scalarpar t(a)*b;\n fi;\n elif type(x,tensormonom) then\n cf,term:=select (type,x,`cliscalar`),remove(type,x,`cliscalar`);\n return cf*gco_un it(term,i);\n elif type(x,tensorpolynom) then\n map(gco_unit,x,i); \n elif\n type(x,clibasmon) then\n return Clifford:-scalarpar t(x)*Id;\n elif x=0 then\n return 0;\n else\n ERROR(`Wrong typ e in gco_unit, can process only tensorpolynoms`);\n fi; \nend proc: # gco_unit\n\n\n##\n## No PACK-9. switch\n##\nswitch:=proc(x,i)\n lo cal cf,term,a,L,res,n1,n2,b,res2;\n option `Copyright (c) Ablamowicz, Fauser 1999-2003. 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,tensormonom) then\n cf ,term:=select(type,x,'cliscalar'),remove(type,x,`cliscalar`);\n ret urn expand(cf*procname(term,i));\n elif type(x,`+`) then\n map(pro cname,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:=pro c(x,i)\n local cf,term,a,L,res,n1,n2,b,res2;global _CLIENV;\n option `Copyright (c) Ablamowicz, Fauser 1999/02. All rights 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(Clifford[extract](a ))*\n nops(Clifford[extract](b)))*&t(L[1..i-1],b,a,L[i+2..no ps([L])]);\n elif type(x,tensormonom) then\n cf,term:=select(type, x,'cliscalar'),remove(type,x,`cliscalar`);\n return expand(cf*gswit ch(term,i));\n elif type(x,`+`) then\n map(gswitch,expand(x),i);\n elif x=0 then\n return 0\n else\n ERROR(`Wrong type in gswitc h`);\n fi;\nend proc: # gswitch\n\n\n##\n## No PACK-11. peek\n##\npe ek:=proc(x,i)\n local a,b,L,cf,term;\n option `Copyright (c) Ablamow icz, Fauser 1999-2003. All rights reserved.`;\n if type(x,tensorbasmo nom) 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..nop s([L])]);\n return a,b;\n fi;\n elif type(x,tensormonom) then \n cf,term:=select(type,x,`cliscalar`),remove(type,x,`cliscalar`); \n a,b:=procname(term,i);\n return cf*a,b;\n elif type(x,tensor polynom) then\n L:=op(x):\n return seq([peek(term,i)],term=L);\n else \n ERROR(`wrong type, only tensorbasmonom and tensormonom al lowed 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-2003. All rights reserved.`;\n if type(y, \{clibasmon,climon,clipolynom\}) then\n if type(x,tensorbasmonom) t hen\n if nops([op(x)]) = 1 then\n if i = 1 then\n \+ return tcollect(&t(y,op(x)));\n else\n return tcollec t(&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) then\n co,term :=select(type,x,`cliscalar`),remove(type,x,`cliscalar`):\n return co*procname(term,y,i)\n elif type(x,tensorpolynom) 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 ret urn &t(y,x) \n else \n return &t(x,y) \n fi:\n el se\n ERROR(`unknown type in poke`)\n fi:\n else \n ERROR(` second argument in poke must be a clipolynom`);\n fi:\nend proc: # po ke\n\n\n##\n## No PACK-13. tcollect\n##\ntcollect:=proc(x)\n option \+ `Copyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`;\n \+ collect(x,`&t`);\nend proc: # tcollect\n\n\n##\n## No PACK-14. pairi ng\n##\npairing:=proc(x,y)\n option `Copyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`;\n if nargs=3 then \n Clifford:- scalarpart(Clifford:-LC(x,y,args[3]))\n else\n Clifford:-scalarpar t(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 op tion `Copyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved. `;\n if type(x,tensorbasmonom) then\n if nops([op(x)]) <= 1 then\n ERROR(`Tensor with two args at least needed`);\n elif nops([o p(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 elif type(x,tensormonom ) then\n cf,term:=select(type,x,`cliscalar`),remove(type,x,`cliscal ar`);\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 el se\n ERROR(`Wrong type in contract, can process 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 optio n `Copyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`; \+ \n coeff(Clifford:-wedge(args),Clifford:-wedge(seq(cat(e,i),i=1.. dim_V)));\nend proc: # bracket\n\n\n##\n## No PACK-17. gantipode\n## \ngantipode:=proc(x,i)\n local n,a,b,cf,term;\n global _CLIENV;\n o ption `Copyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved .`;\n if type(x,tensorbasmonom) then\n if nops([op(x)]) = 1 then\n n:=nops(Clifford:-extract(op(x)));\n return _CLIENV[_QDEF_P REFACTOR]^(n)*x;\n fi;\n a,b:=peek(x,i);\n n:=nops(Clifford:- extract(a));\n return poke(b,_CLIENV[_QDEF_PREFACTOR]^(n)*a,i);\n elif type(x,tensormonom) then\n cf,term:=select(type,x,`cliscalar `),remove(type,x,`cliscalar`);\n return cf*procname(term,i);\n eli f type(x,tensorpolynom) then\n map(procname,x,i);\n elif type(x,\{ clibasmon,climon,clipolynom\}) then\n return Clifford:-gradeinv(x); \n elif x=0 then\n return 0;\n else\n ERROR(`Wrong type in gan tipode, can process only clipolynoms and tensorpolynoms`);\n fi; \n end 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 `Copyright (c) Ablamowic z, Fauser 1999-2003. All rights reserved.`;\n if nargs >3 then ARGS:= args[4..-1] else ARGS:=NULL fi;\n if type(x,tensorbasmonom) then\n \+ L:=op(x):\n a:=L[1..i-1]:\n b:=L[i+2..nops([L])];\n `&t`(a,C lifford:-displayid(f(L[i],L[i+1],ARGS)),b);\n elif type(x,tensormonom ) then\n cf,term:=remove(type,x,`tensorbasmonom`),select(type,x,`te nsorbasmonom`);\n return cf*&map(term,i,f,ARGS);\n elif type(x,`+` ) then\n map(`&map`,expand(x),i,f,ARGS);\n elif x=0 then \n ret urn 0\n else\n ERROR(`Wrong type in &map`);\n fi;\nend proc: # &m ap\n\n\n##\n## No PACK-19. mapop\n##\nmapop:=proc(x,i,LinOp)\n local L,a,b,c,cf,term,ARGS; \n option `Copyright (c) Ablamowicz, Fauser 1 999-2003. All rights reserved.`;\n if nargs >3 then ARGS:=args[4..-1] else ARGS:=NULL fi;\n if type(x,tensorbasmonom) then\n L:=[op(x)] ;\n if 1=nops(L) then \n return &t(LinOp(op(x),ARGS)) \n el se\n a:=L[1..i-1];\n b:= LinOp(L[i],ARGS);\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) the n\n cf,term:=select(type,x,`cliscalar`),remove(type,x,`cliscalar`); \n return cf*procname(term,i,LinOp,ARGS); \n elif type(x,tensor polynom) then\n return map(procname,x,i,LinOp,ARGS); \n elif type (x,\{clibasmon,climon,clipolynom\}) then\n return LinOp(x,ARGS)\n \+ elif x=0 then \n return 0\n else\n ERROR(`Unknown type in mapop , cannot process`,x);\n fi\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 1999-2003. All rights reserved.`;\n if type(x,tensorbasmonom) then\n L:=op(x);\n if nops([L]) < 2 \+ then \n ERROR(`mapop2 needs at least a two-tensor as input`);\n \+ elif nops([L]) = 2 then\n RETURN(LinOp2(x))\n fi; \n a:=L inOp2(&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,`tensorb asmonom`),select(type,x,`tensorbasmonom`);\n return cf*procname(ter m,i,LinOp2); \n elif type(x,tensorpolynom) then\n return map(pr ocname,x,i,LinOp2); \n else\n ERROR(`Unknown type in mapop2, cann ot process`,x);\n fi\nend proc: # mapop2\n\n\n##\n## No PACK-21. tsol ve1\n##\ntsolve1:=proc(eq,indet,covectors)\n local i,TT,vec,CV,co_vec ,vars,sol,sys,tmp_eq;\n option `Copyright (c) Ablamowicz, Fauser 1999 -2003. All rights reserved.`;\n if type(indet,list) then\n vars:=c onvert(indet,set);\n else\n vars:=select(type,indets(indet),indexe d);\n fi;\n if type(covectors,list) then\n CV:=convert(covectors, set);\n else\n CV:=select(type,indets(covectors),indexed);\n fi; \n sys:=\{\}:\n for i from 1 to nops(CV) do\n tmp_eq:=coeff(eq,CV [i]);\n TT:=Clifford:-cliterms(tmp_eq);\n sys:=sys union \{coeff s(tmp_eq,TT)\};\n od:\n sol:=[solve(sys,vars)];\n return sol; \n e nd proc: # tsolve1\n\n\n##\n## No PACK-22. EV (eval)\n##\nEV:=proc(x, y)\n local cf,term,lst,i,n;\n option `Copyright (c) Ablamowicz, Faus er 1999-2003. All rights reserved.`;\n if x=0 or y=0 then RETURN(0) f i;\n if type(x,clibasmon) then\n if type(y,clibasmon) then\n \+ if Clifford:-extract(x,`integers`) = Clifford:-extract(y,`integers`) t hen\n return 1;\n else\n return 0;\n fi;\n \+ elif type(y,climon) then\n cf,term:=select(type,y,`cliscalar`),re move(type,y,`cliscalar`);\n return cf*procname(x,term);\n elif type(y,clipolynom) then\n lst:=[op(y)]:\n return add(procna me(x,lst[i]),i=1..nops(lst));\n else\n ERROR(`Wrong type in EV `);\n fi;\n elif type(x,climon) then\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 e lse\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) Ablamowicz, Fauser 1999-2003. All rig hts reserved.`;\n bas:=Clifford:-cbasis(dim_V);\n Clifford:-clicolle ct(simplify(add(add(R[i,j]*EV(bas[j],x)*bas[i],i=1..2^dim_V),j=1..2^di m_V))); \nend proc: # linop\n\n\n##\n## No PACK-23. op2mat\n##\nop2m at:=proc(fkt)\n option `Copyright (c) Ablamowicz, Fauser 1999-2003. A ll rights reserved.`;\n global dim_V;\n local i,j,bas,ARGS;\n if na rgs >1 then ARGS:=args[2..-1] else ARGS:=NULL fi;\n bas:=Clifford:-cb asis(dim_V):\n linalg[matrix](2^dim_V,2^dim_V,(i,j)->EV(bas[i],fkt(ba s[j],ARGS)));\nend proc:\n\n\n##\n## No PACK-23. lists2mat\n##\nlists 2mat:=proc(lst1,lst2)\n option `Copyright (c) Ablamowicz, Fauser 1999 -2003. All rights reserved.`;\n global dim_V;\n local i,j,bas;\n li nalg[matrix](2^dim_V,2^dim_V,(i,j)->EV(lst1[i],lst2[j]));\nend proc:\n \n##\n## No PACK-24. linop2\n##\nlinop2:=proc(x,MAT)\n local res,co, erg1,erg2,bas,i,j,a,b,lst,terms,tr_table;\n global dim_V;\n option ` Copyright (c) Ablamowicz, Fauser 1999-2003. 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,tensormonom) then\n lst:=[x]:\n elif type(x,tensorpolynom) then\n lst:=[op(x)]:\n else\n ERROR(`ass umes first argument to be a 2-tensor`);\n fi;\n res:=0:\n for terms in lst do\n erg1,erg2 := peek(terms,1);\n if type(erg1,clibasmo n) then\n co:=1;\n else\n co,erg1:=select(type,erg1,clisc alar),remove(type,x,`cliscalar`);\n fi; \n a:=tr_table[erg1]:\n \+ b:=tr_table[op(erg2)]:\n for i from 1 to 2^dim_V do\n for j f rom 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##\nop2mat2:=proc(fkt)\n option `Copyrigh t (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`;\n global d im_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:=Clifford:-cbasis(dim_V):\n mat:=lina lg[matrix](4^dim_V,4^dim_V):\n for i from 1 to 2^dim_V do\n for j fr om 1 to 2^dim_V do\n for p from 1 to 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:o d: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-2003. All 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:=N ULL 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(contrac t(&t(switch(source[i],1),target[j]),2,EV),1,EV):\n od:od:\n evalm(ma t); \nend proc:\n\n\n##\n## No PACK-27. VERSION\n##\nVERSION:=proc() \n option `Copyright (c) Ablamowicz, Fauser 1999-2003. All rights r eserved.`; \n printf(`<============================================ =================>\\n`);\n printf(` \260\260Bi-Gebra Package VERSI ON 1.01 for Clifford version 6\260\260\\n`);\n printf(` by Rafal Ablamowicz(\247) and Bertfried Fauser(*)\\n`);\n printf(` (c) \+ Dec-16-99 / Oct-22-2002\\n`);\n printf(` Available from http://m ath.tntech.edu/rafal/\\n`);\n printf(` \+ \\n`);\n printf(` (\247) Department of Mathemat ics, Box 5054 \\n`);\n printf(` Tennessee Technological \+ University \\n`);\n printf(` Cookeville, TN 38505, U.S. A. \\n`);\n printf(` Email: rablamowicz@tntech.ed u \\n`);\n printf(` URL: http://math.tntech.edu/ rafal/\\n`);\n printf(` (*) Universit\"at Konstanz \+ \\n`);\n printf(` Fachbereich Physik, Fach M678 \+ \\n`);\n printf(` 78457 Konstanz, Germany \+ \\n`);\n printf(` Email: Bertfried.Fauser@uni-konstanz.de \+ \\n`);\n printf(` URL: http://clifford.physik.uni-konstanz.d e/~fauser/\\n`);\n printf(` \+ \\n`);\n printf(`Online help available with: \+ \\n`);\n printf(` > ?Bigebra \+ \\n`);\n printf(` or use 'help' menue and search for to pics \\n\\n`);\n printf(`Copyright (c) Rafal Ablamowicz, Bertfried \+ Fauser 1999-2003.\\n`);\n printf(` All rights reserved . See also > ?Bigebra[help]\\n\\n`);\n printf(` BUG-REPORTS to Bert fried 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, Fauser 1999-2003. All rights reserved.`; \n local nu ll;\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 `C opyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`; \n \+ if evalb(x) then ; else x; fi;\nend proc: # remove_eq\n\n\n########### ##################################################################### \n# \+ #\n# beta functions \+ #\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 global dim_V;\n option `Copyright (c) Ablamowicz, \+ Fauser 1999/02. All rights reserved.`;\n if type(x,tensorbasmonom) th en\n L:=op(x);\n if nops([L]) = 1 then\n return &t(Clifford :-LC(L,Clifford:-wedge(seq(e||k,k=1..dim_V))));\n else\n a:=Cl ifford:-LC(L[i],&w(seq(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 r eturn cf*procname(term,i); \n elif type(x,tensorpolynom) then\n \+ return map(procname,x,i); \n elif type(x,`clibasmon`) or type(x,`cl imon`) or type(x,`clipolynom`) then\n return Clifford:-LC(x,Cliffor d:-wedge(seq(e||k,k=1..dim_V)));\n else\n ERROR(`No known type, ca nnot process`,x);\n fi\nend:\n\n\n################################### #############################################\n# \+ #\n# unused f unctions for compatibility 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) Ab lamowicz, Fauser 1999-2003. All rights reserved.`;\n if type(x,clibas mon) then\n lst:=Clifford:-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,climon) then\n cf:=select(type,x,`cliscalar`); \n if nops([cf]) > 1 then\n cf := map(`*`,cf);\n fi;\n t erm:=x/cf;\n return cf*procname(term,i);\n else\n map(procname, x,i);\n fi; \nend proc: # eps\n\nend module:\n# Bigebra\n\nlibname[1] ;\nsavelib(Bigebra);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 "restart:wit h(Clifford):with(Bigebra);" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#Q6C:\\Ma ple6/Cliffordlib6\"" }}{PARA 6 "" 1 "" {TEXT -1 83 "Increase verbosity by infolevel[`function`]=val -- use online help > ?Bigebra[help]" }} {PARA 12 "" 1 "" {XPPMATH 20 "6#7C%%&ccoG%%&gcoG%'&gco_dG%(&gco_plG%%& mapG%#&vG%#EVG%(VERSIONG%(bracketG%)contractG%'drop_tG%$epsG%*gantipod eG%)gco_unitG%(gswitchG%&hodgeG%&linopG%'linop2G%*lists2matG%+lists2ma t2G%+make_BI_IdG%&mapopG%'mapop2G%%meetG%'op2matG%(op2mat2G%(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`);" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}}{MARK "0 8 0" 1092 } {VIEWOPTS 1 1 0 1 1 1803 1 1 1 1 }{PAGENUMBERS 0 1 2 33 1 1 }