Return to intw.sm1 CVS log

Up to [local] / OpenXM / src / kan96xx / Doc

Added OpenXM-tag.

%% $OpenXM: OpenXM/src/kan96xx/Doc/intw.sm1,v 1.3 2003/10/16 05:03:13 takayama Exp $
%%   When you use wIntegration0, you need oxasir.sm1.
%%   Load this package after you have loaded cohom.sm1.
%%   Annihilating ideal,  0-th integral and restriction with weight vector.
%%   1998, 11/6, 11/9, 11/18
%%   1999,  1/25, 6/5.
%% It was at gbhg3/Int/intw.sm1  <-- s linked from lib/intw.sm1  
%% This file is error clean.
/intw.verbose 0 def
/intw.stat 0 def   %% statistics.

%% cf. gbhg3/Demo/ann.sm1
/intw.version (2.981105) def
(lib/intw.sm1, Version 1999, 6/13. Package for integration with a generic weight.) message
oxasir.ccc tag 0 eq {
  (Warning: The functions *wbfRoots, wdeRham0, wIntegration0 does not work without oxasir.) message
  (         This package requires oxasir.sm1 and ox_asir server.) message
} { } ifelse
cohom.sm1.loaded tag 0 eq {
  (Warning: This package requires cohom.sm1 ) message
} { } ifelse
oxasir.sm1.loaded tag 0 eq {
  (Warning: This package requires oxasir.sm1 ) message
} { } ifelse

intw.version [(Version)] system_variable gt
{ [(This package requires the latest version of kan/sm1) nl
   (Please get it from http://www.math.kobe-u.ac.jp/KAN) ] cat
  error
} { } ifelse


[(integral-k1)
 [([[f1 ... fm] [v1 ... vn] [v1 w1 ... vp wp] k1] integral0 )
  (                                              [[g1 ... gq],[e1,...,er]])
  (poly|string f1 ...fm; string v1 ... vn;)
  (string v1 ... vp; integer w1 ... wp;)
  (integer k1;)
  (poly g1 ... gq; poly e1, ..., er;)
  (f1 ... fm are annihilors, v1 ... vn are variables,)
  (w1 is the weight of the variable v1, ...)
  (k1 is the maximal degree of the filtration: maximal integral root)
  (of b-function. cf. intwbf)
  (g1, ..., gq are integral. e1, ..., er are basis of the free module to which)
  (the g1, ..., gq belong.)
  (THE ORDERS OF INTEGRAL VARIABLES MUST BE SAME BOTH IN THE SECOND AND)
  (THE THIRD ARGUMENTS. INTEGRAL VARIABLES MUST APPEAR FIRST.)
  $Example 1: [[(x-y) (Dx+Dy)] [(y) (x)] [(y) -1 (Dy) 1] 1] integral-k1$
  $Example 2: [[(x (x-1)) (x)] annfs 0 get [(x)] [(x) -1 (Dx) 1] 1] integral-k1$
  $Example 3: [[ (Dt- (2 t x1 + x2)) (Dx1 - t^2) (Dx2 - t) ] $
  $            [(t) (x1) (x2)] [(t) -1 (Dt) 1] 0] integral-k1 $
  $           The resulting ideal annihilates f(x1,x2)=int(x1*t^2+x2*t,dt) $
 ]
] putUsages (integral-k1 ) messagen
/integral-k1 {
  /arg1 set
  [/in-integral0 /ff /vv /ww /gg1 /gg2 /ord-vec
   /dt-list /nn /ii /dt-ii /mm /jj  /xvars /dvars /ans1 /k1 /kk /ans2
   /vec-input /vec-length
  ] pushVariables
  [(CurrentRingp) (KanGBmessage)] pushEnv
  [
    /ff arg1 0 get def
    /vv arg1 1 get def
    /ww arg1 2 get def
    /k1 arg1 3 get def
    /vec-length 1 def
    intw.verbose 
    { [ff vv ww k1] messagen ( is the input. ) message } { } ifelse
    ff 0 get isArray {
      ff { {toString} map } map /ff set
      /vec-input 1 def
      %% Compute the length of the input vector
      ff { length dup vec-length gt { /vec-length set } {  pop } ifelse } map
    }{
      ff {toString} map /ff set
      /vec-input 0 def
    } ifelse
    /vv  vv { (,) 2 cat_n } map aload length cat_n def
    intw.verbose { vv message } {  } ifelse
    [(KanGBmessage) intw.verbose] system_variable
    [vv ring_of_differential_operators
     [ww] weight_vector 0] define_ring
    ww getxvars2 /xvars set
    ww getdvars2 /dvars set
    intw.verbose {
    (xvars = ) messagen xvars message
    (dvars = ) messagen dvars message
    } {  } ifelse
    %% ww = [(x) -1 (Dx) 1 (z) -1 (Dz) 1]
    %% dvars = [[(Dx) (Dz)] [(Dx) 1 (Dz) 1]]
    %% xvars = [(x) (z)]
    /integral0.ff ff def  %% keep variable for debug.

    vec-input {
      ff { { . [[(h). (1).]] replace ww laplace0} map homogenize } map /ff set
    } {
      ff { . [[(h). (1).]] replace ww laplace0 homogenize } map /ff set
      %% recompute the lenth of the vector.  For e input.
      ff { @@@.esymbol . degree 1 add dup vec-length gt 
           { /vec-length set } {  pop } ifelse } map

    } ifelse

    intw.verbose {
      (Computing Groebner basis with the weight vector ) messagen
       ww message
    } { } ifelse
    [ff] groebner 0 get {[[(h). (1).]] replace} map /gg1 set
    intw.verbose {
      gg1 message           %% keep variable for debug.
    } {  } ifelse
    %% gg1 is the (-w,w)-adapted basis.
    /integral0.gg1 gg1 def


   intw.verbose {
     (Computing gr 0-k1 of I  in D v^0 + D v^1 + ... + D v^{k1} : shifting) 
     message
   } {  } ifelse
   /ans1 [ ] def
   0 1 k1 {
     /kk set
    intw.verbose {
      (kk = ) messagen kk message
    } {  } ifelse
    /ord-vec gg1 { ww ord_w kk sub} map def
    intw.verbose {  ord-vec message  } {  } ifelse
    %% ww = [(x) -1 (Dx) 1], kk == 0
    %% gg1 = [ (x Dx).  (y Dx). (x).] 
    %% ord-vec = [ 0    1       -1  ]
    %% dt-list = [ [ 1]   [ 0 ]  [ (Dx^1).] ]
    ord-vec { 0  2 1 roll sub } map 
   { 
      dvars 0 get { . } map  %% [(Dx). (Dz).]
      dvars 1 get { dup (type?) dc 5 eq { pop } { } ifelse } map %% [1 1]
      3 -1 roll  ip1
    } map /dt-list set
    %% dt-list [ [ 1 ] [  ] [ (Dx^1).] ]
    dt-list { dup length 0 eq { pop [ (0). ] } {  } ifelse } map /dt-list set
    intw.verbose {
      (dt-list = ) messagen dt-list message
    } { } ifelse
    %%%  t1, -1 ;  t2 , -1;
    %% dt-list = [ [ (Dt1). (Dt2). ] [ (1). ] ]
    %% gg1     = [   (t1+t2).          (t1 Dt2). ]
    /nn gg1 length def
    [
      0 1 nn 1 sub {
        /ii set
        dt-list ii get /dt-ii set  
        /mm dt-ii length def
        0 1 mm 1 sub {
          /jj set
          dt-ii jj get
          gg1 ii get mul
          [[(h). (1).]] replace
           xvars { [ 2 1 roll . (0). ] } map replace ww laplace0
        } for
      } for
    ] ans1 join /ans1 set
  } for
  intw.verbose {
    ( ans1 = [ degree-k1, ..., degree-0] = ) messagen
     ans1 message
  } {  } ifelse

  intw.verbose
  {  (Eliminating xvars (variable of integration.) ) message }
  {  } ifelse
  ans1 { dup (0). eq { pop } { } ifelse } map /ans1 set
  ans1 [ ] eq 
  {  [ $There is no relation. It means that there are ($ 
        k1 1 add 
       $)*(length-of-the-input-vector) free basis.$ 
     ] {toString messagen} map
     (  ) message
     /ans2 [ ] def /integral-k1.L1 goto
  } {  } ifelse
  [vv ring_of_differential_operators
   %% elimination order.
   [ xvars {  1 } map ] weight_vector 0] define_ring
  [(NN) 
    [(NN)] system_variable xvars length sub
  ] system_variable
  %%%%  xvars are regarded as vector index by this trick!!
  %%%%  NN should be recovered to the original value or
  %%%%  Each ring should have a flag --- <<the constant might be changed(rw)>>
  %%%%  In a future version of sm1, when setUpRing is called, sm1 looks for
  %%%%  ring data base and if it finds the same ring and the flag of the ring
  %%%%  is (ro), then it does not generate a new ring structure. 1998, 11/19.
  (isSameComponent) (xd) switch_function  %% for test.

  [ ans1 { toString . } map ] groebner_sugar 0 get /ans2 set
  /integral0.ans ans2 def

  intw.stat 
  { (Size of GB integral0.gg1 is ) messagen integral0.gg1 length message
    (Size of the generators of the submodule integral0.ans is ) messagen
    integral0.ans length message    
  } { } ifelse

  /integral-k1.L1
  %%%% Compute the vector space basis
  %%% /www2 /vbase /ebase /vbase2 
  %% xvars = [(x) (z)], www2 = [1 1], k1=2, vec-length=2
  %% [1 e] [1, x, z, x^2, x z, z^2]
  /www2 dvars 1 get { dup isString { pop } { } ifelse } map def
  [xvars www2 k1] ip1a /vbase set
  vbase { toString . } map /vbase set
  [0 1 vec-length 1 sub { @@@.esymbol . 2 1 roll npower } for] /ebase set
  /vbase2 [ ] def ebase { vbase mul vbase2 join /vbase2 set} map
  intw.verbose {
    (base is ) messagen vbase2 message
  } {  } ifelse

  /arg1 [ans2 vbase2] def
  ] pop
  popEnv
  popVariables
  arg1
} def

/homogenize2 {
  /arg1 set
  [/in-homogenize2 /f /ans] pushVariables
  [
     /f arg1 def
     f isArray {
       f { homogenize } map /ans set
     }
     {  /ans f homogenize def
     } ifelse
     /arg1 ans def
  ] pop
  popVariables
  arg1
} def


%%% aux functions.
%% ww = [(x) -1 (Dx) 1 (z) -1 (Dz) 1]
%% getdvars2 ==> dvars = [[(Dx) (Dz)] [(Dx) 1 (Dz) 1]]
%% getxvars2 ==> xvars = [(x) (z)]
/getxvars2 {
  /arg1 set
  [/in-getxvars2 /ww /vv /ans /ii /nn /ans] pushVariables
  [ /ww arg1 def
    /ans [  ] def
    /nn ww length def
    0 1 nn 1 sub {
      /ii set
      ww ii get (type?) dc 1 eq
      {  }  % skip, may be weight [(x) 2 ] is OK.
      {
         /vv ww ii get (string) dc def
         vv (array) dc 0 get 
         @@@.Dsymbol (array) dc 0 get  
         eq  %% If the first character is D?
         {  } % skip
         { ans [ vv ] join /ans set }
         ifelse
       } ifelse
    } for
    /arg1 ans def
  ] pop
  popVariables
  arg1
} def
%% ww = [(x) -1 (Dx) 1 (z) -1 (Dz) 1]
%% dvars = [[(Dx) (Dz)] [(Dx) 1 (Dz) 1]]
%% xvars = [(x) (z)]
/getdvars2 {
  /arg1 set
  [/in-getdvars2 /ww /vv /ans /ii /nn /ans1 /ans2] pushVariables
  [ /ww arg1 def
    /ans1 [  ] def /ans2 [ ] def
    /nn ww length def
    0 1 nn 1 sub {
      /ii set
      ww ii get (type?) dc 1 eq
      {  }  % skip, may be weight [(x) 2 ] is OK.
      {
         /vv ww ii get (string) dc def
         vv (array) dc 0 get
         @@@.Dsymbol (array) dc 0 get  
         eq  %% If the first character is D?
         { ans1 [ vv ] join /ans1 set
           ans2 [ vv ww ii 1 add get ] join /ans2 set
          }
         {  } %% skip
         ifelse
       } ifelse
    } for
    /arg1 [ans1 ans2] def
  ] pop
  popVariables
  arg1
} def

[(wbf)
 [([[f1 ... fm] [v1 ... vn] [v1 w1 ... vp wp]] wbf [g1 ... gq])
  (<poly>|<string> f1 ...fm; <string> v1 ... vn;)
  (<string> v1 ... vp; <integer> w1 ... wp;)
  (<poly> g1 ... gq;)
  (f1 ... fm are generators, v1 ... vn are variables,)
  (w1 is the weight of the variable v1, ...)
  (THE ORDERS OF INTEGRAL VARIABLES MUST BE SAME BOTH IN THE SECOND AND)
  (THE THIRD ARGUMENTS. INTEGRAL VARIABLES MUST APPEAR FIRST.)
  (If the weight is not generic, then the function exits with error.)
  (cf. bf-111 for w=(1 1 1 1 ...) )
  $Example 1: [[(x-y) (Dx+Dy)] [(y) (x)] [(y) -1 (Dy) 1]] wbf$
  $            restrict only for y.$
  $Example 2: [[(-3 x^2 Dy-2 y Dx) (2 x Dx+3 y Dy+6)] [(x) (y)]$
  $            [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] wbf$
  $Example 3: [[[(0) (x^2 Dx+x)] [(Dx^2+x Dx^3) (0)]] [(x)]$
  $            [(x) -1 (Dx) 1]] wbf$
 ]
] putUsages ( wbf ) messagen
/wbf {
  /arg1 set
  [/in-wbf /aaa] pushVariables
  [ /aaa arg1 def
    aaa [1] join intwbf /arg1 set
  ] pop
  popVariables
  arg1
} def

[(intwbf)
 [([[f1 ... fm] [v1 ... vn] [v1 w1 ... vp wp]] intwbf [g1 ... gq])
  (<poly>|<string> f1 ...fm; <string> v1 ... vn;)
  (<string> v1 ... vp; <integer> w1 ... wp;)
  (<poly> g1 ... gq;)
  (f1 ... fm are generators, v1 ... vn are variables,)
  (w1 is the weight of the variable v1, ...)
  (THE ORDERS OF INTEGRAL VARIABLES MUST BE SAME BOTH IN THE SECOND AND)
  (THE THIRD ARGUMENTS. INTEGRAL VARIABLES MUST APPEAR FIRST.)
  (If the weight is not generic, then the function exits with error.)
  $Example 1: [[(x-y) (Dx+Dy)] [(y) (x)] [(y) -1 (Dy) 1]] intwbf$
  $            integrate only for y.$
  $Example 2: [[(-3 x^2 Dy-2 y Dx) (2 x Dx+3 y Dy+6)] [(x) (y)]$
  $            [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] intwbf$
  $Example 3: [[[(0) (x^2 Dx+x)] [(Dx^2+x Dx^3) (0)]] [(x)]$
  $            [(x) -1 (Dx) 1]] intwbf$
 ]
] putUsages ( intwbf ) messagen

/intwbf {
  /arg1 set
  [/in-integral0 /ff /vv /ww /gg1 /gg2 /ord-vec
   /dt-list /nn /ii /dt-ii /mm /jj  /xvars /dvars /ans1 /k1 /kk /ans2
   /vec-input /gg1.init /gg1.init2 /complementxvars /gg1.init3
   /rest-bf
  ] pushVariables
  [(CurrentRingp) (KanGBmessage)] pushEnv
  [
    /ff arg1 0 get def
    /vv arg1 1 get def
    /ww arg1 2 get def
    arg1 length 4 eq {
      /rest-bf 1 def
      intw.verbose { (bf for restriction.) message } { } ifelse
    } {
      /rest-bf 0 def
      intw.verbose { (bf for integration.) message } { } ifelse
    } ifelse
    intw.verbose 
    { [ff vv ww ] messagen ( is the input. ) message } { } ifelse
    ff 0 get isArray {
      ff { {toString} map } map /ff set
      /vec-input 1 def
    }{
      ff {toString} map /ff set
      /vec-input 0 def
    } ifelse
    /vv  vv { (,) 2 cat_n } map aload length cat_n def
    intw.verbose { vv message } {  } ifelse
    [(KanGBmessage) intw.verbose] system_variable
    [vv ring_of_differential_operators
     [ww] weight_vector 0] define_ring
    ww getxvars2 /xvars set
    ww getdvars2 /dvars set
    intw.verbose {
    (xvars = ) messagen xvars message
    (dvars = ) messagen dvars message
    } {  } ifelse
    %% ww = [(x) -1 (Dx) 1 (z) -1 (Dz) 1]
    %% dvars = [[(Dx) (Dz)] [(Dx) 1 (Dz) 1]]
    %% xvars = [(x) (z)]
    /integral0.ff ff def  %% keep variable for debug.

    rest-bf {
     %% No Laplace transform for the restriction.
     vec-input {
       ff { { . [[(h). (1).]] replace } map homogenize } map /ff set
     } {
       ff { . [[(h). (1).]] replace homogenize } map /ff set
     } ifelse
    }{
     vec-input {
       ff { { . [[(h). (1).]] replace ww laplace0} map homogenize } map /ff set
     } {
       ff { . [[(h). (1).]] replace ww laplace0 homogenize } map /ff set
     } ifelse
    } ifelse

    intw.verbose {
      (Computing Groebner basis with the weight vector ) messagen
       ww message
    } { } ifelse
    [ff] groebner 0 get {[[(h). (1).]] replace} map /gg1 set
    intw.verbose {
      gg1 message           %% keep variable for debug.
    } {  } ifelse
    %% gg1 is the (-w,w)-adapted basis.
    /integral0.gg1 gg1 def
    %%% The above code is as same as that of integral-k1

    intwbf.aux1  
    /arg1 set
  ] pop
  popEnv
  popVariables
  arg1
} def

/intwbf.aux1 {
  [/gg1.init /gg1.init2 /complementxvars /gg1.init3] pushVariables
  [(CurrentRingp)] pushEnv
  [
    %%% It uses local variables in intwbf or integral-k1
    %%%%%%% Let's compute the b-function. It only works for full integration
    %%%%%%% and generic weight vector.
    %% order must be defined by (1) www and (2) [@@@.esymbol  1]
    %%  (x Dx^2 e + Dx e + x e + Dx) -->x Dx^2 e + Dx e + Dx --> (x Dx^2 + Dx)e
    intw.verbose {
     [(-------------- computing the b-ideal for generic initial. ---------)
     $-------- if the output is [(e f_1(x,y)) (e f_2(x,y)) g_1(x,y) g_2(x,y) --$
     $-------- then (f_1,f_2) cap (g_1,g_2) would be the b-ideal. $
     ]{message} map
    } { } ifelse
    /complementxvars xvars [vv to_records pop] complement def
    intw.verbose {
      (vv = ) messagen vv message
      (step1. complementxvars = ) messagen complementxvars message
    } { } ifelse
    complementxvars { dup @@@.Dsymbol 2 1 roll 2 cat_n } map
    /complementxvars set
    intw.verbose {
      (step2. complementxvars = ) messagen complementxvars message
    } { } ifelse
    %% vv = (x,y,z)
    %% xvars = [(x) (z)]
    %% complementxvars = [(y) (Dy)]

    gg1 {ww weightv init [@@@.esymbol  1] weightv init} map /gg1.init set
    intw.verbose {
      gg1.init message 
    } { } ifelse
    gg1.init { xvars {.} map dvars 0 get {.} map xvars {.} map 
               distraction2 } map  /gg1.init2 set
    %% remove 0
    gg1.init2 { dup (0). eq { pop } {  } ifelse } map /gg1.init2 set

    %% Let's eliminate complementxvars
    complementxvars [ ] eq {  }
    {
       [vv ring_of_differential_operators
        [ complementxvars { 1 } map ] weight_vector 0] define_ring
       [gg1.init2 { dehomogenize toString . } map] groebner_sugar
       0 get /gg1.init3 set
       gg1.init3 complementxvars eliminatev /gg1.init2 set 
    } ifelse

    intw.verbose {
      (b-ideal is --------) message
      gg1.init2 message
    } {  } ifelse 

    gg1.init2 /arg1 set
  ] pop
  popEnv
  popVariables
  arg1
} def

%%% see, gbhg3/Int/int1.sm1


[(ip1a)
 [([vlist wlist k] ip1a slist)
  ( x^i ; i_1 w_1 + ... + i_p w_p <= k )
  (Example 1: [[(x) (y) (z)] [1 1 1] 3] ip1a )
  (Example 2: [[(x)] [1] 4] ip1a )
]] putUsages
/ip1a {
  /arg1 set
  [/in-ip1a /vlist /wlist /kk /ans /i] pushVariables
  [(CurrentRingp)] pushEnv
  [
    /vlist arg1 0 get def
    /wlist arg1 1 get def
    /kk    arg1 2 get def

    [vlist from_records ring_of_polynomials 0] define_ring
    vlist { toString . } map /vlist set
    /ans [ ] def
    0 1 kk {
      /i set
      vlist wlist i ip1 ans join /ans set
    } for
    ans /arg1 set
  ] pop
  popEnv
  popVariables
  arg1
} def


%% [(x1) (x2)] typeL [ [[(Dx1) (Dx1+D_z1)] [(Dx2) (Dx2+D_z2)]]
%%                     [(_z1) (_z2)] ]
/typeL {
  /arg1 set
  [/in-typeL /xvars /n /zlist /i /tmpr] pushVariables
  [
    /xvars arg1 def
    xvars length /n set
    [ 1 1 n { toString } for ] /zlist set
    zlist { (_z) 2 1 roll 2 cat_n } map /zlist set
    %% [(_z1) (_z2) ... ]
    /rule [ 1 1 n { pop 0 } for ] def
    0 1 n 1 sub {
      /i set
      [ @@@.Dsymbol xvars i get 2 cat_n
        [@@@.Dsymbol xvars i get
         (+)
         @@@.Dsymbol zlist i get
        ] cat
      ] /tmpr set
      rule i tmpr put
    } for
    /arg1 [rule zlist] def
  ] pop
  popVariables
  arg1
} def

%% [(x1) (x2)] typeR [ [[(x1) (x1-_z1)] [(x2) (x2-_z2)]
%%                     [(Dx1) (-D_z1)] [(Dx2) (-D_z2)]]
%%                     [(_z1) (_z2)] ]
/typeR {
  /arg1 set
  [/in-typeL /xvars /n /zlist /i /tmpr] pushVariables
  [
    /xvars arg1 def
    xvars length /n set
    [ 1 1 n { toString } for ] /zlist set
    zlist { (_z) 2 1 roll 2 cat_n } map /zlist set
    %% [(_z1) (_z2) ... ]
    /rule [ 1 1 n 2 mul { pop 0 } for ] def
    0 1 n 1 sub {
      /i set
      [ @@@.Dsymbol xvars i get 2 cat_n
        [
         (-)
         @@@.Dsymbol zlist i get
        ] cat
      ] /tmpr set
      rule << i n add >> tmpr put
      [ xvars i get
        [ xvars i get
          (-)
          zlist i get
        ] cat
      ] /tmpr set
      rule  i  tmpr put
    } for
    /arg1 [rule zlist] def
  ] pop
  popVariables
  arg1
} def

/tensor0 {
  /arg1 set
  [/in-tensor0  /vlist
   /vlist2 /exteriorTensor /aaa /ans
  ] pushVariables
  [
    arg1 tensor0.aux  /aaa set
    /exteriorTensor aaa 0 get def
    /vlist aaa 1 get def
    /vlist2 aaa 2 get def
    [exteriorTensor vlist2 [ vlist vlist2 join [ ]] 0] message
    [exteriorTensor vlist2 [ vlist vlist2 join [ ]] 0] restriction
    /ans set 
    ans 0 get toVectors2 /arg1 set
  ]pop
  popVariables
  arg1
} def

/tensor1 {
  /arg1 set
  [/in-tensor0  /vlist
   /vlist2 /exteriorTensor /aaa /ans
  ] pushVariables
  [
    arg1 tensor0.aux  /aaa set
    /exteriorTensor aaa 0 get def
    /vlist aaa 1 get def
    /vlist2 aaa 2 get def
    [exteriorTensor vlist2 [ vlist vlist2 join [ ]]] message
    [exteriorTensor vlist2 [ vlist vlist2 join [ ]]] restriction
    /ans set 
    ans {toVectors2} map /arg1 set
  ]pop
  popVariables
  arg1
} def
  


/tensor0.aux {
  /arg1 set
  [/in-tensor0.aux /mLeft /mRight /vlist
   /ruleL /ruleR  /vlist2 /exteriorTensor
  ] pushVariables
  [(CurrentRingp)] pushEnv
  [
     /mLeft arg1 0 get def
     /mRight arg1 1 get def
     /vlist arg1 2 get def
   
     mLeft {toString} map /mLeft set
     mRight {toString} map /mRight set
     vlist isString {
       [vlist to_records pop ] /vlist set
     } { } ifelse

     /ruleL vlist typeL 0 get def
     /ruleR vlist typeR 0 get def
     /vlist2 vlist typeL 1 get def

     [vlist vlist2 join from_records
      ring_of_differential_operators 0] define_ring
     ruleL { { . } map } map /ruleL set
     ruleR { { . } map } map /ruleR set

     mLeft { . ruleL replace dehomogenize } map /mLeft set
     mRight { . ruleR replace dehomogenize } map /mRight set

     /exteriorTensor mLeft mRight join { toString } map def
     
     /arg1 [exteriorTensor vlist vlist2] def
  ] pop
  popEnv
  popVariables
  arg1
} def

[(tensor0)
 [( [F G vlist] tensor0 )
  (This function requires the package cohom.sm1.)
  (Example 1:)
  ( [[(2 x Dx - 1)] [(2 x Dx - 3)] (x)] tensor0 )
  (Example 2:)
  ( [[(-x*Dx^2+x-Dx+1)] [((x Dx + x +1)(Dx-1))] (x)] tensor0 )
  (Example 3:)
  ( [[(x Dx -1) (y Dy -4)] [(Dx + Dy) (Dx-Dy^2)] (x,y)] tensor0 )
]] putUsages
(tensor0 ) messagen

/wTensor0 {
  /arg1 set
  [/in-wTensor0  /vlist
   /vlist2 /exteriorTensor /aaa /ans /weight /i /wlist
  ] pushVariables
  [
    arg1 /aaa set
    aaa 3 get /wlist set
    [aaa 0 get aaa 1 get aaa 2 get] tensor0.aux  /aaa set
    /exteriorTensor aaa 0 get def
    /vlist aaa 1 get def
    /vlist2 aaa 2 get def

    [
    0 1 wlist length 1 sub {
      /i set
      vlist2 i get
      0 wlist i get sub
      [@@@.Dsymbol vlist2 i get] cat
      wlist i get
    } for
    ] /weight set
    [exteriorTensor vlist vlist2 join weight] message
    [exteriorTensor vlist vlist2 join weight] wRestriction0
    /ans set 
    ans 0 get toVectors2 /arg1 set
  ]pop
  popVariables
  arg1
} def
(wTensor0 ) messagen
[(wTensor0)
 [([F G v weight] wTensor0)
  (See tensor0)
  (It calls wRestriction0 instead of restriction.)
  (Example 1:)
  ( [[(x Dx -1) (y Dy -4)] [(Dx + Dy) (Dx-Dy^2)] (x,y) [1 2]] wTensor0 )
]] putUsages

%% analyzing a given b-ideal.
/integralRoots001 {
  /arg1 set
  [/in-integralRoots00 /R /ff /n /i /j
   /ans /ans2
  ] pushVariables
  [(CurrentRingp)] pushEnv
  [
     /ff arg1 def
     /R ff 0 get (ring) dc def
     [(CurrentRingp) R] system_variable

     ff toVectors /ff set
     /n 0 def
     0 1 ff length 1 sub {
       /i set
       ff i get length n gt
       { /n ff i get length def }
       {  } ifelse
     } for %% n is the maximal length.

     [ 1 1 n { } for ] /ans set
     1 1 n {
       /i set
       /ans2 [ ] def
       0 1 ff length 1 sub {
         /j set
         ff j get length i eq {
           ans2 [ ff j get i 1 sub get ] join /ans2 set
         } { } ifelse
       } for
       ans << i 1 sub >> ans2 put 
     } for 
     /arg1 ans def     
  ] pop
  popEnv
  popVariables
  arg1
} def

/intwbfRoots {
   /arg1 set
   [/in-intwbfRoots /aaa /ggg /vvv /www] pushVariables
   [
      /aaa arg1 def
      aaa 2 get getxvars2 { toString } map /vvv set
      aaa 2 get getdvars2 1 get 
         { dup isString { pop } {  } ifelse } map /www set
      (vvv=) messagen vvv message
      (www=) messagen www message
      aaa length 3 {
        %% integration.
        aaa intwbf 
        /intwbf.bideal set  %% global var
      } {
        %% restriction
        aaa wbf
        /intwbf.bideal set  %% global var
      } ifelse
      intwbf.bideal integralRoots001
      /intwbf.bideal2 set  %% global var
      (b-ideal is ) messagen intwbf.bideal2 message
      (It is in the global variable intwbf.bideal2.) message
      intwbf.bideal2
      { /ggg set
        %% [ggg vvv www] { { (type?) dc } map } map message error
        [ggg vvv www] rationalRoots2
      } map
      /ggg set

      %% Integer 0 is returned as a null by ox_asir.
      ggg {{ dup tag 0 eq { pop 0 } { } ifelse } map} map /ggg set

      (vvv = ) messagen vvv message
      (www = ) messagen www message
      (Roots are ) messagen ggg message


      [-intInfinity] ggg flatten join shell rest /arg1 set
   ] pop
   popVariables
   arg1
} def

[(intwbfRoots)
 [(This function needs oxasir  --- rationalRoots2)
   $This function is defined in intw.sm1 and requires oxasir.sm1 and ox_asir server.$
  $Example 1:  [[(-3 x^2 Dy-2 y Dx) (2 x Dx+3 y Dy+6)] [(x) (y)] $
  $             [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] intwbfRoots $
  $Example 2:   [[[(0) (x^2 Dx+x)] [(Dx^2+x Dx^3) (0)]] [(x)] $
  $               [(x) -1 (Dx) 1]] intwbfRoots $
]] putUsages
(intwbfRoots ) messagen

/wbfRoots {
  /arg1 set
  [/in-wbfRoots /aaa ]pushVariables
  [
    /aaa arg1 def
    aaa [1] join intwbfRoots /arg1 set
  ] pop
  popVariables
  arg1
} def
[(wbfRoots)
 [(This function needs oxasir  --- rationalRoots2)
   $This function is defined in intw.sm1 and requires oxasir.sm1 and ox_asir server.$
  $Example 1:  [[(-3 x^2 Dy-2 y Dx) (2 x Dx+3 y Dy+6)] [(x) (y)] $
  $             [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] wbfRoots $
  $Example 2:   [[[(0) (x^2 Dx+x)] [(Dx^2+x Dx^3) (0)]] [(x)] $
  $               [(x) -1 (Dx) 1]] wbfRoots $
]] putUsages
(wbfRoots ) messagen



/wIntegration0 {
  /arg1 set
  [/in-wIntegration /aaa /rrr /k1 /ans]  pushVariables
  [
    /aaa arg1 def
    aaa intwbfRoots /rrr set
    rrr << rrr length 1 sub  >> get /k1 set
    k1 0 lt {
       /ans [ ] def
    } {
       aaa [k1] join integral-k1 /ans set
    } ifelse
    (k1 = ) messagen k1 message
    /arg1 ans def
  ] pop
  popVariables
  arg1
} def

(wIntegration0 ) message
[(wIntegration0) 
 [( [gg vlist weight] wIntegration0  [ igg bb] )
  (list of strings gg; list of strings vlist;)
  (list weight;)
  (integer k1;)
  (list of polys igg; list of polys base;)
  (gg are input ideal or submodule.)
  (igg are relations and bb are bases. They give the integral.)
  (This function fails when weight is not generic.)
  (cf. intwbf, intwbfRoots, integral-k1. )
   $This function is defined in intw.sm1 and requires oxasir.sm1 and ox_asir server.$
  $See Grobner Deformations of Hypergeometric Differential Equations, Springer$
  $    Section 5.5 for the algorithm.$
  $Example 1: [ [(Dt - (3 t^2-x)) (Dx + t)] [(t) (x)] [(t) -1 (Dt) 1]] $
  $              wIntegration0 $
  $Example 2: [[(-3 x^2 Dy-2 y Dx) (2 x Dx+3 y Dy+6)] [(x) (y)] $
  $            [(x) -1 (Dx) 1 (y) -2 (Dy) 2]]  wIntegration0 $
  $           The output [[-x, 1] [x,1]] implies the integral is $
  $           (K x + K 1)/(K (-x) + K 1) = 0 where K is the base field and$
  $           x and 1 is the vector space basis.$
  $           Note that the order of weight and the order of the variables$
  $           must be the same.  Note also that the next of (x) must be (Dx)$
  $           and so on.$
]] putUsages

/wRestriction0 {
  /arg1 set
  [/in-wRestriction0 /gg /vlist /v0 /vv /b /aaa /ans] pushVariables
  [(CurrentRingp)] pushEnv
  [
     /aaa arg1 def
     /gg aaa 0 get def
     /vlist aaa 1 get def
     vlist isArray 
     { vlist from_records /v0 set } 
     { /v0 vlist def vlist to_records /vlist set } ifelse
     /vv vlist vlist { /b set [@@@.Dsymbol b] cat } map join def
     [v0 ring_of_differential_operators 0] define_ring pop
     gg 0 get isArray {
       gg { { toString . vv laplace0 toString } map } map /gg set
     } 
     {
       gg { toString . vv laplace0 toString }  map /gg set
     } ifelse
     /ans  [gg] aaa rest join wIntegration0 def

     [v0 ring_of_differential_operators 0] define_ring pop
     ans { { toString . vv laplace0 } map } map /ans set
     /arg1 ans def
  ] pop
  popEnv
  popVariables
  arg1
} def

(wRestriction0 ) messagen
[(wRestriction0) 
 [( [gg vlist weight] wRestriction0  [ igg bb] )
  (list of strings gg; list of strings vlist;)
  (list weight;)
  (integer k1;)
  (list of polys igg; list of polys base;)
  (gg are input ideal or submodule.)
  (igg are relations and bb are bases. They give the 0-th restriction.)
  (This function fails when weight is not generic.)
  (cf. intwbf, intwbfRoots, integral-k1. )
   $This function is defined in intw.sm1 and requires oxasir.sm1 and ox_asir server.$
  $See Grobner Deformations of Hypergeometric Differential Equations, Springer$
  $    Section 5.5 for the algorithm.$
  $Example 1: [ [(Dt^2) (Dx^2)] [(t) (x)] [(t) -1 (Dt) 1]] $
  $              wRestriction0 $
  $Example 2: [[(Dx^2) (Dy^2)] [(x) (y)] $
  $            [(x) -1 (Dx) 1 (y) -2 (Dy) 2]]  wRestriction0 $
  $           The output [[-Dx, 1] [Dx,1]] implies the restriction is $
  $           (K Dx + K 1)/(K (-Dx) + K 1) = 0 where K is the base field and$
  $           Dx and 1 is the vector space basis.$
  $           Note that the order of weight and the order of the variables$
  $           must be the same.  Note also that the next of (x) must be (Dx)$
  $           and so on.$
]] putUsages



/ann-t-f {
  /arg1 set
  [/in-ann-t-f /f /vlist /s  /vvv /nnn /rrr
   /v1  /ops /ggg /ggg0 
   ] pushVariables
  [(CurrentRingp) (KanGBmessage)] pushEnv
  [
    /f arg1 0 get def  /vlist arg1 1 get def
    f toString /f set
    vlist { toString } map /vlist set
    [(KanGBmessage) fs.verbose] system_variable
    /s vlist 0 get def
    /vvv (_u,_v,_t,) vlist rest { (,) 2 cat_n } map aload length /nnn set
         s nnn 2 add cat_n def
    fs.verbose { vvv message } {  }ifelse
    [vvv ring_of_differential_operators
     [[(_u) 1 (_v) 1]] weight_vector 0] define_ring /rrr set
   
    [ (_t). f . sub  ]
    vlist rest { /v1 set  
          f . @@@.Dsymbol v1 2 cat_n . 1 diff0 [@@@.Dsymbol (_t)] cat . mul
          @@@.Dsymbol v1 2 cat_n . add } map
    join
    /ops set
    ops {[[(h). (1).]] replace } map /ops set
    fs.verbose { ops message  } {  }ifelse
    ops { [[(_t). s .] [[@@@.Dsymbol (_t)] cat . @@@.Dsymbol s 2 cat_n .]] replace dehomogenize } map
    /arg1 set
  ] pop
  popEnv
  popVariables
  arg1
} def
[(ann-t-f)
 [(ann-t-f returns the annihilating ideal of delta(t-f(x)))
  $Example: [(x^3-y^2) [(t) (x) (y)]] ann-t-f $
]] putUsages
(ann-t-f ) messagen

/bf-111 {
  /arg1 set
  [/in-bf-111 /aa /vlist /rest-vlist] pushVariables
  [(CurrentRingp) (KanGBmessage)] pushEnv
  [
    /aa arg1 def
    aa 1 get /vlist set
    aa 2 get /rest-vlist set
    /vlist [vlist to_records pop] def
    /rest-vlist [rest-vlist to_records pop] def
    /BFvarlist vlist def /BFparlist  [ ] def
    aa 0 get { toString} map
    rest-vlist  bfm 0 get /bf-111.bfunc set
    /arg1 bf-111.bfunc def
  ] pop
  popEnv
  popVariables
  arg1
} def
[(bf-111)
 [( [ideal vlist rest-vlist bf-111] bf-111 )
  (Compute the b-function for the weight vector 11111 for the variables)
  (res-vlist.  cf. wbf)
  (Example: [ [((x Dx -1 ) x Dx (x Dx + 2)) (y Dy)] (x,y) (x)] bf-111 )
]] putUsages
(bf-111 ) messagen

/wdeRham0 {
  /arg1 set
  [/in-wdeRham0 /aaa /ff0 /vlist /myweight] pushVariables
  [
    /aaa arg1 def
    /ff0 arg1 0 get def
    /vlist arg1 1 get def
    /myweight arg1 2 get def
    [ff0 vlist] annfs /ff0 set

    /vlist [vlist to_records pop ] def
    [ff0 0 get vlist myweight] wIntegration0
    /arg1 set
  ] pop
  popVariables
  arg1
} def
(wdeRham0 ) messagen
[(wdeRham0)
 [ $It computes the midle dimensional cohomology groups and bases.$
   $A generic weight vector is used for the computation.$
   $This function is defined in intw.sm1 and requires oxasir.sm1 and ox_asir server.$
   $ Example 1 : [(x^3-y^2) (x,y) [(x) -1 (Dx) 1 (y) -2 (Dy) 2]] wdeRham0 $
   $ Example 2 : [(x^3+y^3+z^3) (x,y,z) $
   $      [(x) -1 (Dx) 1 (y) -2 (Dy) 2 (z) -3 (Dz) 3]] wdeRham0 $
   $ Example 3 : [(x^3 -y z^2) (x,y,z) $
   $      [(x) -1 (Dx) 1 (y) -2 (Dy) 2 (z) -3 (Dz) 3]] wdeRham0 $
   $ Example 4 : [(x^3 -y^2 z^2) (x,y,z) $
   $      [(x) -1 (Dx) 1 (y) -2 (Dy) 2 (z) -3 (Dz) 3]] wdeRham0 $
]] putUsages

/intw.sm1.loaded 1 def

( ) message ;