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

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

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