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

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

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