source: git/Singular/LIB/dmodvar.lib @ 7f9ca3

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