% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.19 2004/04/29 12:04:45 takayama Exp $ %[(parse) (hol.sm1) pushfile] extension %[(parse) (appell.sm1) pushfile] extension (ecart.sm1 : ecart division for D, 2003/07/25 ) message-quiet /ecart.begin { beginEcart } def /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.setOpt { /arg1 set [/in-ecart.setOpt /opt /i /n /ans] pushVariables [ /opt arg1 def /ans [ ] def /n opt length def 0 2 n 1 sub { /i set opt i get tag StringP eq not { (ecart.setOpt : [keyword value keyword value ....] ) error } { } ifelse { % start of the loop % Global: degreeShift opt i get (degreeShift) eq { /degreeShift opt i 1 add get def exit } { } ifelse % Global: hdShift opt i get (startingShift) eq { /hdShift opt i 1 add get def exit } { } ifelse % Global: hdShift opt i get (noAutoHomogenize) eq { /hdShift -1 def exit } { } ifelse % Global: ecart.useSugar opt i get (sugar) eq { /ecart.useSugar opt i 1 add get def exit } { } ifelse ans [opt i get opt i 1 add get ] append /ans set exit } loop } for ecart.gb.verbose { (ecart.setOpt:) message (degreeShift=) messagen degreeShift message $hdShift(startingShift)=$ messagen hdShift message (sugar=) messagen ecart.useSugar message (Other options=) messagen ans message } { } ifelse /arg1 ans def ] pop popVariables arg1 } def /ecart.dehomogenize { /arg1 set [/in.ecart.dehomogenize /ll /rr] pushVariables [ /ll arg1 def ll tag 6 eq { ll { ecart.dehomogenize } map /ll set } { ll (0). eq { } { ll getRing /rr set ll [ [ (H) rr ,, (1) rr ,, ] [ (h) rr ,, (1) rr ,, ]] replace /ll set } ifelse } ifelse /arg1 ll def ] pop popVariables arg1 } def [(ecart.dehomogenize) [(obj ecart.dehomogenize r) (h->1, H->1) ]] putUsages /ecart.dehomogenizeH { /arg1 set [/in.ecart.dehomogenize /ll /rr] pushVariables [ /ll arg1 def ll tag 6 eq { ll { ecart.dehomogenize } map /ll set } { ll (0). eq { } { ll getRing /rr set ll [ [ (H) rr ,, (1) rr ,, ] ] replace /ll set } ifelse } ifelse /arg1 ll def ] pop popVariables arg1 } def [(ecart.dehomogenizeH) [(obj ecart.dehomogenizeH r) (H->1, h is not changed.) ]] putUsages /ecart.homogenize01 { /arg1 set [/in.ecart.homogenize01 /ll /ll0] pushVariables [ /ll arg1 def ll tag ArrayP eq { ll 0 get tag ArrayP eq not { [(degreeShift) [ ] ll ] homogenize /arg1 set } { ll { ecart.homogenize01 } map /arg1 set } ifelse } { [(degreeShift) [ ] ll ] homogenize /arg1 set } ifelse ] pop popVariables arg1 } def [(ecart.homogenize01) [(obj ecart.homogenize01 r) (Example: ) ( [(x1,x2) ring_of_differential_operators ) ( [[(H) 1 (h) 1 (x1) 1 (x2) 1] ) ( [(h) 1 (Dx1) 1 (Dx2) 1] ) ( [(Dx1) 1 (Dx2) 1] ) ( [(x1) -1 (x2) -1]) ( ] ecart.weight_vector ) ( 0 ) ( [(weightedHomogenization) 1 (degreeShift) [[0 0 0]]]) ( ] define_ring) ( ecart.begin) ( [[1 -4 -2 5]] appell4 0 get /eqs set) ( eqs { . [[(x1). (x1+2).] [(x2). (x2+4).]] replace} map ) ( {ecart.homogenize01} map /eqs2 set) ( [eqs2] groebner ) ]] putUsages /ecart.homogenize01_with_shiftVector { /arg2.set /arg1 set [/in.ecart.homogenize01 /ll /sv /ll0] pushVariables [ /sv arg2 def /ll arg1 def ll tag ArrayP eq { ll 0 get tag ArrayP eq not { [(degreeShift) sv ll ] homogenize /arg1 set } { ll { ecart.homogenize01_with_shiftVector } map /arg1 set } ifelse } { [(degreeShift) sv ll ] homogenize /arg1 set } ifelse ] pop popVariables arg1 } def [(ecart.dehomogenize01_with_degreeShift) [(obj shift-vector ecart.dehomogenize01_with_degreeShift r) (cf. homogenize) ]] putUsages %% Aux functions to return the default weight vectors. /ecart.wv1 { /arg1 set [/in.ecart.wv1 /v] pushVariables [ /v arg1 def [(H) (h) v to_records pop] /v set v { 1 } map /v set /arg1 v def ] pop popVariables arg1 } def /ecart.wv2 { /arg1 set [/in.ecart.wv2 /v] pushVariables [ /v arg1 def [v to_records pop] /v set v { [ @@@.Dsymbol 3 -1 roll ] cat 1 } map /v set [(h) 1 ] v join /v set /arg1 v def ] pop popVariables 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 [(degreeShift) ds]]; array f; string v; array of array w; w is the weight matirx.$ ( array ds; ds is the degree shift for the ring. ) $a : [f v w [(degreeShift) ds (startingShift) hdShift]]; array f; string v; array of array w; w is the weight matirx.$ ( array ds; ds is the degree shift for the ring. ) ( array hsShift is the degree shift for the homogenization. cf.homogenize ) $a : [f v w [(degreeShift) ds (noAutoHomogenize) 1]]; array f; string v; array of array w; w is the weight matirx.$ ( No automatic homogenization.) $ [(degreeShift) ds (noAutoHomogenize) 1 (sugar) 1] -->use the sugar strate $ ( ) $cf. ecarth.gb (homogenized), ecartd.gb (dehomogenize), ecartd.reduction $ ( ) $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] ] $ $ [(degreeShift) [[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 %ecarth.gb s(H)-homogenized outputs. GG's original version of ecart gb. /ecarth.gb { /arg1 set [/in-ecarth.gb /aa /typev /setarg /f /v /gg /wv /vec /ans /rr /mm /degreeShift /env2 /opt /ans.gb /hdShift /ecart.useSugar ] pushVariables [(CurrentRingp) (KanGBmessage)] pushEnv [ /aa arg1 def aa isArray { } { ( << array >> ecarth.gb) error } ifelse /setarg 0 def /wv 0 def /degreeShift 0 def /hdShift 0 def /opt [(weightedHomogenization) 1] def /ecart.useSugar 0 def aa { tag } map /typev set typev [ ArrayP ] eq { /f aa 0 get def /v gb.v def /setarg 1 def } { } ifelse typev [ArrayP StringP] eq { /f aa 0 get def /v aa 1 get def /setarg 1 def } { } ifelse typev [ArrayP RingP] eq { /f aa 0 get def /v aa 1 get def /setarg 1 def } { } ifelse typev [ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get from_records def /setarg 1 def } { } ifelse typev [ArrayP StringP ArrayP] eq { /f aa 0 get def /v aa 1 get def /wv aa 2 get def /setarg 1 def } { } ifelse typev [ArrayP ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get from_records def /wv aa 2 get def /setarg 1 def } { } ifelse typev [ArrayP StringP ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get def /wv aa 2 get def opt aa 3 get ecart.setOpt join /opt set /setarg 1 def } { } ifelse typev [ArrayP ArrayP ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get from_records def /wv aa 2 get def opt aa 3 get ecart.setOpt join /opt set /setarg 1 def } { } ifelse /env1 getOptions def ecart.gb.verbose { $ecarth.gb computes std basis with h-s(H)-homogenized buchberger algorithm.$ message } { } ifelse setarg { } { (ecarth.gb : Argument mismatch) error } ifelse [(KanGBmessage) ecart.gb.verbose ] system_variable %%% Start of the preprocess v tag RingP eq { /rr v def }{ f getRing /rr set } ifelse %% To the normal form : matrix expression. f gb.toMatrixOfString /f set /mm gb.itWasMatrix def rr tag 0 eq { %% Define our own ring v isInteger { (Error in gb: Specify variables) error } { } ifelse wv isInteger { [v ring_of_differential_operators % [ v ecart.wv1 v ecart.wv2 ] ecart.weight_vector gb.characteristic opt ] define_ring }{ degreeShift isInteger { [v ring_of_differential_operators % [v ecart.wv1 v ecart.wv2] wv join ecart.weight_vector wv ecart.weight_vector gb.characteristic opt ] define_ring }{ [v ring_of_differential_operators % [v ecart.wv1 v ecart.wv2] wv join ecart.weight_vector wv ecart.weight_vector gb.characteristic [(degreeShift) degreeShift] opt join ] define_ring } ifelse } ifelse } { %% Use the ring structre given by the input. v isInteger not { gb.warning { (Warning : the given ring definition is not used.) message } { } ifelse } { } ifelse rr ring_def /wv rr gb.getWeight def } ifelse %%% Enf of the preprocess ecart.gb.verbose { (The first and the second weight vectors for automatic homogenization: ) message v ecart.wv1 message v ecart.wv2 message degreeShift isInteger { } { (The degree shift is ) messagen degreeShift message } ifelse } { } ifelse %%BUG: case of v is integer v ecart.checkOrder ecart.begin ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse hdShift tag 1 eq { ecart.autoHomogenize not hdShift -1 eq or { % No automatic h-s-homogenization. f { {. } map} map /f set } { % Automatic h-s-homogenization without degreeShift (ecarth.gb: Input polynomial or vectors are automatically h-H-homogenized without degree shift.) message f { {. ecart.dehomogenize} map} map /f set f ecart.homogenize01 /f set } ifelse } { % Automatic h-s-homogenization with degreeShift (ecarth.gb: Input polynomial or vectors are automatically h-H-homogenized with degree shift.) message f { {. ecart.dehomogenize} map} map /f set f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set }ifelse ecart.useSugar { ecart.needSyz { [f [(needSyz)] gb.options join ] groebner_sugar /gg set } { [f gb.options] groebner_sugar 0 get /gg set } ifelse } { ecart.needSyz { [f [(needSyz)] gb.options join ] groebner /gg set } { [f gb.options] groebner 0 get /gg set } ifelse } ifelse ecart.needSyz { mm { gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set } { /ans.gb gg 0 get def } ifelse /ans [gg 2 get , ans.gb , gg 1 get , f ] def % ans pmat ; } { wv isInteger { /ans [gg gg {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. mm { ans { /tmp set [mm tmp] toVectors } map /ans set }{ } ifelse } ifelse ecart.end %% env1 restoreOptions %% degreeShift changes "grade" /arg1 ans def ] pop popEnv popVariables arg1 } def (ecarth.gb ) messagen-quiet [(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.) (The computation is done by using Ecart division algorithm.) $Buchberger algorithm is applied for double h-H(s)-homogenized elements and$ (they are not dehomogenized.) (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 [(degreeShift) ds]]; array f; string v; array of array w; w is the weight matirx.$ ( array ds; ds is the degree shift ) ( ) (/ecart.autoHomogenize 0 def ) ( not to dehomogenize and homogenize) ( ) $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]] ] 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]]] 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] ] ] 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] [(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) $ $ [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] $ $ [(degreeShift) [[0 1] [-3 1] ]] ] ecarth.gb pmat ; $ ( ) (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 ) ]] putUsages /ecart.syz { /arg1 set [/in-ecart.syz /ecart.save.needSyz /ff /ff.ans] pushVariables [ /ff arg1 def /ecart.save.needSyz ecart.needSyz def /ecart.needSyz 1 def ff ecart.gb /ff.ans set /ecart.needSyz ecart.save.needSyz def /arg1 ff.ans def ] pop popVariables arg1 } def (ecart.syz ) messagen-quiet [(ecart.syz) [(a ecart.syz b) (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] [(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) $ $ [ [(Dx) 1 (Dy) 1] [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] ecart.syz pmat ; $ ( ) (cf. ecart.gb) ( /ecart.autoHomogenize 0 def ) ]] putUsages /ecartn.begin { (red@) (standard) switch_function %% (red@) (ecart) switch_function [(Ecart) 1] system_variable [(CheckHomogenization) 0] system_variable [(ReduceLowerTerms) 0] system_variable [(AutoReduce) 0] system_variable [(EcartAutomaticHomogenization) 0] system_variable } def /ecartn.gb { /arg1 set [/in-ecartn.gb /aa /typev /setarg /f /v /gg /wv /vec /ans /rr /mm /degreeShift /env2 /opt /ans.gb ] pushVariables [(CurrentRingp) (KanGBmessage)] pushEnv [ /aa arg1 def aa isArray { } { ( << array >> ecartn.gb) error } ifelse /setarg 0 def /wv 0 def /degreeShift 0 def /opt [(weightedHomogenization) 1] def aa { tag } map /typev set typev [ ArrayP ] eq { /f aa 0 get def /v gb.v def /setarg 1 def } { } ifelse typev [ArrayP StringP] eq { /f aa 0 get def /v aa 1 get def /setarg 1 def } { } ifelse typev [ArrayP RingP] eq { /f aa 0 get def /v aa 1 get def /setarg 1 def } { } ifelse typev [ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get from_records def /setarg 1 def } { } ifelse typev [ArrayP StringP ArrayP] eq { /f aa 0 get def /v aa 1 get def /wv aa 2 get def /setarg 1 def } { } ifelse typev [ArrayP ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get from_records def /wv aa 2 get def /setarg 1 def } { } ifelse typev [ArrayP StringP ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get def /wv aa 2 get def opt aa 3 get ecart.setOpt join /opt set /setarg 1 def } { } ifelse typev [ArrayP ArrayP ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get from_records def /wv aa 2 get def opt aa 3 get ecart.setOpt join /opt set /setarg 1 def } { } ifelse /env1 getOptions def setarg { } { (ecart.gb : Argument mismatch) error } ifelse [(KanGBmessage) ecart.gb.verbose ] system_variable %%% Start of the preprocess v tag RingP eq { /rr v def }{ f getRing /rr set } ifelse %% To the normal form : matrix expression. f gb.toMatrixOfString /f set /mm gb.itWasMatrix def rr tag 0 eq { %% Define our own ring v isInteger { (Error in gb: Specify variables) error } { } ifelse wv isInteger { [v ring_of_differential_operators [ v ecart.wv1 v ecart.wv2 ] ecart.weight_vector gb.characteristic opt ] define_ring }{ degreeShift isInteger { [v ring_of_differential_operators [v ecart.wv1 v ecart.wv2] wv join ecart.weight_vector gb.characteristic opt ] define_ring }{ [v ring_of_differential_operators [v ecart.wv1 v ecart.wv2] wv join ecart.weight_vector gb.characteristic [(degreeShift) degreeShift] opt join ] define_ring } ifelse } ifelse } { %% Use the ring structre given by the input. v isInteger not { gb.warning { (Warning : the given ring definition is not used.) message } { } ifelse } { } ifelse rr ring_def /wv rr gb.getWeight def } ifelse %%% Enf of the preprocess ecart.gb.verbose { (The first and the second weight vectors are automatically set as follows) message v ecart.wv1 message v ecart.wv2 message degreeShift isInteger { } { (The degree shift is ) messagen degreeShift message } ifelse } { } ifelse %%BUG: case of v is integer v ecart.checkOrder ecartn.begin ecart.gb.verbose { (ecartn.gb : ecart.gb without ecart division.) message } { } ifelse ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse ecart.autoHomogenize { (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.) message } { } ifelse ecart.autoHomogenize { f { {. ecart.dehomogenize} map} map /f set f ecart.homogenize01 /f set }{ f { {. } map } map /f set } ifelse ecart.needSyz { [f [(needSyz)] gb.options join ] groebner /gg set } { [f gb.options] groebner 0 get /gg set } ifelse ecart.needSyz { mm { gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set } { /ans.gb gg 0 get def } ifelse /ans [gg 2 get , ans.gb , gg 1 get , f ] def % ans pmat ; } { wv isInteger { /ans [gg gg {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. mm { ans { /tmp set [mm tmp] toVectors } map /ans set }{ } ifelse } ifelse ecart.end %% env1 restoreOptions %% degreeShift changes "grade" /arg1 ans def ] pop popEnv popVariables arg1 } def (ecartn.gb[gb by non-ecart division] ) messagen-quiet /ecartd.gb { /arg1 set [/in-ecart.gb /aa /typev /setarg /f /v /gg /wv /vec /ans /rr /mm /degreeShift /env2 /opt /ans.gb /hdShift /ecart.useSugar ] pushVariables [(CurrentRingp) (KanGBmessage)] pushEnv [ /aa arg1 def aa isArray { } { ( << array >> ecartd.gb) error } ifelse /setarg 0 def /wv 0 def /degreeShift 0 def /hdShift 0 def /ecart.useSugar 0 def /opt [(weightedHomogenization) 1] def aa { tag } map /typev set typev [ ArrayP ] eq { /f aa 0 get def /v gb.v def /setarg 1 def } { } ifelse typev [ArrayP StringP] eq { /f aa 0 get def /v aa 1 get def /setarg 1 def } { } ifelse typev [ArrayP RingP] eq { /f aa 0 get def /v aa 1 get def /setarg 1 def } { } ifelse typev [ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get from_records def /setarg 1 def } { } ifelse typev [ArrayP StringP ArrayP] eq { /f aa 0 get def /v aa 1 get def /wv aa 2 get def /setarg 1 def } { } ifelse typev [ArrayP ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get from_records def /wv aa 2 get def /setarg 1 def } { } ifelse typev [ArrayP StringP ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get def /wv aa 2 get def opt aa 3 get ecart.setOpt join /opt set /setarg 1 def } { } ifelse typev [ArrayP ArrayP ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get from_records def /wv aa 2 get def opt aa 3 get ecart.setOpt join /opt set /setarg 1 def } { } ifelse /env1 getOptions def setarg { } { (ecart.gb : Argument mismatch) error } ifelse [(KanGBmessage) ecart.gb.verbose ] system_variable $ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ message %%% Start of the preprocess v tag RingP eq { /rr v def }{ f getRing /rr set } ifelse %% To the normal form : matrix expression. f gb.toMatrixOfString /f set /mm gb.itWasMatrix def rr tag 0 eq { %% Define our own ring v isInteger { (Error in gb: Specify variables) error } { } ifelse wv isInteger { (Give an weight vector such that x < 1) error }{ degreeShift isInteger { [v ring_of_differential_operators wv ecart.weight_vector gb.characteristic opt ] define_ring }{ [v ring_of_differential_operators wv ecart.weight_vector gb.characteristic [(degreeShift) degreeShift] opt join ] define_ring } ifelse } ifelse } { %% Use the ring structre given by the input. v isInteger not { gb.warning { (Warning : the given ring definition is not used.) message } { } ifelse } { } ifelse rr ring_def /wv rr gb.getWeight def } ifelse %%% Enf of the preprocess ecart.gb.verbose { degreeShift isInteger { } { (The degree shift is ) messagen degreeShift message } ifelse } { } ifelse %%BUG: case of v is integer v ecart.checkOrder ecartd.begin ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse hdShift tag 1 eq { ecart.autoHomogenize not hdShift -1 eq or { % No automatic h-homogenization. f { {. } map} map /f set } { % Automatic h-homogenization without degreeShift (ecartd.gb : Input polynomial or vectors are automatically homogenized without degreeShift) message f { {. ecart.dehomogenize} map} map /f set f ecart.homogenize01 /f set f { { [[(H). (1).]] replace } map } map /f set } ifelse } { % Automatic h-homogenization with degreeShift (ecartd.gb : Input polynomial or vectors are automatically homogenized with degreeShift) message f { {. ecart.dehomogenize} map} map /f set f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set f { { [[(H). (1).]] replace } map } map /f set }ifelse ecart.useSugar { ecart.needSyz { [f [(needSyz)] gb.options join ] groebner_sugar /gg set } { [f gb.options] groebner_sugar 0 get /gg set } ifelse } { ecart.needSyz { [f [(needSyz)] gb.options join ] groebner /gg set } { [f gb.options] groebner 0 get /gg set } ifelse } ifelse ecart.needSyz { mm { gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set } { /ans.gb gg 0 get def } ifelse /ans [gg 2 get , ans.gb , gg 1 get , f ] def % ans pmat ; } { wv isInteger { /ans [gg gg {init} map] def }{ %% Get the initial ideal 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. mm { ans { /tmp set [mm tmp] toVectors } map /ans set }{ } ifelse } ifelse ecartd.end %% env1 restoreOptions %% degreeShift changes "grade" /arg1 ans def ] pop popEnv popVariables arg1 } def (ecartd.gb[results are dehomogenized at each reduction step] ) messagen-quiet /ecart.checkOrder { /arg1 set [/in-ecart.checkOrder /vv /tt /dd /n /i] pushVariables [ /vv arg1 def vv isArray { } { [vv to_records pop] /vv set } ifelse vv {toString} map /vv set vv { /tt set [@@@.Dsymbol tt] cat } map /dd set % Starting the checks. 0 1 vv length 1 sub { /i set vv i get . dd i get . mul /tt set tt @@@.hsymbol . add init tt eq { } { [@@@.hsymbol ( is larger than ) vv i get ( ) dd i get] cat error} ifelse } for 0 1 vv length 1 sub { /i set vv i get . /tt set tt (1). add init (1). eq { } { [vv i get ( is larger than 1 ) ] cat error} ifelse } for /arg1 1 def ] pop popVariables arg1 } def [(ecart.checkOrder) [(v ecart.checkOrder bool checks if the given order is relevant) (for the ecart division.) (cf. ecartd.gb, ecart.gb, ecartn.gb) ] ] putUsages /ecart.wv_last { /arg1 set [/in-ecart.wv_last /vv /tt /dd /n /i] pushVariables [ /vv arg1 def vv isArray { } { [vv to_records pop] /vv set } ifelse vv {toString} map /vv set vv { /tt set [@@@.Dsymbol tt] cat } map /dd set vv { -1 } map dd { 1 } map join /arg1 set ] pop popVariables arg1 } def [(ecart.wv_last) [(v ecart.wv_last wt ) (It returns the weight vector -1,-1,...-1; 1,1, ..., 1) (Use this weight vector as the last weight vector for ecart division) (if ecart.checkOrder complains about the order given.) ] ] putUsages /ecart.mimimalBase.test { [ [ (0) , (-2*Dx) , (2*t) , (y) , (x^2) ] [ (3*t ) , ( -3*Dy ) , ( 0 ) , ( -x ) , ( -y) ] [ (3*y ) , ( 6*Dt ) , ( 2*x ) , ( 0 ) , ( 1) ] [ (-3*x^2 ) , ( 0 ) , ( -2*y ) , ( 1 ) , ( 0 )] [ (Dx ) , ( 0 ) , ( -Dy ) , ( Dt ) , ( 0) ] [ (0 ) , ( 0 ) , ( 6*t*Dt+2*x*Dx+3*y*Dy+8*h ) , ( 0 ) , ( 3*x^2*Dt+Dx) ] [ (6*t*Dx ) , ( 0 ) , ( -6*t*Dy ) , ( -2*x*Dx-3*y*Dy-5*h ) , ( -2*y*Dx-3*x^2*Dy) ] [ (6*t*Dt+3*y*Dy+9*h ) , ( 0 ) , ( 2*x*Dy ) , ( -2*x*Dt ) , ( -2*y*Dt+Dy) ] ] /ff set /nmshift [ [1 0 1 1 1] [1 0 1 0 0] ] def /shift [ [1 0 1 0 0] ] def /weight [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] def [ff (t,x,y) weight [(degreeShift) shift (startingShift) nmshift]] ecart.minimalBase } def /test {ecart.mimimalBase.test} def %(x,y) ==> [(Dx) 1 (Dy) 1 (h) 1] /ecart.minimalBase.D1 { /arg1 set [/in-ecart.minimalBase.D1 /tt /v] pushVariables [ /v arg1 def [ v to_records pop] /v set v { /tt set [@@@.Dsymbol tt] cat 1 } map /v set v [(h) 1] join /arg1 set ] pop popVariables arg1 } def % [0 1 2] 1 ecart.removeElem [0 2] /ecart.removeElem { /arg2 set /arg1 set [/in-ecart.removeElem /v /q /i /ans /j] pushVariables [ /v arg1 def /q arg2 def /ans v length 1 sub newVector def /j 0 def 0 1 v length 1 sub { /i set i q eq not { ans j v i get put /j j 1 add def } { } ifelse } for ] pop popVariables arg1 } def /ecart.isZeroRow { /arg1 set [/in-ecart.isZeroRow /aa /i /n /yes] pushVariables [ /aa arg1 def aa length /n set /yes 1 def 0 1 n 1 sub { /i set aa i get (0). eq { } { /yes 0 def } ifelse } for /arg1 yes def ] pop popVariables arg1 } def /ecart.removeZeroRow { /arg1 set [/in-ecart.removeZeroRow /aa /i /n /ans] pushVariables [ /aa arg1 def aa length /n set /ans [ ] def 0 1 n 1 sub { /i set aa i get ecart.isZeroRow { } { ans aa i get append /ans set } ifelse } for /arg1 ans def ] pop popVariables arg1 } def /ecart.gen_input { /arg1 set [/in-ecart.gen_input /aa /typev /setarg /f /v /gg /wv /vec /ans /rr /mm /degreeShift /env2 /opt /ss0 /hdShift /ff ] pushVariables [ /aa arg1 def aa isArray { } { ( << array >> ecart.gen_input) error } ifelse /setarg 0 def /wv 0 def /degreeShift 0 def /hdShift 0 def /opt [ ] def aa { tag } map /typev set typev [ArrayP StringP ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get def /wv aa 2 get def opt aa 3 get ecart.setOpt join /opt set /setarg 1 def } { } ifelse typev [ArrayP ArrayP ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get from_records def /wv aa 2 get def opt aa 3 get ecart.setOpt join /opt set /setarg 1 def } { } ifelse setarg { } { (ecart.minimalBase : Argument mismatch) error } ifelse [(KanGBmessage) ecart.gb.verbose ] system_variable f 0 get tag ArrayP eq { } { f { /tt set [ tt ] } map /f set } ifelse [f v wv [(degreeShift) degreeShift (startingShift) [hdShift 0 get degreeShift 0 get]] opt join] ecart.gb /ff set ff getRing ring_def ff 0 get { {toString } map } map /ff set [ff v wv [(degreeShift) degreeShift (startingShift) [hdShift 0 get degreeShift 0 get]] opt join ] /arg1 set ] pop popVariables arg1 } def [(ecart.gen_input) [$[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]] ] ecart.gen_input $ $ [gg_h v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]] $ (It generates the input for the minimal filtered free resolution.) (Current ring is changed to the ring of gg_h.) (cf. ecart.minimalBase) $Example: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $ $ [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $ $ [(degreeShift) [ [0] ] $ $ (startingShift) [ [0] [0] ]] ] ecart.gen_input /gg set gg pmat $ ]] putUsages [(ecart.minimalBase) [$[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]] ecart.minimalBase $ ( [mbase gr_of_mbase ) $ [syz v ecart.weight_vector [(degreeShift) new_uv_shift_m (startingShift) [new_D_shift_n new_uv_shift_m]]]$ ( gr_of_syz ]) (mbase is the minimal generators of ff in D^h in the sense of filtered minimal) (generators.) $Example: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $ $ [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $ $ [(degreeShift) [ [0] ] $ $ (startingShift) [ [0] [0] ] ] ] ecart.gen_input /gg0 set $ $ gg0 ecart.minimalBase /ss0 set $ $ ss0 2 get ecart.minimalBase /ss1 set $ $ ss1 2 get ecart.minimalBase /ss2 set $ $ (--------- minimal filtered resolution -------) message $ $ ss0 0 get pmat ss1 0 get pmat ss2 0 get pmat $ $ (--------- degree shift (n,m) n:D-shift m:uv-shift -------) message $ $ gg0 3 get 3 get message $ $ ss0 2 get 3 get 3 get message $ $ ss1 2 get 3 get 3 get message $ $ ss2 2 get 3 get 3 get message ; $ ]] putUsages /ecart.minimalBase { /arg1 set [/in-ecart.minimalBase /ai1 /ai /aa /typev /setarg /f /v /gg /wv /vec /ans /rr /mm /degreeShift /env2 /opt /ss0 /hdShift /degreeShiftD /degreeShiftUV /degreeShiftDnew /degreeShiftUVnew /tt /ai1_gr /ai_gr /s /r /p /q /i /j /k /ai1_new /ai_new /ai_new2 ] pushVariables [ /aa arg1 def aa isArray { } { ( << array >> ecart.minimalBase) error } ifelse /setarg 0 def /wv 0 def /degreeShift 0 def /hdShift 0 def /opt [ ] def aa { tag } map /typev set typev [ArrayP StringP ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get def /wv aa 2 get def opt aa 3 get ecart.setOpt join /opt set /setarg 1 def } { } ifelse typev [ArrayP ArrayP ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get from_records def /wv aa 2 get def opt aa 3 get ecart.setOpt join /opt set /setarg 1 def } { } ifelse setarg { } { (ecart.minimalBase : Argument mismatch) error } ifelse [(KanGBmessage) ecart.gb.verbose ] system_variable f 0 get tag ArrayP eq { } { f { /tt set [ tt ] } map /f set } ifelse [f v wv [(degreeShift) degreeShift (noAutoHomogenize) 1] opt join] ecart.syz /ss0 set ss0 getRing ring_def /degreeShiftD hdShift 0 get def /degreeShiftUV hdShift 1 get def % -- ai --> D^r -- ai1 --> D^rr /ai1 f { { . } map } map def /ai ss0 0 get def { /degreeShiftUVnew ai1 { [ << wv 0 get weightv >> degreeShiftUV ] ord_ws_all } map def (degreeShiftUVnew=) messagen degreeShiftUVnew message /degreeShiftDnew ai1 { [ << v ecart.minimalBase.D1 weightv >> degreeShiftD ] ord_ws_all} map def (degreeShiftDnew=) messagen degreeShiftDnew message ai {[wv 0 get weightv degreeShiftUVnew] init} map /ai_gr set %C Note 2003.8.26 ai [ ] eq { exit } { } ifelse /s ai length def /r ai 0 get length def /itIsMinimal 1 def 0 1 s 1 sub { /i set 0 1 r 1 sub { /j set [(isConstantAll) ai_gr i get j get] gbext ai_gr i get j get (0). eq not and { /itIsMinimal 0 def /p i def /q j def } { } ifelse } for } for itIsMinimal { exit } { } ifelse % construct new ai and ai1 (A_i and A_{i-1}) /ai1_new r 1 sub newVector def /j 0 def 0 1 r 1 sub { /i set i q eq not { ai1_new j ai1 i get put /j j 1 add def } { } ifelse } for /ai_new [s r] newMatrix def 0 1 s 1 sub { /j set 0 1 r 1 sub { /k set ai_new [j k] << ai p get q get >> << ai j get k get >> mul << ai j get q get >> << ai p get k get >> mul sub put } for } for % remove 0 column /ai_new2 [s 1 sub r 1 sub] newMatrix def /j 0 def 0 1 s 1 sub { /i set i p eq not { ai_new2 j << ai_new i get q ecart.removeElem >> put /j j 1 add def } { } ifelse } for % ( ) error /ai1 ai1_new def /ai ai_new2 ecart.removeZeroRow def } loop /arg1 [ ai1 ai1 {[wv 0 get weightv degreeShift 0 get] init} map %Getting gr of A_{i-1} [ai v wv [(degreeShift) [degreeShiftUVnew] (startingShift) [degreeShiftDnew degreeShiftUVnew]]] ai {[wv 0 get weightv degreeShiftUVnew] init} map %Getting gr of A_i ] def ] pop popVariables arg1 } def /ecart.minimalResol { /arg1 set [/in-ecart.minimalResol /aa /ans /gg0 /ansds /ans_gr /c] pushVariables [ /aa arg1 def /ans [ ] def /ansds [ ] def /ans_gr [ ] def /c 0 def (---- ecart.gen_input ----) message aa ecart.gen_input /gg0 set ansds gg0 3 get 3 get append /ansds set (---- ecart.minimalBase --- Degree ) messagen c message c 1 add /c set gg0 ecart.minimalBase /ssi set ansds ssi 2 get 3 get 3 get append /ansds set ans ssi 0 get append /ans set ans_gr ssi 1 get append /ans_gr set { ssi 3 get [ ] eq { exit } { } ifelse (---- ecart.minimalBase --- Degree ) messagen c message c 1 add /c set ssi 2 get ecart.minimalBase /ssi_new set ans ssi_new 0 get append /ans set ansds ssi_new 2 get 3 get 3 get append /ansds set ans_gr ssi_new 1 get append /ans_gr set /ssi ssi_new def } loop /arg1 [ans ansds ans_gr] def ] pop popVariables arg1 } def (ecart.minimalResol) message [(ecart.minimalResol) [ $[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]] ecart.minimalResol $ ( [resol degree_shifts gr_of_resol_by_uv_shift_m] ) $Example1: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $ $ [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $ $ [(degreeShift) [ [0] ] $ $ (startingShift) [ [0] [0] ] ] ] ecart.minimalResol /gg set gg pmat $ ]] putUsages %% for ecart.weight_vector /ecart.eliminationOrderTemplate { %% esize >= 1 %% if esize == 0, it returns reverse lexicographic order. %% m esize eliminationOrderTemplate mat /arg2 set /arg1 set [/m /esize /m1 /m2 /k /om /omtmp] pushVariables [ /m arg1 def /esize arg2 def /m1 m esize sub 1 sub def /m2 esize 1 sub def [esize 0 gt { [1 1 esize { pop 1 } for esize 1 << m 1 sub >> { pop 0 } for ] %% 1st vector } { } ifelse m esize gt { [1 1 esize { pop 0 } for esize 1 << m 1 sub >> { pop 1 } for ] %% 2nd vector } { } ifelse m1 0 gt { m 1 sub -1 << m m1 sub >> { /k set m k evec_neg } for } { } ifelse m2 0 gt { << esize 1 sub >> -1 1 { /k set m k evec_neg } for } { } ifelse ] /om set om [ 0 << m 2 idiv >> 1 sub] 0 put om [ << m 2 idiv >> 1 add << m 2 idiv >> 1 sub] 0 put /arg1 om def ] pop popVariables arg1 } def %note 2003.09.29 /ecart.elimination_order { %% [x-list d-list params] (x,y,z) elimination_order %% vars evars %% [x-list d-list params order] /arg2 set /arg1 set [/vars /evars /univ /order /perm /univ0 /compl /m /omtmp] pushVariables /vars arg1 def /evars [arg2 to_records pop] def [ /univ vars 0 get reverse vars 1 get reverse join def << univ length 2 sub >> << evars length >> ecart.eliminationOrderTemplate /order set [[1]] order oplus [[1]] oplus /order set /m order length 2 sub def /omtmp [1 1 m 2 add { pop 0 } for ] def omtmp << m 2 idiv >> 1 put order omtmp append /order set % order pmat /univ0 [univ reverse aload pop pop] reverse def %% [e,x,y,h] --> [x,y,h] /compl [univ 0 get] evars join evars univ0 complement join def compl univ getPerm /perm set %%perm :: univ :: compl :: order perm permuteOrderMatrix /order set vars [order] join /arg1 set ] pop popVariables arg1 } def /ecart.define_ring { /arg1 set [/rp /param /foo] pushVariables [/rp arg1 def rp 0 get length 3 eq { rp 0 [rp 0 get 0 get rp 0 get 1 get rp 0 get 2 get ] ( ) ecart.elimination_order put } { } ifelse [ rp 0 get 0 get %% x-list rp 0 get 1 get %% d-list rp 0 get 2 get /param set param 0 << rp 1 get >> put %% << rp 1 get >> is 17 in the example. param %% parameters. rp 0 get 3 get %% order matrix. rp length 2 eq { [ ] } %% null optional argument. { rp 2 get } ifelse ] /foo set foo aload pop set_up_ring@ ] pop popVariables [(CurrentRingp)] system_variable } def /ecart.weight_vector { /arg2 set /arg1 set [/vars /univ /w-vectors /www /k /order1 /order2] pushVariables /vars arg1 def /w-vectors arg2 def [ /univ vars 0 get reverse vars 1 get reverse join def [ 0 1 << w-vectors length 1 sub >> { /k set univ w-vectors k get w_to_vec } for ] /order1 set %% order1 :: vars ( ) ecart.elimination_order 3 get /order2 set vars [ << order1 order2 join >> ] join /arg1 set ] pop popVariables arg1 } def %% end of for ecart.define_ring /ecartd.reduction { /arg2 set /arg1 set [/in-ecartd.reduction /gbasis /flist /ans /gbasis2] pushVariables [(CurrentRingp) (KanGBmessage)] pushEnv [ /gbasis arg2 def /flist arg1 def gbasis 0 get tag 6 eq { } { (ecartd.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 ecartd.gb 0 get getRing ring_def /gbasis2 gbasis 0 get ,,, def } ifelse ecartd.begin flist ,,, /flist set flist tag 6 eq { flist { gbasis2 reduction } map /ans set }{ flist gbasis2 reduction /ans set } ifelse /arg1 ans def ecartd.end ] pop popEnv popVariables arg1 } def /ecartd.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]]] ecartd.gb /gg set (Dx) [gg 0 get] ecartd.reduction /gg2 set gg2 message (-----------------------------) message [(Dx) (Dy) (Dx+x*Dy)] [gg 0 get] ecartd.reduction /gg3 set gg3 message (-----------------------------) message [[( 2*(1-x-y) Dx + h ) ( 2*(1-x-y) Dy + h )] (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] } def /ecarth.reduction { /arg2 set /arg1 set [/in-ecarth.reduction /gbasis /flist /ans /gbasis2] pushVariables [(CurrentRingp) (KanGBmessage)] pushEnv [ /gbasis arg2 def /flist arg1 def gbasis 0 get tag 6 eq { } { (ecarth.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 ecarth.gb 0 get getRing ring_def /gbasis2 gbasis 0 get ,,, def } ifelse ecarth.begin flist ,,, /flist set flist tag 6 eq { flist { gbasis2 reduction } map /ans set }{ flist gbasis2 reduction /ans set } ifelse /arg1 ans def ecarth.end ] pop popEnv popVariables arg1 } def [(ecartd.reduction) [ (f basis ecartd.reduction r) (f is reduced by basis by the tangent cone algorithm.) (r is the return value format of reduction.) (basis is the argument format of ecartd.gb.) (The first element of basis must be a standard basis.) (cf. reduction, ecartd.gb, ecartd.reduction.test ) $Example:$ $ [[( 2*(1-x-y) Dx + h ) ( 2*(1-x-y) Dy + h )] $ $ (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set $ $ (Dx+Dy) ggg ecartd.reduction :: $ ]] putUsages ( ) message-quiet