Changeset 565e86 in git


Ignore:
Timestamp:
Dec 23, 2008, 10:39:31 PM (14 years ago)
Author:
Viktor Levandovskyy <levandov@…>
Branches:
(u'spielwiese', '91fdef05f09f54b8d58d92a472e9c4a43aa4656f')
Children:
199ae72040d35b09813089e33464df761b5aad78
Parents:
6045c31371ebacbf1acfc2f082225f05016f06b2
Message:
*levandov: numerous changes, docu fixes, exchange of procs between libs etc


git-svn-id: file:///usr/local/Singular/svn/trunk@11268 2c84dea3-7e68-4137-9b89-c4e89433aadc
Location:
Singular/LIB
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • Singular/LIB/bfct.lib

    r6045c3 r565e86  
    11//////////////////////////////////////////////////////////////////////////////
    2 version="$Id: bfct.lib,v 1.7 2008-12-09 16:50:21 levandov Exp $";
     2version="$Id: bfct.lib,v 1.8 2008-12-23 21:39:31 levandov Exp $";
    33category="Noncommutative";
    44info="
    5 LIBRARY: bfct.lib     M. Noro's Algorithm for Bernstein-Sato polynomial
     5LIBRARY: bfct.lib     Algorithms for b-functions and Bernstein-Sato polynomial
    66AUTHORS: Daniel Andres, daniel.andres@math.rwth-aachen.de
    77@* Viktor Levandovskyy,      levandov@math.rwth-aachen.de
    88
    99THEORY: Given a polynomial ring R = K[x_1,...,x_n] and a polynomial F in R,
    10 @*      one is interested in the global Bernstein-Sato polynomial b(s) in K[s],
    11 @*      defined to be the monic polynomial, satisfying a functional identity
    12 @*             L * f^{s+1} = b(s) f^s,   for some operator L in D[s].
    13 @* Here, D stands for an n-th Weyl algebra K<x_1,...,x_n,d_1,...,d_n | d_j x_j = x_j d_j +1>
    14 @* One is interested in the following data:
    15 @*   global Bernstein-Sato polynomial in K[s] and
    16 @*   the list of all roots of b(s), which are known to be rational, with their multiplicities.
     10@*      one is interested in the global b-Function (also known as Bernstein-Sato
     11@*      polynomial) b(s) in K[s], defined to be the monic polynomial, satisfying a functional
     12@*      identity L * F^{s+1} = b(s) F^s,   for some operator L in D[s]. Here, D stands for an
     13@*      n-th Weyl algebra K<x_1,...,x_n,d_1,...,d_n | d_j x_j = x_j d_j +1>.
     14@*      One is interested in the following data:
     15@*      - Bernstein-Sato polynomial b(s) in K[s],
     16@*      - the list of its roots, which are known to be rational
     17@*      - the multiplicities of the roots.
     18@*      References: Saito, Strurmfels, Takayama: Groebner Deformations of Hypergeometric
     19@*      Differential Equations (2000), Noro: An Efficient Modular Algorithm for Computing
     20@*      the Global b-function, (2002).
     21
    1722
    1823MAIN PROCEDURES:
    1924
    20 bfct(f[,s,t,v]);            compute the global Bernstein-Sato polynomial of a given poly
    21 bfctsyz(f[,r,s,t,u,v]);     compute the global Bernstein-Sato polynomial of a given poly
    22 bfctann(f[,s]);             compute the global Bernstein-Sato polynomial of a given poly
    23 bfctonestep(f[,s,t]);       compute the global Bernstein-Sato polynomial of a given poly
    24 bfctideal(I,w[,s,t]);       compute the global b-function of a given ideal w.r.t. a given weight
    25 pintersect(f,I);            compute the intersection of the ideal generated by a given poly with a given ideal
    26 pintersectsyz(f,I[,p,s,t]); compute the intersection of the ideal generated by a given poly with a given ideal
    27 linreduce(f,I[,s]);         reduce a poly by linear reductions only
    28 ncsolve(I[,s]);             find and compute a linear dependency of the elements of an ideal
     25bfct(f[,s,t,v]);            computes the Bernstein-Sato polynomial of poly f
     26bfctSyz(f[,r,s,t,u,v]);     computes the Bernstein-Sato polynomial of poly f
     27bfctAnn(f[,s]);             computes the Bernstein-Sato polynomial of poly f
     28bfctOneGB(f[,s,t]);         computes the Bernstein-Sato polynomial of poly f
     29bfctIdeal(I,w[,s,t]);       computes the global b-function of ideal I w.r.t. the weight w
     30pIntersect(f,I);            intersection of the ideal I with the subalgebra K[f] for a poly f
     31pIntersectSyz(f,I[,p,s,t]);  intersection of the ideal I with the subalgebra K[f] for a poly f
     32linReduce(f,I[,s]);         reduces a poly by linear reductions only
     33linSyzSolve(I[,s]);         computes a linear dependency of the elements of ideal I
    2934
    3035AUXILIARY PROCEDURES:
    3136
    32 ispositive(v);   check whether all entries of an intvec are positive
    33 isin(l,i);       check whether an element is a member of a list
    34 scalarprod(v,w); compute the standard scalar product of two intvecs
    35 vec2poly(v[,i]); convert a coefficient vector to a poly
     37allPositive(v);  checks whether all entries of an intvec are positive
     38scalarProd(v,w); computes the standard scalar product of two intvecs
     39vec2poly(v[,i]); constructs an univariate poly with given coefficients
    3640
    3741SEE ALSO: dmod_lib, dmodapp_lib, gmssing_lib
     
    4044
    4145LIB "qhmoduli.lib"; // for Max
    42 LIB "dmod.lib"; // for SannfsBFCT etc
    43 LIB "dmodapp.lib";  // for initialideal etc
    44 
    45 
     46LIB "dmod.lib";     // for SannfsBFCT etc
     47LIB "dmodapp.lib";  // for initialIdeal etc
     48
     49
     50///////////////////////////////////////////////////////////////////////////////
     51// testing for consistency of the library:
    4652proc testbfctlib ()
    4753{
    4854  // tests all procs for consistency
    4955  "AUXILIARY PROCEDURES:";
    50   example ispositive;
    51   example isin;
    52   example scalarprod;
     56  example allPositive;
     57  example scalarProd;
    5358  example vec2poly;
    5459  "MAIN PROCEDURES:";
    5560  example bfct;
    56   example bfctsyz;
    57   example bfctann;
    58   example bfctonestep;
    59   example bfctideal;
    60   example pintersect;
    61   example pintersectsyz;
    62   example linreduce;
    63   example ncsolve;
    64 }
    65 
     61  example bfctSyz;
     62  example bfctAnn;
     63  example bfctOneGB;
     64  example bfctIdeal;
     65  example pIntersect;
     66  example pIntersectSyz;
     67  example linReduce;
     68  example linReduceIdeal;
     69  example linSyzSolve;
     70}
    6671
    6772//--------------- auxiliary procedures ---------------------------------------------------------
     
    7176RETURN:  a ring, the associated graded ring of the basering w.r.t. u and v
    7277PURPOSE: compute the associated graded ring of the basering w.r.t. u and v
     78ASSUME: basering is a Weyl algebra
    7379EXAMPLE: example gradedWeyl; shows examples
    7480NOTE:    u[i] is the weight of x(i), v[i] the weight of D(i).
     
    122128{
    123129  "EXAMPLE:"; echo = 2;
    124   LIB "bfct.lib";
    125130  ring @D = 0,(x,y,z,Dx,Dy,Dz),dp;
    126131  def D = Weyl();
     
    132137
    133138
    134 proc ispositive (intvec v)
    135 "USAGE:  ispositive(v);  v an intvec
    136 RETURN:  1 if all components of v are positive, or 0 otherwise
     139proc allPositive (intvec v)
     140"USAGE:  allPositive(v);  v an intvec
     141RETURN:  int, 1 if all components of v are positive, or 0 otherwise
    137142PURPOSE: check whether all components of an intvec are positive
    138 EXAMPLE: example ispositive; shows an example
     143EXAMPLE: example allPositive; shows an example
    139144"
    140145{
     
    154159  "EXAMPLE:"; echo = 2;
    155160  intvec v = 1,2,3;
    156   ispositive(v);
     161  allPositive(v);
    157162  intvec w = 1,-2,3;
    158   ispositive(w);
    159 }
    160 
    161 proc isin (list l, i)
    162 "USAGE:  isin(l,i);  l a list, i an argument of any type
    163 RETURN:  an int, the position of the first appearance of i in l, or 0 if i is not a member of l
     163  allPositive(w);
     164}
     165
     166static proc findFirst (list l, i)
     167"USAGE:  findFirst(l,i);  l a list, i an argument of any type
     168RETURN:  int, the position of the first appearance of i in l, or 0 if i is not a member of l
    164169PURPOSE: check whether the second argument is a member of a list
    165 EXAMPLE: example isin; shows an example
     170EXAMPLE: example findFirst; shows an example
    166171"
    167172{
     
    177182  return(0);
    178183}
     184//   isin(list(1, 2, list(1)),2);       // seems to be a bit buggy,
     185//   isin(list(1, 2, list(1)),3);       // but works for the purposes
     186//   isin(list(1, 2, list(1)),list(1)); // of this library
     187//   isin(l,list(2));
    179188example
    180189{
     
    182191  ring r = 0,x,dp;
    183192  list l = 1,2,3;
    184   isin(l,4);
    185   isin(l,2);
    186 }
    187 
    188 proc scalarprod (intvec v, intvec w)
    189 "USAGE:  scalarprod(v,w);  v,w intvecs
    190 RETURN:  an int, the standard scalar product of v and w
    191 PURPOSE: compute the scalar product of two intvecs
    192 NOTE:    the arguments must have the same size
    193 EXAMPLE: example scalarprod; shows examples
     193  findFirst(l,4);
     194  findFirst(l,2);
     195}
     196
     197proc scalarProd (intvec v, intvec w)
     198"USAGE:  scalarProd(v,w);  v,w intvecs
     199RETURN:  int, the standard scalar product of v and w
     200PURPOSE: computes the scalar product of two intvecs
     201ASSUME:  the arguments are of the same size
     202EXAMPLE: example scalarProd; shows examples
    194203"
    195204{
     
    213222  intvec v = 1,2,3;
    214223  intvec w = 4,5,6;
    215   scalarprod(v,w);
    216 }
    217 
     224  scalarProd(v,w);
     225}
    218226
    219227//-------------- main procedures -------------------------------------------------------
    220228
    221 
    222 proc linreduce(poly f, ideal I, list #)
    223 "USAGE:  linreduce(f, I [,s,t]);  f a poly, I an ideal, s,t optional ints
    224 RETURN:  a poly obtained by linear reductions of the given poly with the given ideal
    225 PURPOSE: reduce a poly only by linear reductions
    226 NOTE:    If s<>0, a list consisting of the reduced poly and the coefficient vector of the used
    227 @*       reductions is returned.
    228 @*       If t<>0, only leading monomials are reduced, otherwise, and by default, all monomials
    229 @*       are reduced, if possible.
    230 EXAMPLE: example linreduce; shows examples
     229proc linReduceIdeal(ideal I, list #)
     230"USAGE:  linReduceIdeal(I [,s,t]); I an ideal, s,t optional ints
     231RETURN:  ideal/list, linear reductum (over field) of f by elements from I
     232PURPOSE: reduce a poly only by linear reductions (no monomial multiplications)
     233NOTE:    If s<>0, a list consisting of the reduced ideal and the coefficient
     234@*       vectors of the used reductions given as module is returned.
     235@*       Otherwise (and by default), only the reduced ideal is returned.
     236@*       If t=0 (and by default) all monomials are reduced (if possible),
     237@*       otherwise, only leading monomials are reduced.
     238DISPLAY: If @code{printlevel}>=1, all debug messages will be printed.
     239EXAMPLE: example linReduceIdeal; shows examples
    231240"
    232241{
     242  // #[1] = remembercoeffs
     243  // #[2] = redtail
    233244  int ppl = printlevel - voice + 2;
    234245  int remembercoeffs = 0; // default
    235   int redlm          = 0; // default
     246  int redtail        = 0; // default
    236247  if (size(#)>0)
    237248  {
     
    244255      if (typeof(#[2])=="int" || typeof(#[2])=="number")
    245256      {
    246         redlm = #[2];
     257        redtail = #[2];
     258      }
     259    }
     260  }
     261  int sI = ncols(I);
     262  int sZeros = sI - size(I);
     263  dbprint(ppl,"ideal contains "+string(sZeros)+" zero(s)");
     264  int i,j;
     265  ideal J,lmJ,ordJ;
     266  list lJ = sort(I);
     267  module M; // for the coefficients
     268  if (sZeros > 0) // I contains zeros
     269  {
     270    if (remembercoeffs <> 0)
     271    {
     272      j = 0;
     273      for (i=1; i<=sI; i++)
     274      {
     275        if (I[i] == 0)
     276        {
     277          j++;
     278          J[j] = 0;
     279          ordJ[j] = -1;
     280          M[j] = gen(i);
     281        }
     282        else
     283        {
     284          M[i+sZeros-j] = gen(lJ[2][i-j]+j);
     285        }
     286      }
     287    }
     288    else
     289    {
     290      for (i=1; i<=sZeros; i++)
     291      {
     292        J[i] = 0;
     293        ordJ[i] = -1;
     294      }
     295    }
     296    I = J,lJ[1];
     297  }
     298  else
     299  {
     300    I = lJ[1];
     301    if (remembercoeffs <> 0)
     302    {
     303      for (i=1; i<=size(lJ[1]); i++) { M[i+sZeros] = gen(lJ[2][i]); }
     304    }
     305  }
     306  dbprint(ppl,"initially sorted ideal:", I);
     307  if (remembercoeffs <> 0) { dbprint(ppl," used permutations:", M); }
     308  poly lm,c,redpoly,maxlmJ;
     309  J[sZeros+1] = I[sZeros+1];
     310  lm = I[sZeros+1];
     311  maxlmJ = leadmonom(lm);
     312  lmJ[sZeros+1] = maxlmJ;
     313  int ordlm,reduction,maxordJ;
     314  maxordJ = ord(lm);
     315  ordJ[sZeros+1] = maxordJ;
     316  vector v;
     317  for (i=sZeros+2; i<=sI; i++)
     318  {
     319    redpoly = I[i];
     320    lm = leadmonom(redpoly);
     321    ordlm = ord(lm);
     322    reduction = 1;
     323    if (remembercoeffs <> 0) { v = M[i]; }
     324    while (reduction == 1) // while there was a reduction
     325    {
     326      reduction = 0;
     327      for (j=sZeros+1; j<i; j++)
     328      {
     329        if (lm == 0) { break; }
     330        if (ordlm > maxordJ) { break; }
     331        if (ordlm == ordJ[j])
     332        {           
     333          if (lm > maxlmJ) { break; }
     334          if (lm == lmJ[j])
     335          {
     336            dbprint(ppl,"reducing " + string(redpoly));
     337            dbprint(ppl," with " + string(J[j]));
     338            c = leadcoef(redpoly)/leadcoef(J[j]);
     339            redpoly = redpoly - c*J[j];
     340            dbprint(ppl," to " + string(redpoly));
     341            lm = leadmonom(redpoly);
     342            ordlm = ord(lm);
     343            if (remembercoeffs <> 0) { M[i] = M[i] - c * M[j]; }
     344            reduction = 1;
     345          }
     346        }
     347      }
     348    }
     349    for (j=sZeros+1; j<i; j++)
     350    {
     351      if (redpoly < J[j]) { break; }
     352    }
     353    J = insertGenerator(J,redpoly,j);
     354    lmJ = insertGenerator(lmJ,lm,j);
     355    ordJ = insertGenerator(ordJ,poly(ordlm),j);
     356    if (remembercoeffs <> 0)
     357    {
     358      v = M[i];
     359      M = deleteGenerator(M,i);
     360      M = insertGenerator(M,v,j);
     361    }
     362    maxordJ = ord(J[i]);
     363    maxlmJ = lmJ[i];
     364  }
     365  if (redtail <> 0)
     366  {
     367    dbprint(ppl,"finished reducing leading monomials:",J);
     368    if (remembercoeffs <> 0) { dbprint(ppl,"used reductions:",M); }
     369    int k;
     370    for (i=sZeros+1; i<=sI; i++)
     371    {
     372      lm = lmJ[i];
     373      for (j=i+1; j<=sI; j++)
     374      {
     375        for (k=2; k<=size(J[j]); k++) // run over all terms in J[j]
     376        {
     377          if (ordJ[i] == ord(J[j][k]))
     378          {   
     379            if (lm == normalize(J[j][k]))
     380            {
     381              c = leadcoef(J[j][k])/leadcoef(J[i]);
     382              dbprint(ppl,"reducing " + string(J[j]));
     383              dbprint(ppl," with " + string(J[i]));
     384              J[j] = J[j] - c*J[i];
     385              dbprint(ppl," to " + string(J[j]));
     386              if (remembercoeffs <> 0) { M[j] = M[j] - c * M[i]; }
     387            }
     388          }
     389        }
     390      }
     391    }
     392  }
     393  if (remembercoeffs <> 0) { return(list(J,M)); }
     394  else { return(J); }
     395}
     396example
     397{
     398  "EXAMPLE:"; echo = 2;
     399  ring r = 0,(x,y),dp;
     400  ideal I = 3,x+9,y4,y4+7x+2;
     401  linReduceIdeal(I);
     402  linReduceIdeal(I,0,1);
     403  list l = linReduceIdeal(I,1,1); l;
     404  module M = I;
     405  l[1] - ideal(M*l[2]);
     406}
     407
     408proc linReduce(poly f, ideal I, list #)
     409"USAGE:  linReduce(f, I [,s,t]); f a poly, I an ideal, s,t optional ints
     410RETURN:  poly/list, linear reductum (over field) of f by elements from I
     411PURPOSE: reduce a poly only by linear reductions (no monomial multiplications)
     412NOTE:    If s<>0, a list consisting of the reduced poly and the coefficient
     413@*       vector of the used reductions is returned, otherwise (and by default)
     414@*       only reduced poly is returned.
     415@*       If t=0 (and by default) all monomials are reduced (if possible),
     416@*       otherwise, only leading monomials are reduced.
     417DISPLAY: If @code{printlevel}>=1, all debug messages will be printed.
     418EXAMPLE: example linReduce; shows examples
     419"
     420{
     421  int ppl = printlevel - voice + 2;
     422  int remembercoeffs = 0; // default
     423  int redtail        = 0; // default
     424  int prepareideal   = 1; // default
     425  if (size(#)>0)
     426  {
     427    if (typeof(#[1])=="int" || typeof(#[1])=="number")
     428    {
     429      remembercoeffs = #[1];
     430    }
     431    if (size(#)>1)
     432    {
     433      if (typeof(#[2])=="int" || typeof(#[2])=="number")
     434      {
     435        redtail = #[2];
     436      }
     437      if (size(#)>2)
     438      {
     439        if (typeof(#[3])=="int" || typeof(#[3])=="number")
     440        {
     441          prepareideal = #[3];
     442        }
    247443      }
    248444    }
     
    250446  int i,j,k;
    251447  int sI = ncols(I);
    252   ideal lmI,lcI;
     448  // pre-reduce I:
     449  module M;
     450  if (prepareideal <> 0)
     451  {
     452    if (remembercoeffs <> 0)
     453    {
     454      list sortedI = linReduceIdeal(I,1,redtail);
     455      I = sortedI[1];
     456      M = sortedI[2];
     457      dbprint(ppl,"prepared ideal:",I);
     458      dbprint(ppl," with operations:",M);
     459    }
     460    else
     461    {
     462      I = linReduceIdeal(I,0,redtail);
     463    }
     464  }
     465  else
     466  {
     467    if (remembercoeffs <> 0)
     468    {
     469      for (i=1; i<=sI; i++)
     470      {
     471        M[i] = gen(i);
     472      }
     473    }
     474  }
     475  ideal lmI,lcI,ordI;
    253476  for (i=1; i<=sI; i++)
    254477  {
    255478    lmI[i] = leadmonom(I[i]);
    256479    lcI[i] = leadcoef(I[i]);
     480    ordI[i] = ord(lmI[i]);
    257481  }
    258482  vector v;
    259483  poly c;
    260   int reduction = 1;
    261   if (redlm == 0)
    262   {
    263     ideal monomf;
    264     for (k=1; k<=size(f); k++)
    265     {
    266       monomf[k] = normalize(f[k]);
    267     }
    268     while (reduction == 1) // while there was a reduction
    269     {
    270       reduction = 0;
    271       for (i=sI; i>=1; i--)
    272       {
    273         dbprint(ppl,"testing ideal entry:",i);
    274         for (j=1; j<=size(f); j++)
     484  // === reduce leading monomials ===
     485  poly lm = leadmonom(f);
     486  int ordf = ord(lm);
     487  for (i=sI; i>=1; i--)  // I is sorted: smallest lm's on top
     488  {
     489    if (lm == 0)
     490    {
     491      break;
     492    }
     493    else
     494    {
     495      if (ordf == ordI[i])
     496      {
     497        if (lm == lmI[i])
    275498        {
    276           if (monomf[j] == lmI[i])
     499          c = leadcoef(f)/lcI[i];
     500          f = f - c*I[i];
     501          lm = leadmonom(f);
     502          ordf = ord(lm);
     503          if (remembercoeffs <> 0)
     504          {
     505            v = v - c * M[i];
     506          }
     507        }
     508      }
     509    }
     510  }
     511  // === reduce tails as well ===
     512  if (redtail <> 0)
     513  {
     514    dbprint(ppl,"poly after reduction of leading monomials:",f);
     515    for (i=1; i<=sI; i++)
     516    {
     517      dbprint(ppl,"testing ideal entry:",i);
     518      for (j=1; j<=size(f); j++)
     519      {
     520        if (ord(f[j]) == ordI[i])
     521        {
     522          if (normalize(f[j]) == lmI[i])
    277523          {
    278524            c = leadcoef(f[j])/lcI[i];
    279525            f = f - c*I[i];
    280526            dbprint(ppl,"reducing poly to ",f);
    281             monomf = 0;
    282             for (k=1; k<=size(f); k++)
    283             {
    284               monomf[k] = normalize(f[k]);
    285             }
    286             reduction = 1;
    287527            if (remembercoeffs <> 0)
    288528            {
    289               v = v - c * gen(i);
     529              v = v - c * M[i];
    290530            }
    291             break;
    292           }
    293         }
    294         if (reduction == 1)
    295         {
    296           break;
    297         }
    298       }
    299     }
    300   }
    301   else // reduce only leading monomials
    302   {
    303     poly lm = leadmonom(f);
    304     while (reduction == 1) // while there was a reduction
    305     {
    306       reduction = 0;
    307       for (i=sI;i>=1;i--)
    308       {
    309         if (lm <> 0 && lm == lmI[i])
    310         {
    311           c = leadcoef(f)/lcI[i];
    312           f = f - c*I[i];
    313           lm = leadmonom(f);
    314           reduction = 1;
    315           if (remembercoeffs <> 0)
    316           {
    317             v = v - c * gen(i);
    318531          }
    319532        }
     
    338551  poly f = 5xy+7y+3;
    339552  poly g = 7x+5y+3;
    340   linreduce(g,I);
    341   linreduce(g,I,0,1);
    342   linreduce(f,I,1);
    343 }
    344 
    345 proc ncsolve (ideal I, list #)
    346 "USAGE:  ncsolve(I[,s]);  I an ideal, s an optional int
    347 RETURN:  coefficient vector of a linear combination of 0 in the elements of I
    348 PURPOSE: compute a linear dependency between the elements of an ideal if such one exists
     553  linReduce(g,I);
     554  linReduce(g,I,0,1);
     555  linReduce(f,I,1);
     556  f = x3 + y2 + x2 + y + x;
     557  I = x3 - y3, y3 - x2, x3 - y2, x2 - y, y2-x;
     558  list l = linReduce(f, I, 1);
     559  l;
     560  module M = I;
     561  f - (l[1] - (M*l[2])[1,1]);
     562}
     563
     564proc linSyzSolve (ideal I, list #)
     565"USAGE:  linSyzSolve(I[,s]);  I an ideal, s an optional int
     566RETURN:  vector, coefficient vector of a linear combination of 0 in the elements of I
     567PURPOSE: compute a linear dependency between the elements of an ideal
     568@*       if such one exists
    349569NOTE:    If s<>0, @code{std} is used for Groebner basis computations,
    350570@*       otherwise, @code{slimgb} is used.
    351571@*       By default, @code{slimgb} is used in char 0 and @code{std} in char >0.
    352 @*      If printlevel=1, progress debug messages will be printed,
     572DISPLAY: If printlevel=1, progress debug messages will be printed,
    353573@*       if printlevel>=2, all the debug messages will be printed.
    354 EXAMPLE: example ncsolve; shows examples
     574EXAMPLE: example linSyzSolve; shows examples
    355575"
    356576{
     
    374594  else
    375595  {
    376     // 1. introduce undefined coeffs
     596    // ------- 1. introduce undefined coeffs ------------------
    377597    def save = basering;
    378598    int p = char(save);
     
    386606    ring @A = p,(@a(1..sI)),lp;
    387607    ring @aA = (p,@a(1..sI)), (@z),dp;
     608    // TODO: BUG! WHAT IF THE ORIGINAL RING ALREADY HAS SUCH VARIABLES/PARAMETERS!!!?
     609    // TODO: YOU CAN OVERCOME THIS BY MEANS SIMILAR TO "chooseSafeVarName" FROM NEW "matrix.lib"
    388610    def @B = save + @aA;
    389611    setring @B;
    390612    ideal I = imap(save,I);
    391     // 2. form the linear system for the undef coeffs
     613    // ------- 2. form the linear system for the undef coeffs ---
    392614    int i;   poly W;  ideal QQ;
    393615    for (i=1; i<=sI; i++)
     
    403625    setring @A;
    404626    ideal QQ = imap(@B,QQ);
    405     // 3. this QQ is a polynomial ideal, so "solve" the system
    406     dbprint(ppl, "ncsolve: starting Groebner basis computation with engine:", whichengine);
     627    // ------- 3. this QQ is a polynomial ideal, so "solve" the system -----
     628    dbprint(ppl, "linSyzSolve: starting Groebner basis computation with engine:", whichengine);
    407629    QQ = engine(QQ,whichengine);
    408630    dbprint(ppl, "QQ after engine:", QQ);
    409631    if (dim(QQ) == -1)
    410632    {
    411       dbprint(ppl+1, "no solutions by ncsolve");
     633      dbprint(ppl+1, "no solutions by linSyzSolve");
    412634      // output zeroes
    413635      setring save;
     
    415637      return(v);
    416638    }
    417     // 4. in order to get the numeric values
     639    // ------- 4. in order to get the numeric values -------
    418640    matrix AA = matrix(maxideal(1));
    419641    module MQQ = std(module(QQ));
     
    439661  ring r = 0,x,dp;
    440662  ideal I = x,2x;
    441   ncsolve(I);
     663  linSyzSolve(I);
    442664  ideal J = x,x2;
    443   ncsolve(J);
    444 }
    445 
    446 proc pintersect (poly s, ideal I)
    447 "USAGE:  pintersect(f, I);  f a poly, I an ideal
    448 RETURN:  coefficient vector of the monic generator of the intersection of the ideal generated by f with I
    449 PURPOSE: compute the intersection of an ideal with a principal ideal defined by f
     665  linSyzSolve(J);
     666}
     667
     668proc pIntersect (poly s, ideal I)
     669"USAGE:  pIntersect(f, I);  f a poly, I an ideal
     670RETURN:  vector, coefficient vector of the monic polynomial
     671PURPOSE: compute the intersection of ideal I with the subalgebra K[f]
     672ASSUME:  I is given as Groebner basis.
    450673NOTE:    If the intersection is zero, this proc might not terminate.
    451 @*       I should be given as standard basis.
    452 @*       If printlevel=1, progress debug messages will be printed,
     674DISPLAY: If printlevel=1, progress debug messages will be printed,
    453675@*       if printlevel>=2, all the debug messages will be printed.
    454 EXAMPLE: example pintersect; shows examples
     676EXAMPLE: example pIntersect; shows examples
    455677"
    456678{
    457679  // assume I is given in Groebner basis
    458   attrib(I,"isSB",1); // set attribute for suppressing NF messages
     680  if (attrib(I,"isSB") <> 1)
     681  {
     682    print("WARNING: The input has no SB attribute!");
     683    print(" Treating it as if it were a Groebner basis and proceeding...");
     684    attrib(I,"isSB",1); // set attribute for suppressing NF messages
     685  }
    459686  int ppl = printlevel-voice+2;
    460687  // ---case 1: I = basering---
    461688  if (size(I) == 1)
    462689  {
    463     if (simplify(I,1) == ideal(1))
     690    if (simplify(I,2)[1] == 1)
    464691    {
    465692      return(gen(2)); // = s
     
    512739  poly toNF,tobracket,newNF,rednewNF,oldNF,secNF;
    513740  i = 1;
    514   dbprint(ppl+1,"pintersect starts...");
     741  dbprint(ppl+1,"pIntersect starts...");
    515742  while (1)
    516743  {
     
    535762      secNF = newNF;
    536763    }
    537     ll = linreduce(newNF,redNI,1);
     764    ll = linReduce(newNF,redNI,1);
    538765    rednewNF = ll[1];
    539766    l[i+1] = ll[2];
     
    578805  v = imap(@R,v);
    579806  kill @R;
    580   dbprint(ppl+1,"pintersect finished");
     807  dbprint(ppl+1,"pIntersect finished");
    581808  return(v);
    582809}
     
    586813  ring r = 0,(x,y),dp;
    587814  poly f = x^2+y^3+x*y^2;
    588   def D = initialmalgrange(f);
     815  def D = initialMalgrange(f);
    589816  setring D;
    590817  inF;
    591   pintersect(t*Dt,inF);
    592 }
    593 
    594 proc pintersectsyz (poly s, ideal II, list #)
    595 "USAGE:  pintersectsyz(f, I [,p,s,t]);  f a poly, I an ideal, p, t optial ints, p a prime number
    596 RETURN:  coefficient vector of the monic generator of the intersection of the ideal generated by f with I
    597 PURPOSE: compute the intersection of an ideal with a principal ideal defined by f
    598 NOTE:    If the intersection is zero, this proc might not terminate.
    599 @*       I should be given as standard basis.
    600 @*       If p>0 is given, this proc computes the generator of the intersection in char p first and
    601 @*       then only searches for a generator of the obtained degree in the basering.
    602 @*       Otherwise, it searched for all degrees.
    603 @*       This is done by computing syzygies.
     818  pIntersect(t*Dt,inF);
     819}
     820
     821proc pIntersectSyz (poly s, ideal II, list #)
     822"USAGE:  pIntersectSyz(f, I [,p,s,t]);  f a poly, I an ideal, p, t optial ints, p a prime number
     823RETURN:  vector, coefficient vector of the monic polynomial
     824PURPOSE: compute the intersection of an ideal I with the subalgebra K[f]
     825ASSUME:  I is given as Groebner basis.
     826NOTE:    If the intersection is zero, this procedure might not terminate.
     827@*       If p>0 is given, this proc computes the generator of the intersection in char p first
     828@*       and then only searches for a generator of the obtained degree in the basering.
     829@*       Otherwise, it searched for all degrees by computing syzygies.
    604830@*       If s<>0, @code{std} is used for Groebner basis computations in char 0,
    605831@*       otherwise, and by default, @code{slimgb} is used.
    606832@*       If t<>0 and by default, @code{std} is used for Groebner basis computations in char >0,
    607833@*       otherwise, @code{slimgb} is used.
    608 @*      If printlevel=1, progress debug messages will be printed,
     834DISPLAY: If printlevel=1, progress debug messages will be printed,
    609835@*       if printlevel>=2, all the debug messages will be printed.
    610 EXAMPLE: example pintersectsyz; shows examples
     836EXAMPLE: example pIntersectSyz; shows examples
    611837"
    612838{
    613839  // assume I is given in Groebner basis
    614840  ideal I = II;
    615   attrib(I,"isSB",1); // set attribute for suppressing NF messages
     841  if (attrib(I,"isSB") <> 1)
     842  {
     843    print("WARNING: The input has no SB attribute!");
     844    print(" Treating it as if it were a Groebner basis and proceeding...");
     845    attrib(I,"isSB",1); // set attribute for suppressing NF messages
     846  }
    616847  int ppl = printlevel-voice+2;
    617848  int whichengine  = 0; // default
     
    668899  }
    669900  i = 1;
    670   dbprint(ppl+1,"pintersectsyz starts...");
     901  dbprint(ppl+1,"pIntersectSyz starts...");
    671902  dbprint(ppl+1,"with ideal I=", I);
    672903  while (1)
     
    688919    }
    689920    // look for a solution
    690     dbprint(ppl,"ncsolve starts with: "+string(matrix(NI)));
     921    dbprint(ppl,"linSyzSolve starts with: "+string(matrix(NI)));
    691922    if (solveincharp<>0) // modular method
    692923    {
    693924      setring Rp;
    694925      NI[i+1] = phi(newNF);
    695       v = ncsolve(NI,modengine);
     926      v = linSyzSolve(NI,modengine);
    696927      if (v!=0) // there is a modular solution
    697928      {
    698929        dbprint(ppl,"got solution in char ",solveincharp," of degree " ,i);
    699930        setring save;
    700         v = ncsolve(NI,whichengine);
     931        v = linSyzSolve(NI,whichengine);
    701932        if (v==0)
    702933        {
     
    712943    else // non-modular method
    713944    {
    714       v = ncsolve(NI,whichengine);
     945      v = linSyzSolve(NI,whichengine);
    715946    }
    716947    matrix MM[1][nrows(v)] = matrix(v);
    717     dbprint(ppl,"ncsolve ready  with: "+string(MM));
     948    dbprint(ppl,"linSyzSolve ready  with: "+string(MM));
    718949    kill MM;
    719     //  "ncsolve ready with"; print(v);
     950    //  "linSyzSolve ready with"; print(v);
    720951    if (v!=0)
    721952    {
     
    729960      if (p!=0)
    730961      {
    731         dbprint(ppl,"ncsolve: bad solution!");
     962        dbprint(ppl,"linSyzSolve: bad solution!");
    732963      }
    733964      else
    734965      {
    735         dbprint(ppl,"ncsolve: got solution!");
     966        dbprint(ppl,"linSyzSolve: got solution!");
    736967        // "got solution!";
    737968        break;
     
    741972    i++;
    742973  }
    743   dbprint(ppl+1,"pintersectsyz finished");
     974  dbprint(ppl+1,"pIntersectSyz finished");
    744975  return(v);
    745976}
     
    749980  ring r = 0,(x,y),dp;
    750981  poly f = x^2+y^3+x*y^2;
    751   def D = initialmalgrange(f);
     982  def D = initialMalgrange(f);
    752983  setring D;
    753984  inF;
    754985  poly s = t*Dt;
    755   pintersectsyz(s,inF);
     986  pIntersectSyz(s,inF);
    756987  int p = prime(20000);
    757   pintersectsyz(s,inF,p,0,0);
     988  pIntersectSyz(s,inF,p,0,0);
    758989}
    759990
    760991proc vec2poly (list #)
    761992"USAGE:  vec2poly(v [,i]);  v a vector or an intvec, i an optional int
    762 RETURN:  a poly with coefficient vector v
    763 PURPOSE: convert a coefficient vector to a poly
    764 NOTE:    If i>0 is given, the returned poly is an element of K[var(i)],
    765 @*       otherwise, and by default, @code{i=1} is used.
    766 @*       The first entry of v is the coefficient of 1.
     993RETURN:  poly, an univariate poly in i-th variable with coefficients given by v
     994PURPOSE: constructs an univariate poly in K[var(i)] with given coefficients,
     995@*       such that the coefficient at var(i)^{j-1} is v[j].
     996NOTE:    The optional argument i must be positive, by default i is 1.
    767997EXAMPLE: example vec2poly; shows examples
    768998"
     
    8581088}
    8591089
    860 static proc bfctengine (poly f, int inorann, int whichengine, int methodord, int methodpintersect, int pintersectchar, int modengine, intvec u0)
     1090static proc bfctengine (poly f, int inorann, int whichengine, int methodord, int methodpIntersect, int pIntersectchar, int modengine, intvec u0)
    8611091{
    8621092  int ppl = printlevel - voice +2;
     
    8661096  if (inorann == 0) // bfct using initial ideal
    8671097  {
    868     def D = initialmalgrange(f,whichengine,methodord,1,u0);
     1098    def D = initialMalgrange(f,whichengine,methodord,1,u0);
    8691099    setring D;
    8701100    ideal J = inF;
     
    8811111  vector b;
    8821112  // try it modular
    883   if (methodpintersect <> 0) // pintersectsyz
    884   {
    885     if (pintersectchar == 0) // pintersectsyz::modular
     1113  if (methodpIntersect <> 0) // pIntersectSyz
     1114  {
     1115    if (pIntersectchar == 0) // pIntersectSyz::modular
    8861116    {
    8871117      int lb = 30000;
     
    8931123        dbprint(ppl,"number of run in the loop: "+string(i));
    8941124        int q = prime(random(lb,ub));
    895         if (isin(usedprimes,q)==0) // if q was not already used
     1125        if (findFirst(usedprimes,q)==0) // if q was not already used
    8961126        {
    8971127          usedprimes = usedprimes,q;
    8981128          dbprint(ppl,"used prime is: "+string(q));
    899           b = pintersectsyz(s,J,q,whichengine,modengine);
     1129          b = pIntersectSyz(s,J,q,whichengine,modengine);
    9001130        }
    9011131        i++;
    9021132      }
    9031133    }
    904     else // pintersectsyz::non-modular
    905     {
    906       b = pintersectsyz(s,J,0,whichengine);
    907     }
    908   }
    909   else // pintersect: linreduce
    910   {
    911     b = pintersect(s,J);
     1134    else // pIntersectSyz::non-modular
     1135    {
     1136      b = pIntersectSyz(s,J,0,whichengine);
     1137    }
     1138  }
     1139  else // pIntersect: linReduce
     1140  {
     1141    b = pIntersect(s,J);
    9121142  }
    9131143  setring save;
     
    9261156proc bfct (poly f, list #)
    9271157"USAGE:  bfct(f [,s,t,v]);  f a poly, s,t optional ints, v an optional intvec
    928 RETURN:  list of roots of the Bernstein-Sato polynomial bs(f) and their multiplicies
    929 PURPOSE: compute the global Bernstein-Sato polynomial for a hypersurface, defined by f, according to the algorithm by Masayuki Noro
    930 NOTE:    In this proc, the initial Malgrange ideal is computed.
    931 @*       Further, a system of linear equations is solved by linear reductions.
    932 @*       If s<>0, @code{std} is used for Groebner basis computations,
     1158RETURN:  list of ideal and intvec
     1159PURPOSE: computes the roots of the Bernstein-Sato polynomial b(s)
     1160@*       for the hypersurface defined by f.
     1161ASSUME:  The basering is a commutative polynomial ring in char 0.
     1162BACKGROUND: In this proc, the initial Malgrange ideal is computed according to the algorithm
     1163@*       by Masayuki Noro and then a system of linear equations is solved by linear reductions.
     1164NOTE:    In the output list, the ideal contains all the roots
     1165@*       and the intvec their multiplicities.
     1166@*       If s<>0, @code{std} is used for GB computations,
    9331167@*       otherwise, and by default, @code{slimgb} is used.
    9341168@*       If t<>0, a matrix ordering is used for Groebner basis computations,
    9351169@*       otherwise, and by default, a block ordering is used.
    936 @*       If v is a positive weight vector, v is used for homogenization computations,
     1170@*       If v is a positive weight vector, v is used for homogenization computations, 
    9371171@*       otherwise and by default, no weights are used.
    938 @*      If printlevel=1, progress debug messages will be printed,
     1172DISPLAY: If printlevel=1, progress debug messages will be printed,
    9391173@*       if printlevel>=2, all the debug messages will be printed.
    9401174EXAMPLE: example bfct; shows examples
     
    9651199      if (size(#)>2)
    9661200      {
    967         if (typeof(#[3])=="intvec" && size(#[3])==n && ispositive(#[3])==1)
     1201        if (typeof(#[3])=="intvec" && size(#[3])==n && allPositive(#[3])==1)
    9681202        {
    9691203          u0 = #[3];
     
    9851219}
    9861220
    987 proc bfctsyz (poly f, list #)
    988 "USAGE:  bfctsyz(f [,r,s,t,u,v]);  f a poly, r,s,t,u optional ints, v an optional intvec
    989 RETURN:  list of roots of the Bernstein-Sato polynomial bs(f) and its multiplicies
    990 PURPOSE: compute the global Bernstein-Sato polynomial for a hypersurface, defined by f, according to the algorithm by Masayuki Noro
    991 NOTE:    In this proc, the initial Malgrange ideal is computed.
    992 @*       Further, a system of linear equations is solved by computing syzygies.
    993 @*       If r<>0, @code{std} is used for Groebner basis computations in characteristic 0,
     1221proc bfctSyz (poly f, list #)
     1222"USAGE:  bfctSyz(f [,r,s,t,u,v]);  f a poly, r,s,t,u optional ints, v an optional intvec
     1223RETURN:  list of ideal and intvec
     1224PURPOSE: computes the roots of the Bernstein-Sato polynomial b(s)
     1225@*       for the hypersurface defined by f
     1226ASSUME:  The basering is a commutative polynomial ring in char 0.
     1227BACKGROUND: In this proc, the initial Malgrange ideal is computed according to the algorithm
     1228@*       by Masayuki Noro and then a system of linear equations is solved by computing syzygies.
     1229NOTE:    In the output list, the ideal contains all the roots
     1230@*       and the intvec their multiplicities.
     1231@*       If r<>0, @code{std} is used for GB computations in characteristic 0,
    9941232@*       otherwise, and by default, @code{slimgb} is used.
    995 @*       If s<>0, a matrix ordering is used for Groebner basis computations,
    996 @*       otherwise, and by default, a block ordering is used.
    997 @*       If t<>0, the computation of the intersection is solely performed over charasteristic 0,
    998 @*       otherwise and by default, a modular method is used.
    999 @*       If u<>0 and by default, @code{std} is used for Groebner basis computations in characteristic >0,
    1000 @*       otherwise, @code{slimgb} is used.
    1001 @*       If v is a positive weight vector, v is used for homogenization computations,
    1002 @*       otherwise and by default, no weights are used.
    1003 @*      If printlevel=1, progress debug messages will be printed,
     1233@*       If s<>0, a matrix ordering is used for GB computations, otherwise,
     1234@*       and by default, a block ordering is used.
     1235@*       If t<>0, the computation of the intersection is solely performed over
     1236@*       charasteristic 0, otherwise and by default, a modular method is used.
     1237@*       If u<>0 and by default, @code{std} is used for GB computations in
     1238@*       characteristic >0, otherwise, @code{slimgb} is used.
     1239@*       If v is a positive weight vector, v is used for homogenization
     1240@*       computations, otherwise and by default, no weights are used.
     1241DISPLAY: If printlevel=1, progress debug messages will be printed,
    10041242@*       if printlevel>=2, all the debug messages will be printed.
    10051243EXAMPLE: example bfct; shows examples
     
    10181256  int whichengine = 0; // default
    10191257  int methodord   = 0; // default
    1020   int pintersectchar  = 0; // default
     1258  int pIntersectchar  = 0; // default
    10211259  int modengine   = 1; // default
    10221260  intvec u0       = 0; // default
     
    10371275        if (typeof(#[3])=="int" || typeof(#[3])=="number")
    10381276        {
    1039           pintersectchar = int(#[3]);
     1277          pIntersectchar = int(#[3]);
    10401278        }
    10411279        if (size(#)>3)
     
    10471285          if (size(#)>4)
    10481286          {
    1049             if (typeof(#[5])=="intvec" && size(#[5])==n && ispositive(#[5])==1)
     1287            if (typeof(#[5])=="intvec" && size(#[5])==n && allPositive(#[5])==1)
    10501288            {
    10511289              u0 = #[5];
     
    10561294    }
    10571295  }
    1058   list b = bfctengine(f,0,whichengine,methodord,1,pintersectchar,modengine,u0);
     1296  list b = bfctengine(f,0,whichengine,methodord,1,pIntersectchar,modengine,u0);
    10591297  return(b);
    10601298}
     
    10641302  ring r = 0,(x,y),dp;
    10651303  poly f = x^2+y^3+x*y^2;
    1066   bfctsyz(f);
     1304  bfctSyz(f);
    10671305  intvec v = 3,2;
    1068   bfctsyz(f,0,1,1,0,v);
    1069 }
    1070 
    1071 proc bfctideal (ideal I, intvec w, list #)
    1072 "USAGE:  bfctideal(I,w[,s,t]);  I an ideal, w an intvec, s,t optional ints
    1073 RETURN:  list of roots and their multiplicies of the global b-function of I w.r.t. the weight vector (-w,w)
    1074 PURPOSE: compute the global b-function of an ideal according to the algorithm by M. Noro
    1075 NOTE:    Assume, I is an ideal in the n-th Weyl algebra where the sequence of the
    1076 @*       variables is x(1),...,x(n),D(1),...,D(n).
    1077 @*       If s<>0, @code{std} is used for Groebner basis computations in characteristic 0,
     1306  bfctSyz(f,0,1,1,0,v);
     1307}
     1308
     1309proc bfctIdeal (ideal I, intvec w, list #)
     1310"USAGE:  bfctIdeal(I,w[,s,t]);  I an ideal, w an intvec, s,t optional ints
     1311RETURN:  list of ideal and intvec
     1312PURPOSE: computes the roots of the global b-function of I wrt the weight vector (-w,w).
     1313ASSUME:  The basering is the n-th Weyl algebra in char 0, where the sequence of
     1314@*       the variables is x(1),...,x(n),D(1),...,D(n).
     1315BACKGROUND:  In this proc, the initial ideal of I is computed according to the algorithm by
     1316@*       Masayuki Noro and then a system of linear equations is solved by linear reductions.
     1317NOTE:    In the output list, the ideal contains all the roots
     1318@*       and the intvec their multiplicities.
     1319@*       If s<>0, @code{std} is used for GB computations in characteristic 0,
    10781320@*       otherwise, and by default, @code{slimgb} is used.
    1079 @*       If t<>0, a matrix ordering is used for Groebner basis computations,
    1080 @*       otherwise, and by default, a block ordering is used.
    1081 @*      If printlevel=1, progress debug messages will be printed,
     1321@*       If t<>0, a matrix ordering is used for GB computations, otherwise,
     1322@*       and by default, a block ordering is used.
     1323DISPLAY: If printlevel=1, progress debug messages will be printed,
    10821324@*       if printlevel>=2, all the debug messages will be printed.
    10831325EXAMPLE: example bfctideal; shows examples
     
    11041346    }
    11051347  }
    1106   ideal J = initialideal(I,-w,w,whichengine,methodord);
     1348  ideal J = initialIdeal(I,-w,w,whichengine,methodord);
    11071349  poly s;
    11081350  for (i=1; i<=n; i++)
     
    11101352    s = s + w[i]*var(i)*var(n+i);
    11111353  }
    1112   vector b = pintersect(s,J);
     1354  vector b = pIntersect(s,J);
    11131355  list l = listofroots(b,0);
    11141356  return(l);
     
    11201362  def D = Weyl();
    11211363  setring D;
    1122   ideal I = 3*x^2*Dy+2*y*Dx,2*x*Dx+3*y*Dy+6;
     1364  ideal I = std(3*x^2*Dy+2*y*Dx,2*x*Dx+3*y*Dy+6); I;
    11231365  intvec w1 = 1,1;
    11241366  intvec w2 = 1,2;
    11251367  intvec w3 = 2,3;
    1126   bfctideal(I,w1);
    1127   bfctideal(I,w2,1);
    1128   bfctideal(I,w3,0,1);
    1129 }
    1130 
    1131 
    1132 proc bfctonestep (poly f,list #)
    1133 "USAGE:  bfctonestep(f [,s,t]);  f a poly, s,t optional ints
    1134 RETURN:  list of roots of the Bernstein-Sato polynomial bs(f) and its multiplicies
    1135 PURPOSE: compute the global Bernstein-Sato polynomial for a hypersurface, defined by f, using only one Groebner basis computation
    1136 NOTE:    If s<>0, @code{std} is used for the Groebner basis computation, otherwise,
     1368  bfctIdeal(I,w1);
     1369  bfctIdeal(I,w2,1);
     1370  bfctIdeal(I,w3,0,1);
     1371}
     1372
     1373proc bfctOneGB (poly f,list #)
     1374"USAGE:  bfctOneGB(f [,s,t]);  f a poly, s,t optional ints
     1375RETURN:  list of ideal and intvec
     1376PURPOSE: computes the roots of the Bernstein-Sato polynomial b(s) for the
     1377@*       hypersurface defined by f, using only one GB computation
     1378ASSUME:  The basering is a commutative polynomial ring in char 0.
     1379BACKGROUND: In this proc, the initial Malgrange ideal is computed based on the
     1380@*       algorithm by Masayuki Noro and combined with an elimination ordering.
     1381NOTE:    In the output list, the ideal contains all the roots
     1382@*       and the intvec their multiplicities.
     1383@*       If s<>0, @code{std} is used for the GB computation, otherwise,
    11371384@*       and by default, @code{slimgb} is used.
    1138 @*       If t<>0, a matrix ordering is used for Groebner basis computations,
     1385@*       If t<>0, a matrix ordering is used for GB computations,
    11391386@*       otherwise, and by default, a block ordering is used.
    1140 @*      If printlevel=1, progress debug messages will be printed,
     1387DISPLAY: If printlevel=1, progress debug messages will be printed,
    11411388@*       if printlevel>=2, all the debug messages will be printed.
    1142 EXAMPLE: example bfctonestep; shows examples
     1389EXAMPLE: example bfctOneGB; shows examples
    11431390"
    11441391{
     
    11461393  def save = basering;
    11471394  int n = nvars(save);
     1395  int noofvars = 2*n+4;
    11481396  int i;
    11491397  int whichengine = 0; // default
     
    11631411    }
    11641412  }
    1165   def DDh = initialidealengine("bfctonestep", whichengine, methodord, f);
     1413  intvec uv;
     1414  uv[n+3] = 1;
     1415  ring r = 0,(x(1..n)),dp;
     1416  poly f = fetch(save,f);
     1417  uv[1] = -1; uv[noofvars] = 0;
     1418  //  for the ordering
     1419  intvec @a; @a = 1:noofvars; @a[2] = 2;
     1420  intvec @a2 = @a; @a2[2] = 0; @a2[2*n+4] = 0;
     1421  if (methodord == 0) // default: block ordering
     1422  {
     1423    ring Dh = 0,(t,s,x(n..1),Dt,D(n..1),h),(a(@a),a(@a2),a(uv),dp(noofvars-1),lp(1));
     1424  }
     1425  else // M() ordering
     1426  {
     1427    intmat @Ord[noofvars][noofvars];
     1428    @Ord[1,1..noofvars] = uv;
     1429    @Ord[2,1..noofvars] = 1:(noofvars-1);
     1430    for (i=1; i<=noofvars-2; i++)
     1431    {
     1432      @Ord[2+i,noofvars - i] = -1;
     1433    }
     1434    dbprint(ppl,"weights for ordering:",transpose(@a));
     1435    dbprint(ppl,"the ordering matrix:",@Ord);
     1436    ring Dh = 0,(t,s,x(n..1),Dt,D(n..1),h),(a(@a),a(@a2),M(@Ord));
     1437  }
     1438  dbprint(ppl,"the ring Dh:",Dh);
     1439  // non-commutative relations
     1440  matrix @relD[noofvars][noofvars];
     1441  @relD[1,2] = t*h^2;// s*t = t*s+t*h^2
     1442  @relD[2,n+3] = Dt*h^2;// Dt*s = s*Dt+h^2
     1443  @relD[1,n+3] = h^2;
     1444  for (i=1; i<=n; i++)
     1445  {
     1446    @relD[i+2,n+3+i] = h^2;
     1447  }
     1448  dbprint(ppl,"nc relations:",@relD);
     1449  def DDh = nc_algebra(1,@relD);
    11661450  setring DDh;
    1167   dbprint(ppl, "the initial ideal:", string(matrix(inF)));
     1451  dbprint(ppl,"computing in ring",DDh);
     1452  ideal I;
     1453  poly f = imap(r,f);
     1454  kill r;
     1455  f = homog(f,h);
     1456  I = t - f, t*Dt - s;  // defining the Malgrange ideal
     1457  for (i=1; i<=n; i++)
     1458  {
     1459    I = I, D(i)+diff(f,x(i))*Dt;
     1460  }
     1461  dbprint(ppl, "starting Groebner basis computation with engine:", whichengine);
     1462  I = engine(I, whichengine);
     1463  dbprint(ppl, "finished Groebner basis computation");
     1464  dbprint(ppl, "I before dehomogenization is" ,I);
     1465  I = subst(I,h,1); // dehomogenization
     1466  dbprint(ppl, "I after dehomogenization is" ,I);
     1467  I = inForm(I,uv); // we are only interested in the initial form w.r.t. uv
     1468  dbprint(ppl, "the initial ideal:", string(matrix(I)));
    11681469  intvec tonselect = 1;
    1169   for (i=3; i<=2*n+4; i++)
    1170   {
    1171     tonselect = tonselect,i;
    1172   }
    1173   inF = nselect(inF,tonselect);
    1174   dbprint(ppl, "generators containing only s:", string(matrix(inF)));
    1175   inF = engine(inF, whichengine); // is now a principal ideal;
     1470  for (i=3; i<=2*n+4; i++) { tonselect = tonselect,i; }
     1471  I = nselect(I,tonselect);
     1472  dbprint(ppl, "generators containing only s:", string(matrix(I)));
     1473  I = engine(I, whichengine); // is now a principal ideal;
    11761474  setring save;
    11771475  ideal J; J[2] = var(1);
    11781476  map @m = DDh,J;
    1179   ideal inF = @m(inF);
    1180   poly p = inF[1];
     1477  ideal I = @m(I);
     1478  poly p = I[1];
    11811479  list l = listofroots(p,1);
    11821480  return(l);
     
    11871485  ring r = 0,(x,y),dp;
    11881486  poly f = x^2+y^3+x*y^2;
    1189   bfctonestep(f);
    1190   bfctonestep(f,1,1);
    1191 }
    1192 
    1193 proc bfctann (poly f, list #)
    1194 "USAGE:  bfctann(f [,r]);  f a poly, r an optional int
    1195 RETURN:  list of roots of the Bernstein-Sato polynomial bs(f) and their multiplicies
    1196 PURPOSE: compute the global Bernstein-Sato polynomial for a hypersurface, defined by f
    1197 NOTE:    In this proc, ann(f^s) is computed.
    1198 @*       If r<>0, @code{std} is used for Groebner basis computations,
     1487  bfctOneGB(f);
     1488  bfctOneGB(f,1,1);
     1489}
     1490
     1491proc bfctAnn (poly f, list #)
     1492"USAGE:  bfctAnn(f [,r]);  f a poly, r an optional int
     1493RETURN:  list of ideal and intvec
     1494PURPOSE: computes the roots of the Bernstein-Sato polynomial b(s)
     1495@*       for the hypersurface defined by f
     1496ASSUME:  The basering is a commutative polynomial ring in char 0.
     1497BACKGROUND: In this proc, ann(f^s) is computed and then a system of linear
     1498@*       equations is solved by linear reductions.
     1499NOTE:    In the output list, the ideal contains all the roots
     1500@*       and the intvec their multiplicities.
     1501@*       If r<>0, @code{std} is used for GB computations,
    11991502@*       otherwise, and by default, @code{slimgb} is used.
    1200 @*      If printlevel=1, progress debug messages will be printed,
     1503DISPLAY: If printlevel=1, progress debug messages will be printed,
    12011504@*       if printlevel>=2, all the debug messages will be printed.
    12021505EXAMPLE: example bfctann; shows examples
     
    12211524  ring r = 0,(x,y),dp;
    12221525  poly f = x^2+y^3+x*y^2;
    1223   bfctann(f);
    1224 }
    1225 
    1226 static proc hardexamples ()
     1526  bfctAnn(f);
     1527}
     1528
     1529/*
     1530//static proc hardexamples ()
    12271531{
    12281532  //  some hard examples
     
    12461550  bfct(xyzreiffen45);
    12471551}
    1248 
     1552*/
  • Singular/LIB/dmod.lib

    r6045c3 r565e86  
    11//////////////////////////////////////////////////////////////////////////////
    2 version="$Id: dmod.lib,v 1.32 2008-12-09 16:50:21 levandov Exp $";
     2version="$Id: dmod.lib,v 1.33 2008-12-23 21:39:31 levandov Exp $";
    33category="Noncommutative";
    44info="
     
    2727@* OT) the classical Ann F^s algorithm from Oaku and Takayama (J. Pure
    2828        Applied Math., 1999),
    29 @* LOT) Levandovskyy's modification of the Oaku-Takayama algorithm (unpublished)
     29@* LOT) Levandovskyy's modification of the Oaku-Takayama algorithm (ISSAC 2007)
    3030@* BM) the Ann F^s algorithm by Briancon and Maisonobe (Remarques sur
    3131        l'ideal de Bernstein associe a des polynomes, preprint, 2002)
    3232
    3333GUIDE:
    34 @* - Ann F^s = I = I(F^s) = LD in D(R)[s] can be computed by SannfsBM SannfsOT, SannfsLOT
     34@* - Ann F^s = I = I(F^s) = LD in D(R)[s] can be computed by SannfsBM, SannfsOT, SannfsLOT
    3535@* - Ann^(1) F^s in D(R)[s] can be computed by Sannfslog
    3636@* - global Bernstein polynomial bs resp. BS in K[s] can be computed by bernsteinBM
    37 @* - Ann F^s0 = I(F^s0) = LD0 in D(R) can be computed by annfs0, annfsBM, annfsOT, annfsLOT
     37@* - Ann F^s0 = I(F^s0) = LD0 in D(R) can be computed by annfs0, annfsBM, annfsOT, annfsLOT, annfs2
    3838@* - all the relevant data (LD, LD0, bs, PS) are computed by operatorBM
    3939
     
    4949annfsBMI(F[,eng]);      compute Ann F^s and Bernstein ideal for a poly F=f1*..*fP (multivariate algorithm of Briancon-Maisonobe)
    5050checkRoot(F,a[,S,eng]); check if a given rational is a root of the global Bernstein polynomial of F and compute its multiplicity
    51 
    52 SECONDARY PROCEDURES FOR D-MODULES:
    53 
    5451annfsBM(F[,eng]);          compute Ann F^s0 in D and Bernstein poly for a poly F (algorithm of Briancon-Maisonobe)
    5552annfsLOT(F[,eng]);         compute Ann F^s0 in D and Bernstein poly for a poly F (Levandovskyy modification of the Oaku-Takayama algorithm)
    5653annfsOT(F[,eng]);          compute Ann F^s0 in D and Bernstein poly for a poly F (algorithm of Oaku-Takayama)
    5754SannfsBM(F[,eng]);         compute Ann F^s in D[s] for a poly F (algorithm of Briancon-Maisonobe)
    58 SannfsBFCT(F[,eng]);      compute Ann F^s in D[s] for a poly F (algorithm of Briancon-Maisonobe)
     55SannfsBFCT(F[,eng]);      compute Ann F^s in D[s] for a poly F (algorithm of Briancon-Maisonobe, other output ordering)
    5956SannfsLOT(F[,eng]);        compute Ann F^s in D[s] for a poly F (Levandovskyy modification of the Oaku-Takayama algorithm)
    6057SannfsOT(F[,eng]);         compute Ann F^s in D[s] for a poly F (algorithm of Oaku-Takayama)
    61 annfs0(I,F [,eng]);           compute Ann F^s0 in D and Bernstein poly from the known Ann F^s in D[s]
     58annfs0(I,F [,eng]);          compute Ann F^s0 in D and Bernstein poly from the known Ann F^s in D[s]
     59annfs2(I,F [,eng]);           compute Ann F^s0 in D and Bernstein poly from the known Ann F^s in D[s] by using a trick of Noro
     60annfsRB(I,F [,eng]);          compute Ann F^s0 in D and Bernstein poly from the known Ann F^s in D[s] by reduceB strategy of Macaulay
    6261checkRoot1(I,F,a[,eng]);   check whether a rational is a root of the global Bernstein polynomial of F from the known Ann F^s in D[s]
    6362checkRoot2(I,F,a[,eng]);   check whether a rational is a root of the global Bernstein polynomial of F and compute its multiplicity from the known Ann F^s in D[s]
    64 checkFactor(I,F,qs[,eng]); check whether a polynomial qs in K[s] is a factor of the global Bernstein polynomial of F from the known Ann F^s in D[s]
     63checkFactor(I,F,q[,eng]); check whether a polynomial q in K[s] is a factor of the global Bernstein polynomial of F from the known Ann F^s in D[s]
    6564
    6665AUXILIARY PROCEDURES:
     
    7271minIntRoot(P,fact); minimal integer root among the roots of a maximal ideal P
    7372varnum(s);          the number of the variable with the name s
     73
    7474
    7575SEE ALSO: gmssing_lib, bfct_lib, dmodapp_lib
     
    9292  "MAIN PROCEDURES:";
    9393  example annfs;
    94   example annfs0;
    9594  example Sannfs;
    9695  example Sannfslog;
     
    101100  example annfsBMI;
    102101  example checkRoot;
     102  example annfs0;
     103  example annfs2;
     104  example annfsRB;
     105  example annfs2;
    103106  "SECONDARY D-MOD PROCEDURES:";
    104107  example annfsBM;
     
    108111  example SannfsLOT;
    109112  example SannfsOT;
     113  example SannfsBFCT;
    110114  example checkRoot1;
    111115  example checkRoot2;
     
    130134@*       - the ideal LD (which is a Groebner basis) is the needed D-module structure,
    131135@*       - the list  BS is the list of roots and multiplicities of a Bernstein polynomial of f.
    132 @*      If @code{printlevel}=1, progress debug messages will be printed,
    133 @*       if @code{printlevel}>=2, all the debug messages will be printed.
     136DISPLAY: If @code{printlevel}=1, progress debug messages will be printed,
     137@*          if @code{printlevel}>=2, all the debug messages will be printed.
    134138EXAMPLE: example annfs; shows examples
    135139"
     
    252256@*       In the output ring:
    253257@*       - the ideal LD is the needed D-module structure.
    254 @*      If @code{printlevel}=1, progress debug messages will be printed,
    255 @*       if @code{printlevel}>=2, all the debug messages will be printed.
     258DISPLAY: If @code{printlevel}=1, progress debug messages will be printed,
     259@*          if @code{printlevel}>=2, all the debug messages will be printed.
    256260EXAMPLE: example Sannfs; shows examples
    257261"
     
    365369@*       If eng <>0, @code{std} is used for Groebner basis computations,
    366370@*       otherwise, and by default @code{slimgb} is used.
    367 @*       If printlevel=1, progress debug messages will be printed,
    368 @*       if printlevel>=2, all the debug messages will be printed.
     371DISPLAY: If @code{printlevel}=1, progress debug messages will be printed,
     372@*          if @code{printlevel}>=2, all the debug messages will be printed.
    369373EXAMPLE: example Sannfslog; shows examples
    370374"
     
    506510// alternative code for SannfsBM, renamed from annfsBM to ALTannfsBM
    507511// is superfluos - will not be included in the official documentation
    508 proc ALTannfsBM (poly F, list #)
     512static proc ALTannfsBM (poly F, list #)
    509513"USAGE:  ALTannfsBM(f [,eng]);  f a poly, eng an optional int
    510514RETURN:  ring
     
    514518@*       If eng <>0, @code{std} is used for Groebner basis computations,
    515519@*       otherwise, and by default @code{slimgb} is used.
    516 @*       If printlevel=1, progress debug messages will be printed,
    517 @*       if printlevel>=2, all the debug messages will be printed.
     520DISPLAY: If @code{printlevel}=1, progress debug messages will be printed,
     521@*          if @code{printlevel}>=2, all the debug messages will be printed.
    518522EXAMPLE: example ALTannfsBM; shows examples
    519523"
     
    703707NOTE:    If eng <>0, @code{std} is used for Groebner basis computations,
    704708@*       otherwise, and by default @code{slimgb} is used.
    705 @*       If printlevel=1, progress debug messages will be printed,
    706 @*       if printlevel>=2, all the debug messages will be printed.
     709DISPLAY: If @code{printlevel}=1, progress debug messages will be printed,
     710@*          if @code{printlevel}>=2, all the debug messages will be printed.
    707711EXAMPLE: example bernsteinBM; shows examples
    708712"
     
    933937@*       If eng <>0, @code{std} is used for Groebner basis computations,
    934938@*       otherwise, and by default @code{slimgb} is used.
    935 @*       If printlevel=1, progress debug messages will be printed,
    936 @*       if printlevel>=2, all the debug messages will be printed.
     939DISPLAY: If @code{printlevel}=1, progress debug messages will be printed,
     940@*          if @code{printlevel}>=2, all the debug messages will be printed.
    937941EXAMPLE: example annfsBM; shows examples
    938942"
     
    12171221
    12181222
    1219 // try to replace s with -s-1 => data is shorter
     1223// replacing s with -s-1 => data is shorter
    12201224// analogue of annfs0
    12211225proc annfs2(ideal I, poly F, list #)
     
    12231227RETURN:  ring
    12241228PURPOSE: compute the annihilator ideal of f^s in the Weyl Algebra, based on the
    1225 output of procedures SannfsBM, SannfsOT or SannfsLOT
     1229output of Sannfs-like procedure
    12261230NOTE:    activate this ring with the @code{setring} command. In this ring,
    12271231@*       - the ideal LD (which is a Groebner basis) is the annihilator of f^s,
     
    12291233@*       If eng <>0, @code{std} is used for Groebner basis computations,
    12301234@*       otherwise and by default @code{slimgb} is used.
    1231 @*       Uses the shorter form of expressions in the variable s (the idea of Noro).
    1232 @*       If printlevel=1, progress debug messages will be printed,
    1233 @*       if printlevel>=2, all the debug messages will be printed.
     1235@*       annfs2 uses the shorter form of expressions in the variable s (the idea of Noro).
     1236DISPLAY: If @code{printlevel}=1, progress debug messages will be printed,
     1237@*       if @code{printlevel}>=2, all the debug messages will be printed.
    12341238EXAMPLE: example annfs2; shows examples
    12351239"
     
    13901394@*       If eng <>0, @code{std} is used for Groebner basis computations,
    13911395@*       otherwise and by default @code{slimgb} is used.
    1392 @*       Uses the shorter form of expressions in the variable s (the idea of Noro).
    1393 @*       If printlevel=1, progress debug messages will be printed,
    1394 @*       if printlevel>=2, all the debug messages will be printed.
     1396@*       This procedure follows the 'reduceB' strategy, used in Macaulay2.
     1397DISPLAY: If @code{printlevel}=1, progress debug messages will be printed,
     1398@*       if @code{printlevel}>=2, all the debug messages will be printed.
    13951399EXAMPLE: example annfsRB; shows examples
    13961400"
     
    15611565  poly F = x^3+y^3+z^3;
    15621566  printlevel = 0;
    1563   def A = SannfsBM(F);
    1564   setring A;
    1565   LD;
     1567  def A = SannfsBM(F); setring A;
     1568  LD; // s-parametric ahhinilator
    15661569  poly F = imap(r,F);
    1567   def B  = annfsRB(LD,F);
    1568   setring B;
     1570  def B  = annfsRB(LD,F); setring B;
    15691571  LD;
    15701572  BS;
     
    15841586@*       If eng <>0, @code{std} is used for Groebner basis computations,
    15851587@*       otherwise and by default @code{slimgb} is used.
    1586 @*       If printlevel=1, progress debug messages will be printed,
    1587 @*       if printlevel>=2, all the debug messages will be printed.
     1588DISPLAY: If @code{printlevel}=1, progress debug messages will be printed,
     1589@*       if @code{printlevel}>=2, all the debug messages will be printed.
    15881590EXAMPLE: example operatorBM; shows examples
    15891591"
     
    18891891// for this, do special modulo with emphasis on the 2comp
    18901892// of the transp matrix, there must appear 1 in the GB
     1893// then use lift to get the expression...
    18911894// need: (c,<) ordering for such comp's
    18921895
    1893 // proc operatorModulo(poly F, ideal I, poly b)
    1894 // "USAGE:  operatorModulo(f,I,b);  f a poly, I an ideal, b a poly
    1895 // RETURN:  poly
    1896 // PURPOSE: compute the B-operator from the poly F, ideal I = Ann f^s and Bernstein-Sato
    1897 // polynomial b using modulo
    1898 // NOTE:  The computations take place in the ring, similar to the one returned by Sannfs procedure.
    1899 // @*       If printlevel=1, progress debug messages will be printed,
    1900 // @*       if printlevel>=2, all the debug messages will be printed.
    1901 // EXAMPLE: example operatorModulo; shows examples
    1902 // "
    1903 // {
    1904 //   // with hom_kernel;
    1905 //   matrix AA[1][2] = F,-b;
    1906 //   //  matrix M = matrix(subst(I,s,s+1)*freemodule(2)); // ann f^{s+1}
    1907 //   matrix N = matrix(I); // ann f^s
    1908 //   //  matrix K = hom_kernel(AA,M,N);
    1909 //   matrix K = modulo(AA,N);
    1910 //   K = transpose(K);
    1911 //   print(K);
    1912 //   ideal J;
    1913 //   int i;
    1914 //   poly t; number n;
    1915 //   for(i=1; i<=nrows(K); i++)
    1916 //   {
    1917 //     if (K[i,2]!=0)
    1918 //     {
    1919 //       if ( leadmonom(K[i,2]) == 1)
    1920 //       {
    1921 //      t = K[i,1];
    1922 //      n = leadcoef(K[i,2]);
    1923 //      t = t/n;
    1924 //      //        J = J, K[i][2];
    1925 //      break;
    1926 //       }
    1927 //     }
    1928 //   }
    1929 //   ideal J = groebner(subst(I,s,s+1)); // for NF
    1930 //   t = NF(t,J);
    1931 //   "candidate:"; t;
    1932 //   J = subst(J,s,s-1);
    1933 //   // test:
    1934 //   if ( NF(t*F-b,J) !=0)
    1935 //   {
    1936 //     "Problem: PS does not work on F";
    1937 //   }
    1938 //   return(t);
    1939 // }
    1940 // example
    1941 // {
    1942 //   "EXAMPLE:"; echo = 2;
    1943 //   //  ring r = 0,(x,y,z),Dp;
    1944 //   //   poly F = x^3+y^3+z^3;
    1945 //   LIB "dmod.lib"; option(prot); option(mem);
    1946 //   ring r = 0,(x,y),Dp;
    1947 //   //  poly F = x^3+y^3+x*y^2;
    1948 //   poly F = x^4 + y^4 + x*y^4;
    1949 //   def A = Sannfs(F); // here we get LD = ann f^s
    1950 //   setring A;
    1951 //   poly F = imap(r,F);
    1952 //   def B = annfs0(LD,F); // to obtain BS polynomial
    1953 //   list BS = imap(B,BS);
    1954 //   poly b = fl2poly(BS,"s");
    1955 //   LD = groebner(LD);
    1956 //   poly PS = operatorModulo(F,LD,b);
    1957 //   PS; // the operator, s.t. PS*F^{s+1} = bs*F^s mod LD
    1958 //   reduce(PS*F-bs,LD); // check the property of PS
    1959 // }
    1960 
    1961 proc fl2poly(list L, string s)
    1962 "USAGE:  fl2poly(L,s); L a list, s a string
     1896/*
     1897proc operatorModulo(poly F, ideal I, poly b)
     1898"USAGE:  operatorModulo(f,I,b);  f a poly, I an ideal, b a poly
    19631899RETURN:  poly
    1964 PURPOSE: reconstruct a monic polynomial in one variable from its factorization
    1965 ASSUME:  s is a string with the name of some variable and L is supposed to consist of two entries:
    1966 @*         L[1] of the type ideal with the roots of a polynomial
    1967 @*         L[2] of the type intvec with the multiplicities of corr. roots
    1968 EXAMPLE: example fl2poly; shows examples
     1900PURPOSE: compute the B-operator from the poly F, ideal I = Ann f^s and Bernstein-Sato
     1901polynomial b using modulo
     1902NOTE:  The computations take place in the ring, similar to the one returned by Sannfs procedure.
     1903@*       If printlevel=1, progress debug messages will be printed,
     1904@*       if printlevel>=2, all the debug messages will be printed.
     1905EXAMPLE: example operatorModulo; shows examples
    19691906"
    19701907{
    1971   if (varnum(s)==0)
    1972   {
    1973     ERROR("no such variable found"); return(0);
    1974   }
    1975   poly x = var(varnum(s));
    1976   poly P = 1;
    1977   int sl = size(L[1]);
    1978   ideal RR = L[1];
    1979   intvec IV = L[2];
    1980   for(int i=1; i<= sl; i++)
    1981   {
    1982     P = P*((x-RR[i])^IV[i]);
    1983   }
    1984   return(P);
     1908  // with hom_kernel;
     1909  matrix AA[1][2] = F,-b;
     1910  //  matrix M = matrix(subst(I,s,s+1)*freemodule(2)); // ann f^{s+1}
     1911  matrix N = matrix(I); // ann f^s
     1912  //  matrix K = hom_kernel(AA,M,N);
     1913  matrix K = modulo(AA,N);
     1914  K = transpose(K);
     1915  print(K);
     1916  ideal J;
     1917  int i;
     1918  poly t; number n;
     1919  for(i=1; i<=nrows(K); i++)
     1920  {
     1921    if (K[i,2]!=0)
     1922    {
     1923      if ( leadmonom(K[i,2]) == 1)
     1924      {
     1925        t = K[i,1];
     1926        n = leadcoef(K[i,2]);
     1927        t = t/n;
     1928        //        J = J, K[i][2];
     1929        break;
     1930      }
     1931    }
     1932  }
     1933  ideal J = groebner(subst(I,s,s+1)); // for NF
     1934  t = NF(t,J);
     1935  "candidate:"; t;
     1936  J = subst(J,s,s-1);
     1937  // test:
     1938  if ( NF(t*F-b,J) !=0)
     1939  {
     1940    "Problem: PS does not work on F";
     1941  }
     1942  return(t);
    19851943}
    19861944example
    19871945{
    19881946  "EXAMPLE:"; echo = 2;
    1989   ring r = 0,(x,y,z,s),Dp;
    1990   ideal I = -1,-4/3,-5/3,-2;
    1991   intvec mI = 2,1,1,1;
    1992   list BS = I,mI;
    1993   poly p = fl2poly(BS,"s");
    1994   p;
    1995   factorize(p,2);
    1996 }
     1947  //  ring r = 0,(x,y,z),Dp;
     1948  //   poly F = x^3+y^3+z^3;
     1949  LIB "dmod.lib"; option(prot); option(mem);
     1950  ring r = 0,(x,y),Dp;
     1951  //  poly F = x^3+y^3+x*y^2;
     1952  poly F = x^4 + y^4 + x*y^4;
     1953  def A = Sannfs(F); // here we get LD = ann f^s
     1954  setring A;
     1955  poly F = imap(r,F);
     1956  def B = annfs0(LD,F); // to obtain BS polynomial
     1957  list BS = imap(B,BS);
     1958  poly b = fl2poly(BS,"s");
     1959  LD = groebner(LD);
     1960  poly PS = operatorModulo(F,LD,b);
     1961  PS; // the operator, s.t. PS*F^{s+1} = bs*F^s mod LD
     1962  reduce(PS*F-bs,LD); // check the property of PS
     1963}
     1964*/
     1965
     1966
    19971967
    19981968proc annfsParamBM (poly F, list #)
     
    20051975@*       If eng <>0, @code{std} is used for Groebner basis computations,
    20061976@*       otherwise, and by default @code{slimgb} is used.
    2007 @*       If printlevel=1, progress debug messages will be printed,
    2008 @*       if printlevel>=2, all the debug messages will be printed.
     1977DISPLAY: If @code{printlevel}=1, progress debug messages will be printed,
     1978@*          if @code{printlevel}>=2, all the debug messages will be printed.
    20091979EXAMPLE: example annfsParamBM; shows examples
    20101980"
     
    34453415@*       If eng <>0, @code{std} is used for Groebner basis computations,
    34463416@*       otherwise, and by default @code{slimgb} is used.
    3447 @*      If printlevel=1, progress debug messages will be printed,
     3417DISPLAY: If printlevel=1, progress debug messages will be printed,
    34483418@*       if printlevel>=2, all the debug messages will be printed.
    34493419EXAMPLE: example SannfsBFCT; shows examples
     
    36373607  poly F = x^3+y^3+z^3*w;
    36383608  printlevel = 0;
    3639   def A = SannfsBFCT(F);
    3640   setring A;
     3609  def A = SannfsBFCT(F); setring A;
    36413610  intvec v = 1,2,3,4,5,6,7,8;
    36423611  // are there polynomials, depending on s only?
    36433612  nselect(LD,v);
    36443613  // a fancier example:
    3645   def R = reiffen(4,5);
    3646   setring R;
     3614  def R = reiffen(4,5); setring R;
    36473615  v = 1,2,3,4;
     3616  RC; // the Reiffen curve in 4,5
    36483617  def B = SannfsBFCT(RC);
    36493618  setring B;
     
    38853854}
    38863855
    3887 
     3856/*
    38883857proc SannfsLOTold(poly F, list #)
    38893858"USAGE:  SannfsLOT(f [,eng]);  f a poly, eng an optional int
     
    41094078}
    41104079
     4080*/
    41114081
    41124082proc annfsLOT(poly F, list #)
     
    41584128RETURN:  ring
    41594129PURPOSE: compute the annihilator ideal of f^s in the Weyl Algebra, based on the
    4160 output of procedures SannfsBM, SannfsOT or SannfsLOT
     4130output of Sannfs-like procedure
    41614131NOTE:    activate this ring with the @code{setring} command. In this ring,
    41624132@*       - the ideal LD (which is a Groebner basis) is the annihilator of f^s,
     
    42994269  poly F = x^3+y^3+z^3;
    43004270  printlevel = 0;
    4301   def A = SannfsBM(F);
     4271  def A = SannfsBM(F);   setring A;
    43024272  // alternatively, one can use SannfsOT or SannfsLOT
    4303   setring A;
    43044273  LD;
    43054274  poly F = imap(r,F);
    4306   def B  = annfs0(LD,F);
    4307   setring B;
     4275  def B  = annfs0(LD,F);  setring B;
    43084276  LD;
    43094277  BS;
     
    46564624@*       We compute the real annihilator for any rational value of n (both generic and exceptional).
    46574625@*       The implementation goes along the lines of Saito-Sturmfels-Takayama, Alg. 5.3.15
    4658 @*      If printlevel=1, progress debug messages will be printed,
     4626DISPLAY: If printlevel=1, progress debug messages will be printed,
    46594627@*       if printlevel>=2, all the debug messages will be printed.
    46604628EXAMPLE: example annfspecial; shows examples
     
    47244692}
    47254693
    4726 static proc new_ex_annfspecial()
     4694/*
     4695//static proc new_ex_annfspecial()
    47274696{
    47284697  //another example for annfspecial: x3+y3+z3
     
    47404709  annfspecial(LD,F,-1,1);   // exceptional root
    47414710}
     4711*/
    47424712
    47434713proc minIntRoot(ideal P, int fact)
     
    48174787"USAGE:  isHolonomic(M); M an ideal/module/matrix
    48184788RETURN:  int, 1 if M is holonomic and 0 otherwise
     4789ASSUME: basering is a Weyl algebra
    48194790PURPOSE: check the modules for the property of holonomy
    48204791NOTE:    M is holonomic, if 2*dim(M) = dim(R), where R is a
     
    49564927@*       'alg1' (default) - for the algorithm 1 of J. Martin-Morales (unpublished)
    49574928@*       'alg2' - for the algorithm 2 of J. Martin-Morales (unpublished)
    4958 @*       The output int is:
    4959 @*       - if the algorithm 1 is chosen: 1 if -alpha is a root of the global Bernstein polynomial and 0 otherwise
    4960 @*       - if the algorithm 2 is chosen: the multiplicity of -alpha as a root of the global Bernstein polynomial of f.
    4961 @*                                       (If -alpha is not a root, the output is 0)
     4929@*       The output of type int is:
     4930@*       'alg1': 1 if -alpha is a root of the global Bernstein polynomial and 0 otherwise
     4931@*       'alg2': the multiplicity of -alpha as a root of the global Bernstein polynomial of f.
     4932@*                (If -alpha is not a root, the output is 0)
    49624933@*       If eng <>0, @code{std} is used for Groebner basis computations,
    49634934@*       otherwise (and by default) @code{slimgb} is used.
    4964 @*      If printlevel=1, progress debug messages will be printed,
    4965 @*       if printlevel>=2, all the debug messages will be printed.
     4935DISPLAY: If printlevel=1, progress debug messages will be printed,
     4936@*          if printlevel>=2, all the debug messages will be printed.
    49664937EXAMPLE: example checkRoot; shows examples
    49674938"
     
    50685039NOTE:    If eng <>0, @code{std} is used for Groebner basis computations,
    50695040@*       otherwise (and by default) @code{slimgb} is used.
    5070 @*      If printlevel=1, progress debug messages will be printed,
    5071 @*       if printlevel>=2, all the debug messages will be printed.
     5041DISPLAY: If printlevel=1, progress debug messages will be printed,
     5042@*          if printlevel>=2, all the debug messages will be printed.
    50725043EXAMPLE: example checkRoot1; shows examples
    50735044"
     
    51925163NOTE:    If eng <>0, @code{std} is used for Groebner basis computations,
    51935164@*       otherwise (and by default) @code{slimgb} is used.
    5194 @*      If printlevel=1, progress debug messages will be printed,
    5195 @*       if printlevel>=2, all the debug messages will be printed.
     5165DISPLAY: If printlevel=1, progress debug messages will be printed,
     5166@*          if printlevel>=2, all the debug messages will be printed.
    51965167EXAMPLE: example checkRoot2; shows examples
    51975168"
     
    53245295NOTE:    If eng <>0, @code{std} is used for Groebner basis computations,
    53255296@*       otherwise (and by default) @code{slimgb} is used.
    5326 @*      If printlevel=1, progress debug messages will be printed,
    5327 @*       if printlevel>=2, all the debug messages will be printed.
     5297DISPLAY: If printlevel=1, progress debug messages will be printed,
     5298@*          if printlevel>=2, all the debug messages will be printed.
    53285299EXAMPLE: example checkFactor; shows examples
    53295300"
     
    54615432}
    54625433
    5463 
    5464 static proc exCheckGenericity()
     5434/// ****** EXAMPLES ************
     5435
     5436/*
     5437
     5438//static proc exCheckGenericity()
    54655439{
    54665440  LIB "control.lib";
     
    54845458}
    54855459
    5486 static proc exOT_17()
     5460//static proc exOT_17()
    54875461{
    54885462  // Oaku-Takayama, p.208
     
    54995473}
    55005474
    5501 static proc exOT_16()
     5475//static proc exOT_16()
    55025476{
    55035477  // Oaku-Takayama, p.208
     
    55135487}
    55145488
    5515 static proc ex_bcheck()
     5489//static proc ex_bcheck()
    55165490{
    55175491  ring R = 0,(x,y),dp;
     
    55265500}
    55275501
    5528 static proc ex_bcheck2()
     5502//static proc ex_bcheck2()
    55295503{
    55305504  ring R = 0,(x,y),dp;
     
    55365510}
    55375511
    5538 static proc ex_BMI()
     5512//static proc ex_BMI()
    55395513{
    55405514  // a hard example
     
    55495523}
    55505524
    5551 static proc ex2_BMI()
     5525//static proc ex2_BMI()
    55525526{
    55535527  // this example was believed to be intractable in 2005 by Gago-Vargas, Castro and Ucha
     
    55635537}
    55645538
    5565 static proc ex_operatorBM()
     5539//static proc ex_operatorBM()
    55665540{
    55675541  ring r = 0,(x,y,z,w),Dp;
     
    55785552  reduce(PS*F-bs,LD); // check the property of PS
    55795553}
     5554
     5555*/
  • Singular/LIB/dmodapp.lib

    r6045c3 r565e86  
    11//////////////////////////////////////////////////////////////////////////////
    2 version="$Id: dmodapp.lib,v 1.12 2008-12-09 17:52:35 levandov Exp $";
     2version="$Id: dmodapp.lib,v 1.13 2008-12-23 21:39:31 levandov Exp $";
    33category="Noncommutative";
    44info="
    55LIBRARY: dmodapp.lib     Applications of algebraic D-modules
    6 AUTHORS: Viktor Levandovskyy,     levandov@math.rwth-aachen.de
     6AUTHORS: Viktor Levandovskyy,      levandov@math.rwth-aachen.de
    77@*             Daniel Andres, daniel.andres@math.rwth-aachen.de
    88
     
    1818rational function G/F from Quot(R). These can be computed via annPoly resp. annRat.
    1919
    20 @* - initial form and initial ideals in Weyl algebras with respect to a given weight vector can be computed with the help of inForm, initialmalgrange, initialideal.
     20@* - initial form and initial ideals in Weyl algebras with respect to a given weight vector can be computed with the help of inForm, initialMalgrange, initialIdeal.
    2121
    2222@* - appelF1, appelF2 and appelF4 return ideals in parametric Weyl algebra, which
     
    3232DLoc0(I, F);  presentation of the localization of D/I w.r.t. f^s, based on the procedure SDLoc
    3333
    34 initialmalgrange(f[,s,t,u,v]); Groebner basis of the initial Malgrange ideal for a given poly
    35 initialideal(I,u,v[,s,t]); initial ideal of a given ideal w.r.t. given weights
     34initialMalgrange(f[,s,t,u,v]); Groebner basis of the initial Malgrange ideal for a given poly
     35initialIdeal(I,u,v[,s,t]); initial ideal of a given ideal w.r.t. given weights
    3636inForm(f,w);     initial form of a poly/ideal w.r.t. a given weight
    3737isFsat(I, F);       check whether the ideal I is F-saturated
     
    4444engine(I,i);     computes a Groebner basis with the algorithm given by i
    4545poly2list(f);   decompose a poly to a list of terms and exponents
     46fl2poly(L,s);  reconstruct a monic univariate polynomial from its factorization
     47insertGenerator(id,p[,k]); insert an element into an ideal/module
     48deleteGenerator(id,k); delete the k-th element from an ideal/module
     49
    4650
    4751SEE ALSO: dmod_lib, gmssing_lib, bfct_lib
     
    5862// charInfo(); ???
    5963
     64
     65///////////////////////////////////////////////////////////////////////////////
     66// testing for consistency of the library:
    6067proc testdmodapp()
    6168{
    62   example initialideal;
    63   example initialmalgrange;
     69  example initialIdeal;
     70  example initialMalgrange;
    6471  example DLoc;
    6572  example DLoc0;
     
    7380  example appelF4;
    7481  example poly2list;
    75 }
    76 
    77 
    78 proc initialideal (ideal I, intvec u, intvec v, list #)
    79 "USAGE:  initialideal(I,u,v [,s,t]);  I an ideal, u,v intvecs, s,t optional ints
    80 RETURN:  an ideal, a Broebner basis of the initial ideal of the input ideal w.r.t. the weights u and v
    81 PURPOSE: compute the initial ideal
    82 NOTE:    Assume, I is an ideal in the n-th Weyl algebra where the sequence of the
    83 @*       indeterminates is x(1),...,x(n),D(1),...,D(n).
    84 @*       Further assume that u is the weight for the x(i) and v the weight for the D(i).
     82  example fl2poly;
     83  example insertGenerator;
     84  example deleteGenerator;
     85}
     86
     87
     88proc initialIdeal (ideal I, intvec u, intvec v, list #)
     89"USAGE:  initialIdeal(I,u,v [,s,t]);  I ideal, u,v intvecs, s,t optional ints
     90RETURN:  ideal, GB of initial ideal of the input ideal wrt the weights u and v
     91PURPOSE: computes the initial ideal
     92NOTE:    Assume, I is an ideal in the n-th Weyl algebra D, where the sequence
     93@*       of the indeterminates is x(1),...,x(n),D(1),...,D(n).
     94@*       Further assume that u is the weight for the x(i) and v the weight for
     95@*       the D(i).
    8596@*       Note that the returned ideal is not a D-ideal but an ideal in the associated
    8697@*       graded ring while the Groebner basis is a subset of D.
     
    89100@*       If t<>0, a matrix ordering is used for Groebner basis computations,
    90101@*       otherwise, and by default, a block ordering is used.
    91 @*      If printlevel=1, progress debug messages will be printed,
     102DISPLAY: If printlevel=1, progress debug messages will be printed,
    92103@*       if printlevel>=2, all the debug messages will be printed.
    93 EXAMPLE: example initialideal; shows examples
     104EXAMPLE: example initialIdeal; shows examples
    94105"
    95106{
     
    113124    }
    114125  }
    115   def D = initialidealengine("initialideal", whichengine, methodord, I, u, v);
    116   ideal inF = fetch(D,inF);
     126  def D = initialIdealEngine("initialIdeal", whichengine, methodord, I, u, v);
     127  ideal inF = fetch(D,inF); attrib(inF,"isSB",1);
    117128  return(inF);
    118129}
     
    125136  intvec u = -1; intvec v = 2;
    126137  ideal I = x^2*Dx^2,x*Dx^4;
    127   ideal J = initialideal(I,u,v); J;
    128 }
    129 
    130 proc initialmalgrange (poly f,list #)
    131 "USAGE:  initialmalgrange(f, [,s,t,u,v]);  f a poly, s,t,u optional ints, v an optional intvec
    132 RETURN:  a ring, the Weyl algebra induced by the basering, extended in the indeterminates t and Dt
    133 PURPOSE: compute the initial Malgrange ideal of a given poly w.r.t. the weight vector
    134 @*       (-1,0...,0,1,0,...,0) such that the weight of t is -1 and the weight of Dt is 1.
     138  ideal J = initialIdeal(I,u,v); J;
     139}
     140
     141proc initialMalgrange (poly f,list #)
     142"USAGE:  initialMalgrange(f, [,s,t,u,v]);  f poly, s,t,u optional ints, v optional intvec
     143RETURN:  ring, the Weyl algebra induced by basering, extended with vars t and Dt,
     144@*       containing the ideal \"inF\", being the initial ideal of the Malgrange
     145@*       ideal of f.
     146PURPOSE: computes the initial Malgrange ideal of a given poly wrt the weight
     147@*       vector (-1,0...,0,1,0,...,0) such that the weight of t is -1 and the
     148@*       weight of Dt is 1.
    135149NOTE:    Activate the output ring with the @code{setring} command.
    136150@*       Varnames of the basering should not include t and Dt.
    137 @*       In the ouput ring, inF is the initial Malgrange ideal.
    138 @*       If s<>0, @code{std} is used for Groebner basis computations, otherwise,
    139 @*        and by default, @code{slimgb} is used.
     151@*       If s<>0, @code{std} is used for Groebner basis computations,
     152@*       otherwise, and by default, @code{slimgb} is used.
    140153@*       If t<>0, a matrix ordering is used for Groebner basis computations,
    141154@*       otherwise, and by default, a block ordering is used.
    142155@*       If u<>0, the order of the variables is reversed.
    143 @*       If v is a positive weight vector, v is used for homogenization computations,
    144 @*       otherwise and by default, no weights are used.
    145 @*      If printlevel=1, progress debug messages will be printed,
     156@*       If v is a positive weight vector, v is used for homogenization
     157@*       computations, otherwise and by default, no weights are used.
     158DISPLAY: If printlevel=1, progress debug messages will be printed,
    146159@*       if printlevel>=2, all the debug messages will be printed.
    147 EXAMPLE: example initialmalgrange; shows examples
     160EXAMPLE: example initialMalgrange; shows examples
    148161"
    149162{
     
    175188        if (size(#)>3)
    176189        {
    177           if (typeof(#[4])=="intvec" && size(#[4])==n && ispositive(#[4])==1)
     190          if (typeof(#[4])=="intvec" && size(#[4])==n && allPositive(#[4])==1)
    178191          {
    179192            u0 = #[4];
     
    187200    u0 = 1:n;
    188201  }
    189   def D = initialidealengine("initialmalgrange",whichengine, methodord, f, 0, 0, u0, reversevars);
    190   setring D;
     202  def D = initialIdealEngine("initialMalgrange",whichengine, methodord, f, 0, 0, u0, reversevars);
     203  setring save;
    191204  return(D);
    192205}
     
    196209  ring r = 0,(x,y),dp;
    197210  poly f = x^2+y^3+x*y^2;
    198   def D = initialmalgrange(f);
     211  def D = initialMalgrange(f);
    199212  setring D;
    200213  inF;
    201214  setring r;
    202215  intvec v = 3,2;
    203   def D2 = initialmalgrange(f,1,0,1,v);
     216  def D2 = initialMalgrange(f,1,0,1,v);
    204217  setring D2;
    205218  inF;
    206219}
    207220
    208 proc initialidealengine(string calledfrom, int whichengine, int blockord, list #)
     221static proc initialIdealEngine(string calledfrom, int whichengine, int blockord, list #)
    209222{
    210223  //#[1] = f or I
     
    218231  n = nvars(save);
    219232  intvec uv;
    220   if (calledfrom == "initialideal")
     233  if (calledfrom == "initialIdeal")
    221234  {
    222235    ideal I = #[1];
     
    227240    noofvars = 2*n+1;
    228241  }
    229   else
     242  else // initialMalgrange
    230243  {
    231244    poly f = #[1];
    232     if (calledfrom == "initialmalgrange")
    233     {
    234       uv[n+2] = 1;
    235       noofvars = 2*n+3;
    236       intvec u0 = #[4];
    237       int reversevars = #[5];
    238       ring r = 0,(x(1..n)),wp(u0);
    239     }
    240     else // bfctonestep
    241     {
    242       uv[n+3] = 1;
    243       noofvars = 2*n+4;
    244       ring r = 0,(x(1..n)),dp;
    245     }
     245    uv[n+2] = 1;
     246    noofvars = 2*n+3;
     247    intvec u0 = #[4];
     248    int reversevars = #[5];
     249    ring r = 0,(x(1..n)),wp(u0);
    246250    poly f = fetch(save,f);
    247251    uv[1] = -1; uv[noofvars] = 0;
     
    249253  //  for the ordering
    250254  intvec @a;
    251   if (calledfrom == "initialmalgrange")
     255  if (calledfrom == "initialMalgrange")
    252256  {
    253257    int d = deg(f);
     
    264268    @a = weighttx,weightD,1;
    265269  }
    266   else
     270  else // initialIdeal
    267271  {
    268272    @a = 1:noofvars;
    269     if (calledfrom == "bfctonestep")
    270     {
    271       @a[2] = 2;
    272       intvec @a2 = @a; @a2[2] = 0; @a2[2*n+4] = 0;
    273     }
    274273  }
    275274  if (blockord == 0) // default: blockordering
    276275  {
    277     if (calledfrom == "initialmalgrange")
     276    if (calledfrom == "initialMalgrange")
    278277    {
    279278      ring Dh = 0,(t,x(n..1),Dt,D(n..1),h),(a(@a),a(uv),dp(noofvars-1),lp(1));
    280279    }
    281     else
    282     {
    283       if (calledfrom == "initialideal")
    284       {
    285         ring Dh = 0,(x(1..n),D(1..n),h),(a(@a),dp(noofvars-1),lp(1));
    286       }
    287       else // bfctonestep
    288       {
    289         ring Dh = 0,(t,s,x(n..1),Dt,D(n..1),h),(a(@a),a(@a2),a(uv),dp(noofvars-1),lp(1));
    290       }
     280    else // initialIdeal
     281    {
     282      ring Dh = 0,(x(1..n),D(1..n),h),(a(@a),dp(noofvars-1),lp(1));
    291283    }
    292284  }
     
    302294    dbprint(ppl,"weights for ordering:",transpose(@a));
    303295    dbprint(ppl,"the ordering matrix:",@Ord);
    304     if (calledfrom == "initialmalgrange")
     296    if (calledfrom == "initialMalgrange")
    305297    {
    306298      ring Dh = 0,(t,x(n..1),Dt,D(n..1),h),(a(@a),M(@Ord));
    307299    }
    308     else
    309     {
    310       if (calledfrom == "initialideal")
    311       {
    312         ring Dh = 0,(x(1..n),D(1..n),h),(a(@a),M(@Ord));
    313       }
    314       else // bfctonestep
    315       {
    316         ring Dh = 0,(t,s,x(n..1),Dt,D(n..1),h),(a(@a),a(@a2),M(@Ord));
    317       }
     300    else // initialIdeal
     301    {
     302      ring Dh = 0,(x(1..n),D(1..n),h),(a(@a),M(@Ord));
    318303    }
    319304  }
     
    321306  // non-commutative relations
    322307  matrix @relD[noofvars][noofvars];
    323   if (calledfrom == "initialmalgrange")
    324   {
    325     for (i=1; i<=n+1; i++)
    326     {
    327       @relD[i,n+1+i] = h^(d+1);
    328     }
    329   }
    330   else
    331   {
    332     if (calledfrom == "initialideal")
    333     {
    334       for (i=1; i<=n; i++)
    335       {
    336         @relD[i,n+i] = h^2;
    337       }
    338     }
    339     else // bfctonestep
    340     {
    341       @relD[1,2] = t*h^2;// s*t = t*s+t*h^2
    342       @relD[2,n+3] = Dt*h^2;// Dt*s = s*Dt+h^2
    343       @relD[1,n+3] = h^2;
    344       for (i=1; i<=n; i++)
    345       {
    346         @relD[i+2,n+3+i] = h^2;
    347       }
     308  if (calledfrom == "initialMalgrange")
     309  {
     310    for (i=1; i<=n+1; i++) { @relD[i,n+1+i] = h^(d+1); }
     311  }
     312  else // initialIdeal
     313  {
     314    for (i=1; i<=n; i++)
     315    {
     316      @relD[i,n+i] = h^2;
    348317    }
    349318  }
     
    353322  dbprint(ppl,"computing in ring",DDh);
    354323  ideal I;
    355   if (calledfrom == "initialideal")
     324  if (calledfrom == "initialIdeal")
    356325  {
    357326    I = fetch(save,I);
     
    367336    {
    368337      I = I, D(i)+diff(f,x(i))*Dt;
    369     }
    370     if (calledfrom == "bfctonestep")
    371     {
    372       I = I,t*Dt-s;
    373338    }
    374339  }
     
    380345  dbprint(ppl, "I after dehomogenization is" ,I);
    381346  I = inForm(I,uv); // we are only interested in the initial form w.r.t. uv
    382   if (calledfrom == "initialmalgrange")
     347  if (calledfrom == "initialMalgrange")
    383348  {
    384349    // keep the names of the variables of the basering
     
    425390    }
    426391  }
    427   else
    428   {
    429     if (calledfrom == "initialideal")
    430     {
    431       ring @D = 0,(x(1..n),D(1..n)),dp;
    432       def D = Weyl(@D);
    433       setring D;
    434       ideal I = imap(DDh,I);
    435       kill Dh,DDh;
    436     }
    437   }
    438   if (calledfrom <> "bfctonestep")
    439   {
    440     dbprint(ppl, "starting cosmetic Groebner basis computation with engine:", whichengine);
    441     I = engine(I, whichengine);
    442     dbprint(ppl,"finished cosmetic Groebner basis computation:");
    443     dbprint(ppl,"the initial ideal is:", I);
    444   }
    445   ideal inF = I;
     392  else // initialIdeal
     393  {
     394    ring @D = 0,(x(1..n),D(1..n)),dp;
     395    def D = Weyl(@D);
     396    setring D;
     397    ideal I = imap(DDh,I);
     398    kill Dh,DDh;
     399  }
     400  dbprint(ppl, "starting cosmetic Groebner basis computation with engine:", whichengine);
     401  I = engine(I, whichengine);
     402  dbprint(ppl,"finished cosmetic Groebner basis computation:");
     403  dbprint(ppl,"the initial ideal is:", I);
     404  ideal inF = I; attrib(inF,"isSB",1);
    446405  export(inF);
    447406  return(basering);
    448407}
    449408
    450 proc inForm (list #)
    451 "USAGE:  inForm(I,w);  I an ideal, w an intvec
    452 RETURN:  the initial form of I w.r.t. the weight vector w
    453 PURPOSE: compute the initial form of an  ideal w.r.t a given weight vector
    454 NOTE:  the size of the weight vector must be equal to the number of variables of the basering
     409proc inForm (ideal I, intvec w)
     410"USAGE:  inForm(I,w);  I ideal, w intvec
     411RETURN:  the initial form of I wrt the weight vector w
     412PURPOSE: computes the initial form of an ideal wrt a given weight vector
     413NOTE:  the size of the weight vector must be equal to the number of variables
     414@*     of the basering.
    455415EXAMPLE: example inForm; shows examples
    456416"
    457417{
    458   if (size(#)<2)
    459   {
    460     ERROR("inForm needs two arguments of type poly/ideal,intvec");
    461   }
    462   if (typeof(#[1])=="poly" || typeof(#[1])=="ideal")
    463   {
    464     ideal I = #[1];
    465   }
    466   else
    467   {
    468     ERROR("first argument must be of type poly or ideal");
    469   }
    470   if (typeof(#[2])=="intvec")
    471   {
    472     def w = #[2];
    473   }
    474   else
    475   {
    476     ERROR("second argument must be of type intvec");
    477   }
    478418  if (size(w) != nvars(basering))
    479419  {
    480420    ERROR("weight vector has wrong dimension");
    481421  }
     422  if (I == 0)
     423  {
     424    return(I);
     425  } 
    482426  int j,i,s,m;
    483427  list l;
     
    487431  {
    488432    l = poly2list(I[j]);
    489     m = scalarprod(w,l[1][1]);
    490     g = 0;
     433    m = scalarProd(w,l[1][1]);
     434    g = l[1][2];
    491435    for (i=2; i<=size(l); i++)
    492436    {
    493       s = scalarprod(w,l[i][1]);
    494       m = Max(list(s,m));
    495     }
    496     for (i=1; i<=size(l); i++)
    497     {
    498       if (scalarprod(w,l[i][1]) == m)
     437      s = scalarProd(w,l[i][1]);
     438      if (s == m)
    499439      {
    500         g = g+l[i][2];
     440        g = g + l[i][2];
    501441      }
     442      else
     443      {
     444        if (s > m)
     445        {
     446          m = s;
     447          g = l[i][2];
     448        }
     449      }
    502450    }
    503451    J[j] = g;
    504452  }
    505   if (typeof(#[1])=="poly")
    506   {
    507     return(J[1]); // if the input was a poly, return a poly
    508   }
    509   else
    510   {
    511     return(J);    // otherwise, return an ideal
    512   }
     453  return(J);
    513454}
    514455example
     
    527468  inForm(I,w2);
    528469  inForm(I,w3);
    529   inForm(F,w1);
    530 }
    531 
    532 static proc charVariety(ideal I)
     470}
     471
     472/*
     473
     474proc charVariety(ideal I)
    533475"USAGE:  charVariety(I);  I an ideal
    534476RETURN:  ring
     
    615557}
    616558
     559/*
     560
    617561// TODO
    618 static proc charInfo(ideal I)
     562
     563/*
     564proc charInfo(ideal I)
    619565"USAGE:  charInfo(I);  I an ideal
    620566RETURN:  ring
     
    638584  // run primdec
    639585}
     586*/
    640587
    641588
     
    666613  "EXAMPLE:"; echo = 2;
    667614  ring r = 0,x,dp;
    668   def A = appelF1(); //(1,2,3,4);
     615  def A = appelF1();
    669616  setring A;
    670617  IAppel1;
     
    696643  "EXAMPLE:"; echo = 2;
    697644  ring r = 0,x,dp;
    698   def A = appelF2(); //(1,2,3,4);
     645  def A = appelF2();
    699646  setring A;
    700647  IAppel2;
     
    726673  "EXAMPLE:"; echo = 2;
    727674  ring r = 0,x,dp;
    728   def A = appelF4(); //(1,2,3,4);
     675  def A = appelF4();
    729676  setring A;
    730677  IAppel4;
     
    740687  list l;
    741688  int i = 1;
    742   if (f==0) // just for the zero polynomial
     689  if (f == 0) // just for the zero polynomial
    743690  {
    744691    l[1] = list(leadexp(f), lead(f));
    745692  }
    746   while (f!=0)
     693  else { l[size(f)] = list(); } // memory pre-allocation
     694  while (f != 0)
    747695  {
    748696    l[i] = list(leadexp(f), lead(f));
    749     f = f-lead(f);
     697    f = f - lead(f);
    750698    i++;
    751699  }
     
    803751"USAGE:  DLoc(I, F);  I an ideal, F a poly
    804752RETURN: nothing (exports objects instead)
    805 ASSUME: the basering is a Weyl algebra and I is F-saturated
     753ASSUME: the basering is a Weyl algebra
    806754PURPOSE: compute the presentation of the localization of D/I w.r.t. f^s
    807755NOTE:    In the basering, the following objects are exported:
     
    860808{
    861809  /* assume: to be run in the output ring of SDLoc */
    862   /* todo: add F, eliminate vars*Dvars, factorize BS */
     810  /* doing: add F, eliminate vars*Dvars, factorize BS */
    863811  /* analogue to annfs0 */
    864812  def @R2 = basering;
     
    12921240NOTE:    activate the output ring with the @code{setring} command.
    12931241@*       In the output ring:
    1294 @*       - the ideal RLD (which is given in a Groebner basis) is the annihilator.
     1242@*       - the ideal LD (which is given in a Groebner basis) is the annihilator.
    12951243@*       If @code{printlevel}=1, progress debug messages will be printed,
    12961244@*       if @code{printlevel}>=2, all the debug messages will be printed.
     
    13691317  kill @R1;   kill @R2;
    13701318  dbprint(ppl,"// -4-[annRat] running modulo");
    1371   ideal RLD  = modulo(G,LL);
     1319  ideal LD  = modulo(G,LL);
    13721320  dbprint(ppl,"// -4-[annRat] running GB on the final result");
    1373   RLD  = engine(RLD,0);
    1374   export RLD;
     1321  LD  = engine(LD,0);
     1322  export LD;
    13751323  return(@R3);
    13761324}
     
    13821330  def B = annRat(g,f);
    13831331  setring B;
    1384   RLD;
     1332  LD;
    13851333  // Now, compare with the output of Macaulay2:
    13861334  ideal tst = 3*x*Dx + 2*y*Dy + 1, y^3*Dy^2 - x^2*Dy^2 + 6*y^2*Dy + 6*y,
    138713359*y^2*Dx^2*Dy - 4*y*Dy^3 + 27*y*Dx^2 + 2*Dy^2, 9*y^3*Dx^2 - 4*y^2*Dy^2 + 10*y*Dy -10;
    13881336 option(redSB); option(redTail);
    1389  RLD = groebner(RLD);
     1337 LD = groebner(LD);
    13901338 tst = groebner(tst);
    1391  print(matrix(NF(RLD,tst)));  print(matrix(NF(tst,RLD)));
     1339 print(matrix(NF(LD,tst)));  print(matrix(NF(tst,LD)));
    13921340 // So, these two answers are the same
    13931341}
    13941342
    1395 static proc ex_annRat()
    1396 {
    1397   // more complicated example
     1343/*
     1344//static proc ex_annRat()
     1345{
     1346  // more complicated example for annRat
    13981347  ring r = 0,(x,y,z),dp;
    13991348  poly f = x3+y3+z3; // mir = -2
     
    14021351  setring A;
    14031352}
     1353*/
    14041354
    14051355proc annPoly(poly f)
     
    14091359NOTE:    activate the output ring with the @code{setring} command.
    14101360@*       In the output ring:
    1411 @*       - the ideal RLD (which is given in a Groebner basis) is the annihilator.
     1361@*       - the ideal LD (which is given in a Groebner basis) is the annihilator.
    14121362@*       If @code{printlevel}=1, progress debug messages will be printed,
    14131363@*       if @code{printlevel}>=2, all the debug messages will be printed.
     
    14551405}
    14561406
    1457 static proc exCusp()
     1407/* DIFFERENT EXAMPLES
     1408
     1409//static proc exCusp()
    14581410{
    14591411  "EXAMPLE:"; echo = 2;
     
    14741426}
    14751427
    1476 static proc exWalther1()
     1428//static proc exWalther1()
    14771429{
    14781430  // p.18 Rem 3.10
     
    14941446}
    14951447
    1496 static proc exWalther2()
     1448//static proc exWalther2()
    14971449{
    14981450  // p.19 Rem 3.10 cont'd
     
    15181470}
    15191471
    1520 static proc exWalther3()
     1472//static proc exWalther3()
    15211473{
    15221474  // can check with annFs too :-)
     
    15501502}
    15511503
     1504*/
     1505
    15521506proc engine(ideal I, int i)
    15531507"USAGE:  engine(I,i);  I an ideal, i an int
     
    15811535  engine(I,1); // uses std
    15821536}
     1537
     1538proc insertGenerator (list #)
     1539"USAGE:  insertGenerator(id,p[,k]);  id an ideal/module, p a poly/vector, k an optional int
     1540RETURN:  same as id
     1541PURPOSE: insert an element into an ideal or a module
     1542NOTE:    If k is given, p is inserted at position k, otherwise (and by default),
     1543@*       p is inserted at the beginning.
     1544EXAMPLE: example insertGenerator; shows examples
     1545"
     1546{
     1547  if (size(#) < 2)
     1548  {
     1549    ERROR("insertGenerator has to be called with at least 2 arguments (ideal/module,poly/vector)");
     1550  }
     1551  string inp1 = typeof(#[1]);
     1552  if (inp1 == "ideal" || inp1 == "module")
     1553  {
     1554    if (inp1 == "ideal") { ideal id = #[1]; }
     1555    else { module id = #[1]; }
     1556  }
     1557  else { ERROR("first argument has to be of type ideal or module"); }
     1558  string inp2 = typeof(#[2]);
     1559  if (inp2 == "poly" || inp2 == "vector")
     1560  {
     1561    if (inp2 =="poly") { poly f = #[2]; }
     1562    else
     1563    {
     1564      if (inp1 == "ideal")
     1565      {
     1566        ERROR("second argument has to be a poly if first argument is an ideal");
     1567      }
     1568      else { vector f = #[2]; }
     1569    }
     1570  }
     1571  else { ERROR("second argument has to be of type poly/vector"); }
     1572  int n = ncols(id);
     1573  int k = 1; // default
     1574  if (size(#)>=3)
     1575  {
     1576    if (typeof(#[3]) == "int")
     1577    {
     1578      k = #[3];
     1579      if (k<=0)
     1580      {
     1581        ERROR("third argument has to be positive");
     1582      }
     1583    }
     1584    else { ERROR("third argument has to be of type int"); }
     1585  }
     1586  execute(inp1 +" J;");
     1587  if (k == 1) { J = f,id; }
     1588  else
     1589  {
     1590    if (k>n)
     1591    {
     1592      J = id;
     1593      J[k] = f;
     1594    }
     1595    else // 1<k<=n
     1596    {
     1597      J[1..k-1] = id[1..k-1];
     1598      J[k] = f;
     1599      J[k+1..n+1] = id[k..n];
     1600    }
     1601  }
     1602  return(J);
     1603}
     1604example
     1605{
     1606  "EXAMPLE:"; echo = 2;
     1607  ring r = 0,(x,y,z),dp;
     1608  ideal I = x^2,z^4;
     1609  insertGenerator(I,y^3);
     1610  insertGenerator(I,y^3,2);
     1611  module M = I;
     1612  insertGenerator(M,[x^3,y^2,z],2);
     1613}
     1614
     1615proc deleteGenerator (list #)
     1616"USAGE:  deleteGenerator(id,k);  id an ideal/module, k an int
     1617RETURN:  same as id
     1618PURPOSE: deletes the k-th element from an ideal or a module
     1619EXAMPLE: example insertGenerator; shows examples
     1620"
     1621{
     1622  if (size(#) < 2)
     1623  {
     1624    ERROR("deleteGenerator has to be called with 2 arguments (ideal/module,int)");
     1625  }
     1626  string inp1 = typeof(#[1]);
     1627  if (inp1 == "ideal" || inp1 == "module")
     1628  {
     1629    if (inp1 == "ideal") { ideal id = #[1]; }
     1630    else { module id = #[1]; }
     1631  }
     1632  else { ERROR("first argument has to be of type ideal or module"); }
     1633  string inp2 = typeof(#[2]);
     1634  if (inp2 == "int" || inp2 == "number") { int k = int(#[2]); }
     1635  else { ERROR("second argument has to be of type int"); }
     1636  int n = ncols(id);
     1637  if (n == 1) { ERROR(inp1+" must have more than one generator"); }
     1638  if (k<=0 || k>n) { ERROR("second argument has to be in the range 1,...,"+string(n)); }
     1639  execute(inp1 +" J;");
     1640  if (k == 1) { J = id[2..n]; }
     1641  else
     1642  {
     1643    if (k == n) { J = id[1..n-1]; }
     1644    else
     1645    {
     1646      J[1..k-1] = id[1..k-1];
     1647      J[k..n-1] = id[k+1..n];
     1648    }
     1649  }
     1650  return(J);
     1651}
     1652example
     1653{
     1654  "EXAMPLE:"; echo = 2;
     1655  ring r = 0,(x,y,z),dp;
     1656  ideal I = x^2,y^3,z^4;
     1657  deleteGenerator(I,2);
     1658  module M = [x,y,z],[x2,y2,z2],[x3,y3,z3];;
     1659  deleteGenerator(M,2);
     1660}
     1661
     1662proc fl2poly(list L, string s)
     1663"USAGE:  fl2poly(L,s); L a list, s a string
     1664RETURN:  poly
     1665PURPOSE: reconstruct a monic polynomial in one variable from its factorization
     1666ASSUME:  s is a string with the name of some variable and L is supposed to consist of two entries:
     1667@*         L[1] of the type ideal with the roots of a polynomial
     1668@*         L[2] of the type intvec with the multiplicities of corr. roots
     1669EXAMPLE: example fl2poly; shows examples
     1670"
     1671{
     1672  if (varnum(s)==0)
     1673  {
     1674    ERROR("no such variable found"); return(0);
     1675  }
     1676  poly x = var(varnum(s));
     1677  poly P = 1;
     1678  int sl = size(L[1]);
     1679  ideal RR = L[1];
     1680  intvec IV = L[2];
     1681  for(int i=1; i<= sl; i++)
     1682  {
     1683    P = P*((x-RR[i])^IV[i]);
     1684  }
     1685  return(P);
     1686}
     1687example
     1688{
     1689  "EXAMPLE:"; echo = 2;
     1690  ring r = 0,(x,y,z,s),Dp;
     1691  ideal I = -1,-4/3,-5/3,-2;
     1692  intvec mI = 2,1,1,1;
     1693  list BS = I,mI;
     1694  poly p = fl2poly(BS,"s");
     1695  p;
     1696  factorize(p,2);
     1697}
Note: See TracChangeset for help on using the changeset viewer.