{VERSION 5 0 "IBM INTEL NT" "5.0" } {USTYLETAB {CSTYLE "Maple Input" -1 0 "Courier" 0 1 255 0 0 1 0 1 0 0 1 0 0 0 0 1 }{CSTYLE "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 19 "Bigebra_M8_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-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, 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 627 "###\n### Bigebra_M8_1.01.mws of Dec#-16-99 -- Oct-1 0-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### Tenne ssee Technological University\n### Cookeville, TN 38505 \n### \+ U.S.A.\n### rablamowicz@tntech.edu\n### http://math.tntech .edu/rafal/\n###\n### (*) Universit\"at Konstanz\n### Fachbereic h Physik\n### Fach M678\n### 78457 Konstanz\n### German y\n### Bertfried.Fauser@uni-konstanz.de\n### http://kaluza.p hysik.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, provided it is distrubuted with full source and this header.\n### Commerc ial distribution need explicite permission by the copyright holder.\n# ## It is prohibited to translate this software into other languag es etc. \n###\n###\n### DISCLAIMER:\n###\n### This software comes as -is and without any guaratee. Using this software" }}{PARA 0 "" 0 "" {TEXT 257 154 "### may result in miscomputation, damages of your syst em or computer at your\n### risk. The autors do not take any responsi bility. Nevertheless they made" }}{PARA 0 "" 0 "" {TEXT 258 60 "### a ny 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 st art by defining a new module Bigebra which has the option package. Imp ortant things are\n-- The package is executed on startup when loaded \+ like any Maple code.\n-- Types have to be made globaly available, hen ce they have to be defined in the startup routine." }}{PARA 14 "" 0 " " {TEXT -1 0 "" }}{PARA 14 "> " 0 "" {MPLTEXT 1 0 29440 "Bigebra:=modu le()\n export `&gco`,`&gco_pl`,`&gco_d`,make_BI_Id,`&cco`,\n \+ gco_unit,switch,gswitch,peek,poke,`&v`,meet,\n tcollect,p airing,bracket,contract,gantipode,\n `&map`,mapop,mapop2,tso lve1,EV,\n linop,op2mat,lists2mat,linop2,op2mat2,lists2mat2, \n VERSION,drop_t,remove_eq,\n hodge,eps; \n glob al dim_V,`type/tensorbasmonom`, `type/tensormonom`, `type/tensorpolyno m`;\n local gco_monom,gpl_co_monom,gpl_co_monom2,co_d_monom,gco_d_m onom,cco_monom, #F,\n init,exit;\n # co_dec_monom2,co _map_monoms,co_map_monoms_t,co_tensor,co_prod,cco_prod\n option packa ge,\n load=init,\n unload=exit,\n `Copyright ( c) Ablamowicz, Fauser 1999-2003. All rights reserved.`; \n init:=pro c()\n option `Copyright (c) Ablamowicz, Fauser 1999-2003. All right s 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 printf(\"Increase ve rbosity by infolevel[`function`]=val -- use online help > ?Bigebra[hel p]\\n\");\n\n \n ##################################################### #############################\n # \+ #\n # export types to tople vel namespace (polution, bahhh) #\n # \+ \+ #\n ############################################################### ###################\n ##\n ## No INIT-1.\n ##\n `type/tensorbasmon om`:=proc(p)\n option `Copyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`; \n evalb(`&t`=op(0,p))\n end proc: # typ e/tensorbasmonom\n\n ##\n ## No INIT-2.\n ##\n `type/tensormonom`: =proc(p)\n option `Copyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`; \n if type(p,`tensorbasmonom`) then return tr ue fi; \n if type(p,`*`) and 1<>select(type,p,`tensorbasmonom`) th en\n true;\n else\n false \n fi;\n end proc: # ty pe/tensormonom\n\n ##\n ## No INIT-3.\n ##\n `type/tensorpolynom`: =proc(p) \n option `Copyright (c) Ablamowicz, Fauser 1999-2003. Al l 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\n exit:=proc()\n return \"Nice to have served you, .... hope to see yo u again!\";\nend proc; # exit \n\n\n################################ ###################################################\n# \+ #\n# \+ Here follow local functions \+ #\n# \+ #\n########################################## #########################################\n\n##\n## No LOC-1. Grassma nn product for points (vectors)\n##\ngco_monom:=proc(x,name)\n local fun,a,list1,list2,du1,du2,NL,NP,NR,vz,i,j;\n global _CLIENV;\n op tion `Copyright (c) Ablamowicz, Fauser 1999-2003. All 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:=n ops(list2)+1; ## added 1 here\n add((_CLIENV[_QDEF_PREFACTOR])^(add (list2[i][j]-j,j=1..nops(list2[i])))* \n `name`(Clifford:-makecli basmon(map(fun,list2[i])),\n Clifford:-makeclibasmon(map(f un,list2[NP-i]))),i=1..NP-1);\nend proc: ### 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_mon om`:=proc(x) \n local u;\n global F,`convert/dwedge_to_wedge`,`con vert/wedge_to_dwedge`; \n option `Copyright (c) R. Ablamowicz, B. Fa user 1999-2003. All rights reserved.`; \n u := proc (z) convert(z,w edge_to_dwedge,F) end; \n mapop(mapop(`&gco`(convert(x,dwedge_to_wed ge,-F)),1,u),2,u) \nend:\n\n\n##\n## No LOC-3. Grassmann co-product o f hyperplanes \n##\ngpl_co_monom:=proc(x,name)\n local b,NL;\n glo bal _CLIENV,dim_V;\n option `Copyright (c) Ablamowicz, Fauser 1999-2 003. 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 proc: ### gpl_co_monom \n\n\n##\n## No LOC-4. Grassmann co-product of hyperplanes ver2 (not i n use) \n##\ngpl_co_monom2:=proc(x,name)\n local b,NL;\n global _C LIENV,dim_V;\n option `Copyright (c) Ablamowicz, Fauser 1999-2003. A ll rights reserved.`;\n b:=&gco(Clifford:-makeclibasmon([seq(i,i=1.. dim_V)]));\n NL:=nops(Clifford:-extract(x));\n &map(name(x,b),1,Cl ifford:-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 re served.`;\n if type(x,clibasmon) then\n if x = Id then \n ret urn 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 ret urn &map(&map(res,3,Clifford:-wedge),1,Clifford:-wedge);\n fi;\n e lif type(x,climon) then\n cf,term:=select(type,x,`cliscalar`),remov e(type,x,`cliscalar`);\n return expand(cf*procname(term));\n elif \+ type(x,clipolynom) then\n return map(procname,x); \n else\n \+ error \"received unknown type in cco_monom to process\";\n fi;\nend p roc: # cco_monom\n\n\n################################################ ###################################\n# \+ #\n# Here follow expo rted 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, Fau ser 1999-2003. All rights reserved.`;\n if type(x,clibasmon) then\n \+ return gco_monom(x,`&t`);\n elif type(x,climon) then\n co,te rm:=select(type,x,cliscalar),remove(type,x,cliscalar);\n return ex pand(co*gco_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_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 e lif type(x,tensormonom) then\n co,term:=remove(type,x,tensorbasmon om),select(type,x,tensorbasmonom);\n return expand(co*procname(ter m,i));\n elif type(x,tensorpolynom) then\n return map('procname' ,x,i)\n else error \"wrong type in &gco\"\n fi:\nend proc: ### &gc o\n\n\n##\n## No PACK-2. meet (definition 1)\n##\n`&v`:=proc(x,y)\n l ocal xx,res,lst,var_i,v1,v2;\n option `Copyright (c) Ablamowicz, Faus er 1999-2003. 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 re s := 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 `Copyright (c) Ablamo wicz, Fauser 1999-2003. All rights reserved.`;\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:-wedge(v1,x))*op(v2);\n od;\n res; \nend proc: # meet\n\n\n##\n## No PACK-4. Grassmann co-product of hyp erplanes (Pluecker coordinates)\n##\n`&gco_pl`:=proc(x,i) \n local c o,term,xx,a,b,c;\n option `Copyright (c) R. Ablamowicz, B. Fauser 19 99-2003. 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,ter m:=select(type,x,'cliscalar'),remove(type,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,tensorbasmono m) 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) 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 m ap('procname',x,i)\n elif x=0 then\n return 0\n else error \"w rong type in &gpl_co\"\n fi:\nend proc: ### &gpl_co\n\n##\n## No PACK -5. dotted Grassmann co-product computed in the undotted basis\n##\n`& gco_d`:=proc(x, i) \n local co, term, xx, a, b, c; \n option `Copy right (c) R. Ablamowicz, B. Fauser 1999-2003. All rights reserved.`; \+ \n \n### ===> CAUTION THIS MIGHT NOT WORK <=== ###\n if not type(&C( e1,e2),cliprod) then \n WARNING(`Need 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,cliscalar), remove(type,x,cliscalar); \n return expand(co*gco_d_monom(term,`&t`)) \n elif type(x,clip olynom) 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 .. nops([xx])]; \n \+ return `&t`(a,gco_d_monom(b,`&t`),c) \n elif type(x,tensormonom) t hen \n co, term := remove(type,x,tensorbasmonom), select(type,x,te nsorbasmonom); \n return expand(co*procname(term,i)) \n elif typ e(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,bas,res;\n option \+ `Copyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`;\n \+ if evalb(dim_V='dim_V') then\n ERROR(`global variable dim_V must b e assigned`);\n else\n if not type(BI,matrix) then\n BI:=lina lg[matrix](dim_V,dim_V):\n fi;\n res:=[]:\n for i from 0 to d im_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(BI_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,a rs,func,co,term,res,j,xx,a,b,c,bl,aa,ff,p,L;\n option `Copyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`;\n if type(x,\{ clipolynom,climon,clibasmon\}) then\n return cco_monom(x);\n eli f 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 := sele ct(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 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##\ngco_unit:=proc(x,i)\n local a,b, cf,term;\n option `Copyright (c) Ablamowicz, Fauser 1999-2003. All ri ghts 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:-scalarpart(a)*b;\n fi; \n elif type(x,tensormonom) then\n cf,term:=select(type,x,`cliscal ar`),remove(type,x,`cliscalar`);\n return cf*gco_unit(term,i);\n e lif type(x,tensorpolynom) then\n map(gco_unit,x,i);\n elif\n ty pe(x,clibasmon) then\n return Clifford:-scalarpart(x)*Id;\n elif x=0 then\n return 0;\n else\n error \"Wrong type 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 local cf,term,a,L ,res,n1,n2,b,res2;\n option `Copyright (c) Ablamowicz, Fauser 1999-20 03. All rights reserved.`;\n if type(x,tensorbasmonom) then\n L:=o p(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(t ype,x,'cliscalar'),remove(type,x,`cliscalar`);\n return expand(cf*p rocname(term,i));\n elif type(x,`+`) then\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 loca l 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,tens orbasmonom) then\n L:=op(x);\n a:=L[i];\n b:=L[i+1];\n ret urn (_CLIENV[_QDEF_PREFACTOR])^(nops(Clifford[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 return expand(cf*gswitch(term,i));\n elif type(x,`+`) then\n map(gswitch,expand(x),i);\n elif x=0 the n\n return 0\n else\n error \"Wrong type in gswitch\";\n fi;\n end proc: # gswitch\n\n\n##\n## No PACK-11. peek\n##\npeek:=proc(x,i) \n local a,b,L,cf,term;\n option `Copyright (c) Ablamowicz, Fauser 1 999-2003. 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 el se\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(type,x,`cliscalar`);\n a,b:=pro cname(term,i);\n return cf*a,b;\n elif type(x,tensorpolynom) then \n L:=op(x):\n return seq([peek(term,i)],term=L);\n else \n \+ error \"wrong type, only tensorbasmonom and tensormonom allowed in pee k\"\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) Ablamowic z, Fauser 1999-2003. All rights reserved.`;\n if type(y,\{clibasmon,c limon,clipolynom\}) then\n if type(x,tensorbasmonom) then\n if nops([op(x)]) = 1 then\n if i = 1 then\n return tcoll ect(&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) 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,c limon,clipolynom\}) then\n if i=1 then \n return &t(y,x) \+ \n else \n return &t(x,y) \n fi:\n else\n er ror \"unknown type in poke\"\n fi:\n else \n error \"second arg ument 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-2003. All rights reserved.`;\n collect(x ,`&t`);\nend proc: # tcollect\n\n\n##\n## No PACK-14. pairing\n##\npa iring:=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:-scalarpart(Clifford :-LC(x,y))\n fi\nend proc: # pairing\n\n\n##\n## No PACK-15. contrac t\n##\ncontract:=proc(x,i,f)\n local n,a,b,t,cf,term;\n option `Copy right (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`;\n if t ype(x,tensorbasmonom) then\n if nops([op(x)]) <= 1 then\n erro r \"Tensor with two args at least needed\";\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 elif type(x,tensormonom) then\n \+ cf,term:=select(type,x,`cliscalar`),remove(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 er ror \"Wrong type in contract, can process only tensorpolynoms of grade higher than two\";\n fi; \nend proc: # contract\n\n\n##\n## No PAC K-16. bracket\n##\nbracket:=proc()\n global dim_V;\n option `Copyri ght (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`; \n c oeff(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##\ngantipod e:=proc(x,i)\n local n,a,b,cf,term;\n global _CLIENV;\n option `Cop yright (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`;\n if \+ type(x,tensorbasmonom) then\n if nops([op(x)]) = 1 then\n n:=n ops(Clifford:-extract(op(x)));\n return _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_PREFACTOR]^(n)*a,i);\n elif typ e(x,tensormonom) then\n cf,term:=select(type,x,`cliscalar`),remove( type,x,`cliscalar`);\n return cf*procname(term,i);\n elif type(x,t ensorpolynom) 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 gantipode, c an process only clipolynoms and tensorpolynoms\";\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 `Copyright (c) Ablamowicz, 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,Clifford:- 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,`tensorbasmo nom`);\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 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:=proc(x,i,LinOp)\n local L,a,b,c ,cf,term,ARGS; \n option `Copyright (c) Ablamowicz, Fauser 1999-2003 . All rights reserved.`;\n if nargs >3 then ARGS:=args[4..-1] else AR GS:=NULL fi;\n if type(x,tensorbasmonom) then\n L:=[op(x)];\n i f 1=nops(L) then \n return &t(LinOp(op(x),ARGS)) \n else\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) then\n c f,term:=select(type,x,`cliscalar`),remove(type,x,`cliscalar`);\n re turn cf*procname(term,i,LinOp,ARGS); \n elif type(x,tensorpolynom) then\n return map(procname,x,i,LinOp,ARGS); \n elif type(x,\{cli basmon,climon,clipolynom\}) then\n return LinOp(x,ARGS)\n elif x=0 then \n return 0\n else\n error \"Unknown type in mapop, canno t 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 optio n `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: =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,`tensor basmonom`),select(type,x,`tensorbasmonom`);\n return cf*procname(te rm,i,LinOp2); \n elif type(x,tensorpolynom) then\n return map(p rocname,x,i,LinOp2); \n else\n ERROR(`Unknown type in mapop2, can not process`,x);\n fi\nend proc: # mapop2\n\n\n##\n## No PACK-21. tso lve1\n##\ntsolve1:=proc(eq,indet,covectors)\n local i,TT,vec,CV,co_ve c,vars,sol,sys,tmp_eq;\n option `Copyright (c) Ablamowicz, Fauser 199 9-2003. All rights reserved.`;\n if type(indet,list) then\n vars:= convert(indet,set);\n else\n vars:=select(type,indets(indet),index ed);\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 8\260\260\\n`);\n printf(` by Rafal Ablamowicz(\247) and Bertfried Fauser(*)\\n`);\n printf(` (c) \+ Dec-16-99 / Nov-16-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 ple8/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 "4 0 0" 0 } {VIEWOPTS 1 1 0 1 1 1803 1 1 1 1 }{PAGENUMBERS 0 1 2 33 1 1 }