xideal.red 5.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188
  1. module xideal;
  2. %
  3. % XIDEAL V2.4
  4. %
  5. %
  6. % Authors: David Hartley
  7. % GMD - German National Research Center
  8. % for Information Technology
  9. % D-53754 St Augustin
  10. % Germany
  11. %
  12. % email: David.Hartley@gmd.de
  13. %
  14. %
  15. % Philip A Tuckey
  16. % Laboratoire de Physique Mol\'eculaire,
  17. % Universit\'e de Franche-Comt\'e,
  18. % 25030 Besan\c{}con,
  19. % France
  20. %
  21. % email: pat@rs1.univ-fcomte.fr
  22. %
  23. %
  24. % Description: Tools for calculations with ideals of polynomials in
  25. % exterior algebra. Uses Groebner basis algorithms
  26. % described in D Hartley and P A Tuckey, "A direct
  27. % characterisation of Groebner bases in Clifford and
  28. % Grassmann algebras", Preprint MPI-Ph/93-96 1993, and J
  29. % Apel "A relationship between Groebner bases of ideals
  30. % and vector modules of G-algebras", Contemp
  31. % Math 131(1992)195.
  32. %
  33. % Requires: REDUCE 3.6 patched to 25 Apr 96 or later
  34. %
  35. % Created: 5/8/92 V0 as ideal.red
  36. %
  37. % Modified: 4/3/94 V1 Renamed xideal.red
  38. % Compiles independently
  39. % Converted right reduction and spolys to
  40. % left
  41. % Added graded lexicographical ordering
  42. % Enabled non-graded ideals
  43. % Fixed trivial ideal bug
  44. % Removed subform
  45. % Renamed xtrace -> xstats
  46. % 1/12/94 V2 Enable 2-sided ideals
  47. % Enable p-forms with p >= 0
  48. % 8/12/95 Added subs2 checking in reduction
  49. % 19/1/96 V2.2 Added subs2 checking in xrepartit
  50. % Added resimp before subs2
  51. % Fixed rtypes of operators
  52. % 16/4/96 V2.3 Added exvars and excoeffs
  53. %
  54. %
  55. % Algebraic mode entry points
  56. %
  57. % xorder k;
  58. % establishes the term order, where k is one of lex, gradlex (graded by
  59. % number of factors in term) or deglex (graded by exterior degree of
  60. % term.)
  61. %
  62. % xvars U,V,W,...;
  63. % declares which degree 0 kernels are to be regarded as polynomial
  64. % variables (rest are coefficient parameters). U,V,W can be variables
  65. % or lists of variables. xvars nil, restores the default, in which all
  66. % declared 0-forms are polynomial variables.
  67. %
  68. % xideal(S) xideal(S,V,r) or xideal(S,r)
  69. % calculates an exterior Groebner basis for the list of generator S,
  70. % with optional 0-form variables V, optionally up to degree r.
  71. %
  72. % xmodideal(F,S) or F xmodideal S
  73. % reduces F with respect to an exterior Groebner basis for the list of
  74. % generators S. F may be either a single exterior form,
  75. % or a list of forms.
  76. %
  77. % xmod(F,S) or F xmod S
  78. % reduces F with respect to the set of exterior polynomials S, which is
  79. % not necessarily a Groebner basis. F may be either a single
  80. % exterior form, or a list of forms. This routine can be used in
  81. % conjunction with xideal to produce the same effect as xmodideal:
  82. % F xmodideal S = F xmod xideal(S,exdegree F).
  83. %
  84. % xauto(S)
  85. % autoreduces the polynomials in S.
  86. %
  87. % exvars(F)
  88. % returns polynomials variables (as defined by xvars) from F
  89. %
  90. % excoeffs(F)
  91. % returns polynomials coefficients (as defined by xvars) from F
  92. %
  93. % Switches
  94. %
  95. % xfullreduce - Allows reduced Groebner bases to be calculated
  96. % (default ON)
  97. % trxideal - Trace spoly and wedge poly production (default OFF)
  98. % trxmod - Trace reduction to normal form (default OFF)
  99. %
  100. % ======================================================================
  101. % Need EXCALC loaded first.
  102. load_package 'excalc;
  103. create!-package('(
  104. xideal % Header module
  105. xgroeb % GB calculation
  106. xreduct % Normal form algorithms
  107. xcrit % Critical pairs, critical values
  108. xpowers % Powers, including div relation and lcm.
  109. xstorage % Storage and retrieval of critical pairs and polynomials.
  110. xaux % Auxiliary functions for XIDEAL
  111. xexcalc % Modifications to Eberhard Schruefer's excalc
  112. ),'(contrib xideal));
  113. % Switches
  114. fluid '(!*xfullreduce !*trxideal !*twosided !*trxmod);
  115. switch xfullreduce,trxideal,twosided,trxmod;
  116. !*xfullreduce := t; % whether to autoreduce GB
  117. !*trxideal := nil; % display new polynomials added to GB
  118. !*twosided := nil; % construct GB for two-sided ideal
  119. !*trxmod := nil; % display reduction chains
  120. % Global variables
  121. fluid '(xvars!* xtruncate!* xvarlist!* xdegreelist!* zerodivs!*
  122. xpolylist!*);
  123. xvars!* := t; % list of variables to include in partition
  124. xtruncate!* := nil; % degree at which to truncate GB
  125. xvarlist!* := {}; % variables in current problem
  126. xdegreelist!* := {}; % a-list of degrees of variables
  127. zerodivs!* := {}; % odd degree variables
  128. xpolylist!* := {}; % internal list for debugging only
  129. % Macros used in other modules
  130. smacro procedure xkey pr;
  131. car pr;
  132. smacro procedure pr_type pr;
  133. cadr pr;
  134. smacro procedure pr_lhs pr;
  135. caddr pr;
  136. smacro procedure pr_rhs pr;
  137. cadddr pr;
  138. smacro procedure empty_xset;
  139. '!*xset!* . nil;
  140. smacro procedure empty_xsetp c;
  141. null cdr c;
  142. smacro procedure xset_item c;
  143. car c;
  144. % Macros from other packages for compilation
  145. smacro procedure ldpf u; % from excalc
  146. %selector for leading standard form in patitioned sf;
  147. caar u;
  148. smacro procedure !*k2pf u; % from excalc
  149. u .* (1 ./ 1) .+ nil;
  150. smacro procedure negpf u; % from excalc
  151. multpfsq(u,(-1) ./ 1);
  152. smacro procedure get!*fdeg u; % from excalc
  153. (if x then car x else nil) where x = get(u,'fdegree);
  154. smacro procedure get!*ifdeg u; % from excalc
  155. (if x then cdr x else nil)
  156. where x = assoc(length cdr u,get(car u,'ifdegree));
  157. endmodule;
  158. end;