File r38/packages/ncpoly/ncpoly.rlg artifact 7111b14e3e part of check-in 3af273af29


Tue Feb 10 12:28:14 2004 run on Linux
nc_setup({k,n,NN,KK},{NN*n-n*NN=NN,KK*k-k*KK=KK},left);



 p1 := (n-k+1)*NN - (n+1);


p1 :=  - k*nn + n*nn - n + nn - 1

 p2 := (k+1)*KK -(n-k);


p2 := k*kk + k - n + kk

 l_g:=nc_groebner ({p1,p2});


l_g := {k*nn - n*nn + n - nn + 1,

        k*kk + k - n + kk,

        n*nn*kk - n*kk - n + nn*kk - kk - 1}


 nc_preduce(p1+p2,l_g);


0


 nc_divide  (k*p1+p2,p1);


{k,k*kk + k - n + kk}

 nc_divide  (k*p1+p2,2*p1);


{k,2*k*kk + 2*k - 2*n + 2*kk}

 nc_divide  (2*k*k*p1 + k*p1 + p2,2*p1);


    2
{2*k  + k,

 2*k*kk + 2*k - 2*n + 2*kk}

 
 nc_factorize (p1*p2);


{ - k*nn + n*nn - n + nn - 1,

 k*kk + k - n + kk}


nc_setup({k,n,NN,KK},{NN*n-n*NN=NN,KK*k-k*KK=KK},right);


nc_factorize (p1*p2);


{ - k*nn + n*nn - n + nn - 1,

 k*kk + k - n + kk}


% applications to shift operators

nc_setup({n,NN},{NN*n-n*NN=1},left);


n*NN;


n*nn

nc_factorize(ws);


{n,nn}

nc_setup({n,NN},{NN*n-n*NN=1},right);


n*NN;


n*nn

nc_factorize(ws);


{n,nn}

nc_setup({NN,n},{NN*n-n*NN=1},right);


n*NN;


nn*n - 1

nc_factorize(ws);


{n,nn}

nc_setup({NN,n},{NN*n-n*NN=1},left);


n*NN;


nn*n - 1

nc_factorize(ws);


{n,nn}


% Applications to partial differential equations

nc_setup({x,Dx},{Dx*x-x*Dx=1});



p:= 2*Dx^2 + x* Dx^3 + 3*x*Dx + x^2*Dx^2 + 14 + 7*x*Dx;


      2   2       3                 2
p := x *dx  + x*dx  + 10*x*dx + 2*dx  + 14

nc_factorize p;


                   2
{x*dx + 2,x*dx + dx  + 7}

right_factor(p,1);


 2   2       3                 2
x *dx  + x*dx  + 10*x*dx + 2*dx  + 14
 % no factor of degr 1
right_factor(p,2);


         2
x*dx + dx  + 7

left_factor(p,2);


x*dx + 2


nc_setup({x,Dx},{Dx*x-x*Dx=1});



q := x**2*dx**2 + 2*x**2*dx + x*dx**3 + 2*x*dx**2 
    + 8*x*dx + 16*x + 2*dx**2 + 4*dx$



nc_factorize q;


          2
{x*dx + dx  + 7,

 x,

 dx + 2}

right_factor(q,1);


dx + 2

right_factor(q,1,{x});


 2   2      2          3         2                       2
x *dx  + 2*x *dx + x*dx  + 2*x*dx  + 8*x*dx + 16*x + 2*dx  + 4*dx
  % no such right factor
right_factor(q,1,{dx});


dx + 2


% looking for factor with degree bound for an individual variable

q := x**6*dx + x**5*dx**2 + 12*x**5 + 10*x**4*dx + 20*x**3 
+ x**2*dx**3 - x**2*dx**2 + x*dx**4 - x*dx**3 + 8*x*dx**2 
- 8*x*dx + 2*dx**3 - 2*dx**2$



right_factor(q,dx);


 6       5   2       5       4          3    2   3    2   2       4       3
x *dx + x *dx  + 12*x  + 10*x *dx + 20*x  + x *dx  - x *dx  + x*dx  - x*dx

         2                3       2
 + 8*x*dx  - 8*x*dx + 2*dx  - 2*dx

right_factor(q,dx^2);


 4     2
x  + dx  - dx


% some coefficient sports
nc_setup({NN,n},{NN*n-n*NN=1},left);


q:=(n*nn)^2;


       2  2
q := nn *n  - 3*nn*n + 1

nc_factorize q;


{n,

 nn,

 n,

 nn}

nc_preduce(q,{c1+c2*n + c3*nn + c4*n*nn});


   2       2                        2        2          2      2
(c3 *c4)*nn  + (2*c1*c3*c4 - 2*c2*c3  + c3*c4 )*nn + (c2 *c4)*n

                     2           2         2
 + (2*c1*c2*c4 - 2*c2 *c3 - c2*c4 )*n + (c1 *c4 - 2*c1*c2*c3 + c2*c3*c4)

nc_divide(q,n);


   2
{nn *n - 3*nn,1}


nc_cleanup;



end;


Time for test: 5420 ms, plus GC time: 140 ms


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