source: git/Singular/LIB/absfact.lib @ a088613

spielwiese
Last change on this file since a088613 was a088613, checked in by Martin Lee <martinlee84@…>, 11 years ago
chg: renamed absBiFactorize to absFactorizeBCG
  • Property mode set to 100644
File size: 24.2 KB
Line 
1////
2version="version absfact.lib 4.0.0.0 Jun_2013 "; // $Id$
3category="Factorization";
4info="
5LIBRARY: absfact.lib   Absolute factorization for characteristic 0
6AUTHORS: Wolfram Decker,       decker at math.uni-sb.de
7         Gregoire Lecerf,      lecerf at math.uvsq.fr
8         Gerhard Pfister,      pfister at mathematik.uni-kl.de
9         Martin Lee,           mlee at mathematik.uni-kl.de
10
11OVERVIEW:
12A library for computing the absolute factorization of multivariate
13polynomials f with coefficients in a field K of characteristic zero.
14Using Trager's idea, the implemented algorithm computes an absolutely
15irreducible factor by factorizing over some finite extension field L
16(which is chosen such that V(f) has a smooth point with coordinates in L).
17Then a minimal extension field is determined making use of the
18Rothstein-Trager partial fraction decomposition algorithm.
19absFactorizeBCG uses the algorithm of Bertone, Cheze and Galligo for bivariate
20polynomials and similar ideas as above to reduce to this case.
21
22REFERENCES:
23G. Cheze, G. Lecerf: Lifting and recombination techniques for absolute
24                  factorization. Journal of Complexity, 23(3):380-420, 2007.
25C. Bertone, G. Cheze, and A. Galligo: Modular las vegas algorithms for
26                  polynomial absolute factorization. J. Symb. Comput.,
27                  45(12):1280-1295, December 2010
28
29KEYWORDS: factorization; absolute factorization.
30SEE ALSO: factorize
31
32PROCEDURES:
33  absFactorize();        absolute factorization of poly
34  absFactorizeBCG();     absolute factorization of poly
35";
36
37////////////////////////////////////////////////////////////////////
38static proc partialDegree(poly p, int i)
39"USAGE:  partialDegree(p,i);   p poly, i int
40RETURN: int, the degree of p in the i-th variable
41"
42{
43  int n = nvars(basering);
44  intvec tmp;
45  tmp[n] = 0;
46  tmp[i] = 1;
47  return(deg(p,tmp));
48}
49////////////////////////////////////////////////////////////////////
50static proc belongTo(string s, list l)
51"USAGE:  belongTo(s,l);   s string, l list
52RETURN: 1 if s belongs to l, 0 otherwise
53"
54{
55  string tmp;
56  for(int i = 1; i <= size(l); i++) {
57    tmp = l[i];
58    if (tmp == s) {
59      return(1);
60    }
61  }
62  return(0);
63}
64////////////////////////////////////////////////////////////////////
65static proc variableWithSmallestPositiveDegree(poly p)
66"USAGE:  variableWithSmallestPositiveDegree(p);  p poly
67RETURN: int;  0 if p is constant. Otherwise, the index of the
68        variable which has the smallest positive degree in p.
69"
70{
71  int n = nvars(basering);
72  int v = 0;
73  int d = deg(p);
74  int d_loc;
75  for(int i = 1; i <= n; i++) {
76    d_loc = partialDegree(p, i);
77    if (d_loc >= 1 and d_loc <= d) {
78      v = i;
79      d = d_loc;
80    }
81  }
82  return(v);
83}
84////////////////////////////////////////////////////////////////////
85static proc smallestProperSimpleFactor(poly p)
86"USAGE:  smallestProperSimpleFactor(p);   p poly
87RETURN: poly:  a proper irreducible simple factor of p of smallest
88        degree. If no such factor exists, 0 is returned.
89"
90{
91  list p_facts = factorize(p);
92  int s = size(p_facts[1]);
93  int d = deg(p)+1;
94  poly q = 0;
95  poly f;
96  int e;
97  for(int i = 1; i <= s; i++)
98  {
99    f = p_facts[1][i];
100    e = deg(f);
101    if (e >= 1 and e < d and p_facts[2][i] == 1)
102    {
103      q = f / leadcoef(f);
104      d = e;
105    }
106  }
107  return(q);
108}
109////////////////////////////////////////////////////////////////////
110static proc smallestProperFactor(poly p)
111"USAGE:  smallestProperFactor(p);   p poly
112RETURN: poly:  a proper irreducible factor of p of smallest degree.
113        If p is constant, 0 is returned.
114"
115{
116  list p_facts = factorize(p);
117  int s = size(p_facts[1]);
118  int d = deg(p)+1;
119  poly q = 0;
120  poly f;
121  int e;
122  for(int i = 1; i <= s; i++)
123  {
124    f = p_facts[1][i];
125    e = deg(f);
126    if (e >= 1 and e < d)
127    {
128      q = f / leadcoef(f);
129      d = e;
130    }
131  }
132  return(q);
133}
134////////////////////////////////////////////////////////////////////
135static proc extensionContainingSmoothPoint(poly p, int m)
136"USAGE:  extensionContainingSmoothPoint(p,m);  p poly, m int
137RETURN: poly:  an irreducible univariate polynomial that defines an
138        algebraic extension of the current ground field that contains
139        a smooth point of the hypersurface defined by p=0.
140"
141{
142  int n = nvars(basering) - 1;
143  poly q = 0;
144  int i;
145  list a;
146  for(i=1;i<=n+1;i++){a[i] = 0;}
147  a[m] = var(n+1);
148  // The list a is to be taken with random entries in [-e, e].
149  // Every 10 * n trial, e is incremented by 1.
150  int e = 1;
151  int nbtrial = 0;
152  map h;
153  while (q == 0)
154  {
155    h = basering, a[1..n+1];
156    q = smallestProperSimpleFactor(h(p));
157    for(i = 1; i  <= n ; i = i + 1)
158    {
159      if (i != m)
160      {
161        a[i] = random(-e, e);
162      }
163    }
164    nbtrial++;
165    if (nbtrial >= 10 * n)
166    {
167      e = e + 1;
168      nbtrial = 0;
169    }
170  }
171  return(q);
172}
173////////////////////////////////////////////////////////////////////
174static proc RothsteinTragerResultant(poly g, poly f, int m)
175"USAGE:  RothsteinTragerResultant(g,f,m);  g,f poly, m int
176RETURN: poly
177NOTE:   To be called by the RothsteinTrager procedure only.
178"
179{
180  def MPz = basering;
181  int n = nvars(MPz) - 1;
182  int d = partialDegree(f, m);
183  poly df = diff(f, var(m));
184  list a;
185  int i;
186  for(i=1;i<=n+1;i++){ a[i] = 0; }
187  a[m] = var(m);
188  poly q = 0;
189  int e = 1;
190  int nbtrial = 0;
191  map h;
192  while (q == 0)
193  {
194    h = MPz, a[1..n+1];
195    q = resultant(h(f), h(df) * var(n+1) - h(g), var(m));
196    if (deg(q) == d)
197    {
198      return(q/leadcoef(q));
199    }
200    q = 0;
201    for(i = 1; i  <= n ; i++)
202    {
203      if (i != m)
204      {
205        a[i] = random(-e, e);
206      }
207    }
208    nbtrial++;
209    if (nbtrial >= 10 * n)
210    {
211      e++;
212      nbtrial = 0;
213    }
214  }
215}
216////////////////////////////////////////////////////////////////////
217static proc RothsteinTrager(list g, poly p, int m, int expectedDegQ)
218"USAGE:  RothsteinTrager(g,p,m,d);  g list, p poly, m,d int
219RETURN: list L consisting of two entries of type poly
220NOTE:   the return value is the Rothstein-Trager partial fraction
221        decomposition of the quotient s/p, where s is a generic linear
222        combination of the elements of g. The genericity via d
223        (the expected degree of L[1]).
224"
225{
226  def MPz = basering;
227  int n = nvars(MPz) - 1;
228  poly dp = diff(p, var(m));
229  int r = size(g);
230  list a;
231  int i;
232  for(i=1;i<=r;i++){a[i] = 0;}
233  a[r] = 1;
234  int nbtrial = 0;
235  int e = 1;
236  poly s;
237  poly q;
238  while (1)
239  {
240    s = 0;
241    for(i = 1; i <= r; i++){s = s + a[i] * g[i];}
242    q = RothsteinTragerResultant(s, p, m);
243    q = smallestProperFactor(q);
244    if (deg(q) == expectedDegQ)
245    {
246      // Go into the quotient by q(z)=0
247      ring MP_z = (0,var(n+1)), (x(1..n)), dp;
248      list lMP_z = ringlist(MP_z);
249      lMP_z[1][4] = ideal(imap(MPz,q));
250      list tmp = ringlist(MPz)[2];
251      lMP_z[2] = list(tmp[1..n]);
252      def MPq = ring(lMP_z);
253      setring(MPq);
254      poly f = gcd(imap(MPz, p), par(1) * imap(MPz, dp) - imap(MPz, s));
255      f = f / leadcoef(f);
256      setring(MPz);
257      return(list(q, imap(MPq, f)));
258    }
259    for(i = 1; i  <= r ; i++)
260    {
261      a[i] = random(-e, e);
262    }
263    nbtrial++;
264    if (nbtrial >= 10 * r)
265    {
266      e++;
267      nbtrial = 0;
268    }
269  }
270}
271////////////////////////////////////////////////////////////////////
272static proc absFactorizeIrreducible(poly p)
273"USAGE:   absFactorizeIrreducible(p);   p poly
274ASSUME:  p is an irreducible polynomial that does not depend on the last
275         variable @z of the basering.
276RETURN:  list L of two polynomials: q=L[1] is an irreducible polynomial of
277         minimal degree in @z such that p has an absolute factor
278         over K[@z]/<q>, and f represents such an absolute factor.
279"
280{
281  int dblevel = printlevel - voice + 2;
282  dbprint(dblevel,"Entering absfact.lib::absFactorizeIrreducible with ",p);
283  def MPz = basering;
284  int d = deg(p);
285  int n = nvars(MPz) - 1;
286
287  if (d < 1)
288  {
289    return(list(var(n+1), p));
290  }
291  int m = variableWithSmallestPositiveDegree(p);
292  // var(m) is now considered as the main variable.
293
294  poly q = extensionContainingSmoothPoint(p, m);
295  int r = deg(q);
296  if (r == 1)
297  {
298    return(list(var(n+1), p));
299  }
300
301  list tmp = ringlist(MPz)[2];
302  // Go into the quotient by q(z)=0
303  ring MP_z = (0,var(n+1)), (x(1..n)), dp;
304  list lMP_z = ringlist(MP_z);
305  lMP_z[1][4] = ideal(imap(MPz,q));
306  lMP_z[2] = list(tmp[1..n]);
307  def MPq = ring(lMP_z);
308  setring(MPq);
309  dbprint(dblevel-1,"Factoring in algebraic extension");
310  // "Factoring p in the algebraic extension...";
311  poly p_loc = imap(MPz, p);
312  poly f = smallestProperSimpleFactor(p_loc);
313  int degf = deg(f);
314
315  if (degf == d)
316  {
317    setring(MPz);
318    return(list(var(n+1), p));
319  }
320
321  if (degf * r == d)
322  {
323    setring(MPz);
324    return(list(q, imap(MPq, f)));
325  }
326  dbprint(dblevel-1,"Absolutely irreducible factor found");
327  dbprint(dblevel,"Minimizing field extension");
328  // "Need to find a minimal extension";
329  poly co_f = p_loc / f;
330  poly e = diff(f, var(m)) * co_f;
331  setring(MPz);
332  poly e = imap(MPq, e);
333  list g;
334  int i;
335  for(i = 1; i <= r; i++)
336  {
337    g[i] = subst(e, var(n+1), 0);
338    e = diff(e, var(n+1));
339  }
340  return(RothsteinTrager(g, p, m, d div degf));
341}
342
343////////////////////////////////////////////////////////////////////
344proc absFactorize(poly p, list #)
345"USAGE:  absFactorize(p [,s]);   p poly, s string
346ASSUME: coefficient field is the field of rational numbers or a
347        transcendental extension thereof
348RETURN: ring @code{R} which is obtained from the current basering
349        by adding a new parameter (if a string @code{s} is given as a
350        second input, the new parameter gets this string as name). The ring
351        @code{R} comes with a list @code{absolute_factors} with the
352        following entries:
353@format
354    absolute_factors[1]: ideal   (the absolute factors)
355    absolute_factors[2]: intvec  (the multiplicities)
356    absolute_factors[3]: ideal   (the minimal polynomials)
357    absolute_factors[4]: int     (total number of nontriv. absolute factors)
358@end format
359        The entry @code{absolute_factors[1][1]} is a constant, the
360        entry @code{absolute_factors[3][1]} is the parameter added to the
361        current ring.@*
362        Each of the remaining entries @code{absolute_factors[1][j]} stands for
363        a class of conjugated absolute factors. The corresponding entry
364        @code{absolute_factors[3][j]} is the minimal polynomial of the
365        field extension over which the factor is minimally defined (its degree
366        is the number of conjugates in the class). If the entry
367        @code{absolute_factors[3][j]} coincides with @code{absolute_factors[3][1]},
368        no field extension was necessary for the @code{j}th (class of)
369        absolute factor(s).
370NOTE:   All factors are presented denominator- and content-free. The constant
371        factor (first entry) is chosen such that the product of all (!) the
372        (denominator- and content-free) absolute factors of @code{p} equals
373        @code{p / absolute_factors[1][1]}.
374SEE ALSO: factorize, absPrimdecGTZ
375EXAMPLE: example absFactorize; shows an example
376"
377{
378  int dblevel = printlevel - voice + 2;
379  dbprint(dblevel,"Entering absfact.lib::absFactorize with ",p);
380  def MP = basering;
381  int i;
382  if (char(MP) != 0)
383  {
384    ERROR("// absfact.lib::absFactorize is only implemented for "+
385          "characteristic 0");
386  }
387  if(minpoly!=0)
388  {
389    ERROR("// absfact.lib::absFactorize is not implemented for algebraic "
390          +"extensions");
391  }
392
393  int n = nvars(MP);
394  int pa=npars(MP);
395  list lMP= ringlist(MP);
396  list buflMP= lMP;
397  intvec vv,vk;
398  for(i=1;i<=n;i++){vv[i]=1;}
399  vk=vv,1;
400
401  //if the basering has parameters, add the parameters to the variables
402  //takes care about coefficients and possible denominators
403  if(pa>0)
404  {
405    poly qh=cleardenom(p);
406    if (p==0)
407    {
408      number cok=0;
409    }
410    else
411    {
412      number cok=leadcoef(p)/leadcoef(qh);
413    }
414    p=qh;
415    string sp;
416    for(i=1;i<=npars(basering);i++)
417    {
418      sp=string(par(i));
419      sp=sp[2..size(sp)-1];
420      lMP[2][n+i]=sp;
421      vv=vv,1;
422    }
423    lMP[1]=0;
424    n=n+npars(MP);
425  }
426
427  // MPz is obtained by adding the new variable @z to MP
428  // ordering is wp(1...1)
429  // All the above subroutines work in MPz
430  string newvar;
431  if(size(#)>0)
432  {
433    if(typeof(#[1])=="string")
434    {
435      newvar=#[1];
436    }
437    else
438    {
439      newvar = "a";
440    }
441  }
442  else
443  {
444    newvar = "a";
445  }
446  if (newvar=="a")
447  {
448    if(belongTo(newvar, lMP[2])||defined(a)){newvar = "b";}
449    if(belongTo(newvar, lMP[2])||defined(b)){newvar = "c";}
450    if(belongTo(newvar, lMP[2])||defined(c)){newvar = "@c";}
451    while(belongTo(newvar, lMP[2]))
452    {
453       newvar = "@" + newvar;
454    }
455  }
456  lMP[2][n+1] = newvar;
457
458  // new ordering
459  vv=vv,1;
460  list orst;
461  orst[1]=list("wp",vv);
462  orst[2]=list("C",0);
463  lMP[3]=orst;
464
465  def MPz = ring(lMP);
466  setring(MPz);
467  poly p=imap(MP,p);
468
469  // special treatment in the homogeneous case, dropping one variable
470  // by substituting the first variable by 1
471  int ho=homog(p);
472  if(ho)
473  {
474    int dh=deg(p);
475    p=subst(p,var(1),1);
476    int di=deg(p);
477  }
478  list rat_facts = factorize(p);
479  int s = size(rat_facts[1]);
480  list tmpf; // absolute factors
481  intvec tmpm; // respective multiplicities
482  tmpf[1] = list(var(n+1), leadcoef(imap(MP,p)));
483  tmpm[1] = 1;
484  poly tmp;
485  for(i = 2; i <= s; i++)
486  {
487    tmp = rat_facts[1][i];
488    tmp = tmp / leadcoef(tmp);
489    tmpf[i] = absFactorizeIrreducible(tmp);
490    tmpm[i] = rat_facts[2][i];
491  }
492  // the homogeneous case, homogenizing the result
493  // the new variable has to have degree 0
494  // need to change the ring
495  if(ho)
496  {
497    list ll=ringlist(MPz);
498    vv[size(vv)]=0;
499    ll[3][1][2]=vv;
500    def MPhelp=ring(ll);
501    setring(MPhelp);
502    list tmpf=imap(MPz,tmpf);
503    for(i=2;i<=size(tmpf);i++)
504    {
505      tmpf[i][2]=homog(tmpf[i][2],var(1));
506    }
507    if(dh>di)
508    {
509      tmpf[size(tmpf)+1]=list(var(n+1),var(1));
510      tmpm[size(tmpm)+1]=dh-di;
511    }
512    setring(MPz);
513    tmpf=imap(MPhelp,tmpf);
514  }
515  // in case of parameters we have to go back to the old ring
516  // taking care about constant factors
517  if(pa)
518  {
519    setring(MP);
520    n=nvars(MP);
521    list lM=ringlist(MP);
522    orst[1]=list("wp",vk);
523    orst[2]=list("C",0);
524    lM[2][n+1] = newvar;
525    lM[3]=orst;
526    def MPout=ring(lM);
527    setring(MPout);
528    list tmpf=imap(MPz,tmpf);
529    number cok=imap(MP,cok);
530    tmpf[1][2]=cok*tmpf[1][2];
531  }
532  else
533  {
534    def MPout=MPz;
535  }
536  // if we want the output as string
537  if(size(#)>0)
538  {
539    if(typeof(#[1])=="int")
540    {
541      if(#[1]==77)
542      {  // undocumented feature for Gerhard's absPrimdecGTZ
543        if (size(tmpf)<2){ list abs_fac = list(var(n+1),poly(1)); }
544        else { list abs_fac=tmpf[2..size(tmpf)]; }
545        abs_fac=abs_fac,newvar;
546        return(string(abs_fac));
547      }
548    }
549  }
550  // preparing the output for SINGULAR standard
551  // a list: factors(ideal),multiplicities(intvec),minpolys(ideal),
552  // number of factors in the absolute factorization
553  // the output(except the coefficient) should have no denominators
554  // and no content
555  ideal facts,minpols;
556  intvec mults;
557  int nfacts;
558  number co=1;
559  minpols[1]=tmpf[1][1];
560  facts[1]=tmpf[1][2];     //the coefficient
561  for(i=2;i<=size(tmpf);i++)
562  {
563    minpols[i]=cleardenom(tmpf[i][1]);
564    facts[i]=cleardenom(tmpf[i][2]);
565    co=co*(leadcoef(tmpf[i][2])/leadcoef(facts[i]))^(deg(minpols[i])*tmpm[i]);
566  }
567  facts[1]=facts[1]*co;
568  for(i=1;i<=size(tmpm);i++)
569  {
570    mults[i]=tmpm[i];
571  }
572  for(i=2;i<=size(mults);i++)
573  {
574    nfacts=nfacts+mults[i]*deg(minpols[i]);
575  }
576  list absolute_factors=facts,mults,minpols,nfacts;
577
578  // create ring with extra parameter `newvar` for output:
579  setring(MP);
580  list Lout=ringlist(MP);
581  if(!pa)
582  {
583    list Lpar=list(char(MP),list(newvar),list(list("lp",intvec(1))),ideal(0));
584  }
585  else
586  {
587    list Lpar=Lout[1];
588    Lpar[2][size(Lpar[2])+1]=newvar;
589    vv=Lpar[3][1][2];
590    vv=vv,1;
591    Lpar[3][1][2]=vv;
592  }
593  Lout[1]=Lpar;
594  def MPo=ring(Lout);
595  setring(MPo);
596  list absolute_factors=imap(MPout,absolute_factors);
597  export absolute_factors;
598  setring(MP);
599
600  dbprint( printlevel-voice+3,"
601// 'absFactorize' created a ring, in which a list absolute_factors (the
602// absolute factors) is stored.
603// To access the list of absolute factors, type (if the name S was assigned
604// to the return value):
605        setring(S); absolute_factors; ");
606  return(MPo);
607}
608example
609{
610  "EXAMPLE:"; echo = 2;
611  ring R = (0), (x,y), lp;
612  poly p = (-7*x^2 + 2*x*y^2 + 6*x + y^4 + 14*y^2 + 47)*(5x2+y2)^3*(x-y)^4;
613  def S = absFactorize(p) ;
614  setring(S);
615  absolute_factors;
616}
617
618////////////////////////////////////////////////////////////////////////////////
619proc absFactorizeBCG(poly p, list #)
620"USAGE:  absFactorizeBCG(p [,s]);   p poly, s string
621ASSUME: coefficient field is the field of rational numbers or a
622        transcendental extension thereof
623RETURN: ring @code{R} which is obtained from the current basering
624        by adding a new parameter (if a string @code{s} is given as a
625        second input, the new parameter gets this string as name). The ring
626        @code{R} comes with a list @code{absolute_factors} with the
627        following entries:
628@format
629    absolute_factors[1]: ideal   (the absolute factors)
630    absolute_factors[2]: intvec  (the multiplicities)
631    absolute_factors[3]: ideal   (the minimal polynomials)
632    absolute_factors[4]: int     (total number of nontriv. absolute factors)
633@end format
634        The entry @code{absolute_factors[1][1]} is a constant, the
635        entry @code{absolute_factors[3][1]} is the parameter added to the
636        current ring.@*
637        Each of the remaining entries @code{absolute_factors[1][j]} stands for
638        a class of conjugated absolute factors. The corresponding entry
639        @code{absolute_factors[3][j]} is the minimal polynomial of the
640        field extension over which the factor is minimally defined (its degree
641        is the number of conjugates in the class). If the entry
642        @code{absolute_factors[3][j]} coincides with @code{absolute_factors[3][1]},
643        no field extension was necessary for the @code{j}th (class of)
644        absolute factor(s).
645NOTE:   All factors are presented denominator- and content-free. The constant
646        factor (first entry) is chosen such that the product of all (!) the
647        (denominator- and content-free) absolute factors of @code{p} equals
648        @code{p / absolute_factors[1][1]}.
649SEE ALSO: factorize, absPrimdecGTZ, absFactorize
650EXAMPLE: example absFactorizeBCG; shows an example
651"
652{
653  int dblevel = printlevel - voice + 2;
654  dbprint(dblevel,"Entering absfact.lib::absFactorizeBCG with ",p);
655  def MP = basering;
656  int i;
657  if (char(MP) != 0)
658  {
659    ERROR("// absfact.lib::absFactorizeBCG is only implemented for "+
660          "characteristic 0");
661  }
662  if(minpoly!=0)
663  {
664    ERROR("// absfact.lib::absFactorizeBCG is not implemented for algebraic "
665          +"extensions");
666  }
667
668  int n = nvars(MP);
669  int pa=npars(MP);
670  list lMP= ringlist(MP);
671  intvec vv,vk;
672  for(i=1;i<=n;i++){vv[i]=1;}
673  vk=vv,1;
674
675  //if the basering has parameters, add the parameters to the variables
676  //takes care about coefficients and possible denominators
677  if(pa>0)
678  {
679    poly qh=cleardenom(p);
680    if (p==0)
681    {
682      number cok=0;
683    }
684    else
685    {
686      number cok=leadcoef(p)/leadcoef(qh);
687    }
688    p=qh;
689    string sp;
690    for(i=1;i<=npars(basering);i++)
691    {
692      sp=string(par(i));
693      sp=sp[2..size(sp)-1];
694      lMP[2][n+i]=sp;
695      vv=vv,1;
696    }
697    lMP[1]=0;
698    n=n+npars(MP);
699  }
700
701  // MPz is obtained by adding the new variable @z to MP
702  // ordering is wp(1...1)
703  // All the above subroutines work in MPz
704  string newvar;
705  if(size(#)>0)
706  {
707    if(typeof(#[1])=="string")
708    {
709      newvar=#[1];
710    }
711    else
712    {
713      newvar = "a";
714    }
715  }
716  else
717  {
718    newvar = "a";
719  }
720  if (newvar=="a")
721  {
722    if(belongTo(newvar, lMP[2])||defined(a)){newvar = "b";}
723    if(belongTo(newvar, lMP[2])||defined(b)){newvar = "c";}
724    if(belongTo(newvar, lMP[2])||defined(c)){newvar = "@c";}
725    while(belongTo(newvar, lMP[2]))
726    {
727       newvar = "@" + newvar;
728    }
729  }
730
731  // create ring with extra parameter `newvar` for output:
732  setring(MP);
733  list Lout=ringlist(MP);
734  if(!pa)
735  {
736    list Lpar=list(char(MP),list(newvar),list(list("lp",intvec(1))),ideal(0));
737  }
738  else
739  {
740    list Lpar=Lout[1];
741    Lpar[2][size(Lpar[2])+1]=newvar;
742    vv=Lpar[3][1][2];
743    vv=vv,1;
744    Lpar[3][1][2]=vv;
745  }
746  Lout[1]=Lpar;
747  def MPo=ring(Lout);
748  setring(MPo);
749
750  poly p=imap(MP,p);
751
752  // special treatment in the homogeneous case, dropping one variable
753  // by substituting the first variable by 1
754  int ho=homog(p);
755  if(ho)
756  {
757    int dh=deg(p);
758    p=subst(p,var(1),1);
759    int di=deg(p);
760  }
761
762  list tmpf=system ("absFact", p);
763
764  // the homogeneous case, homogenizing the result
765  // the new variable has to have degree 0
766  // need to change the ring
767  if(ho)
768  {
769    list ll=ringlist(MPo);
770    vv[size(vv)]=0;
771    ll[3][1][2]=vv;
772    def MPhelp=ring(ll);
773    setring(MPhelp);
774    list tmpf=imap(MPo,tmpf);
775    for(i=2;i<=size(tmpf[1]);i++)
776    {
777      tmpf[1][i]=homog(tmpf[1][i],var(1));
778    }
779    if(dh>di)
780    {
781      tmpf[1][size(tmpf[1])+1]=var(1);
782      tmpf[2][size(tmpf[2])+1]=dh-di;
783      tmpf[3][size(tmpf[3])+1]=par(npars(MPo));
784      tmpf[4]= tmpf[4]+dh-di;
785    }
786    setring(MPo);
787    tmpf=imap(MPhelp,tmpf);
788  }
789
790  if (pa)
791  {
792    number cok=imap(MP,cok);
793    tmpf[1][1]=cok*tmpf[1][1];
794  }
795
796  // if we want the output as string
797  if(size(#)>0)
798  {
799    if(typeof(#[1])=="int")
800    {
801      if(#[1]==77)
802      {  // undocumented feature for Gerhard's absPrimdecGTZ
803        if (size(tmpf[1])<2){ list abs_fac = list(var(n+1),poly(1)); }
804        else
805        {
806          list abs_fac= tmpf[3][2];
807          abs_fac= abs_fac, tmpf[1][2];
808          for (i= 3; i <= size(tmpf[1]); i++)
809          {
810            abs_fac=abs_fac,tmpf[3][i];
811            abs_fac=abs_fac,tmpf[1][i];
812          }
813        }
814        abs_fac=abs_fac,newvar;
815        return(string(abs_fac));
816      }
817    }
818  }
819
820  list absolute_factors= tmpf;
821  export absolute_factors;
822  setring(MP);
823
824  dbprint( printlevel-voice+3,"
825// 'absFactorizeBCG' created a ring, in which a list absolute_factors (the
826// absolute factors) is stored.
827// To access the list of absolute factors, type (if the name S was assigned
828// to the return value):
829        setring(S); absolute_factors; ");
830  return(MPo);
831}
832example
833{
834  "EXAMPLE:"; echo = 2;
835  ring R = (0), (x,y), lp;
836  poly p = (-7*x^2 + 2*x*y^2 + 6*x + y^4 + 14*y^2 + 47)*(5x2+y2)^3*(x-y)^4;
837  def S = absFactorizeBCG(p) ;
838  setring(S);
839  absolute_factors;
840}
841
842
843/*
844  ring r=0,(x,t),dp;
845  poly p=x^4+(t^3-2t^2-2t)*x^3-(t^5-2t^4-t^2-2t-1)*x^2
846         -(t^6-4t^5+t^4+6t^3+2t^2)*x+(t^6-4t^5+2t^4+4t^3+t^2);
847  def S = absFactorize(p,"s");
848  setring(S);
849  absolute_factors;
850
851  ring r1=(0,a,b),(x,y),dp;
852  poly p=(a3-a2b+27ab3-27b4)/(a+b5)*x2+(a2+27b3)*y;
853  def S = absFactorize(p);
854  setring(S);
855  absolute_factors;
856
857  ring r2=0,(x,y,z,w),dp;
858  poly f=(x2+y2+z2)^2+w4;
859  def S =absFactorize(f);
860  setring(S);
861  absolute_factors;
862
863ring r=0,(x),dp;
864poly p=0;
865def S = absFactorize(p);
866setring(S);
867absolute_factors;
868
869ring r=0,(x),dp;
870poly p=7/11;
871def S = absFactorize(p);
872setring(S);
873absolute_factors;
874
875ring r=(0,a,b),(x,y),dp;
876poly p=0;
877def S = absFactorize(p);
878setring(S);
879absolute_factors;
880
881ring r=(0,a,b),(x,y),dp;
882poly p=(a+1)/b;
883def S = absFactorize(p);
884setring(S);
885absolute_factors;
886
887ring r=(0,a,b),(x,y),dp;
888poly p=(a+1)/b*x;
889def S = absFactorize(p,"s");
890setring(S);
891absolute_factors;
892
893ring r=(0,a,b),(x,y),dp;
894poly p=(a+1)/b*x + 1;
895def S = absFactorize(p,"s");
896setring(S);
897absolute_factors;
898
899ring r=(0,a,b),(x,y),dp;
900poly p=(a+1)/b*x + y;
901def S = absFactorize(p,"s");
902setring(S);
903absolute_factors;
904
905ring r=0,(x,t),dp;
906poly p=x^4+(t^3-2t^2-2t)*x^3-(t^5-2t^4-t^2-2t-1)*x^2
907       -(t^6-4t^5+t^4+6t^3+2t^2)*x+(t^6-4t^5+2t^4+4t^3+t^2);
908def S = absFactorize(p,"s");
909setring(S);
910absolute_factors;
911
912ring r1=(0,a,b),(x,y),dp;
913poly p=(a3-a2b+27ab3-27b4)/(a+b5)*x2+(a2+27b3)*y;
914def S = absFactorize(p);
915setring(S);
916absolute_factors;
917
918ring r2=0,(x,y,z,w),dp;
919poly f=(x2+y2+z2)^2+w4;
920def S =absFactorize(f);
921setring(S);
922absolute_factors;
923
924ring r3=0,(x,y,z,w),dp;
925poly f=(x2+y2+z2)^4+w8;
926def S =absFactorize(f);
927setring(S);
928absolute_factors;
929
930ring r4=0,(x,y),dp;
931poly f=y6-(2x2-2x-14)*y4-(4x3+35x2-6x-47)*y2+14x4-12x3-94x2;
932def S=absFactorize(f);
933setring(S);
934absolute_factors;
935
936ring R1 = 0, x, dp;
937def S1 = absFactorize(x4-2);
938setring(S1);
939absolute_factors;
940
941ring R3 = 0, (x,y), dp;
942poly f = x2y4+y6+2x3y2+2xy4-7x4+7x2y2+14y4+6x3+6xy2+47x2+47y2;
943def S3 = absFactorize(f);
944setring(S3);
945absolute_factors;
946
947ring R4 = 0, (x,y), dp;
948poly f = y4+2*xy2-7*x2+14*y2+6*x+47;
949def S4 = absFactorize(f);
950setring(S4);
951absolute_factors;
952
953*/
Note: See TracBrowser for help on using the repository browser.