source: git/libpolys/polys/clapsing.cc @ cd964c

spielwiese
Last change on this file since cd964c was cd964c, checked in by Hans Schoenemann <hannes@…>, 11 years ago
add: new function singclap_gcd_and_divide
  • Property mode set to 100644
File size: 37.3 KB
RevLine 
[35aab3]1// emacs edit mode for this file is -*- C++ -*-
2/****************************************
3*  Computer Algebra System SINGULAR     *
4****************************************/
5/*
6* ABSTRACT: interface between Singular and factory
7*/
8
[b963c5]9//#define FACTORIZE2_DEBUG
[af598e]10#include "config.h"
11#include <misc/auxiliary.h>
12
[22a09d]13#ifdef HAVE_FACTORY
[35aab3]14#define SI_DONT_HAVE_GLOBAL_VARS
[fea2af]15
[22a09d]16#include <factory/factory.h>
[fea2af]17
[67c1dc]18#ifdef HAVE_LIBFAC
[e65b1a4]19#include <factory/libfac/libfac.h>
[67c1dc]20#endif
[fea2af]21
[22a09d]22
[af598e]23#include <omalloc/omalloc.h>
24#include <coeffs/numbers.h>
25#include <coeffs/coeffs.h>
[24a9587]26#include <coeffs/bigintmat.h>
[af598e]27
28// #include <kernel/ffields.h>
29
30#include "monomials/ring.h"
31#include "simpleideals.h"
[35aab3]32
[9144617]33
[1f414c8]34//#include "polys.h"
35#define TRANSEXT_PRIVATES
36#include "ext_fields/transext.h"
37
[9144617]38
39#include "clapsing.h"
40#include "clapconv.h"
41// #include <kernel/clapconv.h>
[67c1dc]42
[9144617]43
[a86cda]44void out_cf(const char *s1,const CanonicalForm &f,const char *s2);
[35aab3]45
[abb4787]46static poly singclap_gcd_r ( poly f, poly g, const ring r )
[35aab3]47{
48  poly res=NULL;
49
[36586bb]50  assume(f!=NULL);
51  assume(g!=NULL);
52
53  if((pNext(f)==NULL) && (pNext(g)==NULL))
[9b9b5a]54  {
[a934fc8]55    poly p=p_One(r);
[36586bb]56    for(int i=rVar(r);i>0;i--)
57      p_SetExp(p,i,si_min(p_GetExp(f,i,r),p_GetExp(g,i,r)),r);
58    p_Setm(p,r);
59    return p;
[9b9b5a]60  }
[35aab3]61
[ea48f7d]62  Off(SW_RATIONAL);
[ce2576]63  if (rField_is_Q(r) || (rField_is_Zp(r)))
64  {
65    bool b1=isOn(SW_USE_EZGCD_P);
66    Off (SW_USE_NTL_GCD_P);
67    setCharacteristic( rChar(r) );
68    CanonicalForm F( convSingPFactoryP( f,r ) ), G( convSingPFactoryP( g, r ) );
69    res=convFactoryPSingP( gcd( F, G ) , r);
70    if (!b1) Off (SW_USE_EZGCD_P);
71  }
72  // and over Q(a) / Fp(a)
73  else if ( rField_is_Extension(r))
74  {
75    if ( rField_is_Q_a(r)) setCharacteristic( 0 );
76    else                   setCharacteristic( rChar(r) );
[dd668f]77    if (r->cf->extRing->qideal!=NULL)
[ce2576]78    {
79      bool b1=isOn(SW_USE_QGCD);
80      if ( rField_is_Q_a(r) ) On(SW_USE_QGCD);
[dd668f]81      CanonicalForm mipo=convSingPFactoryP(r->cf->extRing->qideal->m[0],
[ce2576]82                                           r->cf->extRing);
83      Variable a=rootOf(mipo);
84      CanonicalForm F( convSingAPFactoryAP( f,a,r ) ),
85                    G( convSingAPFactoryAP( g,a,r ) );
86      res= convFactoryAPSingAP( gcd( F, G ),r );
87      if (!b1) Off(SW_USE_QGCD);
88    }
89    else
90    {
91      CanonicalForm F( convSingTrPFactoryP( f,r ) ), G( convSingTrPFactoryP( g,r ) );
92      res= convFactoryPSingTrP( gcd( F, G ),r );
93    }
94  }
95  else
96    WerrorS( feNotImplemented );
[ea48f7d]97  Off(SW_RATIONAL);
[35aab3]98  return res;
99}
100
[cd964c]101void singclap_gcd_and_divide ( poly& f, poly& g, const ring r)
[91d0e6]102{
103  poly res=NULL;
104
[ce3f53c]105  if (f!=NULL) p_Cleardenom(f, r);
[cd964c]106  if (g!=NULL) p_Cleardenom(g, r);
107  else         return; // g==0 => but do a p_Cleardenom(f)
108  if (f==NULL) return; // f==0 => but do a p_Cleardenom(g)
109
110  Off(SW_RATIONAL);
111  CanonicalForm F,G,GCD;
112  if (rField_is_Q(r) || (rField_is_Zp(r)))
113  {
114    bool b1=isOn(SW_USE_EZGCD_P);
115    Off (SW_USE_NTL_GCD_P);
116    setCharacteristic( rChar(r) );
117    F=convSingPFactoryP( f,r );
118    G=convSingPFactoryP( g,r );
119    GCD=gcd(F,G);
120    if (!GCD.isOne())
121    {
122      p_Delete(&f,r);
123      p_Delete(&g,r);
124      f=convFactoryPSingP( F/GCD, r);
125      g=convFactoryPSingP( G/GCD, r);
126    }
127    if (!b1) Off (SW_USE_EZGCD_P);
128  }
129  // and over Q(a) / Fp(a)
130  else if ( rField_is_Extension(r))
131  {
132    if ( rField_is_Q_a(r)) setCharacteristic( 0 );
133    else                   setCharacteristic( rChar(r) );
134    if (r->cf->extRing->qideal!=NULL)
135    {
136      bool b1=isOn(SW_USE_QGCD);
137      if ( rField_is_Q_a(r) ) On(SW_USE_QGCD);
138      CanonicalForm mipo=convSingPFactoryP(r->cf->extRing->qideal->m[0],
139                                           r->cf->extRing);
140      Variable a=rootOf(mipo);
141      F=( convSingAPFactoryAP( f,a,r ) );
142      G=( convSingAPFactoryAP( g,a,r ) );
143      GCD=gcd(F,G);
144      if (!GCD.isOne())
145      {
146        p_Delete(&f,r);
147        p_Delete(&g,r);
148        f= convFactoryAPSingAP( F/GCD,r );
149        g= convFactoryAPSingAP( G/GCD,r );
150      }
151      if (!b1) Off(SW_USE_QGCD);
152    }
153    else
154    {
155      F=( convSingTrPFactoryP( f,r ) );
156      G=( convSingTrPFactoryP( g,r ) );
157      GCD=gcd(F,G);
158      if (!GCD.isOne())
159      {
160        p_Delete(&f,r);
161        p_Delete(&g,r);
162        f= convFactoryPSingTrP( F/GCD,r );
163        g= convFactoryPSingTrP( G/GCD,r );
164      }
165    }
166  }
167  else
168    WerrorS( feNotImplemented );
169  Off(SW_RATIONAL);
170}
171
172poly singclap_gcd ( poly f, poly g, const ring r)
173{
174  poly res=NULL;
175
176  if (f!=NULL) p_Cleardenom(f, r);             
[ce3f53c]177  if (g!=NULL) p_Cleardenom(g, r);
[f8ace52]178  else         return f; // g==0 => gcd=f (but do a p_Cleardenom)
179  if (f==NULL) return g; // f==0 => gcd=g (but do a p_Cleardenom)
[91d0e6]180
[ce3f53c]181  res=singclap_gcd_r(f,g,r);
182  p_Delete(&f, r);
183  p_Delete(&g, r);
[91d0e6]184  return res;
185}
186
[c95632f]187/*2 find the maximal exponent of var(i) in poly p*/
[ce3f53c]188int pGetExp_Var(poly p, int i, const ring r)
[c95632f]189{
190  int m=0;
191  int mm;
192  while (p!=NULL)
193  {
[ce3f53c]194    mm=p_GetExp(p,i,r);
[c95632f]195    if (mm>m) m=mm;
196    pIter(p);
197  }
198  return m;
199}
200
[9d9078]201// destroys f,g,x
[ce3f53c]202poly singclap_resultant ( poly f, poly g , poly x, const ring r)
[35aab3]203{
[9d9078]204  poly res=NULL;
[ce3f53c]205  int i=p_IsPurePower(x, r);
[35aab3]206  if (i==0)
207  {
208    WerrorS("3rd argument must be a ring variable");
[9d9078]209    goto resultant_returns_res;
[35aab3]210  }
211  if ((f==NULL) || (g==NULL))
[9d9078]212    goto resultant_returns_res;
[ce2576]213  // for now there is only the possibility to handle polynomials over
214  // Q and Fp ...
215  if (rField_is_Zp(r) || rField_is_Q(r))
216  {
217    Variable X(i);
218    setCharacteristic( rChar(r) );
219    CanonicalForm F( convSingPFactoryP( f,r ) ), G( convSingPFactoryP( g,r ) );
220    res=convFactoryPSingP( resultant( F, G, X),r );
[35aab3]221    Off(SW_RATIONAL);
[ce2576]222    goto resultant_returns_res;
[35aab3]223  }
[ce2576]224  // and over Q(a) / Fp(a)
225  else if (rField_is_Extension(r))
226  {
227    if (rField_is_Q_a(r)) setCharacteristic( 0 );
228    else               setCharacteristic( rChar(r) );
229    Variable X(i+rPar(r));
[dd668f]230    if (r->cf->extRing->qideal!=NULL)
[ce2576]231    {
232      //Variable X(i);
[dd668f]233      CanonicalForm mipo=convSingPFactoryP(r->cf->extRing->qideal->m[0],
[ce2576]234                                           r->cf->extRing);
235      Variable a=rootOf(mipo);
236      CanonicalForm F( convSingAPFactoryAP( f,a,r ) ),
237                    G( convSingAPFactoryAP( g,a,r ) );
238      res= convFactoryAPSingAP( resultant( F, G, X ),r );
239    }
240    else
241    {
242      //Variable X(i+rPar(currRing));
243      number nf,ng;
244      p_Cleardenom_n(f,r,nf);p_Cleardenom_n(g,r,ng);
245      int ef,eg;
246      ef=pGetExp_Var(f,i,r);
247      eg=pGetExp_Var(g,i,r);
248      CanonicalForm F( convSingTrPFactoryP( f,r ) ), G( convSingTrPFactoryP( g,r ) );
249      res= convFactoryPSingTrP( resultant( F, G, X ),r );
[a355723]250      if ((nf!=NULL)&&(!n_IsOne(nf,r->cf)))
[ce2576]251      {
252        number n=n_Invers(nf,r->cf);
253        while(eg>0)
254        {
255          res=p_Mult_nn(res,n,r);
256          eg--;
257        }
258        n_Delete(&n,r->cf);
259      }
260      n_Delete(&nf,r->cf);
[a355723]261      if ((ng!=NULL)&&(!n_IsOne(ng,r->cf)))
[ce2576]262      {
263        number n=n_Invers(ng,r->cf);
264        while(ef>0)
265        {
266          res=p_Mult_nn(res,n,r);
267          ef--;
268        }
269        n_Delete(&n,r->cf);
270      }
271      n_Delete(&ng,r->cf);
272    }
273    Off(SW_RATIONAL);
274    goto resultant_returns_res;
275  }
276  else
277    WerrorS( feNotImplemented );
[9d9078]278resultant_returns_res:
[ce3f53c]279  p_Delete(&f,r);
280  p_Delete(&g,r);
281  p_Delete(&x,r);
[9d9078]282  return res;
[35aab3]283}
284//poly singclap_resultant ( poly f, poly g , poly x)
285//{
286//  int i=pVar(x);
287//  if (i==0)
288//  {
289//    WerrorS("ringvar expected");
290//    return NULL;
291//  }
292//  ideal I=idInit(1,1);
293//
294//  // get the coeffs von f wrt. x:
295//  I->m[0]=pCopy(f);
296//  matrix ffi=mpCoeffs(I,i);
297//  ffi->rank=1;
298//  ffi->ncols=ffi->nrows;
299//  ffi->nrows=1;
300//  ideal fi=(ideal)ffi;
301//
302//  // get the coeffs von g wrt. x:
303//  I->m[0]=pCopy(g);
304//  matrix ggi=mpCoeffs(I,i);
305//  ggi->rank=1;
306//  ggi->ncols=ggi->nrows;
307//  ggi->nrows=1;
308//  ideal gi=(ideal)ggi;
309//
310//  // contruct the matrix:
311//  int fn=IDELEMS(fi); //= deg(f,x)+1
312//  int gn=IDELEMS(gi); //= deg(g,x)+1
313//  matrix m=mpNew(fn+gn-2,fn+gn-2);
314//  if(m==NULL)
315//  {
316//    return NULL;
317//  }
318//
319//  // enter the coeffs into m:
320//  int j;
321//  for(i=0;i<gn-1;i++)
322//  {
323//    for(j=0;j<fn;j++)
324//    {
325//      MATELEM(m,i+1,fn-j+i)=pCopy(fi->m[j]);
326//    }
327//  }
328//  for(i=0;i<fn-1;i++)
329//  {
330//    for(j=0;j<gn;j++)
331//    {
332//      MATELEM(m,gn+i,gn-j+i)=pCopy(gi->m[j]);
333//    }
334//  }
335//
336//  poly r=mpDet(m);
337//
338//  idDelete(&fi);
339//  idDelete(&gi);
340//  idDelete((ideal *)&m);
341//  return r;
342//}
343
[ce3f53c]344BOOLEAN singclap_extgcd ( poly f, poly g, poly &res, poly &pa, poly &pb , const ring r)
[35aab3]345{
346  // for now there is only the possibility to handle univariate
347  // polynomials over
348  // Q and Fp ...
349  res=NULL;pa=NULL;pb=NULL;
350  On(SW_SYMMETRIC_FF);
[ce2576]351  if ( rField_is_Q(r) || rField_is_Zp(r) )
[35aab3]352  {
[ce2576]353    setCharacteristic( rChar(r) );
354    CanonicalForm F( convSingPFactoryP( f,r ) ), G( convSingPFactoryP( g,r) );
355    CanonicalForm FpG=F+G;
356    if (!(FpG.isUnivariate()|| FpG.inCoeffDomain()))
357    //if (!F.isUnivariate() || !G.isUnivariate() || F.mvar()!=G.mvar())
358    {
359      Off(SW_RATIONAL);
360      WerrorS("not univariate");
361      return TRUE;
362    }
363    CanonicalForm Fa,Gb;
364    On(SW_RATIONAL);
365    res=convFactoryPSingP( extgcd( F, G, Fa, Gb ),r );
366    pa=convFactoryPSingP(Fa,r);
367    pb=convFactoryPSingP(Gb,r);
368    Off(SW_RATIONAL);
369  }
370  // and over Q(a) / Fp(a)
371  else if ( rField_is_Extension(r))
372  {
373    if (rField_is_Q_a(r)) setCharacteristic( 0 );
374    else                 setCharacteristic( rChar(r) );
375    CanonicalForm Fa,Gb;
[dd668f]376    if (r->cf->extRing->qideal!=NULL)
[ce2576]377    {
[dd668f]378      CanonicalForm mipo=convSingPFactoryP(r->cf->extRing->qideal->m[0],
[ce2576]379                                           r->cf->extRing);
380      Variable a=rootOf(mipo);
381      CanonicalForm F( convSingAPFactoryAP( f,a,r ) ),
382                    G( convSingAPFactoryAP( g,a,r ) );
383      CanonicalForm FpG=F+G;
384      if (!(FpG.isUnivariate()|| FpG.inCoeffDomain()))
385      //if (!F.isUnivariate() || !G.isUnivariate() || F.mvar()!=G.mvar())
386      {
387        WerrorS("not univariate");
388        return TRUE;
389      }
390      res= convFactoryAPSingAP( extgcd( F, G, Fa, Gb ),r );
391      pa=convFactoryAPSingAP(Fa,r);
392      pb=convFactoryAPSingAP(Gb,r);
393    }
394    else
395    {
396      CanonicalForm F( convSingTrPFactoryP( f, r ) ), G( convSingTrPFactoryP( g, r ) );
397      CanonicalForm FpG=F+G;
398      if (!(FpG.isUnivariate()|| FpG.inCoeffDomain()))
399      //if (!F.isUnivariate() || !G.isUnivariate() || F.mvar()!=G.mvar())
400      {
401        Off(SW_RATIONAL);
402        WerrorS("not univariate");
403        return TRUE;
404      }
405      res= convFactoryPSingTrP( extgcd( F, G, Fa, Gb ), r );
406      pa=convFactoryPSingTrP(Fa, r);
407      pb=convFactoryPSingTrP(Gb, r);
408    }
[35aab3]409    Off(SW_RATIONAL);
[ce2576]410  }
411  else
412  {
413    WerrorS( feNotImplemented );
[35aab3]414    return TRUE;
415  }
[a86cda]416#ifndef NDEBUG
417  // checking the result of extgcd:
418  poly dummy;
[ce3f53c]419  dummy=p_Sub(p_Add_q(pp_Mult_qq(f,pa,r),pp_Mult_qq(g,pb,r),r),p_Copy(res,r),r);
[a86cda]420  if (dummy!=NULL)
421  {
[ce3f53c]422    PrintS("extgcd( ");p_Write(f,r);p_Write0(g,r);PrintS(" )\n");
[ce2576]423    PrintS("extgcd( ");p_Write(f,r);p_Write0(g,r);PrintS(" )\n");
[ce3f53c]424    p_Delete(&dummy,r);
[a86cda]425  }
[9d9078]426#endif
[35aab3]427  return FALSE;
428}
429
[ce3f53c]430poly singclap_pdivide ( poly f, poly g, const ring r )
[35aab3]431{
432  poly res=NULL;
433  On(SW_RATIONAL);
[ce2576]434  if (rField_is_Zp(r) || rField_is_Q(r))
435  {
436    setCharacteristic( rChar(r) );
437    CanonicalForm F( convSingPFactoryP( f,r ) ), G( convSingPFactoryP( g,r ) );
438    res = convFactoryPSingP( F / G,r );
439  }
440  else if (rField_is_Extension(r))
441  {
442    if (rField_is_Q_a(r)) setCharacteristic( 0 );
443    else               setCharacteristic( rChar(r) );
[dd668f]444    if (r->cf->extRing->qideal!=NULL)
[ce2576]445    {
[dd668f]446      CanonicalForm mipo=convSingPFactoryP(r->cf->extRing->qideal->m[0],
[ce2576]447                                                 r->cf->extRing);
448      Variable a=rootOf(mipo);
449      CanonicalForm F( convSingAPFactoryAP( f,a,r ) ),
450                    G( convSingAPFactoryAP( g,a,r ) );
451      res= convFactoryAPSingAP(  F / G, r  );
452    }
453    else
454    {
455      CanonicalForm F( convSingTrPFactoryP( f,r ) ), G( convSingTrPFactoryP( g,r ) );
456      res= convFactoryPSingTrP(  F / G,);
457    }
458  }
459  #if 0 // not yet working
460  else if (rField_is_GF())
461  {
462    //Print("GF(%d^%d)\n",nfCharP,nfMinPoly[0]);
463    setCharacteristic( nfCharP,nfMinPoly[0], currRing->parameter[0][0] );
464    CanonicalForm F( convSingGFFactoryGF( f ) ), G( convSingGFFactoryGF( g ) );
465    res = convFactoryGFSingGF( F / G );
466  }
467  #endif
468  else
469    WerrorS( feNotImplemented );
[d1f231]470  Off(SW_RATIONAL);
471  return res;
472}
473
[ce3f53c]474void singclap_divide_content ( poly f, const ring r )
[35aab3]475{
476  if ( f==NULL )
477  {
478    return;
479  }
480  else  if ( pNext( f ) == NULL )
481  {
[ce3f53c]482    p_SetCoeff( f, n_Init( 1, r->cf ), r );
[35aab3]483    return;
484  }
485  else
486  {
[ce3f53c]487    if ( rField_is_Q_a(r) )
[35aab3]488      setCharacteristic( 0 );
[ce3f53c]489    else  if ( rField_is_Zp_a(r) )
490      setCharacteristic( -rChar(r) );
[35aab3]491    else
492      return; /* not implemented*/
493
494    CFList L;
495    CanonicalForm g, h;
496    poly p = pNext(f);
497
498    // first attemp: find 2 smallest g:
499
500    number g1=pGetCoeff(f);
501    number g2=pGetCoeff(p); // p==pNext(f);
502    pIter(p);
[ce3f53c]503    int sz1=n_Size(g1, r->cf);
504    int sz2=n_Size(g2, r->cf);
[35aab3]505    if (sz1>sz2)
506    {
507      number gg=g1;
508      g1=g2; g2=gg;
509      int sz=sz1;
510      sz1=sz2; sz2=sz;
511    }
512    while (p!=NULL)
513    {
[ce3f53c]514      int n_sz=n_Size(pGetCoeff(p),r->cf);
[35aab3]515      if (n_sz<sz1)
516      {
517        sz2=sz1;
518        g2=g1;
519        g1=pGetCoeff(p);
520        sz1=n_sz;
521        if (sz1<=3) break;
522      }
523      else if(n_sz<sz2)
524      {
525        sz2=n_sz;
526        g2=pGetCoeff(p);
527        sz2=n_sz;
528      }
529      pIter(p);
530    }
[7b2b05]531    g = convSingPFactoryP( NUM(((fraction)g1)), r->cf->extRing );
532    g = gcd( g, convSingPFactoryP( NUM(((fraction)g2)) , r->cf->extRing));
[35aab3]533
534    // second run: gcd's
535
536    p = f;
537    while ( (p != NULL) && (g != 1)  && ( g != 0))
538    {
[7b2b05]539      h = convSingPFactoryP( NUM(((fraction)pGetCoeff(p))), r->cf->extRing );
[35aab3]540      pIter( p );
541
542      g = gcd( g, h );
543
544      L.append( h );
545    }
546    if (( g == 1 ) || (g == 0))
547    {
548      // pTest(f);
549      return;
550    }
551    else
552    {
553      CFListIterator i;
554      for ( i = L, p = f; i.hasItem(); i++, p=pNext(p) )
555      {
[7b2b05]556        fraction c=(fraction)pGetCoeff(p);
557        p_Delete(&(NUM(c)),r->cf->extRing); // 2nd arg used to be nacRing
558        NUM(c)=convFactoryPSingP( i.getItem() / g, r->cf->extRing );
[35aab3]559        //nTest((number)c);
560        //#ifdef LDEBUG
561        //number cn=(number)c;
562        //StringSetS(""); nWrite(nt); StringAppend(" ==> ");
[00d2a4]563        //nWrite(cn);PrintS(StringEndS("\n")); // NOTE/TODO: use StringAppendS("\n"); omFree(s);
[35aab3]564        //#endif
565      }
566    }
567    // pTest(f);
568  }
569}
570
[ce3f53c]571BOOLEAN count_Factors(ideal I, intvec *v,int j, poly &f, poly fac, const ring r)
572{
573  p_Test(f,r);
574  p_Test(fac,r);
[0a55e5]575  int e=0;
[ce3f53c]576  if (!p_IsConstantPoly(fac,r))
[0a55e5]577  {
578#ifdef FACTORIZE2_DEBUG
[ce2576]579    printf("start count_Factors(%d), Fdeg=%d, factor deg=%d\n",j,p_Totaldegree(f,r),p_Totaldegree(fac,r));
[1db880]580    p_wrp(fac,r);PrintLn();
[0a55e5]581#endif
582    On(SW_RATIONAL);
583    CanonicalForm F, FAC,Q,R;
584    Variable a;
[ce2576]585    if (rField_is_Zp(r) || rField_is_Q(r))
586    {
587      F=convSingPFactoryP( f,r );
588      FAC=convSingPFactoryP( fac,r );
589    }
590    else if (rField_is_Extension(r))
591    {
[dd668f]592      if (r->cf->extRing->qideal!=NULL)
[ce2576]593      {
[dd668f]594        CanonicalForm mipo=convSingPFactoryP(r->cf->extRing->qideal->m[0],
[ce2576]595                                    r->cf->extRing);
596        a=rootOf(mipo);
597        F=convSingAPFactoryAP( f,a,r );
598        FAC=convSingAPFactoryAP( fac,a,r );
599      }
600      else
601      {
602        F=convSingTrPFactoryP( f,r );
603        FAC=convSingTrPFactoryP( fac,r );
604      }
605    }
606    else
607      WerrorS( feNotImplemented );
[0a55e5]608
609    poly q;
610    loop
611    {
612      Q=F;
613      Q/=FAC;
614      R=Q;
615      R*=FAC;
616      R-=F;
617      if (R.isZero())
618      {
[ce2576]619        if (rField_is_Zp(r) || rField_is_Q(r))
620        {
621          q = convFactoryPSingP( Q,r );
622        }
623        else if (rField_is_Extension(r))
624        {
[dd668f]625          if (r->cf->extRing->qideal!=NULL)
[ce2576]626          {
627            q= convFactoryAPSingAP( Q,r );
628          }
629          else
630          {
631            q= convFactoryPSingTrP( Q,r );
632          }
633        }
[ce3f53c]634        e++; p_Delete(&f,r); f=q; q=NULL; F=Q;
[0a55e5]635      }
636      else
637      {
638        break;
639      }
640    }
641    if (e==0)
642    {
643      Off(SW_RATIONAL);
644      return FALSE;
645    }
646  }
647  else e=1;
648  I->m[j]=fac;
649  if (v!=NULL) (*v)[j]=e;
650  Off(SW_RATIONAL);
651  return TRUE;
652}
653
[cd6df87]654#ifdef HAVE_FACTORY
[a5d9313]655int singclap_factorize_retry;
[5348866]656# ifdef HAVE_LIBFAC
657  extern int libfac_interruptflag;
658# endif
[cd6df87]659#endif
[a5d9313]660
[ce3f53c]661ideal singclap_factorize ( poly f, intvec ** v , int with_exps, const ring r)
[93e7e91]662/* destroys f, sets *v */
[35aab3]663{
[ce3f53c]664  p_Test(f,r);
[0a55e5]665#ifdef FACTORIZE2_DEBUG
[ce2576]666  printf("singclap_factorize, degree %ld\n",p_Totaldegree(f,r));
[0a55e5]667#endif
[35aab3]668  // with_exps: 3,1 return only true factors, no exponents
669  //            2 return true factors and exponents
670  //            0 return coeff, factors and exponents
[ee5d91]671  BOOLEAN save_errorreported=errorreported;
[35aab3]672
673  ideal res=NULL;
674
675  // handle factorize(0) =========================================
676  if (f==NULL)
677  {
678    res=idInit(1,1);
679    if (with_exps!=1)
680    {
681      (*v)=new intvec(1);
682      (**v)[0]=1;
683    }
684    return res;
685  }
686  // handle factorize(mon) =========================================
687  if (pNext(f)==NULL)
688  {
689    int i=0;
690    int n=0;
691    int e;
[ce3f53c]692    for(i=rVar(r);i>0;i--) if(p_GetExp(f,i,r)!=0) n++;
[35aab3]693    if (with_exps==0) n++; // with coeff
694    res=idInit(si_max(n,1),1);
695    switch(with_exps)
696    {
697      case 0: // with coef & exp.
[ce3f53c]698        res->m[0]=p_NSet(n_Copy(pGetCoeff(f),r->cf),r);
[35aab3]699        // no break
700      case 2: // with exp.
[54ff35]701        (*v)=new intvec(si_max(1,n));
[35aab3]702        (**v)[0]=1;
703        // no break
704      case 1: ;
705      #ifdef TEST
706      default: ;
707      #endif
708    }
709    if (n==0)
710    {
[ce3f53c]711      res->m[0]=p_One(r);
[35aab3]712      // (**v)[0]=1; is already done
713    }
[93e7e91]714    else
[35aab3]715    {
[ce3f53c]716      for(i=rVar(r);i>0;i--)
[35aab3]717      {
[ce3f53c]718        e=p_GetExp(f,i,r);
[93e7e91]719        if(e!=0)
720        {
721          n--;
[ce3f53c]722          poly p=p_One(r);
723          p_SetExp(p,i,1,r);
724          p_Setm(p,r);
[93e7e91]725          res->m[n]=p;
726          if (with_exps!=1) (**v)[n]=e;
727        }
[35aab3]728      }
729    }
[ce3f53c]730    p_Delete(&f,r);
[35aab3]731    return res;
732  }
[ce2576]733  //PrintS("S:");p_Write(f,r);PrintLn();
[54ff35]734  // use factory/libfac in general ==============================
[35aab3]735  Off(SW_RATIONAL);
736  On(SW_SYMMETRIC_FF);
737  #ifdef HAVE_NTL
738  extern int prime_number;
[ce3f53c]739  if(rField_is_Q(r)) prime_number=0;
[35aab3]740  #endif
741  CFFList L;
742  number N=NULL;
[ffdd694]743  number NN=NULL;
[ce3f53c]744  number old_lead_coeff=n_Copy(pGetCoeff(f), r->cf);
[35aab3]745
[ce3f53c]746  if (!rField_is_Zp(r) && !rField_is_Zp_a(r)) /* Q, Q(a) */
[0a55e5]747  {
748    //if (f!=NULL) // already tested at start of routine
749    {
[ce3f53c]750      number n0=n_Copy(pGetCoeff(f),r->cf);
[0a55e5]751      if (with_exps==0)
[ce3f53c]752        N=n_Copy(n0,r->cf);
753      p_Cleardenom(f, r);
[ce2576]754      //after here f should not have a denominator!!
755      //PrintS("S:");p_Write(f,r);PrintLn();
[ce3f53c]756      NN=n_Div(n0,pGetCoeff(f),r->cf);
757      n_Delete(&n0,r->cf);
[0a55e5]758      if (with_exps==0)
759      {
[ce3f53c]760        n_Delete(&N,r->cf);
761        N=n_Copy(NN,r->cf);
[0a55e5]762      }
763    }
764  }
[ce3f53c]765  else if (rField_is_Zp_a(r))
[35aab3]766  {
[ffdd694]767    //if (f!=NULL) // already tested at start of routine
[0a55e5]768    if (singclap_factorize_retry==0)
[35aab3]769    {
[ce3f53c]770      number n0=n_Copy(pGetCoeff(f),r->cf);
[ffdd694]771      if (with_exps==0)
[ce3f53c]772        N=n_Copy(n0,r->cf);
773      p_Norm(f,r);
774      p_Cleardenom(f, r);
775      NN=n_Div(n0,pGetCoeff(f),r->cf);
776      n_Delete(&n0,r->cf);
[ffdd694]777      if (with_exps==0)
[35aab3]778      {
[ce3f53c]779        n_Delete(&N,r->cf);
780        N=n_Copy(NN,r->cf);
[35aab3]781      }
782    }
[ffdd694]783  }
[ce3f53c]784  if (rField_is_Q(r) || rField_is_Zp(r))
[ffdd694]785  {
[ce3f53c]786    setCharacteristic( rChar(r) );
787    CanonicalForm F( convSingPFactoryP( f,r ) );
[34ceab]788    L = factorize( F );
[35aab3]789  }
790  // and over Q(a) / Fp(a)
[ce3f53c]791  else if (rField_is_Extension(r))
[35aab3]792  {
[ce2576]793    if (rField_is_Q_a (r)) setCharacteristic (0);
794    else                   setCharacteristic( rChar(r) );
[dd668f]795    if (r->cf->extRing->qideal!=NULL)
[35aab3]796    {
[dd668f]797      CanonicalForm mipo=convSingPFactoryP(r->cf->extRing->qideal->m[0],
[6ccdd3a]798                                           r->cf->extRing);
[35aab3]799      Variable a=rootOf(mipo);
[ce2576]800      CanonicalForm F( convSingAPFactoryAP( f, a, r ) );
[ce3f53c]801      if (rField_is_Zp_a(r))
[35aab3]802      {
803        L = factorize( F, a );
804      }
805      else
806      {
[34ceab]807        //  over Q(a)
[fcf7587]808        L= factorize (F, a);
[35aab3]809      }
810    }
811    else
812    {
[ce2576]813      CanonicalForm F( convSingTrPFactoryP( f,r ) );
[34ceab]814      L = factorize( F );
[35aab3]815    }
816  }
817  else
818  {
819    goto notImpl;
820  }
821  {
[ce3f53c]822    poly ff=p_Copy(f,r); // a copy for the retry stuff
[35aab3]823    // the first factor should be a constant
824    if ( ! L.getFirst().factor().inCoeffDomain() )
825      L.insert(CFFactor(1,1));
826    // convert into ideal
827    int n = L.length();
[91cb92]828    if (n==0) n=1;
[35aab3]829    CFFListIterator J=L;
830    int j=0;
831    if (with_exps!=1)
832    {
833      if ((with_exps==2)&&(n>1))
834      {
835        n--;
836        J++;
837      }
838      *v = new intvec( n );
839    }
840    res = idInit( n ,1);
841    for ( ; J.hasItem(); J++, j++ )
842    {
843      if (with_exps!=1) (**v)[j] = J.getItem().exp();
[ce3f53c]844      if (rField_is_Zp(r) || rField_is_Q(r))           /* Q, Fp */
[8fc55e2]845      {
[46f6af6]846        //count_Factors(res,*v,f, j, convFactoryPSingP( J.getItem().factor() );
[ce3f53c]847        res->m[j] = convFactoryPSingP( J.getItem().factor(),r );
[8fc55e2]848      }
[35aab3]849      #if 0
850      else if (rField_is_GF())
[46f6af6]851        res->m[j] = convFactoryGFSingGF( J.getItem().factor() );
[35aab3]852      #endif
[ce3f53c]853      else if (rField_is_Extension(r))     /* Q(a), Fp(a) */
[35aab3]854      {
[ea1d44c]855#ifndef NDEBUG
[5d491d]856        intvec *w=NULL;
857        if (v!=NULL) w=*v;
[ea1d44c]858#endif
[dd668f]859        if (r->cf->extRing->qideal==NULL)
[8fc55e2]860        {
[ea1d44c]861#ifdef NDEBUG
862          res->m[j]= convFactoryPSingTrP( J.getItem().factor(),r );
863#else
[ce2576]864          if(!count_Factors(res,w,j,ff,convFactoryPSingTrP( J.getItem().factor(),r ),r))
[d499d1]865          {
[a86cda]866            if (w!=NULL)
[e080ab]867              (*w)[j]=1;
[ce3f53c]868            res->m[j]=p_One(r);
[d499d1]869          }
[ea1d44c]870#endif
[8fc55e2]871        }
[35aab3]872        else
[8fc55e2]873        {
[ea1d44c]874#ifdef NDEBUG
875          res->m[j]= convFactoryAPSingAP( J.getItem().factor(),r );
876#else
[ce2576]877          if (!count_Factors(res,w,j,ff,convFactoryAPSingAP( J.getItem().factor(),r ),r))
[d499d1]878          {
[a86cda]879            if (w!=NULL)
[e080ab]880              (*w)[j]=1;
[ce3f53c]881            res->m[j]=p_One(r);
[d499d1]882          }
[ea1d44c]883#endif
[8fc55e2]884        }
[0a55e5]885      }
886    }
[ea1d44c]887#ifndef NDEBUG
[ce3f53c]888    if (rField_is_Extension(r) && (!p_IsConstantPoly(ff,r)))
[0a55e5]889    {
890      singclap_factorize_retry++;
891      if (singclap_factorize_retry<3)
892      {
893        int jj;
894        #ifdef FACTORIZE2_DEBUG
895        printf("factorize_retry\n");
896        #endif
897        intvec *ww=NULL;
[ce3f53c]898        id_Test(res,r);
899        ideal h=singclap_factorize ( ff, &ww , with_exps, r );
900        id_Test(h,r);
[0a55e5]901        int l=(*v)->length();
[91cb92]902        (*v)->resize(l+ww->length());
[0a55e5]903        for(jj=0;jj<ww->length();jj++)
[91cb92]904          (**v)[jj+l]=(*ww)[jj];
[0a55e5]905        delete ww;
906        ideal hh=idInit(IDELEMS(res)+IDELEMS(h),1);
907        for(jj=IDELEMS(res)-1;jj>=0;jj--)
908        {
909          hh->m[jj]=res->m[jj];
910          res->m[jj]=NULL;
911        }
912        for(jj=IDELEMS(h)-1;jj>=0;jj--)
913        {
914          hh->m[jj+IDELEMS(res)]=h->m[jj];
915          h->m[jj]=NULL;
916        }
[ce3f53c]917        id_Delete(&res,r);
918        id_Delete(&h,r);
[0a55e5]919        res=hh;
[ce3f53c]920        id_Test(res,r);
[0a55e5]921        ff=NULL;
922      }
923      else
924      {
925        WarnS("problem with factorize");
[226dd7]926        #if 0
927        pWrite(ff);
928        idShow(res);
929        #endif
[ce3f53c]930        id_Delete(&res,r);
[226dd7]931        res=idInit(2,1);
[ce3f53c]932        res->m[0]=p_One(r);
[226dd7]933        res->m[1]=ff; ff=NULL;
[35aab3]934      }
935    }
[ea1d44c]936#endif
[ce3f53c]937    p_Delete(&ff,r);
[35aab3]938    if (N!=NULL)
939    {
[ce3f53c]940      p_Mult_nn(res->m[0],N,r);
941      n_Delete(&N,r->cf);
[ffdd694]942      N=NULL;
[35aab3]943    }
944    // delete constants
945    if (res!=NULL)
946    {
947      int i=IDELEMS(res)-1;
948      int j=0;
949      for(;i>=0;i--)
950      {
951        if ((res->m[i]!=NULL)
952        && (pNext(res->m[i])==NULL)
[ce3f53c]953        && (p_IsConstant(res->m[i],r)))
[35aab3]954        {
955          if (with_exps!=0)
956          {
[ce3f53c]957            p_Delete(&(res->m[i]),r);
[35aab3]958            if ((v!=NULL) && ((*v)!=NULL))
959              (**v)[i]=0;
960            j++;
961          }
962          else if (i!=0)
963          {
[d8932ed]964            while ((v!=NULL) && ((*v)!=NULL) && ((**v)[i]>1))
965            {
[ce3f53c]966              res->m[0]=p_Mult_q(res->m[0],p_Copy(res->m[i],r),r);
[d8932ed]967              (**v)[i]--;
968            }
[ce3f53c]969            res->m[0]=p_Mult_q(res->m[0],res->m[i],r);
[35aab3]970            res->m[i]=NULL;
971            if ((v!=NULL) && ((*v)!=NULL))
[d499d1]972              (**v)[i]=1;
[35aab3]973            j++;
974          }
975        }
976      }
977      if (j>0)
978      {
979        idSkipZeroes(res);
980        if ((v!=NULL) && ((*v)!=NULL))
981        {
982          intvec *w=*v;
[f12cd23]983          int len=IDELEMS(res);
984          *v = new intvec( len );
[0a55e5]985          for (i=0,j=0;i<si_min(w->length(),len);i++)
[35aab3]986          {
987            if((*w)[i]!=0)
988            {
989              (**v)[j]=(*w)[i]; j++;
990            }
991          }
992          delete w;
993        }
994      }
995      if (res->m[0]==NULL)
996      {
[ce3f53c]997        res->m[0]=p_One(r);
[35aab3]998      }
999    }
1000  }
[dd668f]1001  if (rField_is_Q_a(r) && (r->cf->extRing->qideal!=NULL))
[35aab3]1002  {
1003    int i=IDELEMS(res)-1;
1004    int stop=1;
1005    if (with_exps!=0) stop=0;
1006    for(;i>=stop;i--)
1007    {
[ce3f53c]1008      p_Norm(res->m[i],r);
[35aab3]1009    }
[ce3f53c]1010    if (with_exps==0) p_SetCoeff(res->m[0],old_lead_coeff,r);
1011    else n_Delete(&old_lead_coeff,r->cf);
[35aab3]1012  }
1013  else
[ce3f53c]1014    n_Delete(&old_lead_coeff,r->cf);
[ee5d91]1015  errorreported=save_errorreported;
[35aab3]1016notImpl:
1017  if (res==NULL)
1018    WerrorS( feNotImplemented );
[ffdd694]1019  if (NN!=NULL)
[35aab3]1020  {
[ce3f53c]1021    n_Delete(&NN,r->cf);
[ffdd694]1022  }
1023  if (N!=NULL)
1024  {
[ce3f53c]1025    n_Delete(&N,r->cf);
[35aab3]1026  }
[ce3f53c]1027  if (f!=NULL) p_Delete(&f,r);
[35aab3]1028  //PrintS("......S\n");
1029  return res;
1030}
[3ef9c8]1031ideal singclap_sqrfree ( poly f, intvec ** v , int with_exps, const ring r)
[0dd641]1032{
[ce3f53c]1033  p_Test(f,r);
[0dd641]1034#ifdef FACTORIZE2_DEBUG
1035  printf("singclap_sqrfree, degree %d\n",pTotaldegree(f));
1036#endif
1037  // with_exps: 3,1 return only true factors, no exponents
1038  //            2 return true factors and exponents
1039  //            0 return coeff, factors and exponents
1040  BOOLEAN save_errorreported=errorreported;
1041
1042  ideal res=NULL;
1043
1044  // handle factorize(0) =========================================
1045  if (f==NULL)
1046  {
1047    res=idInit(1,1);
[c92097b]1048    if (with_exps!=1 && with_exps!=3)
[3ef9c8]1049    {
1050      (*v)=new intvec(1);
1051      (**v)[0]=1;
1052    }
[0dd641]1053    return res;
1054  }
1055  // handle factorize(mon) =========================================
1056  if (pNext(f)==NULL)
1057  {
1058    int i=0;
1059    int n=0;
1060    int e;
[ce3f53c]1061    for(i=rVar(r);i>0;i--) if(p_GetExp(f,i,r)!=0) n++;
[c92097b]1062    if (with_exps==0 || with_exps==3) n++; // with coeff
[0dd641]1063    res=idInit(si_max(n,1),1);
[3ef9c8]1064    switch(with_exps)
1065    {
1066      case 0: // with coef & exp.
1067        res->m[0]=p_NSet(n_Copy(pGetCoeff(f),r->cf),r);
1068        // no break
[c92097b]1069      case 3: // with coef & exp.
1070        res->m[0]=p_NSet(n_Copy(pGetCoeff(f),r->cf),r);
1071        // no break
[3ef9c8]1072      case 2: // with exp.
1073        (*v)=new intvec(si_max(1,n));
1074        (**v)[0]=1;
1075        // no break
1076      case 1: ;
1077      #ifdef TEST
1078      default: ;
1079      #endif
1080    }
[ce3f53c]1081    res->m[0]=p_NSet(n_Copy(pGetCoeff(f),r->cf),r);
[0dd641]1082    if (n==0)
1083    {
[ce3f53c]1084      res->m[0]=p_One(r);
[0dd641]1085      // (**v)[0]=1; is already done
1086    }
[3ef9c8]1087    else
[0dd641]1088    {
[3ef9c8]1089      for(i=rVar(r);i>0;i--)
[0dd641]1090      {
[3ef9c8]1091        e=p_GetExp(f,i,r);
1092        if(e!=0)
1093        {
1094          n--;
1095          poly p=p_One(r);
1096          p_SetExp(p,i,1,r);
1097          p_Setm(p,r);
1098          res->m[n]=p;
1099          if (with_exps!=1) (**v)[n]=e;
1100        }
[0dd641]1101      }
1102    }
[3ef9c8]1103    p_Delete(&f,r);
[0dd641]1104    return res;
1105  }
1106  //PrintS("S:");pWrite(f);PrintLn();
1107  // use factory/libfac in general ==============================
1108  Off(SW_RATIONAL);
1109  On(SW_SYMMETRIC_FF);
1110  #ifdef HAVE_NTL
1111  extern int prime_number;
[ce3f53c]1112  if(rField_is_Q(r)) prime_number=0;
[0dd641]1113  #endif
1114  CFFList L;
[3ef9c8]1115  number N=NULL;
1116  number NN=NULL;
[f78374]1117  number old_lead_coeff=n_Copy(pGetCoeff(f), r->cf);
[0dd641]1118
[ce3f53c]1119  if (!rField_is_Zp(r) && !rField_is_Zp_a(r)) /* Q, Q(a) */
[0dd641]1120  {
1121    //if (f!=NULL) // already tested at start of routine
[3ef9c8]1122    number n0=n_Copy(pGetCoeff(f),r->cf);
[c92097b]1123    if (with_exps==0 || with_exps==3)
[3ef9c8]1124      N=n_Copy(n0,r->cf);
1125    p_Cleardenom(f, r);
1126    //after here f should not have a denominator!!
1127    //PrintS("S:");p_Write(f,r);PrintLn();
1128    NN=n_Div(n0,pGetCoeff(f),r->cf);
1129    n_Delete(&n0,r->cf);
[c92097b]1130    if (with_exps==0 || with_exps==3)
[0dd641]1131    {
[3ef9c8]1132      n_Delete(&N,r->cf);
1133      N=n_Copy(NN,r->cf);
[0dd641]1134    }
1135  }
[ce3f53c]1136  else if (rField_is_Zp_a(r))
[0dd641]1137  {
1138    //if (f!=NULL) // already tested at start of routine
1139    if (singclap_factorize_retry==0)
1140    {
[3ef9c8]1141      number n0=n_Copy(pGetCoeff(f),r->cf);
[c92097b]1142      if (with_exps==0 || with_exps==3)
[3ef9c8]1143        N=n_Copy(n0,r->cf);
[ce3f53c]1144      p_Norm(f,r);
1145      p_Cleardenom(f, r);
[3ef9c8]1146      NN=n_Div(n0,pGetCoeff(f),r->cf);
1147      n_Delete(&n0,r->cf);
[c92097b]1148      if (with_exps==0 || with_exps==3)
[3ef9c8]1149      {
1150        n_Delete(&N,r->cf);
1151        N=n_Copy(NN,r->cf);
1152      }
[0dd641]1153    }
1154  }
[ce3f53c]1155  if (rField_is_Q(r) || rField_is_Zp(r))
[0dd641]1156  {
[ce3f53c]1157    setCharacteristic( rChar(r) );
1158    CanonicalForm F( convSingPFactoryP( f,r ) );
[85194f2]1159    L = sqrFree( F );
[0dd641]1160  }
[3ef9c8]1161  else if (rField_is_Extension(r))
1162  {
1163    if (rField_is_Q_a (r)) setCharacteristic (0);
1164    else                   setCharacteristic( rChar(r) );
[dd668f]1165    if (r->cf->extRing->qideal!=NULL)
[3ef9c8]1166    {
[dd668f]1167      CanonicalForm mipo=convSingPFactoryP(r->cf->extRing->qideal->m[0],
[3ef9c8]1168                                           r->cf->extRing);
1169      Variable a=rootOf(mipo);
1170      CanonicalForm F( convSingAPFactoryAP( f, a, r ) );
1171      L= sqrFree (F);
1172    }
1173    else
1174    {
1175      CanonicalForm F( convSingTrPFactoryP( f,r ) );
1176      L = sqrFree( F );
1177    }
1178  }
[0dd641]1179  #if 0
1180  else if (rField_is_GF())
1181  {
[ce3f53c]1182    int c=rChar(r);
[0dd641]1183    setCharacteristic( c, primepower(c) );
1184    CanonicalForm F( convSingGFFactoryGF( f ) );
1185    if (F.isUnivariate())
1186    {
1187      L = factorize( F );
1188    }
1189    else
1190    {
1191      goto notImpl;
1192    }
1193  }
1194  #endif
1195  else
1196  {
1197    goto notImpl;
1198  }
1199  {
1200    // convert into ideal
1201    int n = L.length();
1202    if (n==0) n=1;
1203    CFFListIterator J=L;
1204    int j=0;
[3ef9c8]1205    if (with_exps!=1)
1206    {
1207      if ((with_exps==2)&&(n>1))
1208      {
1209        n--;
1210        J++;
1211      }
1212      *v = new intvec( n );
1213    }
[c92097b]1214    else if (L.getFirst().factor().inCoeffDomain() && with_exps!=3)
[3ef9c8]1215    {
1216      n--;
1217      J++;
1218    }
[0dd641]1219    res = idInit( n ,1);
1220    for ( ; J.hasItem(); J++, j++ )
1221    {
[c92097b]1222      if (with_exps!=1 && with_exps!=3) (**v)[j] = J.getItem().exp();
[3ef9c8]1223      if (rField_is_Zp(r) || rField_is_Q(r))
1224        res->m[j] = convFactoryPSingP( J.getItem().factor(),r );
1225      else if (rField_is_Extension(r))     /* Q(a), Fp(a) */
1226      {
[dd668f]1227        if (r->cf->extRing->qideal==NULL)
[3ef9c8]1228          res->m[j]=convFactoryPSingTrP( J.getItem().factor(),r );
1229        else
1230          res->m[j]=convFactoryAPSingAP( J.getItem().factor(),r );
1231      }
[0dd641]1232    }
1233    if (res->m[0]==NULL)
1234    {
[ce3f53c]1235      res->m[0]=p_One(r);
[0dd641]1236    }
[f78374]1237    if (N!=NULL)
1238    {
1239      p_Mult_nn(res->m[0],N,r);
1240      n_Delete(&N,r->cf);
1241      N=NULL;
1242    }
[0dd641]1243  }
[dd668f]1244  if (rField_is_Q_a(r) && (r->cf->extRing->qideal!=NULL))
[f78374]1245  {
1246    int i=IDELEMS(res)-1;
1247    int stop=1;
[c92097b]1248    if (with_exps!=0 || with_exps==3) stop=0;
[f78374]1249    for(;i>=stop;i--)
1250    {
1251      p_Norm(res->m[i],r);
1252    }
[c92097b]1253    if (with_exps==0 || with_exps==3) p_SetCoeff(res->m[0],old_lead_coeff,r);
[f78374]1254    else n_Delete(&old_lead_coeff,r->cf);
1255  }
1256  else
1257    n_Delete(&old_lead_coeff,r->cf);
[ce3f53c]1258  p_Delete(&f,r);
[0dd641]1259  errorreported=save_errorreported;
1260notImpl:
1261  if (res==NULL)
1262    WerrorS( feNotImplemented );
[f78374]1263  if (NN!=NULL)
1264  {
1265    n_Delete(&NN,r->cf);
1266  }
1267  if (N!=NULL)
1268  {
1269    n_Delete(&N,r->cf);
1270  }
[0dd641]1271  return res;
1272}
[ce3f53c]1273
[67c1dc]1274#ifdef HAVE_LIBFAC
1275matrix singclap_irrCharSeries ( ideal I, const ring r)
[35aab3]1276{
1277  if (idIs0(I)) return mpNew(1,1);
1278
1279  // for now there is only the possibility to handle polynomials over
1280  // Q and Fp ...
1281  matrix res=NULL;
1282  int i;
1283  Off(SW_RATIONAL);
1284  On(SW_SYMMETRIC_FF);
1285  CFList L;
1286  ListCFList LL;
[ce3f53c]1287  if (((rChar(r) == 0) || (rChar(r) > 1) )
1288  && (rPar(r)==0))
[35aab3]1289  {
[ce3f53c]1290    setCharacteristic( rChar(r) );
[35aab3]1291    for(i=0;i<IDELEMS(I);i++)
1292    {
1293      poly p=I->m[i];
1294      if (p!=NULL)
1295      {
[ce3f53c]1296        p=p_Copy(p,r);
1297        p_Cleardenom(p, r);
1298        L.append(convSingPFactoryP(p,r));
[35aab3]1299      }
1300    }
1301  }
1302  // and over Q(a) / Fp(a)
[ce3f53c]1303  else if (( rChar(r)==1 ) // Q(a)
1304  || (rChar(r) <-1))       // Fp(a)
[35aab3]1305  {
[ce3f53c]1306    if (rChar(r)==1) setCharacteristic( 0 );
1307    else               setCharacteristic( -rChar(r) );
[35aab3]1308    for(i=0;i<IDELEMS(I);i++)
1309    {
1310      poly p=I->m[i];
1311      if (p!=NULL)
1312      {
[ce3f53c]1313        p=p_Copy(p,r);
1314        p_Cleardenom(p, r);
1315        L.append(convSingTrPFactoryP(p,r));
[35aab3]1316      }
1317    }
1318  }
1319  else
1320  {
1321    WerrorS( feNotImplemented );
1322    return res;
1323  }
1324
1325  // a very bad work-around --- FIX IT in libfac
1326  // should be fixed as of 2001/6/27
1327  int tries=0;
1328  int m,n;
1329  ListIterator<CFList> LLi;
1330  loop
1331  {
1332    LL=IrrCharSeries(L);
1333    m= LL.length(); // Anzahl Zeilen
1334    n=0;
1335    for ( LLi = LL; LLi.hasItem(); LLi++ )
1336    {
1337      n = si_max(LLi.getItem().length(),n);
1338    }
1339    if ((m!=0) && (n!=0)) break;
1340    tries++;
1341    if (tries>=5) break;
1342  }
1343  if ((m==0) || (n==0))
1344  {
1345    Warn("char_series returns %d x %d matrix from %d input polys (%d)",
1346      m,n,IDELEMS(I)+1,LL.length());
[fc2746]1347    iiWriteMatrix((matrix)I,"I",2,r,0);
[35aab3]1348    m=si_max(m,1);
1349    n=si_max(n,1);
1350  }
1351  res=mpNew(m,n);
1352  CFListIterator Li;
1353  for ( m=1, LLi = LL; LLi.hasItem(); LLi++, m++ )
1354  {
1355    for (n=1, Li = LLi.getItem(); Li.hasItem(); Li++, n++)
1356    {
[ce3f53c]1357      if ( (rChar(r) == 0) || (rChar(r) > 1) )
1358        MATELEM(res,m,n)=convFactoryPSingP(Li.getItem(),r);
[35aab3]1359      else
[ce3f53c]1360        MATELEM(res,m,n)=convFactoryPSingTrP(Li.getItem(),r);
[35aab3]1361    }
1362  }
1363  Off(SW_RATIONAL);
1364  return res;
[67c1dc]1365}
[35aab3]1366
[3aa9b6]1367char* singclap_neworder ( ideal I, const ring r)
[35aab3]1368{
1369  int i;
1370  Off(SW_RATIONAL);
1371  On(SW_SYMMETRIC_FF);
1372  CFList L;
[ce3f53c]1373  if (((rChar(r) == 0) || (rChar(r) > 1) )
1374  && (rPar(r)==0))
[35aab3]1375  {
[ce3f53c]1376    setCharacteristic( rChar(r) );
[35aab3]1377    for(i=0;i<IDELEMS(I);i++)
1378    {
[ce3f53c]1379      L.append(convSingPFactoryP(I->m[i],r));
[35aab3]1380    }
1381  }
1382  // and over Q(a) / Fp(a)
[ce3f53c]1383  else if (( rChar(r)==1 ) // Q(a)
1384  || (rChar(r) <-1))       // Fp(a)
[35aab3]1385  {
[ce3f53c]1386    if (rChar(r)==1) setCharacteristic( 0 );
1387    else               setCharacteristic( -rChar(r) );
[35aab3]1388    for(i=0;i<IDELEMS(I);i++)
1389    {
[ce3f53c]1390      L.append(convSingTrPFactoryP(I->m[i],r));
[35aab3]1391    }
1392  }
1393  else
1394  {
1395    WerrorS( feNotImplemented );
1396    return NULL;
1397  }
1398
1399  List<int> IL=neworderint(L);
1400  ListIterator<int> Li;
1401  StringSetS("");
1402  Li = IL;
[ce3f53c]1403  int offs=rPar(r);
1404  int* mark=(int*)omAlloc0((rVar(r)+offs)*sizeof(int));
1405  int cnt=rVar(r)+offs;
[35aab3]1406  loop
1407  {
1408    if(! Li.hasItem()) break;
1409    BOOLEAN done=TRUE;
1410    i=Li.getItem()-1;
1411    mark[i]=1;
1412    if (i<offs)
1413    {
1414      done=FALSE;
[ce3f53c]1415      //StringAppendS(r->parameter[i]);
[35aab3]1416    }
1417    else
1418    {
[ce3f53c]1419      StringAppendS(r->names[i-offs]);
[35aab3]1420    }
1421    Li++;
1422    cnt--;
1423    if(cnt==0) break;
1424    if (done) StringAppendS(",");
1425  }
[ce3f53c]1426  for(i=0;i<rVar(r)+offs;i++)
[35aab3]1427  {
1428    BOOLEAN done=TRUE;
1429    if(mark[i]==0)
1430    {
1431      if (i<offs)
1432      {
1433        done=FALSE;
[ce3f53c]1434        //StringAppendS(r->parameter[i]);
[35aab3]1435      }
1436      else
1437      {
[ce3f53c]1438        StringAppendS(r->names[i-offs]);
[35aab3]1439      }
1440      cnt--;
1441      if(cnt==0) break;
1442      if (done) StringAppendS(",");
1443    }
1444  }
[538512]1445  char * s=StringEndS();
[35aab3]1446  if (s[strlen(s)-1]==',') s[strlen(s)-1]='\0';
1447  return s;
[67c1dc]1448}
1449#endif /*HAVE_LIBFAC*/
[35aab3]1450
[ce3f53c]1451BOOLEAN singclap_isSqrFree(poly f, const ring r)
[35aab3]1452{
1453  BOOLEAN b=FALSE;
[abb4787]1454  CanonicalForm F( convSingPFactoryP( f,r ) );
1455  if((r->cf->type==n_Zp)&&(!F.isUnivariate()))
[35aab3]1456      goto err;
[abb4787]1457  b=(BOOLEAN)isSqrFree(F);
1458  Off(SW_RATIONAL);
[35aab3]1459  return b;
[abb4787]1460err:
1461  WerrorS( feNotImplemented );
1462  return 0;
[35aab3]1463}
1464
[ce3f53c]1465poly singclap_det( const matrix m, const ring s )
[35aab3]1466{
1467  int r=m->rows();
1468  if (r!=m->cols())
1469  {
1470    Werror("det of %d x %d matrix",r,m->cols());
1471    return NULL;
1472  }
1473  poly res=NULL;
[abb4787]1474  CFMatrix M(r,r);
1475  int i,j;
1476  for(i=r;i>0;i--)
[35aab3]1477  {
[abb4787]1478    for(j=r;j>0;j--)
[35aab3]1479    {
[abb4787]1480      M(i,j)=convSingPFactoryP(MATELEM(m,i,j),s);
[35aab3]1481    }
1482  }
[abb4787]1483  res= convFactoryPSingP( determinant(M,r),s ) ;
[35aab3]1484  Off(SW_RATIONAL);
1485  return res;
1486}
1487
[2e4ec14]1488int singclap_det_i( intvec * m, const ring /*r*/)
[35aab3]1489{
[9d5ba2]1490//  assume( r == currRing ); // Anything else is not guaranted to work!
1491   
1492  setCharacteristic( 0 ); // ?
[35aab3]1493  CFMatrix M(m->rows(),m->cols());
1494  int i,j;
1495  for(i=m->rows();i>0;i--)
1496  {
1497    for(j=m->cols();j>0;j--)
1498    {
1499      M(i,j)=IMATELEM(*m,i,j);
1500    }
1501  }
[ce3f53c]1502  int res= convFactoryISingI( determinant(M,m->rows()) ) ;
[24a9587]1503  return res;
1504}
1505
1506number singclap_det_bi( bigintmat * m, const coeffs cf)
1507{
1508  assume(m->basecoeffs()==cf);
1509  CFMatrix M(m->rows(),m->cols());
1510  int i,j;
1511  BOOLEAN setchar=TRUE;
1512  for(i=m->rows();i>0;i--)
1513  {
1514    for(j=m->cols();j>0;j--)
1515    {
1516      M(i,j)=cf->convSingNFactoryN(BIMATELEM(*m,i,j),setchar,cf);
1517      setchar=FALSE;
1518    }
1519  }
1520  number res= cf->convFactoryNSingN( determinant(M,m->rows()),cf ) ;
[35aab3]1521  return res;
1522}
[c74d6a]1523
[2072126]1524#ifdef HAVE_NTL
[895b31c]1525#if 1
[ce3f53c]1526matrix singntl_HNF(matrix  m, const ring s )
[9d9078]1527{
[af8863]1528  int r=m->rows();
1529  if (r!=m->cols())
1530  {
1531    Werror("HNF of %d x %d matrix",r,m->cols());
1532    return NULL;
1533  }
[895b31c]1534   
1535  matrix res=mp_New(r,r);
1536   
[ce3f53c]1537  if (rField_is_Q(s))
[af8863]1538  {
[9d9078]1539
[af8863]1540    CFMatrix M(r,r);
1541    int i,j;
1542    for(i=r;i>0;i--)
1543    {
1544      for(j=r;j>0;j--)
1545      {
[ce3f53c]1546        M(i,j)=convSingPFactoryP(MATELEM(m,i,j),s );
[af8863]1547      }
1548    }
1549    CFMatrix *MM=cf_HNF(M);
1550    for(i=r;i>0;i--)
1551    {
1552      for(j=r;j>0;j--)
[9d9078]1553      {
[ce3f53c]1554        MATELEM(res,i,j)=convFactoryPSingP((*MM)(i,j),s);
[af8863]1555      }
1556    }
1557    delete MM;
1558  }
1559  return res;
1560}
[895b31c]1561
1562intvec* singntl_HNF(intvec*  m, const ring)
[af8863]1563{
1564  int r=m->rows();
1565  if (r!=m->cols())
1566  {
1567    Werror("HNF of %d x %d matrix",r,m->cols());
1568    return NULL;
1569  }
1570  setCharacteristic( 0 );
1571  CFMatrix M(r,r);
1572  int i,j;
1573  for(i=r;i>0;i--)
1574  {
1575    for(j=r;j>0;j--)
1576    {
1577      M(i,j)=IMATELEM(*m,i,j);
1578    }
1579  }
1580  CFMatrix *MM=cf_HNF(M);
1581  intvec *mm=ivCopy(m);
1582  for(i=r;i>0;i--)
1583  {
1584    for(j=r;j>0;j--)
1585    {
1586      IMATELEM(*mm,i,j)=convFactoryISingI((*MM)(i,j));
1587    }
1588  }
1589  delete MM;
1590  return mm;
1591}
[895b31c]1592
[ce3f53c]1593matrix singntl_LLL(matrix  m, const ring s )
[9d9078]1594{
[9c0b20a]1595  int r=m->rows();
1596  int c=m->cols();
[895b31c]1597  matrix res=mp_New(r,c);
[ce3f53c]1598  if (rField_is_Q(s))
[9c0b20a]1599  {
1600    CFMatrix M(r,c);
1601    int i,j;
1602    for(i=r;i>0;i--)
1603    {
1604      for(j=c;j>0;j--)
1605      {
[ce3f53c]1606        M(i,j)=convSingPFactoryP(MATELEM(m,i,j),s);
[9c0b20a]1607      }
1608    }
1609    CFMatrix *MM=cf_LLL(M);
1610    for(i=r;i>0;i--)
1611    {
1612      for(j=c;j>0;j--)
[9d9078]1613      {
[ce3f53c]1614        MATELEM(res,i,j)=convFactoryPSingP((*MM)(i,j),s);
[9c0b20a]1615      }
1616    }
1617    delete MM;
1618  }
1619  return res;
1620}
[895b31c]1621
1622intvec* singntl_LLL(intvec*  m, const ring)
[9c0b20a]1623{
1624  int r=m->rows();
1625  int c=m->cols();
1626  setCharacteristic( 0 );
1627  CFMatrix M(r,c);
1628  int i,j;
1629  for(i=r;i>0;i--)
1630  {
1631    for(j=r;j>0;j--)
1632    {
1633      M(i,j)=IMATELEM(*m,i,j);
1634    }
1635  }
1636  CFMatrix *MM=cf_LLL(M);
1637  intvec *mm=ivCopy(m);
1638  for(i=r;i>0;i--)
1639  {
1640    for(j=c;j>0;j--)
1641    {
1642      IMATELEM(*mm,i,j)=convFactoryISingI((*MM)(i,j));
1643    }
1644  }
1645  delete MM;
1646  return mm;
1647}
[c74d6a]1648#endif
[686f46]1649#endif
[c74d6a]1650
[fea2af]1651
1652#endif /* HAVE_FACTORY */
Note: See TracBrowser for help on using the repository browser.