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