Annotation of OpenXM/src/kan96xx/Doc/tower-sugar.sm1, Revision 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>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to tower-sugar.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc