{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 "T imes" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 } {PSTYLE "Text Output" -1 2 1 {CSTYLE "" -1 -1 "Courier" 1 10 0 0 255 1 2 2 2 2 2 1 3 1 3 1 }1 1 0 0 0 0 1 0 1 0 2 2 0 1 }{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 "Maple Output" -1 11 1 {CSTYLE "" -1 -1 "Times " 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }3 3 0 0 0 0 1 0 1 0 2 2 0 1 } {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" -1 14 1 {CSTYLE "" -1 -1 "Times" 1 12 0 0 0 1 2 2 2 2 2 2 1 1 1 1 }1 1 0 0 3 3 1 0 1 0 2 2 14 5 }{PSTYLE "Heading 1" -1 256 1 {CSTYLE "" -1 -1 "Tim es" 1 18 0 0 0 1 2 1 2 2 2 2 1 1 1 1 }3 1 0 0 8 4 1 0 1 0 2 2 0 1 }} {SECT 0 {EXCHG {PARA 256 "" 0 "" {TEXT -1 17 "Bigebra_M7_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, 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 626 "###\n### Bigebra_M7_01.mws of Dec#-16-99 -- Nov 05, 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 29453 "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\n\n\n ini t:=proc()\n option `Copyright (c) Ablamowicz, Fauser 1999-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 printf(\"Incr ease verbosity by infolevel[`function`]=val -- use online help > ?Bige bra[help]\\n\");\n\n \n ############################################## ####################################\n # \+ #\n # export types t o toplevel namespace (polution, bahhh) #\n # \+ #\n ######################################################## ##########################\n ##\n ## No INIT-1.\n ##\n `type/tenso rbasmonom`:=proc(p)\n option `Copyright (c) Ablamowicz, Fauser 199 9-2003. All rights reserved.`; \n evalb(`&t`=op(0,p))\n end proc : # type/tensorbasmonom\n\n ##\n ## No INIT-2.\n ##\n `type/tensor monom`:=proc(p)\n option `Copyright (c) Ablamowicz, Fauser 1999-20 03. All rights reserved.`; \n if type(p,`tensorbasmonom`) then re turn true fi; \n if type(p,`*`) and 1<>select(type,p,`tensorbasmon om`) then\n true;\n else\n false \n fi;\n end pro c: # type/tensormonom\n\n ##\n ## No INIT-3.\n ##\n `type/tensorpo lynom`:=proc(p) \n option `Copyright (c) Ablamowicz, Fauser 1999-2 003. All rights reserved.`; \n if type(p,`tensormonom`) then retu rn 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: ### i nit\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:=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-2003. All rights re served.`;\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):=l ist1[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:-makeclibasmo n(map(fun,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`g co_d_monom`:=proc(x) \n local u;\n global F,`convert/dwedge_to_wed ge`,`convert/wedge_to_dwedge`; \n option `Copyright (c) R. Ablamowic z, B. Fauser 1999-2003. All rights reserved.`; \n u := proc (z) con vert(z,wedge_to_dwedge,F) end; \n mapop(mapop(`&gco`(convert(x,dwedg e_to_wedge,-F)),1,u),2,u) \nend:\n\n\n##\n## No LOC-3. Grassmann co-p roduct of hyperplanes \n##\ngpl_co_monom:=proc(x,name)\n local b,NL; \n global _CLIENV,dim_V;\n option `Copyright (c) Ablamowicz, Fause r 1999-2003. All rights reserved.`;\n b:=&gco(Clifford:-makeclibasmo n([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_c o_monom\n\n\n##\n## No LOC-4. Grassmann co-product of hyperplanes ver2 (not in use) \n##\ngpl_co_monom2:=proc(x,name)\n local b,NL;\n gl obal _CLIENV,dim_V;\n option `Copyright (c) Ablamowicz, Fauser 1999- 2003. All 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,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 ri ghts 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 f i;\n elif type(x,climon) then\n cf,term:=select(type,x,`cliscalar` ),remove(type,x,`cliscalar`);\n return expand(cf*procname(term));\n elif type(x,clipolynom) then\n return map(procname,x); \n els e\n ERROR(`received unknown type in cco_monom to process`);\n fi; \nend proc: # cco_monom\n\n\n######################################### ##########################################\n# \+ #\n# Here foll ow exported function \+ #\n# \+ #\n################################################### ################################\n\n##\n## No PACK-1.\n##\n`&gco`:=pro c(x,i) \n local co,term,xx,a,b,c;\n option `Copyright (c) Ablamowi cz, Fauser 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,term:=select(type,x,cliscalar),remove(type,x,cliscalar);\n re turn expand(co*gco_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 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,tenso rbasmonom),select(type,x,tensorbasmonom);\n return expand(co*procn ame(term,i));\n elif type(x,tensorpolynom) then\n return map('pr ocname',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 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. meet (definition 2)\n##\nmeet :=proc(x,y)\n local yy,res,lst,var_i,v1,v2;\n option `Copyright (c) \+ Ablamowicz, 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 o f hyperplanes (Pluecker coordinates)\n##\n`&gco_pl`:=proc(x,i) \n lo cal co,term,xx,a,b,c;\n option `Copyright (c) R. Ablamowicz, B. Faus er 1999-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 c o,term:=select(type,x,'cliscalar'),remove(type,x,'cliscalar');\n r eturn expand(co*gpl_co_monom(term,`&t`));\n elif type(x,clipolynom) \+ then\n return expand(map('procname',x));\n elif type(x,tensorbas monom) then\n if nops([op(x)]) = 1 then\n return gpl_co_mono m(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(ty pe,x,tensorbasmonom),select(type,x,tensorbasmonom);\n return expan d(co*procname(term,i));\n elif type(x,tensorpolynom) then\n retu rn 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 P ACK-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 ` Copyright (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,clibas mon) then \n return gco_d_monom(x,`&t`) \n elif type(x,climon) t hen \n co, term := select(type,x,cliscalar), remove(type,x,cliscal ar); \n return expand(co*gco_d_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 ret urn 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,tensormon om) then \n co, term := remove(type,x,tensorbasmonom), select(type ,x,tensorbasmonom); \n return expand(co*procname(term,i)) \n eli f 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,bas,res;\n opt ion `Copyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved.` ;\n if evalb(dim_V='dim_V') then\n ERROR(`global variable dim_V mu st 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(dim_V,i);\n res:=[op(res ),\n seq(seq([Clifford:-scalarpart(\n Cliffo rd:-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,ars,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 \+ 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 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 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:-scalarpart(a)*b;\n \+ fi;\n elif type(x,tensormonom) then\n cf,term:=select(type,x,`clis calar`),remove(type,x,`cliscalar`);\n return 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 Clifford:-scalarpart(x)*Id;\n e lif 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- 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 return expand(cf *procname(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 loc al 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,ten sorbasmonom) then\n L:=op(x);\n a:=L[i];\n b:=L[i+1];\n re turn (_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 t hen\n return 0\n else\n ERROR(`Wrong type in gswitch`);\n fi; \nend 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 1999-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 \+ 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,te rm:=select(type,x,`cliscalar`),remove(type,x,`cliscalar`);\n a,b:=p rocname(term,i);\n return cf*a,b;\n elif type(x,tensorpolynom) the n\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 argum ent 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##\npair ing:=proc(x,y)\n option `Copyright (c) Ablamowicz, Fauser 1999-2003. \+ All rights reserved.`;\n if nargs=3 then \n Clifford:-scalarpart(C lifford:-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 `Copyr ight (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`;\n if ty pe(x,tensorbasmonom) then\n if nops([op(x)]) <= 1 then\n ERROR (`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:=p eek(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 r eturn cf*procname(term,i,f);\n elif type(x,tensorpolynom) then\n m ap(procname,x,i,f);\n elif x=0 then \n return 0;\n else\n ERRO R(`Wrong type in contract, can process only tensorpolynoms of grade hi gher than two`);\n fi; \nend proc: # contract\n\n\n##\n## No PACK-1 6. bracket\n##\nbracket:=proc()\n global dim_V;\n option `Copyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`; \n coef f(Clifford:-wedge(args),Clifford:-wedge(seq(cat(e,i),i=1..dim_V)));\ne nd 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 option `Copyri ght (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`;\n if typ e(x,tensorbasmonom) then\n if nops([op(x)]) = 1 then\n n:=nops (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 type( x,tensormonom) then\n cf,term:=select(type,x,`cliscalar`),remove(ty pe,x,`cliscalar`);\n return cf*procname(term,i);\n elif type(x,ten sorpolynom) then\n map(procname,x,i);\n elif type(x,\{clibasmon,cl imon,clipolynom\}) then\n return Clifford:-gradeinv(x);\n elif x=0 then\n return 0;\n else\n ERROR(`Wrong type in gantipode, can \+ 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 lo cal cf,term,L,a,b,ARGS;\n option `Copyright (c) Ablamowicz, Fauser 19 99-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:-dis playid(f(L[i],L[i+1],ARGS)),b);\n elif type(x,tensormonom) then\n \+ cf,term:=remove(type,x,`tensorbasmonom`),select(type,x,`tensorbasmonom `);\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 els e\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. Al l 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 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 cf,te rm:=select(type,x,`cliscalar`),remove(type,x,`cliscalar`);\n return cf*procname(term,i,LinOp,ARGS); \n elif type(x,tensorpolynom) the n\n return map(procname,x,i,LinOp,ARGS); \n elif type(x,\{clibasm on,climon,clipolynom\}) then\n return LinOp(x,ARGS)\n elif x=0 the n \n return 0\n else\n ERROR(`Unknown type in mapop, cannot pro cess`,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:=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`),sel ect(type,x,`tensorbasmonom`);\n return cf*procname(term,i,LinOp2); \+ \n elif type(x,tensorpolynom) then\n return map(procname,x,i,Li nOp2); \n else\n ERROR(`Unknown type in mapop2, cannot process`,x );\n fi\nend proc: # mapop2\n\n\n##\n## No PACK-21. tsolve1\n##\ntsol ve1:=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 ri ghts reserved.`;\n if type(indet,list) then\n vars:=convert(indet, set);\n else\n vars:=select(type,indets(indet),indexed);\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 \{coeffs(tmp_eq,TT)\} ;\n od:\n sol:=[solve(sys,vars)];\n return sol; \n end proc: # tso lve1\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, Fauser 1999-2003. \+ 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:-e xtract(x,`integers`) = Clifford:-extract(y,`integers`) then\n r eturn 1;\n else\n return 0;\n fi;\n elif type(y,cl imon) then\n cf,term:=select(type,y,`cliscalar`),remove(type,y,`c liscalar`);\n return cf*procname(x,term);\n elif type(y,clipol ynom) 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) then\n cf,term:=select(type,x,`cliscalar`),re move(type,x,`cliscalar`);\n return cf*procname(term,y);\n elif typ e(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 opt ion `Copyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved.` ;\n bas:=Clifford:-cbasis(dim_V);\n Clifford:-clicollect(simplify(ad d(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-2003. All rights res erved.`;\n global dim_V;\n local i,j,bas,ARGS;\n if nargs >1 then A RGS:=args[2..-1] else ARGS:=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## No PACK-23. lists2mat\n##\nlists2mat:=proc(l st1,lst2)\n option `Copyright (c) Ablamowicz, Fauser 1999-2003. All r ights reserved.`;\n global 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##\nlinop2:=proc(x,MAT)\n local res,co,erg1,erg2,ba s,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,tens orpolynom) then\n lst:=[op(x)]:\n else\n ERROR(`assumes first a rgument 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,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_tab le[op(erg2)]:\n for i from 1 to 2^dim_V do\n for j from 1 to 2^d im_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 PAC K-25. op2mat2\n##\nop2mat2:=proc(fkt)\n option `Copyright (c) Ablamo wicz, Fauser 1999-2003. All rights reserved.`;\n global dim_V;\n loc al i,j,p,q,bas,mat,ARGS;\n if nargs >1 then ARGS:=args[2..-1] else AR GS:=NULL fi;\n bas:=Clifford:-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^di m_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(b as[q],bas[p]),ARGS),bas[i],bas[j]),2,EV),1,EV):\n od:od:od:od:\n eva lm(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,ma t,ARGS;\n if nargs >1 then ARGS:=args[2..-1] else ARGS:=NULL fi;\n m at:=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 pr oc:\n\n\n##\n## No PACK-27. VERSION\n##\nVERSION:=proc()\n option \+ `Copyright (c) Ablamowicz, Fauser 1999-2003. All rights reserved.`; \n printf(`<========================================================= ====>\\n`);\n printf(` \260\260Bi-Gebra Package VERSION 1.01 for C lifford version 7\260\260\\n`);\n printf(` by Rafal Ablamowicz( \247) and Bertfried Fauser(*)\\n`);\n printf(` (c) Dec-16-99 / \+ Nov-05-2002\\n`);\n printf(` Available from http://math.tntech.e du/rafal/\\n`);\n printf(` \+ \\n`);\n printf(` (\247) Department of Mathematics, Box 505 4 \\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 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.de/~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 topics \\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 Bertfried Fause r \\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) Ablamow icz, Fauser 1999-2003. 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-2003. All rights reserved.`; \n if evalb(x) t hen ; else x; fi;\nend proc: # remove_eq\n\n\n######################## ########################################################\n# \+ #\n # beta functions \+ #\n# \+ #\n############################################## ##################################\n##\n## No BETA-1.\n##\n## Not avai lable 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) then\n L:=op( x);\n if nops([L]) = 1 then\n return &t(Clifford:-LC(L,Cliffor d:-wedge(seq(e||k,k=1..dim_V))));\n else\n a:=Clifford:-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:=selec t(type,x,`cliscalar`),remove(type,x,`cliscalar`);\n return cf*procn ame(term,i); \n elif type(x,tensorpolynom) then\n return map(pr ocname,x,i); \n elif type(x,`clibasmon`) or type(x,`climon`) or type (x,`clipolynom`) 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 c ompatibility 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, Fause r 1999-2003. All rights reserved.`;\n if type(x,clibasmon) 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 t ype(x,climon) 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; \n end proc: # eps\n\nend module:\n# Bigebra\n\nlibname[1];\nsavelib(Bige bra);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 "restart:with(Clifford):wit h(Bigebra);" }}{PARA 11 "" 1 "" {XPPMATH 20 "6#Q6C:\\Maple7/Cliffordli b6\"" }}{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%*gantipodeG%)gco_unitG%( gswitchG%&hodgeG%&linopG%'linop2G%*lists2matG%+lists2mat2G%+make_BI_Id G%&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 "2 0 0" 0 }{VIEWOPTS 1 1 0 1 1 1803 1 1 1 1 }{PAGENUMBERS 0 1 2 33 1 1 }