===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/hol.sm1,v
retrieving revision 1.14
retrieving revision 1.20
diff -u -p -r1.14 -r1.20
--- OpenXM/src/kan96xx/Doc/hol.sm1	2004/05/04 07:48:47	1.14
+++ OpenXM/src/kan96xx/Doc/hol.sm1	2004/06/10 06:01:50	1.20
@@ -1,4 +1,4 @@
-% $OpenXM: OpenXM/src/kan96xx/Doc/hol.sm1,v 1.13 2003/07/29 08:36:39 takayama Exp $
+% $OpenXM: OpenXM/src/kan96xx/Doc/hol.sm1,v 1.19 2004/06/03 08:10:44 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
@@ -415,6 +416,7 @@ message-quiet
       /ans set
     }{ }
     ifelse
+    ans getRing (oxRingStructure) dc /gb.oxRingStructure set
     %% 
     env1 restoreOptions  %% degreeShift changes "grade"
 
@@ -762,6 +764,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 ; $
@@ -919,7 +922,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
@@ -1822,7 +1828,124 @@ message-quiet
  $       [[(x Dx -h^2) (0)] [(Dx^2) (1)] [(Dx^3) (Dx)]] (x,y)] isSameIdeal_h $
 ]] putUsages
 
+/gb.reduction {
+  /arg2 set
+  /arg1 set
+  [/in-gb.reduction /gbasis /flist /ans /gbasis2
+  ] pushVariables
+  [(CurrentRingp) (KanGBmessage)] pushEnv
+  [
+     /gbasis arg2  def
+     /flist  arg1  def
+     gbasis 0 get tag 6 eq { }
+     { (gb.reduction: 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
+     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_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 )]
+    (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]]
+  gb /gg set
+
+  ((h-x-y)*Dx) [gg 0 get] gb.reduction /gg2 set
+  gg2 message
+  (-----------------------------) message
+
+    [[( 2*(h-x-y) Dx + h^2 ) ( 2*(h-x-y) Dy + h^2 )]
+      (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set
+   ((h-x-y)*Dx) ggg gb.reduction /gg4 set
+   gg4 message
+  (-----------------------------) message
+  [gg2 gg4]
+} def
+[(gb.reduction)
+[ (f basis gb.reduction 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.)
+  $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 )] $
+  $   (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set $
+  $ ((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 ;