%% oaku/Restriction/r-interface.sm1   1998,  4/30. 5/8. 5/12, 11/14
%% 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
%%
/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 ::$
 ]
] 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.
  ] 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

     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
     mmm { toString . dehomogenize } map /mmm set

     mmm { toString } map /mmm set
     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.
        [mmm zzz] messagen (bfm ) message
        mmm zzz bfm 0 get /rest.bfunc set
        (b-function is ) messagen rest.bfunc message
        rest.bfunc findIntegralRoots /tmp set
        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
            [mmm zzz] messagen (bfm ) message
            mmm zzz bfm 0 get /rest.bfunc set
            (b-function is ) messagen rest.bfunc message
            rest.bfunc findIntegralRoots /tmp set
            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.) message 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 ::$
 ]
] putUsages

/integration {
  /arg1 set
  [/in-integration /intvars /intvarsD /vars /params /inputs /aaa] 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 { toString . dehomogenize } map /inputs set
     /intvarsD  intvars { @@@.Dsymbol 2 1 roll 2 cat_n } map def
     inputs { intvars intvarsD join laplace0 } map /inputs set

     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", to appear in)
 (Journal of pure and applied algebra, 1998. 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
   /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