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

Annotation of OpenXM/src/kan96xx/Doc/tower.sm1, Revision 1.2

1.2     ! takayama    1: %% $OpenXM$
1.1       maekawa     2: %% It is used to check the mmLarger_tower,  1997, 10/26 at Heidelberg.
                      3: %% It is used to check the mmLarger_tower,  1997, 10/27 -- 29 at Oberwolfach.
                      4: %% 1997, 11/7   s_ring_of_differential_operators  at Kobe
                      5: %% 1998, 1/28   Homogenize_vec = 0;
                      6: %% 1998, 11/5   Doc/tower.sm1
                      7: %%
                      8: %% tower.sm1 is kept in this directory for the compatibility to
                      9: %% old demo programs and packages.  It is being merged to
                     10: %%     resol0.sm1        cf. r-interface.sm1, tower.sm1, tower-sugar.sm1
                     11: %%
                     12: /tower.version (2.981105) def
                     13: tower.version [(Version)] system_variable gt
                     14: { (This package requires the latest version of kan/sm1) message
                     15:   (Please get it from http://www.math.kobe-u.ac.jp/KAN) message
                     16:   error
                     17: } { } ifelse
                     18:
                     19: /debug.res0 0 def
                     20: /debug.sResolution 0 def
                     21: /stat.tower 0 def
                     22: /tower.verbose 0 def
                     23: %(tower-test.sm1) run
                     24: tower.verbose
                     25: { (Doc/tower.sm1 is still under construction.) message } { } ifelse
                     26:
                     27: [(sResolution)
                     28:  [( sResolution constructs the Schreyer resolution.)
                     29:   ( depth f sResolution r   where )
                     30:   ( r = [starting Groebner basis g, [ s1, s2 , s3, ...], order-def].)
                     31:   ( g is the reduced Groebner basis for f, )
                     32:   ( s1 is the syzygy of f,)
                     33:   ( s2 is the syzygy of s1,)
                     34:   ( s3 is the syzygy of s2 and so on.)
                     35:   (Note that es and ES are reserved for schreyer ordering.)
                     36:   (Note also that schreyer order causes troubles for other computations)
                     37:   (except sResolution in kan/sm1.)
                     38:   (Example:)
                     39:   $  [(x,y) s_ring_of_differential_operators$
                     40:   $   [[(Dx) 1 (x) -1]] s_weight_vector$
                     41:   $   0 [(schreyer) 1]] define_ring$
                     42:   $   $
                     43:   $  [( x^3-y^2 ) tparse$
                     44:   $   ( 2 x Dx + 3 y Dy + 6 ) tparse$
                     45:   $   ( 2 y Dx + 3 x^2 Dy) tparse$
                     46:   $  ] sResolution /ans set ; $
                     47:  ]] putUsages
                     48:
                     49: /offTower {
                     50:   [(AvoidTheSameRing)] pushEnv
                     51:   [ [(AvoidTheSameRing) 0] system_variable
                     52:     [(gbListTower) [[ ]] (list) dc] system_variable
                     53:   ] pop popEnv
                     54: } def
                     55:
                     56:
                     57: /tparse {
                     58:   /arg1 set
                     59:   [/f /ans /fhead /val] pushVariables
                     60:   [
                     61:     /f arg1 def
                     62:     (report) (mmLarger) switch_function /val set
                     63:     f isString {  }  { f toString /f set } ifelse
                     64:     (mmLarger) (matrix) switch_function
                     65:     f expand /f set
                     66:     [(AvoidTheSameRing)] pushEnv [ [(AvoidTheSameRing) 0] system_variable (mmLarger) (tower) switch_function ] pop popEnv
                     67:     /ans  (0). def
                     68:     {
                     69:       f (0). eq {exit} { } ifelse
                     70:      (mmLarger) (matrix) switch_function
                     71:       f init /fhead set f fhead sub /f set
                     72:      [(AvoidTheSameRing)] pushEnv [ [(AvoidTheSameRing) 0] system_variable (mmLarger) (tower) switch_function ] pop popEnv
                     73:       ans fhead add /ans set
                     74:     } loop
                     75:     (mmLarger) val switch_function
                     76:     /arg1 ans def
                     77:   ] pop
                     78:   popVariables
                     79:   arg1
                     80: } def
                     81:
                     82:
                     83: /toes {
                     84:   %% [x+2, y x ] ===> x + 2 + y x es (sorted by the schreyer order.)
                     85:   /arg1 set
                     86:   [/vec] pushVariables
                     87:   [
                     88:     /vec arg1 def
                     89:     vec isPolynomial { /vec [vec] def } {  } ifelse
                     90:     [(toes) vec] gbext /arg1 set
                     91:   ] pop
                     92:   popVariables
                     93:   arg1
                     94: } def
                     95:
                     96: /toE {
                     97:   %% [x+2, y x ] ===> x e + 2 e + y s e (sorted by the schreyer order.)
                     98:   /arg1 set
                     99:   [/n /vec /oures /i /ppp] pushVariables
                    100:   [
                    101:     /vec arg1 def
                    102:     /oures @@@.esymbol . def
                    103:     vec isPolynomial { /vec [vec] def } { } ifelse
                    104:     vec isArray
                    105:     { } {(error: vec toE, vec must be an array) message error} ifelse
                    106:     /n vec length def
                    107:     0 1 n 1 sub
                    108:     { /i set
                    109:       vec i get oures degree  0 eq
                    110:       {  }
                    111:       {(error: vec toE, vec must not contain the variable e) message error}
                    112:       ifelse
                    113:     } for
                    114:
                    115:     [ 0 1 n 1 sub { /i set oures i power } for ] /ppp set
                    116:     %% ppp message
                    117:     vec ppp mul /arg1 set
                    118:   ] pop
                    119:   popVariables
                    120:   arg1
                    121: } def
                    122:
                    123: /res0 {
                    124:   /arg1 set
                    125:   [/g /t.syz /nexttower /m /t.gb /skel /betti  /gg
                    126:    /k /i /j /pair  /tmp  /si /sj /grG /syzAll] pushVariables
                    127:   [
                    128:     /g arg1 def  %% g = [g_1, ..., g_m] g_i does not contain h and es.
                    129:     [(Homogenize)] system_variable 0 eq
                    130:     { tower.verbose {
                    131:         (Warning: Homogenization option is automatically turned on. ReduceLowerTerms = 1) message
                    132:       } {  } ifelse
                    133:       [(Homogenize) 1] system_variable
                    134:       [(ReduceLowerTerms) 1] system_variable
                    135:     } {  } ifelse
                    136:     g length 0 eq { (error: [ ] argument to res0.) message error } { } ifelse
                    137:     g { toes } map /g set
                    138:     stat.tower { (Size of g is ) messagen  g length messagen } { } ifelse
                    139:     stat.tower { (, sizes of each element in g are ) messagen
                    140:            g { length } map message } { } ifelse
                    141:     debug.res0 {(es expression of g: ) messagen g message } { } ifelse
                    142:     stat.tower { (Computing the skelton.) message } { } ifelse
                    143:     [(schreyerSkelton) g] gbext /skel set
                    144:     /betti skel length def
                    145:     stat.tower { (Done. Number of skelton is ) messagen betti message } { } ifelse
                    146:
                    147:     debug.res0
                    148:       { (init of original g : ) messagen g {init} map  message
                    149:         (length of skelton ) messagen betti message
                    150:         (schreyerSkelton g : ) messagen skel message
                    151:         (Doing reduction ) messagen
                    152:       } { } ifelse
                    153:
                    154:     %(red@) (debug) switch_function
                    155:     %(red@) (module1v) switch_function
                    156:
                    157:     /grG g (gradedPolySet) dc def
                    158:     [ 0 1 betti 1 sub { pop 0 } for ] /syzAll set
                    159:      0 1 betti 1 sub {
                    160:        /k set
                    161:        [
                    162:        /pair skel  k get def
                    163:        pair 0 get 0 get /i set
                    164:        pair 0 get 1 get /j set
                    165:        pair 1 get 0 get /si set
                    166:        pair 1 get 1 get        /sj set
                    167:        si  g  i get mul
                    168:        sj  g  j get mul  add
                    169:        grG reduction /tmp set  % si g[i] + sj g[j] + \sum tmp[2][k] g[k] = 0.
                    170:        tmp 0 get (0). eq {
                    171:            tower.verbose { (.) messagen  [(flush)] extension pop } { } ifelse
                    172:        }
                    173:        {
                    174:          (Error: the result of resolution is not zero) message
                    175:          ( [i,j], [si,sj] = ) messagen [ [ i j ] [si sj ]] message
                    176:          error
                    177:        } ifelse
                    178:        /t.syz tmp 2 get def
                    179:        << tmp 1 get >> si  mul << t.syz i get >> add /si set
                    180:        << tmp 1 get >> sj  mul << t.syz j get >> add /sj set
                    181:        t.syz i si put
                    182:        t.syz j sj put
                    183:        ] pop
                    184:        syzAll k t.syz put
                    185:      } for
                    186:
                    187:      /t.syz syzAll def
                    188:      tower.verbose {
                    189:       ( Done. betti=) messagen  betti message
                    190:      } {  } ifelse
                    191:
                    192:     /nexttower g {init } map def
                    193:     /arg1 [t.syz nexttower] def
                    194:   ] pop
                    195:   popVariables
                    196:   arg1
                    197: } def
                    198:
                    199: /sResolution {
                    200:   /arg1 set
                    201:   /arg2 set  %% optional parameter.
                    202:   [/g  /gbTower /ans /ff /opt /count /startingGB /opts /vectorInput
                    203:   ] pushVariables
                    204:   [ /g arg1 def
                    205:     /opt arg2 def
                    206:
                    207:     setupEnvForResolution
                    208:
                    209:     /count -1 def
                    210:     %% optional parameter.
                    211:     opt isInteger {
                    212:       /count opt def
                    213:     } {  } ifelse
                    214:
                    215:     (mmLarger) (matrix) switch_function
                    216:     %% new code of 1999, 5/18
                    217:     g 0 get isArray {
                    218:        /vectorInput 1 def
                    219:     } {
                    220:        /vectorInput 0 def
                    221:     } ifelse
                    222:     vectorInput {
                    223:       tower.verbose { (tower.sm1: Vector input is homogenized : ) message
                    224:                       [g { sHomogenize2 } map ] message } { } ifelse
                    225:       [g { sHomogenize2 } map ] groebner 0 get /g set
                    226:     } {
                    227:       tower.verbose { (tower.sm1: Homogenize the scalar input : ) message
                    228:                       [g {sHomogenize} map ] message } { } ifelse
                    229:       [g {sHomogenize} map ] groebner 0 get  /g set
                    230:     } ifelse
                    231:
                    232:
                    233:     /startingGB g def
                    234:     debug.sResolution
                    235:     {
                    236:      (g is ) messagen g message
                    237:      (---------------------------------------------------) message
                    238:     } { } ifelse
                    239:     /ans [ ] def
                    240:     % /gbTower [g {init} map  ] def
                    241:     /gbTower [  ] def
                    242:     [(AvoidTheSameRing)] pushEnv [ [(AvoidTheSameRing) 0] system_variable (mmLarger) (tower) switch_function ] pop popEnv
                    243:     {
                    244:       g res0 /ff set
                    245:       ans ff 0 get append /ans set %% store the syzygy.
                    246:       debug.sResolution
                    247:       {
                    248:        (Syzygy : ) messagen ff 0 get message
                    249:        (----------------------------------------------------) message
                    250:       } { } ifelse
                    251:       [ff 1 get] gbTower  join /gbTower set
                    252:       /g  ff 0 get def
                    253:       g length 0 eq { exit } { } ifelse
                    254:
                    255:       [(AvoidTheSameRing)] pushEnv
                    256:       [ [(AvoidTheSameRing) 0] system_variable
                    257:         [(gbListTower) gbTower (list) dc] system_variable
                    258:       ] pop popEnv
                    259:
                    260:       count 0 eq { (Resolution procedure stoped because counter == 0.) message
                    261:                     exit }
                    262:       { } ifelse
                    263:       count 1 sub /count set
                    264:
                    265:
                    266:      } loop
                    267:
                    268:      restoreEnvAfterResolution
                    269:
                    270:      /arg1 [startingGB ans gbTower] def
                    271:   ] pop
                    272:   popVariables
                    273:   arg1
                    274: } def
                    275:
                    276: /sHomogenize {
                    277:   /arg1 set
                    278:   [/ff ] pushVariables
                    279:   [
                    280:     /ff arg1 def
                    281:     ff homogenize
                    282:     toString tparse   %% homogenization may destroy the order.
                    283:                       %%   cf. 97feb4.txt 1997, 10/29
                    284:     /arg1 set
                    285:   ] pop
                    286:   popVariables
                    287:   arg1
                    288: } def
                    289:
                    290: /sHomogenize2 {
                    291:   /arg1 set
                    292:   [/ff /vectorInput /f2deg /f2 /tt /f2max /ttdeg] pushVariables
                    293:   [
                    294:     /ff arg1 def
                    295:     ff isArray{
                    296:       ff homogenize /f2 set
                    297:       f2 {toString tparse} map /f2 set
                    298:       f2 {/tt set [(grade) tt] gbext} map /f2deg set
                    299:       [-1] f2deg join shell reverse 0 get /f2max set
                    300:       f2 { /tt set [(grade) tt] gbext /ttdeg set
                    301:            tt [@@@.hsymbol (^) f2max ttdeg sub toString] cat . mul
                    302:       } map
                    303:     } {
                    304:       ff homogenize
                    305:       toString tparse   %% homogenization may destroy the order.
                    306:                         %%   cf. 97feb4.txt 1997, 10/29
                    307:     } ifelse
                    308:     /arg1 set
                    309:   ] pop
                    310:   popVariables
                    311:   arg1
                    312: } def
                    313:
                    314:
                    315:
                    316: /s_ring_of_differential_operators {
                    317:   /arg1 set
                    318:   [/vars /n /i /xList /dList /param] pushVariables
                    319:   [
                    320:      (mmLarger) (matrix) switch_function
                    321:      (mpMult)   (diff) switch_function
                    322:      (red@)     (module1) switch_function
                    323:      (groebner) (standard) switch_function
                    324:      (grade) (module1v) switch_function
                    325:      (isSameComponent) (x) switch_function
                    326:
                    327:      [arg1 to_records pop] /vars set %[x y z]
                    328:      vars reverse /xList set         %[z y x]
                    329:      vars {@@@.Dsymbol 2 1 roll 2 cat_n} map
                    330:      reverse /dList set              %[Dz Dy Dx]
                    331:      [(H)] xList join [(es) @@@.esymbol ] join /xList set
                    332:     %% You cannot change the order of es and e, because
                    333:     %% mmLarger_tower automatically assumes es is at the bottom
                    334:     %% of [nn,n-1] variables.
                    335:      [(h)] dList join [(ES) @@@.Esymbol ] join /dList set
                    336:      [0 1 1 1 << xList length >>
                    337:         1 1 1 << xList length 2 sub >> ] /param set
                    338:      [ xList dList param ] /arg1 set
                    339:   ] pop
                    340:   popVariables
                    341:   arg1
                    342: } def
                    343:
                    344: /s_weight_vector {
                    345:   /arg2 set  /arg1 set
                    346:   [/vars /univ /w-vectors /www /k /order1 /order2] pushVariables
                    347:   /vars arg1 def /w-vectors arg2 def
                    348:   [
                    349:     /univ vars 0 get reverse
                    350:           vars 1 get reverse join
                    351:     def
                    352:     [
                    353:     0 1 << w-vectors length 1 sub >>
                    354:     {
                    355:       /k set
                    356:       univ w-vectors k get w_to_vec
                    357:     } for
                    358:     ] /order1 set
                    359:     %% order1 ::
                    360:
                    361:     vars s_reverse_lex_order 3 get /order2 set
                    362:     vars [ << order1 order2 join >> ] join /arg1 set
                    363:   ] pop
                    364:   popVariables
                    365:   arg1
                    366: } def
                    367:
                    368: /s_reverse_lex_order {
                    369: %% [x-list d-list params]  elimination_order
                    370: %%  vars
                    371: %% [x-list d-list params order]
                    372:    /arg1 set
                    373:   [/vars /univ /order /perm /univ0 /compl] pushVariables
                    374:   /vars arg1 def
                    375:   [
                    376:     /univ vars 0 get reverse
                    377:           vars 1 get reverse join
                    378:     def
                    379:
                    380:     << univ length 3 sub >>
                    381:     0
                    382:     eliminationOrderTemplate /order set
                    383:
                    384:     [[1]] [[1]] oplus order oplus [[1]] oplus /order set
                    385:
                    386:     vars [order] join /arg1 set
                    387:   ] pop
                    388:   popVariables
                    389:   arg1
                    390: } def
                    391:
                    392:
                    393: /setupEnvForResolution {
                    394:     getOptions /opts set
                    395:     [(Homogenize_vec)] system_variable 1 eq
                    396:     {  [(Homogenize_vec) 0] system_variable
                    397:       (grade) (module1v) switch_function
                    398:       tower.verbose {
                    399:          (Homogenize_vec is automatically set to 0. grade is set to module1v) message
                    400:       } { } ifelse
                    401:     } {  } ifelse
                    402:
                    403:    [(Schreyer)] system_variable 1 eq
                    404:    {   }
                    405:    {(Error: You can compute resolutions only in the ring defined with) message
                    406:     $the [(schreyer) 1] option.  cf. s_ring_of_differential_operators$ message
                    407:     error
                    408:    } ifelse
                    409:
                    410:    (report) (mmLarger) switch_function (tower) eq
                    411:    {   }
                    412:    { tower.verbose {
                    413:          $Warning: (mmLarger) (tower) switch_function is executed.$ message
                    414:      } { } ifelse
                    415:      [(AvoidTheSameRing)] pushEnv [ [(AvoidTheSameRing) 0] system_variable (mmLarger) (tower) switch_function ] pop popEnv
                    416:    } ifelse
                    417:
                    418: } def
                    419:
                    420: /restoreEnvAfterResolution {
                    421:   [(AvoidTheSameRing)] pushEnv
                    422:   [ [(AvoidTheSameRing) 0] system_variable
                    423:     [(gbListTower) [[ ]] (list) dc] system_variable
                    424:   ] pop popEnv
                    425:   opts restoreOptions
                    426: } def
                    427:
                    428: %%%%%  1998, 4/11. To get frame for homogenized resolutions.
                    429: /sResolutionFrame {
                    430:   /arg1 set
                    431:   /arg2 set  %% optional parameter.
                    432:   [/g  /gbTower /ans /ff /opt /count /startingGB /opts] pushVariables
                    433:   [ /g arg1 def
                    434:     /opt arg2 def
                    435:
                    436:
                    437:     stat.tower {  [(Statistics) 1] system_variable } {  } ifelse
                    438:     /count -1 def
                    439:     %% optional parameter.
                    440:     opt isInteger {
                    441:       /count opt def
                    442:     } {  } ifelse
                    443:
                    444:     (mmLarger) (matrix) switch_function
                    445:     [g {sHomogenize} map ] groebner  0 get /g set
                    446:     g { init } map /g set
                    447:
                    448:     setupEnvForResolution-sugar
                    449:
                    450:     /startingGB g def
                    451:     debug.sResolution
                    452:     {
                    453:      (g is ) messagen g message
                    454:      (---------------------------------------------------) message
                    455:     } { } ifelse
                    456:     /ans [ ] def
                    457:     % /gbTower [g {init} map  ] def
                    458:     /gbTower [  ] def
                    459:     [(AvoidTheSameRing)] pushEnv [ [(AvoidTheSameRing) 0] system_variable (mmLarger) (tower) switch_function ] pop popEnv
                    460:     {
                    461:       g res0Frame /ff set
                    462:       ans ff 0 get append /ans set %% store the syzygy.
                    463:       debug.sResolution
                    464:       {
                    465:        (Syzygy : ) messagen ff 0 get message
                    466:        (----------------------------------------------------) message
                    467:       } { } ifelse
                    468:       [ff 1 get] gbTower  join /gbTower set
                    469:       /g  ff 0 get def
                    470:       g length 0 eq { exit } { } ifelse
                    471:
                    472:       [(AvoidTheSameRing)] pushEnv
                    473:       [ [(AvoidTheSameRing) 0] system_variable
                    474:         [(gbListTower) gbTower (list) dc] system_variable
                    475:       ] pop popEnv
                    476:
                    477:       count 0 eq { (Resolution prodecure stoped because counter == 0.) message
                    478:                     exit }
                    479:       { } ifelse
                    480:       count 1 sub /count set
                    481:
                    482:
                    483:      } loop
                    484:
                    485:      restoreEnvAfterResolution-sugar
                    486:
                    487:      /arg1 [startingGB ans  gbTower] def
                    488:   ] pop
                    489:   popVariables
                    490:   arg1
                    491: } def
                    492:
                    493: /newPolyVector {
                    494:   /arg1 set
                    495:   /arg2 (0). def
                    496:   [ 1 1 arg1 { pop arg2 } for ]
                    497: } def
                    498:
                    499: /res0Frame {
                    500:   /arg1 set
                    501:   [/g /t.syz /nexttower /m /t.gb /skel /betti  /gg
                    502:    /k /i /j /pair  /tmp  /si /sj /grG /syzAll /gLength] pushVariables
                    503:   [
                    504:     /g arg1 def  %% g = [g_1, ..., g_m] g_i does not contain h and es.
                    505:     [(Homogenize)] system_variable 1 eq
                    506:     { (Warning: Homogenization and ReduceLowerTerms options are automatically turned off.) message
                    507:       [(Homogenize) 0] system_variable
                    508:       [(ReduceLowerTerms) 0] system_variable
                    509:     } {  } ifelse
                    510:     g length 0 eq { (error: [ ] argument to res0.) message error } { } ifelse
                    511:     g { toes } map /g set
                    512:     stat.tower { (Size of g is ) messagen  g length messagen } { } ifelse
                    513:     stat.tower { (, sizes of each element in g are ) messagen
                    514:            g { length } map message } { } ifelse
                    515:     debug.res0 {(es expression of g: ) messagen g message } { } ifelse
                    516:     stat.tower { (Computing the skelton.) message } { } ifelse
                    517:     [(schreyerSkelton) g] gbext /skel set
                    518:     /betti skel length def
                    519:     stat.tower { (Done. Number of skelton is ) messagen betti message } { } ifelse
                    520:
                    521:     debug.res0
                    522:       { (init of original g : ) messagen g {init} map  message
                    523:         (length of skelton ) messagen betti message
                    524:         (schreyerSkelton g : ) messagen skel message
                    525:         (Doing reduction ) messagen
                    526:       } { } ifelse
                    527:
                    528:     g length /gLength set
                    529:     /grG g (gradedPolySet) dc def
                    530:     [ 0 1 betti 1 sub { pop 0 } for ] /syzAll set
                    531:      0 1 betti 1 sub {
                    532:        /k set
                    533:        [
                    534:        /pair skel  k get def
                    535:        pair 0 get 0 get /i set
                    536:        pair 0 get 1 get /j set
                    537:        pair 1 get 0 get /si set
                    538:        pair 1 get 1 get        /sj set
                    539:        % si g[i] + sj g[j] + \sum tmp[2][k] g[k] = 0.
                    540:        (.) messagen  [(flush)] extension pop
                    541:
                    542:        /t.syz gLength newPolyVector def
                    543:        t.syz i si put
                    544:        t.syz j sj put
                    545:        ] pop
                    546:        syzAll k t.syz put
                    547:      } for
                    548:
                    549:      /t.syz syzAll def
                    550:     ( Done. betti=) messagen  betti message
                    551:
                    552:
                    553:     /nexttower g {init } map def
                    554:     /arg1 [t.syz nexttower] def
                    555:     %% clear all unnecessary variables to save memory.
                    556:     /g 0 def /t.syz 0 def /nexttower 0 def /t.gb 0 def /skel 0 def /gg 0 def
                    557:     /k 0 def /tmp 0 def /grG 0 def /syzAll 0 def
                    558:   ] pop
                    559:   popVariables
                    560:   arg1
                    561: } def
                    562:
                    563: /s_ring_of_polynomials {
                    564:   /arg1 set
                    565:   [/vars /n /i /xList /dList /param] pushVariables
                    566:   [
                    567:      (mmLarger) (matrix) switch_function
                    568:      (mpMult)   (poly) switch_function
                    569:      (red@)     (module1) switch_function
                    570:      (groebner) (standard) switch_function
                    571:      (isSameComponent) (x) switch_function
                    572:
                    573:      [arg1 to_records pop] /vars set
                    574:      vars length evenQ
                    575:      { }
                    576:      { vars [(PAD)] join /vars set }
                    577:      ifelse
                    578:      vars length 2 idiv /n set
                    579:      [ << n 1 sub >> -1 0
                    580:           { /i set
                    581:             vars i get
                    582:           } for
                    583:      ] /xList set
                    584:      [ << n 1 sub >> -1 0
                    585:           { /i set
                    586:             vars << i n add >> get
                    587:           } for
                    588:      ] /dList set
                    589:
                    590:      [(H)] xList join [(es) @@@.esymbol ] join /xList set
                    591:      %% You cannot change the order of es and e, because
                    592:      %% mmLarger_tower automatically assumes es is at the bottom
                    593:      %% of [nn,n-1] variables.
                    594:      [(h)] dList join [(ES) @@@.Esymbol ] join /dList set
                    595:      [0 %% dummy characteristic
                    596:       << xList length 2 sub >> << xList length 2 sub >>
                    597:       << xList length 2 sub >> << xList length >>
                    598:      %%    c  l   m   n
                    599:       << xList length 2 sub >> << xList length 2 sub >>
                    600:       << xList length 2 sub >> << xList length 2 sub >>
                    601:      %%   cc  ll  mm  nn    es must belong to differential variables.
                    602:      ] /param set
                    603:      [xList dList param] /arg1 set
                    604:   ] pop
                    605:   popVariables
                    606:   arg1
                    607: } def
                    608:
                    609: /setupEnvForResolution-sugar {
                    610:    getOptions /opts set
                    611:    [(Homogenize)] system_variable 1 eq
                    612:    { (Warning: Homogenization and ReduceLowerTerms options are automatically turned off.) message
                    613:      [(Homogenize) 0] system_variable
                    614:      [(ReduceLowerTerms) 0] system_variable
                    615:    } {  } ifelse
                    616:
                    617:    [(Schreyer)] system_variable 1 eq
                    618:    {   }
                    619:    {(Error: You can compute resolutions only in the ring defined with) message
                    620:     $the [(schreyer) 1] option.  cf. s_ring_of_differential_operators$ message
                    621:     error
                    622:    } ifelse
                    623:
                    624:    (report) (mmLarger) switch_function (tower) eq
                    625:    {   }
                    626:    { $Warning: (mmLarger) (tower) switch_function is executed.$ message
                    627:      [(AvoidTheSameRing)] pushEnv [ [(AvoidTheSameRing) 0] system_variable (mmLarger) (tower) switch_function ] pop popEnv
                    628:    } ifelse
                    629:
                    630: } def
                    631:
                    632: /restoreEnvAfterResolution-sugar {
                    633:   %% Turn off tower by (mmLarger) (tower)  switch_function
                    634:   %% and clear the tower of orders by [(gbListTower) [[]] (list) dc] system_variable
                    635:   [(AvoidTheSameRing)] pushEnv
                    636:   [ [(AvoidTheSameRing) 0] system_variable
                    637:     [(gbListTower) [[]] (list) dc] system_variable
                    638:   ] pop popEnv
                    639:   opts restoreOptions
                    640: } def
                    641:
                    642:

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