passagemath-singular 10.6.31rc3__cp314-cp314-manylinux_2_27_aarch64.manylinux_2_28_aarch64.whl

sage_wheels/share/singular/LIB/dmodloc.lib

@@ -0,0 +1,2645 @@
+/////////////////////////////////////////////////////////////////////
+version="version dmodloc.lib 4.1.2.0 Feb_2019 "; // $Id: 5408af8b93d275f519cc9b7bf4caad8075f275a5 $
+category="Noncommutative";
+info="
+LIBRARY: dmodloc.lib     Localization of algebraic D-modules and applications
+AUTHOR:  Daniel Andres,  daniel.andres@math.rwth-aachen.de
+
+Support: DFG Graduiertenkolleg 1632 `Experimentelle und konstruktive Algebra'
+
+
+OVERVIEW:
+Let I be a left ideal in the n-th polynomial Weyl algebra D=K[x]<d> and
+let f be a polynomial in K[x].
+
+If D/I is a holonomic module over D, it is known that the localization of D/I
+at f is also holonomic. The procedure @code{Dlocalization} computes an ideal
+J in D such that this localization is isomorphic to D/J as D-modules.
+
+If one regards I as an ideal in the rational Weyl algebra as above, K(x)<d>*I,
+and intersects with K[x]<d>, the result is called the Weyl closure of I.
+The procedures @code{WeylClosure} (if I has finite holonomic rank) and
+@code{WeylClosure1} (if I is in the first Weyl algebra) can be used for
+computations.
+
+As an application of the Weyl closure, the procedure @code{annRatSyz} computes
+a holonomic part of the annihilator of a rational function by computing certain
+syzygies. The full annihilator can be obtained by taking the Weyl closure of
+the result.
+
+If one regards the left ideal I as system of linear PDEs, one can find its
+polynomial solutions with @code{polSol} (if I is holonomic) or
+@code{polSolFiniteRank} (if I is of finite holonomic rank). Rational solutions
+can be obtained with @code{ratSol}.
+
+The procedure @code{bfctBound} computes a possible multiple of the b-function
+for f^s*u at a generic root of f. Here, u stands for [1] in D/I.
+
+This library also offers the procedures @code{holonomicRank} and
+@code{DsingularLocus} to compute the holonomic rank and the singular locus
+of the D-module D/I.
+
+
+REFERENCES:
+   (OT)  T. Oaku, N. Takayama: `Algorithms for D-modules',
+         Journal of Pure and Applied Algebra, 1998.
+@* (OTT) T. Oaku, N. Takayama, H. Tsai: `Polynomial and rational solutions
+         of holonomic systems', Journal of Pure and Applied Algebra, 2001.
+@* (OTW) T. Oaku, N. Takayama, U. Walther: `A Localization Algorithm for
+         D-modules', Journal of Symbolic Computation, 2000.
+@* (Tsa) H. Tsai: `Algorithms for algebraic analysis', PhD thesis, 2000.
+
+
+PROCEDURES:
+Dlocalization(I,f[,k,e]);  computes the localization of a D-module
+WeylClosure(I);    computes the Weyl closure of an ideal in the Weyl algebra
+WeylClosure1(L);   computes the Weyl closure of operator in first Weyl algebra
+holonomicRank(I);  computes the holonomic rank of I
+DsingularLocus(I); computes the singular locus of a D-module
+polSol(I[,w,m]);   computes basis of polynomial solutions to the given system
+polSolFiniteRank(I[,w]); computes basis of polynomial solutions to given system
+ratSol(I);         computes basis of rational solutions to the given system
+bfctBound(I,f[,primdec]); computes multiple of b-function for f^s*u
+annRatSyz(f,g[,db,eng]);  computes part of annihilator of rational function g/f
+
+dmodGeneralAssumptionCheck();   check general assumptions
+extendWeyl(S);     extends basering (Weyl algebra) by given vars
+polyVars(f,v);     checks whether f contains only variables indexed by v
+monomialInIdeal(I);    computes all monomials appearing in generators of ideal
+vars2pars(v);      converts variables specified by v into parameters
+minIntRoot2(L);    finds minimal integer root in a list of roots
+maxIntRoot(L);     finds maximal integer root in a list of roots
+dmodAction(id,f[,v]);  computes the natural action of a D-module on K[x]
+dmodActionRat(id,w);   computes the natural action of a D-module on K(x)
+simplifyRat(v);    simplifies rational function
+addRat(v,w);       adds rational functions
+multRat(v,w);      multiplies rational functions
+diffRat(v,j);      derives rational function
+commRing();        deletes non-commutative relations from ring
+rightNFWeyl(id,k); computes right NF wrt right ideal (var(k)) in Weyl algebra
+
+
+KEYWORDS: D-module; holonomic rank; singular locus of D-module;
+D-localization; localization of D-module; characteristic variety;
+Weyl closure; polynomial solutions; rational solutions;
+annihilator of rational function
+
+
+SEE ALSO: bfun_lib, dmod_lib, dmodapp_lib, dmodvar_lib, gmssing_lib
+";
+
+
+/*
+CHANGELOG:
+12.11.12: bugfixes, updated docu
+17.12.12: updated docu, removed redundant procedure killTerms
+*/
+
+LIB "bfun.lib";    // for pIntersect etc
+LIB "dmodapp.lib"; // for GBWeight, charVariety etc
+LIB "nctools.lib"; // for Weyl, isWeyl etc
+
+// testing for consistency of the library /////////////////////////////////////
+
+static proc testdmodloc()
+{
+  example dmodGeneralAssumptionCheck;
+  example safeVarName;
+  example extendWeyl;
+  example polyVars;
+  example monomialInIdeal;
+  example vars2pars;
+  example minIntRoot2;
+  example maxIntRoot;
+  example dmodAction;
+  example dmodActionRat;
+  example simplifyRat;
+  example addRat;
+  example multRat;
+  example diffRat;
+  example commRing;
+  example holonomicRank;
+  example DsingularLocus;
+  example rightNFWeyl;
+  example Dlocalization;
+  example WeylClosure1;
+  example WeylClosure;
+  example polSol;
+  example polSolFiniteRank;
+  example ratSol;
+  example bfctBound;
+  example annRatSyz;
+}
+
+
+// tools //////////////////////////////////////////////////////////////////////
+
+proc dmodGeneralAssumptionCheck ()
+"
+USAGE:    dmodGeneralAssumptionCheck();
+RETURN:   nothing, but checks general assumptions on the basering
+NOTE:     This procedure checks the following conditions on the basering R
+          and prints an error message if any of them is violated:
+@*         - R is the n-th Weyl algebra over a field of characteristic 0,
+@*         - R is not a qring,
+@*         - for all 1<=i<=n the identity var(i+n)*var(i)=var(i)*var(i+1)+1
+             holds, i.e. the sequence of variables is given by
+             x(1),...,x(n),D(1),...,D(n), where D(i) is the differential
+             operator belonging to x(i).
+EXAMPLE:  example dmodGeneralAssumptionCheck; shows examples
+"
+{
+  // char K <> 0, qring
+  if (  (size(ideal(basering)) >0) || (char(basering) >0) )
+  {
+    ERROR("Basering is inappropriate: characteristic>0 or qring present");
+  }
+  // no Weyl algebra
+  if (isWeyl() == 0)
+  {
+    ERROR("Basering is not a Weyl algebra");
+  }
+  // wrong sequence of vars
+  int i,n;
+  n = nvars(basering) div 2;
+  for (i=1; i<=n; i++)
+  {
+    if (bracket(var(i+n),var(i))<>1)
+    {
+      ERROR(string(var(i+n))+" is not a differential operator for " +string(var(i)));
+    }
+  }
+  return();
+}
+example
+{
+  "EXAMPLE"; echo=2;
+  ring r = 0,(x,D),dp;
+  dmodGeneralAssumptionCheck(); // prints error message
+  def W = Weyl();
+  setring W;
+  dmodGeneralAssumptionCheck(); // returns nothing
+}
+
+
+static proc safeVarName (string s)
+"
+USAGE:    safeVarName(s);  s string
+RETURN:   string, returns s if s is not the name of a par/var of basering
+          and `@' + s otherwise
+EXAMPLE:  example safeVarName; shows examples
+"
+{
+  string S = "," + charstr(basering) + "," + varstr(basering) + ",";
+  s = "," + s + ",";
+  while (find(S,s) <> 0)
+  {
+    s[1] = "@";
+    s = "," + s;
+  }
+  s = s[2..size(s)-1];
+  return(s);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  ring r = (0,a),(w,@w,x,y),dp;
+  safeVarName("a");
+  safeVarName("x");
+  safeVarName("z");
+  safeVarName("w");
+}
+
+
+proc extendWeyl (def newVars)
+"
+USAGE:    extendWeyl(S);  S string or list of strings
+ASSUME:   The basering is the n-th Weyl algebra over a field of
+          characteristic 0 and for all 1<=i<=n the identity
+          var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the sequence of
+          variables is given by x(1),...,x(n),D(1),...,D(n), where D(i)
+          is the differential operator belonging to x(i).
+RETURN:   ring, Weyl algebra extended by vars given by S
+EXAMPLE:  example extendWeyl; shows examples
+"
+{
+  dmodGeneralAssumptionCheck();
+  int i,s;
+  string inpt = typeof(newVars);
+  list L;
+  if (inpt=="string")
+  {
+    s = 1;
+    L = newVars;
+  }
+  else
+  {
+    if (inpt=="list")
+    {
+      s = size(newVars);
+      if (s<1)
+      {
+        ERROR("No new variables specified.");
+      }
+      for (i=1; i<=s; i++)
+      {
+        if (typeof(newVars[i]) <> "string")
+        {
+          ERROR("Entries of input list must be of type string.");
+        }
+      }
+      L = newVars;
+    }
+    else
+    {
+      ERROR("Expected string or list of strings as input.");
+    }
+  }
+  def save = basering;
+  int n = nvars(save) div 2;
+  list RL = ringlist(save);
+  RL = RL[1..4];
+  list Ltemp = L;
+  for (i=s; i>0; i--)
+  {
+    Ltemp[n+s+i] = "D" + newVars[i];
+  }
+  for (i=n; i>0; i--)
+  {
+    Ltemp[s+i]     = RL[2][i];
+    Ltemp[n+2*s+i] = RL[2][n+i];
+  }
+  RL[2] = Ltemp;
+  Ltemp = list();
+  Ltemp[1] = list("dp",intvec(1:(2*n+2*s)));
+  Ltemp[2] = list("C",intvec(0));
+  RL[3] = Ltemp;
+  kill Ltemp;
+  def @Dv = ring(RL);
+  setring @Dv;
+  def Dv = Weyl();
+  setring save;
+  return(Dv);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  ring @D2 = 0,(x,y,Dx,Dy),dp;
+  def D2 = Weyl();
+  setring D2;
+  def D3 = extendWeyl("t");
+  setring D3; D3;
+  list L = "u","v";
+  def D5 = extendWeyl(L);
+  setring D5;
+  D5;
+}
+
+
+proc polyVars (poly f, intvec v)
+"
+USAGE:    polyVars(f,v);  f poly, v intvec
+RETURN:   int, 1 if f contains only variables indexed by v, 0 otherwise
+EXAMPLE:  example polyVars; shows examples
+"
+{
+  ideal varsf = variables(f); // vars contained in f
+  ideal V;
+  int i;
+  int n = nvars(basering);
+  for (i=1; i<=size(v); i++)
+  {
+    if ( (v[i]<0) || (v[i]>n) )
+    {
+      ERROR("var(" + string(v[i]) + ") out of range");
+    }
+    V[i] = var(v[i]);
+  }
+  attrib(V,"isSB",1);
+  ideal N = NF(varsf,V);
+  N = simplify(N,2);
+  if (N[1]==0)
+  {
+    return(1);
+  }
+  else
+  {
+    return(0);
+  }
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  ring r = 0,(x,y,z),dp;
+  poly f = y^2+zy;
+  intvec v = 1,2;
+  polyVars(f,v); // does f depend only on x,y?
+  v = 2,3;
+  polyVars(f,v); // does f depend only on y,z?
+}
+
+
+proc monomialInIdeal (ideal I)
+"
+USAGE:    monomialInIdeal(I);  I ideal
+RETURN:   ideal consisting of all monomials appearing in generators of ideal
+EXAMLPE:  example monomialInIdeal; shows examples
+"
+{
+  // returns ideal consisting of all monomials appearing in generators of ideal
+  I = simplify(I,2+8);
+  int i;
+  poly p;
+  ideal M;
+  for (i=1; i<=size(I); i++)
+  {
+    p = I[i];
+    while (p<>0)
+    {
+      M[size(M)+1] = leadmonom(p);
+      p = p - lead(p);
+    }
+  }
+  M = simplify(M,4+2);
+  return(M);
+}
+example
+{
+  "EXAMPLE"; echo=2;
+  ring r = 0,(x,y),dp;
+  ideal I = x2+5x3y7, x-x2-6xy;
+  monomialInIdeal(I);
+}
+
+
+proc vars2pars (intvec v)
+"
+USAGE:    vars2pars(v);  v intvec
+ASSUME:   The basering is commutative.
+RETURN:   ring with variables specified by v converted into parameters
+EXAMPLE:  example vars2pars; shows examples
+"
+{
+  if (isCommutative() == 0)
+  {
+    ERROR("The basering must be commutative.");
+  }
+  v = sortIntvec(v)[1];
+  int sv = size(v);
+  if ( (v[1]<1) || (v[sv]<1) )
+  {
+    ERROR("Expected entries of intvec in the range 1.."+string(n));
+  }
+  def save = basering;
+  int i,j,n;
+  n = nvars(save);
+  list RL = ringlist(save);
+  list Lp,Lv,L1;
+  if (typeof(RL[1]) == "list")
+  {
+    L1 = RL[1];
+    Lp = L1[2];
+  }
+  else
+  {
+    L1[1] = RL[1];
+    L1[4] = ideal(0);
+  }
+  j = sv;
+  for (i=1; i<=n; i++)
+  {
+    if (j>0)
+    {
+      if (v[j]==i)
+      {
+        Lp[size(Lp)+1] = string(var(i));
+        j--;
+      }
+      else
+      {
+        Lv[size(Lv)+1] = string(var(i));
+      }
+    }
+    else
+    {
+      Lv[size(Lv)+1] = string(var(i));
+    }
+  }
+  RL[2] = Lv;
+  L1[2] = Lp;
+  L1[3] = list(list("lp",intvec(1:size(Lp))));
+  RL[1] = L1;
+  L1 = list();
+  L1[1] = list("dp",intvec(1:sv));
+  L1[2] = list("C",intvec(0));
+  RL[3] = L1;
+//   RL;
+  def R = ring(RL);
+  return(R);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  ring r = 0,(x,y,z,a,b,c),dp;
+  intvec v = 4,5,6;
+  def R = vars2pars(v);
+  setring R;
+  R;
+  v = 1,2;
+  def RR = vars2pars(v);
+  setring RR;
+  RR;
+}
+
+
+static proc minMaxIntRoot (list L, string minmax)
+{
+  int win;
+  if (size(L)>1)
+  {
+    if ( (typeof(L[1])<>"ideal") || (typeof(L[2])<>"intvec") )
+    {
+      win = 1;
+    }
+  }
+  else
+  {
+    win = 1;
+  }
+  if (win)
+  {
+    ERROR("Expected list in the format of bFactor");
+  }
+  if (size(L)>2)
+  {
+    if ( (L[3]=="1") || (L[3]=="0") )
+    {
+      print("// Warning: Constant poly. Returning 0.");
+      return(int(0));
+    }
+  }
+  ideal I = L[1];
+  int i,k,b;
+  if (minmax=="min")
+  {
+    i = ncols(I);
+    k = -1;
+    b = 0;
+  }
+  else // minmax=="max"
+  {
+    i = 1;
+    k = 1;
+    b = ncols(I);
+  }
+  for (; k*i<k*b; i=i+k)
+  {
+    if (isInt(leadcoef(I[i])))
+    {
+      return(int(leadcoef(I[i])));
+    }
+  }
+  print("// Warning: No integer root found. Returning 0.");
+  return(int(0));
+}
+
+
+//TODO rename? minIntRoot is name of proc in dmod.lib
+proc minIntRoot2 (list L)
+"
+USAGE:    minIntRoot2(L);  L list
+ASSUME:   L is the output of bFactor.
+RETURN:   int, the minimal integer root in a list of roots
+SEE ALSO: minIntRoot, maxIntRoot, bFactor
+EXAMPLE:  example minIntRoot2; shows examples
+"
+{
+  return(minMaxIntRoot(L,"min"));
+}
+example
+{
+  "EXAMPLE"; echo=2;
+  ring r = 0,x,dp;
+  poly f = x*(x+1)*(x-2)*(x-5/2)*(x+5/2);
+  list L = bFactor(f);
+  minIntRoot2(L);
+}
+
+
+proc maxIntRoot (list L)
+"
+USAGE:    maxIntRoot(L);  L list
+ASSUME:   L is the output of bFactor.
+RETURN:   int, the maximal integer root in a list of roots
+SEE ALSO: minIntRoot2, bFactor
+EXAMPLE:  example maxIntRoot; shows examples
+"
+{
+  return(minMaxIntRoot(L,"max"));
+}
+example
+{
+  "EXAMPLE"; echo=2;
+  ring r = 0,x,dp;
+  poly f = x*(x+1)*(x-2)*(x-5/2)*(x+5/2);
+  list L = bFactor(f);
+  maxIntRoot(L);
+}
+
+
+proc dmodAction (def id, poly f, list #)
+"
+USAGE:    dmodAction(id,f[,v]);  id ideal or poly, f poly, v optional intvec
+ASSUME:   If v is not given, the basering is the n-th Weyl algebra W over a
+          field of characteristic 0 and for all 1<=i<=n the identity
+          var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the sequence of
+          variables is given by x(1),...,x(n),D(1),...,D(n), where D(i) is the
+          differential operator belonging to x(i).
+          Otherwise, v is assumed to specify positions of variables, which form
+          a Weyl algebra as a subalgebra of the basering:
+          If size(v) equals 2*n, then bracket(var(v[i]),var(v[j])) must equal
+          1 if and only if j equals i+n, and 0 otherwise,  for all 1<=i,j<=n.
+@*        Further, assume that f does not contain any D(i).
+RETURN:   same type as id, the result of the natural D-module action of id on f
+NOTE:     The assumptions made are not checked.
+EXAMPLE:  example dmodAction; shows examples
+"
+{
+  string inp1 = typeof(id);
+  if ((inp1<>"poly") && (inp1<>"ideal"))
+  {
+    ERROR("Expected first argument to be poly or ideal but received "+inp1);
+  }
+  intvec posXD = 1..nvars(basering);
+  if (size(#)>0)
+  {
+    if (typeof(#[1])=="intvec")
+    {
+      posXD = #[1];
+    }
+  }
+  if ((size(posXD) mod 2)<>0)
+  {
+    ERROR("Even number of variables expected.")
+  }
+  int n = (size(posXD)) div 2;
+  int i,j,k,l;
+  ideal resI = id;
+  int sid = ncols(resI);
+  intvec v;
+  poly P,h;
+  for (l=1; l<=sid; l++)
+  {
+    P = resI[l];
+    resI[l] = 0;
+    for (i=1; i<=size(P); i++)
+    {
+      v = leadexp(P[i]);
+      h = f;
+      for (j=1; j<=n; j++)
+      {
+        for (k=1; k<=v[posXD[j+n]]; k++) // action of Dx
+        {
+          h = diff(h,var(posXD[j]));
+        }
+        h = h*var(posXD[j])^v[posXD[j]]; // action of x
+      }
+      h = leadcoef(P[i])*h;
+      resI[l] = resI[l] + h;
+    }
+  }
+  if (inp1 == "ideal")
+  {
+    return(resI);
+  }
+  else
+  {
+    return(resI[1]);
+  }
+}
+example
+{
+  ring r = 0,(x,y,z),dp;
+  poly f = x^2*z - y^3;
+  def A = annPoly(f);
+  setring A;
+  poly f = imap(r,f);
+  dmodAction(LD,f);
+  poly P = y*Dy+3*z*Dz-3;
+  dmodAction(P,f);
+  dmodAction(P[1],f);
+}
+
+
+static proc checkRatInput (vector I)
+{
+  // check for valid input
+  int wrginpt;
+  if (nrows(I)<>2)
+  {
+    wrginpt = 1;
+  }
+  else
+  {
+    if (I[2] == 0)
+    {
+      wrginpt = 1;
+    }
+  }
+  if (wrginpt)
+  {
+    ERROR("Vector must consist of exactly two components, second one not 0");
+  }
+  return();
+}
+
+
+proc dmodActionRat(def id, vector w)
+"
+USAGE:    dmodActionRat(id,w);  id ideal or poly, f vector
+ASSUME:   The basering is the n-th Weyl algebra W over a field of
+          characteristic 0 and for all 1<=i<=n the identity
+          var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the sequence of
+          variables is given by x(1),...,x(n),D(1),...,D(n), where D(i) is the
+          differential operator belonging to x(i).
+@*        Further, assume that w has exactly two components, second one not 0,
+          and that w does not contain any D(i).
+RETURN:   same type as id, the result of the natural D-module action of id on
+          the rational function w[1]/w[2]
+EXAMPLE:  example dmodActionRat; shows examples
+"
+{
+  string inp1 = typeof(id);
+  if ( (inp1<>"poly") && (inp1<>"ideal") )
+  {
+    ERROR("Expected first argument to be poly or ideal but received " + inp1);
+  }
+  checkRatInput(w);
+  poly f = w[1];
+  finKx(f);
+  f = w[2];
+  finKx(f);
+  def save = basering;
+  def r = commRing();
+  setring r;
+  ideal I = imap(save,id);
+  vector w = imap(save,w);
+  int i,j,k,l;
+  int n = nvars(basering) div 2;
+  int sid = ncols(I);
+  intvec v;
+  poly P;
+  vector h,resT;
+  module resL;
+  for (l=1; l<=sid; l++)
+  {
+    P = I[l];
+    resT = [0,1];
+    for (i=1; i<=size(P); i++)
+    {
+      v = leadexp(P[i]);
+      h = w;
+      for (j=1; j<=n; j++)
+      {
+        for (k=1; k<=v[j+n]; k++) // action of Dx
+        {
+          h = diffRat(h,j);
+        }
+        h = h + h[1]*(var(j)^v[j]-1)*gen(1);  // action of x
+      }
+      h = h + (leadcoef(P[i])-1)*h[1]*gen(1);
+      resT = addRat(resT,h);
+    }
+    resL[l] = resT;
+  }
+  setring save;
+  module resL = imap(r,resL);
+  return(resL);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  ring r = 0,(x,y),dp;
+  poly f = 2*x;  poly g = y;
+  def A = annRat(f,g); setring A;
+  poly f = imap(r,f); poly g = imap(r,g);
+  vector v = [f,g]; // represents f/g
+  // x and y act by multiplication
+  dmodActionRat(x,v);
+  dmodActionRat(y,v);
+  // Dx and Dy act by partial derivation
+  dmodActionRat(Dx,v);
+  dmodActionRat(Dy,v);
+  dmodActionRat(x*Dx+y*Dy,v);
+  setring r;
+  f = 2*x*y; g = x^2 - y^3;
+  def B = annRat(f,g); setring B;
+  poly f = imap(r,f); poly g = imap(r,g);
+  vector v = [f,g];
+  dmodActionRat(LD,v); // hence LD is indeed the annihilator of f/g
+}
+
+
+static proc arithmeticRat (vector I, vector J, string op, list #)
+{
+  // op = "+": return I+J
+  // op = "*": return I*J
+  // op = "s": return simplified I
+  // op = "d": return diff(I,var(#[1]))
+  int isComm = isCommutative();
+  if (!isComm)
+  {
+    def save = basering;
+    def r = commRing();
+    setring r;
+    ideal m = maxideal(1);
+    map f = save,m;
+    vector I = f(I);
+    vector J = f(J);
+  }
+  vector K;
+  poly p;
+  if (op == "s")
+  {
+    p = gcd(I[1],I[2]);
+    K = (I[1]/p)*gen(1) + (I[2]/p)*gen(2);
+  }
+  else
+  {
+    if (op == "+")
+    {
+      I = arithmeticRat(I,vector(0),"s");
+      J = arithmeticRat(J,vector(0),"s");
+      p = lcm(I[2],J[2]);
+      K = (I[1]*p/I[2] + J[1]*p/J[2])*gen(1) + p*gen(2);
+    }
+    else
+    {
+      if (op == "*")
+      {
+        K = (I[1]*J[1])*gen(1) + (I[2]*J[2])*gen(2);
+      }
+      else
+      {
+        if (op == "d")
+        {
+          int j = #[1];
+          K = (diff(I[1],var(j))*I[2] - I[1]*diff(I[2],var(j)))*gen(1)+ (I[2]^2)*gen(2);
+        }
+      }
+    }
+    K = arithmeticRat(K,vector(0),"s");
+  }
+  if (!isComm)
+  {
+    setring save;
+    vector K = imap(r,K);
+  }
+  return(K);
+}
+
+
+proc simplifyRat (vector J)
+"
+USAGE:    simplifyRat(v);  v vector
+ASSUME:   Assume that v has exactly two components, second one not 0.
+RETURN:   vector, representing simplified rational function v[1]/v[2]
+NOTE:     Possibly present non-commutative relations of the basering are
+          ignored.
+EXAMPLE:  example simplifyRat; shows examples
+"
+{
+  checkRatInput(J);
+  return(arithmeticRat(J,vector(0),"s"));
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+   ring r = 0,(x,y),dp;
+  vector v = [x2-1,x+1];
+  simplifyRat(v);
+  simplifyRat(v) - [x-1,1];
+}
+
+
+proc addRat (vector I, vector J)
+"
+USAGE:    addRat(v,w);  v,w vectors
+ASSUME:   Assume that v,w have exactly two components, second ones not 0.
+RETURN:   vector, representing rational function (v[1]/v[2])+(w[1]/w[2])
+NOTE:     Possibly present non-commutative relations of the basering are
+          ignored.
+EXAMPLE:  example addRat; shows examples
+"
+{
+  checkRatInput(I);
+  checkRatInput(J);
+  return(arithmeticRat(I,J,"+"));
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  ring r = 0,(x,y),dp;
+  vector v = [x,y];
+  vector w = [y,x];
+  addRat(v,w);
+  addRat(v,w) - [x2+y2,xy];
+}
+
+
+proc multRat (vector I, vector J)
+"
+USAGE:    multRat(v,w);  v,w vectors
+ASSUME:   Assume that v,w have exactly two components, second ones not 0.
+RETURN:   vector, representing rational function (v[1]/v[2])*(w[1]/w[2])
+NOTE:     Possibly present non-commutative relations of the basering are
+          ignored.
+EXAMPLE:  example multRat; shows examples
+"
+{
+  checkRatInput(I);
+  checkRatInput(J);
+  return(arithmeticRat(I,J,"*"));
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  ring r = 0,(x,y),dp;
+  vector v = [x,y];
+  vector w = [y,x];
+  multRat(v,w);
+  multRat(v,w) - [1,1];
+}
+
+
+proc diffRat (vector I, int j)
+"
+USAGE:    diffRat(v,j);  v vector, j int
+ASSUME:   Assume that v has exactly two components, second one not 0.
+RETURN:   vector, representing rational function derivative of rational
+          function (v[1]/v[2]) w.r.t. var(j)
+NOTE:     Possibly present non-commutative relations of the basering are
+          ignored.
+EXAMPLE:  example diffRat; shows examples
+"
+{
+  checkRatInput(I);
+  if ( (j<1) || (j>nvars(basering)) )
+  {
+    ERROR("Second argument must be in the range 1.."+string(nvars(basering)));
+  }
+  return(arithmeticRat(I,vector(0),"d",j));
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  ring r = 0,(x,y),dp;
+  vector v = [x,y];
+  diffRat(v,1);
+  diffRat(v,1) - [1,y];
+  diffRat(v,2);
+  diffRat(v,2) - [-x,y2];
+}
+
+
+proc commRing ()
+"
+USAGE:    commRing();
+RETURN:   ring, basering without non-commutative relations
+EXAMPLE:  example commRing; shows examples
+"
+{
+  list RL = ringlist(basering);
+  if (size(RL)<=4)
+  {
+    return(basering);
+  }
+  RL = RL[1..4];
+  def r = ring(RL);
+  return(r);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  def W = makeWeyl(3);
+  setring W; W;
+  def W2 = commRing();
+  setring W2; W2;
+  ring r = 0,(x,y),dp;
+  def r2 = commRing(); // same as r
+  setring r2; r2;
+}
+
+
+// TODO remove this proc once chern.lib is ready
+static proc orderedPartition(int n, list #)
+"
+USAGE:   orderedPartition(n,a); n,a positive ints
+         orderedPartition(n,w); n positive int, w positive intvec
+RETURN:  list of intvecs
+PURPOSE: Computes all partitions of n of length a, if the second
+         argument is an int, or computes all weighted partitions
+         w.r.t. w of n of length size(w) if the second argument
+         is an intvec.
+         In both cases, zero parts are included.
+EXAMPLE: example orderedPartition; shows an example
+"
+{
+  int a,wrongInpt,intInpt;
+  intvec w = 1;
+  if (size(#)>0)
+  {
+    if (typeof(#[1]) == "int")
+    {
+      a = #[1];
+      intInpt = 1;
+    }
+    else
+    {
+      if (typeof(#[1]) == "intvec")
+      {
+        w = #[1];
+        a = size(w);
+      }
+      else
+      {
+        wrongInpt = 1;
+      }
+    }
+  }
+  else
+  {
+    wrongInpt = 1;
+  }
+  if (wrongInpt)
+  {
+    ERROR("Expected second argument of type int or intvec.");
+  }
+  kill wrongInpt;
+  if (n==0 && a>0)
+  {
+    return(list(0:a));
+  }
+  if (n<=0 || a<=0 || allPositive(w)==0)
+  {
+    ERROR("Positive arguments expected.");
+  }
+  int baseringdef;
+  if (defined(basering)) // if a basering is defined, it should be saved for later use
+  {
+    def save = basering;
+    baseringdef = 1;
+  }
+  ring r = 0,(x(1..a)),dp; // all variables for partition of length a
+  ideal M;
+  if (intInpt)
+  {
+    M = maxideal(n);   // all monomials of total degree n
+  }
+  else
+  {
+    M = weightKB(ideal(0),n,w); // all monomials of total weighted degree n
+  }
+  list L;
+  int i;
+  for (i = 1; i <= ncols(M); i++) {L = insert(L,leadexp(M[i]));}
+  // the leadexp corresponds to a partition
+  if (baseringdef) // sets the old ring as basering again
+  {
+    setring save;
+  }
+  return(L); //returns the list of partitions
+}
+example
+{
+ "EXAMPLE"; echo = 2;
+ orderedPartition(4,2);
+ orderedPartition(5,3);
+ orderedPartition(2,4);
+ orderedPartition(8,intvec(2,3));
+ orderedPartition(7,intvec(2,2)); // no such partition
+}
+
+
+// applications of characteristic variety /////////////////////////////////////
+
+proc holonomicRank (ideal I, list #)
+"
+USAGE:    holonomicRank(I[,e]);   I ideal, e optional int
+ASSUME:   The basering is the n-th Weyl algebra over a field of
+          characteristic 0 and for all 1<=i<=n the identity
+          var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the sequence of
+          variables is given by x(1),...,x(n),D(1),...,D(n), where D(i)
+          is the differential operator belonging to x(i).
+RETURN:   int, the holonomic rank of I
+REMARKS:  The holonomic rank of I is defined to be the K(x(1..n))-dimension of
+          the module W/WI, where W is the rational Weyl algebra
+          K(x(1..n))<D(1..n)>.
+          If this dimension is infinite, -1 is returned.
+NOTE:     If e<>0, @code{std} is used for Groebner basis computations,
+          otherwise (and by default) @code{slimgb} is used.
+@*        If printlevel=1, progress debug messages will be printed,
+          if printlevel>=2, all the debug messages will be printed.
+EXAMPLE:  example holonomicRank; shows examples
+"
+{
+  // assumption check is done by charVariety
+  int ppl = printlevel - voice + 2;
+  int eng;
+  if (size(#)>0)
+  {
+    if(typeof(#[1])=="int")
+    {
+      eng = #[1];
+    }
+  }
+  def save = basering;
+  dbprint(ppl  ,"// Computing characteristic variety...");
+  def grD = charVariety(I);
+  setring grD; // commutative ring
+  dbprint(ppl  ,"// ...done.");
+  dbprint(ppl-1,"// " + string(charVar));
+  int n = nvars(save) div 2;
+  intvec v = 1..n;
+  def R = vars2pars(v);
+  setring R;
+  ideal J = imap(grD,charVar);
+  dbprint(ppl  ,"// Starting GB computation...");
+  J = engine(J,0); // use slimgb
+  dbprint(ppl  ,"// ...done.");
+  dbprint(ppl-1,"// " + string(J));
+  int d = vdim(J);
+  setring save;
+  return(d);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  // (OTW), Example 8
+  ring r3 = 0,(x,y,z,Dx,Dy,Dz),dp;
+  def D3 = Weyl();
+  setring D3;
+  poly f = x^3-y^2*z^2;
+  ideal I = f^2*Dx+3*x^2, f^2*Dy-2*y*z^2, f^2*Dz-2*y^2*z;
+  // I annihilates exp(1/f)
+  holonomicRank(I);
+}
+
+
+proc DsingularLocus (ideal I)
+"
+USAGE:    DsingularLocus(I);  I ideal
+ASSUME:   The basering is the n-th Weyl algebra over a field of
+          characteristic 0 and for all 1<=i<=n the identity
+          var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the sequence of
+          variables is given by x(1),...,x(n),D(1),...,D(n), where D(i)
+          is the differential operator belonging to x(i).
+RETURN:   ideal, describing the singular locus of the D-module D/I
+NOTE:     If printlevel>=1, progress debug messages will be printed,
+          if printlevel>=2, all the debug messages will be printed
+EXAMPLE:  example DsingularLocus; shows examples
+"
+{
+  // assumption check is done by charVariety
+  int ppl = printlevel - voice + 2;
+  def save = basering;
+  dbprint(ppl  ,"// Computing characteristic variety...");
+  def grD = charVariety(I);
+  setring grD;
+  dbprint(ppl  ,"// ...done");
+  dbprint(ppl-1,"// " + string(charVar));
+  poly pDD = 1;
+  ideal IDD;
+  int i;
+  int n = nvars(basering) div 2;
+  for (i=1; i<=n; i++)
+  {
+    pDD = pDD*var(i+n);
+    IDD[i] = var(i+n);
+  }
+  dbprint(ppl  ,"// Computing saturation...");
+  ideal S = sat(charVar,IDD);
+  dbprint(ppl  ,"// ...done");
+  dbprint(ppl-1,"// " + string(S));
+  dbprint(ppl  ,"// Computing elimination...");
+  S = eliminate(S,pDD);
+  dbprint(ppl  ,"// ...done");
+  dbprint(ppl-1,"// " + string(S));
+  dbprint(ppl  ,"// Computing radical...");
+  S = radical(S);
+  dbprint(ppl  ,"// ...done");
+  dbprint(ppl-1,"// " + string(S));
+  setring save;
+  ideal S = imap(grD,S);
+  return(S);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  // (OTW), Example 8
+  ring @D3 = 0,(x,y,z,Dx,Dy,Dz),dp;
+  def D3 = Weyl();
+  setring D3;
+  poly f = x^3-y^2*z^2;
+  ideal I = f^2*Dx + 3*x^2, f^2*Dy-2*y*z^2, f^2*Dz-2*y^2*z;
+  // I annihilates exp(1/f)
+  DsingularLocus(I);
+}
+
+
+// localization ///////////////////////////////////////////////////////////////
+
+static proc finKx(poly f)
+{
+  int n = nvars(basering) div 2;
+  intvec iv = 1..n;
+  if (polyVars(f,iv) == 0)
+  {
+    ERROR("Given poly may not contain differential operators.");
+  }
+  return();
+}
+
+
+proc rightNFWeyl (def id, int k)
+"
+USAGE:    rightNFWeyl(id,k);  id ideal or poly, k int
+ASSUME:   The basering is the n-th Weyl algebra over a field of
+          characteristic 0 and for all 1<=i<=n the identity
+          var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the sequence of
+          variables is given by x(1),...,x(n),D(1),...,D(n), where D(i)
+          is the differential operator belonging to x(i).
+RETURN:   same type as id, the right normal form of id with respect to the
+          principal right ideal generated by the k-th variable
+NOTE:     No Groebner basis computation is used.
+EXAMPLE:  example rightNFWeyl; shows examples.
+"
+{
+  dmodGeneralAssumptionCheck();
+  string inpt = typeof(id);
+  if (inpt=="ideal" || inpt=="poly")
+  {
+    ideal I = id;
+  }
+  else
+  {
+    ERROR("Expected first input to be of type ideal or poly.");
+  }
+  def save = basering;
+  int n = nvars(save) div 2;
+  if (0>k || k>2*n)
+  {
+    ERROR("Expected second input to be in the range 1.."+string(2*n)+".");
+  }
+  int i,j;
+  if (k>n) // var(k) = Dx(k-n)
+  {
+    // switch var(k),var(k-n)
+    list RL = ringlist(save);
+    matrix rel = RL[6];
+    rel[k-n,k] = -1;
+    RL = RL[1..4];
+    list L = RL[2];
+    string str = L[k-n];
+    L[k-n] = L[k];
+    L[k] = str;
+    RL[2] = L;
+    def @W = ring(RL);
+    kill L,RL,str;
+    ideal @mm = maxideal(1);
+    setring @W;
+    matrix rel = imap(save,rel);
+    def W = nc_algebra(1,rel);
+    setring W;
+    ideal @mm = imap(save,@mm);
+    map mm = save,@mm;
+    ideal I = mm(I);
+    i = k-n;
+  }
+  else  // var(k) = x(k)
+  {
+    def W = save;
+    i = k;
+  }
+  for (j=1; j<=ncols(I); j++)
+  {
+    I[j] = subst(I[j],var(i),0);
+  }
+  setring save;
+  I = imap(W,I);
+  if (inpt=="poly")
+  {
+    return(I[1]);
+  }
+  else
+  {
+    return(I);
+  }
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  ring r = 0,(x,y,Dx,Dy),dp;
+  def W = Weyl();
+  setring W;
+  ideal I = x^3*Dx^3, y^2*Dy^2, x*Dy, y*Dx;
+  rightNFWeyl(I,1); // right NF wrt principal right ideal x*W
+  rightNFWeyl(I,3); // right NF wrt principal right ideal Dx*W
+  rightNFWeyl(I,2); // right NF wrt principal right ideal y*W
+  rightNFWeyl(I,4); // right NF wrt principal right ideal Dy*W
+  poly p = x*Dx+1;
+  rightNFWeyl(p,1); // right NF wrt principal right ideal x*W
+}
+
+
+// TODO check OTW for assumptions on holonomicity
+proc Dlocalization (ideal J, poly f, list #)
+"
+USAGE:    Dlocalization(I,f[,k,e]);  I ideal, f poly, k,e optional ints
+ASSUME:   The basering is the n-th Weyl algebra over a field of
+          characteristic 0 and for all 1<=i<=n the identity
+          var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the sequence of
+          variables is given by x(1),...,x(n),D(1),...,D(n), where D(i)
+          is the differential operator belonging to x(i).
+@*        Further, assume that f does not contain any D(i) and that I is
+          holonomic on K^n\V(f).
+RETURN:   ideal or list, computes an ideal J such that D/J is isomorphic
+          to D/I localized at f as D-modules.
+          If k<>0, a list consisting of J and an integer m is returned,
+          such that f^m represents the natural map from D/I to D/J.
+          Otherwise (and by default), only the ideal J is returned.
+REMARKS:  It is known that a localization at f of a holonomic D-module is
+          again a holonomic D-module.
+@*        Reference: (OTW)
+NOTE:     If e<>0, @code{std} is used for Groebner basis computations,
+          otherwise (and by default) @code{slimgb} is used.
+@*        If printlevel=1, progress debug messages will be printed,
+          if printlevel>=2, all the debug messages will be printed.
+SEE ALSO: DLoc, SDLoc, DLoc0
+EXAMPLE: example Dlocalization; shows examples
+"
+{
+  dmodGeneralAssumptionCheck();
+  finKx(f);
+  int ppl = printlevel - voice + 2;
+  int outList,eng;
+  if (size(#)>0)
+  {
+    if (typeof(#[1])=="int" || typeof(#[1])=="number")
+    {
+      outList = int(#[1]);
+    }
+    if (size(#)>1)
+    {
+      if (typeof(#[2])=="int" || typeof(#[2])=="number")
+      {
+        eng = int(#[2]);
+      }
+    }
+  }
+  int i,j;
+  def save = basering;
+  int n = nvars(save) div 2;
+  def Dv = extendWeyl(safeVarName("v"));
+  setring Dv;
+  poly f = imap(save,f);
+  ideal phiI;
+  for (i=n; i>0; i--)
+  {
+    phiI[i+n] = var(i+n+2)-var(1)^2*bracket(var(i+n+2),f)*var(n+2);
+    phiI[i]   = var(i+1);
+  }
+  map phi = save,phiI;
+  ideal J = phi(J);
+  J = J, 1-f*var(1);
+  // TODO original J has to be holonomic only on K^n\V(f), not on all of K^n
+  // does is suffice to show that new J is holonomic on Dv??
+  if (isHolonomic(J) == 0)
+  {
+    ERROR("Module is not holonomic.");
+  }
+  intvec w = 1; w[n+1]=0;
+  ideal G = GBWeight(J,w,-w,eng);
+  dbprint(ppl  ,"// found GB wrt weight " +string(-w));
+  dbprint(ppl-1,"// " + string(G));
+  intvec ww = w,-w;
+  ideal inG = inForm(G,ww);
+  inG = engine(inG,eng);
+  poly s = var(1)*var(n+2); // s=v*Dv
+  vector intersecvec = pIntersect(s,inG);
+  s = vec2poly(intersecvec);
+  s = subst(s,var(1),-var(1)-1);
+  list L = bFactor(s);
+  dbprint(ppl  ,"// found b-function");
+  dbprint(ppl-1,"// roots: "+string(L[1]));
+  dbprint(ppl-1,"// multiplicities: "+string(L[2]));
+  kill inG,intersecvec,s;
+  // TODO: use maxIntRoot
+  L = intRoots(L);           // integral roots of b-function
+  if (L[2]==0:size(L[2]))    // no integral roots
+  {
+    setring save;
+    return(ideal(1));
+  }
+  intvec iv;
+  for (i=1; i<=ncols(L[1]); i++)
+  {
+    iv[i] = int(L[1][i]);
+  }
+  int l0 = Max(iv);
+  dbprint(ppl,"// maximal integral root is " +string(l0));
+  kill L,iv;
+  intvec degG;
+  ideal Gk;
+  for (j=1; j<=ncols(G); j++)
+  {
+    degG[j] = deg(G[j],ww);
+    for (i=0; i<=l0-degG[j]; i++)
+    {
+      Gk[ncols(Gk)+1] = var(1)^i*G[j];
+    }
+  }
+  Gk = rightNFWeyl(Gk,n+2);
+  dbprint(ppl,"// found right normalforms");
+  module M = coeffs(Gk,var(1));
+  setring save;
+  def mer = makeModElimRing(save);
+  setring mer;
+  module M = imap(Dv,M);
+  kill Dv;
+  M = engine(M,eng);
+  dbprint(ppl  ,"// found GB of free module of rank " + string(l0+1));
+  dbprint(ppl-1,"// " + string(M));
+  M = prune(M);
+  setring save;
+  matrix M = imap(mer,M);
+  kill mer;
+  int ro = nrows(M);
+  int co = ncols(M);
+  ideal I;
+  if (ro == 1) // nothing to do
+  {
+    I = M;
+  }
+  else
+  {
+    matrix zm[ro-1][1]; // zero matrix
+    matrix v[ro-1][1];
+    for (i=1; i<=co; i++)
+    {
+      v = M[1..ro-1,i];
+      if (v == zm)
+      {
+        I[size(I)+1] = M[ro,i];
+      }
+    }
+  }
+  if (outList<>0)
+  {
+    return(list(I,l0+2));
+  }
+  else
+  {
+    return(I);
+  }
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  // (OTW), Example 8
+  ring r = 0,(x,y,z,Dx,Dy,Dz),dp;
+  def W = Weyl();
+  setring W;
+  poly f = x^3-y^2*z^2;
+  ideal I = f^2*Dx+3*x^2, f^2*Dy-2*y*z^2, f^2*Dz-2*y^2*z;
+  // I annihilates exp(1/f)
+  ideal J = Dlocalization(I,f);
+  J;
+  Dlocalization(I,f,1); // The natural map D/I -> D/J is given by 1/f^2
+}
+
+
+
+// Weyl closure ///////////////////////////////////////////////////////////////
+
+static proc orderFiltrationD1 (poly f)
+{
+  // returns list of ideal and intvec
+  // ideal contains x-parts, intvec corresponding degree in Dx
+  poly g,h;
+  g = f;
+  ideal I;
+  intvec v,w,u;
+  w = 0,1;
+  int i,j;
+  i = 1;
+  while (g<>0)
+  {
+    h = inForm(g,w);
+    I[i] = 0;
+    for (j=1; j<=size(h); j++)
+    {
+      v = leadexp(h[j]);
+      u[i] = v[2];
+      v[2] = 0;
+      I[i] = I[i] + leadcoef(h[j])*monomial(v);
+    }
+    g = g-h;
+    i++;
+  }
+  return(list(I,u));
+}
+
+
+static proc kerLinMapD1 (ideal W, poly L, poly p)
+{
+  // computes kernel of right multiplication with L viewed
+  // as homomorphism of K-vector spaces span(W) -> D1/p*D1
+  // assume p in K[x], basering is K<x,Dx>
+  ideal G,K;
+  G = std(p);
+  list l;
+  int i,j;
+  // first, compute the image of span(W)
+  if (simplify(W,2)[1] == 0)
+  {
+    return(K); // = 0
+  }
+  for (i=1; i<=size(W); i++)
+  {
+    l = orderFiltrationD1(W[i]*L);
+    K[i] = 0;
+    for (j=1; j<=size(l[1]); j++)
+    {
+      K[i] = K[i] + NF(l[1][j],G)*var(2)^(l[2][j]);
+    }
+  }
+  // now, we get the kernel by linear algebra
+  l = linReduceIdeal(K,1);
+  i = ncols(l[1]) - size(l[1]);
+  if (i<>0)
+  {
+    K = matrix(W)*matrix(l[2]);
+    K = K[1..i];
+  }
+  else
+  {
+    K = 0;
+  }
+  return(K);
+}
+
+
+static proc leftDivisionKxD1 (poly p, poly L)
+{
+  // basering is D1 = K<x,Dx>
+  // p in K[x]
+  // compute p^(-1)*L if p is a left divisor of L
+//   if (rightNF(L,ideal(p))<>0)
+//   {
+//     ERROR("First poly is not a right factor of second poly");
+//   }
+  def save = basering;
+  list l = orderFiltrationD1(L);
+  ideal l1 = l[1];
+  ring r = 0,x,dp;
+  ideal l1 = fetch(save,l1);
+  poly p = fetch(save,p);
+  int i;
+  for (i=1; i<=ncols(l1); i++)
+  {
+    l1[i] =  division(l1[i],p)[1][1,1];
+  }
+  setring save;
+  ideal I = fetch(r,l1);
+  poly f;
+  for (i=1; i<=ncols(I); i++)
+  {
+    f = f + I[i]*var(2)^(l[2][i]);
+  }
+  return(f);
+}
+
+
+proc WeylClosure1 (poly L)
+"
+USAGE:    WeylClosure1(L);  L a poly
+ASSUME:   The basering is the first Weyl algebra D=K<x,d|dx=xd+1> over a field
+          K of characteristic 0.
+RETURN:   ideal, the Weyl closure of the principal left ideal generated by L
+REMARKS:  The Weyl closure of a left ideal I in the Weyl algebra D is defined
+          to be the intersection of I regarded as left ideal in the rational
+          Weyl algebra K(x)<d> with the polynomial Weyl algebra D.
+@*        Reference: (Tsa), Algorithm 1.2.4
+NOTE:     If printlevel=1, progress debug messages will be printed,
+          if printlevel>=2, all the debug messages will be printed.
+SEE ALSO: WeylClosure
+EXAMPLE:  example WeylClosure1; shows examples
+"
+{
+  dmodGeneralAssumptionCheck(); // assumption check
+  int ppl = printlevel - voice + 2;
+  def save = basering;
+  intvec w = 0,1; // for order filtration
+  poly p = inForm(L,w);
+  ring @R = 0,var(1),dp;
+  ideal mm = var(1),1;
+  map m = save,mm;
+  ideal @p = m(p);
+  poly p = @p[1];
+  poly g = gcd(p,diff(p,var(1)));
+  if (g == 1)
+  {
+    g = p;
+  }
+  ideal facp = factorize(g,1); // g is squarefree, constants aren't interesting
+  dbprint(ppl-1,
+          "// squarefree part of highest coefficient w.r.t. order filtration:");
+  dbprint(ppl-1, "// " + string(facp));
+  setring save;
+  p = imap(@R,p);
+  // 1-1 extend basering by parameter and introduce new var t=x*d
+  list RL = ringlist(save);
+  RL = RL[1..4];
+  list l;
+  l[1] = int(0);
+  l[2] = list(safeVarName("a"));
+  l[3] = list(list("lp",intvec(1)));
+  l[4] = ideal(0);
+  RL[1] = l;
+  l = RL[2] + list(safeVarName("t"));
+  RL[2] = l;
+  l = list();
+  l[1] = list("dp",intvec(1,1));
+  l[2] = list("dp",intvec(1));
+  l[3] = list("C",intvec(0));
+  RL[3] = l;
+  def @Wat = ring(RL);
+  kill RL,l;
+  setring @Wat;
+  matrix relD[3][3];
+  relD[1,2] = 1;
+  relD[1,3] = var(1);
+  relD[2,3] = -var(2);
+  def Wat = nc_algebra(1,relD);
+  setring Wat;
+  kill @Wat;
+  // 1-2 rewrite L using Euler operators
+  ideal mm = var(1)+par(1),var(2);
+  map m = save,mm;
+  poly L = m(L);
+  w = -1,1,0; // for Bernstein filtration
+  int i = 1;
+  ideal Q;
+  poly p = L;
+  intvec d;
+  while (p<>0)
+  {
+    Q[i] = inForm(p,w);
+    p = p - Q[i];
+    d[i] = -deg(Q[i],w);
+    i++;
+  }
+  ideal S = std(var(1)*var(2)-var(3));
+  Q = NF(Q,S);
+  dbprint(ppl,  "// found Euler representation of operator");
+  dbprint(ppl-1,"// " + string(Q));
+  Q = subst(Q,var(1),1);
+  Q = subst(Q,var(2),1);
+  // 1-3 prepare for algebraic extensions with minpoly = facp[i]
+  list RL = ringlist(Wat);
+  RL = RL[1..4];
+  list l;
+  l = string(var(3));
+  RL[2] = l;
+  l = list();
+  l[1] = list("dp",intvec(1));
+  l[2] = list("C",intvec(0));
+  RL[3] = l;
+  mm = par(1);
+  m = @R,par(1);
+  ideal facp = m(facp);
+  kill @R,m,mm,l,S;
+  intvec maxroots,testroots;
+  int sq = size(Q);
+  string strQ = "ideal Q = " + string(Q) + ";";
+  // TODO do it without string workaround when issue with maps from
+  //   transcendental to algebraic extension fields is fixed
+  int j,maxr;
+  // 2-1 get max int root of lowest nonzero entry of Q in algebraic extension
+  for (i=1; i<=size(facp); i++)
+  {
+    testroots = 0;
+    def Ra = ring(RL);
+    setring Ra;
+    ideal mm = 1,1,var(1);
+    map m = Wat,mm;
+    ideal facp = m(facp);
+    minpoly = leadcoef(facp[i]);
+    execute(strQ);
+    if (simplify(Q,2)[1] == poly(0))
+    {
+      break;
+    }
+    j = 1;
+    while (j<sq)
+    {
+      if (Q[j]==0)
+      {
+        j++;
+      }
+      else
+      {
+        break;
+      }
+    }
+    maxroots[i] = d[j]; // d[j] = r_k
+    list LR = bFactor(Q[j]);
+    LR = intRoots(LR);
+    if (LR[2]<>0:size(LR[2])) // there are integral roots
+    {
+      for (j=1; j<=ncols(LR[1]); j++)
+      {
+        testroots[j] = int(LR[1][j]);
+      }
+      maxr = Max(testroots);
+      if(maxr<0)
+      {
+        maxr = 0;
+      }
+      maxroots[i] = maxroots[i] + maxr;
+    }
+    kill LR;
+    setring Wat;
+    kill Ra;
+  }
+  maxr = Max(maxroots);
+  // 3-1 build basis of vectorspace
+  setring save;
+  ideal KB;
+  for (i=0; i<deg(p); i++)  // it's really <, not <=
+  {
+    for (j=0; j<=maxr; j++) // it's really <=, not <
+    {
+      KB[size(KB)+1] = monomial(intvec(i,j));
+    }
+  }
+  dbprint(ppl,"// got vector space basis");
+  dbprint(ppl-1, "// " + string(KB));
+  // 3-2 get kernel of *L: span(KB)->D/pD
+  KB = kerLinMapD1(KB,L,p);
+  dbprint(ppl,"// got kernel");
+  dbprint(ppl-1, "// " + string(KB));
+  // 4-1 get (1/p)*f*L where f in KB
+  for (i=1; i<=ncols(KB); i++)
+  {
+    KB[i] = leftDivisionKxD1(p,KB[i]*L);
+  }
+  KB = L,KB;
+  // 4-2 done
+  return(KB);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  ring r = 0,(x,Dx),dp;
+  def W = Weyl();
+  setring W;
+  poly L = (x^3+2)*Dx-3*x^2;
+  WeylClosure1(L);
+  L = (x^4-4*x^3+3*x^2)*Dx^2+(-6*x^3+20*x^2-12*x)*Dx+(12*x^2-32*x+12);
+  WeylClosure1(L);
+}
+
+
+proc WeylClosure (ideal I)
+"
+USAGE:    WeylClosure(I);  I an ideal
+ASSUME:   The basering is the n-th Weyl algebra W over a field of
+          characteristic 0 and for all 1<=i<=n the identity
+          var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the sequence of
+          variables is given by x(1),...,x(n),D(1),...,D(n), where D(i) is the
+          differential operator belonging to x(i).
+@*        Moreover, assume that the holonomic rank of W/I is finite.
+RETURN:   ideal, the Weyl closure of I
+REMARKS:  The Weyl closure of a left ideal I in the Weyl algebra W is defined to
+          be the intersection of I regarded as left ideal in the rational Weyl
+          algebra K(x(1..n))<D(1..n)> with the polynomial Weyl algebra W.
+@*        Reference: (Tsa), Algorithm 2.2.4
+NOTE:     If printlevel=1, progress debug messages will be printed,
+          if printlevel>=2, all the debug messages will be printed.
+SEE ALSO: WeylClosure1
+EXAMPLE:  example WeylClosure; shows examples
+"
+{
+  // assumption check
+  dmodGeneralAssumptionCheck();
+  if (holonomicRank(I)==-1)
+  {
+    ERROR("Input is not of finite holonomic rank.");
+  }
+  int ppl = printlevel - voice + 2;
+  int eng = 0; // engine
+  def save = basering;
+  dbprint(ppl  ,"// Starting to compute singular locus...");
+  ideal sl = DsingularLocus(I);
+  sl = simplify(sl,2);
+  dbprint(ppl  ,"// ...done.");
+  dbprint(ppl-1,"// " + string(sl));
+  if (sl[1] == 0) // can never get here
+  {
+    ERROR("Can't find polynomial in K[x] vanishing on singular locus.");
+  }
+  poly f = sl[1];
+  dbprint(ppl  ,"// Found poly vanishing on singular locus: " + string(f));
+  dbprint(ppl  ,"// Starting to compute localization...");
+  list L = Dlocalization(I,f,1);
+  ideal G = L[1];
+  dbprint(ppl  ,"// ...done.");
+  dbprint(ppl-1,"// " + string(G));
+  dbprint(ppl  ,"// Starting to compute kernel of localization map...");
+  if (eng == 0)
+  {
+    G = moduloSlim(f^L[2],G);
+  }
+  else
+  {
+    G = modulo(f^L[2],G);
+  }
+  dbprint(ppl  ,"// ...done.");
+  return(G);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  // (OTW), Example 8
+  ring r = 0,(x,y,z,Dx,Dy,Dz),dp;
+  def D3 = Weyl();
+  setring D3;
+  poly f = x^3-y^2*z^2;
+  ideal I = f^2*Dx + 3*x^2, f^2*Dy-2*y*z^2, f^2*Dz-2*y^2*z;
+  // I annihilates exp(1/f)
+  WeylClosure(I);
+}
+
+
+
+// solutions to systems of PDEs ///////////////////////////////////////////////
+
+proc polSol (ideal I, list #)
+"
+USAGE:    polSol(I[,w,m]);  I ideal, w optional intvec, m optional int
+ASSUME:   The basering is the n-th Weyl algebra W over a field of
+          characteristic 0 and for all 1<=i<=n the identity
+          var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the sequence of
+          variables is given by x(1),...,x(n),D(1),...,D(n), where D(i) is the
+          differential operator belonging to x(i).
+@*        Moreover, assume that I is holonomic.
+RETURN:   ideal, a basis of the polynomial solutions to the given system of
+          linear PDEs with polynomial coefficients, encoded via I
+REMARKS:  If w is given, w should consist of n strictly negative entries.
+          Otherwise and by default, w is set to -1:n.
+          In this case, w is used as weight vector for the computation of a
+          b-function.
+@*        If m is given, m is assumed to be the minimal integer root of the
+          b-function of I w.r.t. w. Note that this assumption is not checked.
+@*        Reference: (OTT), Algorithm 2.4
+NOTE:     If printlevel=1, progress debug messages will be printed,
+          if printlevel>=2, all the debug messages will be printed.
+SEE ALSO: polSolFiniteRank, ratSol
+EXAMPLE:  example polSol; shows examples
+"
+{
+  dmodGeneralAssumptionCheck();
+  int ppl = printlevel - voice + 2;
+  int mr,mrgiven;
+  def save = basering;
+  int n = nvars(save);
+  intvec w = -1:(n div 2);
+  if (size(#)>0)
+  {
+    if (typeof(#[1])=="intvec")
+    {
+      if (allPositive(-#[1]))
+      {
+        w = #[1];
+      }
+    }
+    if (size(#)>1)
+    {
+      if (typeof(#[2])=="int")
+      {
+        mr = #[2];
+        mrgiven = 1;
+      }
+    }
+  }
+  // Step 1: the b-function
+  list L;
+  if (!mrgiven)
+  {
+    if (!isHolonomic(I))
+    {
+      ERROR("Ideal is not holonomic. Try polSolFiniteRank.");
+    }
+    dbprint(ppl,"// Computing b-function...");
+    L = bfctIdeal(I,w);
+    dbprint(ppl,"// ...done.");
+    dbprint(ppl-1,"//   Roots: " + string(L[1]));
+    dbprint(ppl-1,"//   Multiplicities: " + string(L[2]));
+    mr = minIntRoot2(L);
+    dbprint(ppl,"// Minimal integer root is " + string(mr) + ".");
+  }
+  if (mr>0)
+  {
+    return(ideal(0));
+  }
+  // Step 2: get the form of a solution f
+  int i;
+  L = list();
+  for (i=0; i<=-mr; i++)
+  {
+    L = L + orderedPartition(i,-w);
+  }
+  ideal mons;
+  for (i=1; i<=size(L); i++)
+  {
+    mons[i] = monomial(L[i]);
+  }
+  kill L;
+  mons = simplify(mons,2+4); // L might contain lots of 0s by construction
+  ring @C = (0,@c(1..size(mons))),dummyvar,dp;
+  def WC = save + @C;
+  setring WC;
+  ideal mons = imap(save,mons);
+  poly f;
+  for (i=1; i<=size(mons); i++)
+  {
+    f = f + par(i)*mons[i];
+  }
+  // Step 3: determine values of @c(i) by equating coefficients
+  ideal I = imap(save,I);
+  I = dmodAction(I,f,1..n);
+  ideal M = monomialInIdeal(I);
+  matrix CC = coeffs(I,M);
+  int j;
+  ideal C;
+  for (i=1; i<=nrows(CC); i++)
+  {
+    f = 0;
+    for (j=1; j<=ncols(CC); j++)
+    {
+      f = f + CC[i,j];
+    }
+    C[size(C)+1] = f;
+  }
+  // Step 3.1: solve a linear system
+  ring rC = 0,(@c(1..size(mons))),dp;
+  ideal C = imap(WC,C);
+  matrix M = coeffs(C,maxideal(1));
+  module MM = leftKernel(M);
+  setring WC;
+  module MM = imap(rC,MM);
+  // Step 3.2: return the solution
+  ideal F = ideal(MM*transpose(mons));
+  setring save;
+  ideal F = imap(WC,F);
+  return(F);
+}
+example
+{
+  "EXAMPLE:"; echo=2;
+  ring r = 0,(x,y,Dx,Dy),dp;
+  def W = Weyl();
+  setring W;
+  poly tx,ty = x*Dx, y*Dy;
+  ideal I =      // Appel F1 with parameters (2,-3,-2,5)
+    tx*(tx+ty+4)-x*(tx+ty+2)*(tx-3),
+    ty*(tx+ty+4)-y*(tx+ty+2)*(ty-2),
+    (x-y)*Dx*Dy+2*Dx-3*Dy;
+  intvec w = -1,-1;
+  polSol(I,w);
+}
+
+
+static proc ex_polSol()
+{  ring r = 0,(x,y,Dx,Dy),dp;
+  def W = Weyl();
+  setring W;
+  poly tx,ty = x*Dx, y*Dy;
+  ideal I =      // Appel F1 with parameters (2,-3,-2,5)
+    tx*(tx+ty+4)-x*(tx+ty+2)*(tx-3),
+    ty*(tx+ty+4)-y*(tx+ty+2)*(ty-2),
+    (x-y)*Dx*Dy+2*Dx-3*Dy;
+  intvec w = -5,-7;
+  // the following gives a bug
+  polSol(I,w);
+  // this is due to a bug in weightKB, see ticket #339
+  // http://www.singular.uni-kl.de:8002/trac/ticket/339
+}
+
+
+proc polSolFiniteRank (ideal I, list #)
+"
+USAGE:    polSolFiniteRank(I[,w]);  I ideal, w optional intvec
+ASSUME:   The basering is the n-th Weyl algebra W over a field of
+          characteristic 0 and for all 1<=i<=n the identity
+          var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the sequence of
+          variables is given by x(1),...,x(n),D(1),...,D(n), where D(i) is the
+          differential operator belonging to x(i).
+@*        Moreover, assume that I is of finite holonomic rank.
+RETURN:   ideal, a basis of the polynomial solutions to the given system of
+          linear PDEs with polynomial coefficients, encoded via I
+REMARKS:  If w is given, w should consist of n strictly negative entries.
+          Otherwise and by default, w is set to -1:n.
+          In this case, w is used as weight vector for the computation of a
+          b-function.
+@*        Reference: (OTT), Algorithm 2.6
+NOTE:     If printlevel=1, progress debug messages will be printed,
+          if printlevel>=2, all the debug messages will be printed.
+SEE ALSO: polSol, ratSol
+EXAMPLE:  example polSolFiniteRank; shows examples
+"
+{
+  dmodGeneralAssumptionCheck();
+  if (holonomicRank(I)==-1)
+  {
+    ERROR("Ideal is not of finite holonomic rank.");
+  }
+  int ppl = printlevel - voice + 2;
+  int n = nvars(basering) div 2;
+  int eng;
+  intvec w = -1:(n div 2);
+  if (size(#)>0)
+  {
+    if (typeof(#[1])=="intvec")
+    {
+      if (allPositive(-#[1]))
+      {
+        w = #[1];
+      }
+    }
+  }
+  dbprint(ppl,"// Computing initial ideal...");
+  ideal J = initialIdealW(I,-w,w);
+  dbprint(ppl,"// ...done.");
+  dbprint(ppl,"// Computing Weyl closure...");
+  J = WeylClosure(J);
+  J = engine(J,eng);
+  dbprint(ppl,"// ...done.");
+  poly s;
+  int i;
+  for (i=1; i<=n; i++)
+  {
+    s = s + w[i]*var(i)*var(i+n);
+  }
+  dbprint(ppl,"// Computing intersection...");
+  vector v = pIntersect(s,J);
+  list L = bFactor(vec2poly(v));
+  dbprint(ppl-1,"//   roots: " + string(L[1]));
+  dbprint(ppl-1,"//   multiplicities: " + string(L[2]));
+  dbprint(ppl,"// ...done.");
+  int mr =  minIntRoot2(L);
+  int pl = printlevel;
+  printlevel = printlevel + 1;
+  ideal K = polSol(I,w,mr);
+  printlevel = printlevel - 1;
+  return(K);
+}
+example
+{
+  "EXAMPLE:"; echo=2;
+  ring r = 0,(x,y,Dx,Dy),dp;
+  def W = Weyl();
+  setring W;
+  poly tx,ty = x*Dx, y*Dy;
+  ideal I =      // Appel F1 with parameters (2,-3,-2,5)
+    tx*(tx+ty+4)-x*(tx+ty+2)*(tx-3),
+    ty*(tx+ty+4)-y*(tx+ty+2)*(ty-2),
+    (x-y)*Dx*Dy+2*Dx-3*Dy;
+  intvec w = -1,-1;
+  polSolFiniteRank(I,w);
+}
+
+
+static proc twistedIdeal(ideal I, poly f, intvec k, ideal F)
+{
+  // I subset D_n, f in K[x], F = factorize(f,1), size(k) = size(F), k[i]>0
+  def save = basering;
+  int n = nvars(save) div 2;
+  int i,j;
+  intvec a,v,w;
+  w = (0:n),(1:n);
+  for (i=1; i<=size(I); i++)
+  {
+    a[i] = deg(I[i],w);
+  }
+  ring FD = 0,(fd(1..n)),dp;
+  def @@WFD = save + FD;
+  setring @@WFD;
+  poly f = imap(save,f);
+  list RL = ringlist(basering);
+  RL = RL[1..4];
+  list L = RL[3];
+  v = (1:(2*n)),((deg(f)+1):n);
+  L = insert(L,list("a",v));
+  RL[3] = L;
+  def @WFD = ring(RL);
+  setring @WFD;
+  poly f = imap(save,f);
+  matrix Drel[3*n][3*n];
+  for (i=1; i<=n; i++)
+  {
+    Drel[i,i+n] = 1;     // [D,x]
+    Drel[i,i+2*n] = f;   // [fD,x]
+    for (j=1; j<=n; j++)
+    {
+      Drel[i+n,j+2*n] = -diff(f,var(i))*var(j+n);  // [fD,D]
+      Drel[j+2*n,i+2*n] = diff(f,var(i))*var(j+2*n) - diff(f,var(j))*var(i+2*n);
+      // [fD,fD]
+    }
+  }
+  def WFD = nc_algebra(1,Drel);
+  setring WFD;
+  kill @WFD,@@WFD;
+  ideal I = imap(save,I);
+  poly f = imap(save,f);
+  for (i=1; i<=size(I); i++)
+  {
+    I[i] = f^(a[i])*I[i];
+  }
+  ideal S;
+  for (i=1; i<=n; i++)
+  {
+    S[size(S)+1] = var(i+2*n) - f*var(i+n);
+  }
+  S = slimgb(S);
+  I = NF(I,S);
+  if (select1(I,intvec((n+1)..2*n))[1] <> 0)
+  {
+    // should never get here
+    ERROR("Something's wrong. Please inform the author.");
+  }
+  setring save;
+  ideal mm = maxideal(1);
+  poly s;
+  for (i=1; i<=n; i++)
+  {
+    s = f*var(i+n);
+    for (j=1; j<=size(F); j++)
+    {
+      s = s + k[j]*(f/F[j])*bracket(var(i+n),F[j]);
+    }
+    mm[i+2*n] = s;
+  }
+  map m = WFD,mm;
+  ideal J = m(I);
+  return(J);
+}
+example
+{
+  "EXAMPLE"; echo=2;
+  ring r = 0,(x,y,Dx,Dy),dp;
+  def W = Weyl();
+  setring W;
+  poly tx,ty = x*Dx, y*Dy;
+  ideal I =      // Appel F1 with parameters (3,-1,1,1) is a solution
+    tx*(tx+ty)-x*(tx+ty+3)*(tx-1),
+    ty*(tx+ty)-y*(tx+ty+3)*(ty+1);
+  kill tx,ty;
+  poly f = x^3*y^2-x^2*y^3-x^3*y+x*y^3+x^2*y-x*y^2;
+  ideal F = x-1,x,-x+y,y-1,y;
+  intvec k = -1,-1,-1,-3,-1;
+  ideal T = twistedIdeal(I,f,k,F);
+  // TODO change the ordering of WFD
+  // introduce new var f??
+  //paper:
+  poly fx = diff(f,x);
+  poly fy = diff(f,y);
+  poly fDx = f*Dx;
+  poly fDy = f*Dy;
+  poly fd(1) = fDx;
+  poly fd(2) = fDy;
+  ideal K=
+    (x^2-x^3)*(fDx)^2+x*((1-3*x)*f-(1-x)*y*fy-(1-x)*x*fx)*(fDx)
+    +x*(1-x)*y*(fDy)*(fDx)+x*y*f*(fDy)+3*x*f^2,
+    (y^2-y^3)*(fDy)^2+y*((1-5*y)*f-(1-y)*x*fx-(1-y)*y*fy)*(fDy)
+    +y*(1-y)*x*(fDx)*(fDy)-y*x*f*(fDx)-3*y*f^2;
+}
+
+
+proc ratSol (ideal I)
+"
+USAGE:    ratSol(I);  I ideal
+ASSUME:   The basering is the n-th Weyl algebra W over a field of
+          characteristic 0 and for all 1<=i<=n the identity
+          var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the sequence of
+          variables is given by x(1),...,x(n),D(1),...,D(n), where D(i) is the
+          differential operator belonging to x(i).
+@*        Moreover, assume that I is holonomic.
+RETURN:   module, a basis of the rational solutions to the given system of
+          linear PDEs with polynomial coefficients, encoded via I
+          Note that each entry has two components, the first one standing for
+          the enumerator, the second one for the denominator.
+REMARKS:  Reference: (OTT), Algorithm 3.10
+NOTE:     If printlevel=1, progress debug messages will be printed,
+          if printlevel>=2, all the debug messages will be printed.
+SEE ALSO: polSol, polSolFiniteRank
+EXAMPLE:  example ratSol; shows examples
+"
+{
+  dmodGeneralAssumptionCheck();
+  if (!isHolonomic(I))
+  {
+    ERROR("Ideal is not holonomic.");
+  }
+  int ppl = printlevel - voice + 2;
+  def save = basering;
+  dbprint(ppl,"// computing singular locus...");
+  ideal S = DsingularLocus(I);
+  dbprint(ppl,"// ...done.");
+  poly f = S[1];
+  dbprint(ppl,"// considering poly " + string(f));
+  int n = nvars(save) div 2;
+  list RL = ringlist(save);
+  RL = RL[1..4];
+  list L = RL[2];
+  L = list(L[1..n]);
+  RL[2] = L;
+  L = list();
+  L[1] = list("dp",intvec(1:n));
+  L[2] = list("C",intvec(0));
+  RL[3] = L;
+  def rr = ring(RL);
+  setring rr;
+  poly f = imap(save,f);
+  ideal F = factorize(f,1); // not interested in multiplicities
+  dbprint(ppl,"// with irreducible factors " + string(F));
+  setring save;
+  ideal F = imap(rr,F);
+  kill rr,RL;
+  int i;
+  intvec k;
+  ideal FF = 1,1;
+  dbprint(ppl,"// computing b-functions of irreducible factors...");
+  for (i=1; i<=size(F); i++)
+  {
+    dbprint(ppl,"//   considering " + string(F[i]) + "...");
+    L = bfctBound(I,F[i]);
+    if (size(L) == 3) // bfct is constant
+    {
+      dbprint(ppl,"//   ...got " + string(L[3]));
+      if (L[3] == "1")
+      {
+        return(0); // TODO type // no rational solutions
+      }
+      else // should never get here
+      {
+        ERROR("Oops, something went wrong. Please inform the author.");
+      }
+    }
+    else
+    {
+      dbprint(ppl,"//   ...got roots " + string(L[1]));
+      dbprint(ppl,"//      with multiplicities " + string(L[2]));
+      k[i] = -maxIntRoot(L)-1;
+      if (k[i] < 0)
+      {
+        FF[2] = FF[2]*F[i]^(-k[i]);
+      }
+      else
+      {
+        FF[1] = FF[1]*F[i]^(k[i]);
+      }
+    }
+  }
+  vector v = FF[1]*gen(1) + FF[2]*gen(2);
+  kill FF;
+  dbprint(ppl,"// ...done");
+  ideal twI = twistedIdeal(I,f,k,F);
+  intvec w = -1:n;
+  dbprint(ppl,"// computing polynomial solutions of twisted system...");
+  if (isHolonomic(twI))
+  {
+    ideal P = polSol(twI,w);
+  }
+  else
+  {
+    ideal P = polSolFiniteRank(twI,w);
+  }
+  module M;
+  vector vv;
+  for (i=1; i<=ncols(P); i++)
+  {
+    vv = P[i]*gen(1) + 1*gen(2);
+    M[i] = multRat(v,vv);
+  }
+  dbprint(ppl,"// ...done");
+  return (M);
+}
+example
+{
+  "EXAMPLE"; echo=2;
+  ring r = 0,(x,y,Dx,Dy),dp;
+  def W = Weyl();
+  setring W;
+  poly tx,ty = x*Dx, y*Dy;
+  ideal I =      // Appel F1 with parameters (3,-1,1,1) is a solution
+    tx*(tx+ty)-x*(tx+ty+3)*(tx-1),
+    ty*(tx+ty)-y*(tx+ty+3)*(ty+1);
+  module M = ratSol(I);
+  // We obtain a basis of the rational solutions to I represented by a
+  // module / matrix with two rows.
+  // Each column of the matrix represents a rational function, where
+  // the first row correspond to the enumerator and the second row to
+  // the denominator.
+  print(M);
+}
+
+
+proc bfctBound (ideal I, poly f, list #)
+"
+USAGE:    bfctBound (I,f[,primdec]);  I ideal, f poly, primdec optional string
+ASSUME:   The basering is the n-th Weyl algebra W over a field of
+          characteristic 0 and for all 1<=i<=n the identity
+          var(i+n)*var(i)=var(i)*var(i+1)+1 holds, i.e. the sequence of
+          variables is given by x(1),...,x(n),D(1),...,D(n), where D(i) is the
+          differential operator belonging to x(i).
+@*        Moreover, assume that I is holonomic.
+RETURN:   list of roots (of type ideal) and multiplicities (of type intvec) of
+          a multiple of the b-function for f^s*u at a generic root of f.
+          Here, u stands for [1] in D/I.
+REMARKS:  Reference: (OTT), Algorithm 3.4
+NOTE:     This procedure requires to compute a primary decomposition in a
+          commutative ring. The optional string primdec can be used to specify
+          the algorithm to do so. It may either be `GTZ' (Gianni, Trager,
+          Zacharias) or `SY' (Shimoyama, Yokoyama). By default, `GTZ' is used.
+@*        If printlevel=1, progress debug messages will be printed,
+          if printlevel>=2, all the debug messages will be printed.
+SEE ALSO: bernstein, bfct, bfctAnn
+EXAMPLE:  example bfctBound; shows examples
+"
+{
+  dmodGeneralAssumptionCheck();
+  finKx(f);
+  if (!isHolonomic(I))
+  {
+    ERROR("Ideal is not holonomic.");
+  }
+  int ppl = printlevel - voice + 2;
+  string primdec = "GTZ";
+  if (size(#)>1)
+  {
+    if (typeof(#[1])=="string")
+    {
+      if ( (#[1]=="SY") || (#[1]=="sy") || (#[1]=="Sy") )
+      {
+        primdec = "SY";
+      }
+      else
+      {
+        if ( (#[1]<>"GTZ") && (#[1]<>"gtz") && (#[1]<>"Gtz") )
+        {
+          print("// Warning: optional string may either be `GTZ' or `SY',");
+          print("//          proceeding with `GTZ'.");
+          primdec = "GTZ";
+        }
+      }
+    }
+  }
+  def save = basering;
+  int n = nvars(save) div 2;
+  // step 1
+  ideal mm = maxideal(1);
+  def Wt = extendWeyl(safeVarName("t"));
+  setring Wt;
+  poly f = imap(save,f);
+  ideal mm = imap(save,mm);
+  int i;
+  for (i=1; i<=n; i++)
+  {
+    mm[i+n] = var(i+n+2) + bracket(var(i+n+2),f)*var(n+2);
+  }
+  map m = save,mm;
+  ideal I = m(I);
+  I = I, var(1)-f;
+  // step 2
+  intvec w = 1,(0:n);
+  dbprint(ppl  ,"// Computing initial ideal...");
+  I = initialIdealW(I,-w,w);
+  dbprint(ppl  ,"// ...done.");
+  dbprint(ppl-1,"// " + string(I));
+  // step 3: rewrite I using Euler operator t*Dt
+  list RL = ringlist(Wt);
+  RL = RL[1..4];
+  list L = RL[2] + list(safeVarName("s")); // s=t*Dt
+  RL[2] = L;
+  L = list();
+  L[1] = list("dp",intvec(1:(2*n+2)));
+  L[2] = list("dp",intvec(1));
+  L[3] = list("C",intvec(0));
+  RL[3] = L;
+  def @Wts = ring(RL);
+  kill L,RL;
+  setring @Wts;
+  matrix relD[2*n+3][2*n+3];
+  relD[1,2*n+3] = var(1);
+  relD[n+2,2*n+3] = -var(n+2);
+  for (i=1; i<=n+1; i++)
+  {
+    relD[i,n+i+1] = 1;
+  }
+  def Wts = nc_algebra(1,relD);
+  setring Wts;
+  ideal I = imap(Wt,I);
+  kill Wt,@Wts;
+  ideal S = var(1)*var(n+2)-var(2*n+3);
+  attrib(S,"isSB",1);
+  dbprint(ppl  ,"// Computing Euler representation...");
+  // I = NF(I,S);
+  int d;
+  intvec ww = 0:(2*2+2); ww[1] = -1; ww[n+2] = 1;
+  for (i=1; i<=size(I); i++)
+  {
+    d = deg(I[i],ww);
+    if (d>0)
+    {
+      I[i] = var(1)^d*I[i];
+    }
+    if (d<0)
+    {
+      d = -d;
+      I[i] = var(n+2)^d*I[i];
+    }
+  }
+  I = NF(I,S); // now there are no t,Dt in I, only s
+  dbprint(ppl  ,"// ...done.");
+  I = subst(I,var(2*n+3),-var(2*n+3)-1);
+  ring Ks = 0,s,dp;
+  def Ws = save + Ks;
+  setring Ws;
+  ideal I = imap(Wts,I);
+  kill Wts;
+  poly DD = 1;
+  for (i=1; i<=n; i++)
+  {
+    DD = DD * var(n+i);
+  }
+  dbprint(ppl  ,"// Eliminating differential operators...");
+  ideal J = eliminate(I,DD); // J subset K[x,s]
+  dbprint(ppl  ,"// ...done.");
+  dbprint(ppl-1,"// " + string(J));
+  list RL = ringlist(Ws);
+  RL = RL[1..4];
+  list L = RL[2];
+  L = list(L[1..n]) + list(L[2*n+1]);
+  RL[2] = L;
+  L = list();
+  L[1] = list("dp",intvec(1:(n+1)));
+  L[2] = list("C",intvec(0));
+  RL[3] = L;
+  def Kxs = ring(RL);
+  setring Kxs;
+  ideal J = imap(Ws,J);
+  dbprint(ppl  ,"// Computing primary decomposition with engine "
+          + primdec + "...");
+  if (primdec == "GTZ")
+  {
+    list P = primdecGTZ(J);
+  }
+  else
+  {
+    list P = primdecSY(J);
+  }
+  dbprint(ppl  ,"// ...done.");
+  dbprint(ppl-1,"// " + string(P));
+  ideal GP,Qix,rad,B;
+  poly f = imap(save,f);
+  vector v;
+  for (i=1; i<=size(P); i++)
+  {
+    dbprint(ppl  ,"// Considering primary component " + string(i)
+            + " of " + string(size(P)) + "...");
+    dbprint(ppl  ,"//   Intersecting with K[x] and computing radical...");
+    GP = std(P[i][1]);
+    Qix = eliminate(GP,var(n+1)); // subset K[x]
+    rad = radical(Qix);
+    rad = std(rad);
+    dbprint(ppl  ,"//   ...done.");
+    dbprint(ppl-1,"// " + string(rad));
+    if (rad[1]==0 || NF(f,rad)==0)
+    {
+      dbprint(ppl  ,"//   Intersecting with K[s]...");
+      v = pIntersect(var(n+1),GP);
+      B[size(B)+1] = vec2poly(v,n+1);
+      dbprint(ppl  ,"//   ...done.");
+      dbprint(ppl-1,"// " + string(B[size(B)]));
+    }
+    dbprint(ppl  ,"// ...done.");
+  }
+  f = lcm(B); // =lcm(B[1],...,B[size(B)])
+  list bb = bFactor(f);
+  setring save;
+  list bb = imap(Kxs,bb);
+  return(bb);
+}
+example
+{
+  "EXAMPLE"; echo=2;
+  ring r = 0,(x,y,Dx,Dy),dp;
+  def W = Weyl();
+  setring W;
+  poly tx,ty = x*Dx, y*Dy;
+  ideal I =      // Appel F1 with parameters (2,-3,-2,5)
+    tx*(tx+ty+4)-x*(tx+ty+2)*(tx-3),
+    ty*(tx+ty+4)-y*(tx+ty+2)*(ty-2),
+    (x-y)*Dx*Dy+2*Dx-3*Dy;
+  kill tx,ty;
+  poly f = x-1;
+  bfctBound(I,f);
+}
+
+
+//TODO check f/g or g/f, check Weyl closure of result
+proc annRatSyz (poly f, poly g, list #)
+"
+USAGE:    annRatSyz(f,g[,db,eng]);  f, g polynomials, db,eng optional integers
+ASSUME:   The basering is commutative and over a field of characteristic 0.
+RETURN:   ring (a Weyl algebra) containing an ideal `LD', which is (part of)
+          the annihilator of the rational function g/f in the corresponding
+          Weyl algebra
+REMARKS:  This procedure uses the computation of certain syzygies.
+          One can obtain the full annihilator by computing the Weyl closure of
+          the ideal LD.
+NOTE:     Activate the output ring with the @code{setring} command.
+          In the output ring, the ideal `LD' (in Groebner basis) is (part of)
+          the annihilator of g/f.
+@*        If db>0 is given, operators of order up to db are considered,
+          otherwise, and by default, a minimal holonomic solution is computed.
+@*        If eng<>0, @code{std} is used for Groebner basis computations,
+          otherwise, and by default, @code{slimgb} is used.
+@*        If printlevel =1, progress debug messages will be printed,
+          if printlevel>=2, all the debug messages will be printed.
+SEE ALSO: annRat, annPoly
+EXAMPLE:  example annRatSyz; shows examples
+"
+{
+  // check assumptions
+  if (!isCommutative())
+  {
+    ERROR("Basering must be commutative.");
+  }
+  if (  (size(ideal(basering)) >0) || (char(basering) >0) )
+  {
+    ERROR("Basering is inappropriate: characteristic>0 or qring present.");
+  }
+  if (g == 0)
+  {
+    ERROR("Second polynomial must not be zero.");
+  }
+  int db,eng;
+  if (size(#)>0)
+  {
+    if (typeof(#[1]) == "int")
+    {
+      db = int(#[1]);
+    }
+    if (size(#)>1)
+    {
+      if (typeof(#[2]) == "int")
+      {
+        eng = int(#[1]);
+      }
+    }
+  }
+  int ppl = printlevel - voice + 2;
+  vector I = f*gen(1)+g*gen(2);
+  checkRatInput(I);
+  int i,j;
+  def R = basering;
+  int n = nvars(R);
+  list RL = ringlist(R);
+  RL = RL[1..4];
+  list Ltmp = RL[2];
+  for (i=1; i<=n; i++)
+  {
+    Ltmp[i+n] = safeVarName("D" + Ltmp[i]);
+  }
+  RL[2] = Ltmp;
+  Ltmp = list();
+  Ltmp[1] = list("dp",intvec(1:2*n));
+  Ltmp[2] = list("C",intvec(0));
+  RL[3] = Ltmp;
+  kill Ltmp;
+  def @D = ring(RL);
+  setring @D;
+  def D = Weyl();
+  setring D;
+  ideal DD = 1;
+  ideal Dcd,Dnd,LD,tmp;
+  Dnd = 1;
+  module DS;
+  poly DJ;
+  kill @D;
+  setring R;
+  module Rnd,Rcd;
+  Rnd[1] = I;
+  vector RJ;
+  ideal L = I[1];
+  module RS;
+  poly p,pnew;
+  pnew = I[2];
+  int k,c;
+  while(1)
+  {
+    k++;
+    setring R;
+    dbprint(ppl,"// Testing order: " + string(k));
+    Rcd = Rnd;
+    Rnd = 0;
+    setring D;
+    Dcd = Dnd;
+    Dnd = 0;
+    dbprint(ppl-1,"// Current members of the annihilator: " + string(LD));
+    setring R;
+    c = size(Rcd);
+    p = pnew;
+    for (i=1; i<=c; i++)
+    {
+      for (j=1; j<=n; j++)
+      {
+        RJ = diffRat(Rcd[i],j);
+        setring D;
+        DJ = Dcd[i]*var(n+j);
+        tmp = Dnd,DJ;
+        if (size(Dnd) <> size(simplify(tmp,4))) // new element
+        {
+          Dnd[size(Dnd)+1] = DJ;
+          setring R;
+          Rnd[size(Rnd)+1] = RJ;
+          pnew = lcm(pnew,RJ[2]);
+        }
+        else // already have DJ in Dnd
+        {
+          setring R;
+        }
+      }
+    }
+    p = pnew/p;
+    for (i=1; i<=size(L); i++)
+    {
+      L[i] = p*L[i];
+    }
+    for (i=1; i<=size(Rnd); i++)
+    {
+      L[size(L)+1] = pnew/Rnd[i][2]*Rnd[i][1];
+    }
+    RS = syz(L);
+    setring D;
+    DD = DD,Dnd;
+    setring R;
+    if (RS <> 0)
+    {
+      setring D;
+      DS = imap(R,RS);
+      LD = ideal(transpose(DS)*transpose(DD));
+    }
+    else
+    {
+      setring D;
+    }
+    LD = engine(LD,eng);
+    // test if we're done
+    if (db<=0)
+    {
+      if (isHolonomic(LD)) { break; }
+    }
+    else
+    {
+      if (k==db) { break; }
+    }
+  }
+  export(LD);
+  setring R;
+  return(D);
+}
+example
+{
+  "EXAMPLE:"; echo = 2;
+  // printlevel = 3;
+  ring r = 0,(x,y),dp;
+  poly f = 2*x*y; poly g = x^2 - y^3;
+  def A = annRatSyz(f,g);   // compute a holonomic solution
+  setring A; A;
+  LD;
+  setring r;
+  def B = annRatSyz(f,g,5); // compute a solution up to degree 5
+  setring B;
+  LD; // this is the full annihilator as we will check below
+  setring r;
+  def C = annRat(f,g); setring C;
+  LD; // the full annihilator
+  ideal BLD = imap(B,LD);
+  NF(LD,std(BLD));
+}
+