=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/ecart.sm1,v retrieving revision 1.5 retrieving revision 1.10 diff -u -p -r1.5 -r1.10 --- OpenXM/src/kan96xx/Doc/ecart.sm1 2003/08/04 11:42:42 1.5 +++ OpenXM/src/kan96xx/Doc/ecart.sm1 2003/08/23 02:28:40 1.10 @@ -1,4 +1,4 @@ -% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.4 2003/07/30 09:00:51 takayama Exp $ +% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.9 2003/08/22 23:55:21 takayama Exp $ %[(parse) (hol.sm1) pushfile] extension %[(parse) (appell.sm1) pushfile] extension @@ -7,6 +7,14 @@ /ecart.end { endEcart } def /ecart.autoHomogenize 1 def /ecart.needSyz 0 def +/ecartd.begin { + ecart.begin + [(EcartAutomaticHomogenization) 1] system_variable +} def +/ecartd.end { + ecart.end + [(EcartAutomaticHomogenization) 0] system_variable +} def /ecart.dehomogenize { /arg1 set @@ -133,10 +141,57 @@ arg1 } def +/ecart.gb {ecartd.gb} def + +[(ecart.gb) + [(a ecart.gb b) + (array a; array b;) + $b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$ + ( in the ring of differential operators.) + (The computation is done by using Ecart division algorithm and ) + (the double homogenization.) + (cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003) + $ ii is the initial ideal in case of w is given or <> belongs$ + $ to a ring. In the other cases, it returns the initial monominal.$ + (a : [f ]; array f; f is a set of generators of an ideal in a ring.) + (a : [f v]; array f; string v; v is the variables. ) + (a : [f v w]; array f; string v; array of array w; w is the weight matirx.) + (a : [f v w ds]; array f; string v; array of array w; w is the weight matirx.) + ( array ds; ds is the degree shift ) + ( ) + $cf. ecarth.gb (homogenized), ecartd.gb (dehomogenize) $ + ( ) + $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $ + $ [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $ + (Example 2: ) + $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $ + $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecart.gb /ff set ff pmat ;$ + (To set the current ring to the ring in which ff belongs ) + ( ff getRing ring_def ) + ( ) + $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $ + $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.gb pmat ; $ + ( This example will cause an error on order.) + ( ) + $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $ + $ [ [ (x) -1 (y) -1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $ + ( This example will cause an error on order.) + ( ) + $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $ + $ [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] [[0 1] [-3 1] ] ] ecart.gb pmat ; $ + ( ) + (cf. gb, groebner, ecarth.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, ) + ( ecart.dehomogenize, ecart.dehomogenizeH) + ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for ) + ( define_ring ) + (/ecart.autoHomogenize 0 def ) + ( not to dehomogenize and homogenize) +]] putUsages + /ecart.gb.verbose 1 def -/ecart.gb { +/ecarth.gb { /arg1 set - [/in-ecart.gb /aa /typev /setarg /f /v + [/in-ecarth.gb /aa /typev /setarg /f /v /gg /wv /vec /ans /rr /mm /degreeShift /env2 /opt /ans.gb ] pushVariables @@ -219,21 +274,23 @@ } { } ifelse wv isInteger { [v ring_of_differential_operators - [ v ecart.wv1 v ecart.wv2 ] weight_vector +% [ v ecart.wv1 v ecart.wv2 ] weight_vector gb.characteristic opt ] define_ring }{ degreeShift isInteger { [v ring_of_differential_operators - [v ecart.wv1 v ecart.wv2] wv join weight_vector +% [v ecart.wv1 v ecart.wv2] wv join weight_vector + wv weight_vector gb.characteristic opt ] define_ring }{ [v ring_of_differential_operators - [v ecart.wv1 v ecart.wv2] wv join weight_vector +% [v ecart.wv1 v ecart.wv2] wv join weight_vector + wv weight_vector gb.characteristic [(degreeShift) degreeShift] opt join ] define_ring @@ -254,7 +311,7 @@ %%% Enf of the preprocess ecart.gb.verbose { - (The first and the second weight vectors are automatically set as follows) + (The first and the second weight vectors for automatic homogenization: ) message v ecart.wv1 message v ecart.wv2 message @@ -297,7 +354,11 @@ wv isInteger { /ans [gg gg {init} map] def }{ - /ans [gg gg {wv 0 get weightv init} map] def + degreeShift isInteger { + /ans [gg gg {wv 0 get weightv init} map] def + } { + /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def + } ifelse }ifelse %% Postprocess : recover the matrix expression. @@ -319,10 +380,10 @@ popVariables arg1 } def -(ecart.gb ) messagen-quiet +(ecarth.gb ) messagen-quiet -[(ecart.gb) - [(a ecart.gb b) +[(ecarth.gb) + [(a ecarth.gb b) (array a; array b;) $b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$ ( in the ring of differential operators.) @@ -341,22 +402,22 @@ ( not to dehomogenize and homogenize) ( ) $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $ - $ [ [ (Dx) 1 ] ] ] ecart.gb pmat ; $ + $ [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.gb pmat ; $ (Example 2: ) (To put H and h=1, type in, e.g., ) $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $ - $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecart.gb /gg set gg ecart.dehomogenize pmat ;$ + $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecarth.gb /gg set gg ecart.dehomogenize pmat ;$ ( ) $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $ - $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.gb pmat ; $ + $ [ [ (Dx) 1 (Dy) 1] ] ] ecarth.gb pmat ; $ ( ) $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $ - $ [ [ (x) -1 (y) -1] ] ] ecart.gb pmat ; $ + $ [ [ (x) -1 (y) -1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.gb pmat ; $ ( ) $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] ] ] ecart.gb pmat ; $ + $ [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] [[0 1] [-3 1] ] ] ecarth.gb pmat ; (buggy infinite loop)$ ( ) - (cf. gb, groebner, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, ) + (cf. gb, groebner, ecart.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, ) ( ecart.dehomogenize, ecart.dehomogenizeH) ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for ) ( define_ring ) @@ -385,12 +446,14 @@ (array a; array b;) $b : [syzygy gb tmat input]; gb = tmat * input $ $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $ - $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.syz /ff set $ + $ [ [ (Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.syz /ff set $ $ ff 0 get ff 3 get mul pmat $ $ ff 2 get ff 3 get mul [ff 1 get ] transpose sub pmat ; $ ( ) + (To set the current ring to the ring in which ff belongs ) + ( ff getRing ring_def ) $Example 2: [[ [(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] ] ] ecart.syz pmat ; $ + $ [ [(Dx) 1 (Dy) 1] [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] ecart.syz pmat ; $ ( ) (cf. ecart.gb) ( /ecart.autoHomogenize 0 def ) @@ -570,7 +633,11 @@ wv isInteger { /ans [gg gg {init} map] def }{ - /ans [gg gg {wv 0 get weightv init} map] def + degreeShift isInteger { + /ans [gg gg {wv 0 get weightv init} map] def + } { + /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def + } ifelse }ifelse %% Postprocess : recover the matrix expression. @@ -721,8 +788,7 @@ %%BUG: case of v is integer v ecart.checkOrder - ecart.begin - [(EcartAutomaticHomogenization) 1] system_variable + ecartd.begin ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse @@ -746,7 +812,11 @@ wv isInteger { /ans [gg gg {init} map] def }{ - /ans [gg gg {wv 0 get weightv init} map] def + degreeShift isInteger { + /ans [gg gg {wv 0 get weightv init} map] def + } { + /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def + } ifelse }ifelse %% Postprocess : recover the matrix expression. @@ -757,8 +827,7 @@ ifelse } ifelse - ecart.end - [(EcartAutomaticHomogenization) 0] system_variable + ecartd.end %% env1 restoreOptions %% degreeShift changes "grade" @@ -792,7 +861,7 @@ /i set vv i get . /tt set tt (1). add init (1). eq { } - { [vv i get ( is larger than 1) vv i get] cat error} ifelse + { [vv i get ( is larger than 1 ) ] cat error} ifelse } for /arg1 1 def ] pop