Annotation of OpenXM/src/kan96xx/Doc/r-interface.sm1, Revision 1.1
1.1 ! maekawa 1: %% oaku/Restriction/r-interface.sm1 1998, 4/30. 5/8. 5/12, 11/14
! 2: %% 1999, 9/9
! 3: %% lib/r-interface.sm1
! 4: %%
! 5: %% r-interface.sm1 is kept in this directory for the compatibility to
! 6: %% old demo programs and packages. It is being merged to
! 7: %% resol0.sm1 cf. tower.sm1, tower-sugar.sm1, restall_s.sm1,
! 8: %% restall.sm1
! 9: %% 1999, 9/9 : this file is stilled being modified for vector input.
! 10: %% wbfRoots (oxasir.sm1, intw.sm1) is used to get b-function
! 11: %% for modules. Note that wbfRoots works only for generic
! 12: %% weights.
! 13: %%
! 14: /r-interface.version (2.981105) def
! 15: /r-interface.verbose 0 def
! 16: /deRham.verbose 0 def
! 17: %% /BFnotruncate 1 def Controlled from cohom.sm1
! 18:
! 19: r-interface.version [(Version)] system_variable gt
! 20: { (This package requires the latest version of kan/sm1) message
! 21: (Please get it from http://www.math.kobe-u.ac.jp/KAN) message
! 22: error
! 23: } { } ifelse
! 24:
! 25: [(restriction)
! 26: [
! 27: ( [[f1 f2 ...] [t1 t2 ...] [vars params] [k0 k1 limitdeg ]] restriction )
! 28: ( [ 0-th cohomology group, (-1)-th cohomology group, .... ] )
! 29: ( )
! 30: ( [[f1 f2 ...] [t1 t2 ...] [vars params] limitdeg] restriction )
! 31: ( )
! 32: (This function can be used by loading the experimental package cohom.sm1.)
! 33: (Restriction of the D-ideal [f1 f2 ...] to t1=0, t2=0, ... is computed. )
! 34: (vars is a list of the variables and params is a list of parameters. )
! 35: (k0 is the minimum integral root of the b-function and k1 is the maximum)
! 36: (integral root of the b-function. If these values are not given and)
! 37: (they are small, then they are automatically computed. The program returns)
! 38: ( 0-th, ..., -limitdeg-th cohomology groups.)
! 39: ([vars params] and [k0 k1 deg] are optional arguments.)
! 40: (If vars and params are not given, the values of the global variables)
! 41: (BFvarlist and BFparlist will be used.)
! 42: ( )
! 43: (For the algorithm, see math.AG/9805006, http://xxx.langl.gov)
! 44: ( )
! 45: (Example 1: cf. math.AG/9801114, Example 1.4 )
! 46: $ [[(- 2 x Dx - 3 y Dy +1) (3 y Dx^2 - 2 x Dy)] $
! 47: $ [(x) (y)] [[(x) (y)] [ ]]] restriction :: $
! 48: $[ [ 0 , [ ] ] , [ 1 , [ ] ] , [ 1 , [ ] ] ] $
! 49: $ H^0 = 0, H^(-1)= C^1/(no relation), H^(-2)=C^1/(no relation).$
! 50: (Example 2: )
! 51: $[[(x Dx-1) (Dy^2)] [(y)] [[(x) (y)] [ ]]] restriction ::$
! 52: $[ [ 2 , [ -x*Dx+1 , -x*e*Dx+e ] ] , [ 0 , [ ] ] ]$
! 53: $ H^0=D_1^2/([-x Dx+1,0],[0, -x Dx + 1]), H^(-1) = 0 $
! 54: $ where e^0, e^1, e^2, ..., e^(m-1) are standard basis vectors of$
! 55: $ rank m free module (D_1)^m. D_1 is the ring of differential$
! 56: $ opertors of one variable x.$
! 57: (Example 3: )
! 58: $[[(x Dx-1) (Dy^2)] [(y)] [[(x) (y)] [ ]] 0] restriction ::$
! 59: (Example 4: )
! 60: $[[[(0) (x^2 Dx+x)] [(Dx^2+x Dx^3) (0)]] [(x)] [[(x)] [ ]]] restriction ::$
! 61: $In case of vector input, RESTRICTION VARIABLES MUST APPEAR FIRST$
! 62: $in the list of variable. We are using wbfRoots to get the roots of $
! 63: $b-functions, so we can use only generic weight vector for now.$
! 64: ]
! 65: ] putUsages
! 66:
! 67: /restriction {
! 68: /arg1 set
! 69: [/in-restriction /ppp /verbose /nnn /k0 /k1 /limitdeg
! 70: /x-vars /params /mmm /zzz /rest.bfunc
! 71: /gg %% it is not used in restriction, but restall*.sm1 destroys gg.
! 72: /vectorInput /wvec
! 73: ] pushVariables
! 74: [(CurrentRingp) (KanGBmessage)] pushEnv
! 75: [
! 76: /ppp arg1 def
! 77: /verbose 1 def
! 78: ppp
! 79: (restriction: argument must be an array.)
! 80: rest.listq pop
! 81:
! 82: /nnn ppp length def
! 83: nnn 2 lt nnn 4 gt or
! 84: { (restriction: too many or too few arguments) message
! 85: (restriction) usage error } { } ifelse
! 86:
! 87: nnn 3 eq nnn 4 eq or
! 88: {
! 89: %% set up global variables.
! 90: ppp 2 get
! 91: (restriction: the third argument must be [vars params] or [vars]. For example, [[(x) (y)]].)
! 92: rest.listq pop
! 93:
! 94: ppp 2 get length 2 eq { }
! 95: { ppp 2 get length 1 eq {
! 96: ppp 2 << ppp 2 get [ ] append >> put
! 97: }
! 98: {
! 99: (restriction: the third argument must be [vars params]) message
! 100: error } ifelse
! 101: } ifelse
! 102: ppp 2 get 0 get (vars must be an array.) rest.listq
! 103: { toString} map /x-vars set
! 104: ppp 2 get 1 get (params must be an array.) rest.listq
! 105: { toString} map /params set
! 106: }
! 107: {/x-vars BFvarlist def /params BFparlist def } ifelse
! 108:
! 109:
! 110:
! 111: /mmm ppp 0 get def %% module
! 112: /zzz ppp 1 get def %% algebraic set (zero set)
! 113: mmm
! 114: (restriction: the first argument must be list of polynomials)
! 115: rest.listq pop
! 116:
! 117: mmm length 0 eq {
! 118: (restriction: the input matrix does not contain generators.) message
! 119: error
! 120: } { } ifelse
! 121: mmm 0 get isArray {
! 122: /vectorInput 1 def
! 123: } {
! 124: /vectorInput 0 def
! 125: } ifelse
! 126: %% (vectorInput=) messagen vectorInput message
! 127:
! 128: zzz
! 129: (restriction: the second argument must be list of polynomials)
! 130: rest.listq pop
! 131:
! 132: [x-vars params join from_records ring_of_differential_operators 0]
! 133: define_ring
! 134: vectorInput {
! 135: mmm { {toString . dehomogenize}map } map /mmm set
! 136:
! 137: mmm { {toString} map } map /mmm set
! 138: }{
! 139: mmm { toString . dehomogenize } map /mmm set
! 140:
! 141: mmm { toString } map /mmm set
! 142: } ifelse
! 143: zzz { toString } map /zzz set
! 144:
! 145: x-vars rest.checkReserved
! 146: params rest.checkReserved
! 147:
! 148: /BFvarlist x-vars def /BFparlist params def
! 149:
! 150: [(KanGBmessage) r-interface.verbose] system_variable
! 151:
! 152:
! 153: nnn 2 eq nnn 3 eq or
! 154: { %% set up k0, k1 and limitdeg by computing b-functions.
! 155: vectorInput {
! 156: r-interface.load.oxasir.wint
! 157: /wvec zzz { -1 } map zzz { xtoDx } map { 1 } map join def
! 158: [mmm BFvarlist wvec] messagen ( wbfRoots ) message
! 159: [mmm BFvarlist wvec] wbfRoots /tmp set
! 160: }{
! 161: [mmm zzz] messagen (bfm ) message
! 162: mmm zzz bfm /rest.bfunc00 set
! 163: rest.bfunc00 length 0 eq {
! 164: (restriction: No b-function. The input may not be holonomic.) error
! 165: } { } ifelse
! 166: rest.bfunc00 0 get /rest.bfunc set
! 167: (b-function is ) messagen rest.bfunc message
! 168: rest.bfunc findIntegralRoots /tmp set
! 169: } ifelse
! 170: tmp length 0 eq
! 171: { (All cohomology groups are zero.) message
! 172: /arg1 null def
! 173: /r-interface.sortir goto
! 174: } { } ifelse
! 175: tmp 0 get /k0 set
! 176: tmp << tmp length 1 sub >> get /k1 set
! 177: /limitdeg zzz length def
! 178: }
! 179: {
! 180: ppp 3 get isInteger
! 181: {
! 182: /limitdeg ppp 3 get def
! 183: vectorInput {
! 184: r-interface.load.oxasir.wint
! 185: /wvec zzz { -1 } map zzz { xtoDx } map { 1 } map join def
! 186: [mmm BFvarlist wvec] messagen ( wbfRoots ) message
! 187: [mmm BFvarlist wvec] wbfRoots /tmp set
! 188: }{
! 189: [mmm zzz] messagen (bfm ) message
! 190: mmm zzz bfm /rest.bfunc00 set
! 191: rest.bfunc00 length 0 eq {
! 192: (restriction: No b-function. The input may not be holonomic.) error
! 193: } { } ifelse
! 194: rest.bfunc00 0 get /rest.bfunc set
! 195: (b-function is ) messagen rest.bfunc message
! 196: rest.bfunc findIntegralRoots /tmp set
! 197: } ifelse
! 198: tmp length 0 eq
! 199: { (All cohomology groups are zero.) message
! 200: /arg1 null def
! 201: /r-interface.sortir goto
! 202: } { } ifelse
! 203: tmp 0 get /k0 set
! 204: tmp << tmp length 1 sub >> get /k1 set
! 205: } {
! 206: ppp 3 get
! 207: (restriction: the fourth argument must be [k0 k1 limitdeg])
! 208: rest.listq pop
! 209:
! 210: ppp 3 get length 3 eq { }
! 211: { (restriction: the fourth argument must be [k0 k1 limitdeg]) message
! 212: error } ifelse
! 213: ppp 3 get 0 get /k0 set
! 214: ppp 3 get 1 get /k1 set
! 215: ppp 3 get 2 get /limitdeg set
! 216: }ifelse
! 217: } ifelse
! 218:
! 219: BFnotruncate {
! 220: [mmm zzz k1 limitdeg] messagen ( restall1_s ) message
! 221: mmm zzz k1 limitdeg restall1_s /arg1 set
! 222: } {
! 223: [mmm zzz k0 k1 limitdeg] messagen ( restall_s ) message
! 224: mmm zzz k0 k1 limitdeg restall_s /arg1 set
! 225: } ifelse
! 226: /r-interface.sortir
! 227: ] pop
! 228: popEnv
! 229: popVariables
! 230: arg1
! 231: } def
! 232:
! 233: /rest.listq {
! 234: /arg2 set /arg1 set
! 235: [/in-rest.listq /sss /aaa] pushVariables
! 236: [
! 237: /aaa arg1 def /sss arg2 def
! 238: aaa isArray { }
! 239: { sss message
! 240: error
! 241: } ifelse
! 242: /arg1 aaa def
! 243: ]pop
! 244: popVariables
! 245: arg1
! 246: } def
! 247:
! 248: /rest.checkReserved {
! 249: % check if s is used.
! 250: /arg1 set
! 251: [/in-rest.checkReserved /vlist /tmp] pushVariables
! 252: [ /vlist arg1 def
! 253: vlist (s) position /tmp set
! 254: tmp -1 gt
! 255: { (s is the reserved variable.) error }
! 256: { } ifelse
! 257: ] pop
! 258: popVariables
! 259: } def
! 260:
! 261: [(integration)
! 262: [
! 263: ( [[f1 f2 ...] [t1 t2 ...] [vars params] [k0 k1 limitdeg ]] integration )
! 264: ( [ 0-th cohomology group, (-1)-th cohomology group, .... ] )
! 265: ( )
! 266: ( [[f1 f2 ...] [t1 t2 ...] [vars params] limitdeg] integration )
! 267: ( )
! 268: (This function can be used by loading the experimental package cohom.sm1.)
! 269: (Integration of the D-ideal [f1 f2 ...] to t1=0, t2=0, ... is computed. )
! 270: (vars is a list of the variables and params is a list of parameters. )
! 271: (k0 is the minimum integral root of the b-function and k1 is the maximum)
! 272: (integral root of the b-function. If these values are not given and)
! 273: (they are small, then they are automatically computed. The program returns)
! 274: ( 0-th, ..., -limitdeg-th cohomology groups.)
! 275: ([vars params] and [k0 k1 deg] are optional arguments.)
! 276: (If vars and params are not given, the values of the global variables)
! 277: (BFvarlist and BFparlist will be used.)
! 278: (The operator restriciton will be used after the laplace transformation.)
! 279: ( )
! 280: (For the algorithm, see math.AG/9805006, http://xxx.langl.gov)
! 281: ( )
! 282: (Example 1: )
! 283: $[[(x (x-1)) (x) ] annfs 0 get
! 284: [(x)] [[(x)] [ ]]] integration ::$
! 285: (Example 2: )
! 286: $[ [(Dt - (3 t^2-x)) (Dx + t)] [(t)]
! 287: [[(t) (x)] [ ]] 0] integration ::$
! 288: (Example 3: )
! 289: $[ [[(Dt - (3 t^2-x)) (0)] [ (Dx + t) (0)]] [(t)]
! 290: [[(t) (x)] [ ]] 0] integration ::$
! 291: $In case of vector input, INTEGRAL VARIABLES MUST APPEAR FIRST$
! 292: $in the list of variable. We are using wbfRoots to get the roots of $
! 293: $b-functions, so we can use only generic weight vector for now.$
! 294: ]
! 295: ] putUsages
! 296:
! 297: /integration {
! 298: /arg1 set
! 299: [/in-integration /intvars /intvarsD /vars /params /inputs /aaa
! 300: /vectorInput
! 301: ] pushVariables
! 302: [
! 303: /aaa arg1 def
! 304: /inputs aaa 0 get def
! 305: /intvars aaa 1 get def
! 306: /vars aaa 2 get 0 get def
! 307: /params aaa 2 get 1 get def
! 308: [ vars params join from_records ring_of_differential_operators 0]
! 309: define_ring pop
! 310: inputs 0 get isArray {
! 311: /vectorInput 1 def
! 312: }{
! 313: /vectorInput 0 def
! 314: } ifelse
! 315: vectorInput {
! 316: inputs { {toString . dehomogenize} map } map /inputs set
! 317: }{
! 318: inputs { toString . dehomogenize } map /inputs set
! 319: } ifelse
! 320: /intvarsD intvars { @@@.Dsymbol 2 1 roll 2 cat_n } map def
! 321: vectorInput {
! 322: inputs { {intvars intvarsD join laplace0}map } map /inputs set
! 323: }{
! 324: inputs { intvars intvarsD join laplace0 } map /inputs set
! 325: } ifelse
! 326:
! 327: aaa 0 get messagen ( ==> ) messagen inputs message
! 328: aaa 0 inputs put
! 329: aaa restriction /arg1 set
! 330:
! 331: ] pop
! 332: arg1
! 333: } def
! 334:
! 335:
! 336: [(deRham)
! 337: [([f v] deRham c)
! 338: (string f; string v; f is a polynomial given by a string.)
! 339: (This function can be used by loading the experimental package cohom.sm1. )
! 340: (The dimensions of the deRham cohomology groups H^i(C^n - V(f),C) i=0, i=1, ..)
! 341: (.., n are returned in c.)
! 342: (For example, if c=[1 4 6 4], then it means that dim H^0(C^3-V(f),C) = 1,)
! 343: (dim H^1(C^3-V(f),C) = 4, and so on.)
! 344: (For the algorithm, see "An algorithm for de Rham cohomology groups of the)
! 345: (complement of an affine variety via D-module computation", )
! 346: $Journal of pure and applied algebra, 139 (1999), 201--233. math.AG/9801114$
! 347: ( )
! 348: (Example 0: [(x (x-1) (x-2)) (x)] deRham )
! 349: (Example 1: [(x y (x+y-1)(x-2)) (x,y)] deRham )
! 350: (Example 2: [(x^3-y^2) (x,y)] deRham )
! 351: (Example 3: [(x^3-y^2 z^2) (x,y,z)] deRham )
! 352: (Example 4: [(x y z (x+y+z-1)) (x,y,z)] deRham )
! 353: ]] putUsages
! 354: %% [(x+y+z) (x,y,z)] deRham ---> error in bfm, 1998, 11/27
! 355: /deRham {
! 356: /arg1 set
! 357: [/in-deRham /f /v /vlist /vlist0 /ff0 /ff2 /ttt
! 358: /r-interface.verbose /tower.verbose /fs.verbose /ans
! 359: ] pushVariables
! 360: [
! 361: /r-interface.verbose deRham.verbose def
! 362: /tower.verbose deRham.verbose def
! 363: /fs.verbose deRham.verbose def
! 364: /f arg1 0 get def
! 365: /v arg1 1 get def
! 366: v isArray {
! 367: /v v {toString} map from_records def
! 368: } { } ifelse
! 369: /vlist0 [v to_records pop] def
! 370: /vlist [v to_records pop] dup { /ttt set @@@.Dsymbol ttt 2 cat_n } map
! 371: join def
! 372: [f v] annfs 0 get /ff0 set
! 373:
! 374: ff0 { vlist laplace0 } map /ff2 set
! 375: [ff2 vlist0 [vlist0 [ ]]] restriction /ans set
! 376: /arg1 ans {deRham.simp} map reverse def
! 377: ] pop
! 378: popVariables
! 379: arg1
! 380: } def
! 381:
! 382: %% [3 , [1, e]] ==> 1
! 383: /deRham.simp {
! 384: /arg1 set
! 385: [/in-deRham.simp /gg /kk] pushVariables
! 386: [(KanGBmessage)] pushEnv
! 387: [
! 388: /kk arg1 0 get def
! 389: /gg arg1 1 get def
! 390: [(KanGBmessage) r-interface.verbose] system_variable
! 391: gg length 0 eq { }
! 392: {
! 393: kk [gg] groebner_sugar 0 get length sub /kk set
! 394: } ifelse
! 395: /arg1 kk def
! 396: ] pop
! 397: popEnv
! 398: popVariables
! 399: arg1
! 400: } def
! 401:
! 402:
! 403: /r-interface.load.oxasir.wint {
! 404: [
! 405: oxasir.sm1.loaded tag 0 eq {
! 406: (Loading oxasir.sm1 ) messagen
! 407: [(parse) (oxasir.sm1) pushfile] extension
! 408: }{
! 409: } ifelse
! 410: intw.sm1.loaded tag 0 eq {
! 411: (Loading intw.sm1 ) messagen
! 412: [(parse) (intw.sm1) pushfile] extension
! 413: }{
! 414: } ifelse
! 415: ] pop
! 416: } def
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to r-interface.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc