Annotation of OpenXM/src/kan96xx/Doc/intw.sm1, Revision 1.1
1.1 ! maekawa 1: %% When you use wIntegration0, you need oxasir.sm1.
! 2: %% Load this package after you have loaded cohom.sm1.
! 3: %% Annihilating ideal, 0-th integral and restriction with weight vector.
! 4: %% 1998, 11/6, 11/9, 11/18
! 5: %% 1999, 1/25, 6/5.
! 6: %% It was at gbhg3/Int/intw.sm1 <-- s linked from lib/intw.sm1
! 7: %% This file is error clean.
! 8: /intw.verbose 0 def
! 9: /intw.stat 0 def %% statistics.
! 10:
! 11: %% cf. gbhg3/Demo/ann.sm1
! 12: /intw.version (2.981105) def
! 13: (lib/intw.sm1, Version 1999, 6/13. Package for integration with a generic weight.) message
! 14: oxasir.ccc tag 0 eq {
! 15: (Warning: The functions *wbfRoots, wdeRham0, wIntegration0 does not work without oxasir.) message
! 16: ( This package requires oxasir.sm1 and ox_asir server.) message
! 17: } { } ifelse
! 18: cohom.sm1.loaded tag 0 eq {
! 19: (Warning: This package requires cohom.sm1 ) message
! 20: } { } ifelse
! 21: oxasir.sm1.loaded tag 0 eq {
! 22: (Warning: This package requires oxasir.sm1 ) message
! 23: } { } ifelse
! 24:
! 25: intw.version [(Version)] system_variable gt
! 26: { [(This package requires the latest version of kan/sm1) nl
! 27: (Please get it from http://www.math.kobe-u.ac.jp/KAN) ] cat
! 28: error
! 29: } { } ifelse
! 30:
! 31:
! 32: [(integral-k1)
! 33: [([[f1 ... fm] [v1 ... vn] [v1 w1 ... vp wp] k1] integral0 )
! 34: ( [[g1 ... gq],[e1,...,er]])
! 35: (poly|string f1 ...fm; string v1 ... vn;)
! 36: (string v1 ... vp; integer w1 ... wp;)
! 37: (integer k1;)
! 38: (poly g1 ... gq; poly e1, ..., er;)
! 39: (f1 ... fm are annihilors, v1 ... vn are variables,)
! 40: (w1 is the weight of the variable v1, ...)
! 41: (k1 is the maximal degree of the filtration: maximal integral root)
! 42: (of b-function. cf. intwbf)
! 43: (g1, ..., gq are integral. e1, ..., er are basis of the free module to which)
! 44: (the g1, ..., gq belong.)
! 45: (THE ORDERS OF INTEGRAL VARIABLES MUST BE SAME BOTH IN THE SECOND AND)
! 46: (THE THIRD ARGUMENTS. INTEGRAL VARIABLES MUST APPEAR FIRST.)
! 47: $Example 1: [[(x-y) (Dx+Dy)] [(y) (x)] [(y) -1 (Dy) 1] 1] integral-k1$
! 48: $Example 2: [[(x (x-1)) (x)] annfs 0 get [(x)] [(x) -1 (Dx) 1] 1] integral-k1$
! 49: ]
! 50: ] putUsages (integral-k1 ) messagen
! 51: /integral-k1 {
! 52: /arg1 set
! 53: [/in-integral0 /ff /vv /ww /gg1 /gg2 /ord-vec
! 54: /dt-list /nn /ii /dt-ii /mm /jj /xvars /dvars /ans1 /k1 /kk /ans2
! 55: /vec-input /vec-length
! 56: ] pushVariables
! 57: [(CurrentRingp) (KanGBmessage)] pushEnv
! 58: [
! 59: /ff arg1 0 get def
! 60: /vv arg1 1 get def
! 61: /ww arg1 2 get def
! 62: /k1 arg1 3 get def
! 63: /vec-length 1 def
! 64: intw.verbose
! 65: { [ff vv ww k1] messagen ( is the input. ) message } { } ifelse
! 66: ff 0 get isArray {
! 67: ff { {toString} map } map /ff set
! 68: /vec-input 1 def
! 69: %% Compute the length of the input vector
! 70: ff { length dup vec-length gt { /vec-length set } { pop } ifelse } map
! 71: }{
! 72: ff {toString} map /ff set
! 73: /vec-input 0 def
! 74: } ifelse
! 75: /vv vv { (,) 2 cat_n } map aload length cat_n def
! 76: intw.verbose { vv message } { } ifelse
! 77: [(KanGBmessage) intw.verbose] system_variable
! 78: [vv ring_of_differential_operators
! 79: [ww] weight_vector 0] define_ring
! 80: ww getxvars2 /xvars set
! 81: ww getdvars2 /dvars set
! 82: intw.verbose {
! 83: (xvars = ) messagen xvars message
! 84: (dvars = ) messagen dvars message
! 85: } { } ifelse
! 86: %% ww = [(x) -1 (Dx) 1 (z) -1 (Dz) 1]
! 87: %% dvars = [[(Dx) (Dz)] [(Dx) 1 (Dz) 1]]
! 88: %% xvars = [(x) (z)]
! 89: /integral0.ff ff def %% keep variable for debug.
! 90:
! 91: vec-input {
! 92: ff { { . [[(h). (1).]] replace ww laplace0} map homogenize } map /ff set
! 93: } {
! 94: ff { . [[(h). (1).]] replace ww laplace0 homogenize } map /ff set
! 95: %% recompute the lenth of the vector. For e input.
! 96: ff { @@@.esymbol . degree 1 add dup vec-length gt
! 97: { /vec-length set } { pop } ifelse } map
! 98:
! 99: } ifelse
! 100:
! 101: intw.verbose {
! 102: (Computing Groebner basis with the weight vector ) messagen
! 103: ww message
! 104: } { } ifelse
! 105: [ff] groebner 0 get {[[(h). (1).]] replace} map /gg1 set
! 106: intw.verbose {
! 107: gg1 message %% keep variable for debug.
! 108: } { } ifelse
! 109: %% gg1 is the (-w,w)-adapted basis.
! 110: /integral0.gg1 gg1 def
! 111:
! 112:
! 113: intw.verbose {
! 114: (Computing gr 0-k1 of I in D v^0 + D v^1 + ... + D v^{k1} : shifting)
! 115: message
! 116: } { } ifelse
! 117: /ans1 [ ] def
! 118: 0 1 k1 {
! 119: /kk set
! 120: intw.verbose {
! 121: (kk = ) messagen kk message
! 122: } { } ifelse
! 123: /ord-vec gg1 { ww ord_w kk sub} map def
! 124: intw.verbose { ord-vec message } { } ifelse
! 125: %% ww = [(x) -1 (Dx) 1], kk == 0
! 126: %% gg1 = [ (x Dx). (y Dx). (x).]
! 127: %% ord-vec = [ 0 1 -1 ]
! 128: %% dt-list = [ [ 1] [ 0 ] [ (Dx^1).] ]
! 129: ord-vec { 0 2 1 roll sub } map
! 130: {
! 131: dvars 0 get { . } map %% [(Dx). (Dz).]
! 132: dvars 1 get { dup (type?) dc 5 eq { pop } { } ifelse } map %% [1 1]
! 133: 3 -1 roll ip1
! 134: } map /dt-list set
! 135: %% dt-list [ [ 1 ] [ ] [ (Dx^1).] ]
! 136: dt-list { dup length 0 eq { pop [ (0). ] } { } ifelse } map /dt-list set
! 137: intw.verbose {
! 138: (dt-list = ) messagen dt-list message
! 139: } { } ifelse
! 140: %%% t1, -1 ; t2 , -1;
! 141: %% dt-list = [ [ (Dt1). (Dt2). ] [ (1). ] ]
! 142: %% gg1 = [ (t1+t2). (t1 Dt2). ]
! 143: /nn gg1 length def
! 144: [
! 145: 0 1 nn 1 sub {
! 146: /ii set
! 147: dt-list ii get /dt-ii set
! 148: /mm dt-ii length def
! 149: 0 1 mm 1 sub {
! 150: /jj set
! 151: dt-ii jj get
! 152: gg1 ii get mul
! 153: [[(h). (1).]] replace
! 154: xvars { [ 2 1 roll . (0). ] } map replace ww laplace0
! 155: } for
! 156: } for
! 157: ] ans1 join /ans1 set
! 158: } for
! 159: intw.verbose {
! 160: ( ans1 = [ degree-k1, ..., degree-0] = ) messagen
! 161: ans1 message
! 162: } { } ifelse
! 163:
! 164: intw.verbose
! 165: { (Eliminating xvars (variable of integration.) ) message }
! 166: { } ifelse
! 167: ans1 { dup (0). eq { pop } { } ifelse } map /ans1 set
! 168: ans1 [ ] eq
! 169: { [ $There is no relation. It means that there are ($
! 170: k1 1 add
! 171: $)*(length-of-the-input-vector) free basis.$
! 172: ] {toString messagen} map
! 173: ( ) message
! 174: /ans2 [ ] def /integral-k1.L1 goto
! 175: } { } ifelse
! 176: [vv ring_of_differential_operators
! 177: %% elimination order.
! 178: [ xvars { 1 } map ] weight_vector 0] define_ring
! 179: [(NN)
! 180: [(NN)] system_variable xvars length sub
! 181: ] system_variable
! 182: %%%% xvars are regarded as vector index by this trick!!
! 183: %%%% NN should be recovered to the original value or
! 184: %%%% Each ring should have a flag --- <<the constant might be changed(rw)>>
! 185: %%%% In a future version of sm1, when setUpRing is called, sm1 looks for
! 186: %%%% ring data base and if it finds the same ring and the flag of the ring
! 187: %%%% is (ro), then it does not generate a new ring structure. 1998, 11/19.
! 188: (isSameComponent) (xd) switch_function %% for test.
! 189:
! 190: [ ans1 { toString . } map ] groebner_sugar 0 get /ans2 set
! 191: /integral0.ans ans2 def
! 192:
! 193: intw.stat
! 194: { (Size of GB integral0.gg1 is ) messagen integral0.gg1 length message
! 195: (Size of the generators of the submodule integral0.ans is ) messagen
! 196: integral0.ans length message
! 197: } { } ifelse
! 198:
! 199: /integral-k1.L1
! 200: %%%% Compute the vector space basis
! 201: %%% /www2 /vbase /ebase /vbase2
! 202: %% xvars = [(x) (z)], www2 = [1 1], k1=2, vec-length=2
! 203: %% [1 e] [1, x, z, x^2, x z, z^2]
! 204: /www2 dvars 1 get { dup isString { pop } { } ifelse } map def
! 205: [xvars www2 k1] ip1a /vbase set
! 206: vbase { toString . } map /vbase set
! 207: [0 1 vec-length 1 sub { @@@.esymbol . 2 1 roll npower } for] /ebase set
! 208: /vbase2 [ ] def ebase { vbase mul vbase2 join /vbase2 set} map
! 209: intw.verbose {
! 210: (base is ) messagen vbase2 message
! 211: } { } ifelse
! 212:
! 213: /arg1 [ans2 vbase2] def
! 214: ] pop
! 215: popEnv
! 216: popVariables
! 217: arg1
! 218: } def
! 219:
! 220: /homogenize2 {
! 221: /arg1 set
! 222: [/in-homogenize2 /f /ans] pushVariables
! 223: [
! 224: /f arg1 def
! 225: f isArray {
! 226: f { homogenize } map /ans set
! 227: }
! 228: { /ans f homogenize def
! 229: } ifelse
! 230: /arg1 ans def
! 231: ] pop
! 232: popVariables
! 233: arg1
! 234: } def
! 235:
! 236:
! 237: %%% aux functions.
! 238: %% ww = [(x) -1 (Dx) 1 (z) -1 (Dz) 1]
! 239: %% getdvars2 ==> dvars = [[(Dx) (Dz)] [(Dx) 1 (Dz) 1]]
! 240: %% getxvars2 ==> xvars = [(x) (z)]
! 241: /getxvars2 {
! 242: /arg1 set
! 243: [/in-getxvars2 /ww /vv /ans /ii /nn /ans] pushVariables
! 244: [ /ww arg1 def
! 245: /ans [ ] def
! 246: /nn ww length def
! 247: 0 1 nn 1 sub {
! 248: /ii set
! 249: ww ii get (type?) dc 1 eq
! 250: { } % skip, may be weight [(x) 2 ] is OK.
! 251: {
! 252: /vv ww ii get (string) dc def
! 253: vv (array) dc 0 get
! 254: @@@.Dsymbol (array) dc 0 get
! 255: eq %% If the first character is D?
! 256: { } % skip
! 257: { ans [ vv ] join /ans set }
! 258: ifelse
! 259: } ifelse
! 260: } for
! 261: /arg1 ans def
! 262: ] pop
! 263: popVariables
! 264: arg1
! 265: } def
! 266: %% ww = [(x) -1 (Dx) 1 (z) -1 (Dz) 1]
! 267: %% dvars = [[(Dx) (Dz)] [(Dx) 1 (Dz) 1]]
! 268: %% xvars = [(x) (z)]
! 269: /getdvars2 {
! 270: /arg1 set
! 271: [/in-getdvars2 /ww /vv /ans /ii /nn /ans1 /ans2] pushVariables
! 272: [ /ww arg1 def
! 273: /ans1 [ ] def /ans2 [ ] def
! 274: /nn ww length def
! 275: 0 1 nn 1 sub {
! 276: /ii set
! 277: ww ii get (type?) dc 1 eq
! 278: { } % skip, may be weight [(x) 2 ] is OK.
! 279: {
! 280: /vv ww ii get (string) dc def
! 281: vv (array) dc 0 get
! 282: @@@.Dsymbol (array) dc 0 get
! 283: eq %% If the first character is D?
! 284: { ans1 [ vv ] join /ans1 set
! 285: ans2 [ vv ww ii 1 add get ] join /ans2 set
! 286: }
! 287: { } %% skip
! 288: ifelse
! 289: } ifelse
! 290: } for
! 291: /arg1 [ans1 ans2] def
! 292: ] pop
! 293: popVariables
! 294: arg1
! 295: } def
! 296:
! 297: [(wbf)
! 298: [([[f1 ... fm] [v1 ... vn] [v1 w1 ... vp wp]] wbf [g1 ... gq])
! 299: (<poly>|<string> f1 ...fm; <string> v1 ... vn;)
! 300: (<string> v1 ... vp; <integer> w1 ... wp;)
! 301: (<poly> g1 ... gq;)
! 302: (f1 ... fm are generators, v1 ... vn are variables,)
! 303: (w1 is the weight of the variable v1, ...)
! 304: (THE ORDERS OF INTEGRAL VARIABLES MUST BE SAME BOTH IN THE SECOND AND)
! 305: (THE THIRD ARGUMENTS. INTEGRAL VARIABLES MUST APPEAR FIRST.)
! 306: (If the weight is not generic, then the function exits with error.)
! 307: (cf. bf-111 for w=(1 1 1 1 ...) )
! 308: $Example 1: [[(x-y) (Dx+Dy)] [(y) (x)] [(y) -1 (Dy) 1]] wbf$
! 309: $ restrict only for y.$
! 310: $Example 2: [[(-3 x^2 Dy-2 y Dx) (2 x Dx+3 y Dy+6)] [(x) (y)]$
! 311: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] wbf$
! 312: $Example 3: [[[(0) (x^2 Dx+x)] [(Dx^2+x Dx^3) (0)]] [(x)]$
! 313: $ [(x) -1 (Dx) 1]] wbf$
! 314: ]
! 315: ] putUsages ( wbf ) messagen
! 316: /wbf {
! 317: /arg1 set
! 318: [/in-wbf /aaa] pushVariables
! 319: [ /aaa arg1 def
! 320: aaa [1] join intwbf /arg1 set
! 321: ] pop
! 322: popVariables
! 323: arg1
! 324: } def
! 325:
! 326: [(intwbf)
! 327: [([[f1 ... fm] [v1 ... vn] [v1 w1 ... vp wp]] intwbf [g1 ... gq])
! 328: (<poly>|<string> f1 ...fm; <string> v1 ... vn;)
! 329: (<string> v1 ... vp; <integer> w1 ... wp;)
! 330: (<poly> g1 ... gq;)
! 331: (f1 ... fm are generators, v1 ... vn are variables,)
! 332: (w1 is the weight of the variable v1, ...)
! 333: (THE ORDERS OF INTEGRAL VARIABLES MUST BE SAME BOTH IN THE SECOND AND)
! 334: (THE THIRD ARGUMENTS. INTEGRAL VARIABLES MUST APPEAR FIRST.)
! 335: (If the weight is not generic, then the function exits with error.)
! 336: $Example 1: [[(x-y) (Dx+Dy)] [(y) (x)] [(y) -1 (Dy) 1]] intwbf$
! 337: $ integrate only for y.$
! 338: $Example 2: [[(-3 x^2 Dy-2 y Dx) (2 x Dx+3 y Dy+6)] [(x) (y)]$
! 339: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] intwbf$
! 340: $Example 3: [[[(0) (x^2 Dx+x)] [(Dx^2+x Dx^3) (0)]] [(x)]$
! 341: $ [(x) -1 (Dx) 1]] intwbf$
! 342: ]
! 343: ] putUsages ( intwbf ) messagen
! 344:
! 345: /intwbf {
! 346: /arg1 set
! 347: [/in-integral0 /ff /vv /ww /gg1 /gg2 /ord-vec
! 348: /dt-list /nn /ii /dt-ii /mm /jj /xvars /dvars /ans1 /k1 /kk /ans2
! 349: /vec-input /gg1.init /gg1.init2 /complementxvars /gg1.init3
! 350: /rest-bf
! 351: ] pushVariables
! 352: [(CurrentRingp) (KanGBmessage)] pushEnv
! 353: [
! 354: /ff arg1 0 get def
! 355: /vv arg1 1 get def
! 356: /ww arg1 2 get def
! 357: arg1 length 4 eq {
! 358: /rest-bf 1 def
! 359: intw.verbose { (bf for restriction.) message } { } ifelse
! 360: } {
! 361: /rest-bf 0 def
! 362: intw.verbose { (bf for integration.) message } { } ifelse
! 363: } ifelse
! 364: intw.verbose
! 365: { [ff vv ww ] messagen ( is the input. ) message } { } ifelse
! 366: ff 0 get isArray {
! 367: ff { {toString} map } map /ff set
! 368: /vec-input 1 def
! 369: }{
! 370: ff {toString} map /ff set
! 371: /vec-input 0 def
! 372: } ifelse
! 373: /vv vv { (,) 2 cat_n } map aload length cat_n def
! 374: intw.verbose { vv message } { } ifelse
! 375: [(KanGBmessage) intw.verbose] system_variable
! 376: [vv ring_of_differential_operators
! 377: [ww] weight_vector 0] define_ring
! 378: ww getxvars2 /xvars set
! 379: ww getdvars2 /dvars set
! 380: intw.verbose {
! 381: (xvars = ) messagen xvars message
! 382: (dvars = ) messagen dvars message
! 383: } { } ifelse
! 384: %% ww = [(x) -1 (Dx) 1 (z) -1 (Dz) 1]
! 385: %% dvars = [[(Dx) (Dz)] [(Dx) 1 (Dz) 1]]
! 386: %% xvars = [(x) (z)]
! 387: /integral0.ff ff def %% keep variable for debug.
! 388:
! 389: rest-bf {
! 390: %% No Laplace transform for the restriction.
! 391: vec-input {
! 392: ff { { . [[(h). (1).]] replace } map homogenize } map /ff set
! 393: } {
! 394: ff { . [[(h). (1).]] replace homogenize } map /ff set
! 395: } ifelse
! 396: }{
! 397: vec-input {
! 398: ff { { . [[(h). (1).]] replace ww laplace0} map homogenize } map /ff set
! 399: } {
! 400: ff { . [[(h). (1).]] replace ww laplace0 homogenize } map /ff set
! 401: } ifelse
! 402: } ifelse
! 403:
! 404: intw.verbose {
! 405: (Computing Groebner basis with the weight vector ) messagen
! 406: ww message
! 407: } { } ifelse
! 408: [ff] groebner 0 get {[[(h). (1).]] replace} map /gg1 set
! 409: intw.verbose {
! 410: gg1 message %% keep variable for debug.
! 411: } { } ifelse
! 412: %% gg1 is the (-w,w)-adapted basis.
! 413: /integral0.gg1 gg1 def
! 414: %%% The above code is as same as that of integral-k1
! 415:
! 416: intwbf.aux1
! 417: /arg1 set
! 418: ] pop
! 419: popEnv
! 420: popVariables
! 421: arg1
! 422: } def
! 423:
! 424: /intwbf.aux1 {
! 425: [/gg1.init /gg1.init2 /complementxvars /gg1.init3] pushVariables
! 426: [(CurrentRingp)] pushEnv
! 427: [
! 428: %%% It uses local variables in intwbf or integral-k1
! 429: %%%%%%% Let's compute the b-function. It only works for full integration
! 430: %%%%%%% and generic weight vector.
! 431: %% order must be defined by (1) www and (2) [@@@.esymbol 1]
! 432: %% (x Dx^2 e + Dx e + x e + Dx) -->x Dx^2 e + Dx e + Dx --> (x Dx^2 + Dx)e
! 433: intw.verbose {
! 434: [(-------------- computing the b-ideal for generic initial. ---------)
! 435: $-------- if the output is [(e f_1(x,y)) (e f_2(x,y)) g_1(x,y) g_2(x,y) --$
! 436: $-------- then (f_1,f_2) cap (g_1,g_2) would be the b-ideal. $
! 437: ]{message} map
! 438: } { } ifelse
! 439: /complementxvars xvars [vv to_records pop] complement def
! 440: intw.verbose {
! 441: (vv = ) messagen vv message
! 442: (step1. complementxvars = ) messagen complementxvars message
! 443: } { } ifelse
! 444: complementxvars { dup @@@.Dsymbol 2 1 roll 2 cat_n } map
! 445: /complementxvars set
! 446: intw.verbose {
! 447: (step2. complementxvars = ) messagen complementxvars message
! 448: } { } ifelse
! 449: %% vv = (x,y,z)
! 450: %% xvars = [(x) (z)]
! 451: %% complementxvars = [(y) (Dy)]
! 452:
! 453: gg1 {ww weightv init [@@@.esymbol 1] weightv init} map /gg1.init set
! 454: intw.verbose {
! 455: gg1.init message
! 456: } { } ifelse
! 457: gg1.init { xvars {.} map dvars 0 get {.} map xvars {.} map
! 458: distraction2 } map /gg1.init2 set
! 459: %% remove 0
! 460: gg1.init2 { dup (0). eq { pop } { } ifelse } map /gg1.init2 set
! 461:
! 462: %% Let's eliminate complementxvars
! 463: complementxvars [ ] eq { }
! 464: {
! 465: [vv ring_of_differential_operators
! 466: [ complementxvars { 1 } map ] weight_vector 0] define_ring
! 467: [gg1.init2 { dehomogenize toString . } map] groebner_sugar
! 468: 0 get /gg1.init3 set
! 469: gg1.init3 complementxvars eliminatev /gg1.init2 set
! 470: } ifelse
! 471:
! 472: intw.verbose {
! 473: (b-ideal is --------) message
! 474: gg1.init2 message
! 475: } { } ifelse
! 476:
! 477: gg1.init2 /arg1 set
! 478: ] pop
! 479: popEnv
! 480: popVariables
! 481: arg1
! 482: } def
! 483:
! 484: %%% see, gbhg3/Int/int1.sm1
! 485:
! 486:
! 487: [(ip1a)
! 488: [([vlist wlist k] ip1a slist)
! 489: ( x^i ; i_1 w_1 + ... + i_p w_p <= k )
! 490: (Example 1: [[(x) (y) (z)] [1 1 1] 3] ip1a )
! 491: (Example 2: [[(x)] [1] 4] ip1a )
! 492: ]] putUsages
! 493: /ip1a {
! 494: /arg1 set
! 495: [/in-ip1a /vlist /wlist /kk /ans /i] pushVariables
! 496: [(CurrentRingp)] pushEnv
! 497: [
! 498: /vlist arg1 0 get def
! 499: /wlist arg1 1 get def
! 500: /kk arg1 2 get def
! 501:
! 502: [vlist from_records ring_of_polynomials 0] define_ring
! 503: vlist { toString . } map /vlist set
! 504: /ans [ ] def
! 505: 0 1 kk {
! 506: /i set
! 507: vlist wlist i ip1 ans join /ans set
! 508: } for
! 509: ans /arg1 set
! 510: ] pop
! 511: popEnv
! 512: popVariables
! 513: arg1
! 514: } def
! 515:
! 516:
! 517: %% [(x1) (x2)] typeL [ [[(Dx1) (Dx1+D_z1)] [(Dx2) (Dx2+D_z2)]]
! 518: %% [(_z1) (_z2)] ]
! 519: /typeL {
! 520: /arg1 set
! 521: [/in-typeL /xvars /n /zlist /i /tmpr] pushVariables
! 522: [
! 523: /xvars arg1 def
! 524: xvars length /n set
! 525: [ 1 1 n { toString } for ] /zlist set
! 526: zlist { (_z) 2 1 roll 2 cat_n } map /zlist set
! 527: %% [(_z1) (_z2) ... ]
! 528: /rule [ 1 1 n { pop 0 } for ] def
! 529: 0 1 n 1 sub {
! 530: /i set
! 531: [ @@@.Dsymbol xvars i get 2 cat_n
! 532: [@@@.Dsymbol xvars i get
! 533: (+)
! 534: @@@.Dsymbol zlist i get
! 535: ] cat
! 536: ] /tmpr set
! 537: rule i tmpr put
! 538: } for
! 539: /arg1 [rule zlist] def
! 540: ] pop
! 541: popVariables
! 542: arg1
! 543: } def
! 544:
! 545: %% [(x1) (x2)] typeR [ [[(x1) (x1-_z1)] [(x2) (x2-_z2)]
! 546: %% [(Dx1) (-D_z1)] [(Dx2) (-D_z2)]]
! 547: %% [(_z1) (_z2)] ]
! 548: /typeR {
! 549: /arg1 set
! 550: [/in-typeL /xvars /n /zlist /i /tmpr] pushVariables
! 551: [
! 552: /xvars arg1 def
! 553: xvars length /n set
! 554: [ 1 1 n { toString } for ] /zlist set
! 555: zlist { (_z) 2 1 roll 2 cat_n } map /zlist set
! 556: %% [(_z1) (_z2) ... ]
! 557: /rule [ 1 1 n 2 mul { pop 0 } for ] def
! 558: 0 1 n 1 sub {
! 559: /i set
! 560: [ @@@.Dsymbol xvars i get 2 cat_n
! 561: [
! 562: (-)
! 563: @@@.Dsymbol zlist i get
! 564: ] cat
! 565: ] /tmpr set
! 566: rule << i n add >> tmpr put
! 567: [ xvars i get
! 568: [ xvars i get
! 569: (-)
! 570: zlist i get
! 571: ] cat
! 572: ] /tmpr set
! 573: rule i tmpr put
! 574: } for
! 575: /arg1 [rule zlist] def
! 576: ] pop
! 577: popVariables
! 578: arg1
! 579: } def
! 580:
! 581: /tensor0 {
! 582: /arg1 set
! 583: [/in-tensor0 /vlist
! 584: /vlist2 /exteriorTensor /aaa /ans
! 585: ] pushVariables
! 586: [
! 587: arg1 tensor0.aux /aaa set
! 588: /exteriorTensor aaa 0 get def
! 589: /vlist aaa 1 get def
! 590: /vlist2 aaa 2 get def
! 591: [exteriorTensor vlist2 [ vlist vlist2 join [ ]] 0] message
! 592: [exteriorTensor vlist2 [ vlist vlist2 join [ ]] 0] restriction
! 593: /ans set
! 594: ans 0 get toVectors2 /arg1 set
! 595: ]pop
! 596: popVariables
! 597: arg1
! 598: } def
! 599:
! 600: /tensor1 {
! 601: /arg1 set
! 602: [/in-tensor0 /vlist
! 603: /vlist2 /exteriorTensor /aaa /ans
! 604: ] pushVariables
! 605: [
! 606: arg1 tensor0.aux /aaa set
! 607: /exteriorTensor aaa 0 get def
! 608: /vlist aaa 1 get def
! 609: /vlist2 aaa 2 get def
! 610: [exteriorTensor vlist2 [ vlist vlist2 join [ ]]] message
! 611: [exteriorTensor vlist2 [ vlist vlist2 join [ ]]] restriction
! 612: /ans set
! 613: ans {toVectors2} map /arg1 set
! 614: ]pop
! 615: popVariables
! 616: arg1
! 617: } def
! 618:
! 619:
! 620:
! 621: /tensor0.aux {
! 622: /arg1 set
! 623: [/in-tensor0.aux /mLeft /mRight /vlist
! 624: /ruleL /ruleR /vlist2 /exteriorTensor
! 625: ] pushVariables
! 626: [(CurrentRingp)] pushEnv
! 627: [
! 628: /mLeft arg1 0 get def
! 629: /mRight arg1 1 get def
! 630: /vlist arg1 2 get def
! 631:
! 632: mLeft {toString} map /mLeft set
! 633: mRight {toString} map /mRight set
! 634: vlist isString {
! 635: [vlist to_records pop ] /vlist set
! 636: } { } ifelse
! 637:
! 638: /ruleL vlist typeL 0 get def
! 639: /ruleR vlist typeR 0 get def
! 640: /vlist2 vlist typeL 1 get def
! 641:
! 642: [vlist vlist2 join from_records
! 643: ring_of_differential_operators 0] define_ring
! 644: ruleL { { . } map } map /ruleL set
! 645: ruleR { { . } map } map /ruleR set
! 646:
! 647: mLeft { . ruleL replace dehomogenize } map /mLeft set
! 648: mRight { . ruleR replace dehomogenize } map /mRight set
! 649:
! 650: /exteriorTensor mLeft mRight join { toString } map def
! 651:
! 652: /arg1 [exteriorTensor vlist vlist2] def
! 653: ] pop
! 654: popEnv
! 655: popVariables
! 656: arg1
! 657: } def
! 658:
! 659: [(tensor0)
! 660: [( [F G vlist] tensor0 )
! 661: (This function requires the package cohom.sm1.)
! 662: (Example 1:)
! 663: ( [[(2 x Dx - 1)] [(2 x Dx - 3)] (x)] tensor0 )
! 664: (Example 2:)
! 665: ( [[(-x*Dx^2+x-Dx+1)] [((x Dx + x +1)(Dx-1))] (x)] tensor0 )
! 666: (Example 3:)
! 667: ( [[(x Dx -1) (y Dy -4)] [(Dx + Dy) (Dx-Dy^2)] (x,y)] tensor0 )
! 668: ]] putUsages
! 669: (tensor0 ) messagen
! 670:
! 671: /wTensor0 {
! 672: /arg1 set
! 673: [/in-wTensor0 /vlist
! 674: /vlist2 /exteriorTensor /aaa /ans /weight /i /wlist
! 675: ] pushVariables
! 676: [
! 677: arg1 /aaa set
! 678: aaa 3 get /wlist set
! 679: [aaa 0 get aaa 1 get aaa 2 get] tensor0.aux /aaa set
! 680: /exteriorTensor aaa 0 get def
! 681: /vlist aaa 1 get def
! 682: /vlist2 aaa 2 get def
! 683:
! 684: [
! 685: 0 1 wlist length 1 sub {
! 686: /i set
! 687: vlist2 i get
! 688: 0 wlist i get sub
! 689: [@@@.Dsymbol vlist2 i get] cat
! 690: wlist i get
! 691: } for
! 692: ] /weight set
! 693: [exteriorTensor vlist vlist2 join weight] message
! 694: [exteriorTensor vlist vlist2 join weight] wRestriction0
! 695: /ans set
! 696: ans 0 get toVectors2 /arg1 set
! 697: ]pop
! 698: popVariables
! 699: arg1
! 700: } def
! 701: (wTensor0 ) messagen
! 702: [(wTensor0)
! 703: [([F G v weight] wTensor0)
! 704: (See tensor0)
! 705: (It calls wRestriction0 instead of restriction.)
! 706: (Example 1:)
! 707: ( [[(x Dx -1) (y Dy -4)] [(Dx + Dy) (Dx-Dy^2)] (x,y) [1 2]] wTensor0 )
! 708: ]] putUsages
! 709:
! 710: %% analyzing a given b-ideal.
! 711: /integralRoots001 {
! 712: /arg1 set
! 713: [/in-integralRoots00 /R /ff /n /i /j
! 714: /ans /ans2
! 715: ] pushVariables
! 716: [(CurrentRingp)] pushEnv
! 717: [
! 718: /ff arg1 def
! 719: /R ff 0 get (ring) dc def
! 720: [(CurrentRingp) R] system_variable
! 721:
! 722: ff toVectors /ff set
! 723: /n 0 def
! 724: 0 1 ff length 1 sub {
! 725: /i set
! 726: ff i get length n gt
! 727: { /n ff i get length def }
! 728: { } ifelse
! 729: } for %% n is the maximal length.
! 730:
! 731: [ 1 1 n { } for ] /ans set
! 732: 1 1 n {
! 733: /i set
! 734: /ans2 [ ] def
! 735: 0 1 ff length 1 sub {
! 736: /j set
! 737: ff j get length i eq {
! 738: ans2 [ ff j get i 1 sub get ] join /ans2 set
! 739: } { } ifelse
! 740: } for
! 741: ans << i 1 sub >> ans2 put
! 742: } for
! 743: /arg1 ans def
! 744: ] pop
! 745: popEnv
! 746: popVariables
! 747: arg1
! 748: } def
! 749:
! 750: /intwbfRoots {
! 751: /arg1 set
! 752: [/in-intwbfRoots /aaa /ggg /vvv /www] pushVariables
! 753: [
! 754: /aaa arg1 def
! 755: aaa 2 get getxvars2 { toString } map /vvv set
! 756: aaa 2 get getdvars2 1 get
! 757: { dup isString { pop } { } ifelse } map /www set
! 758: (vvv=) messagen vvv message
! 759: (www=) messagen www message
! 760: aaa length 3 {
! 761: %% integration.
! 762: aaa intwbf
! 763: /intwbf.bideal set %% global var
! 764: } {
! 765: %% restriction
! 766: aaa wbf
! 767: /intwbf.bideal set %% global var
! 768: } ifelse
! 769: intwbf.bideal integralRoots001
! 770: /intwbf.bideal2 set %% global var
! 771: (b-ideal is ) messagen intwbf.bideal2 message
! 772: (It is in the global variable intwbf.bideal2.) message
! 773: intwbf.bideal2
! 774: { /ggg set
! 775: %% [ggg vvv www] { { (type?) dc } map } map message error
! 776: [ggg vvv www] rationalRoots2
! 777: } map
! 778: /ggg set
! 779:
! 780: %% Integer 0 is returned as a null by ox_asir.
! 781: ggg {{ dup tag 0 eq { pop 0 } { } ifelse } map} map /ggg set
! 782:
! 783: (vvv = ) messagen vvv message
! 784: (www = ) messagen www message
! 785: (Roots are ) messagen ggg message
! 786:
! 787:
! 788: [-intInfinity] ggg flatten join shell rest /arg1 set
! 789: ] pop
! 790: popVariables
! 791: arg1
! 792: } def
! 793:
! 794: [(intwbfRoots)
! 795: [(This function needs oxasir --- rationalRoots2)
! 796: $This function is defined in intw.sm1 and requires oxasir.sm1 and ox_asir server.$
! 797: $Example 1: [[(-3 x^2 Dy-2 y Dx) (2 x Dx+3 y Dy+6)] [(x) (y)] $
! 798: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] intwbfRoots $
! 799: $Example 2: [[[(0) (x^2 Dx+x)] [(Dx^2+x Dx^3) (0)]] [(x)] $
! 800: $ [(x) -1 (Dx) 1]] intwbfRoots $
! 801: ]] putUsages
! 802: (intwbfRoots ) messagen
! 803:
! 804: /wbfRoots {
! 805: /arg1 set
! 806: [/in-wbfRoots /aaa ]pushVariables
! 807: [
! 808: /aaa arg1 def
! 809: aaa [1] join intwbfRoots /arg1 set
! 810: ] pop
! 811: popVariables
! 812: arg1
! 813: } def
! 814: [(wbfRoots)
! 815: [(This function needs oxasir --- rationalRoots2)
! 816: $This function is defined in intw.sm1 and requires oxasir.sm1 and ox_asir server.$
! 817: $Example 1: [[(-3 x^2 Dy-2 y Dx) (2 x Dx+3 y Dy+6)] [(x) (y)] $
! 818: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] wbfRoots $
! 819: $Example 2: [[[(0) (x^2 Dx+x)] [(Dx^2+x Dx^3) (0)]] [(x)] $
! 820: $ [(x) -1 (Dx) 1]] wbfRoots $
! 821: ]] putUsages
! 822: (wbfRoots ) messagen
! 823:
! 824:
! 825:
! 826: /wIntegration0 {
! 827: /arg1 set
! 828: [/in-wIntegration /aaa /rrr /k1 /ans] pushVariables
! 829: [
! 830: /aaa arg1 def
! 831: aaa intwbfRoots /rrr set
! 832: rrr << rrr length 1 sub >> get /k1 set
! 833: k1 0 lt {
! 834: /ans [ ] def
! 835: } {
! 836: aaa [k1] join integral-k1 /ans set
! 837: } ifelse
! 838: (k1 = ) messagen k1 message
! 839: /arg1 ans def
! 840: ] pop
! 841: popVariables
! 842: arg1
! 843: } def
! 844:
! 845: (wIntegration0 ) message
! 846: [(wIntegration0)
! 847: [( [gg vlist weight] wIntegration0 [ igg bb] )
! 848: (list of strings gg; list of strings vlist;)
! 849: (list weight;)
! 850: (integer k1;)
! 851: (list of polys igg; list of polys base;)
! 852: (gg are input ideal or submodule.)
! 853: (igg are relations and bb are bases. They give the integral.)
! 854: (This function fails when weight is not generic.)
! 855: (cf. intwbf, intwbfRoots, integral-k1. )
! 856: $This function is defined in intw.sm1 and requires oxasir.sm1 and ox_asir server.$
! 857: $See Grobner Deformations of Hypergeometric Differential Equations, Springer$
! 858: $ Section 5.5 for the algorithm.$
! 859: $Example 1: [ [(Dt - (3 t^2-x)) (Dx + t)] [(t) (x)] [(t) -1 (Dt) 1]] $
! 860: $ wIntegration0 $
! 861: $Example 2: [[(-3 x^2 Dy-2 y Dx) (2 x Dx+3 y Dy+6)] [(x) (y)] $
! 862: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] wIntegration0 $
! 863: $ The output [[-x, 1] [x,1]] implies the integral is $
! 864: $ (K x + K 1)/(K (-x) + K 1) = 0 where K is the base field and$
! 865: $ x and 1 is the vector space basis.$
! 866: $ Note that the order of weight and the order of the variables$
! 867: $ must be the same. Note also that the next of (x) must be (Dx)$
! 868: $ and so on.$
! 869: ]] putUsages
! 870:
! 871: /wRestriction0 {
! 872: /arg1 set
! 873: [/in-wRestriction0 /gg /vlist /v0 /vv /b /aaa /ans] pushVariables
! 874: [(CurrentRingp)] pushEnv
! 875: [
! 876: /aaa arg1 def
! 877: /gg aaa 0 get def
! 878: /vlist aaa 1 get def
! 879: vlist isArray
! 880: { vlist from_records /v0 set }
! 881: { /v0 vlist def vlist to_records /vlist set } ifelse
! 882: /vv vlist vlist { /b set [@@@.Dsymbol b] cat } map join def
! 883: [v0 ring_of_differential_operators 0] define_ring pop
! 884: gg 0 get isArray {
! 885: gg { { toString . vv laplace0 toString } map } map /gg set
! 886: }
! 887: {
! 888: gg { toString . vv laplace0 toString } map /gg set
! 889: } ifelse
! 890: /ans [gg] aaa rest join wIntegration0 def
! 891:
! 892: [v0 ring_of_differential_operators 0] define_ring pop
! 893: ans { { toString . vv laplace0 } map } map /ans set
! 894: /arg1 ans def
! 895: ] pop
! 896: popEnv
! 897: popVariables
! 898: arg1
! 899: } def
! 900:
! 901: (wRestriction0 ) messagen
! 902: [(wRestriction0)
! 903: [( [gg vlist weight] wRestriction0 [ igg bb] )
! 904: (list of strings gg; list of strings vlist;)
! 905: (list weight;)
! 906: (integer k1;)
! 907: (list of polys igg; list of polys base;)
! 908: (gg are input ideal or submodule.)
! 909: (igg are relations and bb are bases. They give the 0-th restriction.)
! 910: (This function fails when weight is not generic.)
! 911: (cf. intwbf, intwbfRoots, integral-k1. )
! 912: $This function is defined in intw.sm1 and requires oxasir.sm1 and ox_asir server.$
! 913: $See Grobner Deformations of Hypergeometric Differential Equations, Springer$
! 914: $ Section 5.5 for the algorithm.$
! 915: $Example 1: [ [(Dt^2) (Dx^2)] [(t) (x)] [(t) -1 (Dt) 1]] $
! 916: $ wRestriction0 $
! 917: $Example 2: [[(Dx^2) (Dy^2)] [(x) (y)] $
! 918: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] wRestriction0 $
! 919: $ The output [[-Dx, 1] [Dx,1]] implies the restriction is $
! 920: $ (K Dx + K 1)/(K (-Dx) + K 1) = 0 where K is the base field and$
! 921: $ Dx and 1 is the vector space basis.$
! 922: $ Note that the order of weight and the order of the variables$
! 923: $ must be the same. Note also that the next of (x) must be (Dx)$
! 924: $ and so on.$
! 925: ]] putUsages
! 926:
! 927:
! 928:
! 929: /ann-t-f {
! 930: /arg1 set
! 931: [/in-ann-t-f /f /vlist /s /vvv /nnn /rrr
! 932: /v1 /ops /ggg /ggg0
! 933: ] pushVariables
! 934: [(CurrentRingp) (KanGBmessage)] pushEnv
! 935: [
! 936: /f arg1 0 get def /vlist arg1 1 get def
! 937: f toString /f set
! 938: vlist { toString } map /vlist set
! 939: [(KanGBmessage) fs.verbose] system_variable
! 940: /s vlist 0 get def
! 941: /vvv (_u,_v,_t,) vlist rest { (,) 2 cat_n } map aload length /nnn set
! 942: s nnn 2 add cat_n def
! 943: fs.verbose { vvv message } { }ifelse
! 944: [vvv ring_of_differential_operators
! 945: [[(_u) 1 (_v) 1]] weight_vector 0] define_ring /rrr set
! 946:
! 947: [ (_t). f . sub ]
! 948: vlist rest { /v1 set
! 949: f . @@@.Dsymbol v1 2 cat_n . 1 diff0 [@@@.Dsymbol (_t)] cat . mul
! 950: @@@.Dsymbol v1 2 cat_n . add } map
! 951: join
! 952: /ops set
! 953: ops {[[(h). (1).]] replace } map /ops set
! 954: fs.verbose { ops message } { }ifelse
! 955: ops { [[(_t). s .] [[@@@.Dsymbol (_t)] cat . @@@.Dsymbol s 2 cat_n .]] replace dehomogenize } map
! 956: /arg1 set
! 957: ] pop
! 958: popEnv
! 959: popVariables
! 960: arg1
! 961: } def
! 962: [(ann-t-f)
! 963: [(ann-t-f returns the annihilating ideal of delta(t-f(x)))
! 964: $Example: [(x^3-y^2) [(t) (x) (y)]] ann-t-f $
! 965: ]] putUsages
! 966: (ann-t-f ) messagen
! 967:
! 968: /bf-111 {
! 969: /arg1 set
! 970: [/in-bf-111 /aa /vlist /rest-vlist] pushVariables
! 971: [(CurrentRingp) (KanGBmessage)] pushEnv
! 972: [
! 973: /aa arg1 def
! 974: aa 1 get /vlist set
! 975: aa 2 get /rest-vlist set
! 976: /vlist [vlist to_records pop] def
! 977: /rest-vlist [rest-vlist to_records pop] def
! 978: /BFvarlist vlist def /BFparlist [ ] def
! 979: aa 0 get { toString} map
! 980: rest-vlist bfm 0 get /bf-111.bfunc set
! 981: /arg1 bf-111.bfunc def
! 982: ] pop
! 983: popEnv
! 984: popVariables
! 985: arg1
! 986: } def
! 987: [(bf-111)
! 988: [( [ideal vlist rest-vlist bf-111] bf-111 )
! 989: (Compute the b-function for the weight vector 11111 for the variables)
! 990: (res-vlist. cf. wbf)
! 991: (Example: [ [((x Dx -1 ) x Dx (x Dx + 2)) (y Dy)] (x,y) (x)] bf-111 )
! 992: ]] putUsages
! 993: (bf-111 ) messagen
! 994:
! 995: /wdeRham0 {
! 996: /arg1 set
! 997: [/in-wdeRham0 /aaa /ff0 /vlist /myweight] pushVariables
! 998: [
! 999: /aaa arg1 def
! 1000: /ff0 arg1 0 get def
! 1001: /vlist arg1 1 get def
! 1002: /myweight arg1 2 get def
! 1003: [ff0 vlist] annfs /ff0 set
! 1004:
! 1005: /vlist [vlist to_records pop ] def
! 1006: [ff0 0 get vlist myweight] wIntegration0
! 1007: /arg1 set
! 1008: ] pop
! 1009: popVariables
! 1010: arg1
! 1011: } def
! 1012: (wdeRham0 ) messagen
! 1013: [(wdeRham0)
! 1014: [ $It computes the midle dimensional cohomology groups and bases.$
! 1015: $A generic weight vector is used for the computation.$
! 1016: $This function is defined in intw.sm1 and requires oxasir.sm1 and ox_asir server.$
! 1017: $ Example 1 : [(x^3-y^2) (x,y) [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] wdeRham0 $
! 1018: $ Example 2 : [(x^3+y^3+z^3) (x,y,z) $
! 1019: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2 (z) -3 (Dz) 3]] wdeRham0 $
! 1020: $ Example 3 : [(x^3 -y z^2) (x,y,z) $
! 1021: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2 (z) -3 (Dz) 3]] wdeRham0 $
! 1022: $ Example 4 : [(x^3 -y^2 z^2) (x,y,z) $
! 1023: $ [(x) -1 (Dx) 1 (y) -2 (Dy) 2 (z) -3 (Dz) 3]] wdeRham0 $
! 1024: ]] putUsages
! 1025:
! 1026: /intw.sm1.loaded 1 def
! 1027:
! 1028: ( ) message ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to intw.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc