source: git/libpolys/polys/clapsing.cc @ 09dbf3

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