File r38/packages/xideal/xideal.rlg artifact 650ac70e7c part of check-in bb64a0280f


Tue Feb 10 12:28:06 2004 run on Linux

*** ^ redefined 
% Test file for XIDEAL package (Groebner bases for exterior algebra)

% Declare EXCALC variables

pform {x,y,z,t}=0,f(i)=1,{u,u(i),u(i,j)}=0;




% Reductions with xmodideal (all should be zero)

d x^d y      xmodideal {d x - d y};


0

d x^d y^d z  xmodideal {d x^d y - d z^d t};


0

d x^d z^d t  xmodideal {d x^d y - d z^d t};


0

f(2)^d x^d y xmodideal {d t^f(1) - f(2)^f(3),
                         f(3)^f(1) - d x^d y};


0

d t^f(1)^d z xmodideal {d t^f(1) - f(2)^f(3),
                         f(1)^d z - d x^d y,
                         d t^d y - d x^f(2)};


0

f(3)^f(4)^f(5)^f(6)
             xmodideal {f(1)^f(2) + f(3)^f(4) + f(5)^f(6)};


0

f(1)^f(4)^f(5)^f(6)
             xmodideal {f(1)^f(2) + f(2)^f(3) + f(3)^f(4)
                        + f(4)^f(5) + f(5)^f(6)};


0

d x^d y^d z  xmodideal {x**2+y**2+z**2-1,x*d x+y*d y+z*d z};


0



% Changing the division between exterior variables and parameters

xideal {a*d x+y*d y};


  d x*a + d y*y
{---------------}
        a

xvars {a};


xideal {a*d x+y*d y};


{d x*a + d y*y,d x^d y}

xideal({a*d x+y*d y},{a,y});


{d x*a + d y*y,

 d x^d y*y}

xvars {};

       % all 0-forms are coefficients
excoeffs(d u - (a*p - q)*d y);


{1, - a*p + q}

exvars(d u - (a*p - q)*d y);


{d u,d y}

xvars {p,q};

    % p,q are no longer coefficients
excoeffs(d u - (a*p - q)*d y);


{ - a,1,1}

exvars(d u - (a*p - q)*d y);


{d y*p,d y*q,d u}

xvars nil;




% Exterior system for heat equation on 1st jet bundle

S := {d u - u(-t)*d t - u(-x)*d x,
      d u(-t)^d t + d u(-x)^d x,
      d u(-x)^d t - u(-t)*d x^d t};


s := { - d t*u  + d u - d x*u ,
              t              x

       - (d t^d u  + d x^d u ),
                 t          x

      u *d t^d x - d t^d u }
       t                  x


% Check that it's closed.

dS := d S xmodideal S;


ds := {}



% Exterior system for a Monge-Ampere equation

korder d u(-y,-y),d u(-x,-y),d u(-x,-x),d u(-y),d u(-x),d u;


M := {u(-x,-x)*u(-y,-y) - u(-x,-y)**2,
      d u       -  u(-x)*d x   -  u(-y)*d y,
      d u(-x) - u(-x,-x)*d x - u(-x,-y)*d y,
      d u(-y) - u(-x,-y)*d x - u(-y,-y)*d y}$



% Get the full Groebner basis

gbdeg := xideal M;


                            2
gbdeg := {u   *u    - (u   ) ,
           x x  y y     x y

          d u - d x*u  - d y*u ,
                     x        y

          d u  - d x*u    - d y*u   ,
             x        x x        x y

          d u  - d x*u    - d y*u   }
             y        x y        y y


% Changing the term ordering can be dramatic

xorder gradlex;


gradlex

gbgrad := xideal M;


                             2
gbgrad := {u   *u    - (u   ) ,
            x x  y y     x y

            - d u + d x*u  + d y*u ,
                         x        y

            - d u  + d x*u    + d y*u   ,
                 y        x y        y y

            - d u  + d x*u    + d y*u   ,
                 x        x x        x y

           d u ^d x + d u ^d y,
              x          y

            - d u *u    + d u *u   ,
                 x  y y      y  x y

            - d u *u    + d u *u   ,
                 x  x y      y  x x

           d u ^d u ,
              y    x

           d u *u  - d u*u    + d y*u   *u  - d y*u *u   ,
              y  x        x y        x y  y        x  y y

           d u *u  - d u*u    + d y*u   *u  - d y*u   *u ,
              x  x        x x        x x  y        x y  x

           u *d x^d y + d u^d x,
            y

           u   *d x^d y + d u ^d x,
            y y              y

           d u^d x^d y,

            - u   *d u^d y + u *d u ^d y - d u ^d u,
               x y            y    x          x

            - u   *d u^d y + u *d u ^d y,
               x x            x    x

           u   *d u^d y + u *d u ^d x + d u ^d u,
            y y            y    x          y

           d u ^d x^d y,
              x

           d u ^d u^d y,
              x

           d u ^d u^d x,
              x

            - u   *d u^d x + u *d u ^d x,
               y y            y    y

           d u ^d u^d x}
              y


% But the bases are equivalent

gbdeg xmod gbgrad;


{}

xorder deglex;


deglex

gbgrad xmod gbdeg;


{}



% Some Groebner bases

gb := xideal {f(1)^f(2) + f(3)^f(4)};


        1  2    3  4
gb := {f ^f  + f ^f ,

        2  3  4
       f ^f ^f ,

        1  3  4
       f ^f ^f }

gb := xideal {f(1)^f(2), f(1)^f(3)+f(2)^f(4)+f(5)^f(6)};


        1  3    2  4    5  6
gb := {f ^f  + f ^f  + f ^f ,

        1  2
       f ^f ,

        2  5  6
       f ^f ^f ,

        2  3  4    3  5  6
       f ^f ^f  - f ^f ^f ,

        1  5  6
       f ^f ^f ,

        3  4  5  6
       f ^f ^f ^f }



% Non-graded ideals

% Left and right ideals are not the same

d t^(d z+d x^d y) xmodideal {d z+d x^d y};


0

(d z+d x^d y)^d t xmodideal {d z+d x^d y};


 - 2*d t^d z


% Higher order forms can now reduce lower order ones

d x xmodideal {d y^d z + d x,d x^d y + d z};


0


% Anything whose even part is a parameter generates the trivial ideal!!

gb := xideal({x + d y},{});


gb := {1}

gb := xideal {1 + f(1) + f(1)^f(2) + f(2)^f(3)^f(4) + f(3)^f(4)^f(5)^f(6)};


gb := {1}

xvars nil;




% Tracing Groebner basis calculations

on trxideal;


gb := xideal {x-y+y*d x-x*d y};


Input Basis

xpoly(1)= - x^d y + d x^y + x - y


New Basis

xpoly(1)=x^d y - d x^y - x + y


wedge_pair{d y,1} -> xpoly(2)=d x^y^d y - x^d y + y^d y

spoly_pair{2,1} -> xpoly(3)=x^x - 2*x^y + y^y

spoly_pair{1,3} -> xpoly(4)=x^d x^y - 2*x^y^d y + y^y^d y + x^x - x^y

spoly_pair{4,3} -> 0

spoly_pair{4,1} -> 0

spoly_pair{2,4} -> criterion 1 hit

wedge_pair{d x,4} -> 0

wedge_pair{d x,2} -> xpoly(5)=x^d x - x^d y - d x^y + y^d y

New Basis

xpoly(1)=x^d y - d x^y - x + y


xpoly(2)=d x^y^d y - x^d y + y^d y


xpoly(3)=x^x - 2*x^y + y^y


xpoly(4)=x^d x - x^d y - d x^y + y^d y


spoly_pair{4,3} -> 0

spoly_pair{4,1} -> 0

spoly_pair{2,4} -> criterion 1 hit

wedge_pair{d x,4} -> 0

        2            2
gb := {x  - 2*x*y + y ,

        - d x*y + d y*x - x + y,

       d x*x - 2*d x*y + d y*y - x + y,

        - d x*y + d y*y + d x^d y*y - x + y}

off trxideal;




% Same thing in lexicographic order, without full reduction

xorder lex;


lex

off xfullreduce;


gblex := xideal {x-y+y*d x-x*d y};


gblex := {d x*y - d y*y - d x^d y*y + x - y,

          d x*y - d y*x + x - y}


% Manual autoreduction

gblex := xauto gblex;


gblex := {d x*y - d y*y - d x^d y*y + x - y}



% Tracing reduction

on trxmod;


first gb xmod gblex;

x^x - 2*x^y + y^y =

   x^(x - d x^y^d y + d x^y - y^d y - y) +

   (d x^y^d y)^(x - d x^y^d y + d x^y - y^d y - y) +

   ( - d x^y)^(x - d x^y^d y + d x^y - y^d y - y) +

   (y^d y)^(x - d x^y^d y + d x^y - y^d y - y) +

   ( - y)^(x - d x^y^d y + d x^y - y^d y - y) +

   0

0



% Restore defaults

on xfullreduce;


off trxideal,trxmod;


xvars nil;


xorder deglex;


deglex



end;


Time for test: 60 ms, plus GC time: 10 ms


REDUCE Historical
REDUCE Sourceforge Project | Historical SVN Repository | GitHub Mirror | SourceHut Mirror | NotABug Mirror | Chisel Mirror | Chisel RSS ]