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

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