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

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