===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/ecart.sm1,v
retrieving revision 1.25
retrieving revision 1.33
diff -u -p -r1.25 -r1.33
--- OpenXM/src/kan96xx/Doc/ecart.sm1	2004/05/13 05:52:53	1.25
+++ OpenXM/src/kan96xx/Doc/ecart.sm1	2004/09/10 13:20:22	1.33
@@ -1,5 +1,6 @@
-% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.24 2004/05/13 05:33:10 takayama Exp $ 
-%[(parse) (hol.sm1) pushfile] extension
+% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.32 2004/08/31 05:30:20 takayama Exp $ 
+(hol_loaded) boundp { }
+{ [(parse) (hol.sm1) pushfile] extension } ifelse
 %[(parse) (appell.sm1) pushfile] extension
 
 (ecart.sm1 : ecart division for D, 2003/07/25 ) message-quiet
@@ -7,7 +8,7 @@
 /ecart.end   { endEcart } def
 /ecart.autoHomogenize 1 def
 /ecart.needSyz 0 def
-/ecartd.gb.oxRingStructure [ ] def
+/ecartd.gb.oxRingStructure [[ ] [ ] ] def
 
 /ecartd.begin { 
   ecart.begin
@@ -89,8 +90,8 @@
      ll (0). eq {
      } {
        ll getRing /rr set
-       ll [ [ @@@.Hsymbol rr ,, (1) rr ,, ] 
-            [ (h) rr ,, (1) rr ,, ]] replace
+       ll [ [ @@@.Hsymbol rr __ (1) rr __ ] 
+            [ (h) rr __ (1) rr __ ]] replace
        /ll set
      } ifelse
    } ifelse
@@ -115,7 +116,7 @@
      ll (0). eq {
      } {
        ll getRing /rr set
-       ll [ [ @@@.Hsymbol rr ,, (1) rr ,, ] ] replace
+       ll [ [ @@@.Hsymbol rr __ (1) rr __ ] ] replace
        /ll set
      } ifelse
    } ifelse
@@ -1556,6 +1557,7 @@
     /univ vars 0 get reverse
           vars 1 get reverse join
     def
+    w-vectors to_int32 /w-vectors set
     [
     0 1 << w-vectors length 1 sub >> 
     {
@@ -1591,11 +1593,11 @@
        /gbasis2 gbasis 0 get def
      } {
        [ [(1)] ] gbasis rest join ecartd.gb 0 get getRing ring_def
-       /gbasis2 gbasis 0 get ,,, def
+       /gbasis2 gbasis 0 get ___ def
      } ifelse
      ecartd.begin
 
-     flist ,,, /flist set
+     flist ___ /flist set
      flist tag 6 eq {
        flist { gbasis2 reduction } map /ans set
      }{
@@ -1628,7 +1630,16 @@
       (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set
    (Dx) ggg ecartd.reduction /gg4 set
    gg4 message
-  [gg2  gg3 gg4]
+
+  (----------- reduction by h=1 ---------------) message
+    [[( 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]]] /ggg set
+   [(Homogenize) 0]  system_variable
+   (Dx) ggg ecartd.reduction /gg5 set
+   [(Homogenize) 1]  system_variable
+   gg5 message
+
+  [gg2  gg3 gg4 gg5]
 } def
 
 /ecarth.reduction {
@@ -1648,11 +1659,11 @@
        /gbasis2 gbasis 0 get def
      } {
        [ [(1)] ] gbasis rest join ecarth.gb 0 get getRing ring_def
-       /gbasis2 gbasis 0 get ,,, def
+       /gbasis2 gbasis 0 get ___ def
      } ifelse
      ecarth.begin
 
-     flist ,,, /flist set
+     flist ___ /flist set
      flist tag 6 eq {
        flist { gbasis2 reduction } map /ans set
      }{
@@ -1682,6 +1693,38 @@
   $ (Dx+Dy) ggg ecartd.reduction :: $
 ]] putUsages
 
+/ecartd.reduction_noh {
+  /arg2 set
+  /arg1 set
+  [/in-ecarth.reduction_noh /gbasis /flist] pushVariables
+  [(Homogenize)] pushEnv
+  [
+     /gbasis arg2  def
+     /flist  arg1  def
+     [(Homogenize) 0] system_variable
+     flist gbasis ecartd.reduction /arg1 set
+  ] pop
+  popEnv
+  popVariables
+  arg1
+} def
+
+[(ecartd.reduction_noh)
+[ (f basis ecartd.reduction_noh r)
+  (f is reduced by basis by the tangent cone algorithm.)
+  (The first element of basis <g_1,...,g_m> must be a standard 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 ecartd.gb and)
+  (it should not contain the variable h.  cf. dehomogenize)
+  $h[0,1](D)-homogenization is NOT used.$
+  (cf. reduction, ecartd.gb, ecartd.reduction )
+  $Example:$
+  $ [[( 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]]] /ggg set $
+  $ (Dx+Dy) ggg ecartd.reduction_noh :: $
+]] putUsages
+
 /ecart.stdOrder {
   /arg1 set
   [/in-ecart.stdOrder /vv /tt /dvv /wv1 /wv2
@@ -1799,21 +1842,23 @@
 } def
 /ecart.homogenize01Ideal {
  /arg1 set
- [/in.ecart.homogenize01Ideal /ll /vv /wv] pushVariables
+ [/in.ecart.homogenize01Ideal /ll /vv /wv /ans] pushVariables
  [
    /ll arg1 0 get def
    /vv arg1 1 get def
    vv isArray { vv from_records /vv set } {  } ifelse
    vv ecart.01Order /wv set
    [vv ring_of_differential_operators 0] define_ring
-   ll ,,, /ll set ll dehomogenize /ll set
+   ll ___ /ll set ll dehomogenize /ll set
    [ll vv wv] gb 0 get /ll set
 
    ecart.begin
    [vv ring_of_differential_operators
     vv ecart.stdOrder weight_vector 0
     [(weightedHomogenization) 1]] define_ring
-   ll ,,, {ecart.homogenize01 ecart.dehomogenizeH} map /arg1 set
+   ll ___ {ecart.homogenize01 ecart.dehomogenizeH} map /ans set
+   ecart.end
+   /arg1 ans def
  ] pop
  popVariables
  arg1
@@ -1829,3 +1874,4 @@
 
 ( ) message-quiet 
 
+/ecart_loaded 1 def
\ No newline at end of file