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

spielwiese
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
Line 
1////////////////////////////////////////////////////////////////////////
2version="$Id$";
3category="Noncommutative";
4info="
5LIBRARY: dmodvar.lib     Algebraic D-modules for varieties
6
7AUTHORS: Daniel Andres,        daniel.andres@math.rwth-aachen.de
8@*       Viktor Levandovskyy,  levandov@math.rwth-aachen.de
9@*       Jorge Martin-Morales, jorge@unizar.es
10
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}.
18@* One is interested in the following data:
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.
25
26References:
27   (BMS06) Budur, Mustata, Saito: Bernstein-Sato polynomials of arbitrary varieties (2006).
28@* (ALM09) Andres, Levandovskyy, Martin-Morales: Principal Intersection and Bernstein-Sato
29Polynomial of an Affine Variety (2009).
30
31
32PROCEDURES:
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]
37
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;
41Weyl algebra; parametric annihilator for variety; Budur-Mustata-Saito approach; initial ideal approach
42";
43
44/*
45// Static procs:
46// coDim(I);           compute the codimension of the leading ideal of I
47// dmodvarAssumeViolation()
48// ORDstr2list (ORD, NN)
49// smallGenCoDim(I,k)
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*/
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{
71  example makeMalgrange;
72  example bfctVarIn;
73  example bfctVarAnn;
74  example SannfsVar;
75}
76//   example coDim;
77
78///////////////////////////////////////////////////////////////////////////////
79
80static proc dmodvarAssumeViolation()
81{
82  // char K = 0, no qring
83  if (  (size(ideal(basering)) >0) || (char(basering) >0) )
84  {
85    ERROR("Basering is inappropriate: characteristic>0 or qring present");
86  }
87  return();
88}
89
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
108// da: in smallGenCoDim(), rewritten using mstd business
109static proc coDim (ideal I)
110  "USAGE:  coDim (I);  I an ideal
111RETURN:  int
112PURPOSE: computes the codimension of the ideal generated by the leading monomials
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.
115NOTE:    The codimension of an ideal I means the number of variables minus the
116   Krull dimension of the basering modulo I.
117EXAMPLE: example coDim; shows examples
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 #)
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.
161EXAMPLE: example SannfsVar; shows examples
162"
163{
164  dmodvarAssumeViolation();
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  {
228    RName[i] = safeVarName("Dt("+string(i)+")","cv");
229    for (j=1; j<=P; j++)
230    {
231      RName[P+(i-1)*P+j] = safeVarName("s("+string(i)+")("+string(j)+")","cv");
232    }
233  }
234  // now, create the names for new vars
235  list DName;
236  for(i=1; i<=N; i++)
237  {
238    DName[i] = safeVarName("D"+Name[i],"cv");  //concat
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
260        //         @D[k,P+(i-1)*P+j] = (j==k)*Dt(i);
261        @D[k,P+(i-1)*P+j] = (j==k)*var(i);
262        for (l=1; l<=P; l++)
263        {
264          if ( (i-k)*P < l-j )
265          {
266            //[sij,skl] = djk*sil - dil*skj
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);
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    {
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);
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    {
302      //       q = Dt(j);
303      q = var(j);
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 ----------
310  dbprint(ppl,"// -1-2- starting the elimination of Dt(i) in @R");
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;
369  A;
370  LD;
371}
372
373proc bfctVarAnn (ideal F, list #)
374  "USAGE:  bfctVarAnn(F[,gid,eng]); F an ideal, gid,eng optional ints
375RETURN:  list of an ideal and an intvec
376PURPOSE: computes the roots of the Bernstein-Sato polynomial and their multiplicities
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).
391DISPLAY: If printlevel=1, progress debug messages will be printed,
392@* if printlevel=2, all the debug messages will be printed.
393EXAMPLE: example bfctVarAnn; shows examples
394"
395{
396  dmodvarAssumeViolation();
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      {
413        eng = int(#[2]);
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;
426  int sF = size(F); // no 0 in F
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;
440  for (i=1; i<=sF; i++)
441  {
442    //     S = S + s(i)(i);
443    S = S + var((i-1)*sF+i);
444  }
445  dbprint(ppl,"// -4-1- computing the minimal polynomial of S");
446  dbprint(ppl-1,"S = "+string(S));
447  vector M = pIntersect(S,K);
448  dbprint(ppl,"// -4-2- the minimal polynomial has been computed");
449  ring @R3 = 0,s,dp;
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");
454  dbprint(ppl-1,cd);
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;
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
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
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  {
512    TName[i] = safeVarName("t("+string(i)+")","cv");
513    DTName[i] = safeVarName("Dt("+string(i)+")","cv");
514  }
515  //now, create the names for new vars
516  list DName;
517  for (i=1; i<=N; i++)
518  {
519    DName[i] = safeVarName("D"+Name[i],"cv");  //concat
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@;
530  def @R = Weyl();
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  {
540    //     I[j] = t(j) - F[j];
541    I[j] = var(j) - F[j];
542  }
543  poly p,q;
544  for (i=1; i<=N; i++)
545  {
546    p=0;
547    for (j=1; j<=P; j++)
548    {
549      //       q = Dt(j);
550      q = var(P+N+j);
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;
566  def W = makeMalgrange(I);
567  setring W;
568  W;
569  IF;
570}
571
572proc bfctVarIn (ideal I, list #)
573  "USAGE:  bfctVarIn(I [,a,b,c]);  I an ideal, a,b,c optional ints
574RETURN:  list of ideal and intvec
575PURPOSE: computes the roots of the Bernstein-Sato polynomial and their
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.
580NOTE:    In the output list, say L,
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).
596DISPLAY: If printlevel=1, progress debug messages will be printed,
597@* if printlevel>=2, all the debug messages will be printed.
598EXAMPLE: example bfctVarIn; shows examples
599"
600{
601  dmodvarAssumeViolation();
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      {
620        whicheng = int(#[2]);
621      }
622      if (size(#)>2)
623      {
624        if (typeof(#[3])=="int" || typeof(#[3])=="number")
625        {
626          whichord = int(#[3]);
627        }
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);
642  def D = makeMalgrange(I);
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];
660    ideal BB;
661    int nB = ncols(B);
662    for (i=nB; i>0; i--)
663    {
664      BB[i] = -B[nB-i+1]+c-r-1;
665    }
666    L[1] = BB;
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{
692  // call from K[x], returns list L
693  // L[1]=I or L[1]=smaller generating set of I
694  // L[2]=codimension(I)
695  int ppl = printlevel - voice + 2;
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
760/*
761// Some more examples
762
763static proc TXcups()
764{
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;
775}
776
777static proc ex47()
778{
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);
785}
786
787static proc ex48()
788{
789ring r8 = 0,(x1,x2,x3),dp;
790ideal I = x1^3-x2*x3, x2^2-x1*x3, x3^2-x1^2*x2;
791bfctVarIn(I);
792}
793
794static proc ex49 ()
795{
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);
799}
800
801static proc ex410()
802{
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);
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);
812bfctVarIn(I,1); // no result yet
813}
814*/
Note: See TracBrowser for help on using the repository browser.