===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/hol.sm1,v
retrieving revision 1.15
retrieving revision 1.25
diff -u -p -r1.15 -r1.25
--- OpenXM/src/kan96xx/Doc/hol.sm1	2004/05/04 08:03:30	1.15
+++ OpenXM/src/kan96xx/Doc/hol.sm1	2005/07/24 09:02:40	1.25
@@ -1,4 +1,4 @@
-% $OpenXM: OpenXM/src/kan96xx/Doc/hol.sm1,v 1.14 2004/05/04 07:48:47 takayama Exp $
+% $OpenXM: OpenXM/src/kan96xx/Doc/hol.sm1,v 1.24 2005/06/23 03:23:26 takayama Exp $
 %% hol.sm1, 1998, 11/8, 11/10, 11/14, 11/25, 1999, 5/18, 6/5. 2000, 6/8
 %% rank, rrank, characteristic
 %% This file is error clean.
@@ -14,6 +14,7 @@ $hol.sm1, basic package for holonomic systems (C) N.Ta
 message-quiet
 
 /gb.warning 0 def
+/gb.oxRingStructure [[ ] [ ]] def
 /rank.v [(x) (y) (z)] def   %% default value of v (variables).
 /rank.ch [ ] def  %% characteristic variety.
 /rank.verbose 0 def
@@ -269,6 +270,27 @@ message-quiet
 ] putUsages
 (rrank ) messagen-quiet
 
+
+% Take the value of arg1 in prior.
+/mergeGroebnerOptions {
+  /arg2 set
+  /arg1 set
+  [/loc /glo /ans] pushVariables
+  [
+    /loc arg1 def
+    /glo arg2 def
+    /ans [ ] def
+    {
+      loc tag 0 eq { /ans glo def exit } { } ifelse
+      /ans glo loc join def
+      exit
+    } loop 
+    /arg1 ans def
+  ] pop
+  popVariables
+  arg1
+} def
+
 /gb.v 1 def
 /gb.verbose 0 def
 /gb.options [ ] def
@@ -279,13 +301,14 @@ message-quiet
   /arg1 set
   [/in-gb /aa /typev /setarg /f /v 
    /gg /wv /termorder /vec /ans /rr /mm
-   /degreeShift  /env2
+   /degreeShift  /env2 /groebnerOptions
   ] pushVariables 
   [(CurrentRingp) (KanGBmessage)] pushEnv
   [
 
     /aa arg1 def
     aa isArray { } { ( << array >> gb) error } ifelse
+    aa getAttributeList configureGroebnerOption /groebnerOptions set
     /setarg 0 def
     /wv 0 def
     /degreeShift 0 def
@@ -392,16 +415,17 @@ message-quiet
     }{
      /gb.homogenized 1 def
     } ifelse
-    gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
+    groebnerOptions gb.options mergeGroebnerOptions /groebnerOptions set
+    gb.verbose { (groebnerOptions = ) messagen groebnerOptions message } { } ifelse
     termorder {
-      f { {,,, dehomogenize} map } map /f set
-      [f gb.options] groebner_sugar 0 get /gg set
+      f { {___ dehomogenize} map } map /f set
+      [f groebnerOptions] groebner_sugar 0 get /gg set
     }{
-      f { {,,, dehomogenize} map} map /f set
+      f { {___ dehomogenize} map} map /f set
       gb.autoHomogenize {
         f fromVectors { homogenize } map /f set
       } {  } ifelse
-      [f gb.options] groebner 0 get /gg set
+      [f groebnerOptions] groebner 0 get /gg set
     }ifelse
     wv isInteger {
       /ans [gg gg {init} map] def
@@ -415,6 +439,9 @@ message-quiet
       /ans set
     }{ }
     ifelse
+    ans getRing (oxRingStructure) dc /gb.oxRingStructure set
+    %% gg getAttributeList message
+    ans gg getAttributeList setAttributeList /ans set
     %% 
     env1 restoreOptions  %% degreeShift changes "grade"
 
@@ -430,12 +457,14 @@ message-quiet
   /arg1 set
   [/in-pgb /aa /typev /setarg /f /v 
    /gg /wv /termorder /vec /ans /rr /mm
+   /groebnerOptions
   ] pushVariables 
   [(CurrentRingp) (KanGBmessage) (UseCriterion1)] pushEnv
   [
 
     /aa arg1 def
     aa isArray { } { (<< array >> pgb) error } ifelse
+    aa getAttributeList configureGroebnerOption /groebnerOptions set
     /setarg 0 def
     /wv 0 def
     aa { tag } map /typev set
@@ -505,17 +534,18 @@ message-quiet
     } ifelse
     %%% Enf of the preprocess
 
-    gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
+    groebnerOptions gb.options mergeGroebnerOptions /groebnerOptions set
+    gb.verbose { (groebnerOptions = ) messagen groebnerOptions message } { } ifelse
     termorder {
       f { {. dehomogenize} map } map /f set
       [(UseCriterion1) 1] system_variable
-      [f gb.options] groebner_sugar 0 get /gg set
+      [f groebnerOptions] groebner_sugar 0 get /gg set
       [(UseCriterion1) 0] system_variable
     }{
       f { {. dehomogenize} map} map /f set
       f fromVectors { homogenize } map /f set
       [(UseCriterion1) 1] system_variable
-      [f gb.options] groebner 0 get /gg set
+      [f groebnerOptions] groebner 0 get /gg set
       [(UseCriterion1) 0] system_variable
     }ifelse
     wv isInteger {
@@ -531,6 +561,7 @@ message-quiet
     }{ }
     ifelse
     %% 
+    ans gg getAttributeList setAttributeList /ans set
 
     /arg1 ans def
   ] pop
@@ -762,6 +793,7 @@ message-quiet
   (                array ds; ds is the degree shift )
   (  )
   (gb.authoHomogenize 1 [default])
+  (gb.oxRingStructure )
   ( )
   $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
   $             [ [ (Dx) 1 ] ] ] gb pmat ; $
@@ -778,6 +810,12 @@ message-quiet
   (  )
   $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
   $             [ [ (x) -1 (y) -1] ]  [[0 1] [-3 1] ] ] gb pmat ; $
+  ( )
+  $Example 6: [ [( (x Dx)^2 + (y Dy)^2 - x y Dx Dy + 1) ( x y Dx Dy -1)] (x,y) $
+  $             [ [ (Dx) 1 ] ] ] [(reduceOnly) 1] setAttributeList gb pmat ; $
+  ( )
+  $Example 7: [ [( (x Dx)^2 + (y Dy)^2 + 1) ( x y Dx Dy -1)] (x,y) $
+  $     [ [ (Dx) 1 ] ] ] [(gbCheck) 1] setAttributeList gb getAttributeList ::$
   (  )
   (cf. gb, groebner, groebner_sugar, syz. )
 ]] putUsages
@@ -795,6 +833,8 @@ message-quiet
   $Example 1: [(x,y) ring_of_polynomials 0] define_ring $
   $           [ [(x^2+y^2-4). (x y -1).] ] pgb :: $
   $Example 2: [ [(x^2+y^2) (x y)]   (x,y)  [ [(x) -1 (y) -1] ] ] pgb :: $
+  $Example 3: [ [(x^2+y^2 + x y ) (x y)]   (x,y)  [ [(x) -1 (y) -1] ] ]  $
+  $           [(reduceOnly) 1] setAttributeList pgb :: $
   (cf. gb, groebner, groebner_sugar, syz. )
 ]] putUsages
 
@@ -919,7 +959,10 @@ message-quiet
        [vsize gtmp] toVectors /gtmp set
        ggall 0 gtmp put
     }{  } ifelse
-      /arg1 [gg dehomogenize ggall] def
+
+    gg getRing (oxRingStructure) dc /gb.oxRingStructure set
+
+    /arg1 [gg dehomogenize ggall] def
   ] pop
   popEnv
   popVariables
@@ -1369,7 +1412,7 @@ message-quiet
   /arg1 set
   [/in-gb_h /aa /typev /setarg /f /v 
    /gg /wv /termorder /vec /ans /rr /mm
-   /gb_h.opt
+   /gb_h.opt  /groebnerOptions
   ] pushVariables 
   [(CurrentRingp) (KanGBmessage) (Homogenize_vec)] pushEnv
   [
@@ -1377,6 +1420,7 @@ message-quiet
     /aa arg1 def
     gb.verbose { (Getting in gb_h) message } {  } ifelse
     aa isArray { } { ( << array >> gb_h) error } ifelse
+    aa getAttributeList configureGroebnerOption /groebnerOptions set
     /setarg 0 def
     /wv 0 def
     aa { tag } map /typev set
@@ -1458,14 +1502,15 @@ message-quiet
     [(Homogenize_vec) 0] system_variable
     %%% End of the preprocess
 
-    gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
+    groebnerOptions gb.options mergeGroebnerOptions /groebnerOptions set
+    gb.verbose { (groebnerOptions = ) messagen groebnerOptions message } { } ifelse
     termorder {
       f { {. } map } map /f set
-      [f gb.options] groebner 0 get /gg set %% Do not use sugar.
+      [f groebnerOptions] groebner 0 get /gg set %% Do not use sugar.
     }{
       f { {. } map} map /f set
       f fromVectors /f set
-      [f gb.options] groebner 0 get /gg set
+      [f groebnerOptions] groebner 0 get /gg set
     }ifelse
     wv isInteger {
       /ans [gg gg {init} map] def
@@ -1479,6 +1524,7 @@ message-quiet
       /ans set
     }{ }
     ifelse
+    ans gg getAttributeList setAttributeList /ans set
     gb_h.opt restoreOptions 
     gb.verbose { (Getting out of gb_h) message } {  } ifelse
     %% 
@@ -1519,6 +1565,8 @@ message-quiet
   $              [(2 x^5+x y^4) (y h^3 +x h^3 +x y^3)]] (x,y) $
   $             [ [ (x) -1 (y) -1] ] ] gb_h pmat ; $
   $  This is fine because grade(v_1) = grade(v_2)+1 for all vectors. $
+  $Example 5: [ [[(h+x) (x^3 + 2 h^3 + 2 x h^2)] [(x) (x)]] (x)] $
+  $            [(reduceOnly) 1] setAttributeList gb_h pmat $
   (  )
   (cf. gb, groebner, syz_h. )
 ]] putUsages
@@ -1840,11 +1888,11 @@ message-quiet
        /gbasis2 gbasis 0 get def
      } {
        [ [(1)] ] gbasis rest join gb 0 get getRing ring_def
-       /gbasis2 gbasis 0 get ,,, def
+       /gbasis2 gbasis 0 get ___ def
      } ifelse
 
 
-     flist ,,, /flist set
+     flist ___ /flist set
      flist tag 6 eq {
        flist { gbasis2 reduction } map /ans set
      }{
@@ -1858,6 +1906,43 @@ message-quiet
   arg1
 } def
 
+/gb.reduction_noh {
+  /arg2 set
+  /arg1 set
+  [/in-gb.reduction_noh /gbasis /flist /ans /gbasis2
+  ] pushVariables
+  [(CurrentRingp) (KanGBmessage) (Homogenize)] pushEnv
+  [
+     /gbasis arg2  def
+     /flist  arg1  def
+     gbasis 0 get tag 6 eq { }
+     { (gb.reduction_noh: the second argument must be a list of lists) error }
+     ifelse
+
+     gbasis length 1 eq {
+       gbasis getRing ring_def
+       /gbasis2 gbasis 0 get def
+     } {
+       [ [(1)] ] gbasis rest join gb 0 get getRing ring_def
+       /gbasis2 gbasis 0 get ___ def
+     } ifelse
+
+
+     flist ___ /flist set
+     [(Homogenize) 0] system_variable
+     flist tag 6 eq {
+       flist { gbasis2 reduction } map /ans set
+     }{
+       flist gbasis2 reduction /ans set
+     } ifelse
+     /arg1 ans def
+
+  ] pop
+  popEnv
+  popVariables
+  arg1
+} def
+
 /gb.reduction.test {
   [
     [( 2*(1-x-y) Dx + 1 ) ( 2*(1-x-y) Dy + 1 )]
@@ -1882,6 +1967,7 @@ message-quiet
   (r is the return value format of reduction;)
   (r=[h,c0,syz,input], h = c0 f + \sum syz_i g_i)
   (basis is given in the argument format of gb.)
+  $h[1,1](D)-homogenization is used.$
   (cf. reduction, gb, ecartd.gb, gb.reduction.test )
   $Example:$
   $ [[( 2*(h-x-y) Dx + h^2 ) ( 2*(h-x-y) Dy + h^2 )] $
@@ -1889,9 +1975,23 @@ message-quiet
   $ ((h-x-y)^2*Dx*Dy) ggg gb.reduction :: $
 ]] putUsages
 
+[(gb.reduction_noh)
+[ (f basis gb.reduction_noh r)
+  (f is reduced by basis by the normal form algorithm.)
+  (The first element of basis <g_1,...,g_m> must be a Grobner basis.)
+  (r is the return value format of reduction;)
+  (r=[h,c0,syz,input], h = c0 f + \sum syz_i g_i)
+  (basis is given in the argument format of gb.)
+  (cf. gb.reduction, gb )
+  $Example:$
+  $ [[( 2*Dx + 1 ) ( 2*Dy + 1 )] $
+  $   (x,y) [[(Dx) 1 (Dy) 1]]] /ggg set $
+  $ ((1-x-y)^2*Dx*Dy) ggg gb.reduction_noh :: $
+]] putUsages
+
 ( ) message-quiet ;
 
-
+/hol_loaded 1 def