Annotation of OpenXM/src/kan96xx/Doc/complex.sm1, Revision 1.1
1.1 ! maekawa 1: %% lib/complex.sm1 [ functions for complex ], 1999, 9/9
! 2: %% cf. yama:1999/Int/uli.sm1
! 3: %%%%%%%%%%%%%%%%%%% commands %%%%%%%%%%%%%%%%%%%%%%%%%
! 4: %%% res-div, res-solv, res-kernel-image, res-dual
! 5: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
! 6: [(complex.sm1 : 1999, 9/28, res-div, res-solv, res-kernel-image, res-dual )
! 7: (In this package, complex is expressed in terms of matrices.)
! 8: ] {message} map
! 9: /uli.verbose 0 def
! 10: /uli.weight [(x) -1 (y) -1 (Dx) 1 (Dy) 1] def
! 11:
! 12: %%% M = [M_1, ..., M_p], M_i has the length q
! 13: %%% D^p (row vector) --- M ---> D^q (row vector), v --> v M
! 14: %%% In this package (res-***), all data are expressed by matrices.
! 15: /res-nextShift {
! 16: /arg1 set
! 17: [/in-nextShift /f /mm /m /p /q /i /fi] pushVariables
! 18: [
! 19: /f arg1 0 get def
! 20: /mm arg1 1 get def
! 21: %% D^p[m] ---f---> D^q[mm] [f mm] nextShift m
! 22: /p f length def
! 23: [1 1 p { pop 0 } for] /m set
! 24: 0 1 p 1 sub {
! 25: /i set
! 26: /fi f i get def
! 27: m i << mm fi { uli.weight ord_w } map add maxInArray >> put
! 28: } for
! 29: /arg1 m def
! 30: ] pop
! 31: popVariables
! 32: arg1
! 33: } def
! 34:
! 35: [(res-nextShift)
! 36: [([f mm] nextShift m)
! 37: $Example: [(x,y) ring_of_differential_operators 0] define_ring$
! 38: $ [ [ [ (x). (x^2). (x^3). ] $
! 39: $ [ (Dx). (Dx^2). (Dx^3).]] [5 6 7]] res-nextShift :: $
! 40: ]] putUsages
! 41:
! 42:
! 43: %% Input must be a matrix.
! 44: /res-init {
! 45: /arg1 set
! 46: [/in-initv /v /n] pushVariables
! 47: [
! 48: /v arg1 def
! 49: /n v length def
! 50: [n [v] fromVectors {init} map] toVectors2
! 51: /arg1 set
! 52: ] pop
! 53: popVariables
! 54: arg1
! 55: } def
! 56:
! 57:
! 58: /res-isVadapted {
! 59: /arg1 set
! 60: [/in-res-isVstrict /f /m /mm /ans] pushVariables
! 61: [
! 62: /f arg1 0 get def
! 63: /m arg1 1 get def
! 64: /mm arg1 2 get def
! 65: %% D^p[m] ---f---> D^q[mm] [f m mm] res-isVadapted
! 66: f [ [ ] ] eq {
! 67: /ans 1 def
! 68: } {
! 69: [f mm] res-nextShift m eq {/ans 1 def} { /ans 0 def} ifelse
! 70: } ifelse
! 71: /arg1 ans def
! 72: ] pop
! 73: popVariables
! 74: arg1
! 75: } def
! 76:
! 77: /res-gb {
! 78: /arg1 set
! 79: [/in-res-gb /aa /gg /qq /ans] pushVariables
! 80: [(KanGBmessage)] pushEnv
! 81: [
! 82: /aa arg1 def %% Input is a matrix.
! 83: aa [ ] eq { /arg1 [ ] def /res-gb.LLL goto } { } ifelse
! 84: aa 0 get isArray {
! 85: }{ aa { [ 2 1 roll ] } map /aa} ifelse
! 86: /qq aa 0 get length def
! 87: aa { dehomogenize homogenize } map /aa set
! 88: uli.verbose { } { [(KanGBmessage) 0] system_variable} ifelse
! 89: [aa] groebner 0 get /ans set
! 90: ans 0 get isArray { }
! 91: { [qq ans] toVectors2 /ans set } ifelse
! 92: /arg1 ans def
! 93: /res-gb.LLL
! 94: ] pop
! 95: popEnv
! 96: popVariables
! 97: arg1
! 98: } def
! 99:
! 100: %% Utility functions res-setRing and res-toString
! 101: /res-toString {
! 102: /arg1 set
! 103: [/in-res-toString /s /ans] pushVariables
! 104: [
! 105: /s arg1 def
! 106: s isArray {
! 107: s {res-toString} map /ans set
! 108: }{
! 109: s isPolynomial {
! 110: /ans s toString def
! 111: } {
! 112: /ans s def
! 113: } ifelse
! 114: } ifelse
! 115: ans /arg1 set
! 116: ] pop
! 117: popVariables
! 118: arg1
! 119: } def
! 120:
! 121: %% res-setRing.v res-setRing.vlist are global variables that contain,
! 122: %% for example, (x,y) and [(x) (y)].
! 123: /res-setRing {
! 124: /arg1 set
! 125: [/in-res-setRing /R /v] pushVariables
! 126: [
! 127: /v arg1 def
! 128: v isArray {
! 129: /v v res-toString from_records def
! 130: }{
! 131: v isString {
! 132: }{
! 133: [(res-setRing: ) v toString
! 134: ( is not a set of variables to define a ring.)] cat
! 135: error
! 136: }ifelse
! 137: }ifelse
! 138: /res-setRing.v v def
! 139: /res-setRing.vlist [v to_records pop] def
! 140: [v ring_of_differential_operators 0] define_ring /R set
! 141: /arg1 R def
! 142: ] pop
! 143: popVariables
! 144: arg1
! 145: } def
! 146:
! 147:
! 148: %% [M N] res-div It returns ker(M/N) i.e. D^*/ [M N] res-div = M/N
! 149: %% First size(M) part of the syzygy of M and N.
! 150: /res-div {
! 151: /arg1 set
! 152: [/in-res-div /M /N /ss /m /n /ss2 /ans] pushVariables
! 153: [(KanGBmessage)] pushEnv
! 154: [
! 155: /M arg1 0 get def
! 156: /N arg1 1 get def
! 157: /m M length def
! 158: /n N length def
! 159: M 0 get isArray {
! 160: }{ M { [ 2 1 roll ] } map /M } ifelse
! 161: M { dehomogenize homogenize } map /M set
! 162:
! 163: n 0 eq not {
! 164: N 0 get isArray {
! 165: }{ N { [ 2 1 roll ] } map /N } ifelse
! 166: N { dehomogenize homogenize } map /N set
! 167: } { } ifelse
! 168:
! 169: uli.verbose { } { [(KanGBmessage) 0] system_variable} ifelse
! 170: [M N join [(needSyz)]] groebner 2 get /ss set
! 171: ss dehomogenize /ss set
! 172: ss { [ 2 1 roll aload pop 1 1 n { pop pop } for ] } map
! 173: /ss2 set
! 174: ss2 {homogenize} map /ss2 set
! 175: ss2 [ ] eq {
! 176: [ m res-newpvec ] /ans set
! 177: }{
! 178: [ss2 0 get length [ss2] groebner 0 get dehomogenize ] toVectors2
! 179: /ans set
! 180: } ifelse
! 181:
! 182: /arg1 ans def
! 183: ] pop
! 184: popEnv
! 185: popVariables
! 186: arg1
! 187: } def
! 188: [(res-div)
! 189: [( [M N] res-div K )
! 190: ( matrix M, N, K ; Each element of M and N must be an element of a ring.)
! 191: ( coker(K) is isomorphic to M/N. )
! 192: (Example: [(x,y) ring_of_differential_operators 0] define_ring )
! 193: ( [[[(x+x^2+y^2).] [(x y).]] [[(x+x^2+y^2).] [(x y).]]] res-div)
! 194: ( )
! 195: $res*div accepts string inputs, too. For example,$
! 196: $ [[[[(x+x^2+y^2)] [(x y)]] [[(x+x^2+y^2)] [(x y)]]]$
! 197: $ [(x) (y)]] res*div ::$
! 198: (See also res-toString, res-setRing.)
! 199: ]] putUsages
! 200:
! 201: /res*div {
! 202: /arg1 set
! 203: [/in-res*div /A] pushVariables
! 204: [(CurrentRingp)] pushEnv
! 205: [
! 206: /A arg1 def
! 207: A 1 get res-setRing pop
! 208: A 0 get res-toString expand res-div /arg1 set
! 209: ] pop
! 210: popEnv
! 211: popVariables
! 212: arg1
! 213: } def
! 214:
! 215: /res-syz {
! 216: /arg1 set
! 217: [/in-res-syz /M /m] pushVariables
! 218: [
! 219: /M arg1 def
! 220:
! 221: M 0 get isArray {
! 222: }{ M { [ 2 1 roll ] } map /M } ifelse
! 223:
! 224: M { dehomogenize homogenize } map /M set
! 225: [M [(needSyz)]] groebner 2 get dehomogenize /arg1 set
! 226: ] pop
! 227: popVariables
! 228: arg1
! 229: } def
! 230: [(res-syz)
! 231: [( M res-syz N)
! 232: ( matrix M, N ; each element of M and N must be an element of a ring.)
! 233: ( N is a set of generators of the syzygy module of M.)
! 234: (res*syz is also provided. It accepts string inputs.)
! 235: ]] putUsages
! 236: /res*syz {
! 237: /arg1 set
! 238: [/in-res*syz /A] pushVariables
! 239: [(CurrentRingp)] pushEnv
! 240: [
! 241: /A arg1 def
! 242: A 1 get res-setRing pop
! 243: A 0 get res-toString expand res-syz /arg1 set
! 244: ] pop
! 245: popEnv
! 246: popVariables
! 247: arg1
! 248: } def
! 249:
! 250: /res-getx {
! 251: /arg1 set
! 252: [/in-res-getx /xx /nn /ff] pushVariables
! 253: [
! 254: /ff arg1 def
! 255: /xx ff getvNamesCR def
! 256: [(N)] system_variable /nn set
! 257: [ xx aload pop 1 1 nn { pop pop } for pop ] rest
! 258: /arg1 set
! 259: ] pop
! 260: popVariables
! 261: arg1
! 262: } def
! 263:
! 264: %% Solving \sum c_i M_i = d
! 265: %% [M d] res-solv c'/r ; M : matrix, d, c' : vectors, r : scalar, c'/r =c
! 266: /res-solv {
! 267: /arg1 set
! 268: [/in-res-solv /M /d /ans /B /vv /G /rr /rng] pushVariables
! 269: [(CurrentRingp) (KanGBmessage)] pushEnv
! 270: [
! 271: /M arg1 0 get def
! 272: /d arg1 1 get def
! 273: M getRing /rng set
! 274: rng res-getx /vv set
! 275: uli.verbose { (res-solv : vv = ) messagen vv message } { } ifelse
! 276: uli.verbose { } { [(KanGBmessage) 0] system_variable } ifelse
! 277: M dehomogenize /M set
! 278: [vv from_records ring_of_differential_operators 0] define_ring
! 279: M 0 get isArray {
! 280: M { { toString . } map } map /M set
! 281: } {
! 282: M { toString . } map /M set
! 283: } ifelse
! 284: [M [(needBack)]] groebner_sugar /G set
! 285: G 1 get /B set
! 286:
! 287: d isArray {
! 288: d 0 get isArray { [d] fromVectors 0 get /d set } { } ifelse
! 289: [d] fromVectors 0 get /d set
! 290: } { } ifelse
! 291: d toString . dehomogenize /d set
! 292:
! 293: /res-solv.d d def
! 294: /res-solv.G G def
! 295:
! 296: d G 0 get reduction-noH /rr set
! 297: rr 0 get (0). eq {
! 298: [rr 2 get] B mul 0 get /ans set
! 299: /ans [ ans { toString rng ,, (-1) rng ,, mul} map
! 300: rr 1 get toString .. ] def
! 301: } {
! 302: /ans null def
! 303: } ifelse
! 304: /arg1 ans def
! 305: ] pop
! 306: popEnv
! 307: popVariables
! 308: arg1
! 309: } def
! 310: [(res-solv)
! 311: [$[M d] res-solv [c' r] $
! 312: $ M : matrix, d, c' : vectors, r : scalar(integer) $
! 313: $ c:=c'/r is a solutions of Sum[c_i M_i] = d where c_i is the i-th element $
! 314: $ of the vector c and M_i is the i-th row vector of M.$
! 315: $If there is no solution, then res-solv returns null. $
! 316: (Note that M and d are not treated as an element of the homogenized Weyl)
! 317: (algebra. If M or d contains the homogenization variable h, it automatically)
! 318: (set to 1. If you need to use h, use the command res-solv-h)
! 319: $Example 1: [(x,y) ring_of_differential_operators [[(x) -1 (Dx) 1]] weight_vector 0] $
! 320: $ define_ring $
! 321: $ [ [ [(x Dx + 2).] [ (Dx (x Dx + 3) - (x Dx + 2) (x Dx -4)).]] [(1).]] $
! 322: $ res-solv :: $
! 323: $Example 2: $
! 324: $ [ [ (x Dx + 2). (Dx (x Dx + 3) - (x Dx + 2) (x Dx -4)).] (1).] $
! 325: $ res-solv :: $
! 326: $Example 3: $
! 327: $ [ [[(x Dx + 2). (0).] $
! 328: $ [(Dx+3). (x^3).]$
! 329: $ [(3). (x).]$
! 330: $ [(Dx (x Dx + 3) - (x Dx + 2) (x Dx -4)). (0).]] [(1). (0).]] $
! 331: $ res-solv :: $
! 332: $Example 4: $
! 333: $ [[ (x*Dx+h^2). (Dx^2+x*h).] [(x^2+h^2). (h Dx + x^2).]] /ff set $
! 334: $ [[ (x^2 Dx + x h^2). (Dx^3).]] /gg set $
! 335: $ [ff gg ff mul 0 get ] res-solv-h :: $
! 336: $ $
! 337: $res*solv and res*solv*h accept string inputs, too. For example,$
! 338: $ [[ [ [(x Dx + 2)] [ (Dx (x Dx + 3) - (x Dx + 2) (x Dx -4))]] [(1)]] $
! 339: $ (x)] res*solv :: $
! 340: ]] putUsages
! 341: /res*solv {
! 342: /arg1 set
! 343: [/in-res*solv /A] pushVariables
! 344: [(CurrentRingp)] pushEnv
! 345: [
! 346: /A arg1 def
! 347: A 1 get res-setRing pop
! 348: A 0 get res-toString expand res-solv /arg1 set
! 349: ] pop
! 350: popEnv
! 351: popVariables
! 352: arg1
! 353: } def
! 354:
! 355: %% Solving \sum c_i M_i = d
! 356: %% [M d] res-solv-h c'/r ;
! 357: %% M : matrix, d, c' : vectors, r : scalar, c'/r =c
! 358: /res-solv-h {
! 359: /arg1 set
! 360: [/in-res-solv-h /M /d /ans /B /vv /G /rr /rng] pushVariables
! 361: [(CurrentRingp) (KanGBmessage)] pushEnv
! 362: [
! 363: /M arg1 0 get def
! 364: /d arg1 1 get def
! 365: M getRing /rng set
! 366: rng res-getx /vv set
! 367: uli.verbose { (res-solv-h : vv = ) messagen vv message } { } ifelse
! 368: uli.verbose { } { [(KanGBmessage) 0] system_variable } ifelse
! 369: [vv from_records ring_of_differential_operators 0] define_ring
! 370: M 0 get isArray {
! 371: M { { toString . } map } map /M set
! 372: } {
! 373: M { toString . } map /M set
! 374: } ifelse
! 375:
! 376: getOptions /options set
! 377: (grade) (module1v) switch_function
! 378: [M [(needBack)]] groebner /G set
! 379: options restoreOptions
! 380:
! 381: G 1 get /B set
! 382:
! 383: d isArray {
! 384: d 0 get isArray { [d] fromVectors 0 get /d set } { } ifelse
! 385: [d] fromVectors 0 get /d set
! 386: } { } ifelse
! 387: d toString . /d set
! 388:
! 389: /res-solv.d d def
! 390: /res-solv.G G def
! 391:
! 392: d G 0 get reduction /rr set
! 393: rr 0 get (0). eq {
! 394: [rr 2 get] B mul 0 get /ans set
! 395: /ans [ ans { toString rng ,, (-1) rng ,, mul} map
! 396: rr 1 get toString .. ] def
! 397: } {
! 398: /ans null def
! 399: } ifelse
! 400: /arg1 ans def
! 401: ] pop
! 402: popEnv
! 403: popVariables
! 404: arg1
! 405: } def
! 406: /res*solv*h {
! 407: /arg1 set
! 408: [/in-res*solv*h /A] pushVariables
! 409: [(CurrentRingp)] pushEnv
! 410: [
! 411: /A arg1 def
! 412: A 1 get res-setRing pop
! 413: A 0 get res-toString expand res-solv-h /arg1 set
! 414: ] pop
! 415: popEnv
! 416: popVariables
! 417: arg1
! 418: } def
! 419:
! 420: %% See also xm, sm1_mul, sm1_mul_d, sm1_mul_h
! 421: /res*mul {
! 422: /arg1 set
! 423: [/in-res*mul /A] pushVariables
! 424: [(CurrentRingp)] pushEnv
! 425: [
! 426: /A arg1 def
! 427: A 1 get res-setRing pop
! 428: A 0 get 0 get res-toString expand
! 429: A 0 get 1 get res-toString expand
! 430: mul dehomogenize
! 431: /arg1 set
! 432: ] pop
! 433: popEnv
! 434: popVariables
! 435: arg1
! 436: } def
! 437: /res*mul*h {
! 438: /arg1 set
! 439: [/in-res*mul*h /A] pushVariables
! 440: [(CurrentRingp)] pushEnv
! 441: [
! 442: /A arg1 def
! 443: A 1 get res-setRing pop
! 444: A 0 get 0 get res-toString expand
! 445: A 0 get 1 get res-toString expand
! 446: mul
! 447: /arg1 set
! 448: ] pop
! 449: popEnv
! 450: popVariables
! 451: arg1
! 452: } def
! 453:
! 454: %% cf. sm1_adjoint
! 455: /res*adjoint {
! 456: /arg1 set
! 457: [/in-res*adjoint /A /p /v /p0 /ans] pushVariables
! 458: [(CurrentRingp)] pushEnv
! 459: [
! 460: /A arg1 def
! 461: A 1 get res-setRing pop
! 462: A 0 get res-toString expand dehomogenize /p set
! 463: /v res-setRing.v def
! 464: p isArray {
! 465: p { /p0 set [p0 v] res*adjoint } map /ans set
! 466: }{
! 467: p v adjoint dehomogenize /ans set
! 468: }ifelse
! 469: /arg1 ans def
! 470: ] pop
! 471: popEnv
! 472: popVariables
! 473: arg1
! 474: } def
! 475:
! 476: /res-init-m {
! 477: /arg1 set
! 478: [/in-res-init-m /A /ans] pushVariables
! 479: [
! 480: /A arg1 def
! 481: A isArray {
! 482: A { res-init-m } map /ans set
! 483: }{
! 484: A init /ans set
! 485: }ifelse
! 486: /arg1 ans def
! 487: ] pop
! 488: popVariables
! 489: arg1
! 490: } def
! 491:
! 492: /res-ord_w-m {
! 493: /arg2 set
! 494: /arg1 set
! 495: [/in-ord_w-m /A /ans /w] pushVariables
! 496: [
! 497: /A arg1 def
! 498: /w arg2 def
! 499: A isArray {
! 500: A { w res-ord_w-m } map /ans set
! 501: }{
! 502: A w ord_w /ans set
! 503: }ifelse
! 504: /arg1 ans def
! 505: ] pop
! 506: popVariables
! 507: arg1
! 508: } def
! 509:
! 510: %% cf. sm1_resol1
! 511: /res*resol1 {
! 512: /arg1 set
! 513: [/in-res*resol1 /A /ans /w /ans1 /ans2] pushVariables
! 514: [
! 515: /A arg1 def
! 516: A length 3 ge {
! 517: /w A 2 get def %% weight vector
! 518: } {
! 519: /w null def
! 520: }ifelse
! 521: A resol1 /ans set
! 522: /ans1 ans res-init-m def
! 523: w tag 0 eq {
! 524: /ans [ans ans1] def
! 525: }{
! 526: ans w 0 get res-ord_w-m /ans2 set
! 527: /ans [ans ans1 ans2] def
! 528: }ifelse
! 529: /arg1 ans def
! 530: ] pop
! 531: popVariables
! 532: arg1
! 533: } def
! 534:
! 535: %% @@@
! 536:
! 537: %% submodule to quotient module
! 538: %% M res-sub2Q ==> J, where M \simeq D^m/J
! 539: /res-sub2Q {
! 540: /arg1 set
! 541: [/in-res-sub2Q /M /m] pushVariables
! 542: [
! 543: /M arg1 def
! 544: M 0 get isArray {
! 545: }{ M { [ 2 1 roll ] } map /M } ifelse
! 546: M { dehomogenize homogenize } map /M set
! 547: [M [(needSyz)]] groebner 2 get dehomogenize /arg1 set
! 548: ] pop
! 549: popVariables
! 550: arg1
! 551: } def
! 552: [(res-sub2Q)
! 553: [(M res-sub2Q J)
! 554: (matrix M, J; )
! 555: (The submodule generated by M is isomorphic to D^m/J.)
! 556: ]] putUsages
! 557:
! 558:
! 559: %% submodules to quotient module
! 560: %% [M N] res-subsub2Q ==> J, where M \simeq D^m/J
! 561: /res-subsub2Q {
! 562: /arg1 set
! 563: [/in-res-subsub2Q /M /N /ss /m /n /ss2] pushVariables
! 564: [
! 565: /M arg1 0 get def
! 566: /N arg1 1 get def
! 567: /m M length def
! 568: /n N length def
! 569: M 0 get isArray {
! 570: }{ M { [ 2 1 roll ] } map /M } ifelse
! 571: N 0 get isArray {
! 572: }{ N { [ 2 1 roll ] } map /N } ifelse
! 573: M { dehomogenize homogenize } map /M set
! 574: N { dehomogenize homogenize } map /N set
! 575: [M N join [(needSyz)]] groebner 2 get /ss set
! 576: ss dehomogenize /ss set
! 577: ss { [ 2 1 roll aload pop 1 1 n { pop pop } for ] } map
! 578: /ss2 set
! 579: ss2 {homogenize} map /ss2 set
! 580: [ss2 0 get length [ss2] groebner 0 get dehomogenize ] toVectors2
! 581: /arg1 set
! 582: ] pop
! 583: popVariables
! 584: arg1
! 585: } def
! 586:
! 587: /res-newpvec {
! 588: /arg1 set
! 589: [/in-res-newpvec /n ] pushVariables
! 590: [
! 591: /n arg1 def
! 592: [1 1 n { pop (0). } for] /arg1 set
! 593: ] pop
! 594: popVariables
! 595: arg1
! 596: } def
! 597:
! 598: %% ki.sm1 kernel/image, 1999, 2/4
! 599: %% ki.sm1 is now moved to gbhg3/Int.
! 600: %% It is included in lib/complex.sm1
! 601: /kernel-image.v 1 def
! 602: /kernel-image.p 0 def % characteristic
! 603: %%
! 604: %% D^p <-- m --- D^q <-- n -- D^r
! 605: %% ker(m)/im(n)
! 606: %%
! 607: /res-kernel-image {
! 608: /arg1 set
! 609: [/in-res-kernel-image /p /q /r /m /n /t
! 610: /vlist /s0 /s1 /ans
! 611: ] pushVariables
! 612: [
! 613: /m arg1 0 get def
! 614: /n arg1 1 get def
! 615: /vlist arg1 2 get def
! 616: vlist isArray {
! 617: vlist from_records /vlist
! 618: } { } ifelse
! 619: [vlist ring_of_differential_operators kernel-image.p] define_ring
! 620: m { {toString . dehomogenize toString} map } map /m set
! 621: m length /q set
! 622: n { {toString . dehomogenize toString} map } map /n set
! 623: n length /r set
! 624:
! 625: [m vlist] syz 0 get {{toString} map} map /s0 set
! 626: /t s0 length def
! 627: [ s0 n join vlist ] syz 0 get /s1 set
! 628: s1 { t carN } map /ans set
! 629:
! 630: /arg1 ans def
! 631: ] pop
! 632: popVariables
! 633: arg1
! 634: } def
! 635: [(res-kernel-image)
! 636: [( [m n vlist] res-kernel-image c )
! 637: (When, D^p <-- m --- D^q <-- n -- D^r )
! 638: (D^q/c is isomorhic to ker(m)/im(n).)
! 639: (vlist is a list of variables.)
! 640: ]] putUsages
! 641:
! 642:
! 643: /res-dual {
! 644: /arg1 set
! 645: [/in-res-dual ] pushVariables
! 646: [
! 647: arg1 0 get /input set
! 648: arg1 1 get /vlist set
! 649: /n vlist length def
! 650: /vv vlist from_records def
! 651:
! 652: %% preprocess to input resol0. Future version of resol1 should do them.
! 653: input 0 get isArray {
! 654: /kernel-image.unknowns input 0 get length def
! 655: } { /kernel-image.unknowns 1 def } ifelse
! 656: [vv ring_of_differential_operators
! 657: kernel-image.p ] define_ring
! 658: input 0 get isArray {
! 659: input { {toString . dehomogenize toString} map
! 660: } map /input set
! 661: }{ input { toString . dehomogenize toString} map /input set } ifelse
! 662:
! 663: [input vv]
! 664: resol0 /rr set
! 665:
! 666: %% Postprocess of resol0
! 667: [vv ring_of_differential_operators
! 668: kernel-image.p ] define_ring
! 669: [ [kernel-image.unknowns rr 0 get { toString . dehomogenize } map]
! 670: toVectors2 { {toString} map } map ]
! 671: rr 1 get join /rr-syz set
! 672: %%% end. The result is in rr-syz.
! 673:
! 674: /M rr-syz << n >> get def
! 675: /N rr-syz << n 1 sub >> get def
! 676: M [ ] eq {
! 677: /q N length def
! 678: /M [ [0 1 q 1 sub { pop (0). } for] ] def
! 679: } { } ifelse
! 680:
! 681: %% regard them as a map from row vector v to row vector w; v M --> w
! 682: uli.verbose {
! 683: (M = ) messagen M pmat
! 684: (N = ) messagen N pmat
! 685: } { } ifelse
! 686: M transpose { { toString . dehomogenize vv adjoint} map } map /M set
! 687: N transpose { { toString . dehomogenize vv adjoint} map } map /N set
! 688: uli.verbose {
! 689: $We are now computing ker (*N)/im (*M).$ message
! 690: (*N = ) messagen N pmat
! 691: (*M = ) messagen M pmat
! 692: ( *N *M = ) messagen N M mul dehomogenize message
! 693: ( ) message
! 694: }{ } ifelse
! 695: /M M {{toString} map } map def
! 696: /N N {{toString} map } map def
! 697: [M N vv] res-kernel-image {{toString} map}map /ans1 set
! 698: [ans1 vv] gb 0 get /arg1 set
! 699: ] pop
! 700: popVariables
! 701: arg1
! 702: } def
! 703:
! 704: [(res-dual)
! 705: [$[F V] res-dual G$
! 706: $G is the dual D-module of F. V is a list of variables.$
! 707: $Example 1: [ [( x^3-y^2 ) ( 2 x Dx + 3 y Dy + 6 ) ( 2 y Dx + 3 x^2 Dy) ] $
! 708: $ [(x) (y)]] res-dual $
! 709: $Example 2: [[1 3 4 5]] appell1 res-dual $
! 710: $Example 3: [ [(-x1 Dx1 + x1 + 2) (x2 Dx2 - Dx2 -3)] [(x1) (x2)]] res-dual $
! 711: $Example 4: [ [(x2 Dx2 - Dx2 + 4) (x1 Dx1 + x1 +3)] [(x1) (x2)]] res-dual $
! 712: $ 3 and 4 are res-dual each other. $
! 713: $Example 5: [ [[1 1 1][0 1 2]] [0 0]] gkz res-dual $
! 714: $Example 6: [ [[1 1 1][0 1 2]] [-2 -1]] gkz res-dual $
! 715: $ $
! 716: $Example 7: [ [(x Dx -1) (Dx^2)] [(x)]] res-dual $
! 717: $Example 8: [ [[(1) (0)] [(0) (Dx)]] [(x)]] res-dual $
! 718: $Example 9: [ [((x Dx + x +1) (Dx-1))] [(x)]] res-dual $
! 719: ]] putUsages
! 720:
! 721: %%% From 1999/Int/sst.sm1
! 722: /saturation1 {
! 723: /arg1 set
! 724: [/in-saturation1 /ff /vlist /ulist /mm /hlist /iii
! 725: /i /uweight /aaa
! 726: ] pushVariables
! 727: [(KanGBmessage) (CurrentRingp)] pushEnv
! 728: [
! 729: /ff arg1 def
! 730: /iii ff 0 get {toString} map def %% ideal
! 731: /hlist ff 1 get {toString} map def %% saturation polynomials
! 732: /vlist [ff 2 get to_records pop] def
! 733: /mm hlist length def
! 734:
! 735: [(KanGBmessage) 0] system_variable
! 736: /ulist [ 0 1 mm 1 sub { /i set [(_u) i] cat } for ] def
! 737: /uweight ulist { 1 } map def
! 738: [vlist ulist join from_records ring_of_polynomials
! 739: [uweight] weight_vector 0] define_ring
! 740: [0 1 mm 1 sub { /i set hlist i get .
! 741: ulist i get . mul (1). sub } for]
! 742: /hlist set
! 743: %%hlist pmat
! 744: [iii {.} map hlist join] groebner_sugar 0 get /aaa set
! 745: %%[aaa ulist] pmat
! 746: aaa ulist eliminatev /arg1 set
! 747: ] pop
! 748: popEnv
! 749: popVariables
! 750: arg1
! 751: } def
! 752:
! 753: [(saturation1)
! 754: [([ideal saturation-poly vlist] saturation jjj)
! 755: $It returns(((ideal:f_1^\infty):f_2^\infty) ...) where$
! 756: $saturation-poly is [f_1, f_2, ...]$
! 757: $Example 1: $
! 758: $ [[(x1 y1 + x2 y2 + x3 y3 + x4 y4) $
! 759: $ (x2 y2 + x4 y4) (x3 y3 + x4 y4) (y1 y4 - y2 y3)]$
! 760: $ [(y1) (y2) (y3) (y4)] (x1,x2,x3,x4,y1,y2,y3,y4)] saturation1$
! 761: $ /ff set [ff (x1,x2,x3,x4,y1,y2,y3,y4) $
! 762: $ [[(y1) 1 (y2) 1 (y3) 1 (y4) 1]]] pgb $
! 763: $ 0 get [(y1) (y2) (y3) (y4)] eliminatev ::$
! 764: ]] putUsages
! 765:
! 766:
! 767: /intersection {
! 768: /arg1 set
! 769: [/in-intersection2 /ii /jj /rr /vlist /ii2 /jj2 ] pushVariables
! 770: [(CurrentRingp) (KanGBmessage)] pushEnv
! 771: [
! 772: /ii arg1 0 get def
! 773: /jj arg1 1 get def
! 774: /vlist arg1 2 get def
! 775:
! 776: [(KanGBmessage) 0] system_variable
! 777:
! 778: [vlist to_records pop] /vlist set
! 779: [vlist [(_t)] join from_records ring_of_differential_operators
! 780: [[(_t) 1]] weight_vector 0] define_ring
! 781: ii { toString . (_t). mul } map /ii2 set
! 782: jj { toString . (1-_t). mul } map /jj2 set
! 783: [ii2 jj2 join] groebner_sugar 0 get
! 784: [(_t)] eliminatev /arg1 set
! 785: ] pop
! 786: popEnv
! 787: popVariables
! 788: arg1
! 789: } def
! 790:
! 791: [(intersection)
! 792: [(Ideal intersections in the ring of differential operators.)
! 793: $Example 1: [[[(x1) (x2)] [(x2) (x4)] (x1,x2,x3,x4)] intersection$
! 794: $ [(x2) (x4^2)] (x1,x2,x3,x4)] intersection :: $
! 795: $Example 2: [[[(x1) (x2)] [(x2) (x4)] (x1,x2,x3,x4)] intersection$
! 796: $ [(x2) (x4^2)] (x1,x2,x3,x4)] intersection /ff set ff message$
! 797: $ [ ff [(x2^2) (x3) (x4)] (x1,x2,x3,x4)] intersection :: $
! 798: $Example 3: [[[(x1) (x2)] [(x2) (x4^2)] (x1,x2,x3,x4)] intersection$
! 799: $ [(x2^2) (x3) (x4)] (x1,x2,x3,x4)] intersection :: $
! 800: ]] putUsages
! 801:
! 802:
! 803: /saturation2 {
! 804: /arg1 set
! 805: [/in-saturation2 /ff /vlist /mm /slist /iii
! 806: /i /aaa
! 807: ] pushVariables
! 808: [(KanGBmessage) (CurrentRingp)] pushEnv
! 809: [
! 810: /ff arg1 def
! 811: /iii ff 0 get {toString} map def %% ideal
! 812: /slist ff 1 get {toString} map def %% saturation polynomials
! 813: /vlist ff 2 get def
! 814: /mm slist length def
! 815:
! 816: /aaa [iii [slist 0 get] vlist] saturation1 def
! 817: 1 1 mm 1 sub {
! 818: /i set
! 819: [[iii [slist i get] vlist] saturation1
! 820: aaa vlist] intersection /aaa set
! 821: } for
! 822: /arg1 aaa def
! 823: ] pop
! 824: popEnv
! 825: popVariables
! 826: arg1
! 827: } def
! 828:
! 829: [(saturation2)
! 830: [([ideal saturation-poly vlist] saturations jjj)
! 831: $It returns (ideal:f_1^infty) \cap (ideal:f_2^\infty) \cap ... where$
! 832: $saturation-poly is [f_1, f_2, ...]$
! 833: $Example 1: $
! 834: $ [[(x1 y1 + x2 y2 + x3 y3 + x4 y4) $
! 835: $ (x2 y2 + x4 y4) (x3 y3 + x4 y4) (y1 y4 - y2 y3)]$
! 836: $ [(y1) (y2) (y3) (y4)] (x1,x2,x3,x4,y1,y2,y3,y4)] saturation2$
! 837: $ /ff set [ff (x1,x2,x3,x4,y1,y2,y3,y4) $
! 838: $ [[(y1) 1 (y2) 1 (y3) 1 (y4) 1]]] pgb $
! 839: $ 0 get [(y1) (y2) (y3) (y4)] eliminatev ::$
! 840: $Example 2: [[(x2^2) (x2 x4) (x2) (x4^2)] [(x2) (x4)] (x2,x4)] saturation2$
! 841: ]] putUsages
! 842:
! 843: /innerProduct {
! 844: { [ 2 1 roll ] } map /innerProduct.tmp2 set
! 845: /innerProduct.tmp1 set
! 846: [innerProduct.tmp1] innerProduct.tmp2 mul
! 847: 0 get 0 get
! 848: } def
! 849:
! 850: /saturation {
! 851: /arg1 set
! 852: [/in-saturation /ff /vlist /mm /slist /iii
! 853: /i /aaa /vlist2
! 854: ] pushVariables
! 855: [(KanGBmessage) (CurrentRingp)] pushEnv
! 856: [
! 857: /ff arg1 def
! 858: /iii ff 0 get {toString} map def %% ideal
! 859: /slist ff 1 get {toString} map def %% saturation polynomials
! 860: /vlist ff 2 get def
! 861: /mm slist length def
! 862:
! 863: [vlist to_records pop] [(_z) (_y)] join /vlist2 set
! 864: [vlist2 from_records ring_of_polynomials
! 865: [[(_z) 1 (_y) 1]] weight_vector
! 866: 0] define_ring
! 867:
! 868: [
! 869: [
! 870: [0 1 mm 1 sub { /i set (_y). i npower } for ]
! 871: slist {.} map innerProduct (_z). sub
! 872: ]
! 873: iii {.} map join
! 874:
! 875: [(_z)]
! 876: vlist2 from_records
! 877: ] saturation1 /aaa set
! 878:
! 879: [(KanGBmessage) 0] system_variable
! 880: aaa {toString .} map /aaa set
! 881: [aaa] groebner_sugar 0 get
! 882: [(_z) (_y)] eliminatev
! 883: /arg1 set
! 884: ] pop
! 885: popEnv
! 886: popVariables
! 887: arg1
! 888: } def
! 889:
! 890: [(saturation)
! 891: [([ideal J vlist] saturations jjj)
! 892: $It returns (ideal : J^\infty) $
! 893: (Saturation is computed in the ring of polynomials.)
! 894: $When J=[f_1, f_2, ...], it is equal to $
! 895: $((ideal, z-(f_1 + y f_2 + y^2 f_3 +...)) : z^\infty) \cap k[x].$
! 896: $Example 1: $
! 897: $ [[(x1 y1 + x2 y2 + x3 y3 + x4 y4) $
! 898: $ (x2 y2 + x4 y4) (x3 y3 + x4 y4) (y1 y4 - y2 y3)]$
! 899: $ [(y1) (y2) (y3) (y4)] (x1,x2,x3,x4,y1,y2,y3,y4)] saturation$
! 900: $ /ff set [ff (x1,x2,x3,x4,y1,y2,y3,y4) $
! 901: $ [[(y1) 1 (y2) 1 (y3) 1 (y4) 1]]] pgb $
! 902: $ 0 get [(y1) (y2) (y3) (y4)] eliminatev ::$
! 903: $Example 2: [[(x2^2) (x2 x4) (x2) (x4^2)] [(x2) (x4)] (x2,x4)] saturation$
! 904: ]] putUsages
! 905:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to complex.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc