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

Annotation of OpenXM/src/kan96xx/Doc/tower-sugar.sm1, Revision 1.1.1.1

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

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