diff --git a/clifford.mac b/clifford.mac index f4ee2c9..e07132c 100644 --- a/clifford.mac +++ b/clifford.mac @@ -104,6 +104,7 @@ ratprint:false; else expand((a.b + cinvolve(b).cinvolve(a))/2); */ + wedgesimp:true; inprotype:sym; declare("|", additive); @@ -115,10 +116,12 @@ ratprint:false; if not mapatom(b) then b:expand(b), if inop(a)="+" then return (map( lambda ([u], u | b), a)), if inop(b)="+" then return (map( lambda ([u], a | u), b)), - if not freeof(".", a) then - a:cliffsimp1(a), - if not freeof(".", b) then - b:cliffsimp1(b), + if wedgesimp then ( + if not freeof(".", a) then + a:cliffsimp1(a), + if not freeof(".", b) then + b:cliffsimp1(b) + ), l:maxgrade(a), r:maxgrade(b), qq: l-r, @@ -162,7 +165,13 @@ ratprint:false; if mapatom(a) and mapatom(b) then if a#b then return(a.b) else return (0), - + + if wedgesimp then ( + if not freeof(".", a) then + a:cliffsimp1(a), + if not freeof(".", b) then + b:cliffsimp1(b) + ), [ra, la]: oppart(a, lambda([u], freeof ("~", u) and scalarp(u) )), ra:subst(nil=1, ra), la:subst(nil=1, la), @@ -206,10 +215,12 @@ ratprint:false; if not mapatom(b) then b:expand(b), if inop(a)="+" then return (map( lambda ([u], u & b), a)), if inop(b)="+" then return (map( lambda ([u], a & u), b)), - if not freeof(".", a) then - a:cliffsimp1(a), - if not freeof(".", b) then - b:cliffsimp1(b), + if wedgesimp then ( + if not freeof(".", a) then + a:cliffsimp1(a), + if not freeof(".", b) then + b:cliffsimp1(b) + ), l:maxgrade(a), r:maxgrade(b), /*display(l,r),*/ @@ -351,9 +362,30 @@ permsign(arr):=block([k:0, len, ret:0 ] , ); /* -simplification rules +Abstract Cliford algebra construction */ -matchdeclare([aa, ee], lambda([u], not freeof(asymbol,u) and freeof ("+", u) and not scalarp(u) ), [bb,cc], true, [kk, mm, nn], integerp); +matchdeclare([aa, ee], lambda([u], not freeof(asymbol,u) and freeof ("+", u) and not scalarp(u) ), [bb,cc], true, + [kk, mm, nn], lambda( [z], integerp(z) and z>0)); + +if get('clifford,'version)=false then ( + tellsimp(aa[kk].aa[kk], signature[kk] ), + tellsimpafter(aa[kk].aa[mm], dotsimp2(aa[kk].aa[mm])), + tellsimpafter(bb.ee.cc, dotsimpc(bb.ee.cc)), + tellsimp(bb^nn, bb^^nn) +); + +/* experimental code*/ +if get('clifford,'version)=false then ( + /* simplification of powers + tellsimpafter(aa[kk]^nn, powsimp(aa[kk]^nn)),*/ + tellsimpafter(aa[kk]^^nn, powsimp(aa[kk]^^nn)), + /* simplification of involution*/ + tellsimpafter('cinvolve('cinvolve(bb)), bb) +); + +/* +simplification rules +*/ matchdeclare(dd, lambda([u], freeof(asymbol, u)), gg, lambda([u], not freeof(asymbol, u))); matchdeclare(ds, lambda([u], not freeof(asymbol, u) and not (freeof("^", u) or freeof("^^", u) ) ), rn, numberp); @@ -436,9 +468,9 @@ cinv(ab):=block( [s, b, u:1], /* simplification of exponents */ -powsimp(aa):=block( [a,k,p:1], +powsimp(aa):=block( [a, k, p:1], if atom(aa) then return(aa), - if op(aa)="^^" or op(aa)="^" then ( + if inop(aa)="^^" then ( a:inpart(aa,1), k:inpart(aa,2), for j:1 thru k do @@ -448,20 +480,6 @@ powsimp(aa):=block( [a,k,p:1], else aa ); - /* - Abstract Cliford algebra construction - */ -if get('clifford,'version)=false then ( - tellsimp(aa[kk].aa[kk], signature[kk] ), - tellsimpafter(aa[kk].aa[mm], dotsimp2(aa[kk].aa[mm])), - tellsimpafter(bb.ee.cc, dotsimpc(bb.ee.cc)), - tellsimpafter(bb*ee, subst("*"=".", bb*ee)), - /* simplification of powers*/ - tellsimp(bb^nn, (bb^^nn)), - tellsimpafter(aa[kk]^^nn, powsimp(aa[kk]^^nn)), - /* simplification of involution*/ - tellsimpafter('cinvolve('cinvolve(bb)), bb) -); /* diff --git a/climoivre.mac b/climoivre.mac deleted file mode 100644 index 20e46a9..0000000 --- a/climoivre.mac +++ /dev/null @@ -1,93 +0,0 @@ -/******************************* -Clifford algebra -a lightweight package for performing Geometric Algebra calculations - -Clifford exponential simplifications - -@depends 'clifford - -********************************** - * @license This library is free software; you can redistribute it and/or - * modify it under the terms of the GNU Lesser General Public - * License as published by the Free Software Foundation; either - * version 2.1 of the License, or (at your option) any later version. - * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public - * License along with this library; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - */ - -if get('clifford,'version)=false then ( - load("clifford"), - - simp:false, - tellsimpafter(conjugate(rr),rr), - tellsimpafter(conjugate(aa), conjsimp(aa)), - defrule (rsimp1, conjugate(aa), conjsimp(aa) ), - simp:true -); - - -conjsimp(ab):=block([ sop, s ], - if mapatom(ab) or freeof(asymbol, ab) then conjugate(ab) - else ( - sop:inop(ab), - s:inargs(ab), - s: map(conjugate, s), - substinpart(sop,s,0) - ) -); - -/* -syntactic sign -*/ -csign(expr):= - if expr =0 then 0 - else - if atom (expr) then (if expr<0 then 'minus else 'plus) - else - if op(expr)="-" then 'minus else 'plus; - -/* - De Moivre argument -*/ -ceparse(p):=block([l,r,s, q:1, sop], - sop: inop(p), - if sop = "+" then ( - l:maplist(ceparse, p), - substinpart(".", l, 0) - ) else ( - [l,r]:oppart(p, lambda([u], freeof (asymbol, u)) ), - if _debug=true then display(l,r), - if r='nil then - q:exp(l) - else ( - s: expand(r.r), - s: dotsimpc(s), - if l='nil then l:1, - if _debug=true then display(s), - if s<0 or csign(s)=minus then q: cos(l)+r*sin(l), - if s>0 or csign(s)=plus then q: cosh(l)+r*sinh(l), - if s=0 or csign(s)=0 then q: 1+ r*l - ), - q - ) -); - -/* - Clifford De Moivre -*/ -climoivre(expr):=block([l, r, v], - if freeof(%e, expr) then expr - else ( - [l,r]:oppart(expr, lambda([u], freeof (%e, u)) ), - v: inargs(r), - if l='nil then l:1, - l*ceparse(v[2]) - ) -); \ No newline at end of file diff --git a/rtest_clifford2.mac b/rtest_clifford2.mac index 6d215b8..9f8d507 100644 --- a/rtest_clifford2.mac +++ b/rtest_clifford2.mac @@ -67,12 +67,17 @@ e[1] . e[2] . e[1] . e[2], dotsimpc; -1$ e[2] . e[1] . e[1] . e[2], dotsimpc; 1$ +/*inverses*/ 1/e[2],dotinvsimp; -e[2]$ 1/e[1] . e[2], dotinvsimp; -e[1] . e[2]$ 1/(1+e[1]),cliffsimpall,expand; 1/2-e[1]/2$ +(e[1]- e[2])^^2,expand; +-2$ +(e[1]- e[2])^2,expand; +-2$ block( "init clifford geom/pauli", clifford(e,3), @@ -115,12 +120,4 @@ block( jacobprod(a,b,c):= ( a & b & c + b & c & a + c & a & b), ev(jacobprod(e[1] ,e[2], e[3]), dotsimpc) ); -3*(e[1] . e[2] . e[3])$ -/* -clidet([e[1] ,e[2],e[3] ,e[1]]); -0$ -clidet([e[1] ,e[2],e[3] ,e[2]]); -0$ -clidet([e[1] ,e[2],e[3] ,e[3]]); -0$ -*/ \ No newline at end of file +3*(e[1] . e[2] . e[3])$ \ No newline at end of file diff --git a/rtest_clifford4.mac b/rtest_clifford4.mac index 7b11a85..a982579 100644 --- a/rtest_clifford4.mac +++ b/rtest_clifford4.mac @@ -35,8 +35,8 @@ batch("rtest_clifford", test); 'done$ get('clifford,'version); v20$ -a | b + a & b; -a.b$ +/*a | b + a & b; +a.b$*/ (A1: a & b &c + b & c & a + c& a &b, ratsimp(A1+(- a . b . c - a . c . 'cinvolve(b)+a . 'cinvolve(c) . 'cinvolve(b)+ 'cinvolve(a) . 'cinvolve(b) . 'cinvolve(c)- b . a . 'cinvolve(c)+b . 'cinvolve(a) @@ -73,4 +73,12 @@ rot:R1.rr.R2,cliffsimpall; (g[1]*cos(phi/2)^2+g[1]*sin(phi/2)^2)*t+(g[2]*cos(phi/2)^2+2*g[3]*cos(phi/2)*sin(phi/2)-g[2]*sin(phi/2)^2)*x+ (g[3]*cos(phi/2)^2-2*g[2]*cos(phi/2)*sin(phi/2)-g[3]*sin(phi/2)^2)*y+(g[4]*cos(phi/2)^2+g[4]*sin(phi/2)^2)*z$ trigreduce(rot); -g[1]*t+g[2]*cos(phi)*x+g[3]*sin(phi)*x+g[3]*cos(phi)*y-g[2]*sin(phi)*y+g[4]*z$ \ No newline at end of file +g[1]*t+g[2]*cos(phi)*x+g[3]*sin(phi)*x+g[3]*cos(phi)*y-g[2]*sin(phi)*y+g[4]*z$ +/* +clidet([e[1] ,e[2],e[3] ,e[1]]); +0$ +clidet([e[1] ,e[2],e[3] ,e[2]]); +0$ +clidet([e[1] ,e[2],e[3] ,e[3]]); +0$ +*/ \ No newline at end of file