[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.23

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

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