ncpoly.rlg 3.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266
  1. Tue Feb 10 12:28:14 2004 run on Linux
  2. nc_setup({k,n,NN,KK},{NN*n-n*NN=NN,KK*k-k*KK=KK},left);
  3. p1 := (n-k+1)*NN - (n+1);
  4. p1 := - k*nn + n*nn - n + nn - 1
  5. p2 := (k+1)*KK -(n-k);
  6. p2 := k*kk + k - n + kk
  7. l_g:=nc_groebner ({p1,p2});
  8. l_g := {k*nn - n*nn + n - nn + 1,
  9. k*kk + k - n + kk,
  10. n*nn*kk - n*kk - n + nn*kk - kk - 1}
  11. nc_preduce(p1+p2,l_g);
  12. 0
  13. nc_divide (k*p1+p2,p1);
  14. {k,k*kk + k - n + kk}
  15. nc_divide (k*p1+p2,2*p1);
  16. {k,2*k*kk + 2*k - 2*n + 2*kk}
  17. nc_divide (2*k*k*p1 + k*p1 + p2,2*p1);
  18. 2
  19. {2*k + k,
  20. 2*k*kk + 2*k - 2*n + 2*kk}
  21. nc_factorize (p1*p2);
  22. { - k*nn + n*nn - n + nn - 1,
  23. k*kk + k - n + kk}
  24. nc_setup({k,n,NN,KK},{NN*n-n*NN=NN,KK*k-k*KK=KK},right);
  25. nc_factorize (p1*p2);
  26. { - k*nn + n*nn - n + nn - 1,
  27. k*kk + k - n + kk}
  28. % applications to shift operators
  29. nc_setup({n,NN},{NN*n-n*NN=1},left);
  30. n*NN;
  31. n*nn
  32. nc_factorize(ws);
  33. {n,nn}
  34. nc_setup({n,NN},{NN*n-n*NN=1},right);
  35. n*NN;
  36. n*nn
  37. nc_factorize(ws);
  38. {n,nn}
  39. nc_setup({NN,n},{NN*n-n*NN=1},right);
  40. n*NN;
  41. nn*n - 1
  42. nc_factorize(ws);
  43. {n,nn}
  44. nc_setup({NN,n},{NN*n-n*NN=1},left);
  45. n*NN;
  46. nn*n - 1
  47. nc_factorize(ws);
  48. {n,nn}
  49. % Applications to partial differential equations
  50. nc_setup({x,Dx},{Dx*x-x*Dx=1});
  51. p:= 2*Dx^2 + x* Dx^3 + 3*x*Dx + x^2*Dx^2 + 14 + 7*x*Dx;
  52. 2 2 3 2
  53. p := x *dx + x*dx + 10*x*dx + 2*dx + 14
  54. nc_factorize p;
  55. 2
  56. {x*dx + 2,x*dx + dx + 7}
  57. right_factor(p,1);
  58. 2 2 3 2
  59. x *dx + x*dx + 10*x*dx + 2*dx + 14
  60. % no factor of degr 1
  61. right_factor(p,2);
  62. 2
  63. x*dx + dx + 7
  64. left_factor(p,2);
  65. x*dx + 2
  66. nc_setup({x,Dx},{Dx*x-x*Dx=1});
  67. q := x**2*dx**2 + 2*x**2*dx + x*dx**3 + 2*x*dx**2
  68. + 8*x*dx + 16*x + 2*dx**2 + 4*dx$
  69. nc_factorize q;
  70. 2
  71. {x*dx + dx + 7,
  72. x,
  73. dx + 2}
  74. right_factor(q,1);
  75. dx + 2
  76. right_factor(q,1,{x});
  77. 2 2 2 3 2 2
  78. x *dx + 2*x *dx + x*dx + 2*x*dx + 8*x*dx + 16*x + 2*dx + 4*dx
  79. % no such right factor
  80. right_factor(q,1,{dx});
  81. dx + 2
  82. % looking for factor with degree bound for an individual variable
  83. q := x**6*dx + x**5*dx**2 + 12*x**5 + 10*x**4*dx + 20*x**3
  84. + x**2*dx**3 - x**2*dx**2 + x*dx**4 - x*dx**3 + 8*x*dx**2
  85. - 8*x*dx + 2*dx**3 - 2*dx**2$
  86. right_factor(q,dx);
  87. 6 5 2 5 4 3 2 3 2 2 4 3
  88. x *dx + x *dx + 12*x + 10*x *dx + 20*x + x *dx - x *dx + x*dx - x*dx
  89. 2 3 2
  90. + 8*x*dx - 8*x*dx + 2*dx - 2*dx
  91. right_factor(q,dx^2);
  92. 4 2
  93. x + dx - dx
  94. % some coefficient sports
  95. nc_setup({NN,n},{NN*n-n*NN=1},left);
  96. q:=(n*nn)^2;
  97. 2 2
  98. q := nn *n - 3*nn*n + 1
  99. nc_factorize q;
  100. {n,
  101. nn,
  102. n,
  103. nn}
  104. nc_preduce(q,{c1+c2*n + c3*nn + c4*n*nn});
  105. 2 2 2 2 2 2
  106. (c3 *c4)*nn + (2*c1*c3*c4 - 2*c2*c3 + c3*c4 )*nn + (c2 *c4)*n
  107. 2 2 2
  108. + (2*c1*c2*c4 - 2*c2 *c3 - c2*c4 )*n + (c1 *c4 - 2*c1*c2*c3 + c2*c3*c4)
  109. nc_divide(q,n);
  110. 2
  111. {nn *n - 3*nn,1}
  112. nc_cleanup;
  113. end;
  114. Time for test: 5420 ms, plus GC time: 140 ms