File: [local] / OpenXM / src / kan96xx / Doc / r-interface.sm1 (download)
Revision 1.1.1.1 (vendor branch), Fri Oct 8 02:12:02 1999 UTC (24 years, 11 months ago) by maekawa
Branch: OpenXM, MAIN
CVS Tags: maekawa-ipv6, R_1_3_1-2, RELEASE_20000124, RELEASE_1_3_1_13b, RELEASE_1_2_3_12, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2, RELEASE_1_2_1, RELEASE_1_1_3, RELEASE_1_1_2, KNOPPIX_2006, HEAD, DEB_REL_1_2_3-9, ALPHA Changes since 1.1: +0 -0
lines
o import OpenXM sources
|
%% oaku/Restriction/r-interface.sm1 1998, 4/30. 5/8. 5/12, 11/14
%% 1999, 9/9
%% lib/r-interface.sm1
%%
%% r-interface.sm1 is kept in this directory for the compatibility to
%% old demo programs and packages. It is being merged to
%% resol0.sm1 cf. tower.sm1, tower-sugar.sm1, restall_s.sm1,
%% restall.sm1
%% 1999, 9/9 : this file is stilled being modified for vector input.
%% wbfRoots (oxasir.sm1, intw.sm1) is used to get b-function
%% for modules. Note that wbfRoots works only for generic
%% weights.
%%
/r-interface.version (2.981105) def
/r-interface.verbose 0 def
/deRham.verbose 0 def
%% /BFnotruncate 1 def Controlled from cohom.sm1
r-interface.version [(Version)] system_variable gt
{ (This package requires the latest version of kan/sm1) message
(Please get it from http://www.math.kobe-u.ac.jp/KAN) message
error
} { } ifelse
[(restriction)
[
( [[f1 f2 ...] [t1 t2 ...] [vars params] [k0 k1 limitdeg ]] restriction )
( [ 0-th cohomology group, (-1)-th cohomology group, .... ] )
( )
( [[f1 f2 ...] [t1 t2 ...] [vars params] limitdeg] restriction )
( )
(This function can be used by loading the experimental package cohom.sm1.)
(Restriction of the D-ideal [f1 f2 ...] to t1=0, t2=0, ... is computed. )
(vars is a list of the variables and params is a list of parameters. )
(k0 is the minimum integral root of the b-function and k1 is the maximum)
(integral root of the b-function. If these values are not given and)
(they are small, then they are automatically computed. The program returns)
( 0-th, ..., -limitdeg-th cohomology groups.)
([vars params] and [k0 k1 deg] are optional arguments.)
(If vars and params are not given, the values of the global variables)
(BFvarlist and BFparlist will be used.)
( )
(For the algorithm, see math.AG/9805006, http://xxx.langl.gov)
( )
(Example 1: cf. math.AG/9801114, Example 1.4 )
$ [[(- 2 x Dx - 3 y Dy +1) (3 y Dx^2 - 2 x Dy)] $
$ [(x) (y)] [[(x) (y)] [ ]]] restriction :: $
$[ [ 0 , [ ] ] , [ 1 , [ ] ] , [ 1 , [ ] ] ] $
$ H^0 = 0, H^(-1)= C^1/(no relation), H^(-2)=C^1/(no relation).$
(Example 2: )
$[[(x Dx-1) (Dy^2)] [(y)] [[(x) (y)] [ ]]] restriction ::$
$[ [ 2 , [ -x*Dx+1 , -x*e*Dx+e ] ] , [ 0 , [ ] ] ]$
$ H^0=D_1^2/([-x Dx+1,0],[0, -x Dx + 1]), H^(-1) = 0 $
$ where e^0, e^1, e^2, ..., e^(m-1) are standard basis vectors of$
$ rank m free module (D_1)^m. D_1 is the ring of differential$
$ opertors of one variable x.$
(Example 3: )
$[[(x Dx-1) (Dy^2)] [(y)] [[(x) (y)] [ ]] 0] restriction ::$
(Example 4: )
$[[[(0) (x^2 Dx+x)] [(Dx^2+x Dx^3) (0)]] [(x)] [[(x)] [ ]]] restriction ::$
$In case of vector input, RESTRICTION VARIABLES MUST APPEAR FIRST$
$in the list of variable. We are using wbfRoots to get the roots of $
$b-functions, so we can use only generic weight vector for now.$
]
] putUsages
/restriction {
/arg1 set
[/in-restriction /ppp /verbose /nnn /k0 /k1 /limitdeg
/x-vars /params /mmm /zzz /rest.bfunc
/gg %% it is not used in restriction, but restall*.sm1 destroys gg.
/vectorInput /wvec
] pushVariables
[(CurrentRingp) (KanGBmessage)] pushEnv
[
/ppp arg1 def
/verbose 1 def
ppp
(restriction: argument must be an array.)
rest.listq pop
/nnn ppp length def
nnn 2 lt nnn 4 gt or
{ (restriction: too many or too few arguments) message
(restriction) usage error } { } ifelse
nnn 3 eq nnn 4 eq or
{
%% set up global variables.
ppp 2 get
(restriction: the third argument must be [vars params] or [vars]. For example, [[(x) (y)]].)
rest.listq pop
ppp 2 get length 2 eq { }
{ ppp 2 get length 1 eq {
ppp 2 << ppp 2 get [ ] append >> put
}
{
(restriction: the third argument must be [vars params]) message
error } ifelse
} ifelse
ppp 2 get 0 get (vars must be an array.) rest.listq
{ toString} map /x-vars set
ppp 2 get 1 get (params must be an array.) rest.listq
{ toString} map /params set
}
{/x-vars BFvarlist def /params BFparlist def } ifelse
/mmm ppp 0 get def %% module
/zzz ppp 1 get def %% algebraic set (zero set)
mmm
(restriction: the first argument must be list of polynomials)
rest.listq pop
mmm length 0 eq {
(restriction: the input matrix does not contain generators.) message
error
} { } ifelse
mmm 0 get isArray {
/vectorInput 1 def
} {
/vectorInput 0 def
} ifelse
%% (vectorInput=) messagen vectorInput message
zzz
(restriction: the second argument must be list of polynomials)
rest.listq pop
[x-vars params join from_records ring_of_differential_operators 0]
define_ring
vectorInput {
mmm { {toString . dehomogenize}map } map /mmm set
mmm { {toString} map } map /mmm set
}{
mmm { toString . dehomogenize } map /mmm set
mmm { toString } map /mmm set
} ifelse
zzz { toString } map /zzz set
x-vars rest.checkReserved
params rest.checkReserved
/BFvarlist x-vars def /BFparlist params def
[(KanGBmessage) r-interface.verbose] system_variable
nnn 2 eq nnn 3 eq or
{ %% set up k0, k1 and limitdeg by computing b-functions.
vectorInput {
r-interface.load.oxasir.wint
/wvec zzz { -1 } map zzz { xtoDx } map { 1 } map join def
[mmm BFvarlist wvec] messagen ( wbfRoots ) message
[mmm BFvarlist wvec] wbfRoots /tmp set
}{
[mmm zzz] messagen (bfm ) message
mmm zzz bfm /rest.bfunc00 set
rest.bfunc00 length 0 eq {
(restriction: No b-function. The input may not be holonomic.) error
} { } ifelse
rest.bfunc00 0 get /rest.bfunc set
(b-function is ) messagen rest.bfunc message
rest.bfunc findIntegralRoots /tmp set
} ifelse
tmp length 0 eq
{ (All cohomology groups are zero.) message
/arg1 null def
/r-interface.sortir goto
} { } ifelse
tmp 0 get /k0 set
tmp << tmp length 1 sub >> get /k1 set
/limitdeg zzz length def
}
{
ppp 3 get isInteger
{
/limitdeg ppp 3 get def
vectorInput {
r-interface.load.oxasir.wint
/wvec zzz { -1 } map zzz { xtoDx } map { 1 } map join def
[mmm BFvarlist wvec] messagen ( wbfRoots ) message
[mmm BFvarlist wvec] wbfRoots /tmp set
}{
[mmm zzz] messagen (bfm ) message
mmm zzz bfm /rest.bfunc00 set
rest.bfunc00 length 0 eq {
(restriction: No b-function. The input may not be holonomic.) error
} { } ifelse
rest.bfunc00 0 get /rest.bfunc set
(b-function is ) messagen rest.bfunc message
rest.bfunc findIntegralRoots /tmp set
} ifelse
tmp length 0 eq
{ (All cohomology groups are zero.) message
/arg1 null def
/r-interface.sortir goto
} { } ifelse
tmp 0 get /k0 set
tmp << tmp length 1 sub >> get /k1 set
} {
ppp 3 get
(restriction: the fourth argument must be [k0 k1 limitdeg])
rest.listq pop
ppp 3 get length 3 eq { }
{ (restriction: the fourth argument must be [k0 k1 limitdeg]) message
error } ifelse
ppp 3 get 0 get /k0 set
ppp 3 get 1 get /k1 set
ppp 3 get 2 get /limitdeg set
}ifelse
} ifelse
BFnotruncate {
[mmm zzz k1 limitdeg] messagen ( restall1_s ) message
mmm zzz k1 limitdeg restall1_s /arg1 set
} {
[mmm zzz k0 k1 limitdeg] messagen ( restall_s ) message
mmm zzz k0 k1 limitdeg restall_s /arg1 set
} ifelse
/r-interface.sortir
] pop
popEnv
popVariables
arg1
} def
/rest.listq {
/arg2 set /arg1 set
[/in-rest.listq /sss /aaa] pushVariables
[
/aaa arg1 def /sss arg2 def
aaa isArray { }
{ sss message
error
} ifelse
/arg1 aaa def
]pop
popVariables
arg1
} def
/rest.checkReserved {
% check if s is used.
/arg1 set
[/in-rest.checkReserved /vlist /tmp] pushVariables
[ /vlist arg1 def
vlist (s) position /tmp set
tmp -1 gt
{ (s is the reserved variable.) error }
{ } ifelse
] pop
popVariables
} def
[(integration)
[
( [[f1 f2 ...] [t1 t2 ...] [vars params] [k0 k1 limitdeg ]] integration )
( [ 0-th cohomology group, (-1)-th cohomology group, .... ] )
( )
( [[f1 f2 ...] [t1 t2 ...] [vars params] limitdeg] integration )
( )
(This function can be used by loading the experimental package cohom.sm1.)
(Integration of the D-ideal [f1 f2 ...] to t1=0, t2=0, ... is computed. )
(vars is a list of the variables and params is a list of parameters. )
(k0 is the minimum integral root of the b-function and k1 is the maximum)
(integral root of the b-function. If these values are not given and)
(they are small, then they are automatically computed. The program returns)
( 0-th, ..., -limitdeg-th cohomology groups.)
([vars params] and [k0 k1 deg] are optional arguments.)
(If vars and params are not given, the values of the global variables)
(BFvarlist and BFparlist will be used.)
(The operator restriciton will be used after the laplace transformation.)
( )
(For the algorithm, see math.AG/9805006, http://xxx.langl.gov)
( )
(Example 1: )
$[[(x (x-1)) (x) ] annfs 0 get
[(x)] [[(x)] [ ]]] integration ::$
(Example 2: )
$[ [(Dt - (3 t^2-x)) (Dx + t)] [(t)]
[[(t) (x)] [ ]] 0] integration ::$
(Example 3: )
$[ [[(Dt - (3 t^2-x)) (0)] [ (Dx + t) (0)]] [(t)]
[[(t) (x)] [ ]] 0] integration ::$
$In case of vector input, INTEGRAL VARIABLES MUST APPEAR FIRST$
$in the list of variable. We are using wbfRoots to get the roots of $
$b-functions, so we can use only generic weight vector for now.$
]
] putUsages
/integration {
/arg1 set
[/in-integration /intvars /intvarsD /vars /params /inputs /aaa
/vectorInput
] pushVariables
[
/aaa arg1 def
/inputs aaa 0 get def
/intvars aaa 1 get def
/vars aaa 2 get 0 get def
/params aaa 2 get 1 get def
[ vars params join from_records ring_of_differential_operators 0]
define_ring pop
inputs 0 get isArray {
/vectorInput 1 def
}{
/vectorInput 0 def
} ifelse
vectorInput {
inputs { {toString . dehomogenize} map } map /inputs set
}{
inputs { toString . dehomogenize } map /inputs set
} ifelse
/intvarsD intvars { @@@.Dsymbol 2 1 roll 2 cat_n } map def
vectorInput {
inputs { {intvars intvarsD join laplace0}map } map /inputs set
}{
inputs { intvars intvarsD join laplace0 } map /inputs set
} ifelse
aaa 0 get messagen ( ==> ) messagen inputs message
aaa 0 inputs put
aaa restriction /arg1 set
] pop
arg1
} def
[(deRham)
[([f v] deRham c)
(string f; string v; f is a polynomial given by a string.)
(This function can be used by loading the experimental package cohom.sm1. )
(The dimensions of the deRham cohomology groups H^i(C^n - V(f),C) i=0, i=1, ..)
(.., n are returned in c.)
(For example, if c=[1 4 6 4], then it means that dim H^0(C^3-V(f),C) = 1,)
(dim H^1(C^3-V(f),C) = 4, and so on.)
(For the algorithm, see "An algorithm for de Rham cohomology groups of the)
(complement of an affine variety via D-module computation", )
$Journal of pure and applied algebra, 139 (1999), 201--233. math.AG/9801114$
( )
(Example 0: [(x (x-1) (x-2)) (x)] deRham )
(Example 1: [(x y (x+y-1)(x-2)) (x,y)] deRham )
(Example 2: [(x^3-y^2) (x,y)] deRham )
(Example 3: [(x^3-y^2 z^2) (x,y,z)] deRham )
(Example 4: [(x y z (x+y+z-1)) (x,y,z)] deRham )
]] putUsages
%% [(x+y+z) (x,y,z)] deRham ---> error in bfm, 1998, 11/27
/deRham {
/arg1 set
[/in-deRham /f /v /vlist /vlist0 /ff0 /ff2 /ttt
/r-interface.verbose /tower.verbose /fs.verbose /ans
] pushVariables
[
/r-interface.verbose deRham.verbose def
/tower.verbose deRham.verbose def
/fs.verbose deRham.verbose def
/f arg1 0 get def
/v arg1 1 get def
v isArray {
/v v {toString} map from_records def
} { } ifelse
/vlist0 [v to_records pop] def
/vlist [v to_records pop] dup { /ttt set @@@.Dsymbol ttt 2 cat_n } map
join def
[f v] annfs 0 get /ff0 set
ff0 { vlist laplace0 } map /ff2 set
[ff2 vlist0 [vlist0 [ ]]] restriction /ans set
/arg1 ans {deRham.simp} map reverse def
] pop
popVariables
arg1
} def
%% [3 , [1, e]] ==> 1
/deRham.simp {
/arg1 set
[/in-deRham.simp /gg /kk] pushVariables
[(KanGBmessage)] pushEnv
[
/kk arg1 0 get def
/gg arg1 1 get def
[(KanGBmessage) r-interface.verbose] system_variable
gg length 0 eq { }
{
kk [gg] groebner_sugar 0 get length sub /kk set
} ifelse
/arg1 kk def
] pop
popEnv
popVariables
arg1
} def
/r-interface.load.oxasir.wint {
[
oxasir.sm1.loaded tag 0 eq {
(Loading oxasir.sm1 ) messagen
[(parse) (oxasir.sm1) pushfile] extension
}{
} ifelse
intw.sm1.loaded tag 0 eq {
(Loading intw.sm1 ) messagen
[(parse) (intw.sm1) pushfile] extension
}{
} ifelse
] pop
} def