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

Annotation of OpenXM/src/kan96xx/Doc/hol.sm1, Revision 1.9

1.9     ! takayama    1: % $OpenXM: OpenXM/src/kan96xx/Doc/hol.sm1,v 1.8 2000/08/01 05:53:18 takayama Exp $
1.5       takayama    2: %% hol.sm1, 1998, 11/8, 11/10, 11/14, 11/25, 1999, 5/18, 6/5. 2000, 6/8
1.1       maekawa     3: %% rank, rrank, characteristic
                      4: %% This file is error clean.
                      5: /hol.version (2.990515) def
                      6: hol.version [(Version)] system_variable gt
                      7: { [(This package hol.sm1 requires the latest version of kan/sm1) nl
                      8:    (Please get it from http://www.math.kobe-u.ac.jp/KAN)
                      9:   ] cat
                     10:   error
                     11: } { } ifelse
                     12:
1.5       takayama   13: $hol.sm1, basic package for holonomic systems (C) N.Takayama, 2000, 06/08 $
1.1       maekawa    14: message-quiet
                     15:
1.7       takayama   16: /gb.warning 0 def
1.1       maekawa    17: /rank.v [(x) (y) (z)] def   %% default value of v (variables).
                     18: /rank.ch [ ] def  %% characteristic variety.
                     19: /rank.verbose 0 def
                     20: /rank {
                     21:   /arg1 set
                     22:   [/in-rank /aa /typev /setarg /f /v /vsss /vddd
                     23:    /gg /wv /vd /vdweight /chv
                     24:    /one
                     25:   ] pushVariables
                     26:   [(CurrentRingp) (KanGBmessage)] pushEnv
                     27:   [
                     28:
                     29:     /aa arg1 def
                     30:     aa isArray { } { ( << array >> rank) error } ifelse
                     31:     /setarg 0 def
                     32:     aa { tag } map /typev set
                     33:     typev [ ArrayP ] eq
                     34:     {  /f aa 0 get def
                     35:        /v rank.v def
                     36:        /setarg 1 def
                     37:     } { } ifelse
                     38:     typev [ArrayP StringP] eq
                     39:     {  /f aa 0 get def
                     40:        /v [ aa 1 get to_records pop ] def
                     41:        /setarg 1 def
                     42:     } { } ifelse
                     43:     typev [ArrayP ArrayP] eq
                     44:     {  /f aa 0 get def
                     45:        /v aa 1 get def
                     46:        /setarg 1 def
                     47:     } { } ifelse
                     48:     setarg { } { (rank : Argument mismatch) error } ifelse
                     49:
                     50:     [(KanGBmessage) rank.verbose ] system_variable
                     51:
                     52:     f { toString } map /f set
                     53:     v { @@@.Dsymbol 2 1 roll 2 cat_n 1 } map
                     54:     /vddd set   %% vddd = [(Dx) 1 (Dy) 1 (Dz) 1]
                     55:     v { @@@.Dsymbol 2 1 roll 2 cat_n } map
                     56:     /vd set     %% vd = [(Dx) (Dy) (Dz)]
                     57:     /vdweight
                     58:        vd { [ 2 1 roll -1 ] } map  %% vdweight=[[(Dx) -1] [(Dy) -1] [(Dz) -1]]
                     59:     def
                     60:
                     61:     [v from_records
                     62:      ring_of_differential_operators [vddd] weight_vector 0] define_ring
                     63:     f { . dehomogenize } map /f set
                     64:     [f] groebner_sugar 0 get /gg set
                     65:
                     66:     /wv vddd weightv def
                     67:     gg { wv init } map /chv set  %%obtained the characteristic variety.
                     68:     /rank.ch chv def
                     69:     chv { toString } map /chv set
                     70:
                     71:     [ v vd join from_records
                     72:       ring_of_polynomials
                     73:       [vddd]  vdweight join weight_vector
                     74:       0
                     75:     ] define_ring
                     76:     [chv {.} map] groebner_sugar 0 get { init } map /chii set
                     77:
                     78:     /rank.chii chii def
                     79:     rank.verbose { chii message } {  } ifelse
                     80:     v {[ 2 1 roll . (1).]} map /one set
                     81:     %% [[(x). (1).] [(y). (1).] [(z). (1).]]
                     82:     %% chii { one replace } map  %% buggy code.
                     83:     %% Arg of hilb should be a reduced GB.
                     84:     [chii { one replace } map] groebner 0 get
                     85:     vd hilb /arg1 set
                     86:   ] pop
                     87:   popEnv
                     88:   popVariables
                     89:   arg1
                     90: } def
                     91:
                     92:
                     93: [(rank)
                     94:  [( a rank b)
                     95:   ( array a;  number b)
                     96:   (Example 1 : )
                     97:   $ [ [( (x Dx)^2 + ( y Dy)^2) ( x Dx y Dy -1)] (x,y)] rank :: $
                     98:   (Example 2 : )
                     99:   $[ [( (x^3-y^2) Dx + 3 x^2) ( (x^3-y^2) Dy - 2 y)] (x,y)] rank :: $
                    100:  ]
                    101: ] putUsages
                    102: (rank ) messagen-quiet
                    103:
                    104: /characteristic.verbose 0 def
                    105: /characteristic.v [(x) (y) (z)] def
                    106: /characteristic.ch [ ] def
                    107: /ch { characteristic } def
                    108: /characteristic {
                    109:   /arg1 set
                    110:   [/in-rank /aa /typev /setarg /f /v /vsss /vddd
                    111:    /gg /wv /vd  /chv
                    112:    /one
                    113:   ] pushVariables
                    114:   [(CurrentRingp) (KanGBmessage)] pushEnv
                    115:   [
                    116:
                    117:     /aa arg1 def
                    118:     aa isArray { } { ( << array >> characteristic) error } ifelse
                    119:     /setarg 0 def
                    120:     aa { tag } map /typev set
                    121:     typev [ ArrayP ] eq
                    122:     {  /f aa 0 get def
                    123:        /v characteristic.v def
                    124:        /setarg 1 def
                    125:     } { } ifelse
                    126:     typev [ArrayP StringP] eq
                    127:     {  /f aa 0 get def
                    128:        /v [ aa 1 get to_records pop ] def
                    129:        /setarg 1 def
                    130:     } { } ifelse
                    131:     typev [ArrayP ArrayP] eq
                    132:     {  /f aa 0 get def
                    133:        /v aa 1 get def
                    134:        /setarg 1 def
                    135:     } { } ifelse
                    136:     setarg { } { (rank : Argument mismatch) error } ifelse
                    137:
                    138:     [(KanGBmessage) characteristic.verbose ] system_variable
                    139:
                    140:     f { toString } map /f set
                    141:     v { @@@.Dsymbol 2 1 roll 2 cat_n 1 } map
                    142:     /vddd set   %% vddd = [(Dx) 1 (Dy) 1 (Dz) 1]
                    143:     v { @@@.Dsymbol 2 1 roll 2 cat_n } map
                    144:     /vd set     %% vd = [(Dx) (Dy) (Dz)]
                    145:
                    146:     [v from_records
                    147:      ring_of_differential_operators [vddd] weight_vector 0] define_ring
                    148:     f { . dehomogenize } map /f set
                    149:     [f] groebner_sugar 0 get /gg set
                    150:
                    151:     /wv vddd weightv def
                    152:     gg { wv init } map /chv set
                    153:     /characteristic.ch [chv] def
                    154: %%    gg { wv init toString} map /chv set  %%obtained the characteristic variety.
                    155: %%    /characteristic.ch chv def
                    156:
                    157: %%    [ v vd join from_records
                    158: %%      ring_of_polynomials
                    159: %%      [vddd] weight_vector
                    160: %%      0
                    161: %%    ] define_ring
                    162: %%    [chv {.} map] groebner_sugar 0 get /characteristic.ch set
                    163:
                    164:     characteristic.ch /arg1 set
                    165:   ] pop
                    166:   popEnv
                    167:   popVariables
                    168:   arg1
                    169: } def
                    170:
                    171: [(characteristic)
                    172:  [( a characteristic b)
                    173:   ( array a;  number b)
                    174:   (b is the generator of the characteristic variety of a.)
                    175:   (For the algorithm, see Japan J. of Industrial and Applied Math., 1994, 485--497.)
                    176:   (Example 1 : )
                    177:   $ [ [( (x Dx)^2 + ( y Dy)^2) ( x Dx y Dy -1)] (x,y)] characteristic :: $
                    178:   (Example 2 : )
                    179:   $[ [( (x^3-y^2) Dx + 3 x^2) ( (x^3-y^2) Dy - 2 y)] (x,y)] characteristic :: $
                    180:  ]
                    181: ] putUsages
                    182: (characteristic ) messagen-quiet
                    183: [(ch)
                    184:  [(ch is the abbreviation of characteristic.)
                    185:   ( a ch b)
                    186:   ( array a;  number b)
                    187:   (b is the generator of the characteristic variety of a.)
                    188:   (For the algorithm, see, Japan J. of Industrial and Applied Math., 1994, 485--497.)
                    189:   (Example 1 : )
                    190:   $ [ [( (x Dx)^2 + ( y Dy)^2) ( x Dx y Dy -1)] (x,y)] ch :: $
                    191:   (Example 2 : )
                    192:   $[ [( (x^3-y^2) Dx + 3 x^2) ( (x^3-y^2) Dy - 2 y)] (x,y)] ch :: $
                    193:  ]
                    194: ] putUsages
                    195: (ch ) messagen-quiet
                    196:
                    197: %%%% developing rrank.sm1
                    198: /rrank.v [(x) (y) (z)] def   %% default value of v (variables).
                    199: /rrank.init [ ] def  %% initial ideal.
                    200: /rrank.verbose 0 def
                    201: /rrank {
                    202:   /arg1 set
                    203:   [/in-rrank /aa /typev /setarg /f /v /vsss /vddd
                    204:    /gg /wv /vd /vdweight
                    205:    /one /i /chv
                    206:   ] pushVariables
                    207:   [(CurrentRingp) (KanGBmessage)] pushEnv
                    208:   [
                    209:
                    210:     /aa arg1 def
                    211:     aa isArray { } { ( << array >> rrank) error } ifelse
                    212:     /setarg 0 def
                    213:     aa { tag } map /typev set
                    214:     typev [ ArrayP ] eq
                    215:     {  /f aa 0 get def
                    216:        /v rrank.v def
                    217:        /setarg 1 def
                    218:     } { } ifelse
                    219:     typev [ArrayP StringP] eq
                    220:     {  /f aa 0 get def
                    221:        /v [ aa 1 get to_records pop ] def
                    222:        /setarg 1 def
                    223:     } { } ifelse
                    224:     typev [ArrayP ArrayP] eq
                    225:     {  /f aa 0 get def
                    226:        /v aa 1 get def
                    227:        /setarg 1 def
                    228:     } { } ifelse
                    229:     setarg { } { (rrank : Argument mismatch) error } ifelse
                    230:
                    231:     [(KanGBmessage) rrank.verbose ] system_variable
                    232:
                    233:     f { toString } map /f set
                    234:     v { @@@.Dsymbol 2 1 roll 2 cat_n 1 } map
                    235:
                    236:     v { @@@.Dsymbol 2 1 roll 2 cat_n } map
                    237:     /vd set     %% vd = [(Dx) (Dy) (Dz)] , v = [(x) (y) (z)]
                    238:     /vdweight
                    239:       [ 0 1 v length 1 sub { /i set v i get << 0 i sub >>
                    240:                                     vd i get << i >> } for ]
                    241:     def
                    242:     rrank.verbose { vdweight message } { } ifelse
                    243:
                    244:     [v from_records
                    245:      ring_of_differential_operators [vdweight] weight_vector 0] define_ring
                    246:     f { . dehomogenize homogenize } map /f set
                    247:     [f] groebner 0 get {dehomogenize} map /gg set
                    248:
                    249:     /wv vdweight weightv def
                    250:     gg { wv init } map /rrank.init set  %%obtained the initial ideal
                    251:     rrank.init {toString} map /chv set
                    252:     /arg1 [chv v] rank def
                    253:   ] pop
                    254:   popEnv
                    255:   popVariables
                    256:   arg1
                    257: } def
                    258:
                    259:
                    260: [(rrank)
                    261:  [( a rrank b)
                    262:   ( array a;  number b)
                    263:   (It computes the holonomic rank for regular holonomic system.)
                    264:   (For the algorithm, see Grobner deformations of hypergeometric differential equations, 1999, Springer.)
                    265:   (Chapter 2.)
                    266:   (Example 1 : )
                    267:   $ [ [( (x Dx)^2 + ( y Dy)^2) ( x Dx y Dy -1)] (x,y)] rrank :: $
                    268:  ]
                    269: ] putUsages
                    270: (rrank ) messagen-quiet
                    271:
                    272: /gb.v 1 def
                    273: /gb.verbose 0 def
1.4       takayama  274: /gb.options [ ] def
1.1       maekawa   275: /gb {
                    276:   /arg1 set
                    277:   [/in-gb /aa /typev /setarg /f /v
                    278:    /gg /wv /termorder /vec /ans /rr /mm
                    279:   ] pushVariables
                    280:   [(CurrentRingp) (KanGBmessage)] pushEnv
                    281:   [
                    282:
                    283:     /aa arg1 def
                    284:     aa isArray { } { ( << array >> gb) error } ifelse
                    285:     /setarg 0 def
                    286:     /wv 0 def
                    287:     aa { tag } map /typev set
                    288:     typev [ ArrayP ] eq
                    289:     {  /f aa 0 get def
                    290:        /v gb.v def
                    291:        /setarg 1 def
                    292:     } { } ifelse
                    293:     typev [ArrayP StringP] eq
                    294:     {  /f aa 0 get def
                    295:        /v aa 1 get def
                    296:        /setarg 1 def
                    297:     } { } ifelse
                    298:     typev [ArrayP ArrayP] eq
                    299:     {  /f aa 0 get def
                    300:        /v aa 1 get from_records def
                    301:        /setarg 1 def
                    302:     } { } ifelse
                    303:     typev [ArrayP StringP ArrayP] eq
                    304:     {  /f aa 0 get def
                    305:        /v aa 1 get def
                    306:        /wv aa 2 get def
                    307:        /setarg 1 def
                    308:     } { } ifelse
                    309:     typev [ArrayP ArrayP ArrayP] eq
                    310:     {  /f aa 0 get def
                    311:        /v aa 1 get from_records def
                    312:        /wv aa 2 get def
                    313:        /setarg 1 def
                    314:     } { } ifelse
                    315:
                    316:     setarg { } { (gb : Argument mismatch) error } ifelse
                    317:
                    318:     [(KanGBmessage) gb.verbose ] system_variable
                    319:
                    320:     %%% Start of the preprocess
                    321:     f getRing /rr set
                    322:     %% To the normal form : matrix expression.
                    323:     f gb.toMatrixOfString /f set
                    324:     /mm gb.itWasMatrix def
                    325:
                    326:     rr tag 0 eq {
                    327:       %% Define our own ring
                    328:       v isInteger {
                    329:         (Error in gb: Specify variables) error
                    330:       } {  } ifelse
                    331:       wv isInteger {
                    332:         [v ring_of_differential_operators
                    333:         0] define_ring
                    334:         /termorder 1 def
                    335:       }{
                    336:         [v ring_of_differential_operators
                    337:          wv weight_vector
                    338:         0] define_ring
                    339:         wv gb.isTermOrder /termorder set
                    340:       } ifelse
                    341:     } {
                    342:       %% Use the ring structre given by the input.
                    343:       v isInteger not {
1.7       takayama  344:         gb.warning {
                    345:          (Warning : the given ring definition is not used.) message
                    346:         } { } ifelse
1.1       maekawa   347:       } {  } ifelse
                    348:       rr ring_def
                    349:       /wv rr gb.getWeight def
                    350:       wv gb.isTermOrder /termorder set
                    351:     } ifelse
                    352:     %%% Enf of the preprocess
                    353:
1.4       takayama  354:     gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
1.1       maekawa   355:     termorder {
                    356:       f { {. dehomogenize} map } map /f set
1.4       takayama  357:       [f gb.options] groebner_sugar 0 get /gg set
1.1       maekawa   358:     }{
                    359:       f { {. dehomogenize} map} map /f set
                    360:       f fromVectors { homogenize } map /f set
1.4       takayama  361:       [f gb.options] groebner 0 get /gg set
1.1       maekawa   362:     }ifelse
                    363:     wv isInteger {
                    364:       /ans [gg gg {init} map] def
                    365:     }{
                    366:       /ans [gg gg {wv 0 get weightv init} map] def
                    367:     }ifelse
                    368:
                    369:     %% Postprocess : recover the matrix expression.
                    370:     mm {
                    371:       ans { /tmp set [mm tmp] toVectors } map
                    372:       /ans set
                    373:     }{ }
                    374:     ifelse
                    375:     %%
                    376:
                    377:     /arg1 ans def
                    378:   ] pop
                    379:   popEnv
                    380:   popVariables
                    381:   arg1
                    382: } def
                    383: (gb ) messagen-quiet
                    384:
                    385: /pgb {
                    386:   /arg1 set
                    387:   [/in-pgb /aa /typev /setarg /f /v
                    388:    /gg /wv /termorder /vec /ans /rr /mm
                    389:   ] pushVariables
                    390:   [(CurrentRingp) (KanGBmessage) (UseCriterion1)] pushEnv
                    391:   [
                    392:
                    393:     /aa arg1 def
                    394:     aa isArray { } { (<< array >> pgb) error } ifelse
                    395:     /setarg 0 def
                    396:     /wv 0 def
                    397:     aa { tag } map /typev set
                    398:     typev [ ArrayP ] eq
                    399:     {  /f aa 0 get def
                    400:        /v gb.v def
                    401:        /setarg 1 def
                    402:     } { } ifelse
                    403:     typev [ArrayP StringP] eq
                    404:     {  /f aa 0 get def
                    405:        /v aa 1 get def
                    406:        /setarg 1 def
                    407:     } { } ifelse
                    408:     typev [ArrayP ArrayP] eq
                    409:     {  /f aa 0 get def
                    410:        /v aa 1 get from_records def
                    411:        /setarg 1 def
                    412:     } { } ifelse
                    413:     typev [ArrayP StringP ArrayP] eq
                    414:     {  /f aa 0 get def
                    415:        /v aa 1 get def
                    416:        /wv aa 2 get def
                    417:        /setarg 1 def
                    418:     } { } ifelse
                    419:     typev [ArrayP ArrayP ArrayP] eq
                    420:     {  /f aa 0 get def
                    421:        /v aa 1 get from_records def
                    422:        /wv aa 2 get def
                    423:        /setarg 1 def
                    424:     } { } ifelse
                    425:
                    426:     setarg { } { (pgb : Argument mismatch) error } ifelse
                    427:
                    428:     [(KanGBmessage) gb.verbose ] system_variable
                    429:
                    430:     %%% Start of the preprocess
                    431:     f getRing /rr set
                    432:     %% To the normal form : matrix expression.
                    433:     f gb.toMatrixOfString /f set
                    434:     /mm gb.itWasMatrix def
                    435:
                    436:     rr tag 0 eq {
                    437:       %% Define our own ring
                    438:       v isInteger {
                    439:         (Error in pgb: Specify variables) error
                    440:       } {  } ifelse
                    441:       wv isInteger {
                    442:         [v ring_of_polynomials
                    443:         0] define_ring
                    444:         /termorder 1 def
                    445:       }{
                    446:         [v ring_of_polynomials
                    447:          wv weight_vector
                    448:         0] define_ring
                    449:         wv gb.isTermOrder /termorder set
                    450:       } ifelse
                    451:     } {
                    452:       %% Use the ring structre given by the input.
                    453:       v isInteger not {
1.7       takayama  454:         gb.warning {
                    455:          (Warning : the given ring definition is not used.) message
                    456:         } { } ifelse
1.1       maekawa   457:       } {  } ifelse
                    458:       rr ring_def
                    459:       /wv rr gb.getWeight def
                    460:       wv gb.isTermOrder /termorder set
                    461:     } ifelse
                    462:     %%% Enf of the preprocess
                    463:
1.4       takayama  464:     gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
1.1       maekawa   465:     termorder {
                    466:       f { {. dehomogenize} map } map /f set
                    467:       [(UseCriterion1) 1] system_variable
1.4       takayama  468:       [f gb.options] groebner_sugar 0 get /gg set
1.1       maekawa   469:       [(UseCriterion1) 0] system_variable
                    470:     }{
                    471:       f { {. dehomogenize} map} map /f set
                    472:       f fromVectors { homogenize } map /f set
                    473:       [(UseCriterion1) 1] system_variable
1.4       takayama  474:       [f gb.options] groebner 0 get /gg set
1.1       maekawa   475:       [(UseCriterion1) 0] system_variable
                    476:     }ifelse
                    477:     wv isInteger {
                    478:       /ans [gg gg {init} map] def
                    479:     }{
                    480:       /ans [gg gg {wv 0 get weightv init} map] def
                    481:     }ifelse
                    482:
                    483:     %% Postprocess : recover the matrix expression.
                    484:     mm {
                    485:       ans { /tmp set [mm tmp] toVectors } map
                    486:       /ans set
                    487:     }{ }
                    488:     ifelse
                    489:     %%
                    490:
                    491:     /arg1 ans def
                    492:   ] pop
                    493:   popEnv
                    494:   popVariables
                    495:   arg1
                    496: } def
                    497:
                    498: /pgb.old {
                    499:   /arg1 set
                    500:   [/in-pgb /aa /typev /setarg /f /v
                    501:    /gg /wv /termorder /vec /ans
                    502:   ] pushVariables
                    503:   [(CurrentRingp) (KanGBmessage) (UseCriterion1)] pushEnv
                    504:   [
                    505:
                    506:     /aa arg1 def
                    507:     aa isArray { } { (array pgb) message (pgb) usage error } ifelse
                    508:     /setarg 0 def
                    509:     /wv 0 def
                    510:     aa { tag } map /typev set
                    511:     typev [ ArrayP ] eq
                    512:     {  /f aa 0 get def
                    513:        /v gb.v def
                    514:        /setarg 1 def
                    515:     } { } ifelse
                    516:     typev [ArrayP StringP] eq
                    517:     {  /f aa 0 get def
                    518:        /v aa 1 get def
                    519:        /setarg 1 def
                    520:     } { } ifelse
                    521:     typev [ArrayP ArrayP] eq
                    522:     {  /f aa 0 get def
                    523:        /v aa 1 get from_records def
                    524:        /setarg 1 def
                    525:     } { } ifelse
                    526:     typev [ArrayP StringP ArrayP] eq
                    527:     {  /f aa 0 get def
                    528:        /v aa 1 get def
                    529:        /wv aa 2 get def
                    530:        /setarg 1 def
                    531:     } { } ifelse
                    532:     typev [ArrayP ArrayP ArrayP] eq
                    533:     {  /f aa 0 get def
                    534:        /v aa 1 get from_records def
                    535:        /wv aa 2 get def
                    536:        /setarg 1 def
                    537:     } { } ifelse
                    538:
                    539:     setarg { } { (pgb : Argument mismatch) message error } ifelse
                    540:
                    541:     [(KanGBmessage) gb.verbose ] system_variable
                    542:
                    543:     %% Input must not be vectors.
                    544:     f { toString } map /f set
                    545:
                    546:     wv isInteger {
                    547:       [v ring_of_polynomials
                    548:       0] define_ring
                    549:       /termorder 1 def
                    550:     }{
                    551:       [v ring_of_polynomials
                    552:        wv weight_vector
                    553:       0] define_ring
                    554:       wv gb.isTermOrder /termorder set
                    555:     } ifelse
                    556:     termorder {
                    557:       f { . dehomogenize } map /f set
                    558:       [(UseCriterion1) 1] system_variable
                    559:       [f] groebner_sugar 0 get /gg set
                    560:       [(UseCriterion1) 0] system_variable
                    561:     }{
                    562:       f { . dehomogenize homogenize} map /f set
                    563:       [(UseCriterion1) 1] system_variable
                    564:       [f] groebner 0 get /gg set
                    565:       [(UseCriterion1) 0] system_variable
                    566:     }ifelse
                    567:     wv isInteger {
                    568:       /ans [gg gg {init} map] def
                    569:     }{
                    570:       /ans [gg gg {wv 0 get weightv init} map] def
                    571:     }ifelse
                    572:     /arg1 ans def
                    573:   ] pop
                    574:   popEnv
                    575:   popVariables
                    576:   arg1
                    577: } def
                    578: (pgb ) messagen-quiet
                    579:
                    580: /gb.toMatrixOfString {
                    581:   /arg1 set
                    582:   [/in-gb.toMatrixOfString /ff /aa /ans] pushVariables
                    583:   [
                    584:      /aa arg1 def
                    585:      aa length 0 eq { /ans [ ] def /gb.toMatrixOfString.LLL goto }{ } ifelse
                    586:      aa 0 get isArray {
                    587:        /gb.itWasMatrix aa 0 get length def
                    588:      }{
                    589:        /gb.itWasMatrix 0 def
                    590:      } ifelse
                    591:      aa {
                    592:        /ff set
                    593:        ff isArray {
                    594:          ff {toString} map /ff set
                    595:        }{
                    596:          [ff toString] /ff set
                    597:        } ifelse
                    598:        ff
                    599:      } map /ans set
                    600:     /gb.toMatrixOfString.LLL
                    601:     /arg1 ans def
                    602:   ] pop
                    603:   popVariables
                    604:   arg1
                    605: } def
                    606: [(gb.toMatrixOfString)
                    607: [(It translates given input into a matrix form which is a data structure)
                    608:  (for computations of kernel, image, cokernel, etc.)
                    609:  (gb.itWasMatrix is set to the length of the input vector.)
                    610:  $Example 1: $
                    611:  $  [ (x). (y).] gb.toMatrixOfString ==> [[(x)] [(y)]] $
                    612:  $  gb.itWasMatrix is 0.$
                    613:  $Example 2: $
                    614:  $  [ [(x). (1).] [(y). (0).]] gb.toMatrixOfString ==>  [ [(x) (1)] [(y) (0)]] $
                    615:  $  gb.itWasMatrix is 2.$
                    616: ]] putUsages
                    617:
                    618: /gb.toMatrixOfPoly {
                    619:   /arg1 set
                    620:   [/in-gb.toMatrixOfPoly /ff /aa /ans] pushVariables
                    621:   [
                    622:      /aa arg1 def
                    623:      aa length 0 eq { /ans [ ] def /gb.toMatrixOfPoly.LLL goto }{ } ifelse
                    624:      aa 0 get isArray {
                    625:        /gb.itWasMatrix aa 0 get length def
                    626:      }{
                    627:        /gb.itWasMatrix 0 def
                    628:      } ifelse
                    629:      aa {
                    630:        /ff set
                    631:        ff isArray {
                    632:        }{
                    633:          [ff] /ff set
                    634:        } ifelse
                    635:        ff
                    636:      } map /ans set
                    637:     /gb.toMatrixOfPoly.LLL
                    638:     /arg1 ans def
                    639:   ] pop
                    640:   popVariables
                    641:   arg1
                    642: } def
                    643: [(gb.toMatrixOfPoly)
                    644: [(It translates given input into a matrix form which is a data structure)
                    645:  (for computations of kernel, image, cokernel, etc.)
                    646:  (gb.itWasMatrix is set to the length of the input vector.)
                    647:  $Example 1: $
                    648:  $  [ (x). (y).] gb.toMatrixOfPoly ==> [[(x)] [(y)]] $
                    649:  $  gb.itWasMatrix is 0.$
                    650:  $Example 2: $
                    651:  $  [ [(x). (1).] [(y). (0).]] gb.toMatrixOfPoly ==>  [ [(x) (1)] [(y) (0)]] $
                    652:  $  gb.itWasMatrix is 2.$
                    653: ]] putUsages
                    654:
                    655: /gb.getWeight {
                    656:   /arg1 set
                    657:   [/in-gb.getWeight /rr /ww /vv /ans /nn /ii] pushVariables
                    658:   [(CurrentRingp)] pushEnv
                    659:   [
                    660:      /rr arg1 def
                    661:      rr ring_def
                    662:      getVariableNames /vv set
                    663:      [(orderMatrix)] system_variable 0 get /ww set
                    664:      /nn vv length 1 sub def
                    665:      [0 1 nn {
                    666:         /ii set
                    667:         ww ii get 0 eq {
                    668:         } {
                    669:           vv ii get
                    670:           ww ii get
                    671:         } ifelse
                    672:       } for
                    673:      ] /ans set
                    674:      /arg1 [ans] def
                    675:   ] pop
                    676:   popEnv
                    677:   popVariables
                    678:   arg1
                    679: } def
                    680: [(gb.getWeight)
                    681: [(ring gb.getWeight wv)
                    682:  (It gets the weight vector field of the ring ring.)
                    683: ]] putUsages
                    684:
                    685:
                    686: /gb.isTermOrder {
                    687:   /arg1 set
                    688:   [/in-gb.isTermOrder /vv /ww /yes /i /j] pushVariables
                    689:   [
                    690:      /vv arg1 def
                    691:      /yes 1 def
                    692:      0 1 vv length 1 sub {
                    693:        /i set
                    694:        /ww vv i get def
                    695:        0 1 ww length 1 sub {
                    696:           /j set
                    697:           ww j get isInteger {
                    698:             ww j get 0 lt { /yes 0 def } { } ifelse
                    699:           }{ } ifelse
                    700:        }for
                    701:      }for
                    702:      /arg1 yes def
                    703:   ] pop
                    704:   popVariables
                    705:   arg1
                    706: } def
                    707: [(gb)
                    708:  [(a gb b)
                    709:   (array a; array b;)
                    710:   (b : [g ii];  array g; array in; g is a Grobner basis of f)
                    711:   (             in the ring of differential operators.)
                    712:    $            ii is the initial ideal in case of w is given or <<a>> belongs$
                    713:    $            to a ring. In the other cases, it returns the initial monominal.$
                    714:   (a : [f ];    array f;  f is a set of generators of an ideal in a ring.)
                    715:   (a : [f v];   array f; string v;  v is the variables. )
                    716:   (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
                    717:   (  )
                    718:   $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
                    719:   $             [ [ (Dx) 1 ] ] ] gb pmat ; $
                    720:   (Example 2: )
                    721:   (To put h=1, type in, e.g., )
                    722:   $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
                    723:   $   [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] gb /gg set gg dehomogenize pmat ;$
                    724:   (  )
                    725:   $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) (  x y Dx Dy -1)] (x,y) $
                    726:   $             [ [ (Dx) 1 (Dy) 1] ] ] gb pmat ; $
                    727:   (  )
                    728:   $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
                    729:   $             [ [ (x) -1 (y) -1] ] ] gb pmat ; $
                    730:   (  )
                    731:   (cf. gb, groebner, groebner_sugar, syz. )
                    732: ]] putUsages
                    733:
                    734: [(pgb)
                    735:  [(a pgb b)
                    736:   (array a; array b;)
                    737:   (b : [g ii];  array g; array in; g is a Grobner basis of f)
                    738:   (             in the ring of polynomials.)
                    739:   $             ii is the initial ideal in case of w is given or <<a>>belongs$
                    740:   $             to a ring. In the other cases, it returns the initial monominal.$
                    741:   (a : [f ];    array f;  f is a set of generators of an ideal in a ring.)
                    742:   (a : [f v];   array f; string v;  v is the variables.)
                    743:   (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
                    744:   $Example 1: [(x,y) ring_of_polynomials 0] define_ring $
                    745:   $           [ [(x^2+y^2-4). (x y -1).] ] pgb :: $
                    746:   $Example 2: [ [(x^2+y^2) (x y)]   (x,y)  [ [(x) -1 (y) -1] ] ] pgb :: $
                    747:   (cf. gb, groebner, groebner_sugar, syz. )
                    748: ]] putUsages
                    749:
                    750:
                    751: %/syz.v 1 def
                    752: /syz.v 1 def
                    753: /syz.verbose 0 def
                    754: /syz {
                    755:   /arg1 set
                    756:   [/in-syz /aa /typev /setarg /f /v
                    757:    /gg /wv /termorder /vec /ans /ggall /vectorInput /vsize /gtmp /gtmp2
                    758:    /rr /mm
                    759:   ] pushVariables
                    760:   [(CurrentRingp) (KanGBmessage)] pushEnv
                    761:   [
                    762:
                    763:     /aa arg1 def
                    764:     aa isArray { } { (<< array >> syz) error } ifelse
                    765:     /setarg 0 def
                    766:     /wv 0 def
                    767:     aa { tag } map /typev set
                    768:     typev [ ArrayP ] eq
                    769:     {  /f aa 0 get def
                    770:        /v syz.v def
                    771:        /setarg 1 def
                    772:     } { } ifelse
                    773:     typev [ArrayP StringP] eq
                    774:     {  /f aa 0 get def
                    775:        /v aa 1 get def
                    776:        /setarg 1 def
                    777:     } { } ifelse
1.9     ! takayama  778:     typev [ArrayP RingP] eq
        !           779:     {  /f aa 0 get def
        !           780:        /v aa 1 get def
        !           781:        /setarg 1 def
        !           782:     } { } ifelse
1.1       maekawa   783:     typev [ArrayP ArrayP] eq
                    784:     {  /f aa 0 get def
                    785:        /v aa 1 get from_records def
                    786:        /setarg 1 def
                    787:     } { } ifelse
                    788:     typev [ArrayP StringP ArrayP] eq
                    789:     {  /f aa 0 get def
                    790:        /v aa 1 get def
                    791:        /wv aa 2 get def
                    792:        /setarg 1 def
                    793:     } { } ifelse
1.9     ! takayama  794:     typev [ArrayP RingP ArrayP] eq
        !           795:     {  /f aa 0 get def
        !           796:        /v aa 1 get def
        !           797:        /wv aa 2 get def
        !           798:        /setarg 1 def
        !           799:     } { } ifelse
1.1       maekawa   800:     typev [ArrayP ArrayP ArrayP] eq
                    801:     {  /f aa 0 get def
                    802:        /v aa 1 get from_records def
                    803:        /wv aa 2 get def
                    804:        /setarg 1 def
                    805:     } { } ifelse
                    806:
                    807:     setarg { } { (syz : Argument mismatch) error } ifelse
                    808:
                    809:     [(KanGBmessage) syz.verbose ] system_variable
                    810:
                    811:
                    812:
                    813:     %%% Start of the preprocess
1.9     ! takayama  814:     v tag RingP eq {
        !           815:       /rr v def
        !           816:     }{
        !           817:        f getRing /rr set
        !           818:     } ifelse
1.1       maekawa   819:     %% To the normal form : matrix expression.
                    820:     f gb.toMatrixOfString /f set
                    821:     /mm gb.itWasMatrix def
                    822:     mm 0 gt {
                    823:       /vectorInput 1 def
                    824:     }{
                    825:       /vectorInput 1 def
                    826:     } ifelse
                    827:
                    828:     rr tag 0 eq {
                    829:       %% Define our own ring
                    830:       v isInteger {
                    831:         (Error in syz: Specify variables) error
                    832:       } {  } ifelse
                    833:       wv isInteger {
                    834:         [v ring_of_differential_operators
                    835:         0] define_ring
                    836:         /termorder 1 def
                    837:       }{
                    838:         [v ring_of_differential_operators
                    839:          wv weight_vector
                    840:         0] define_ring
                    841:         wv gb.isTermOrder /termorder set
                    842:       } ifelse
                    843:     }{
                    844:       %% Use the ring structre given by the input.
                    845:       v isInteger not {
1.7       takayama  846:         gb.warning {
                    847:          (Warning : the given ring definition is not used.) message
                    848:         } { } ifelse
1.1       maekawa   849:       } {  } ifelse
                    850:       rr ring_def
                    851:       /wv rr gb.getWeight def
                    852:       wv gb.isTermOrder /termorder set
                    853:     } ifelse
                    854:     %%% Enf of the preprocess
                    855:
                    856:     termorder {
                    857:       f { {. dehomogenize} map } map /f set
                    858:       [f [(needBack) (needSyz)]] groebner_sugar /ggall set
                    859:       ggall 2 get /gg set
                    860:     }{
                    861:       f { {. dehomogenize } map homogenize } map /f set
                    862:       [f [(needBack) (needSyz)]] groebner /ggall set
                    863:       ggall 2 get /gg set
                    864:     }ifelse
                    865:     vectorInput {
                    866:       /vsize f 0 get length def  %% input vector size.
                    867:       /gtmp ggall 0 get def
                    868:        [vsize gtmp] toVectors /gtmp set
                    869:        ggall 0 gtmp put
                    870:     }{  } ifelse
                    871:       /arg1 [gg dehomogenize ggall] def
                    872:   ] pop
                    873:   popEnv
                    874:   popVariables
                    875:   arg1
                    876: } def
                    877: (syz ) messagen-quiet
                    878:
                    879: [(syz)
                    880:  [(a syz [b c])
                    881:   (array a; array b; array c)
                    882:   (b is a set of generators of the syzygies of f.)
                    883:   (c = [gb, backward transformation, syzygy without dehomogenization].)
                    884:   (See groebner.)
                    885:   (a : [f ];    array f;  f is a set of generators of an ideal in a ring.)
                    886:   (a : [f v];   array f; string v;  v is the variables.)
                    887:   (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
1.9     ! takayama  888:   ( v may be a ring object. )
1.1       maekawa   889:   $Example 1: [(x,y) ring_of_polynomials 0] define_ring $
                    890:   $           [ [(x^2+y^2-4). (x y -1).] ] syz :: $
                    891:   $Example 2: [ [(x^2+y^2) (x y)]   (x,y)  [ [(x) -1 (y) -1] ] ] syz :: $
                    892:   $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
                    893:   $             [ [ (Dx) 1 ] ] ] syz pmat ; $
                    894:   $Example 4:  [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
                    895:   $             [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] syz pmat ;$
                    896:   $Example 5:  [ [ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] $
                    897:   $              (x,y) ] syz pmat ;$
                    898:   $Example 6:  [ [ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] $
                    899:   $              (x,y) [[(x) -1 (y) -2]] ] syz pmat ;$
                    900:   $Example 7:  [ [ [(0) (0)] [(0) (0)] [(x) (y)]] $
                    901:   $              [(x) (y)]] syz pmat ;$
                    902: ]] putUsages
                    903:
                    904:
                    905: %%%%%%%%%%%%%%%%%% package fs  %%%%%%%%%%%%%%%%%%%%%%%
                    906: [(genericAnn)
                    907:  [ (f [s v1 v2 ... vn] genericAnn [L1 ... Lm])
                    908:    (L1, ..., Lm are annihilating ideal for f^s.)
                    909:    (f is a polynomial of v1, ..., vn)
                    910:    (<string> | <poly>  f, s, v1, ..., vn ; <poly>  L1, ..., Lm )
                    911:    $Example: (x^3+y^3+z^3) [(s) (x) (y) (z)] genericAnn$
                    912:  ]
                    913: ] putUsages ( genericAnn ) messagen-quiet
                    914: /fs.verbose 0 def
                    915: /genericAnn {
                    916:   /arg2 set /arg1 set
                    917:   [/in-genericAnn /f /vlist /s  /vvv /nnn /rrr
                    918:    /v1  /ops /ggg /ggg0
                    919:    ] pushVariables
                    920:   [(CurrentRingp) (KanGBmessage)] pushEnv
                    921:   [
                    922:     /f arg1 def  /vlist arg2 def
                    923:     f toString /f set
                    924:     vlist { toString } map /vlist set
                    925:     [(KanGBmessage) fs.verbose] system_variable
                    926:     /s vlist 0 get def
                    927:     /vvv (_u,_v,_t,) vlist rest { (,) 2 cat_n } map aload length /nnn set
                    928:          s nnn 2 add cat_n def
                    929:     fs.verbose { vvv message } {  }ifelse
                    930:     [vvv ring_of_differential_operators
                    931:      [[(_u) 1 (_v) 1]] weight_vector 0] define_ring /rrr set
                    932:
                    933:     [ (_u*_t). f . sub  (_u*_v-1). ]
                    934:     vlist rest { /v1 set
                    935: %%D-clean   f . (D) v1 2 cat_n . 1 diff0 (_v*D_t). mul
                    936:         f . @@@.Dsymbol v1 2 cat_n . 1 diff0 [(_v*) @@@.Dsymbol (_t)] cat . mul
                    937:         @@@.Dsymbol v1 2 cat_n . add } map
                    938:     join
                    939:     /ops set
                    940:     ops {[[(h). (1).]] replace } map /ops set
                    941:     fs.verbose { ops message  } {  }ifelse
                    942:     [ops] groebner_sugar 0 get /ggg0 set
                    943:     fs.verbose { ggg0 message } { } ifelse
                    944:     ggg0 [(_u) (_v)] eliminatev
                    945: %%D-clean        { [(_t).] [ (D_t).] [s .] distraction
                    946:         { [(_t).] [ [@@@.Dsymbol (_t)] cat .] [s .] distraction
                    947:           [[s . << (0). s . sub (1). sub >>]] replace
                    948:          } map /arg1 set
                    949:   ] pop
                    950:   popEnv
                    951:   popVariables
                    952:   arg1
                    953: } def
                    954:
                    955: %% Find differential equations for  f^(m), r0 the minimal integral root.
                    956: [(annfs)
                    957:  [( [ f v m r0] annfs g )
                    958:   (It returns the annihilating ideal of f^m where r0 must be smaller)
                    959:   (or equal to the minimal integral root of the b-function.)
                    960:   (Or, it returns the annihilating ideal of f^r0, r0 and the b-function)
                    961:   (where r0 is the minial integral root of b.)
                    962:   (For the algorithm, see J. Pure and Applied Algebra 117&118(1997), 495--518.)
                    963:   (Example 1: [(x^2+y^2+z^2+t^2) (x,y,z,t) -1 -2] annfs :: )
                    964:   $           It returns the annihilating ideal of (x^2+y^2+z^2+t^2)^(-1).$
                    965:   (Example 2: [(x^2+y^2+z^2+t^2) (x,y,z,t)] annfs :: )
                    966:   $           It returns the annihilating ideal of f^r0 and [r0, b-function]$
                    967:   $           where r0 is the minimal integral root of the b-function.$
                    968:   (Example 3: [(x^2+y^2+z^2) (x,y,z) -1 -1] annfs :: )
                    969:   (Example 4: [(x^3+y^3+z^3) (x,y,z)] annfs :: )
                    970:   (Example 5: [((x1+x2+x3)(x1 x2 + x2 x3 + x1 x3) - t x1 x2 x3 ) )
                    971:   (            (t,x1,x2,x3) -1 -2] annfs :: )
                    972:   (           Note that the example 4 uses huge memory space.)
                    973: ]] putUsages
                    974: ( annfs ) messagen-quiet
                    975: /annfs.verbose fs.verbose def
                    976: /annfs.v [(x) (y) (z)] def
                    977: /annfs.s (_s) def
                    978: %% The first variable must be s.
                    979: /annfs {
                    980:   /arg1 set
                    981:   [/in-annfs /aa /typev /setarg  /v /m /r0 /gg /ss /fs /gg2
                    982:    /ans /vtmp /w2 /velim /bbb /rrr /r0
                    983:   ] pushVariables
                    984:   [(CurrentRingp) (KanGBmessage)] pushEnv
                    985:   [
                    986:
                    987:     /aa arg1 def
                    988:     aa isArray { } { ( << array >> annfs) error } ifelse
                    989:     /setarg 0 def
                    990:     aa { tag } map /typev set
                    991:     /r0 [ ] def
                    992:     /m  [ ]  def
                    993:     /v annfs.v def
                    994:     aa 0 << aa 0 get toString >> put
                    995:     typev [ StringP ] eq
                    996:     {  /f aa 0 get def
                    997:        /setarg 1 def
                    998:     } { } ifelse
                    999:     typev [StringP StringP] eq
                   1000:     {  /f aa 0 get def
                   1001:        /v [ aa 1 get to_records pop ] def
                   1002:        /setarg 1 def
                   1003:     } { } ifelse
                   1004:     typev [StringP ArrayP] eq
                   1005:     {  /f aa 0 get def
                   1006:        /v aa 1 get def
                   1007:        /setarg 1 def
                   1008:     } { } ifelse
                   1009:     typev [StringP ArrayP IntegerP IntegerP] eq
                   1010:     {  /f aa 0 get def
                   1011:        /v aa 1 get def
                   1012:        /m aa 2 get def
                   1013:        /r0 aa 3 get def
                   1014:        /setarg 1 def
                   1015:     } { } ifelse
                   1016:     typev [StringP StringP IntegerP IntegerP] eq
                   1017:     {  /f aa 0 get def
                   1018:        /v [ aa 1 get to_records pop ] def
                   1019:        /m aa 2 get def
                   1020:        /r0 aa 3 get def
                   1021:        /setarg 1 def
                   1022:     } { } ifelse
                   1023:     setarg 1 eq { } { (annfs : wrong argument) error } ifelse
                   1024:
                   1025:     [annfs.s] v join /v set
                   1026:
                   1027:     /ss v 0 get def
                   1028:     annfs.verbose {
                   1029:        (f, v, s, f^{m}, m+r0 = ) messagen
                   1030:        [ f  (, ) v  (, )  ss  (, )
                   1031:          (f^) m (,) m (+)  r0 ] {messagen} map ( ) message
                   1032:     } { } ifelse
                   1033:
                   1034:     f v genericAnn /fs set
                   1035:
                   1036:     annfs.verbose {
                   1037:       (genericAnn is ) messagen fs message
                   1038:     } { } ifelse
                   1039:     [(KanGBmessage) annfs.verbose] system_variable
                   1040:
                   1041:     m isArray {
                   1042:       %% Now, let us find  the b-function. /vtmp /w2 /velim /bbb /rrr /r0
                   1043:       v rest { /vtmp set vtmp  @@@.Dsymbol vtmp 2 cat_n } map /velim set
                   1044:       velim { 1 } map /w2 set
                   1045:       annfs.verbose { w2 message } {  } ifelse
                   1046:       [v from_records ring_of_differential_operators
                   1047:        [w2] weight_vector 0] define_ring
                   1048:       [ fs { toString . } map [ f toString . ] join ]
                   1049:       groebner_sugar 0 get velim eliminatev 0 get /bbb set
                   1050:       [[(s) annfs.s] from_records ring_of_polynomials 0] define_ring
                   1051:       bbb toString . [[annfs.s . (s).]] replace /bbb set
                   1052:       annfs.verbose { bbb message } {  } ifelse
                   1053:       bbb findIntegralRoots  /rrr set
                   1054:       rrr 0 get /r0 set  %% minimal integral root.
                   1055:       annfs.verbose { rrr message } {  } ifelse
                   1056:       fs 0 get (ring) dc ring_def
                   1057:       fs { [[annfs.s . r0 toString .]] replace } map /ans set
                   1058:       /ans [ans [r0 bbb]] def
                   1059:       /annfs.label1 goto
                   1060:     } { } ifelse
                   1061:     m 0 ge {
                   1062:       (annfs works only for getting annihilating ideal for f^(negative))
                   1063:       error
                   1064:     } { } ifelse
                   1065:     r0 isArray {
                   1066:       [(Need to compute the minimal root of b-function) nl
                   1067:        (It has not been implemented.) ] cat
                   1068:       error
                   1069:     } {  } ifelse
                   1070:
                   1071:     [v from_records ring_of_differential_operators 0] define_ring
                   1072:     fs {toString . dehomogenize [[ss . r0 (poly) dc]] replace}
                   1073:        map /gg set
                   1074:     annfs.verbose { gg message } { } ifelse
                   1075:
                   1076:     [ [f . << m r0 sub >> npower ] gg join
                   1077:       [(needBack) (needSyz)]] groebner_sugar 2 get /gg2 set
                   1078:
                   1079:     gg2 { 0 get } map /ans set
                   1080:     /ans ans { dup (0). eq {pop} { } ifelse } map def
                   1081:
                   1082:     /annfs.label1
                   1083:     /arg1 ans def
                   1084:   ] pop
                   1085:   popEnv
                   1086:   popVariables
                   1087:   arg1
                   1088: } def
                   1089:
                   1090: /genericAnnWithL.s (s) def
                   1091: /annfs.verify 0 def
                   1092: /genericAnnWithL {
                   1093:   /arg1 set
                   1094:   [/in-genericAnnWithL /aa /typev /setarg  /v /m /r0 /gg /ss /fs /gg2
                   1095:    /ans /vtmp /w2 /velim /bbb /rrr /r0  /myL /mygb /jj
                   1096:   ] pushVariables
                   1097:   [(CurrentRingp) (KanGBmessage) (Homogenize)] pushEnv
                   1098:   [
                   1099:
                   1100:     /aa arg1 def
                   1101:     aa isArray { } { ( << array >> annfs) error } ifelse
                   1102:     /setarg 0 def
                   1103:     aa { tag } map /typev set
                   1104:     /r0 [ ] def
                   1105:     /m  [ ]  def
                   1106:     /v annfs.v def
                   1107:     aa 0 << aa 0 get toString >> put
                   1108:     typev [ StringP ] eq
                   1109:     {  /f aa 0 get def
                   1110:        /setarg 1 def
                   1111:     } { } ifelse
                   1112:     typev [StringP StringP] eq
                   1113:     {  /f aa 0 get def
                   1114:        /v [ aa 1 get to_records pop ] def
                   1115:        /setarg 1 def
                   1116:     } { } ifelse
                   1117:     typev [StringP ArrayP] eq
                   1118:     {  /f aa 0 get def
                   1119:        /v aa 1 get def
                   1120:        /setarg 1 def
                   1121:     } { } ifelse
                   1122:     setarg 1 eq { } { (genericAnnWithL : wrong argument) error } ifelse
                   1123:
                   1124:     [genericAnnWithL.s] v join /v set
                   1125:
                   1126:     /ss v 0 get def
                   1127:     annfs.verbose {
                   1128:        (f, v, s, f^{m}, m+r0 = ) messagen
                   1129:        [ f  (, ) v  (, )  ss  (, )
                   1130:          (f^) m (,) m (+)  r0 ] {messagen} map ( ) message
                   1131:     } { } ifelse
                   1132:
                   1133:     f v genericAnn /fs set
                   1134:
                   1135:     annfs.verbose {
                   1136:       (genericAnn is ) messagen fs message
                   1137:     } { } ifelse
                   1138:     [(KanGBmessage) annfs.verbose] system_variable
                   1139:
                   1140:     m isArray {
                   1141:       %% Now, let us find  the b-function. /vtmp /w2 /velim /bbb /rrr /r0
                   1142:       v rest { /vtmp set vtmp  @@@.Dsymbol vtmp 2 cat_n } map /velim set
                   1143:       velim { 1 } map /w2 set
                   1144:       annfs.verbose { w2 message } {  } ifelse
                   1145:       [v from_records ring_of_differential_operators
                   1146:        [w2] weight_vector 0] define_ring
                   1147:
                   1148:       [ [ f toString . ] fs { toString . } map join [(needBack)]]
                   1149:       groebner_sugar /mygb set
                   1150:       mygb 0 get velim eliminatev 0 get /bbb set
                   1151:       mygb 0 get bbb position /jj set
                   1152:       mygb 1 get jj get 0 get /myL set
                   1153:
                   1154:       annfs.verbose { bbb message } {  } ifelse
                   1155:
                   1156:       annfs.verify {
                   1157:         (Verifying L f - b belongs to genericAnn(f)) message
                   1158:         [(Homogenize) 0] system_variable
                   1159:         << myL f . mul bbb sub >>
                   1160:         [fs { toString . } map] groebner_sugar 0 get
                   1161:         reduction 0 get message
                   1162:         (Is it zero? Then it's fine.) message
                   1163:       } { } ifelse
                   1164:
                   1165:       /ans [bbb [myL fs] ] def
                   1166:       /annfs.label1 goto
                   1167:     } { } ifelse
                   1168:
                   1169:     /annfs.label1
                   1170:     /arg1 ans def
                   1171:   ] pop
                   1172:   popEnv
                   1173:   popVariables
                   1174:   arg1
                   1175: } def
                   1176:
                   1177:
                   1178: [(genericAnnWithL)
                   1179: [$[f v] genericAnnWithL [b [L I]]$
                   1180:  $String f,v; poly b,L; array of poly I;$
                   1181:  $f is a polynomial given by a string. v is the variables.$
                   1182:  $ v must not contain names  s, e.$
                   1183:  $b is the b-function (Bernstein-Sato polynomial) for f and$
                   1184:  $ L is the operator satisfying L f^{s+1} = b(s) f^s $
                   1185:  $ I is the annihilating ideal of f^s.$
                   1186:  $cf. bfunction, annfs, genericAnn.$
                   1187:  $Example 1:  [(x^2+y^2) (x,y)] genericAnnWithL ::$
                   1188:  $Example 2:  [(x^2+y^2+z^2) (x,y,z)] genericAnnWithL ::$
                   1189:  $Example 3:  [(x^3-y^2 z^2) (x,y,z)] genericAnnWithL ::$
                   1190: ]] putUsages
1.2       takayama 1191:
                   1192: /reduction*.noH 0 def
                   1193: /reduction* {
                   1194:   /arg1 set
                   1195:   [/in-reduction* /aa /typev /setarg /f /v
                   1196:    /gg /wv /termorder /vec /ans /rr /mm /h /size /a0 /a3
1.3       takayama 1197:    /opt
1.2       takayama 1198:   ] pushVariables
                   1199:   [(CurrentRingp) (KanGBmessage)] pushEnv
                   1200:   [
                   1201:
                   1202:     /aa arg1 def
                   1203:     aa isArray { } { ( << array >> reduction*) error } ifelse
                   1204:     /setarg 0 def
                   1205:     /wv 0 def
                   1206:     aa { tag } map /typev set
                   1207:     typev [StringP ArrayP ArrayP] eq
                   1208:     typev [ArrayP ArrayP ArrayP] eq or
                   1209:     typev [PolyP ArrayP ArrayP] eq or
                   1210:     {  /h aa 0 get def
                   1211:        /f aa 1 get def
                   1212:        /v aa 2 get from_records def
                   1213:        /setarg 1 def
                   1214:     } { } ifelse
                   1215:     typev [StringP ArrayP ArrayP ArrayP] eq
                   1216:     typev [ArrayP ArrayP ArrayP ArrayP] eq or
                   1217:     typev [PolyP ArrayP ArrayP ArrayP] eq or
                   1218:     {  /h aa 0 get def
                   1219:        /f aa 1 get def
                   1220:        /v aa 2 get from_records def
                   1221:        /wv aa 3 get def
                   1222:        /setarg 1 def
                   1223:     } { } ifelse
                   1224:
                   1225:     setarg { } { (reduction* : Argument mismatch) error } ifelse
                   1226:
                   1227:     [(KanGBmessage) gb.verbose ] system_variable
                   1228:
                   1229:     %%% Start of the preprocess
                   1230:     f getRing /rr set
                   1231:
                   1232:
                   1233:     rr tag 0 eq {
                   1234:       %% Define our own ring
                   1235:       v isInteger {
                   1236:         (Error in reduction*: Specify variables) error
                   1237:       } {  } ifelse
                   1238:       wv isInteger {
                   1239:         [v ring_of_differential_operators
                   1240:         0] define_ring
                   1241:         /termorder 1 def
                   1242:       }{
                   1243:         [v ring_of_differential_operators
                   1244:          wv weight_vector
                   1245:         0] define_ring
                   1246:         wv gb.isTermOrder /termorder set
                   1247:       } ifelse
                   1248:     } {
                   1249:       %% Use the ring structre given by the input.
                   1250:       v isInteger not {
1.7       takayama 1251:         gb.warning {
                   1252:          (Warning : the given ring definition is not used.) message
                   1253:         } { } ifelse
1.2       takayama 1254:       } {  } ifelse
                   1255:       rr ring_def
                   1256:       /wv rr gb.getWeight def
                   1257:       wv gb.isTermOrder /termorder set
                   1258:     } ifelse
                   1259:     %%% Enf of the preprocess
                   1260:
                   1261:     f 0 get isArray {
                   1262:       /size f 0 get length def
                   1263:       f { { toString . } map } map /f set
                   1264:       f fromVectors /f set
                   1265:     }{
                   1266:       /size -1 def
                   1267:       f { toString . } map /f set
                   1268:     } ifelse
                   1269:
                   1270:     h isArray {
                   1271:       h { toString . } map /h set
                   1272:       [h] fromVectors 0 get /h set
                   1273:     }{
                   1274:       h toString . /h set
                   1275:     } ifelse
                   1276:     f { toString . } map /f set
1.3       takayama 1277:     getOptions /opt set
                   1278:     [(ReduceLowerTerms) 1] system_variable
1.2       takayama 1279:     reduction*.noH {
                   1280:       h f reduction-noH /ans set
                   1281:     } {
                   1282:       h f reduction /ans set
                   1283:     } ifelse
1.3       takayama 1284:     opt restoreOptions
1.2       takayama 1285:     size -1 eq not {
                   1286:       [size ans 0 get] toVectors /a0 set
                   1287:       [size ans 3 get] toVectors /a3 set
                   1288:       /ans [a0 ans 1 get ans 2 get a3] def
                   1289:     } { } ifelse
                   1290:     /arg1 ans def
                   1291:   ] pop
                   1292:   popEnv
                   1293:   popVariables
                   1294:   arg1
                   1295: } def
                   1296:
                   1297:
                   1298: [(reduction*)
                   1299: [([f base v] reduction* [h c0 syz input])
                   1300:  ([f base v weight] reduction* [h c0 syz input])
                   1301:  (reduction* is an user interface for reduction and reduction-noH.)
                   1302:  (If reduction*.noH is one, then reduction-noH will be called.)
                   1303:  (Example 1: [(x^2) [(x^2+y^2-4) (x y-1)] [(x) (y)]] reduction* )
                   1304:  (Example 2: [[(1) (y^2-1)] [ [(0) (y-1)] [(1) (y+1)]] [(x) (y)]] reduction*)
                   1305:  (Example 3: [(x^2) [(x^2+y^2-4) (x y-1)] [(x) (y)] [[(x) 10]] ] reduction* )
                   1306: ]] putUsages
1.5       takayama 1307:
                   1308:
                   1309:
                   1310: %%  2000, 6/7,  at Sevilla, Hernando Colon
                   1311: %% macros that deal with homogenized inputs.
                   1312: %%  Sample:  [ [(h+x). (x^3).] [(x). (x).]] /ff set
                   1313: %%           [(Homogenize_vec) 0] system_varialbe
                   1314: %%           (grade) (grave1v) switch_function
                   1315: %%  YA homogenization:  [ [(h^3*(h+x)). (x^3).] [(h x). (x).]] /ff set
                   1316: %%                          4+0         3+1      2+0    1+1
                   1317: /gb_h {
                   1318:   /arg1 set
                   1319:   [/in-gb_h /aa /typev /setarg /f /v
                   1320:    /gg /wv /termorder /vec /ans /rr /mm
                   1321:    /gb_h.opt
                   1322:   ] pushVariables
                   1323:   [(CurrentRingp) (KanGBmessage) (Homogenize_vec)] pushEnv
                   1324:   [
                   1325:
                   1326:     /aa arg1 def
1.6       takayama 1327:     gb.verbose { (Getting in gb_h) message } {  } ifelse
1.5       takayama 1328:     aa isArray { } { ( << array >> gb_h) error } ifelse
                   1329:     /setarg 0 def
                   1330:     /wv 0 def
                   1331:     aa { tag } map /typev set
                   1332:     typev [ ArrayP ] eq
                   1333:     {  /f aa 0 get def
                   1334:        /v gb.v def
                   1335:        /setarg 1 def
                   1336:     } { } ifelse
                   1337:     typev [ArrayP StringP] eq
                   1338:     {  /f aa 0 get def
                   1339:        /v aa 1 get def
                   1340:        /setarg 1 def
                   1341:     } { } ifelse
                   1342:     typev [ArrayP ArrayP] eq
                   1343:     {  /f aa 0 get def
                   1344:        /v aa 1 get from_records def
                   1345:        /setarg 1 def
                   1346:     } { } ifelse
                   1347:     typev [ArrayP StringP ArrayP] eq
                   1348:     {  /f aa 0 get def
                   1349:        /v aa 1 get def
                   1350:        /wv aa 2 get def
                   1351:        /setarg 1 def
                   1352:     } { } ifelse
                   1353:     typev [ArrayP ArrayP ArrayP] eq
                   1354:     {  /f aa 0 get def
                   1355:        /v aa 1 get from_records def
                   1356:        /wv aa 2 get def
                   1357:        /setarg 1 def
                   1358:     } { } ifelse
                   1359:
                   1360:     setarg { } { (gb_h : Argument mismatch) error } ifelse
                   1361:
                   1362:     [(KanGBmessage) gb.verbose ] system_variable
                   1363:
                   1364:     %%% Start of the preprocess
                   1365:     f getRing /rr set
                   1366:     %% To the normal form : matrix expression.
                   1367:     f gb.toMatrixOfString /f set
                   1368:     /mm gb.itWasMatrix def
                   1369:
                   1370:     rr tag 0 eq {
                   1371:       %% Define our own ring
                   1372:       v isInteger {
                   1373:         (Error in gb_h: Specify variables) error
                   1374:       } {  } ifelse
                   1375:       wv isInteger {
                   1376:         [v ring_of_differential_operators
                   1377:         0] define_ring
                   1378:         /termorder 1 def
                   1379:       }{
                   1380:         [v ring_of_differential_operators
                   1381:          wv weight_vector
                   1382:         0] define_ring
                   1383:         wv gb.isTermOrder /termorder set
                   1384:       } ifelse
                   1385:     } {
                   1386:       %% Use the ring structre given by the input.
                   1387:       v isInteger not {
1.7       takayama 1388:         gb.warning {
                   1389:          (Warning : the given ring definition is not used.) message
                   1390:         } { } ifelse
1.5       takayama 1391:       } {  } ifelse
                   1392:       rr ring_def
                   1393:       /wv rr gb.getWeight def
                   1394:       wv gb.isTermOrder /termorder set
                   1395:     } ifelse
                   1396:     getOptions /gb_h.opt set
                   1397:     (grade) (module1v) switch_function
1.6       takayama 1398:     [(Homogenize_vec) 0] system_variable
1.5       takayama 1399:     %%% End of the preprocess
                   1400:
                   1401:     gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
                   1402:     termorder {
                   1403:       f { {. } map } map /f set
                   1404:       [f gb.options] groebner 0 get /gg set %% Do not use sugar.
                   1405:     }{
                   1406:       f { {. } map} map /f set
                   1407:       f fromVectors /f set
                   1408:       [f gb.options] groebner 0 get /gg set
                   1409:     }ifelse
                   1410:     wv isInteger {
                   1411:       /ans [gg gg {init} map] def
                   1412:     }{
                   1413:       /ans [gg gg {wv 0 get weightv init} map] def
                   1414:     }ifelse
                   1415:
                   1416:     %% Postprocess : recover the matrix expression.
                   1417:     mm {
                   1418:       ans { /tmp set [mm tmp] toVectors } map
                   1419:       /ans set
                   1420:     }{ }
                   1421:     ifelse
                   1422:     gb_h.opt restoreOptions
1.6       takayama 1423:     gb.verbose { (Getting out of gb_h) message } {  } ifelse
1.5       takayama 1424:     %%
                   1425:
                   1426:     /arg1 ans def
                   1427:   ] pop
                   1428:   popEnv
                   1429:   popVariables
                   1430:   arg1
                   1431: } def
                   1432: (gb_h ) messagen-quiet
                   1433: [(gb_h)
                   1434:  [(a gb_h b)
                   1435:   (array a; array b;)
                   1436:   (b : [g ii];  array g; array in; g is a Grobner basis of f)
                   1437:   (             in the ring of homogenized differential operators.)
                   1438:   ( The input must be homogenized properly.)
                   1439:   ( Inproper homogenization may cause an infinite loop.)
                   1440:   ( Each element of vectors must be homogenized. If you are using )
                   1441:   ( non-term orders, all elements of vectors must have the same degree with)
                   1442:   ( a proper degree shift vector.)
                   1443:    $            ii is the initial ideal in case of w is given or <<a>> belongs$
                   1444:    $            to a ring. In the other cases, it returns the initial monominal.$
                   1445:   $ [(Homogenize_vec) 0] system_variable (grade) (module1v) switch_function$
                   1446:   (a : [f ];    array f;  f is a set of generators of an ideal in a ring.)
                   1447:   (a : [f v];   array f; string v;  v is the variables. )
                   1448:   (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
                   1449:   (  )
                   1450:   $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -h^4) ( x y Dx Dy -h^4)] (x,y) $
                   1451:   $             [ [ (Dx) 1 ] ] ] gb_h pmat ; $
                   1452:   $Example 2: [ [[(h+x) (x^3)] [(x) (x)]] (x)] gb_h pmat $
                   1453:   $Example 3: [[ [(x^2) (y+x)] [(x+y) (y^3)] $
                   1454:   $              [(2 x^2+x y) (y h^3 +x h^3 +x y^3)]] (x,y) $
                   1455:   $             [ [ (x) -1 (y) -1] ] ] gb_h pmat ; $
                   1456:   $  Infinite loop: see by [(DebugReductionRed) 1] system_variable$
                   1457:   $Example 4: [[ [(x^2) (y+x)] [(x^2+y^2) (y)] $
                   1458:   $              [(2 x^5+x y^4) (y h^3 +x h^3 +x y^3)]] (x,y) $
                   1459:   $             [ [ (x) -1 (y) -1] ] ] gb_h pmat ; $
                   1460:   $  This is fine because grade(v_1) = grade(v_2)+1 for all vectors. $
                   1461:   (  )
                   1462:   (cf. gb, groebner, syz_h. )
                   1463: ]] putUsages
                   1464:
                   1465: /syz_h {
                   1466:   /arg1 set
                   1467:   [/in-syz_h /aa /typev /setarg /f /v
                   1468:    /gg /wv /termorder /vec /ans /ggall /vectorInput /vsize /gtmp /gtmp2
                   1469:    /rr /mm
                   1470:    /syz_h.opt
                   1471:   ] pushVariables
                   1472:   [(CurrentRingp) (KanGBmessage)] pushEnv
                   1473:   [
                   1474:
                   1475:     /aa arg1 def
                   1476:     aa isArray { } { (<< array >> syz_h) error } ifelse
                   1477:     /setarg 0 def
                   1478:     /wv 0 def
                   1479:     aa { tag } map /typev set
                   1480:     typev [ ArrayP ] eq
                   1481:     {  /f aa 0 get def
                   1482:        /v syz.v def
                   1483:        /setarg 1 def
                   1484:     } { } ifelse
                   1485:     typev [ArrayP StringP] eq
                   1486:     {  /f aa 0 get def
                   1487:        /v aa 1 get def
                   1488:        /setarg 1 def
                   1489:     } { } ifelse
                   1490:     typev [ArrayP ArrayP] eq
                   1491:     {  /f aa 0 get def
                   1492:        /v aa 1 get from_records def
                   1493:        /setarg 1 def
                   1494:     } { } ifelse
                   1495:     typev [ArrayP StringP ArrayP] eq
                   1496:     {  /f aa 0 get def
                   1497:        /v aa 1 get def
                   1498:        /wv aa 2 get def
                   1499:        /setarg 1 def
                   1500:     } { } ifelse
                   1501:     typev [ArrayP ArrayP ArrayP] eq
                   1502:     {  /f aa 0 get def
                   1503:        /v aa 1 get from_records def
                   1504:        /wv aa 2 get def
                   1505:        /setarg 1 def
                   1506:     } { } ifelse
                   1507:
                   1508:     setarg { } { (syz_h : Argument mismatch) error } ifelse
                   1509:
                   1510:     [(KanGBmessage) syz.verbose ] system_variable
                   1511:
                   1512:
                   1513:
                   1514:     %%% Start of the preprocess
                   1515:     f getRing /rr set
                   1516:     %% To the normal form : matrix expression.
                   1517:     f gb.toMatrixOfString /f set
                   1518:     /mm gb.itWasMatrix def
                   1519:     mm 0 gt {
                   1520:       /vectorInput 1 def
                   1521:     }{
                   1522:       /vectorInput 1 def
                   1523:     } ifelse
                   1524:
                   1525:     rr tag 0 eq {
                   1526:       %% Define our own ring
                   1527:       v isInteger {
                   1528:         (Error in syz_h: Specify variables) error
                   1529:       } {  } ifelse
                   1530:       wv isInteger {
                   1531:         [v ring_of_differential_operators
                   1532:         0] define_ring
                   1533:         /termorder 1 def
                   1534:       }{
                   1535:         [v ring_of_differential_operators
                   1536:          wv weight_vector
                   1537:         0] define_ring
                   1538:         wv gb.isTermOrder /termorder set
                   1539:       } ifelse
                   1540:     }{
                   1541:       %% Use the ring structre given by the input.
                   1542:       v isInteger not {
1.7       takayama 1543:         gb.warning {
                   1544:          (Warning : the given ring definition is not used.) message
                   1545:         } { } ifelse
1.5       takayama 1546:       } {  } ifelse
                   1547:       rr ring_def
                   1548:       /wv rr gb.getWeight def
                   1549:       wv gb.isTermOrder /termorder set
                   1550:     } ifelse
                   1551:
                   1552:     getOptions /syz_h.opt set
                   1553:     (grade) (module1v) switch_function
                   1554:     [(Homogenize_vec) 0] system_variable
                   1555:     %%% End of the preprocess
                   1556:
                   1557:     termorder {
                   1558:       f { {. } map } map /f set
                   1559:       [f [(needBack) (needSyz)]] groebner /ggall set %% Do not use sugar.
                   1560:       ggall 2 get /gg set
                   1561:     }{
                   1562:       f { {. } map  } map /f set
                   1563:       [f [(needBack) (needSyz)]] groebner /ggall set
                   1564:       ggall 2 get /gg set
                   1565:     }ifelse
                   1566:     vectorInput {
                   1567:       /vsize f 0 get length def  %% input vector size.
                   1568:       /gtmp ggall 0 get def
                   1569:        [vsize gtmp] toVectors /gtmp set
                   1570:        ggall 0 gtmp put
                   1571:     }{  } ifelse
                   1572:
                   1573:     syz_h.opt restoreOptions
                   1574:     %%
                   1575:
                   1576:       /arg1 [gg ggall] def
                   1577:   ] pop
                   1578:   popEnv
                   1579:   popVariables
                   1580:   arg1
                   1581: } def
                   1582: (syz_h ) messagen-quiet
                   1583:
                   1584: [(syz_h)
                   1585:  [(a syz_h [b c])
                   1586:   (array a; array b; array c)
                   1587:   (b is a set of generators of the syzygies of f in the ring of)
                   1588:   (homogenized differential operators.)
                   1589:   ( The input must be homogenized properly.)
                   1590:   ( Inproper homogenization may cause an infinite loop.)
                   1591:   ( Each element of vectors must be homogenized. If you are using )
                   1592:   ( non-term orders, all elements of vectors must have the same degree with)
                   1593:   ( a proper degree shift vector.)
                   1594:   (c = [gb, backward transformation, syzygy without dehomogenization].)
                   1595:   (See gb_h.)
                   1596:   $ [(Homogenize_vec) 0] system_variable (grade) (module1v) switch_function$
                   1597:   (a : [f ];    array f;  f is a set of generators of an ideal in a ring.)
                   1598:   (a : [f v];   array f; string v;  v is the variables.)
                   1599:   (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
                   1600:   $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -h^4) ( x y Dx Dy -h^4)] (x,y) $
                   1601:   $             [ [ (Dx) 1 ] ] ] syz_h pmat ; $
                   1602:   $Example 2: [ [[(h+x) (x^3)] [(x) (x)]] (x)] syz_h pmat $
                   1603:   $Example 3: [[ [(x^2) (y+x)] [(x+y) (y^3)] $
                   1604:   $              [(2 x^2+x y) (y h^3 +x h^3 +x y^3)]] (x,y) $
                   1605:   $             [ [ (x) -1 (y) -1] ] ] syz_h pmat ; $
                   1606:   $  Infinite loop: see by [(DebugReductionRed) 1] system_variable$
                   1607:   $Example 4: [[ [(x^2) (y+x)] [(x^2+y^2) (y)] $
                   1608:   $              [(2 x^5+x y^4) (y h^3 +x h^3 +x y^3)]] (x,y) $
                   1609:   $             [ [ (x) -1 (y) -1] ] ] syz_h pmat ; $
                   1610:   $  This is fine because grade(v_1) = grade(v_2)+1 for all vectors. $
                   1611:   $Example 5:  [ [ [(0) (0)] [(0) (0)] [(x) (y)]] $
                   1612:   $              [(x) (y)]] syz pmat ;$
                   1613: ]] putUsages
                   1614:
                   1615:
                   1616: /isSameIdeal {
                   1617:   /arg1 set
                   1618:   [/in-isSameIdeal /aa /ii /jj /iigg /jjgg /vv /ans /k /n /f] pushVariables
                   1619:   [(CurrentRingp)] pushEnv
                   1620:   [
                   1621:     /aa arg1 def
                   1622:     %% comparison of hilbert series has not yet been implemented.
                   1623:     aa length 3 eq {    }
                   1624:     { ([ii jj vv] isSameIdeal) error } ifelse
1.6       takayama 1625:     gb.verbose { (Getting in isSameIdeal) message } { } ifelse
1.5       takayama 1626:     /ii aa 0 get def
                   1627:     /jj aa 1 get def
                   1628:     /vv aa 2 get def
                   1629:     ii length 0 eq jj length 0 eq and
                   1630:     { /ans 1 def /LLL.isSame goto } {  } ifelse
                   1631:     [ii vv] gb  /iigg set
                   1632:     [jj vv] gb  /jjgg set
                   1633:
                   1634:     iigg getRing ring_def
                   1635:
                   1636:     /ans 1 def
                   1637:     iigg 0 get { [ (toe_) 3 -1 roll ] gbext } map
                   1638:     /iigg set
                   1639:     jjgg 0 get { [ (toe_) 3 -1 roll ] gbext } map
                   1640:     /jjgg set
                   1641:
                   1642:     gb.verbose { ( ii < jj ?) messagen } {  } ifelse
                   1643:     iigg length /n set
                   1644:     0 1 n 1 sub {
                   1645:       /k set
                   1646:       iigg  k get
                   1647:       jjgg  reduction-noH 0 get
                   1648:       (0). eq not { /ans 0 def /LLL.isSame goto} {  } ifelse
                   1649:       gb.verbose { (o) messagen } {  } ifelse
                   1650:     } for
                   1651:     gb.verbose { ( jj < ii ?) messagen } {  } ifelse
                   1652:     jjgg length /n set
                   1653:     0 1 n 1 sub {
                   1654:       /k set
                   1655:       jjgg k get
                   1656:       iigg reduction-noH 0 get
                   1657:       (0). eq not { /ans 0 def /LLL.isSame goto} {  } ifelse
                   1658:       gb.verbose { (o) messagen } {  } ifelse
                   1659:     } for
                   1660:     /LLL.isSame
                   1661:     gb.verbose { ( Done) message } {  } ifelse
                   1662:     /arg1 ans def
                   1663:   ] pop
                   1664:   popEnv
                   1665:   popVariables
                   1666:   arg1
                   1667: } def
                   1668: (isSameIdeal ) messagen-quiet
                   1669:
                   1670: [(isSameIdeal)
                   1671: [([ii jj vv] isSameIdeal bool)
                   1672:  (ii, jj : ideal, vv : variables)
                   1673:  (Note that ii and jj will be dehomogenized and compared in the ring)
                   1674:  (of differential operators. cf. isSameIdeal_h)
                   1675:  $Example 1: [ [(x^3) (y^2)]  [(x^2+y) (y)] (x,y)] isSameIdeal $
                   1676:  $Example 2: [ [[(x^3) (0)] [(y^2) (1)]] $
                   1677:  $             [[(x^3+y^2) (1)] [(y^2) (1)]] (x,y)] isSameIdeal $
                   1678: ]] putUsages
                   1679:
                   1680: /isSameIdeal_h {
                   1681:   /arg1 set
1.6       takayama 1682:   [/in-isSameIdeal_h /aa /ii /jj /iigg /jjgg /vv /ans /k /n /f
                   1683:    /isSameIdeal_h.opt
                   1684:    ] pushVariables
                   1685:   [(CurrentRingp) (Homogenize_vec)] pushEnv
1.5       takayama 1686:   [
                   1687:     /aa arg1 def
1.6       takayama 1688:     gb.verbose { (Getting in isSameIdeal_h) message } { } ifelse
1.5       takayama 1689:     %% comparison of hilbert series has not yet been implemented.
                   1690:     aa length 3 eq {    }
                   1691:     { ([ii jj vv] isSameIdeal_h) error } ifelse
                   1692:     /ii aa 0 get def
                   1693:     /jj aa 1 get def
                   1694:     /vv aa 2 get def
                   1695:     ii length 0 eq jj length 0 eq and
                   1696:     { /ans 1 def /LLL.isSame_h goto } {  } ifelse
                   1697:
                   1698:     [ii vv] gb_h  /iigg set
                   1699:     [jj vv] gb_h  /jjgg set
                   1700:
                   1701:     iigg getRing ring_def
                   1702:
1.6       takayama 1703:     getOptions /isSameIdeal_h.opt set
                   1704:     (grade) (module1v) switch_function
                   1705:     [(Homogenize_vec) 0] system_variable
1.5       takayama 1706:     /ans 1 def
                   1707:     iigg 0 get { [ (toe_) 3 -1 roll ] gbext } map
                   1708:     /iigg set
                   1709:     jjgg 0 get { [ (toe_) 3 -1 roll ] gbext } map
                   1710:     /jjgg set
                   1711:
1.8       takayama 1712:     gb.verbose { (Comparing) message iigg message (and) message jjgg message }
                   1713:     {  } ifelse
1.5       takayama 1714:     gb.verbose { ( ii < jj ?) messagen } {  } ifelse
                   1715:     iigg length /n set
                   1716:     0 1 n 1 sub {
                   1717:       /k set
                   1718:       iigg  k get
                   1719:       jjgg  reduction 0 get
                   1720:       (0). eq not { /ans 0 def /LLL.isSame_h goto} {  } ifelse
                   1721:       gb.verbose { (o) messagen } {  } ifelse
                   1722:     } for
                   1723:     gb.verbose { ( jj < ii ?) messagen } {  } ifelse
                   1724:     jjgg length /n set
                   1725:     0 1 n 1 sub {
                   1726:       /k set
                   1727:       jjgg k get
                   1728:       iigg reduction 0 get
                   1729:       (0). eq not { /ans 0 def /LLL.isSame_h goto} {  } ifelse
                   1730:       gb.verbose { (o) messagen } {  } ifelse
                   1731:     } for
                   1732:     /LLL.isSame_h
                   1733:     gb.verbose { ( Done) message } {  } ifelse
1.6       takayama 1734:     isSameIdeal_h.opt restoreOptions
1.5       takayama 1735:     /arg1 ans def
                   1736:   ] pop
                   1737:   popEnv
                   1738:   popVariables
                   1739:   arg1
                   1740: } def
                   1741: (isSameIdeal_h ) messagen-quiet
                   1742:
                   1743: [(isSameIdeal_h)
                   1744: [([ii jj vv] isSameIdeal_h bool)
                   1745:  (ii, jj : ideal, vv : variables)
                   1746:  (Note that ii and jj will be compared in the ring)
                   1747:  (of homogenized differential operators. Each element of the vector must be)
                   1748:  (homogenized.)
                   1749:  $Example 1: [ [(x Dx - h^2) (Dx^2)]  [(Dx^3) (x Dx-h^2)] (x)] isSameIdeal_h $
                   1750:  $Example 2: [ [[(x Dx -h^2) (0)] [(Dx^2) (1)]] $
                   1751:  $       [[(x Dx -h^2) (0)] [(Dx^2) (1)] [(Dx^3) (Dx)]] (x,y)] isSameIdeal_h $
                   1752: ]] putUsages
                   1753:
                   1754:
1.1       maekawa  1755:
                   1756: ( ) message-quiet ;
                   1757:
                   1758:
                   1759:
                   1760:
                   1761:
                   1762:

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