Annotation of OpenXM/src/kan96xx/Doc/resol0.sm1, Revision 1.1
1.1 ! maekawa 1: %% lib/resol0.sm1, 1998, 11/8, 11/14, 1999, 05/18
! 2: %% cf. r-interface.sm1, tower.sm1, tower-sugar.sm1
! 3: %%
! 4: %% It must contain one-line command for resolution.
! 5: /resol0.verbose 0 def
! 6: /resol0.parse 0 def %% If 1,
! 7: %%Output of resol1 will be in a regular (non-schreyer) ring.
! 8: %% tower or tower-sugar will be chosen by the global variable
! 9: %% resol0.cp --- resol0 context pointer.
! 10: /resol0.version (2.981114) def
! 11: resol0.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: $resol0.sm1, package to construct schreyer resolutions -- not minimal $ message-quiet
! 18: $ (C) N.Takayama, 1999, 5/18. resol0, resol1 $
! 19: message-quiet
! 20:
! 21: resol0.verbose {
! 22: (Loading tower.sm1 in the context Tower and) message
! 23: (loading tower-sugar.sm1 in the context Tower-sugar.) message
! 24: } { } ifelse
! 25:
! 26: (Tower) StandardContextp newcontext /cp.Tower set
! 27: cp.Tower setcontext
! 28: [(parse) (tower.sm1) pushfile] extension pop
! 29: StandardContextp setcontext
! 30:
! 31: (Tower-sugar) StandardContextp newcontext /cp.Tower-sugar set
! 32: cp.Tower-sugar setcontext
! 33: [(parse) (tower-sugar.sm1) pushfile] extension pop
! 34: StandardContextp setcontext
! 35:
! 36: /resol0.cp cp.Tower def
! 37: /resol0.v [(x) (y) (z)] def
! 38: /resol0 {
! 39: /arg1 set
! 40: [/in-resol0 /aa /typev /setarg /f /v
! 41: /gg /wv /vec /ans /depth
! 42: ] pushVariables
! 43: [(CurrentRingp) (KanGBmessage)] pushEnv
! 44: [
! 45: /aa arg1 def
! 46: aa isArray { } { (array gb) message (resol0) usage error } ifelse
! 47: aa length 0 { (resol0) usage error } { } ifelse
! 48: aa 0 get isInteger {
! 49: aa 0 get /depth set
! 50: aa rest /aa set
! 51: }
! 52: { /depth [ ] def } ifelse
! 53:
! 54: /setarg 0 def
! 55: /wv [ ] def
! 56: aa { tag } map /typev set
! 57: typev [ ArrayP ] eq
! 58: { /f aa 0 get def
! 59: /v resol0.v def
! 60: /setarg 1 def
! 61: } { } ifelse
! 62: typev [ArrayP StringP] eq
! 63: { /f aa 0 get def
! 64: /v aa 1 get def
! 65: /setarg 1 def
! 66: } { } ifelse
! 67: typev [ArrayP ArrayP] eq
! 68: { /f aa 0 get def
! 69: /v aa 1 get from_records def
! 70: /setarg 1 def
! 71: } { } ifelse
! 72: typev [ArrayP StringP ArrayP] eq
! 73: { /f aa 0 get def
! 74: /v aa 1 get def
! 75: /wv aa 2 get def
! 76: /setarg 1 def
! 77: } { } ifelse
! 78: typev [ArrayP ArrayP ArrayP] eq
! 79: { /f aa 0 get def
! 80: /v aa 1 get from_records def
! 81: /wv aa 2 get def
! 82: /setarg 1 def
! 83: } { } ifelse
! 84:
! 85: setarg { } { (resol0 : Argument mismatch) message error } ifelse
! 86:
! 87: [(KanGBmessage) resol0.verbose ] system_variable
! 88: f 0 get isArray {
! 89: [v ring_of_differential_operators 0] define_ring
! 90: f { {toString .} map } map /f set
! 91: }{
! 92: f {toString} map /f set
! 93: } ifelse
! 94:
! 95: [resol0.cp v wv ] {tower.define_sring} sendmsg
! 96: [resol0.cp f ] {tower.tparse-vec} sendmsg /gg set
! 97: [resol0.cp depth gg] {tower.sResolution} sendmsg /ans set
! 98: /arg1 ans def
! 99: ] pop
! 100: popEnv
! 101: popVariables
! 102: arg1
! 103: } def
! 104: [(resol0)
! 105: [( [ ii v] resol0 r )
! 106: (array of poly ii; string v;)
! 107: (<< vv >> is a string of variables separated by ,)
! 108: ( )
! 109: ( [ ii v] resol0 r )
! 110: (array of poly ii; array of strings v;)
! 111: (<< vv >> is an array of variable names. )
! 112: ( )
! 113: ( [ ii v w] resol0 r )
! 114: (array of poly ii; string v; array w;)
! 115: (<< w >> is a weight vector.)
! 116: ( )
! 117: (You can also give a parameter << d >> to specify the truncation depth)
! 118: (of the resolution: [ d ii v] resol0, [d ii v w] resol0)
! 119: ( )
! 120: (resol0 constructs a resolution which is adapted (strict))
! 121: (to a filtration. So, it is not minimal.)
! 122: ( r = [starting Groebner basis g, [ s1, s2 , s3, ...], order-def].)
! 123: (g is the reduced Groebner basis for f, )
! 124: ( s1 is the syzygy of g,)
! 125: ( s2 is the syzygy of s1,)
! 126: ( s3 is the syzygy of s2 and so on.)
! 127: (For details, see math.AG/9805006)
! 128: (cf. sResolution, tparse, s_ring_..., resol0.cp)
! 129: (Example: [ [( x^3-y^2 ) ( 2 x Dx + 3 y Dy + 6 ) ( 2 y Dx + 3 x^2 Dy) ] )
! 130: ( (x,y) ] resol0 :: )
! 131: ]] putUsages
! 132:
! 133: /resol1 {
! 134: /arg1 set
! 135: [/in-resol1 /aa /typev /setarg /f /v
! 136: /gg /wv /vec /ans /depth /vectorInput
! 137: /vsize /eVector /ii /syzlist /syzlist1 /syz0 /i
! 138: ] pushVariables
! 139: [(CurrentRingp) (KanGBmessage)] pushEnv
! 140: [
! 141: /aa arg1 def
! 142: aa isArray { } { (array gb) message (resol1) usage error } ifelse
! 143: aa length 0 { (resol1) usage error } { } ifelse
! 144: aa 0 get isInteger {
! 145: aa 0 get /depth set
! 146: aa rest /aa set
! 147: }
! 148: { /depth [ ] def } ifelse
! 149:
! 150: /setarg 0 def
! 151: /wv [ ] def
! 152: aa { tag } map /typev set
! 153: typev [ ArrayP ] eq
! 154: { /f aa 0 get def
! 155: /v resol0.v def
! 156: /setarg 1 def
! 157: } { } ifelse
! 158: typev [ArrayP StringP] eq
! 159: { /f aa 0 get def
! 160: /v aa 1 get def
! 161: /setarg 1 def
! 162: } { } ifelse
! 163: typev [ArrayP ArrayP] eq
! 164: { /f aa 0 get def
! 165: /v aa 1 get from_records def
! 166: /setarg 1 def
! 167: } { } ifelse
! 168: typev [ArrayP StringP ArrayP] eq
! 169: { /f aa 0 get def
! 170: /v aa 1 get def
! 171: /wv aa 2 get def
! 172: /setarg 1 def
! 173: } { } ifelse
! 174: typev [ArrayP ArrayP ArrayP] eq
! 175: { /f aa 0 get def
! 176: /v aa 1 get from_records def
! 177: /wv aa 2 get def
! 178: /setarg 1 def
! 179: } { } ifelse
! 180:
! 181: setarg { } { (resol1 : Argument mismatch) message error } ifelse
! 182:
! 183: [(KanGBmessage) resol0.verbose ] system_variable
! 184: f 0 get isArray {
! 185: /vectorInput 1 def
! 186: /vsize f 0 get length def
! 187: } {
! 188: /vsize 1 def
! 189: /vectorInput 0 def
! 190: }ifelse
! 191:
! 192: vectorInput {
! 193: [v ring_of_differential_operators 0] define_ring
! 194: %% /eVector [0 1 vsize 1 sub { /ii set @@@.esymbol . ii npower } for ] def
! 195: %% f { {toString .} map eVector mul toString } map /f set
! 196: %%Now, sResolution in tower.sm1 accept vector input, 1999, 5/18.
! 197: f { {toString .} map } map /f set
! 198: }{
! 199: f {toString} map /f set
! 200: } ifelse
! 201:
! 202: [resol0.cp v wv ] {tower.define_sring} sendmsg
! 203: [resol0.cp f ] {tower.tparse-vec} sendmsg /gg set
! 204: resol0.verbose { gg message } { } ifelse
! 205: [resol0.cp depth gg] {tower.sResolution} sendmsg /syzlist set
! 206:
! 207: /resol1.syzlist syzlist def %% save in the global variable.
! 208: %% From restall_s.sm1
! 209: %% Reformatting the free resolution:
! 210: %% [[f1,f2,..],[syz1,...]] --> [[[f1],[f2],...],[syz,...]]
! 211: %% (to be modified for the case with more than one unknowns.)
! 212: [v ring_of_differential_operators 0] define_ring
! 213: /degmax syzlist 1 get length def
! 214: /syzlist1 [
! 215: syzlist 0 get /syz0 set
! 216: %% start N.T.
! 217: resol0.parse {
! 218: [vsize syz0 { toString . } map]
! 219: } { [vsize syz0 ] } ifelse
! 220: toVectors2
! 221: %% end N.T.
! 222: 1 1 degmax {/i set
! 223: resol0.parse {
! 224: syzlist 1 get i 1 sub get {{toString .} map } map
! 225: }{ syzlist 1 get i 1 sub get } ifelse
! 226: } for
! 227: ] def
! 228: syzlist1
! 229: /syzlist set
! 230:
! 231: /arg1 syzlist def
! 232: ] pop
! 233: popEnv
! 234: popVariables
! 235: arg1
! 236: } def
! 237: [(resol1)
! 238: [( [ ii v] resol1 r )
! 239: (array of poly ii; string v;)
! 240: (<< vv >> is a string of variables separated by ,)
! 241: ( )
! 242: ( [ ii v] resol1 r )
! 243: (array of poly ii; array of strings v;)
! 244: (<< vv >> is an array of variable names. )
! 245: ( )
! 246: ( [ ii v w] resol1 r )
! 247: (array of poly ii; string v; array w;)
! 248: (<< w >> is a weight vector.)
! 249: ( )
! 250: ( ii may be array of array of poly.)
! 251: (You can also give a parameter << d >> to specify the truncation depth)
! 252: (of the resolution: [ d ii v] resol1, [d ii v w] resol1)
! 253: ( )
! 254: (resol1 constructs a resolution which is adapted (strict))
! 255: (to a filtration. So, it is not minimal in general.)
! 256: ( r = [s0, s1, s2 , s3, ...].)
! 257: ( s0 is the groebner basis of ii,)
! 258: ( s1 is the syzygy of s0,)
! 259: ( s2 is the syzygy of s1,)
! 260: ( s3 is the syzygy of s2 and so on.)
! 261: ( s1 s0 mul ==> 0, s2 s1 mul ==>0, ...)
! 262: (For details, see math.AG/9805006)
! 263: (cf. sResolution, tparse, s_ring_..., resol0.cp)
! 264: (resol1.withZeroMap returns a resolution with zero maps of the both sides)
! 265: ( of the resolution.)
! 266: (cf. resol1.zeroMapL, resol1.zeroMapR, resol1.withZeroMap.aux)
! 267: (resol1.syzlist : global variable to keep the raw output of sResolution.)
! 268: ( )
! 269: (Example 1: [ [( x^3-y^2 ) ( 2 x Dx + 3 y Dy + 6 ) ( 2 y Dx + 3 x^2 Dy) ] )
! 270: ( (x,y) ] resol1 pmat ; )
! 271: (Example 2: [ [( x^3-y^2 ) ( 2 x Dx + 3 y Dy + 6 ) ( 2 y Dx + 3 x^2 Dy) ] )
! 272: ( (x,y) [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] resol1 pmat ; )
! 273: (Example 3: [ [[(2 x Dx + 3 y Dy +6) (0)] )
! 274: ( [(3 x^2 Dy + 2 y Dx) (0)] )
! 275: ( [(0) (x^2+y^2)] )
! 276: ( [(0) (x y )] ] )
! 277: ( (x,y) [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] resol1 pmat ; )
! 278: (Example 4: /resol0.verbose 1 def)
! 279: $ [ [[(x^2+y^2+ x y) (x+y)] [(x y ) ( x^2 + x y^3)] ] (x,y) $
! 280: $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] resol1 pmat ; $
! 281: ]] putUsages
! 282:
! 283: /resol1.withZeroMap {
! 284: resol1 resol1.withZeroMap.aux
! 285: } def
! 286: /resol1.withZeroMap.aux {
! 287: /arg1 set
! 288: [/in-resol1.withZeroMap.aux /ss /nn /mm] pushVariables
! 289: [
! 290: /ss arg1 def
! 291: ss 0 get length /mm set
! 292: ss 0 get 0 get isArray {
! 293: /nn ss 0 get 0 get length def
! 294: } { /nn 1 def } ifelse
! 295: [ [nn mm] resol1.zeroMapR]
! 296: ss join
! 297: /ss set
! 298:
! 299: ss ss length 1 sub get [ ] eq {
! 300: ss << ss length 1 sub >>
! 301: << ss << ss length 2 sub >> get >> length resol1.zeroMapL put
! 302: } { } ifelse
! 303: /arg1 ss def
! 304: ] pop
! 305: popVariables
! 306: arg1
! 307: } def
! 308:
! 309: /resol1.zeroMapR {
! 310: %% [[0,0],
! 311: %% [0,0],
! 312: %% [0,0]]
! 313: /arg1 set
! 314: [/in-resol1.zeroMapR /mm /nn] pushVariables
! 315: [
! 316: /mm arg1 0 get def
! 317: /nn arg1 1 get def
! 318: [ 1 1 mm { pop [1 1 nn { pop (0).} for] } for ]
! 319: /arg1 set
! 320: ] pop
! 321: popVariables
! 322: arg1
! 323: } def
! 324: /resol1.zeroMapL {
! 325: %% [[0,0,0]]
! 326: /arg1 set
! 327: [/in-resol1.zeroMapL /mm ] pushVariables
! 328: [
! 329: /mm arg1 def
! 330: [ [1 1 mm { pop (0). } for ]]
! 331: /arg1 set
! 332: ] pop
! 333: popVariables
! 334: arg1
! 335: } def
! 336:
! 337: /pres1 {
! 338: /arg1 set
! 339: [/in-pres1 /rr /i /nn] pushVariables
! 340: [
! 341: /rr arg1 def
! 342: /nn rr length 1 sub def
! 343: 0 1 nn {
! 344: /i set
! 345: rr i get [ ] eq { /pres1.LLL goto } { } ifelse
! 346: (k^) messagen rr i get 0 get length message
! 347: (^) message
! 348: (|) message
! 349: rr i get pmat
! 350: (|) message
! 351: } for
! 352: /pres1.LLL
! 353: ] pop
! 354: popVariables
! 355: arg1
! 356: } def
! 357: [(pres1)
! 358: [(rr pres1)
! 359: (print resolution rr.)
! 360: $Example $
! 361: $ [ [[(x^2+y^2+ x y) (x+y)] [(x y ) ( x^2 + x y^3)] ] (x,y) $
! 362: $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] resol1.withZeroMap pres1 ; $
! 363: ]] putUsages
! 364:
! 365:
! 366:
! 367: %% It is included to work on the older version. It may removed.
! 368: %% toVectors2 is already in dr.sm1
! 369: (2.990500) [(Version)] system_variable gt
! 370: {
! 371: /toVectors2 {
! 372: /arg1 set
! 373: [/in-toVectors2 /gg /ans /n /tmp] pushVariables
! 374: [
! 375: /gg arg1 def
! 376: /ans gg 1 get toVectors def
! 377: /n gg 0 get def
! 378: ans {
! 379: /tmp set
! 380: tmp length n lt {
! 381: tmp
! 382: [1 1 n tmp length sub { pop (0). } for ]
! 383: join /tmp set
! 384: } { } ifelse
! 385: tmp
! 386: } map
! 387: /ans set
! 388: /arg1 ans def
! 389: ] pop
! 390: popVariables
! 391: arg1
! 392: } def
! 393: } { } ifelse
! 394:
! 395: resol0.cp setcontext
! 396: /tower.define_sring {
! 397: /arg1 set
! 398: [/in-tower.define_sring /vv /ww /r] pushVariables
! 399: [
! 400: /vv arg1 1 get def
! 401: /ww arg1 2 get def
! 402: ww [ ] eq {
! 403: [vv s_ring_of_differential_operators 0 [(schreyer) 1]] define_ring
! 404: } {
! 405: [vv s_ring_of_differential_operators ww s_weight_vector
! 406: 0 [(schreyer) 1]] define_ring
! 407: } ifelse
! 408: /r set
! 409: /arg1 r def
! 410: ] pop
! 411: popVariables
! 412: arg1
! 413: } def
! 414:
! 415: /tower.tparse-vec {
! 416: /arg1 set
! 417: [/in-tower.tparse-vec /ff ] pushVariables
! 418: [
! 419: arg1 1 get /ff set
! 420: ff 0 get isArray {
! 421: ff {{tparse} map} map /ff set
! 422: } {
! 423: ff {tparse} map /ff set
! 424: } ifelse
! 425: /arg1 ff def
! 426: ] pop
! 427: popVariables
! 428: arg1
! 429: } def
! 430:
! 431: /tower.sResolution {
! 432: resol0.verbose {
! 433: /tower.verbose 1 def
! 434: } { } ifelse
! 435: rest aload pop sResolution
! 436: } def
! 437: StandardContextp setcontext
! 438:
! 439: /test00 {
! 440: /resol0.verbose 1 def
! 441: [ [[(x^2+y^2+ x y) (x+y)] [(x y ) ( x^2 + x y^3)] ] (x,y) [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] resol1 /ff set
! 442: } def
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>