source: git/libpolys/polys/clapsing.cc @ 4d47990

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