source: git/Singular/LIB/dmodvar.lib @ 794e6a4

fieker-DuValspielwiese
Last change on this file since 794e6a4 was e31d29, checked in by Hans Schoenemann <hannes@…>, 14 years ago
format git-svn-id: file:///usr/local/Singular/svn/trunk@13455 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100755
File size: 22.4 KB
RevLine 
[4f461c]1////////////////////////////////////////////////////////////////////////
[24c368]2version="$Id$";
[4f461c]3category="Noncommutative";
4info="
5LIBRARY: dmodvar.lib     Algebraic D-modules for varieties
6
[f52e64]7AUTHORS: Daniel Andres,        daniel.andres@math.rwth-aachen.de
8@*       Viktor Levandovskyy,  levandov@math.rwth-aachen.de
9@*       Jorge Martin-Morales, jorge@unizar.es
[4f461c]10
[f52e64]11OVERVIEW: Let K be a field of characteristic 0. Given a polynomial ring R = K[x_1,...,x_n]
12and polynomials f_1,...,f_r in R, define F = f_1*...*f_r and F^s = f_1^s_1*...*f_r^s_r
13for symbolic discrete (that is shiftable) variables s_1,..., s_r.
14The module R[1/F]*F^s has the structure of a D<S>-module, where D<S> = D(R)
15tensored with S over K, where
16@* - D(R) is the n-th Weyl algebra K<x_1,...,x_n,d_1,...,d_n | d_j x_j = x_j d_j + 1>
17@* - S is the universal enveloping algebra of gl_r, generated by s_i = s_{ii}.
[6a07eb]18@* One is interested in the following data:
[f52e64]19@* - the left ideal Ann F^s in D<S>, usually denoted by LD in the output
20@* - global Bernstein polynomial in one variable s = s_1+...+s_r, denoted by bs,
21@* - its minimal integer root s0, the list of all roots of bs, which are known to be
22     negative rational numbers, with their multiplicities, which is denoted by BS
23@* - an r-tuple of operators in D<S>, denoted by PS, such that the functional equality
24     sum(k=1 to k=r) P_k*f_k*F^s = bs*F^s holds in R[1/F]*F^s.
[4f461c]25
[f4490f5]26References:
[f52e64]27   (BMS06) Budur, Mustata, Saito: Bernstein-Sato polynomials of arbitrary varieties (2006).
[e31d29]28@* (ALM09) Andres, Levandovskyy, Martin-Morales: Principal Intersection and Bernstein-Sato
[f52e64]29Polynomial of an Affine Variety (2009).
30
[4f461c]31
[7a051de]32PROCEDURES:
[f52e64]33bfctVarIn(F[,L]);       computes the roots of the Bernstein-Sato polynomial b(s) of the variety V(F) using initial ideal approach
34bfctVarAnn(F[,L]);      computes the roots of the Bernstein-Sato polynomial b(s) of the variety V(F) using Sannfs approach
35SannfsVar(F[,O,e]);     computes the annihilator of F^s in the ring D<S>
36makeMalgrange(F[,ORD]); creates the Malgrange ideal, associated with F = F[1],..,F[P]
[4f461c]37
[6a07eb]38SEE ALSO: bfun_lib, dmod_lib, dmodapp_lib, gmssing_lib
39
40KEYWORDS: D-module; D-module structure; Bernstein-Sato polynomial for variety; global Bernstein-Sato polynomial for variety;
[7a051de]41Weyl algebra; parametric annihilator for variety; Budur-Mustata-Saito approach; initial ideal approach
[4f461c]42";
43
[f52e64]44/*
[4f461c]45// Static procs:
[f52e64]46// coDim(I);           compute the codimension of the leading ideal of I
[4f461c]47// dmodvarAssumeViolation()
48// ORDstr2list (ORD, NN)
49// smallGenCoDim(I,k)
[f52e64]50*/
51
52/*
53  CHANGELOG
54  11.10.10 by DA:
55  - reformated help strings
56  - simplified code
57  - add and use of safeVarName
58  - renamed makeIF to makeMalgrange
59*/
[4f461c]60
61
62LIB "bfun.lib";    // for pIntersect
63LIB "dmodapp.lib"; // for isCommutative etc.
64
65
66///////////////////////////////////////////////////////////////////////////////
67
68// testing for consistency of the library:
69proc testdmodvarlib ()
70{
[f52e64]71  example makeMalgrange;
[4f461c]72  example bfctVarIn;
73  example bfctVarAnn;
74  example SannfsVar;
75}
76//   example coDim;
77
78///////////////////////////////////////////////////////////////////////////////
79
80static proc dmodvarAssumeViolation()
81{
[f52e64]82  // char K = 0, no qring
[4f461c]83  if (  (size(ideal(basering)) >0) || (char(basering) >0) )
84  {
[f52e64]85    ERROR("Basering is inappropriate: characteristic>0 or qring present");
[4f461c]86  }
[f52e64]87  return();
[4f461c]88}
89
[f52e64]90static proc safeVarName (string s, string cv)
91// assumes 's' to be a valid variable name
92// returns valid var name string @@..@s
93{
94  string S;
95  if (cv == "v")  { S = "," + "," + varstr(basering)  + ","; }
96  if (cv == "c")  { S = "," + "," + charstr(basering) + ","; }
97  if (cv == "cv") { S = "," + charstr(basering) + "," + varstr(basering) + ","; }
98  s = "," + s + ",";
99  while (find(S,s) <> 0)
100  {
101    s[1] = "@";
102    s = "," + s;
103  }
104  s = s[2..size(s)-1];
105  return(s)
106    }
107
[4f461c]108// da: in smallGenCoDim(), rewritten using mstd business
109static proc coDim (ideal I)
[f52e64]110  "USAGE:  coDim (I);  I an ideal
[4f461c]111RETURN:  int
112PURPOSE: computes the codimension of the ideal generated by the leading monomials
[f52e64]113   of the given generators of the ideal. This is also the codimension of
114   the ideal if it is represented by a standard basis.
[4f461c]115NOTE:    The codimension of an ideal I means the number of variables minus the
[f52e64]116   Krull dimension of the basering modulo I.
117EXAMPLE: example coDim; shows examples
[4f461c]118"
119{
120  int n = nvars(basering);
121  int d = dim(I); // to insert: check whether I is in GB
122  return(n-d);
123}
124example
125{
126  "EXAMPLE:"; echo = 2;
127  ring R = 0,(x,y,z),Dp;
128  ideal I = x^2+y^3, z;
129  coDim(std(I));
130}
131
132static proc ORDstr2list (string ORD, int NN)
133{
134  /* convert an ordering defined in NN variables in the  */
135  /* string form into the same ordering in the list form */
136  string st;
137  st = "ring @Z = 0,z(1.." + string(NN) + "),";
138  st = st + ORD + ";";
139  execute(st); kill st;
140  list L = ringlist(@Z)[3];
141  kill @Z;
142  return(L);
143}
144
145proc SannfsVar (ideal F, list #)
[f52e64]146  "USAGE:  SannfsVar(F [,ORD,eng]);  F an ideal, ORD an optional string, eng an optional int
147RETURN:  ring (Weyl algebra tensored with U(gl_P)), containing an ideal LD
148PURPOSE: compute the D<S>-module structure of D<S>*f^s where f = F[1]*...*F[P]
149   and D<S> is the Weyl algebra D tensored with K<S>=U(gl_P), according to the
150   generalized algorithm by Briancon and Maisonobe for affine varieties
151ASSUME:  The basering is commutative and over a field of characteristic 0.
152NOTE:    Activate the output ring D<S> with the @code{setring} command.
153   In the ring D<S>, the ideal LD is the needed D<S>-module structure.
154@* The value of ORD must be an elimination ordering in D<Dt,S> for Dt
155   written in the string form, otherwise the result may have no meaning.
156   By default ORD = '(a(1..(P)..1),a(1..(P+P^2)..1),dp)'.
157@* If eng<>0, @code{std} is used for Groebner basis computations,
158   otherwise, and by default @code{slimgb} is used.
159DISPLAY: If printlevel=1, progress debug messages will be printed,
160@* if printlevel>=2, all the debug messages will be printed.
[4f461c]161EXAMPLE: example SannfsVar; shows examples
162"
163{
[f52e64]164  dmodvarAssumeViolation();
[4f461c]165  if (!isCommutative())
166  {
167    ERROR("Basering must be commutative");
168  }
169  def save = basering;
170  int N = nvars(basering);
171  int P = ncols(F);  //ncols better than size, since F[i] could be zero
172  // P is needed for default ORD
173  int i,j,k,l;
174  // st = "(a(1..(P)..1),a(1..(P+P^2)..1),dp)";
175  string st = "(a(" + string(1:P);
176  st = st + "),a(" + string(1:(P+P^2));
177  st = st + "),dp)";
178  // default values
179  string ORD = st;
180  int eng = 0;
181  if ( size(#)>0 )
182  {
183    if ( typeof(#[1]) == "string" )
184    {
185      ORD = string(#[1]);
186      // second arg
187      if (size(#)>1)
188      {
189        // exists 2nd arg
190        if ( typeof(#[2]) == "int" )
191        {
192          // the case: given ORD, given engine
193          eng = int(#[2]);
194        }
195      }
196    }
197    else
198    {
199      if ( typeof(#[1]) == "int" )
200      {
201        // the case: default ORD, engine given
202        eng = int(#[1]);
203        // ORD = "(a(1..(P)..1),a(1..(P+P^2)..1),dp)";  //is already set
204      }
205      else
206      {
207        // incorr. 1st arg
208        ORD = string(st);
209      }
210    }
211  }
212  // size(#)=0, i.e. there is no elimination ordering and no engine given
213  // eng = 0; ORD = "(a(1..(P)..1),a(1..(P^2)..1),dp)";  //are already set
214  int ppl = printlevel-voice+2;
215  // returns a list with a ring and an ideal LD in it
216  // save, N, P and the indices are already defined
217  int Nnew = 2*N+P+P^2;
218  list RL = ringlist(basering);
219  list L;
220  L[1] = RL[1];  //char
221  L[4] = RL[4];  //char, minpoly
222  // check whether vars have admissible names
223  list Name  = RL[2];
224  list RName;
225  // (i,j) <--> (i-1)*p+j
226  for (i=1; i<=P; i++)
227  {
[f52e64]228    RName[i] = safeVarName("Dt("+string(i)+")","cv");
[4f461c]229    for (j=1; j<=P; j++)
230    {
[f52e64]231      RName[P+(i-1)*P+j] = safeVarName("s("+string(i)+")("+string(j)+")","cv");
[4f461c]232    }
233  }
234  // now, create the names for new vars
235  list DName;
236  for(i=1; i<=N; i++)
237  {
[f52e64]238    DName[i] = safeVarName("D"+Name[i],"cv");  //concat
[4f461c]239  }
240  list NName = RName + Name + DName;
241  L[2] = NName;
242  // Name, Dname will be used further
243  kill NName;
244  //block ord (a(1..(P)..1),a(1..(P+P^2)..1),dp);
245  //export Nnew;
246  L[3] = ORDstr2list(ORD,Nnew);
247  // we are done with the list
248  def @R@ = ring(L);
249  setring @R@;
250  matrix @D[Nnew][Nnew];
251  // kronecker(i,j) equals (i==j)
252  // (i,j) <--> (i-1)*p+j
253  for (i=1; i<=P; i++)
254  {
255    for (j=1; j<=P; j++)
256    {
257      for (k=1; k<=P; k++)
258      {
259        //[sij,Dtk] = djk*Dti
[e31d29]260        //         @D[k,P+(i-1)*P+j] = (j==k)*Dt(i);
261        @D[k,P+(i-1)*P+j] = (j==k)*var(i);
[4f461c]262        for (l=1; l<=P; l++)
263        {
264          if ( (i-k)*P < l-j )
265          {
266            //[sij,skl] = djk*sil - dil*skj
[e31d29]267            //             @D[P+(i-1)*P+j,P+(k-1)*P+l] = -(j==k)*s(i)(l) + (i==l)*s(k)(j);
268            @D[P+(i-1)*P+j,P+(k-1)*P+l] = -(j==k)*var(i*P+l) + (i==l)*var(k*P+j);
[4f461c]269          }
270        }
271      }
272    }
273  }
274  for (i=1; i<=N; i++)
275  {
276    //[Dx,x]=1
277    @D[P+P^2+i,P+P^2+N+i] = 1;
278  }
279  def @R = nc_algebra(1,@D);
280  setring @R;
281  //@R@ will be used further
282  dbprint(ppl,"// -1-1- the ring @R(_Dt,_s,_x,_Dx) is ready");
283  dbprint(ppl-1, @R);
284  // create the ideal I
285  // (i,j) <--> (i-1)*p+j
286  ideal  F = imap(save,F);
287  ideal I;
288  for (i=1; i<=P; i++)
289  {
290    for (j=1; j<=P; j++)
291    {
[f52e64]292      //       I[(i-1)*P+j] = Dt(i)*F[j] + s(i)(j);
293      I[(i-1)*P+j] = var(i)*F[j] + var(i*P+j);
[4f461c]294    }
295  }
296  poly p,q;
297  for (i=1; i<=N; i++)
298  {
299    p=0;
300    for (j=1; j<=P; j++)
301    {
[f52e64]302      //       q = Dt(j);
303      q = var(j);
[4f461c]304      q = q*diff(F[j],var(P+P^2+i));
305      p = p + q;
306    }
307    I = I, p + var(P+P^2+N+i);
308  }
309  // -------- the ideal I is ready ----------
[f52e64]310  dbprint(ppl,"// -1-2- starting the elimination of Dt(i) in @R");
[4f461c]311  dbprint(ppl-1, I);
312  ideal J = engine(I,eng);
313  ideal K = nselect(J,1..P);
314  kill I,J;
315  dbprint(ppl,"// -1-3- all Dt(i) are eliminated");
316  dbprint(ppl-1, K);  //K is without Dt(i)
317  // ----------- the ring @R2(_s,_x,_Dx) ------------
318  //come back to the ring save, recover L and remove all Dt(i)
319  //L[1],L[4] do not change
320  setring save;
321  list Lord, tmp;
322  // variables
323  tmp = L[2];
324  Lord = tmp[P+1..Nnew];
325  L[2] = Lord;
326  // ordering
327  // st = "(a(1..(P^2)..1),dp)";
328  st = "(a(" + string(1:P^2);
329  st = st + "),dp)";
330  tmp = ORDstr2list(st,Nnew-P);
331  L[3] = tmp;
332  def @R2@ = ring(L);
333  kill L;
334  // we are done with the list
335  setring @R2@;
336  matrix tmpM,LordM;
337  // non-commutative relations
338  intvec iv = P+1..Nnew;
339  tmpM = imap(@R@,@D);
340  kill @R@;
341  LordM = submat(tmpM,iv,iv);
342  matrix @D2 = LordM;
343  def @R2 = nc_algebra(1,@D2);
344  setring @R2;
345  kill @R2@;
346  dbprint(ppl,"// -2-1- the ring @R(_s,_x,_Dx) is ready");
347  dbprint(ppl-1, @R2);
348  ideal K = imap(@R,K);
349  kill @R;
350  dbprint(ppl,"// -2-2- starting cosmetic Groebner basis computation");
351  dbprint(ppl-1, K);
352  K = engine(K,eng);
353  dbprint(ppl,"// -2-3- the cosmetic Groebner basis has been computed");
354  dbprint(ppl-1,K);
355  ideal LD = K;
356  attrib(LD,"isSB",1);
357  export LD;
358  return(@R2);
359}
360example
361{
362  "EXAMPLE:"; echo = 2;
363  ring R = 0,(x,y),Dp;
364  ideal F = x^3, y^5;
365  //ORD = "(a(1,1),a(1,1,1,1,1,1),dp)";
366  //eng = 0;
367  def A = SannfsVar(F);
368  setring A;
[f52e64]369  A;
[4f461c]370  LD;
371}
372
373proc bfctVarAnn (ideal F, list #)
[f52e64]374  "USAGE:  bfctVarAnn(F[,gid,eng]); F an ideal, gid,eng optional ints
[6a07eb]375RETURN:  list of an ideal and an intvec
[ea87a9]376PURPOSE: computes the roots of the Bernstein-Sato polynomial and their multiplicities
[f52e64]377   for an affine algebraic variety defined by F = F[1],..,F[r].
378ASSUME:  The basering is commutative and over a field in char 0.
379NOTE:    In the output list, the ideal contains all the roots and
380   the intvec their multiplicities.
381@* If gid<>0, the ideal is used as given. Otherwise, and by default, a
382   heuristically better suited generating set is used.
383@* If eng<>0, @code{std} is used for GB computations,
384   otherwise, and by default, @code{slimgb} is used.
385@* Computational remark: The time of computation can be very different depending
386   on the chosen generators of F, although the result is always the same.
387@* Further note that in this proc, the annihilator of f^s in D[s] is computed and
388   then a system of linear equations is solved by linear reductions in order to
389   find the minimal polynomial of S = s(1)(1) + ... + s(P)(P).
390   The resulted is shifted by 1-codim(Var(F)) following (BMS06).
[4f461c]391DISPLAY: If printlevel=1, progress debug messages will be printed,
[f52e64]392@* if printlevel=2, all the debug messages will be printed.
[4f461c]393EXAMPLE: example bfctVarAnn; shows examples
394"
395{
[f52e64]396  dmodvarAssumeViolation();
[4f461c]397  if (!isCommutative())
398  {
399    ERROR("Basering must be commutative");
400  }
401  int gid = 0; // default
402  int eng = 0; // default
403  if (size(#)>0)
404  {
405    if (typeof(#[1])=="int" || typeof(#[1])=="number")
406    {
407      gid = int(#[1]);
408    }
409    if (size(#)>1)
410    {
411      if (typeof(#[2])=="int" || typeof(#[2])=="number")
412      {
[0610f0e]413        eng = int(#[2]);
[4f461c]414      }
415    }
416  }
417  def save = basering;
418  int ppl = printlevel - voice + 2;
419  printlevel = printlevel+1;
420  list L = smallGenCoDim(F,gid);
421  F = L[1];
422  int cd = L[2];
423  kill L;
424  def @R2 = SannfsVar(F,eng);
425  printlevel = printlevel-1;
[f52e64]426  int sF = size(F); // no 0 in F
[4f461c]427  setring @R2;
428  // we are in D[s] and LD is a std of SannfsVar(F)
429  ideal F = imap(save,F);
430  ideal GF = std(F);
431  ideal J = NF(LD,GF);
432  J = J, F;
433  dbprint(ppl,"// -3-1- starting Groebner basis of ann F^s + F ");
434  dbprint(ppl-1,J);
435  ideal K = engine(J,eng);
436  dbprint(ppl,"// -3-2- finished Groebner basis of ann F^s + F ");
437  dbprint(ppl-1,K);
438  poly S;
439  int i;
[f52e64]440  for (i=1; i<=sF; i++)
[4f461c]441  {
[f52e64]442    //     S = S + s(i)(i);
443    S = S + var((i-1)*sF+i);
[4f461c]444  }
445  dbprint(ppl,"// -4-1- computing the minimal polynomial of S");
[f52e64]446  dbprint(ppl-1,"S = "+string(S));
447  vector M = pIntersect(S,K);
[4f461c]448  dbprint(ppl,"// -4-2- the minimal polynomial has been computed");
449  ring @R3 = 0,s,dp;
[f52e64]450  vector M = imap(@R2,M);
451  poly p = vec2poly(M);
452  dbprint(ppl-1,p);
453  dbprint(ppl,"// -5-1- codimension of the variety");
[4f461c]454  dbprint(ppl-1,cd);
[f52e64]455  dbprint(ppl,"// -5-2- shifting BS(s)=minpoly(s-codim+1)");
456  p = subst(p,var(1),var(1)-cd+1);
457  dbprint(ppl-1,p);
458  dbprint(ppl,"// -5-3- factorization of the minimal polynomial");
459  list BS = bFactor(p);
460  setring save;
461  list BS = imap(@R3,BS);
462  kill @R2,@R3;
[4f461c]463  return(BS);
464}
465example
466{
467  "EXAMPLE:"; echo = 2;
468  ring R = 0,(x,y,z),Dp;
469  ideal F = x^2+y^3, z;
470  bfctVarAnn(F);
471}
472
[f52e64]473proc makeMalgrange (ideal F, list #)
474  "USAGE:  makeMalgrange(F [,ORD]);  F an ideal, ORD an optional string
475RETURN:  ring (Weyl algebra) containing an ideal IF
476PURPOSE: create the ideal by Malgrange associated with F = F[1],...,F[P].
477NOTE:    Activate the output ring with the @code{setring} command. In this ring,
478   the ideal IF is the ideal by Malgrange corresponding to F.
479@* The value of ORD must be an arbitrary ordering in K<_t,_x,_Dt,_Dx>
480   written in the string form. By default ORD = 'dp'.
481DISPLAY: If printlevel=1, progress debug messages will be printed,
482@* if printlevel>=2, all the debug messages will be printed.
483EXAMPLE: example makeMalgrange; shows examples
[4f461c]484"
485{
486  string ORD = "dp";
487  if ( size(#)>0 )
488  {
489    if ( typeof(#[1]) == "string" )
490    {
491      ORD = string(#[1]);
492    }
493  }
494  int ppl = printlevel-voice+2;
495  def save = basering;
496  int N = nvars(save);
497  int P = ncols(F);
498  int Nnew = 2*P+2*N;
499  int i,j;
500  string st;
501  list RL = ringlist(save);
502  list L,Lord;
503  list tmp;
504  intvec iv;
505  L[1] = RL[1];
506  L[4] = RL[4];
507  //check whether vars have admissible names
508  list Name = RL[2];
509  list TName, DTName;
510  for (i=1; i<=P; i++)
511  {
[f52e64]512    TName[i] = safeVarName("t("+string(i)+")","cv");
513    DTName[i] = safeVarName("Dt("+string(i)+")","cv");
[4f461c]514  }
515  //now, create the names for new vars
516  list DName;
517  for (i=1; i<=N; i++)
518  {
[f52e64]519    DName[i] = safeVarName("D"+Name[i],"cv");  //concat
[4f461c]520  }
521  list NName = TName + Name + DTName + DName;
522  L[2]   = NName;
523  // Name, Dname will be used further
524  kill NName, TName, Name, DTName, DName;
525  // ORD already set, default ord dp;
526  L[3] = ORDstr2list(ORD,Nnew);
527  // we are done with the list
528  def @R@ = ring(L);
529  setring @R@;
[f52e64]530  def @R = Weyl();
[4f461c]531  setring @R;
532  kill @R@;
533  //dbprint(ppl,"// -1-1- the ring @R(_t,_x,_Dt,_Dx) is ready");
534  //dbprint(ppl-1, @R);
535  // create the ideal I
536  ideal  F = imap(save,F);
537  ideal I;
538  for (j=1; j<=P; j++)
539  {
[f52e64]540    //     I[j] = t(j) - F[j];
541    I[j] = var(j) - F[j];
[4f461c]542  }
543  poly p,q;
544  for (i=1; i<=N; i++)
545  {
546    p=0;
547    for (j=1; j<=P; j++)
548    {
[f52e64]549      //       q = Dt(j);
550      q = var(P+N+j);
[4f461c]551      q = diff(F[j],var(P+i))*q;
552      p = p + q;
553    }
554    I = I, p + var(2*P+N+i);
555  }
556  // -------- the ideal I is ready ----------
557  ideal IF = I;
558  export IF;
559  return(@R);
560}
561example
562{
563  "EXAMPLE:"; echo = 2;
564  ring R = 0,(x,y,z),Dp;
565  ideal I = x^2+y^3, z;
[f52e64]566  def W = makeMalgrange(I);
[4f461c]567  setring W;
[f52e64]568  W;
[4f461c]569  IF;
570}
571
572proc bfctVarIn (ideal I, list #)
[f52e64]573  "USAGE:  bfctVarIn(I [,a,b,c]);  I an ideal, a,b,c optional ints
[4f461c]574RETURN:  list of ideal and intvec
575PURPOSE: computes the roots of the Bernstein-Sato polynomial and their
[f52e64]576   multiplicities for an affine algebraic variety defined by I.
577ASSUME:  The basering is commutative and over a field of characteristic 0.
578@* Varnames of the basering do not include t(1),...,t(r) and
579   Dt(1),...,Dt(r), where r is the number of entries of the input ideal.
[4f461c]580NOTE:    In the output list, say L,
[f52e64]581@* - L[1] of type ideal contains all the rational roots of a b-function,
582@* - L[2] of type intvec contains the multiplicities of above roots,
583@* - optional L[3] of type string is the part of b-function without rational roots.
584@* Note, that a b-function of degree 0 is encoded via L[1][1]=0, L[2]=0 and
585   L[3] is 1 (for nonzero constant) or 0 (for zero b-function).
586@* If a<>0, the ideal is used as given. Otherwise, and by default, a
587   heuristically better suited generating set is used to reduce computation time.
588@* If b<>0, @code{std} is used for GB computations in characteristic 0,
589   otherwise, and by default, @code{slimgb} is used.
590@* If c<>0, a matrix ordering is used for GB computations, otherwise,
591   and by default, a block ordering is used.
592@* Further note, that in this proc, the initial ideal of the multivariate Malgrange
593   ideal defined by I is computed and then a system of linear equations is solved
594   by linear reductions following the ideas by Noro.
595   The result is shifted by 1-codim(Var(F)) following (BMS06).
[4f461c]596DISPLAY: If printlevel=1, progress debug messages will be printed,
[f52e64]597@* if printlevel>=2, all the debug messages will be printed.
[4f461c]598EXAMPLE: example bfctVarIn; shows examples
599"
600{
[f52e64]601  dmodvarAssumeViolation();
[4f461c]602  if (!isCommutative())
603  {
604    ERROR("Basering must be commutative");
605  }
606  int ppl = printlevel - voice + 2;
607  int idealasgiven  = 0; // default
608  int whicheng      = 0; // default
609  int whichord      = 0; // default
610  if (size(#)>0)
611  {
612    if (typeof(#[1])=="int" || typeof(#[1])=="number")
613    {
614      idealasgiven = int(#[1]);
615    }
616    if (size(#)>1)
617    {
618      if (typeof(#[2])=="int" || typeof(#[2])=="number")
619      {
[0610f0e]620        whicheng = int(#[2]);
[4f461c]621      }
622      if (size(#)>2)
623      {
[0610f0e]624        if (typeof(#[3])=="int" || typeof(#[3])=="number")
625        {
626          whichord = int(#[3]);
627        }
[4f461c]628      }
629    }
630  }
631  def save = basering;
632  int i;
633  int n = nvars(basering);
634  // step 0: get small generating set
635  I = simplify(I,2);
636  list L = smallGenCoDim(I,idealasgiven);
637  I = L[1];
638  int c = L[2];
639  kill L;
640  // step 1: setting up the multivariate Malgrange ideal
641  int r = size(I);
[f52e64]642  def D = makeMalgrange(I);
[4f461c]643  setring D;
644  dbprint(ppl-1,"// Computing in " + string(n+r) + "-th Weyl algebra:", D);
645  dbprint(ppl-1,"// The Malgrange ideal: ", IF);
646  // step 2: compute the b-function of the Malgrange ideal w.r.t. approriate weights
647  intvec w = 1:r;
648  w[r+n] = 0;
649  dbprint(ppl,"// Computing the b-function of the Malgrange ideal...");
650  list L = bfctIdeal(IF,w,whicheng,whichord);
651  dbprint(ppl,"// ... done.");
652  dbprint(ppl-1,"// The b-function: ",L);
653  // step 3: shift the result
654  ring S = 0,s,dp;
655  list L = imap(D,L);
656  kill D;
657  if (size(L)==2)
658  {
659    ideal B = L[1];
[f52e64]660    ideal BB;
661    int nB = ncols(B);
662    for (i=nB; i>0; i--)
[4f461c]663    {
[f52e64]664      BB[i] = -B[nB-i+1]+c-r-1;
[4f461c]665    }
[f52e64]666    L[1] = BB;
[4f461c]667  }
668  else // should never get here: BS poly has non-rational roots
669  {
670    string str = L[3];
671    L = delete(L,3);
672    str = "poly @b = (" + str + ")*(" + string(fl2poly(L,"s")) + ");";
673    execute(str);
674    poly b = subst(@b,s,-s+c-r-1);
675    L = bFactor(b);
676  }
677  setring save;
678  list L = imap(S,L);
679  return(L);
680}
681example
682{
683  "EXAMPLE:"; echo = 2;
684  ring R = 0,(x,y,z),dp;
685  ideal F = x^2+y^3, z;
686  list L = bfctVarIn(F);
687  L;
688}
689
690static proc smallGenCoDim (ideal I, int Iasgiven)
691{
[f52e64]692  // call from K[x], returns list L
[4f461c]693  // L[1]=I or L[1]=smaller generating set of I
694  // L[2]=codimension(I)
[f52e64]695  int ppl = printlevel - voice + 2;
[4f461c]696  int n = nvars(basering);
697  int c;
698  if (attrib(I,"isSB") == 1)
699  {
700    c = n - dim(I);
701    if (!Iasgiven)
702    {
703      list L = mstd(I);
704    }
705  }
706  else
707  {
708    def save = basering;
709    list RL = ringlist(save);
710    list @ord;
711    @ord[1] = list("dp", intvec(1:n));
712    @ord[2] = list("C", intvec(0));
713    RL[3] = @ord;
714    kill @ord;
715    if (size(RL)>4) // commutative G-algebra present
716    {
717      RL = RL[1..4];
718    }
719    def R = ring(RL);
720    kill RL;
721    setring R;
722    ideal I = imap(save,I);
723    if (!Iasgiven)
724    {
725      list L = mstd(I);
726      c = n - dim(L[1]);
727      setring save;
728      list L = imap(R,L);
729    }
730    else
731    {
732      I = std(I);
733      c = n - dim(I);
734      setring save;
735    }
736    kill R;
737  }
738  if (!Iasgiven)
739  {
740    if (size(L[2]) < size(I))
741    {
742      I = L[2];
743      dbprint(ppl,"// Found smaller generating set of the given variety: ", I);
744    }
745    else
746    {
747      dbprint(ppl,"// Have not found smaller generating set of the given variety.");
748    }
749  }
750  dbprint(ppl-1,"// The codim of the given variety is " + string(c) + ".");
751  if (!defined(L))
752  {
753    list L;
754  }
755  L[1] = I;
756  L[2] = c;
757  return(L);
758}
759
[f52e64]760/*
[4f461c]761// Some more examples
762
763static proc TXcups()
764{
[f52e64]765"EXAMPLE:"; echo = 2;
766//TX tangent space of X=V(x^2+y^3)
767ring R = 0,(x0,x1,y0,y1),Dp;
768ideal F = x0^2+y0^3, 2*x0*x1+3*y0^2*y1;
769printlevel = 0;
770//ORD = "(a(1,1),a(1,1,1,1,1,1),dp)";
771//eng = 0;
772def A = SannfsVar(F);
773setring A;
774LD;
[4f461c]775}
776
777static proc ex47()
778{
[f52e64]779ring r7 = 0,(x0,x1,y0,y1),dp;
780ideal I = x0^2+y0^3, 2*x0*x1+3*y0^2*y1;
781bfctVarIn(I);
782// second ex - too big
783ideal J = x0^4+y0^5, 4*x0^3*x1+5*y0^4*y1;
784bfctVarIn(J);
[4f461c]785}
786
787static proc ex48()
788{
[f52e64]789ring r8 = 0,(x1,x2,x3),dp;
790ideal I = x1^3-x2*x3, x2^2-x1*x3, x3^2-x1^2*x2;
791bfctVarIn(I);
[4f461c]792}
793
794static proc ex49 ()
795{
[f52e64]796ring r9 = 0,(z1,z2,z3,z4),dp;
797ideal I = z3^2-z2*z4, z2^2*z3-z1*z4, z2^3-z1*z3;
798bfctVarIn(I);
[4f461c]799}
800
801static proc ex410()
802{
[f52e64]803LIB "toric.lib";
804ring r = 0,(z(1..7)),dp;
805intmat A[3][7];
806A = 6,4,2,0,3,1,0,0,1,2,3,0,1,0,0,0,0,0,1,1,2;
807ideal I = toric_ideal(A,"pt");
808I = std(I);
[4f461c]809//ideal I = z(6)^2-z(3)*z(7), z(5)*z(6)-z(2)*z(7), z(5)^2-z(1)*z(7),
810//  z(4)*z(5)-z(3)*z(6), z(3)*z(5)-z(2)*z(6), z(2)*z(5)-z(1)*z(6),
811//  z(3)^2-z(2)*z(4), z(2)*z(3)-z(1)*z(4), z(2)^2-z(1)*z(3);
[f52e64]812bfctVarIn(I,1); // no result yet
[4f461c]813}
[f52e64]814*/
Note: See TracBrowser for help on using the repository browser.