[BACK]Return to ecart.sm1 CVS log [TXT][DIR] Up to [local] / OpenXM / src / kan96xx / Doc

Annotation of OpenXM/src/kan96xx/Doc/ecart.sm1, Revision 1.34

1.34    ! takayama    1: % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.33 2004/09/10 13:20:22 takayama Exp $
1.30      takayama    2: (hol_loaded) boundp { }
                      3: { [(parse) (hol.sm1) pushfile] extension } ifelse
1.1       takayama    4: %[(parse) (appell.sm1) pushfile] extension
                      5:
                      6: (ecart.sm1 : ecart division for D, 2003/07/25 ) message-quiet
                      7: /ecart.begin { beginEcart } def
                      8: /ecart.end   { endEcart } def
                      9: /ecart.autoHomogenize 1 def
                     10: /ecart.needSyz 0 def
1.27      takayama   11: /ecartd.gb.oxRingStructure [[ ] [ ] ] def
1.24      takayama   12:
1.8       takayama   13: /ecartd.begin {
                     14:   ecart.begin
                     15:   [(EcartAutomaticHomogenization) 1] system_variable
                     16: } def
                     17: /ecartd.end {
                     18:   ecart.end
                     19:   [(EcartAutomaticHomogenization) 0] system_variable
                     20: } def
1.1       takayama   21:
1.22      takayama   22: /ecart.message.quiet 0 def
                     23: /ecart.message {
                     24:   ecart.message.quiet { pop } { message } ifelse
                     25: } def
                     26: /ecart.messagen {
                     27:   ecart.message.quiet { pop } { messagen } ifelse
                     28: } def
1.15      takayama   29: /ecart.setOpt {
                     30:   /arg1 set
                     31:   [/in-ecart.setOpt /opt /i /n /ans] pushVariables
                     32:   [
                     33:     /opt arg1 def
                     34:     /ans [ ] def
                     35:     /n opt length def
                     36:     0 2 n 1 sub {
                     37:       /i set
                     38:       opt i get tag StringP eq not {
                     39:          (ecart.setOpt : [keyword value keyword value ....] ) error
                     40:       } {  } ifelse
                     41:      {  % start of the loop
                     42: % Global:  degreeShift
                     43:       opt i get (degreeShift) eq {
                     44:         /degreeShift opt i 1 add get def
                     45:         exit
                     46:       } {  } ifelse
                     47: % Global:  hdShift
                     48:       opt i get (startingShift) eq {
                     49:         /hdShift opt i 1 add get def
                     50:         exit
                     51:       } {  } ifelse
                     52: % Global:  hdShift
                     53:       opt i get (noAutoHomogenize) eq {
                     54:         /hdShift -1 def
                     55:         exit
                     56:       } {  } ifelse
1.16      takayama   57: % Global:  ecart.useSugar
                     58:       opt i get (sugar) eq {
                     59:         /ecart.useSugar opt i 1 add get def
                     60:         exit
                     61:       } {  } ifelse
                     62:
1.34    ! takayama   63:       ans [opt i get opt i 1 add get ]  join /ans set
1.15      takayama   64:       exit
                     65:      } loop
                     66:     } for
                     67:
                     68:     ecart.gb.verbose {
                     69:       (ecart.setOpt:) message
                     70:       (degreeShift=) messagen degreeShift message
                     71:       $hdShift(startingShift)=$ messagen hdShift message
1.16      takayama   72:       (sugar=) messagen ecart.useSugar message
1.15      takayama   73:       (Other options=) messagen ans message
                     74:     } {  } ifelse
                     75:
                     76:     /arg1 ans def
                     77:   ] pop
                     78:   popVariables
                     79:   arg1
                     80: } def
                     81:
1.1       takayama   82: /ecart.dehomogenize {
                     83:  /arg1 set
                     84:  [/in.ecart.dehomogenize /ll /rr] pushVariables
                     85:  [
                     86:    /ll arg1 def
                     87:    ll tag 6 eq {
                     88:      ll { ecart.dehomogenize } map /ll set
                     89:    } {
                     90:      ll (0). eq {
                     91:      } {
                     92:        ll getRing /rr set
1.33      takayama   93:        ll [ [ @@@.Hsymbol rr __ (1) rr __ ]
                     94:             [ (h) rr __ (1) rr __ ]] replace
1.1       takayama   95:        /ll set
                     96:      } ifelse
                     97:    } ifelse
                     98:    /arg1 ll def
                     99:  ] pop
                    100:  popVariables
                    101:  arg1
                    102: } def
                    103: [(ecart.dehomogenize)
                    104:  [(obj ecart.dehomogenize r)
                    105:   (h->1, H->1)
                    106: ]] putUsages
                    107:
                    108: /ecart.dehomogenizeH {
                    109:  /arg1 set
                    110:  [/in.ecart.dehomogenize /ll /rr] pushVariables
                    111:  [
                    112:    /ll arg1 def
                    113:    ll tag 6 eq {
                    114:      ll { ecart.dehomogenize } map /ll set
                    115:    } {
                    116:      ll (0). eq {
                    117:      } {
                    118:        ll getRing /rr set
1.33      takayama  119:        ll [ [ @@@.Hsymbol rr __ (1) rr __ ] ] replace
1.1       takayama  120:        /ll set
                    121:      } ifelse
                    122:    } ifelse
                    123:    /arg1 ll def
                    124:  ] pop
                    125:  popVariables
                    126:  arg1
                    127: } def
                    128: [(ecart.dehomogenizeH)
                    129:  [(obj ecart.dehomogenizeH r)
                    130:   (H->1, h is not changed.)
                    131: ]] putUsages
                    132:
                    133: /ecart.homogenize01 {
                    134:  /arg1 set
1.11      takayama  135:  [/in.ecart.homogenize01 /ll /ll0] pushVariables
1.1       takayama  136:  [
                    137:    /ll arg1 def
1.11      takayama  138:    ll tag ArrayP eq {
                    139:      ll 0 get tag ArrayP eq not {
                    140:        [(degreeShift) [ ] ll ] homogenize   /arg1 set
                    141:      } {
                    142:        ll { ecart.homogenize01 } map /arg1 set
                    143:      } ifelse
                    144:    } {
                    145:        [(degreeShift) [ ] ll ] homogenize   /arg1 set
1.12      takayama  146:    } ifelse
1.1       takayama  147:  ] pop
                    148:  popVariables
                    149:  arg1
                    150: } def
                    151: [(ecart.homogenize01)
                    152:  [(obj ecart.homogenize01 r)
                    153:   (Example:  )
                    154:   (  [(x1,x2) ring_of_differential_operators )
                    155:   (   [[(H) 1 (h) 1 (x1) 1 (x2) 1] )
                    156:   (    [(h) 1 (Dx1) 1 (Dx2) 1] )
                    157:   (    [(Dx1) 1 (Dx2) 1]   )
                    158:   (    [(x1) -1 (x2) -1])
1.18      takayama  159:   (   ] ecart.weight_vector )
1.1       takayama  160:   (   0  )
1.11      takayama  161:   (   [(weightedHomogenization) 1 (degreeShift) [[0 0 0]]])
1.1       takayama  162:   (  ] define_ring)
                    163:   ( ecart.begin)
                    164:   ( [[1 -4 -2 5]] appell4 0 get /eqs set)
                    165:   ( eqs { . [[(x1). (x1+2).] [(x2). (x2+4).]] replace} map )
1.11      takayama  166:   ( {ecart.homogenize01} map /eqs2 set)
1.1       takayama  167:   ( [eqs2] groebner )
                    168: ]] putUsages
                    169:
                    170: /ecart.homogenize01_with_shiftVector {
                    171:  /arg2.set
                    172:  /arg1 set
1.11      takayama  173:  [/in.ecart.homogenize01 /ll /sv /ll0] pushVariables
1.1       takayama  174:  [
                    175:    /sv arg2 def
                    176:    /ll arg1 def
1.11      takayama  177:    ll tag ArrayP eq {
                    178:      ll 0 get tag ArrayP eq not {
                    179:        [(degreeShift) sv ll ] homogenize   /arg1 set
                    180:      } {
                    181:        ll { ecart.homogenize01_with_shiftVector } map /arg1 set
                    182:      } ifelse
                    183:    } {
                    184:        [(degreeShift) sv ll ] homogenize   /arg1 set
1.12      takayama  185:    } ifelse
1.1       takayama  186:  ] pop
                    187:  popVariables
                    188:  arg1
                    189: } def
                    190: [(ecart.dehomogenize01_with_degreeShift)
                    191:  [(obj shift-vector ecart.dehomogenize01_with_degreeShift r)
1.11      takayama  192:   (cf. homogenize)
1.1       takayama  193: ]] putUsages
                    194:
                    195: %% Aux functions to return the default weight vectors.
                    196: /ecart.wv1 {
                    197:   /arg1 set
                    198:   [/in.ecart.wv1 /v] pushVariables
                    199:   [
                    200:     /v arg1 def
1.24      takayama  201:     [@@@.Hsymbol (h) v to_records pop] /v set
1.1       takayama  202:     v { 1 } map /v set
                    203:     /arg1 v def
                    204:   ] pop
                    205:   popVariables
                    206:   arg1
                    207: } def
                    208: /ecart.wv2 {
                    209:   /arg1 set
                    210:   [/in.ecart.wv2 /v] pushVariables
                    211:   [
                    212:     /v arg1 def
                    213:     [v to_records pop] /v set
                    214:     v { [ @@@.Dsymbol 3 -1 roll ] cat 1 } map /v set
                    215:     [(h) 1 ] v join /v set
                    216:     /arg1 v def
                    217:   ] pop
                    218:   popVariables
                    219:   arg1
                    220: } def
                    221:
1.7       takayama  222: /ecart.gb {ecartd.gb}  def
                    223:
1.22      takayama  224: [(ecartd.gb)
                    225: [(See ecart.gb)]] putUsages
                    226:
1.7       takayama  227: [(ecart.gb)
                    228:  [(a ecart.gb b)
                    229:   (array a; array b;)
                    230:   $b : [g ii];  array g; array in; g is a standard (Grobner) basis of f$
                    231:   (             in the ring of differential operators.)
                    232:   (The computation is done by using Ecart division algorithm and )
                    233:   (the double homogenization.)
                    234:   (cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003)
                    235:    $            ii is the initial ideal in case of w is given or <<a>> belongs$
                    236:    $            to a ring. In the other cases, it returns the initial monominal.$
                    237:   (a : [f ];    array f;  f is a set of generators of an ideal in a ring.)
                    238:   (a : [f v];   array f; string v;  v is the variables. )
                    239:   (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
1.15      takayama  240:   $a : [f v w [(degreeShift) ds]]; array f; string v; array of array w; w is the weight matirx.$
1.11      takayama  241:   (                array ds; ds is the degree shift for the ring. )
1.15      takayama  242:   $a : [f v w [(degreeShift) ds (startingShift) hdShift]]; array f; string v; array of array w; w is the weight matirx.$
1.11      takayama  243:   (        array ds; ds is the degree shift for the ring. )
                    244:   (        array hsShift is the degree shift for the homogenization. cf.homogenize )
1.15      takayama  245:   $a : [f v w [(degreeShift) ds (noAutoHomogenize) 1]]; array f; string v; array of array w; w is the weight matirx.$
1.11      takayama  246:   (       No automatic homogenization.)
1.16      takayama  247:   $  [(degreeShift) ds (noAutoHomogenize) 1 (sugar) 1] -->use the sugar strate $
1.7       takayama  248:   (  )
1.19      takayama  249:   $cf. ecarth.gb (homogenized),  ecartd.gb (dehomogenize), ecartd.reduction $
1.25      takayama  250:   (    ecartd.gb.oxRingStructure )
1.7       takayama  251:   ( )
                    252:   $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
                    253:   $             [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $
                    254:   (Example 2: )
                    255:   $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
1.9       takayama  256:   $   [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecart.gb  /ff set ff pmat ;$
                    257:   (To set the current ring to the ring in which ff belongs )
                    258:   (      ff getRing ring_def  )
1.7       takayama  259:   (  )
                    260:   $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) (  x y Dx Dy -1)] (x,y) $
                    261:   $             [ [ (Dx) 1 (Dy) 1] ] ] ecart.gb pmat ; $
1.10      takayama  262:   (   This example will cause an error on order.)
1.7       takayama  263:   (  )
                    264:   $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
                    265:   $             [ [ (x) -1 (y) -1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $
1.10      takayama  266:   (   This example will cause an error on order.)
1.7       takayama  267:   (  )
                    268:   $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
1.15      takayama  269:   $             [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ]  $
                    270:   $             [(degreeShift) [[0 1] [-3 1]]] ] ecart.gb pmat ; $
1.7       takayama  271:   (  )
                    272:   (cf. gb, groebner, ecarth.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
                    273:   (    ecart.dehomogenize, ecart.dehomogenizeH)
                    274:   ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
                    275:   (                                                          define_ring )
                    276:   (/ecart.autoHomogenize 0 def )
                    277:   (               not to dehomogenize and homogenize)
                    278: ]] putUsages
                    279:
1.1       takayama  280: /ecart.gb.verbose 1 def
1.12      takayama  281: %ecarth.gb  s(H)-homogenized outputs.  GG's original version of ecart gb.
1.7       takayama  282: /ecarth.gb {
1.1       takayama  283:   /arg1 set
1.7       takayama  284:   [/in-ecarth.gb /aa /typev /setarg /f /v
1.1       takayama  285:    /gg /wv /vec /ans /rr /mm
                    286:    /degreeShift  /env2 /opt /ans.gb
1.12      takayama  287:    /hdShift
1.17      takayama  288:    /ecart.useSugar
1.1       takayama  289:   ] pushVariables
                    290:   [(CurrentRingp) (KanGBmessage)] pushEnv
                    291:   [
                    292:     /aa arg1 def
1.13      takayama  293:     aa isArray { } { ( << array >> ecarth.gb) error } ifelse
1.1       takayama  294:     /setarg 0 def
                    295:     /wv 0 def
                    296:     /degreeShift 0 def
1.12      takayama  297:     /hdShift 0 def
1.1       takayama  298:     /opt [(weightedHomogenization) 1] def
1.17      takayama  299:     /ecart.useSugar 0 def
1.1       takayama  300:     aa { tag } map /typev set
                    301:     typev [ ArrayP ] eq
                    302:     {  /f aa 0 get def
                    303:        /v gb.v def
                    304:        /setarg 1 def
                    305:     } { } ifelse
                    306:     typev [ArrayP StringP] eq
                    307:     {  /f aa 0 get def
                    308:        /v aa 1 get def
                    309:        /setarg 1 def
                    310:     } { } ifelse
                    311:     typev [ArrayP RingP] eq
                    312:     {  /f aa 0 get def
                    313:        /v aa 1 get def
                    314:        /setarg 1 def
                    315:     } { } ifelse
                    316:     typev [ArrayP ArrayP] eq
                    317:     {  /f aa 0 get def
                    318:        /v aa 1 get from_records def
                    319:        /setarg 1 def
                    320:     } { } ifelse
                    321:     typev [ArrayP StringP ArrayP] eq
                    322:     {  /f aa 0 get def
                    323:        /v aa 1 get def
                    324:        /wv aa 2 get def
                    325:        /setarg 1 def
                    326:     } { } ifelse
                    327:     typev [ArrayP ArrayP ArrayP] eq
                    328:     {  /f aa 0 get def
                    329:        /v aa 1 get from_records def
                    330:        /wv aa 2 get def
                    331:        /setarg 1 def
                    332:     } { } ifelse
1.15      takayama  333:
1.1       takayama  334:     typev [ArrayP StringP ArrayP ArrayP] eq
                    335:     {  /f aa 0 get def
                    336:        /v aa 1 get def
                    337:        /wv aa 2 get def
1.15      takayama  338:        opt aa 3 get ecart.setOpt join /opt set
1.12      takayama  339:        /setarg 1 def
                    340:     } { } ifelse
1.1       takayama  341:     typev [ArrayP ArrayP ArrayP ArrayP] eq
                    342:     {  /f aa 0 get def
                    343:        /v aa 1 get from_records def
                    344:        /wv aa 2 get def
1.15      takayama  345:        opt aa 3 get ecart.setOpt join /opt set
1.13      takayama  346:        /setarg 1 def
                    347:     } { } ifelse
1.1       takayama  348:
                    349:     /env1 getOptions def
                    350:
1.12      takayama  351:     ecart.gb.verbose { $ecarth.gb computes std basis with h-s(H)-homogenized buchberger algorithm.$ message } {  } ifelse
                    352:     setarg { } { (ecarth.gb : Argument mismatch) error } ifelse
1.1       takayama  353:
                    354:     [(KanGBmessage) ecart.gb.verbose ] system_variable
                    355:
                    356:     %%% Start of the preprocess
                    357:     v tag RingP eq {
                    358:        /rr v def
                    359:     }{
                    360:       f getRing /rr set
                    361:     } ifelse
                    362:     %% To the normal form : matrix expression.
                    363:     f gb.toMatrixOfString /f set
                    364:     /mm gb.itWasMatrix def
                    365:
                    366:     rr tag 0 eq {
                    367:       %% Define our own ring
                    368:       v isInteger {
                    369:         (Error in gb: Specify variables) error
                    370:       } {  } ifelse
                    371:       wv isInteger {
                    372:         [v ring_of_differential_operators
1.18      takayama  373: %         [ v ecart.wv1 v ecart.wv2 ] ecart.weight_vector
1.3       takayama  374:          gb.characteristic
1.1       takayama  375:          opt
                    376:         ] define_ring
                    377:       }{
                    378:        degreeShift isInteger {
                    379:          [v ring_of_differential_operators
1.18      takayama  380: %          [v ecart.wv1 v ecart.wv2] wv join ecart.weight_vector
                    381:           wv ecart.weight_vector
1.3       takayama  382:           gb.characteristic
1.1       takayama  383:           opt
                    384:          ] define_ring
                    385:
                    386:        }{
                    387:          [v ring_of_differential_operators
1.18      takayama  388: %          [v ecart.wv1 v ecart.wv2] wv join ecart.weight_vector
                    389:           wv  ecart.weight_vector
1.3       takayama  390:           gb.characteristic
1.1       takayama  391:           [(degreeShift) degreeShift] opt join
                    392:           ] define_ring
                    393:
                    394:        } ifelse
                    395:       } ifelse
                    396:     } {
                    397:       %% Use the ring structre given by the input.
                    398:       v isInteger not {
                    399:         gb.warning {
                    400:          (Warning : the given ring definition is not used.) message
                    401:         } { } ifelse
                    402:       } {  } ifelse
                    403:       rr ring_def
                    404:       /wv rr gb.getWeight def
                    405:
                    406:     } ifelse
                    407:     %%% Enf of the preprocess
                    408:
                    409:     ecart.gb.verbose {
1.6       takayama  410:       (The first and the second weight vectors for automatic homogenization: )
1.1       takayama  411:        message
                    412:        v ecart.wv1 message
                    413:        v ecart.wv2 message
                    414:        degreeShift isInteger { }
                    415:        {
                    416:          (The degree shift is ) messagen
                    417:          degreeShift message
                    418:        } ifelse
                    419:     } { } ifelse
                    420:
1.5       takayama  421:     %%BUG: case of v is integer
                    422:     v ecart.checkOrder
                    423:
1.1       takayama  424:     ecart.begin
                    425:
                    426:     ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
1.13      takayama  427:
1.12      takayama  428:
                    429:     hdShift tag 1 eq {
                    430:      ecart.autoHomogenize not hdShift -1 eq or {
                    431: % No automatic h-s-homogenization.
                    432:        f { {. } map} map /f set
                    433:      } {
                    434: % Automatic h-s-homogenization without degreeShift
1.13      takayama  435:     (ecarth.gb: Input polynomial or vectors are automatically h-H-homogenized without degree shift.)
                    436:       message
1.12      takayama  437:        f { {. ecart.dehomogenize} map} map /f set
                    438:        f ecart.homogenize01 /f set
                    439:      } ifelse
                    440:    } {
                    441: % Automatic h-s-homogenization with degreeShift
1.13      takayama  442:     (ecarth.gb: Input polynomial or vectors are automatically h-H-homogenized with degree shift.)
                    443:       message
1.12      takayama  444:        f { {. ecart.dehomogenize} map} map /f set
                    445:        f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set
                    446:    }ifelse
                    447:
1.17      takayama  448:     ecart.useSugar {
                    449:       ecart.needSyz {
                    450:         [f [(needSyz)] gb.options join ] groebner_sugar /gg set
                    451:       } {
                    452:         [f gb.options] groebner_sugar 0 get /gg set
                    453:       } ifelse
                    454:     } {
                    455:       ecart.needSyz {
                    456:         [f [(needSyz)] gb.options join ] groebner /gg set
                    457:       } {
                    458:         [f gb.options] groebner 0 get /gg set
                    459:       } ifelse
1.1       takayama  460:     } ifelse
                    461:
                    462:     ecart.needSyz {
                    463:       mm {
                    464:        gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
1.11      takayama  465:        } { /ans.gb gg 0 get def } ifelse
                    466:        /ans [gg 2 get , ans.gb , gg 1 get , f ] def
                    467: %      ans pmat ;
1.1       takayama  468:     } {
                    469:       wv isInteger {
                    470:         /ans [gg gg {init} map] def
                    471:       }{
1.10      takayama  472:        degreeShift isInteger {
                    473:          /ans [gg gg {wv 0 get weightv init} map] def
                    474:        } {
                    475:          /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
                    476:        } ifelse
1.1       takayama  477:       }ifelse
                    478:
                    479:       %% Postprocess : recover the matrix expression.
                    480:       mm {
                    481:         ans { /tmp set [mm tmp] toVectors } map
                    482:         /ans set
                    483:       }{ }
                    484:       ifelse
                    485:     } ifelse
                    486:
                    487:     ecart.end
                    488:
                    489:     %%
                    490:     env1 restoreOptions  %% degreeShift changes "grade"
                    491:
                    492:     /arg1 ans def
                    493:   ] pop
                    494:   popEnv
                    495:   popVariables
                    496:   arg1
                    497: } def
1.7       takayama  498: (ecarth.gb ) messagen-quiet
1.1       takayama  499:
1.7       takayama  500: [(ecarth.gb)
                    501:  [(a ecarth.gb b)
1.1       takayama  502:   (array a; array b;)
                    503:   $b : [g ii];  array g; array in; g is a standard (Grobner) basis of f$
                    504:   (             in the ring of differential operators.)
1.12      takayama  505:   (The computation is done by using Ecart division algorithm.)
                    506:   $Buchberger algorithm is applied for double h-H(s)-homogenized elements and$
                    507:   (they are not dehomogenized.)
1.1       takayama  508:   (cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003)
                    509:    $            ii is the initial ideal in case of w is given or <<a>> belongs$
                    510:    $            to a ring. In the other cases, it returns the initial monominal.$
                    511:   (a : [f ];    array f;  f is a set of generators of an ideal in a ring.)
                    512:   (a : [f v];   array f; string v;  v is the variables. )
                    513:   (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
1.15      takayama  514:   $a : [f v w [(degreeShift) ds]]; array f; string v; array of array w; w is the weight matirx.$
1.1       takayama  515:   (                array ds; ds is the degree shift )
                    516:   (  )
                    517:   (/ecart.autoHomogenize 0 def )
                    518:   (               not to dehomogenize and homogenize)
                    519:   ( )
                    520:   $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
1.7       takayama  521:   $             [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.gb pmat ; $
1.1       takayama  522:   (Example 2: )
                    523:   (To put H and h=1, type in, e.g., )
                    524:   $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
1.7       takayama  525:   $   [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecarth.gb /gg set gg ecart.dehomogenize pmat ;$
1.1       takayama  526:   (  )
                    527:   $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) (  x y Dx Dy -1)] (x,y) $
1.7       takayama  528:   $             [ [ (Dx) 1 (Dy) 1] ] ] ecarth.gb pmat ; $
1.1       takayama  529:   (  )
                    530:   $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
1.7       takayama  531:   $             [ [ (x) -1 (y) -1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.gb pmat ; $
1.1       takayama  532:   (  )
                    533:   $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
1.15      takayama  534:   $             [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] $
                    535:   $            [(degreeShift) [[0 1] [-3 1] ]]  ] ecarth.gb pmat ; $
1.1       takayama  536:   (  )
1.7       takayama  537:   (cf. gb, groebner, ecart.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
1.1       takayama  538:   (    ecart.dehomogenize, ecart.dehomogenizeH)
                    539:   ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
                    540:   (                                                          define_ring )
                    541: ]] putUsages
                    542:
                    543:
                    544: /ecart.syz {
                    545:   /arg1 set
                    546:   [/in-ecart.syz /ecart.save.needSyz /ff /ff.ans] pushVariables
                    547:   [
                    548:     /ff arg1 def
                    549:     /ecart.save.needSyz ecart.needSyz def
                    550:     /ecart.needSyz 1 def
                    551:     ff ecart.gb /ff.ans set
                    552:     /ecart.needSyz ecart.save.needSyz def
                    553:     /arg1 ff.ans def
                    554:   ] pop
                    555:   popVariables
                    556:   arg1
                    557: } def
                    558: (ecart.syz ) messagen-quiet
                    559:
                    560: [(ecart.syz)
                    561:  [(a ecart.syz b)
                    562:   (array a; array b;)
                    563:   $b : [syzygy gb tmat input];  gb = tmat * input $
                    564:   $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) (  x y Dx Dy -1)] (x,y) $
1.8       takayama  565:   $             [ [ (Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.syz /ff set $
1.1       takayama  566:   $ ff 0 get ff 3 get mul pmat $
                    567:   $ ff 2 get  ff 3 get mul [ff 1 get ] transpose sub pmat ; $
                    568:   (  )
1.9       takayama  569:   (To set the current ring to the ring in which ff belongs )
                    570:   (      ff getRing ring_def  )
1.1       takayama  571:   $Example 2: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
1.8       takayama  572:   $             [ [(Dx) 1 (Dy) 1] [ (x) -1 (y) -1] ]  [[0 1] [-3 1] ] ] ecart.syz pmat ; $
1.1       takayama  573:   (  )
                    574:   (cf. ecart.gb)
                    575:   (    /ecart.autoHomogenize 0 def )
                    576: ]] putUsages
1.2       takayama  577:
1.3       takayama  578:
                    579: /ecartn.begin {
                    580:   (red@) (standard) switch_function
                    581: %%  (red@) (ecart) switch_function
                    582:   [(Ecart) 1] system_variable
                    583:   [(CheckHomogenization) 0] system_variable
                    584:   [(ReduceLowerTerms) 0] system_variable
                    585:   [(AutoReduce) 0] system_variable
                    586:   [(EcartAutomaticHomogenization) 0] system_variable
                    587: } def
                    588: /ecartn.gb {
                    589:   /arg1 set
                    590:   [/in-ecartn.gb /aa /typev /setarg /f /v
                    591:    /gg /wv /vec /ans /rr /mm
                    592:    /degreeShift  /env2 /opt /ans.gb
                    593:   ] pushVariables
                    594:   [(CurrentRingp) (KanGBmessage)] pushEnv
                    595:   [
                    596:     /aa arg1 def
1.13      takayama  597:     aa isArray { } { ( << array >> ecartn.gb) error } ifelse
1.3       takayama  598:     /setarg 0 def
                    599:     /wv 0 def
                    600:     /degreeShift 0 def
                    601:     /opt [(weightedHomogenization) 1] def
                    602:     aa { tag } map /typev set
                    603:     typev [ ArrayP ] eq
                    604:     {  /f aa 0 get def
                    605:        /v gb.v def
                    606:        /setarg 1 def
                    607:     } { } ifelse
                    608:     typev [ArrayP StringP] eq
                    609:     {  /f aa 0 get def
                    610:        /v aa 1 get def
                    611:        /setarg 1 def
                    612:     } { } ifelse
                    613:     typev [ArrayP RingP] eq
                    614:     {  /f aa 0 get def
                    615:        /v aa 1 get def
                    616:        /setarg 1 def
                    617:     } { } ifelse
                    618:     typev [ArrayP ArrayP] eq
                    619:     {  /f aa 0 get def
                    620:        /v aa 1 get from_records def
                    621:        /setarg 1 def
                    622:     } { } ifelse
                    623:     typev [ArrayP StringP ArrayP] eq
                    624:     {  /f aa 0 get def
                    625:        /v aa 1 get def
                    626:        /wv aa 2 get def
                    627:        /setarg 1 def
                    628:     } { } ifelse
                    629:     typev [ArrayP ArrayP ArrayP] eq
                    630:     {  /f aa 0 get def
                    631:        /v aa 1 get from_records def
                    632:        /wv aa 2 get def
                    633:        /setarg 1 def
                    634:     } { } ifelse
1.15      takayama  635:
1.3       takayama  636:     typev [ArrayP StringP ArrayP ArrayP] eq
                    637:     {  /f aa 0 get def
                    638:        /v aa 1 get def
                    639:        /wv aa 2 get def
1.15      takayama  640:        opt aa 3 get ecart.setOpt join /opt set
1.3       takayama  641:        /setarg 1 def
                    642:     } { } ifelse
                    643:     typev [ArrayP ArrayP ArrayP ArrayP] eq
                    644:     {  /f aa 0 get def
                    645:        /v aa 1 get from_records def
                    646:        /wv aa 2 get def
1.15      takayama  647:        opt aa 3 get ecart.setOpt join /opt set
1.3       takayama  648:        /setarg 1 def
                    649:     } { } ifelse
                    650:
                    651:     /env1 getOptions def
                    652:
                    653:     setarg { } { (ecart.gb : Argument mismatch) error } ifelse
                    654:
                    655:     [(KanGBmessage) ecart.gb.verbose ] system_variable
                    656:
                    657:     %%% Start of the preprocess
                    658:     v tag RingP eq {
                    659:        /rr v def
                    660:     }{
                    661:       f getRing /rr set
                    662:     } ifelse
                    663:     %% To the normal form : matrix expression.
                    664:     f gb.toMatrixOfString /f set
                    665:     /mm gb.itWasMatrix def
                    666:
                    667:     rr tag 0 eq {
                    668:       %% Define our own ring
                    669:       v isInteger {
                    670:         (Error in gb: Specify variables) error
                    671:       } {  } ifelse
                    672:       wv isInteger {
                    673:         [v ring_of_differential_operators
1.18      takayama  674:          [ v ecart.wv1 v ecart.wv2 ] ecart.weight_vector
1.3       takayama  675:          gb.characteristic
                    676:          opt
                    677:         ] define_ring
                    678:       }{
                    679:        degreeShift isInteger {
                    680:          [v ring_of_differential_operators
1.18      takayama  681:           [v ecart.wv1 v ecart.wv2] wv join ecart.weight_vector
1.3       takayama  682:           gb.characteristic
                    683:           opt
                    684:          ] define_ring
                    685:
                    686:        }{
                    687:          [v ring_of_differential_operators
1.18      takayama  688:           [v ecart.wv1 v ecart.wv2] wv join ecart.weight_vector
1.3       takayama  689:           gb.characteristic
                    690:           [(degreeShift) degreeShift] opt join
                    691:           ] define_ring
                    692:
                    693:        } ifelse
                    694:       } ifelse
                    695:     } {
                    696:       %% Use the ring structre given by the input.
                    697:       v isInteger not {
                    698:         gb.warning {
                    699:          (Warning : the given ring definition is not used.) message
                    700:         } { } ifelse
                    701:       } {  } ifelse
                    702:       rr ring_def
                    703:       /wv rr gb.getWeight def
                    704:
                    705:     } ifelse
                    706:     %%% Enf of the preprocess
                    707:
                    708:     ecart.gb.verbose {
                    709:       (The first and the second weight vectors are automatically set as follows)
                    710:        message
                    711:        v ecart.wv1 message
                    712:        v ecart.wv2 message
                    713:        degreeShift isInteger { }
                    714:        {
                    715:          (The degree shift is ) messagen
                    716:          degreeShift message
                    717:        } ifelse
                    718:     } { } ifelse
                    719:
1.5       takayama  720:     %%BUG: case of v is integer
                    721:     v ecart.checkOrder
                    722:
1.3       takayama  723:     ecartn.begin
                    724:
                    725:     ecart.gb.verbose { (ecartn.gb : ecart.gb without ecart division.) message } { } ifelse
                    726:     ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
                    727:     ecart.autoHomogenize {
                    728:       (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
                    729:       message
                    730:     } { } ifelse
                    731:     ecart.autoHomogenize {
                    732:       f { {. ecart.dehomogenize} map} map /f set
                    733:       f ecart.homogenize01 /f set
                    734:     }{
                    735:       f { {. } map } map /f set
                    736:     } ifelse
                    737:     ecart.needSyz {
                    738:       [f [(needSyz)] gb.options join ] groebner /gg set
                    739:     } {
                    740:       [f gb.options] groebner 0 get /gg set
                    741:     } ifelse
                    742:
                    743:     ecart.needSyz {
                    744:       mm {
                    745:        gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
                    746:       } { /ans.gb gg 0 get def } ifelse
                    747:       /ans [gg 2 get , ans.gb , gg 1 get , f ] def
1.11      takayama  748: %      ans pmat ;
1.3       takayama  749:     } {
                    750:       wv isInteger {
                    751:         /ans [gg gg {init} map] def
                    752:       }{
1.10      takayama  753:        degreeShift isInteger {
                    754:          /ans [gg gg {wv 0 get weightv init} map] def
                    755:        } {
                    756:          /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
                    757:        } ifelse
1.3       takayama  758:       }ifelse
                    759:
                    760:       %% Postprocess : recover the matrix expression.
                    761:       mm {
                    762:         ans { /tmp set [mm tmp] toVectors } map
                    763:         /ans set
                    764:       }{ }
                    765:       ifelse
                    766:     } ifelse
                    767:
                    768:     ecart.end
                    769:
                    770:     %%
                    771:     env1 restoreOptions  %% degreeShift changes "grade"
                    772:
                    773:     /arg1 ans def
                    774:   ] pop
                    775:   popEnv
                    776:   popVariables
                    777:   arg1
                    778: } def
                    779: (ecartn.gb[gb by non-ecart division] ) messagen-quiet
1.4       takayama  780:
                    781: /ecartd.gb {
                    782:   /arg1 set
                    783:   [/in-ecart.gb /aa /typev /setarg /f /v
                    784:    /gg /wv /vec /ans /rr /mm
                    785:    /degreeShift  /env2 /opt /ans.gb
1.11      takayama  786:    /hdShift
1.16      takayama  787:    /ecart.useSugar
1.4       takayama  788:   ] pushVariables
                    789:   [(CurrentRingp) (KanGBmessage)] pushEnv
                    790:   [
                    791:     /aa arg1 def
1.13      takayama  792:     aa isArray { } { ( << array >> ecartd.gb) error } ifelse
1.4       takayama  793:     /setarg 0 def
                    794:     /wv 0 def
                    795:     /degreeShift 0 def
1.11      takayama  796:     /hdShift 0 def
1.16      takayama  797:     /ecart.useSugar 0 def
1.4       takayama  798:     /opt [(weightedHomogenization) 1] def
                    799:     aa { tag } map /typev set
                    800:     typev [ ArrayP ] eq
                    801:     {  /f aa 0 get def
                    802:        /v gb.v def
                    803:        /setarg 1 def
                    804:     } { } ifelse
                    805:     typev [ArrayP StringP] eq
                    806:     {  /f aa 0 get def
                    807:        /v aa 1 get def
                    808:        /setarg 1 def
                    809:     } { } ifelse
                    810:     typev [ArrayP RingP] eq
                    811:     {  /f aa 0 get def
                    812:        /v aa 1 get def
                    813:        /setarg 1 def
                    814:     } { } ifelse
                    815:     typev [ArrayP ArrayP] eq
                    816:     {  /f aa 0 get def
                    817:        /v aa 1 get from_records def
                    818:        /setarg 1 def
                    819:     } { } ifelse
                    820:     typev [ArrayP StringP ArrayP] eq
                    821:     {  /f aa 0 get def
                    822:        /v aa 1 get def
                    823:        /wv aa 2 get def
                    824:        /setarg 1 def
                    825:     } { } ifelse
                    826:     typev [ArrayP ArrayP ArrayP] eq
                    827:     {  /f aa 0 get def
                    828:        /v aa 1 get from_records def
                    829:        /wv aa 2 get def
                    830:        /setarg 1 def
                    831:     } { } ifelse
1.15      takayama  832:
1.4       takayama  833:     typev [ArrayP StringP ArrayP ArrayP] eq
                    834:     {  /f aa 0 get def
                    835:        /v aa 1 get def
                    836:        /wv aa 2 get def
1.15      takayama  837:        opt aa 3 get ecart.setOpt join /opt set
1.4       takayama  838:        /setarg 1 def
                    839:     } { } ifelse
                    840:     typev [ArrayP ArrayP ArrayP ArrayP] eq
                    841:     {  /f aa 0 get def
                    842:        /v aa 1 get from_records def
                    843:        /wv aa 2 get def
1.15      takayama  844:        opt aa 3 get ecart.setOpt join /opt set
1.13      takayama  845:        /setarg 1 def
                    846:     } { } ifelse
1.4       takayama  847:
                    848:     /env1 getOptions def
                    849:
                    850:     setarg { } { (ecart.gb : Argument mismatch) error } ifelse
                    851:
                    852:     [(KanGBmessage) ecart.gb.verbose ] system_variable
1.22      takayama  853:     $ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ ecart.message
1.4       takayama  854:
                    855:     %%% Start of the preprocess
                    856:     v tag RingP eq {
                    857:        /rr v def
                    858:     }{
                    859:       f getRing /rr set
                    860:     } ifelse
                    861:     %% To the normal form : matrix expression.
                    862:     f gb.toMatrixOfString /f set
                    863:     /mm gb.itWasMatrix def
                    864:
                    865:     rr tag 0 eq {
                    866:       %% Define our own ring
                    867:       v isInteger {
                    868:         (Error in gb: Specify variables) error
                    869:       } {  } ifelse
                    870:       wv isInteger {
1.22      takayama  871:         (Give a weight vector such that x < 1) error
1.4       takayama  872:       }{
                    873:        degreeShift isInteger {
                    874:          [v ring_of_differential_operators
1.18      takayama  875:            wv ecart.weight_vector
1.4       takayama  876:           gb.characteristic
                    877:           opt
                    878:          ] define_ring
                    879:
                    880:        }{
                    881:          [v ring_of_differential_operators
1.18      takayama  882:            wv ecart.weight_vector
1.4       takayama  883:           gb.characteristic
                    884:           [(degreeShift) degreeShift] opt join
                    885:           ] define_ring
                    886:
                    887:        } ifelse
                    888:       } ifelse
                    889:     } {
                    890:       %% Use the ring structre given by the input.
                    891:       v isInteger not {
                    892:         gb.warning {
                    893:          (Warning : the given ring definition is not used.) message
                    894:         } { } ifelse
                    895:       } {  } ifelse
                    896:       rr ring_def
                    897:       /wv rr gb.getWeight def
                    898:
                    899:     } ifelse
                    900:     %%% Enf of the preprocess
                    901:
                    902:     ecart.gb.verbose {
                    903:        degreeShift isInteger { }
                    904:        {
                    905:          (The degree shift is ) messagen
                    906:          degreeShift message
                    907:        } ifelse
                    908:     } { } ifelse
                    909:
1.5       takayama  910:     %%BUG: case of v is integer
                    911:     v ecart.checkOrder
                    912:
1.8       takayama  913:     ecartd.begin
1.4       takayama  914:
1.22      takayama  915:     ecart.gb.verbose { (gb.options = ) ecart.messagen gb.options ecart.message } { } ifelse
1.4       takayama  916:
1.11      takayama  917:     hdShift tag 1 eq {
1.12      takayama  918:      ecart.autoHomogenize not hdShift -1 eq  or {
1.11      takayama  919: % No automatic h-homogenization.
                    920:        f { {. } map} map /f set
                    921:      } {
                    922: % Automatic h-homogenization without degreeShift
1.22      takayama  923:        (ecartd.gb : Input polynomial or vectors are automatically homogenized without degreeShift) ecart.message
1.11      takayama  924:        f { {. ecart.dehomogenize} map} map /f set
                    925:        f ecart.homogenize01 /f set
1.24      takayama  926:        f { { [[@@@.Hsymbol . (1).]] replace } map } map /f set
1.11      takayama  927:      } ifelse
                    928:    } {
                    929: % Automatic h-homogenization with degreeShift
1.13      takayama  930:        (ecartd.gb : Input polynomial or vectors are automatically homogenized with degreeShift) message
1.11      takayama  931:        f { {. ecart.dehomogenize} map} map /f set
                    932:        f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set
1.24      takayama  933:        f { { [[@@@.Hsymbol . (1).]] replace } map } map /f set
1.11      takayama  934:    }ifelse
1.4       takayama  935:
1.16      takayama  936:     ecart.useSugar {
                    937:       ecart.needSyz {
                    938:         [f [(needSyz)] gb.options join ] groebner_sugar /gg set
                    939:       } {
                    940:         [f gb.options] groebner_sugar 0 get /gg set
                    941:       } ifelse
                    942:     } {
                    943:       ecart.needSyz {
                    944:         [f [(needSyz)] gb.options join ] groebner /gg set
                    945:       } {
                    946:         [f gb.options] groebner 0 get /gg set
                    947:       } ifelse
1.4       takayama  948:     } ifelse
                    949:
                    950:     ecart.needSyz {
                    951:       mm {
                    952:        gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
                    953:       } { /ans.gb gg 0 get def } ifelse
                    954:       /ans [gg 2 get , ans.gb , gg 1 get , f ] def
1.11      takayama  955: %      ans pmat ;
1.4       takayama  956:     } {
                    957:       wv isInteger {
                    958:         /ans [gg gg {init} map] def
                    959:       }{
1.11      takayama  960: %% Get the initial ideal
1.10      takayama  961:        degreeShift isInteger {
                    962:          /ans [gg gg {wv 0 get weightv init} map] def
                    963:        } {
                    964:          /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
                    965:        } ifelse
1.4       takayama  966:       }ifelse
                    967:
                    968:       %% Postprocess : recover the matrix expression.
                    969:       mm {
                    970:         ans { /tmp set [mm tmp] toVectors } map
                    971:         /ans set
                    972:       }{ }
                    973:       ifelse
                    974:     } ifelse
                    975:
1.8       takayama  976:     ecartd.end
1.4       takayama  977:
1.24      takayama  978:     ans getRing (oxRingStructure) dc /ecartd.gb.oxRingStructure set
1.4       takayama  979:     %%
                    980:     env1 restoreOptions  %% degreeShift changes "grade"
                    981:
                    982:     /arg1 ans def
                    983:   ] pop
                    984:   popEnv
                    985:   popVariables
                    986:   arg1
                    987: } def
                    988: (ecartd.gb[results are dehomogenized at each reduction step] ) messagen-quiet
1.2       takayama  989:
1.5       takayama  990: /ecart.checkOrder {
                    991:   /arg1 set
                    992:   [/in-ecart.checkOrder /vv /tt /dd /n /i] pushVariables
                    993:   [
                    994:     /vv arg1 def
                    995:     vv isArray
                    996:     { } { [vv to_records pop] /vv set } ifelse
                    997:     vv {toString} map /vv set
                    998:     vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
                    999:     % Starting the checks.
                   1000:     0 1 vv length 1 sub {
                   1001:        /i set
                   1002:        vv i get . dd i get . mul /tt set
                   1003:        tt @@@.hsymbol . add init tt eq { }
                   1004:        { [@@@.hsymbol ( is larger than ) vv i get ( ) dd i get] cat error} ifelse
                   1005:     } for
                   1006:
                   1007:     0 1 vv length 1 sub {
                   1008:        /i set
                   1009:        vv i get . /tt set
                   1010:        tt (1). add init (1). eq { }
1.6       takayama 1011:        { [vv i get ( is larger than 1 ) ] cat error} ifelse
1.5       takayama 1012:     } for
                   1013:     /arg1 1 def
                   1014:   ] pop
                   1015:   popVariables
                   1016:   arg1
                   1017: } def
                   1018: [(ecart.checkOrder)
                   1019:  [(v ecart.checkOrder bool checks if the given order is relevant)
                   1020:   (for the ecart division.)
                   1021:   (cf. ecartd.gb, ecart.gb, ecartn.gb)
                   1022:  ]
                   1023: ] putUsages
                   1024:
                   1025: /ecart.wv_last {
                   1026:   /arg1 set
                   1027:   [/in-ecart.wv_last /vv /tt /dd /n /i] pushVariables
                   1028:   [
                   1029:     /vv arg1 def
                   1030:     vv isArray
                   1031:     { } { [vv to_records pop] /vv set } ifelse
                   1032:     vv {toString} map /vv set
                   1033:     vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
                   1034:     vv {  -1 } map
                   1035:     dd {   1 } map join /arg1 set
                   1036:   ] pop
                   1037:   popVariables
                   1038:   arg1
                   1039: } def
                   1040: [(ecart.wv_last)
                   1041:  [(v ecart.wv_last wt )
                   1042:   (It returns the weight vector -1,-1,...-1; 1,1, ..., 1)
                   1043:   (Use this weight vector as the last weight vector for ecart division)
                   1044:   (if ecart.checkOrder complains about the order given.)
                   1045:  ]
                   1046: ] putUsages
1.13      takayama 1047:
                   1048: /ecart.mimimalBase.test {
                   1049:  [
                   1050:     [    (0) , (-2*Dx) , (2*t) , (y) , (x^2) ]
                   1051:     [    (3*t ) , ( -3*Dy ) , ( 0 ) , ( -x ) , ( -y) ]
                   1052:     [    (3*y ) , ( 6*Dt ) , ( 2*x ) , ( 0 ) , ( 1) ]
                   1053:     [    (-3*x^2 ) , ( 0 ) , ( -2*y ) , ( 1 ) , ( 0 )]
                   1054:     [    (Dx ) , ( 0 ) , ( -Dy ) , ( Dt ) , ( 0) ]
                   1055:     [  (0 ) , ( 0 ) , ( 6*t*Dt+2*x*Dx+3*y*Dy+8*h ) , ( 0 ) , ( 3*x^2*Dt+Dx) ]
                   1056:     [  (6*t*Dx ) , ( 0 ) , ( -6*t*Dy ) , ( -2*x*Dx-3*y*Dy-5*h ) , ( -2*y*Dx-3*x^2*Dy) ]
                   1057:     [  (6*t*Dt+3*y*Dy+9*h ) , ( 0 ) , ( 2*x*Dy ) , ( -2*x*Dt ) , ( -2*y*Dt+Dy) ]
                   1058:   ]
                   1059:   /ff set
                   1060:
                   1061:   /nmshift [ [1 0 1 1 1] [1 0 1 0 0] ] def
                   1062:   /shift [ [1 0 1 0 0] ] def
                   1063:   /weight [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] def
                   1064:
1.15      takayama 1065:   [ff (t,x,y) weight [(degreeShift) shift (startingShift) nmshift]] ecart.minimalBase
1.13      takayama 1066:
                   1067:
                   1068: }  def
                   1069: /test {ecart.mimimalBase.test} def
                   1070:
                   1071: %(x,y) ==> [(Dx) 1 (Dy) 1 (h) 1]
                   1072: /ecart.minimalBase.D1 {
                   1073:   /arg1 set
                   1074:   [/in-ecart.minimalBase.D1  /tt /v]  pushVariables
                   1075:   [
                   1076:     /v arg1 def
                   1077:     [ v to_records pop] /v set
                   1078:     v { /tt set [@@@.Dsymbol tt] cat 1 } map /v set
                   1079:     v [(h) 1] join /arg1 set
                   1080:   ] pop
                   1081:   popVariables
                   1082:   arg1
                   1083: } def
                   1084:
                   1085: % [0 1 2] 1 ecart.removeElem [0 2]
                   1086: /ecart.removeElem {
                   1087:   /arg2 set
                   1088:   /arg1 set
                   1089:   [/in-ecart.removeElem /v /q /i /ans /j] pushVariables
                   1090:   [
                   1091:     /v arg1 def
                   1092:     /q arg2 def
                   1093:     /ans v length 1 sub newVector def
                   1094:     /j 0 def
                   1095:     0 1 v length 1 sub {
                   1096:       /i set
                   1097:       i q eq not {
                   1098:         ans j  v i get put
                   1099:         /j j 1 add def
                   1100:       } {  } ifelse
                   1101:     } for
                   1102:   ] pop
                   1103:   popVariables
                   1104:   arg1
                   1105: } def
                   1106:
1.14      takayama 1107: /ecart.isZeroRow {
                   1108:   /arg1 set
                   1109:   [/in-ecart.isZeroRow /aa /i /n /yes] pushVariables
                   1110:   [
                   1111:      /aa arg1 def
                   1112:      aa length /n set
                   1113:      /yes 1 def
                   1114:      0 1 n 1 sub {
                   1115:        /i set
                   1116:        aa i get (0). eq {
                   1117:        } {
                   1118:          /yes 0 def
                   1119:        } ifelse
                   1120:      } for
                   1121:      /arg1 yes def
                   1122:   ] pop
                   1123:   popVariables
                   1124:   arg1
                   1125: } def
                   1126:
                   1127: /ecart.removeZeroRow {
                   1128:   /arg1 set
                   1129:   [/in-ecart.removeZeroRow /aa /i /n /ans] pushVariables
                   1130:   [
                   1131:      /aa arg1 def
                   1132:      aa length /n set
                   1133:      /ans [ ] def
                   1134:      0 1 n 1 sub {
                   1135:        /i set
                   1136:        aa i get ecart.isZeroRow {
                   1137:        } {
                   1138:          ans aa i get append /ans set
                   1139:        } ifelse
                   1140:      } for
                   1141:      /arg1 ans def
                   1142:   ] pop
                   1143:   popVariables
                   1144:   arg1
                   1145: } def
                   1146:
                   1147: /ecart.gen_input {
                   1148:   /arg1 set
                   1149:   [/in-ecart.gen_input  /aa /typev /setarg /f /v
                   1150:    /gg /wv /vec /ans /rr /mm
                   1151:    /degreeShift  /env2 /opt /ss0
                   1152:    /hdShift /ff
                   1153:    ] pushVariables
                   1154:   [
                   1155:     /aa arg1 def
                   1156:     aa isArray { } { ( << array >> ecart.gen_input) error } ifelse
                   1157:     /setarg 0 def
                   1158:     /wv 0 def
                   1159:     /degreeShift 0 def
                   1160:     /hdShift 0 def
1.15      takayama 1161:     /opt [ ] def
1.14      takayama 1162:     aa { tag } map /typev set
1.15      takayama 1163:     typev [ArrayP StringP ArrayP ArrayP] eq
1.14      takayama 1164:     {  /f aa 0 get def
                   1165:        /v aa 1 get def
                   1166:        /wv aa 2 get def
1.15      takayama 1167:        opt aa 3 get ecart.setOpt join /opt set
1.14      takayama 1168:        /setarg 1 def
                   1169:     } { } ifelse
1.15      takayama 1170:     typev [ArrayP ArrayP ArrayP ArrayP] eq
1.14      takayama 1171:     {  /f aa 0 get def
                   1172:        /v aa 1 get from_records def
                   1173:        /wv aa 2 get def
1.15      takayama 1174:        opt aa 3 get ecart.setOpt join /opt set
1.14      takayama 1175:        /setarg 1 def
                   1176:     } { } ifelse
                   1177:     setarg { } { (ecart.minimalBase : Argument mismatch) error } ifelse
                   1178:
                   1179:     [(KanGBmessage) ecart.gb.verbose ] system_variable
                   1180:
                   1181:     f 0 get tag ArrayP eq {  }
                   1182:     {  f { /tt set [ tt ] } map /f set } ifelse
                   1183:
1.15      takayama 1184:     [f v wv [(degreeShift) degreeShift (startingShift) [hdShift 0 get degreeShift 0 get]] opt join]
1.14      takayama 1185:     ecart.gb /ff set
                   1186:     ff getRing ring_def
                   1187:
                   1188:     ff 0 get { {toString } map } map /ff set
                   1189:
1.15      takayama 1190:     [ff v wv
                   1191:       [(degreeShift) degreeShift (startingShift) [hdShift 0 get degreeShift 0 get]] opt join
                   1192:     ] /arg1 set
1.14      takayama 1193:   ] pop
                   1194:   popVariables
                   1195:   arg1
                   1196: } def
                   1197: [(ecart.gen_input)
1.18      takayama 1198: [$[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]] ]  ecart.gen_input $
                   1199:  $               [gg_h v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]] $
1.14      takayama 1200:  (It generates the input for the minimal filtered free resolution.)
                   1201:  (Current ring is changed to the ring of gg_h.)
                   1202:  (cf. ecart.minimalBase)
                   1203:   $Example: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $
                   1204:   $           [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $
1.15      takayama 1205:   $          [(degreeShift) [ [0] ] $
                   1206:   $           (startingShift) [ [0] [0] ]] ] ecart.gen_input /gg set gg pmat $
1.14      takayama 1207: ]] putUsages
                   1208:
                   1209:
1.13      takayama 1210: [(ecart.minimalBase)
1.18      takayama 1211: [$[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]]  ecart.minimalBase $
1.14      takayama 1212:  (  [mbase gr_of_mbase )
1.18      takayama 1213:  $     [syz v ecart.weight_vector [(degreeShift) new_uv_shift_m (startingShift) [new_D_shift_n new_uv_shift_m]]]$
1.14      takayama 1214:  (     gr_of_syz ])
                   1215:  (mbase is the minimal generators of ff in D^h in the sense of filtered minimal)
                   1216:  (generators.)
                   1217:   $Example: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $
                   1218:   $           [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $
1.15      takayama 1219:   $           [(degreeShift) [ [0] ] $
                   1220:   $            (startingShift) [ [0] [0] ] ] ] ecart.gen_input /gg0 set $
1.14      takayama 1221:   $         gg0 ecart.minimalBase /ss0 set $
                   1222:   $         ss0 2 get ecart.minimalBase /ss1 set $
                   1223:   $         ss1 2 get ecart.minimalBase /ss2 set $
                   1224:   $     (---------  minimal filtered resolution -------) message $
                   1225:   $     ss0 0 get pmat ss1 0 get pmat ss2 0 get pmat  $
                   1226:   $     (---------  degree shift (n,m) n:D-shift m:uv-shift  -------) message $
1.15      takayama 1227:   $     gg0       3 get 3 get message $
                   1228:   $     ss0 2 get 3 get 3 get message $
                   1229:   $     ss1 2 get 3 get 3 get message $
                   1230:   $     ss2 2 get 3 get 3 get message ; $
1.14      takayama 1231:
1.13      takayama 1232: ]] putUsages
                   1233: /ecart.minimalBase {
                   1234:   /arg1 set
                   1235:   [/in-ecart.minimalBase /ai1 /ai  /aa /typev /setarg /f /v
                   1236:    /gg /wv /vec /ans /rr /mm
                   1237:    /degreeShift  /env2 /opt /ss0
                   1238:    /hdShift
                   1239:     /degreeShiftD /degreeShiftUV
                   1240:     /degreeShiftDnew /degreeShiftUVnew
                   1241:     /tt
                   1242:     /ai1_gr  /ai_gr
                   1243:     /s /r /p /q /i /j /k
                   1244:      /ai1_new /ai_new /ai_new2
                   1245:    ] pushVariables
                   1246:   [
                   1247:     /aa arg1 def
                   1248:     aa isArray { } { ( << array >> ecart.minimalBase) error } ifelse
                   1249:     /setarg 0 def
                   1250:     /wv 0 def
                   1251:     /degreeShift 0 def
                   1252:     /hdShift 0 def
1.15      takayama 1253:     /opt [ ] def
1.13      takayama 1254:     aa { tag } map /typev set
1.15      takayama 1255:     typev [ArrayP StringP ArrayP ArrayP] eq
1.13      takayama 1256:     {  /f aa 0 get def
                   1257:        /v aa 1 get def
                   1258:        /wv aa 2 get def
1.15      takayama 1259:        opt aa 3 get ecart.setOpt join /opt set
1.13      takayama 1260:        /setarg 1 def
                   1261:     } { } ifelse
1.15      takayama 1262:     typev [ArrayP ArrayP ArrayP ArrayP] eq
1.13      takayama 1263:     {  /f aa 0 get def
                   1264:        /v aa 1 get from_records def
                   1265:        /wv aa 2 get def
1.15      takayama 1266:        opt aa 3 get ecart.setOpt join /opt set
1.13      takayama 1267:        /setarg 1 def
                   1268:     } { } ifelse
                   1269:     setarg { } { (ecart.minimalBase : Argument mismatch) error } ifelse
                   1270:
                   1271:     [(KanGBmessage) ecart.gb.verbose ] system_variable
                   1272:
                   1273:     f 0 get tag ArrayP eq {  }
                   1274:     {  f { /tt set [ tt ] } map /f set } ifelse
1.15      takayama 1275:     [f v wv [(degreeShift) degreeShift (noAutoHomogenize) 1] opt join] ecart.syz /ss0 set
1.13      takayama 1276:
                   1277:     ss0 getRing ring_def
                   1278:     /degreeShiftD  hdShift 0 get def
                   1279:     /degreeShiftUV hdShift 1 get def
                   1280: %      -- ai --> D^r -- ai1 --> D^rr
                   1281:     /ai1  f  { { . } map } map def
                   1282:     /ai  ss0 0 get def
                   1283:
                   1284:    {
                   1285:     /degreeShiftUVnew
                   1286:        ai1 { [ << wv 0 get weightv >> degreeShiftUV ] ord_ws_all  } map
                   1287:     def
                   1288:     (degreeShiftUVnew=) messagen degreeShiftUVnew message
                   1289:
                   1290:     /degreeShiftDnew
                   1291:        ai1 { [ << v ecart.minimalBase.D1 weightv >> degreeShiftD ]  ord_ws_all}
                   1292:             map
                   1293:     def
                   1294:     (degreeShiftDnew=) messagen degreeShiftDnew message
                   1295:
                   1296:     ai {[wv 0 get weightv  degreeShiftUVnew] init} map /ai_gr set
                   1297:
                   1298: %C  Note 2003.8.26
                   1299:
1.14      takayama 1300:     ai [ ] eq {
                   1301:       exit
                   1302:     } {  } ifelse
                   1303:
1.13      takayama 1304:     /s ai length def
                   1305:     /r ai 0 get length def
                   1306:
                   1307:     /itIsMinimal 1 def
                   1308:     0 1 s 1 sub {
                   1309:       /i set
                   1310:       0 1 r 1 sub {
                   1311:         /j set
                   1312:
                   1313:         [(isConstantAll) ai_gr i get j get] gbext
                   1314:         ai_gr i get j get (0). eq not and
                   1315:         {
                   1316:            /itIsMinimal 0 def
                   1317:            /p i def /q j def
                   1318:         } {  } ifelse
                   1319:       } for
                   1320:     } for
                   1321:
                   1322:
                   1323:     itIsMinimal { exit } { } ifelse
                   1324:
                   1325: %    construct new ai and ai1 (A_i and A_{i-1})
                   1326:      /ai1_new  r 1 sub newVector def
                   1327:      /j 0 def
                   1328:      0 1 r 1 sub {
                   1329:        /i set
                   1330:        i q eq not {
                   1331:           ai1_new j ai1 i get put
                   1332:           /j  j 1 add def
                   1333:        } { } ifelse
                   1334:      } for
                   1335:
                   1336:      /ai_new [s  r] newMatrix def
                   1337:      0 1 s 1 sub {
                   1338:        /j set
                   1339:        0 1 r 1 sub {
                   1340:          /k set
                   1341:          ai_new [j k]
                   1342:             << ai p get q get >> << ai j get k get >> mul
                   1343:             << ai j get q get >> << ai p get k get >> mul
                   1344:             sub
                   1345:          put
                   1346:        } for
                   1347:      } for
                   1348:
                   1349: % remove 0 column
                   1350:      /ai_new2 [s 1 sub r 1 sub] newMatrix def
                   1351:      /j 0 def
                   1352:      0 1 s 1 sub {
                   1353:        /i set
                   1354:        i p eq not {
                   1355:           ai_new2 j << ai_new i get q ecart.removeElem >> put
                   1356:           /j  j 1 add def
                   1357:        } { } ifelse
                   1358:      } for
                   1359:
                   1360: %   ( ) error
1.14      takayama 1361:      /ai1 ai1_new  def
                   1362:      /ai ai_new2  ecart.removeZeroRow def
1.13      takayama 1363:
                   1364:    } loop
1.14      takayama 1365:    /arg1
                   1366:      [  ai1
                   1367:         ai1 {[wv 0 get weightv  degreeShift 0 get] init} map %Getting gr of A_{i-1}
1.15      takayama 1368:         [ai v wv [(degreeShift) [degreeShiftUVnew] (startingShift) [degreeShiftDnew degreeShiftUVnew]]]
1.14      takayama 1369:         ai {[wv 0 get weightv  degreeShiftUVnew] init} map %Getting gr of A_i
                   1370:      ]
                   1371:    def
1.13      takayama 1372:   ] pop
                   1373:   popVariables
                   1374:   arg1
                   1375: } def
                   1376:
1.15      takayama 1377: /ecart.minimalResol {
                   1378:   /arg1 set
                   1379:   [/in-ecart.minimalResol /aa /ans /gg0 /ansds /ans_gr /c] pushVariables
                   1380:   [
                   1381:      /aa arg1 def
                   1382:      /ans [ ] def
                   1383:      /ansds [ ] def
                   1384:      /ans_gr [ ] def
                   1385:      /c 0 def
                   1386:
                   1387:     (---- ecart.gen_input ----) message
                   1388:      aa ecart.gen_input /gg0 set
                   1389:      ansds gg0 3 get 3 get append /ansds set
                   1390:      (---- ecart.minimalBase --- Degree ) messagen c message c 1 add /c set
                   1391:      gg0 ecart.minimalBase /ssi set
                   1392:      ansds ssi 2 get 3 get 3 get append /ansds set
                   1393:      ans ssi 0 get  append /ans set
                   1394:      ans_gr ssi 1 get append /ans_gr set
                   1395:      {
                   1396:        ssi 3 get [ ] eq { exit } { } ifelse
                   1397:        (---- ecart.minimalBase --- Degree ) messagen c message c 1 add /c set
                   1398:        ssi 2 get ecart.minimalBase /ssi_new set
                   1399:        ans ssi_new 0 get append /ans set
                   1400:        ansds ssi_new 2 get 3 get 3 get append /ansds set
                   1401:        ans_gr ssi_new 1 get append /ans_gr set
                   1402:        /ssi ssi_new def
                   1403:      } loop
                   1404:      /arg1 [ans ansds ans_gr] def
                   1405:   ] pop
                   1406:   popVariables
                   1407:   arg1
                   1408: } def
                   1409:
                   1410: (ecart.minimalResol) message
                   1411:
                   1412: [(ecart.minimalResol)
                   1413: [
                   1414:
1.18      takayama 1415:  $[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]]  ecart.minimalResol $
1.15      takayama 1416:  (  [resol degree_shifts gr_of_resol_by_uv_shift_m] )
                   1417:   $Example1: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $
                   1418:   $           [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $
                   1419:   $           [(degreeShift) [ [0] ] $
                   1420:   $            (startingShift) [ [0] [0] ] ] ] ecart.minimalResol /gg set gg pmat $
                   1421: ]] putUsages
1.18      takayama 1422:
                   1423: %% for ecart.weight_vector
                   1424: /ecart.eliminationOrderTemplate  { %% esize >= 1
                   1425: %% if esize == 0, it returns reverse lexicographic order.
                   1426: %%  m esize eliminationOrderTemplate mat
                   1427:   /arg2 set /arg1 set
                   1428:   [/m  /esize /m1 /m2 /k /om /omtmp] pushVariables
                   1429:   [
                   1430:     /m arg1 def  /esize arg2 def
                   1431:     /m1 m esize sub 1 sub def
                   1432:     /m2 esize 1 sub def
                   1433:      [esize 0 gt
                   1434:       {
                   1435:        [1 1 esize
                   1436:         { pop 1 } for
                   1437:         esize 1 << m 1 sub >>
                   1438:         { pop 0 } for
                   1439:        ]  %% 1st vector
                   1440:       }
                   1441:       { } ifelse
                   1442:
                   1443:       m esize gt
                   1444:       {
                   1445:        [1 1  esize
                   1446:         { pop 0 } for
                   1447:         esize 1 << m 1 sub >>
                   1448:         { pop 1 } for
                   1449:        ]  %% 2nd vector
                   1450:       }
                   1451:       { } ifelse
                   1452:
                   1453:       m1 0 gt
                   1454:       {
                   1455:          m 1 sub -1 << m m1 sub >>
                   1456:          {
                   1457:               /k set
                   1458:               m  k  evec_neg
                   1459:          } for
                   1460:       }
                   1461:       { } ifelse
                   1462:
                   1463:       m2 0 gt
                   1464:       {
                   1465:          << esize 1 sub >> -1 1
                   1466:          {
                   1467:               /k set
                   1468:               m  k  evec_neg
                   1469:          } for
                   1470:       }
                   1471:       { } ifelse
                   1472:
                   1473:     ] /om set
                   1474:      om [ 0 << m 2 idiv >> 1 sub] 0 put
                   1475:      om [ << m 2 idiv >> 1 add  << m 2 idiv >> 1 sub] 0 put
                   1476:     /arg1 om def
                   1477:    ] pop
                   1478:    popVariables
                   1479:    arg1
                   1480: } def
                   1481:
                   1482: %note  2003.09.29
                   1483: /ecart.elimination_order {
                   1484: %% [x-list d-list params]  (x,y,z) elimination_order
                   1485: %%  vars                    evars
                   1486: %% [x-list d-list params order]
                   1487:   /arg2 set  /arg1 set
                   1488:   [/vars /evars /univ /order /perm /univ0 /compl /m /omtmp] pushVariables
                   1489:   /vars arg1 def /evars [arg2 to_records pop] def
                   1490:   [
                   1491:     /univ vars 0 get reverse
                   1492:           vars 1 get reverse join
                   1493:     def
                   1494:
                   1495:     << univ length 2 sub >>
                   1496:     << evars length >>
                   1497:     ecart.eliminationOrderTemplate /order set
                   1498:
                   1499:     [[1]] order oplus [[1]] oplus /order set
                   1500:
                   1501:     /m order length 2 sub def
                   1502:     /omtmp [1 1 m 2 add { pop 0 } for ] def
                   1503:     omtmp << m 2 idiv >> 1 put
                   1504:     order  omtmp append /order set
                   1505:     % order pmat
                   1506:
                   1507:     /univ0 [univ reverse aload pop pop] reverse def %% [e,x,y,h] --> [x,y,h]
                   1508:
                   1509:     /compl
                   1510:       [univ 0 get] evars join evars univ0 complement join
                   1511:     def
                   1512:     compl univ
                   1513:     getPerm /perm set
                   1514:     %%perm :: univ :: compl ::
                   1515:
                   1516:     order perm permuteOrderMatrix /order set
                   1517:
                   1518:
                   1519:     vars [order] join /arg1 set
                   1520:   ] pop
                   1521:   popVariables
                   1522:   arg1
                   1523: } def
                   1524:
                   1525: /ecart.define_ring {
                   1526:    /arg1 set
                   1527:    [/rp /param /foo] pushVariables
                   1528:    [/rp arg1 def
                   1529:
                   1530:      rp 0 get length 3 eq {
                   1531:        rp 0  [rp 0 get 0 get rp 0 get 1 get rp 0 get 2 get ]
                   1532:              ( ) ecart.elimination_order put
                   1533:      } { } ifelse
                   1534:
                   1535:     [
                   1536:       rp 0 get 0 get             %% x-list
                   1537:       rp 0 get 1 get             %% d-list
                   1538:       rp 0 get 2 get /param set
                   1539:       param 0 << rp 1 get >> put %% << rp 1 get >> is 17 in the example.
                   1540:       param                      %% parameters.
                   1541:       rp 0 get 3 get             %% order matrix.
                   1542:       rp length 2 eq
                   1543:       { [  ] }                   %% null optional argument.
                   1544:       { rp 2 get }
                   1545:       ifelse
                   1546:     ]  /foo set
                   1547:     foo aload pop set_up_ring@
                   1548:    ] pop
                   1549:    popVariables
                   1550:    [(CurrentRingp)] system_variable
                   1551: } def
                   1552: /ecart.weight_vector {
                   1553:   /arg2 set  /arg1 set
                   1554:   [/vars /univ /w-vectors /www /k /order1 /order2] pushVariables
                   1555:   /vars arg1 def /w-vectors arg2 def
                   1556:   [
                   1557:     /univ vars 0 get reverse
                   1558:           vars 1 get reverse join
                   1559:     def
1.32      takayama 1560:     w-vectors to_int32 /w-vectors set
1.18      takayama 1561:     [
                   1562:     0 1 << w-vectors length 1 sub >>
                   1563:     {
                   1564:       /k set
                   1565:       univ w-vectors k get w_to_vec
                   1566:     } for
                   1567:     ] /order1 set
                   1568:     %% order1 ::
                   1569:
                   1570:     vars ( ) ecart.elimination_order 3 get /order2 set
                   1571:     vars [ << order1 order2 join >> ] join /arg1 set
                   1572:   ] pop
                   1573:   popVariables
                   1574:   arg1
                   1575: } def
                   1576:
                   1577: %% end of for ecart.define_ring
1.19      takayama 1578:
                   1579: /ecartd.reduction {
                   1580:   /arg2 set
                   1581:   /arg1 set
                   1582:   [/in-ecartd.reduction /gbasis /flist /ans /gbasis2] pushVariables
                   1583:   [(CurrentRingp) (KanGBmessage)] pushEnv
                   1584:   [
                   1585:      /gbasis arg2  def
                   1586:      /flist  arg1  def
                   1587:      gbasis 0 get tag 6 eq { }
                   1588:      { (ecartd.reduction: the second argument must be a list of lists) error }
                   1589:      ifelse
                   1590:
                   1591:      gbasis length 1 eq {
                   1592:        gbasis getRing ring_def
                   1593:        /gbasis2 gbasis 0 get def
                   1594:      } {
                   1595:        [ [(1)] ] gbasis rest join ecartd.gb 0 get getRing ring_def
1.33      takayama 1596:        /gbasis2 gbasis 0 get ___ def
1.19      takayama 1597:      } ifelse
                   1598:      ecartd.begin
                   1599:
1.33      takayama 1600:      flist ___ /flist set
1.19      takayama 1601:      flist tag 6 eq {
                   1602:        flist { gbasis2 reduction } map /ans set
                   1603:      }{
                   1604:        flist gbasis2 reduction /ans set
                   1605:      } ifelse
                   1606:      /arg1 ans def
                   1607:
                   1608:      ecartd.end
                   1609:   ] pop
                   1610:   popEnv
                   1611:   popVariables
                   1612:   arg1
                   1613: } def
                   1614:
                   1615: /ecartd.reduction.test {
                   1616:   [
                   1617:     [( 2*(1-x-y) Dx + 1 ) ( 2*(1-x-y) Dy + 1 )]
                   1618:     (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]]
                   1619:   ecartd.gb /gg set
                   1620:
                   1621:   (Dx) [gg 0 get] ecartd.reduction /gg2 set
                   1622:   gg2 message
                   1623:   (-----------------------------) message
                   1624:
                   1625:   [(Dx) (Dy) (Dx+x*Dy)] [gg 0 get] ecartd.reduction /gg3 set
                   1626:   gg3 message
                   1627:
                   1628:   (-----------------------------) message
                   1629:     [[( 2*(1-x-y) Dx + h ) ( 2*(1-x-y) Dy + h )]
                   1630:       (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set
                   1631:    (Dx) ggg ecartd.reduction /gg4 set
                   1632:    gg4 message
1.28      takayama 1633:
                   1634:   (----------- reduction by h=1 ---------------) message
                   1635:     [[( 2*(1-x-y) Dx + 1 ) ( 2*(1-x-y) Dy + 1 )]
                   1636:       (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set
                   1637:    [(Homogenize) 0]  system_variable
                   1638:    (Dx) ggg ecartd.reduction /gg5 set
                   1639:    [(Homogenize) 1]  system_variable
                   1640:    gg5 message
                   1641:
                   1642:   [gg2  gg3 gg4 gg5]
1.19      takayama 1643: } def
                   1644:
                   1645: /ecarth.reduction {
                   1646:   /arg2 set
                   1647:   /arg1 set
                   1648:   [/in-ecarth.reduction /gbasis /flist /ans /gbasis2] pushVariables
                   1649:   [(CurrentRingp) (KanGBmessage)] pushEnv
                   1650:   [
                   1651:      /gbasis arg2  def
                   1652:      /flist  arg1  def
                   1653:      gbasis 0 get tag 6 eq { }
                   1654:      { (ecarth.reduction: the second argument must be a list of lists) error }
                   1655:      ifelse
                   1656:
                   1657:      gbasis length 1 eq {
                   1658:        gbasis getRing ring_def
                   1659:        /gbasis2 gbasis 0 get def
                   1660:      } {
                   1661:        [ [(1)] ] gbasis rest join ecarth.gb 0 get getRing ring_def
1.33      takayama 1662:        /gbasis2 gbasis 0 get ___ def
1.19      takayama 1663:      } ifelse
                   1664:      ecarth.begin
                   1665:
1.33      takayama 1666:      flist ___ /flist set
1.19      takayama 1667:      flist tag 6 eq {
                   1668:        flist { gbasis2 reduction } map /ans set
                   1669:      }{
                   1670:        flist gbasis2 reduction /ans set
                   1671:      } ifelse
                   1672:      /arg1 ans def
                   1673:
                   1674:      ecarth.end
                   1675:   ] pop
                   1676:   popEnv
                   1677:   popVariables
                   1678:   arg1
                   1679: } def
                   1680:
                   1681: [(ecartd.reduction)
                   1682: [ (f basis ecartd.reduction r)
                   1683:   (f is reduced by basis by the tangent cone algorithm.)
1.20      takayama 1684:   (The first element of basis <g_1,...,g_m> must be a standard basis.)
1.19      takayama 1685:   (r is the return value format of reduction.)
1.20      takayama 1686:   (r=[h,c0,syz,input], h = c0 f + \sum syz_i g_i)
                   1687:   (basis is given in the argument format of ecartd.gb.)
1.21      takayama 1688:   $h[0,1](D)-homogenization is used.$
1.19      takayama 1689:   (cf. reduction, ecartd.gb, ecartd.reduction.test )
                   1690:   $Example:$
                   1691:   $ [[( 2*(1-x-y) Dx + h ) ( 2*(1-x-y) Dy + h )] $
                   1692:   $   (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set $
                   1693:   $ (Dx+Dy) ggg ecartd.reduction :: $
1.29      takayama 1694: ]] putUsages
                   1695:
                   1696: /ecartd.reduction_noh {
                   1697:   /arg2 set
                   1698:   /arg1 set
                   1699:   [/in-ecarth.reduction_noh /gbasis /flist] pushVariables
                   1700:   [(Homogenize)] pushEnv
                   1701:   [
                   1702:      /gbasis arg2  def
                   1703:      /flist  arg1  def
                   1704:      [(Homogenize) 0] system_variable
                   1705:      flist gbasis ecartd.reduction /arg1 set
                   1706:   ] pop
                   1707:   popEnv
                   1708:   popVariables
                   1709:   arg1
                   1710: } def
                   1711:
                   1712: [(ecartd.reduction_noh)
                   1713: [ (f basis ecartd.reduction_noh r)
                   1714:   (f is reduced by basis by the tangent cone algorithm.)
                   1715:   (The first element of basis <g_1,...,g_m> must be a standard basis.)
                   1716:   (r is the return value format of reduction.)
                   1717:   (r=[h,c0,syz,input], h = c0 f + \sum syz_i g_i)
                   1718:   (basis is given in the argument format of ecartd.gb and)
                   1719:   (it should not contain the variable h.  cf. dehomogenize)
                   1720:   $h[0,1](D)-homogenization is NOT used.$
                   1721:   (cf. reduction, ecartd.gb, ecartd.reduction )
                   1722:   $Example:$
                   1723:   $ [[( 2*(1-x-y) Dx + 1 ) ( 2*(1-x-y) Dy + 1 )] $
                   1724:   $   (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set $
                   1725:   $ (Dx+Dy) ggg ecartd.reduction_noh :: $
1.19      takayama 1726: ]] putUsages
1.22      takayama 1727:
                   1728: /ecart.stdOrder {
                   1729:   /arg1 set
                   1730:   [/in-ecart.stdOrder /vv /tt /dvv /wv1 /wv2
                   1731:   ] pushVariables
                   1732:   [
                   1733:      /vv arg1 def
                   1734:      vv isString { [ vv to_records pop] /vv set }
                   1735:      { } ifelse
                   1736:      vv { toString} map /vv set
                   1737:
                   1738:      vv { /tt set [@@@.Dsymbol tt] cat } map /dvv set
                   1739:      dvv { 1 } map /wv1 set
                   1740:      vv { -1 } map dvv { 1 } map join /wv2 set
                   1741:      /arg1 [wv1 wv2 ] def
1.23      takayama 1742:   ] pop
                   1743:   popVariables
1.22      takayama 1744:   arg1
                   1745: } def
                   1746:
                   1747: /ecartd.isSameIdeal_h {
                   1748:   /arg1 set
                   1749:   [/in-ecartd.isSameIdeal_h /aa /ii /jj /iigg /jjgg /vv /ans /k /n /f
                   1750:    /ecartd.isSameIdeal_h.opt
                   1751:    /save-ecart.autoHomogenize  /wv /save-ecart.message.quiet
                   1752:    ] pushVariables
                   1753:   [(CurrentRingp) (Homogenize_vec)] pushEnv
                   1754:   [
                   1755:     /aa arg1 def
                   1756:     gb.verbose { (Getting in ecartd.isSameIdeal_h) message } { } ifelse
                   1757:     %% comparison of hilbert series has not yet been implemented.
                   1758:     /save-ecart.message.quiet ecart.message.quiet def
                   1759:     aa length 3 eq {    }
                   1760:     { ([ii jj vv] ecartd.isSameIdeal_h) error } ifelse
                   1761:     /ii aa 0 get def
                   1762:     /jj aa 1 get def
                   1763:     /vv aa 2 get def
                   1764:     ii length 0 eq jj length 0 eq and
                   1765:     { /ans 1 def /LLL.ecartd.isSame_h goto } {  } ifelse
                   1766:
                   1767:     vv ecart.stdOrder /wv set
                   1768:
                   1769:     /save-ecart.autoHomogenize ecart.autoHomogenize def
                   1770:     /ecart.autoHomogenize 0 def
                   1771:     [ii vv wv] ecartd.gb  /iigg set
                   1772:     [jj vv wv] ecartd.gb  /jjgg set
                   1773:     save-ecart.autoHomogenize /ecart.autoHomogenize set
                   1774:
                   1775:     iigg getRing ring_def
                   1776:
                   1777:     getOptions /ecartd.isSameIdeal_h.opt set
                   1778:
                   1779:     /ans 1 def
                   1780:     iigg 0 get /iigg set
                   1781:     jjgg 0 get /jjgg set
                   1782:     %%Bug: not implemented for the case of module.
                   1783:
                   1784:     /save-ecart.message.quiet ecart.message.quiet def
                   1785:     /ecart.message.quiet 1 def
                   1786:     gb.verbose { (Comparing) message iigg message (and) message jjgg message }
                   1787:     {  } ifelse
                   1788:     gb.verbose { ( ii < jj ?) messagen } {  } ifelse
                   1789:     iigg length /n set
                   1790:     0 1 n 1 sub {
                   1791:       /k set
                   1792:       iigg  k get
                   1793:       [jjgg vv wv] ecartd.reduction 0 get
                   1794:       (0). eq not { /ans 0 def /LLL.ecartd.isSame_h goto} {  } ifelse
                   1795:       gb.verbose { (o) messagen } {  } ifelse
                   1796:     } for
                   1797:     gb.verbose { ( jj < ii ?) messagen } {  } ifelse
                   1798:     jjgg length /n set
                   1799:     0 1 n 1 sub {
                   1800:       /k set
                   1801:       jjgg k get
                   1802:       [iigg vv wv] ecartd.reduction 0 get
                   1803:       (0). eq not { /ans 0 def /LLL.ecartd.isSame_h goto} {  } ifelse
                   1804:       gb.verbose { (o) messagen } {  } ifelse
                   1805:     } for
                   1806:     /LLL.ecartd.isSame_h
                   1807:     gb.verbose { ( Done) message } {  } ifelse
                   1808:     save-ecart.message.quiet /ecart.message.quiet set
                   1809:     ecartd.isSameIdeal_h.opt restoreOptions
                   1810:     /arg1 ans def
                   1811:   ] pop
                   1812:   popEnv
                   1813:   popVariables
                   1814:   arg1
                   1815: } def
                   1816: (ecartd.isSameIdeal_h ) messagen-quiet
                   1817:
                   1818: [(ecartd.isSameIdeal_h)
                   1819: [([ii jj vv] ecartd.isSameIdeal_h bool)
                   1820:  (ii, jj : ideal, vv : variables)
                   1821:  $The ideals ii and jj will be compared in the ring h[0,1](D).$
                   1822:  $ii and jj are re-parsed.$
                   1823:  $Example 1: [ [((1-x) Dx + h)]  [((1-x)^2 Dx + h (1-x))] (x)] ecartd.isSameIdeal_h $
1.23      takayama 1824: ]] putUsages
                   1825:
                   1826: /ecart.01Order {
                   1827:   /arg1 set
                   1828:   [/in-ecart.01Order /vv /tt /dvv /wv1 /wv2
                   1829:   ] pushVariables
                   1830:   [
                   1831:      /vv arg1 def
                   1832:      vv isString { [ vv to_records pop] /vv set }
                   1833:      { } ifelse
                   1834:      vv { toString} map /vv set
                   1835:
                   1836:      vv { /tt set [@@@.Dsymbol tt] cat } map /dvv set
                   1837:      dvv { 1 } map /wv1 set
                   1838:      /arg1 [wv1] def
                   1839:   ] pop
                   1840:   popVariables
                   1841:   arg1
                   1842: } def
                   1843: /ecart.homogenize01Ideal {
                   1844:  /arg1 set
1.26      takayama 1845:  [/in.ecart.homogenize01Ideal /ll /vv /wv /ans] pushVariables
1.23      takayama 1846:  [
                   1847:    /ll arg1 0 get def
                   1848:    /vv arg1 1 get def
                   1849:    vv isArray { vv from_records /vv set } {  } ifelse
                   1850:    vv ecart.01Order /wv set
                   1851:    [vv ring_of_differential_operators 0] define_ring
1.33      takayama 1852:    ll ___ /ll set ll dehomogenize /ll set
1.23      takayama 1853:    [ll vv wv] gb 0 get /ll set
                   1854:
                   1855:    ecart.begin
                   1856:    [vv ring_of_differential_operators
                   1857:     vv ecart.stdOrder weight_vector 0
                   1858:     [(weightedHomogenization) 1]] define_ring
1.33      takayama 1859:    ll ___ {ecart.homogenize01 ecart.dehomogenizeH} map /ans set
1.26      takayama 1860:    ecart.end
                   1861:    /arg1 ans def
1.23      takayama 1862:  ] pop
                   1863:  popVariables
                   1864:  arg1
                   1865: } def
                   1866: [(ecart.homogenize01Ideal)
                   1867: [([ii vv] ecartd.homogenize01Ideal)
                   1868:  (ii : ideal, vv : variables)
                   1869:  $The ideal ii is homogenized in h[0,1](D).$
                   1870:  $Example 1: [ [((1-x) Dx + 1)] (x)] ecart.homogenize01Ideal $
1.22      takayama 1871: ]] putUsages
                   1872:
1.18      takayama 1873:
1.5       takayama 1874:
1.2       takayama 1875: ( ) message-quiet
1.5       takayama 1876:
1.30      takayama 1877: /ecart_loaded 1 def

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>