source: git/kernel/clapsing.cc @ a5d9313

jengelh-datetimespielwiese
Last change on this file since a5d9313 was a5d9313, checked in by Hans Schönemann <hannes@…>, 18 years ago
*hannes: bug 36 git-svn-id: file:///usr/local/Singular/svn/trunk@7816 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 37.0 KB
Line 
1// emacs edit mode for this file is -*- C++ -*-
2/****************************************
3*  Computer Algebra System SINGULAR     *
4****************************************/
5// $Id: clapsing.cc,v 1.6 2005-04-13 16:38:10 Singular Exp $
6/*
7* ABSTRACT: interface between Singular and factory
8*/
9
10#include "mod2.h"
11#include "omalloc.h"
12#ifdef HAVE_FACTORY
13#define SI_DONT_HAVE_GLOBAL_VARS
14#include "structs.h"
15#include "clapsing.h"
16#include "numbers.h"
17#include "ring.h"
18#include <factory.h>
19#include "clapconv.h"
20#ifdef HAVE_LIBFAC_P
21#include <factor.h>
22//CanonicalForm algcd(const CanonicalForm & F, const CanonicalForm & g, const CFList & as, const Varlist & order);
23CanonicalForm alg_gcd(const CanonicalForm &, const CanonicalForm &, const CFList &);
24#endif
25#include "ring.h"
26
27//
28// FACTORY_GCD_TEST: use new gcd instead of old one.  Does not work
29//   without new gcd-implementation which is not publicly available.
30//
31// FACTORY_GCD_STAT: print statistics on polynomials.  Works only
32//   with the file `gcd_stat.cc' and `gcd_stat.h which may be found
33//   in the repository, module `factory-devel'.
34//   Overall statistics may printed using `system("gcdstat");'.
35//
36// FACTORY_GCD_TIMING: accumulate time used for gcd calculations.
37//   Time may be printed (and reset) with `system("gcdtime");'.
38//   For this define, `timing.h' from the factory source directory
39//   has to be copied to the Singular source directory.
40//   Note: for better readability, the macros `TIMING_START()' and
41//   `TIMING_END()' are used in any case.  However, they expand to
42//   nothing if `FACTORY_GCD_TIMING' is off.
43//
44// FACTORY_GCD_DEBOUT: print polynomials involved in gcd calculations.
45//   The polynomials are printed by means of the macros
46//   `FACTORY_*OUT_POLY' which are defined to be empty if
47//   `FACTORY_GCD_DEBOUT' is off.
48//
49// FACTORY_GCD_DEBOUT_PATTERN: print degree patterns of polynomials
50//   involved in gcd calculations.
51//   The patterns are printed by means of the macros
52//   `FACTORY_*OUT_PAT' which are defined to be empty if
53//   `FACTORY_GCD_DEBOUT_PATTERN' is off.
54//
55//   A degree pattern looks like this:
56//
57//   totDeg  size    deg(v1) deg(v2) ...
58//
59//   where "totDeg" means total degree, "size" the number of terms,
60//   and "deg(vi)" is the degree with respect to variable i.
61//   In univariate case, the "deg(vi)" are missing.  For this feature
62//   you need the files `gcd_stat.cc' and `gcd_stat.h'.
63//
64//
65// And here is what the functions print if `FACTORY_GCD_DEBOUT' (1),
66// `FACTORY_GCD_STAT' (2), or `FACTORY_GCD_DEBOUT_PATTERN' (3) is on:
67//
68// sinclap_divide_content:
69// (1) G = <firstCoeff>
70// (3) G#= <firstCoeff, pattern>
71// (1) h = <nextCoeff>
72// (3) h#= <nextCoeff, pattern>
73// (2) gcnt: <statistics on gcd as explained above>
74// (1) g = <intermediateResult>
75// (3) g#= <intermediateResult, pattern>
76// (1) h = <nextCoeff>
77// (3) h#= <nextCoeff, pattern>
78// (2) gcnt: <statistics on gcd as explained above>
79//  ...
80// (1) h = <lastCoeff>
81// (3) h#= <lastCoeff, pattern>
82// (1) g = <finalResult>
83// (3) g#= <finalResult, pattern>
84// (2) gcnt: <statistics on gcd as explained above>
85// (2) cont: <statistics on content as explained above>
86//
87// singclap_alglcm:
88// (1) f = <inputPolyF>
89// (3) f#= <inputPolyF, pattern>
90// (1) g = <inputPolyG>
91// (3) g#= <inputPolyG, pattern>
92// (1) d = <its gcd>
93// (3) d#= <its gcd, pattern>
94// (2) alcm: <statistics as explained above>
95//
96// singclap_algdividecontent:
97// (1) f = <inputPolyF>
98// (3) f#= <inputPolyF, pattern>
99// (1) g = <inputPolyG>
100// (3) g#= <inputPolyG, pattern>
101// (1) d = <its gcd>
102// (3) d#= <its gcd, pattern>
103// (2) acnt: <statistics as explained above>
104//
105
106#ifdef FACTORY_GCD_STAT
107#include "gcd_stat.h"
108#define FACTORY_GCDSTAT( tag, f, g, d ) \
109  printGcdStat( tag, f, g, d )
110#define FACTORY_CONTSTAT( tag, f ) \
111  printContStat( tag, f )
112#else
113#define FACTORY_GCDSTAT( tag, f, g, d )
114#define FACTORY_CONTSTAT( tag, f )
115#endif
116
117#ifdef FACTORY_GCD_TIMING
118#define TIMING
119#include "timing.h"
120TIMING_DEFINE_PRINT( contentTimer );
121TIMING_DEFINE_PRINT( algContentTimer );
122TIMING_DEFINE_PRINT( algLcmTimer );
123#else
124#define TIMING_START( timer )
125#define TIMING_END( timer )
126#endif
127
128#ifdef FACTORY_GCD_DEBOUT
129#include "longalg.h"
130#include "febase.h"
131// napoly f
132#define FACTORY_ALGOUT_POLY( tag, f ) \
133  StringSetS( tag ); \
134  napWrite( f ); \
135  pRINtS(StringAppendS("\n"));
136// CanonicalForm f, represents transcendent extension
137#define FACTORY_CFTROUT_POLY( tag, f ) \
138  { \
139    napoly F=convClapPSingTr( f ); \
140    StringSetS( tag ); \
141    napWrite( F ); \
142    PrintS(StringAppendS("\n")); \
143    napDelete(&F); \
144  }
145// CanonicalForm f, represents algebraic extension
146#define FACTORY_CFAOUT_POLY( tag, f ) \
147  { \
148    napoly F=convClapASingA( f ); \
149    StringSetS( tag ); \
150    napWrite( F ); \
151    PrintS(StringAppendS("\n")); \
152    napDelete(&F); \
153  }
154#else /* ! FACTORY_GCD_DEBOUT */
155#define FACTORY_ALGOUT_POLY( tag, f )
156#define FACTORY_CFTROUT_POLY( tag, f )
157#define FACTORY_CFAOUT_POLY( tag, f )
158#endif /* ! FACTORY_GCD_DEBOUT */
159
160#ifdef FACTORY_GCD_DEBOUT_PATTERN
161// napoly f
162#define FACTORY_ALGOUT_PAT( tag, f ) \
163  if (currRing->minpoly!=NULL) \
164  { \
165    CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z); \
166    Variable a=rootOf(mipo); \
167    printPolyPattern( tag, convSingAClapA( f,a ), rPar( currRing ) ); \
168  } \
169  else \
170  { \
171    printPolyPattern( tag, convSingTrClapP( f ), rPar( currRing ) ); \
172  }
173// CanonicalForm f, represents transcendent extension
174#define FACTORY_CFTROUT_PAT( tag, f ) printPolyPattern( tag, f, rPar( currRing ) )
175// CanonicalForm f, represents algebraic extension
176#define FACTORY_CFAOUT_PAT( tag, f ) printPolyPattern( tag, f, rPar( currRing ) )
177#else /* ! FACTORY_GCD_DEBOUT_PATTERN */
178#define FACTORY_ALGOUT_PAT( tag, f )
179#define FACTORY_CFTROUT_PAT( tag, f )
180#define FACTORY_CFAOUT_PAT( tag, f )
181#endif /* ! FACTORY_GCD_DEBOUT_PATTERN */
182
183// these macors combine both print macros
184#define FACTORY_ALGOUT( tag, f ) \
185  FACTORY_ALGOUT_POLY( tag " = ", f ); \
186  FACTORY_ALGOUT_PAT( tag "#= ", f )
187#define FACTORY_CFTROUT( tag, f ) \
188  FACTORY_CFTROUT_POLY( tag " = ", f ); \
189  FACTORY_CFTROUT_PAT( tag "#= ", f )
190#define FACTORY_CFAOUT( tag, f ) \
191  FACTORY_CFAOUT_POLY( tag " = ", f ); \
192  FACTORY_CFAOUT_PAT( tag "#= ", f )
193
194
195
196
197
198poly singclap_gcd ( poly f, poly g )
199{
200  poly res=NULL;
201
202  if (f!=NULL) pCleardenom(f);
203  if (g!=NULL) pCleardenom(g);
204  else         return pCopy(f); // g==0 => gcd=f (but do a pCleardenom)
205  if (f==NULL) return pCopy(g); // f==0 => gcd=g (but do a pCleardenom)
206
207  if (pIsConstant(f) || pIsConstant(g)) return pOne();
208
209  // for now there is only the possibility to handle polynomials over
210  // Q and Fp ...
211  if (( nGetChar() == 0 || nGetChar() > 1 )
212  && (currRing->parameter==NULL))
213  {
214    setCharacteristic( nGetChar() );
215    CanonicalForm F( convSingPClapP( f ) ), G( convSingPClapP( g ) );
216    res=convClapPSingP( gcd( F, G ) );
217    Off(SW_RATIONAL);
218  }
219  // and over Q(a) / Fp(a)
220  else if (( nGetChar()==1 ) /* Q(a) */
221  || (nGetChar() <-1))       /* Fp(a) */
222  {
223    if (nGetChar()==1) setCharacteristic( 0 );
224    else               setCharacteristic( -nGetChar() );
225    if (currRing->minpoly!=NULL)
226    {
227      if ( nGetChar()==1 ) /* Q(a) */
228      {
229      //  WerrorS( feNotImplemented );
230        CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
231        //Varlist ord;
232        //ord.append(mipo.mvar());
233        CFList as(mipo);
234        Variable a=rootOf(mipo);
235        //CanonicalForm F( convSingAPClapAP( f,a ) ), G( convSingAPClapAP( g,a ) );
236        CanonicalForm F( convSingTrPClapP(f) ), G( convSingTrPClapP(g) );
237        //res= convClapAPSingAP( algcd( F, G, as, ord) );
238        //res= convClapAPSingAP( alg_gcd( F, G, as) );
239        res= convClapAPSingAP( alg_gcd( F, G, as) );
240      }
241      else
242      {
243        CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
244        Variable a=rootOf(mipo);
245        CanonicalForm F( convSingAPClapAP( f,a ) ), G( convSingAPClapAP( g,a ) );
246        res= convClapAPSingAP( gcd( F, G ) );
247      }
248    }
249    else
250    {
251      CanonicalForm F( convSingTrPClapP( f ) ), G( convSingTrPClapP( g ) );
252      res= convClapPSingTrP( gcd( F, G ) );
253    }
254    Off(SW_RATIONAL);
255  }
256  #if 0
257  else if (( nGetChar()>1 )&&(currRing->parameter!=NULL)) /* GF(q) */
258  {
259    int p=rChar(currRing);
260    int n=2;
261    int t=p*p;
262    while (t!=nChar) { t*=p;n++; }
263    setCharacteristic(p,n,'a');
264    CanonicalForm F( convSingGFClapGF( f ) ), G( convSingGFClapGF( g ) );
265    res= convClapGFSingGF( gcd( F, G ) );
266  }
267  #endif
268  else
269    WerrorS( feNotImplemented );
270
271  pDelete(&f);
272  pDelete(&g);
273  pTest(res);
274  return res;
275}
276
277/*2 find the maximal exponent of var(i) in poly p*/
278int pGetExp_Var(poly p, int i)
279{
280  int m=0;
281  int mm;
282  while (p!=NULL)
283  {
284    mm=pGetExp(p,i);
285    if (mm>m) m=mm;
286    pIter(p);
287  }
288  return m;
289}
290
291poly singclap_resultant ( poly f, poly g , poly x)
292{
293  int i=pIsPurePower(x);
294  if (i==0)
295  {
296    WerrorS("3rd argument must be a ring variable");
297    return NULL;
298  }
299  if ((f==NULL) || (g==NULL))
300    return NULL;
301  // for now there is only the possibility to handle polynomials over
302  // Q and Fp ...
303  if (( nGetChar() == 0 || nGetChar() > 1 )
304  && (currRing->parameter==NULL))
305  {
306    Variable X(i);
307    setCharacteristic( nGetChar() );
308    CanonicalForm F( convSingPClapP( f ) ), G( convSingPClapP( g ) );
309    poly res=convClapPSingP( resultant( F, G, X ) );
310    Off(SW_RATIONAL);
311    return res;
312  }
313  // and over Q(a) / Fp(a)
314  else if (( nGetChar()==1 ) /* Q(a) */
315  || (nGetChar() <-1))       /* Fp(a) */
316  {
317    if (nGetChar()==1) setCharacteristic( 0 );
318    else               setCharacteristic( -nGetChar() );
319    poly res;
320    if (currRing->minpoly!=NULL)
321    {
322      Variable X(i);
323      CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
324      Variable a=rootOf(mipo);
325      CanonicalForm F( convSingAPClapAP( f,a ) ), G( convSingAPClapAP( g,a ) );
326      res= convClapAPSingAP( resultant( F, G, X ) );
327    }
328    else
329    {
330      Variable X(i+rPar(currRing));
331      number nf,ng;
332      pCleardenom_n(f,nf);pCleardenom_n(g,ng);
333      int ef,eg;
334      ef=pGetExp_Var(f,i);
335      eg=pGetExp_Var(g,i);
336      CanonicalForm F( convSingTrPClapP( f ) ), G( convSingTrPClapP( g ) );
337      res= convClapPSingTrP( resultant( F, G, X ) );
338      if ((nf!=NULL)&&(!nIsOne(nf))&&(!nIsZero(nf)))
339      {
340        number n=nInvers(nf);
341        while(eg>0)
342        {
343          res=pMult_nn(res,n);
344          eg--;
345        }
346        nDelete(&n);
347      }
348      nDelete(&nf);
349      if ((ng!=NULL)&&(!nIsOne(ng))&&(!nIsZero(ng)))
350      {
351        number n=nInvers(ng);
352        while(ef>0)
353        {
354          res=pMult_nn(res,n);
355          ef--;
356        }
357        nDelete(&n);
358      }
359      nDelete(&ng);
360    }
361    Off(SW_RATIONAL);
362    return res;
363  }
364  else
365    WerrorS( feNotImplemented );
366  return NULL;
367}
368//poly singclap_resultant ( poly f, poly g , poly x)
369//{
370//  int i=pVar(x);
371//  if (i==0)
372//  {
373//    WerrorS("ringvar expected");
374//    return NULL;
375//  }
376//  ideal I=idInit(1,1);
377//
378//  // get the coeffs von f wrt. x:
379//  I->m[0]=pCopy(f);
380//  matrix ffi=mpCoeffs(I,i);
381//  ffi->rank=1;
382//  ffi->ncols=ffi->nrows;
383//  ffi->nrows=1;
384//  ideal fi=(ideal)ffi;
385//
386//  // get the coeffs von g wrt. x:
387//  I->m[0]=pCopy(g);
388//  matrix ggi=mpCoeffs(I,i);
389//  ggi->rank=1;
390//  ggi->ncols=ggi->nrows;
391//  ggi->nrows=1;
392//  ideal gi=(ideal)ggi;
393//
394//  // contruct the matrix:
395//  int fn=IDELEMS(fi); //= deg(f,x)+1
396//  int gn=IDELEMS(gi); //= deg(g,x)+1
397//  matrix m=mpNew(fn+gn-2,fn+gn-2);
398//  if(m==NULL)
399//  {
400//    return NULL;
401//  }
402//
403//  // enter the coeffs into m:
404//  int j;
405//  for(i=0;i<gn-1;i++)
406//  {
407//    for(j=0;j<fn;j++)
408//    {
409//      MATELEM(m,i+1,fn-j+i)=pCopy(fi->m[j]);
410//    }
411//  }
412//  for(i=0;i<fn-1;i++)
413//  {
414//    for(j=0;j<gn;j++)
415//    {
416//      MATELEM(m,gn+i,gn-j+i)=pCopy(gi->m[j]);
417//    }
418//  }
419//
420//  poly r=mpDet(m);
421//
422//  idDelete(&fi);
423//  idDelete(&gi);
424//  idDelete((ideal *)&m);
425//  return r;
426//}
427
428BOOLEAN singclap_extgcd ( poly f, poly g, poly &res, poly &pa, poly &pb )
429{
430  // for now there is only the possibility to handle univariate
431  // polynomials over
432  // Q and Fp ...
433  res=NULL;pa=NULL;pb=NULL;
434  On(SW_SYMMETRIC_FF);
435  if (( nGetChar() == 0 || nGetChar() > 1 )
436  && (currRing->parameter==NULL))
437  {
438    setCharacteristic( nGetChar() );
439    CanonicalForm F( convSingPClapP( f ) ), G( convSingPClapP( g ) );
440    CanonicalForm FpG=F+G;
441    if (!(FpG.isUnivariate()|| FpG.inCoeffDomain()))
442    //if (!F.isUnivariate() || !G.isUnivariate() || F.mvar()!=G.mvar())
443    {
444      Off(SW_RATIONAL);
445      WerrorS("not univariate");
446      return TRUE;
447    }
448    CanonicalForm Fa,Gb;
449    On(SW_RATIONAL);
450    res=convClapPSingP( extgcd( F, G, Fa, Gb ) );
451    pa=convClapPSingP(Fa);
452    pb=convClapPSingP(Gb);
453    Off(SW_RATIONAL);
454  }
455  // and over Q(a) / Fp(a)
456  else if (( nGetChar()==1 ) /* Q(a) */
457  || (nGetChar() <-1))       /* Fp(a) */
458  {
459    if (nGetChar()==1) setCharacteristic( 0 );
460    else               setCharacteristic( -nGetChar() );
461    CanonicalForm Fa,Gb;
462    if (currRing->minpoly!=NULL)
463    {
464      CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
465      Variable a=rootOf(mipo);
466      CanonicalForm F( convSingAPClapAP( f,a ) ), G( convSingAPClapAP( g,a ) );
467      CanonicalForm FpG=F+G;
468      if (!(FpG.isUnivariate()|| FpG.inCoeffDomain()))
469      //if (!F.isUnivariate() || !G.isUnivariate() || F.mvar()!=G.mvar())
470      {
471        WerrorS("not univariate");
472        return TRUE;
473      }
474      res= convClapAPSingAP( extgcd( F, G, Fa, Gb ) );
475      pa=convClapAPSingAP(Fa);
476      pb=convClapAPSingAP(Gb);
477    }
478    else
479    {
480      CanonicalForm F( convSingTrPClapP( f ) ), G( convSingTrPClapP( g ) );
481      CanonicalForm FpG=F+G;
482      if (!(FpG.isUnivariate()|| FpG.inCoeffDomain()))
483      //if (!F.isUnivariate() || !G.isUnivariate() || F.mvar()!=G.mvar())
484      {
485        Off(SW_RATIONAL);
486        WerrorS("not univariate");
487        return TRUE;
488      }
489      res= convClapPSingTrP( extgcd( F, G, Fa, Gb ) );
490      pa=convClapPSingTrP(Fa);
491      pb=convClapPSingTrP(Gb);
492    }
493    Off(SW_RATIONAL);
494  }
495  else
496  {
497    WerrorS( feNotImplemented );
498    return TRUE;
499  }
500  return FALSE;
501}
502
503poly singclap_pdivide ( poly f, poly g )
504{
505  // for now there is only the possibility to handle polynomials over
506  // Q and Fp ...
507  poly res=NULL;
508  On(SW_RATIONAL);
509  if (( nGetChar() == 0 || nGetChar() > 1 )
510  && (currRing->parameter==NULL))
511  {
512    setCharacteristic( nGetChar() );
513    CanonicalForm F( convSingPClapP( f ) ), G( convSingPClapP( g ) );
514    res = convClapPSingP( F / G );
515  }
516  // and over Q(a) / Fp(a)
517  else if (( nGetChar()==1 ) /* Q(a) */
518  || (nGetChar() <-1))       /* Fp(a) */
519  {
520    if (nGetChar()==1) setCharacteristic( 0 );
521    else               setCharacteristic( -nGetChar() );
522    if (currRing->minpoly!=NULL)
523    {
524      CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
525      Variable a=rootOf(mipo);
526      CanonicalForm F( convSingAPClapAP( f,a ) ), G( convSingAPClapAP( g,a ) );
527      res= convClapAPSingAP(  F / G  );
528    }
529    else
530    {
531      CanonicalForm F( convSingTrPClapP( f ) ), G( convSingTrPClapP( g ) );
532      res= convClapPSingTrP(  F / G  );
533    }
534  }
535  else
536    WerrorS( feNotImplemented );
537  Off(SW_RATIONAL);
538  return res;
539}
540
541void singclap_divide_content ( poly f )
542{
543  if ( f==NULL )
544  {
545    return;
546  }
547  else  if ( pNext( f ) == NULL )
548  {
549    pSetCoeff( f, nInit( 1 ) );
550    return;
551  }
552  else
553  {
554    if ( nGetChar() == 1 )
555      setCharacteristic( 0 );
556    else  if ( nGetChar() == -1 )
557      return; /* not implemented for R */
558    else  if ( nGetChar() < 0 )
559      setCharacteristic( -nGetChar() );
560    else if (currRing->parameter==NULL) /* not GF(q) */
561      setCharacteristic( nGetChar() );
562    else
563      return; /* not implemented*/
564
565    CFList L;
566    CanonicalForm g, h;
567    poly p = pNext(f);
568
569    // first attemp: find 2 smallest g:
570
571    number g1=pGetCoeff(f);
572    number g2=pGetCoeff(p); // p==pNext(f);
573    pIter(p);
574    int sz1=nSize(g1);
575    int sz2=nSize(g2);
576    if (sz1>sz2)
577    {
578      number gg=g1;
579      g1=g2; g2=gg;
580      int sz=sz1;
581      sz1=sz2; sz2=sz;
582    }
583    while (p!=NULL)
584    {
585      int n_sz=nSize(pGetCoeff(p));
586      if (n_sz<sz1)
587      {
588        sz2=sz1;
589        g2=g1;
590        g1=pGetCoeff(p);
591        sz1=n_sz;
592        if (sz1<=3) break;
593      }
594      else if(n_sz<sz2)
595      {
596        sz2=n_sz;
597        g2=pGetCoeff(p);
598        sz2=n_sz;
599      }
600      pIter(p);
601    }
602    FACTORY_ALGOUT( "G", ((lnumber)g1)->z );
603    g = convSingTrClapP( ((lnumber)g1)->z );
604    g = gcd( g, convSingTrClapP( ((lnumber)g2)->z ));
605
606    // second run: gcd's
607
608    p = f;
609    TIMING_START( contentTimer );
610    while ( (p != NULL) && (g != 1)  && ( g != 0))
611    {
612      FACTORY_ALGOUT( "h", (((lnumber)pGetCoeff(p))->z) );
613      h = convSingTrClapP( ((lnumber)pGetCoeff(p))->z );
614      pIter( p );
615#ifdef FACTORY_GCD_STAT
616      // save g
617      CanonicalForm gOld = g;
618#endif
619
620#ifdef FACTORY_GCD_TEST
621      g = CFPrimitiveGcdUtil::gcd( g, h );
622#else
623      g = gcd( g, h );
624#endif
625
626      FACTORY_GCDSTAT( "gcnt:", gOld, h, g );
627      FACTORY_CFTROUT( "g", g );
628      L.append( h );
629    }
630    TIMING_END( contentTimer );
631    FACTORY_CONTSTAT( "cont:", g );
632    if (( g == 1 ) || (g == 0))
633    {
634      // pTest(f);
635      return;
636    }
637    else
638    {
639      CFListIterator i;
640      for ( i = L, p = f; i.hasItem(); i++, p=pNext(p) )
641      {
642        lnumber c=(lnumber)pGetCoeff(p);
643        napDelete(&c->z);
644        c->z=convClapPSingTr( i.getItem() / g );
645        //nTest((number)c);
646        //#ifdef LDEBUG
647        //number cn=(number)c;
648        //StringSetS(""); nWrite(nt); StringAppend(" ==> ");
649        //nWrite(cn);PrintS(StringAppend("\n"));
650        //#endif
651      }
652    }
653    // pTest(f);
654  }
655}
656
657static int primepower(int c)
658{
659  int p=1;
660  int cc=c;
661  while(cc!= rInternalChar(currRing)) { cc*=c; p++; }
662  return p;
663}
664
665int singclap_factorize_retry;
666extern int si_factor_reminder;
667
668ideal singclap_factorize ( poly f, intvec ** v , int with_exps)
669{
670  // with_exps: 3,1 return only true factors, no exponents
671  //            2 return true factors and exponents
672  //            0 return coeff, factors and exponents
673
674
675  ideal res=NULL;
676
677  // handle factorize(0) =========================================
678  if (f==NULL)
679  {
680    res=idInit(1,1);
681    if (with_exps!=1)
682    {
683      (*v)=new intvec(1);
684      (**v)[0]=1;
685    }
686    return res;
687  }
688  // handle factorize(mon) =========================================
689  if (pNext(f)==NULL)
690  {
691    int i=0;
692    int n=0;
693    int e;
694    for(i=pVariables;i>0;i--) if(pGetExp(f,i)!=0) n++;
695    if (with_exps==0) n++; // with coeff
696    res=idInit(si_max(n,1),1);
697    switch(with_exps)
698    {
699      case 0: // with coef & exp.
700        res->m[0]=pOne();
701        pSetCoeff(res->m[0],nCopy(pGetCoeff(f)));
702        // no break
703      case 2: // with exp.
704        (*v)=new intvec(si_max(n,1));
705        (**v)[0]=1;
706        // no break
707      case 1: ;
708      #ifdef TEST
709      default: ;
710      #endif
711    }
712    if (n==0)
713    {
714      res->m[0]=pOne();
715      // (**v)[0]=1; is already done
716      return res;
717    }
718    for(i=pVariables;i>0;i--)
719    {
720      e=pGetExp(f,i);
721      if(e!=0)
722      {
723        n--;
724        poly p=pOne();
725        pSetExp(p,i,1);
726        pSetm(p);
727        res->m[n]=p;
728        if (with_exps!=1) (**v)[n]=e;
729      }
730    }
731    return res;
732  }
733  //PrintS("S:");pWrite(f);PrintLn();
734  // use factory/liffac in general ==============================
735  Off(SW_RATIONAL);
736  On(SW_SYMMETRIC_FF);
737  #ifdef HAVE_NTL
738  extern int prime_number;
739  if(rField_is_Q()) prime_number=0;
740  #endif
741  CFFList L;
742  number N=NULL;
743  CanonicalForm T_F(0);
744  number old_lead_coeff=nCopy(pGetCoeff(f));
745
746  if (rField_is_Q() || rField_is_Zp())
747  {
748    setCharacteristic( nGetChar() );
749    if (nGetChar()==0) /* Q */
750    {
751      //if (f!=NULL) // already tested at start of routine
752      {
753        pCleardenom_n(f,N);
754      }
755    }
756    CanonicalForm F( convSingPClapP( f ) );
757    T_F=F;
758    if (nGetChar()==0) /* Q */
759    {
760      L = factorize( F );
761    }
762    else /* Fp */
763    {
764#ifdef HAVE_LIBFAC_P
765      L = Factorize( F );
766#else
767      goto notImpl;
768#endif
769    }
770  }
771  #if 0
772  else if (rField_is_GF())
773  {
774    int c=rChar(currRing);
775    setCharacteristic( c, primepower(c) );
776    CanonicalForm F( convSingGFClapGF( f ) );
777    T_F=F;
778    if (F.isUnivariate())
779    {
780      L = factorize( F );
781    }
782    else
783    {
784      goto notImpl;
785    }
786  }
787  #endif
788  // and over Q(a) / Fp(a)
789  else if (rField_is_Extension())
790  {
791    if (rField_is_Q_a()) setCharacteristic( 0 );
792    else                 setCharacteristic( -nGetChar() );
793    pCleardenom_n(f,N);
794    if (currRing->minpoly!=NULL)
795    {
796      CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
797      Variable a=rootOf(mipo);
798      CanonicalForm F( convSingAPClapAP( f,a ) );
799      T_F=F;
800      L.insert(F);
801      if (rField_is_Zp_a() && F.isUnivariate())
802      {
803        L = factorize( F, a );
804      }
805      else
806      {
807        CanonicalForm G( convSingTrPClapP( f ) );
808        T_F=G;
809#ifdef HAVE_LIBFAC_P
810        if (rField_is_Q_a())
811        {
812          CFList as(mipo);
813          L = newfactoras( G, as, 1);
814        }
815        else
816        {
817          L=Factorize(G, mipo);
818        }
819#else
820        WarnS("complete factorization only for univariate polynomials");
821        if (rField_is_Q_a()||(!F.isUnivariate()) /* Q(a) */
822        {
823          L = factorize( G );
824        }
825        else
826        {
827          L = factorize( G, a );
828        }
829#endif
830      }
831    }
832    else
833    {
834      CanonicalForm F( convSingTrPClapP( f ) );
835      T_F=F;
836      if (rField_is_Q_a())
837      {
838        L = factorize( F );
839      }
840      else /* Fp(a) */
841      {
842#ifdef HAVE_LIBFAC_P
843        L = Factorize( F );
844        //L = factorize( F );
845#else
846        goto notImpl;
847#endif
848      }
849    }
850  }
851  else
852  {
853    goto notImpl;
854  }
855  {
856    // the first factor should be a constant
857    if ( ! L.getFirst().factor().inCoeffDomain() )
858      L.insert(CFFactor(1,1));
859    // convert into ideal
860    int n = L.length();
861    CFFListIterator J=L;
862    CanonicalForm T=1;
863    for ( ; J.hasItem(); J++ )
864    {
865      int T_e = J.getItem().exp();
866      while(T_e>0)  { T *= J.getItem().factor(); T_e--; }
867    }
868    T_F-=T;
869    if (!T_F.isZero())
870    {
871      poly T_F_conv=pOne();
872      J=L;
873      for ( ; J.hasItem(); J++ )
874      {
875        poly p;
876        int T_e = J.getItem().exp();
877        if (rField_is_Zp() || rField_is_Q())           /* Q, Fp */
878          p=( convClapPSingP( J.getItem().factor() ));
879        else if (rField_is_Extension())     /* Q(a), Fp(a) */
880        {
881          if (currRing->minpoly==NULL)
882            p=( convClapPSingTrP( J.getItem().factor() ));
883          else
884            p=( convClapAPSingAP( J.getItem().factor() ));
885        }
886        while(T_e>0)  { T_F_conv=pMult(T_F_conv,pCopy(p)); T_e--; }
887        pDelete(&p);
888      }
889      number n_T=pGetCoeff(T_F_conv);
890      number n_f=pGetCoeff(f);
891      poly n_f_m=pMult_nn(pCopy(f),n_T);
892      T_F_conv=pMult_nn(T_F_conv,n_f);
893      T_F_conv=pSub(T_F_conv,n_f_m);
894      if ((T_F_conv!=NULL) && (singclap_factorize_retry<1))
895      {
896        singclap_factorize_retry++;
897        if( si_factor_reminder) Print("problem with factorize, retrying\n");
898      #ifdef FEHLER_FACTORIZE
899        Print("Problem....:");pWrite(f);
900        J=L;
901        for ( ; J.hasItem(); J++ )
902        {
903          if (rField_is_Zp() || rField_is_Q())           /* Q, Fp */
904            pWrite0( convClapPSingP( J.getItem().factor() ));
905          else if (rField_is_Extension())     /* Q(a), Fp(a) */
906          {
907            if (currRing->minpoly==NULL)
908              pWrite0( convClapPSingTrP( J.getItem().factor() ));
909            else
910              pWrite0( convClapAPSingAP( J.getItem().factor() ));
911          }
912          Print(" exp: %d\n", J.getItem().exp());
913        }
914        Print("mult:");
915        if (rField_is_Zp() || rField_is_Q())           /* Q, Fp */
916          pWrite( convClapPSingP( T ));
917        else if (rField_is_Extension())     /* Q(a), Fp(a) */
918        {
919          if (currRing->minpoly==NULL)
920            pWrite( convClapPSingTrP( T ));
921          else
922            pWrite( convClapAPSingAP( T ));
923        }
924        Print("diff: sing:"); pWrite(T_F_conv);
925        Print("diff: factory:");
926        if (rField_is_Zp() || rField_is_Q())           /* Q, Fp */
927          pWrite( convClapPSingP( T_F ));
928        else if (rField_is_Extension())     /* Q(a), Fp(a) */
929        {
930          if (currRing->minpoly==NULL)
931            pWrite( convClapPSingTrP( T_F ));
932          else
933            pWrite( convClapAPSingAP( T_F ));
934        }
935      #endif
936        ideal T_i=singclap_factorize ( f, v , with_exps);
937        if (N!=NULL) nDelete(&N);
938        pDelete(&T_F_conv);
939        return T_i;
940      }
941    }
942    J=L;
943    int j=0;
944    if (with_exps!=1)
945    {
946      if ((with_exps==2)&&(n>1))
947      {
948        n--;
949        J++;
950      }
951      *v = new intvec( n );
952    }
953    res = idInit( n ,1);
954    for ( ; J.hasItem(); J++, j++ )
955    {
956      if (with_exps!=1) (**v)[j] = J.getItem().exp();
957      if (rField_is_Zp() || rField_is_Q())           /* Q, Fp */
958        res->m[j] = convClapPSingP( J.getItem().factor() );
959      #if 0
960      else if (rField_is_GF())
961        res->m[j] = convClapGFSingGF( J.getItem().factor() );
962      #endif
963      else if (rField_is_Extension())     /* Q(a), Fp(a) */
964      {
965        if (currRing->minpoly==NULL)
966          res->m[j] = convClapPSingTrP( J.getItem().factor() );
967        else
968          res->m[j] = convClapAPSingAP( J.getItem().factor() );
969      }
970    }
971    if (N!=NULL)
972    {
973      pMult_nn(res->m[0],N);
974    }
975    // delete constants
976    if (res!=NULL)
977    {
978      int i=IDELEMS(res)-1;
979      int j=0;
980      for(;i>=0;i--)
981      {
982        if ((res->m[i]!=NULL)
983        && (pNext(res->m[i])==NULL)
984        && (pIsConstant(res->m[i])))
985        {
986          if (with_exps!=0)
987          {
988            pDelete(&(res->m[i]));
989            if ((v!=NULL) && ((*v)!=NULL))
990              (**v)[i]=0;
991            j++;
992          }
993          else if (i!=0)
994          {
995            while ((v!=NULL) && ((*v)!=NULL) && ((**v)[i]>1))
996            {
997              res->m[0]=pMult(res->m[0],pCopy(res->m[i]));
998              (**v)[i]--;
999            }
1000            res->m[0]=pMult(res->m[0],res->m[i]);
1001            res->m[i]=NULL;
1002            if ((v!=NULL) && ((*v)!=NULL))
1003              (**v)[i]=0;
1004            j++;
1005          }
1006        }
1007      }
1008      if (j>0)
1009      {
1010        idSkipZeroes(res);
1011        if ((v!=NULL) && ((*v)!=NULL))
1012        {
1013          intvec *w=*v;
1014          *v = new intvec( si_max(n-j,1) );
1015          for (i=0,j=0;i<w->length();i++)
1016          {
1017            if((*w)[i]!=0)
1018            {
1019              (**v)[j]=(*w)[i]; j++;
1020            }
1021          }
1022          delete w;
1023        }
1024      }
1025      if (res->m[0]==NULL)
1026      {
1027        res->m[0]=pOne();
1028      }
1029    }
1030  }
1031  if (rField_is_Q_a() && (currRing->minpoly!=NULL))
1032  {
1033    int i=IDELEMS(res)-1;
1034    int stop=1;
1035    if (with_exps!=0) stop=0;
1036    for(;i>=stop;i--)
1037    {
1038      pNorm(res->m[i]);
1039    }
1040    if (with_exps==0) pSetCoeff(res->m[0],old_lead_coeff);
1041    else nDelete(&old_lead_coeff);
1042  }
1043  else
1044    nDelete(&old_lead_coeff);
1045notImpl:
1046  if (res==NULL)
1047    WerrorS( feNotImplemented );
1048  if (N!=NULL)
1049  {
1050    number NN=nInvers(N);
1051    pMult_nn(f,NN);
1052    nDelete(&NN);
1053    nDelete(&N);
1054  }
1055  //PrintS("......S\n");
1056  return res;
1057}
1058
1059matrix singclap_irrCharSeries ( ideal I)
1060{
1061#ifdef HAVE_LIBFAC_P
1062  if (idIs0(I)) return mpNew(1,1);
1063
1064  // for now there is only the possibility to handle polynomials over
1065  // Q and Fp ...
1066  matrix res=NULL;
1067  int i;
1068  Off(SW_RATIONAL);
1069  On(SW_SYMMETRIC_FF);
1070  CFList L;
1071  ListCFList LL;
1072  if (((nGetChar() == 0) || (nGetChar() > 1) )
1073  && (currRing->parameter==NULL))
1074  {
1075    setCharacteristic( nGetChar() );
1076    for(i=0;i<IDELEMS(I);i++)
1077    {
1078      poly p=I->m[i];
1079      if (p!=NULL)
1080      {
1081        p=pCopy(p);
1082        pCleardenom(p);
1083        L.append(convSingPClapP(p));
1084      }
1085    }
1086  }
1087  // and over Q(a) / Fp(a)
1088  else if (( nGetChar()==1 ) /* Q(a) */
1089  || (nGetChar() <-1))       /* Fp(a) */
1090  {
1091    if (nGetChar()==1) setCharacteristic( 0 );
1092    else               setCharacteristic( -nGetChar() );
1093    for(i=0;i<IDELEMS(I);i++)
1094    {
1095      poly p=I->m[i];
1096      if (p!=NULL)
1097      {
1098        p=pCopy(p);
1099        pCleardenom(p);
1100        L.append(convSingTrPClapP(p));
1101      }
1102    }
1103  }
1104  else
1105  {
1106    WerrorS( feNotImplemented );
1107    return res;
1108  }
1109
1110  // a very bad work-around --- FIX IT in libfac
1111  // should be fixed as of 2001/6/27
1112  int tries=0;
1113  int m,n;
1114  ListIterator<CFList> LLi;
1115  loop
1116  {
1117    LL=IrrCharSeries(L);
1118    m= LL.length(); // Anzahl Zeilen
1119    n=0;
1120    for ( LLi = LL; LLi.hasItem(); LLi++ )
1121    {
1122      n = si_max(LLi.getItem().length(),n);
1123    }
1124    if ((m!=0) && (n!=0)) break;
1125    tries++;
1126    if (tries>=5) break;
1127  }
1128  if ((m==0) || (n==0))
1129  {
1130    Warn("char_series returns %d x %d matrix from %d input polys (%d)",
1131      m,n,IDELEMS(I)+1,LL.length());
1132    iiWriteMatrix((matrix)I,"I",2,0);
1133    m=si_max(m,1);
1134    n=si_max(n,1);
1135  }
1136  res=mpNew(m,n);
1137  CFListIterator Li;
1138  for ( m=1, LLi = LL; LLi.hasItem(); LLi++, m++ )
1139  {
1140    for (n=1, Li = LLi.getItem(); Li.hasItem(); Li++, n++)
1141    {
1142      if ( (nGetChar() == 0) || (nGetChar() > 1) )
1143        MATELEM(res,m,n)=convClapPSingP(Li.getItem());
1144      else
1145        MATELEM(res,m,n)=convClapPSingTrP(Li.getItem());
1146    }
1147  }
1148  Off(SW_RATIONAL);
1149  return res;
1150#else
1151  return NULL;
1152#endif
1153}
1154
1155char* singclap_neworder ( ideal I)
1156{
1157#ifdef HAVE_LIBFAC_P
1158  int i;
1159  Off(SW_RATIONAL);
1160  On(SW_SYMMETRIC_FF);
1161  CFList L;
1162  if (((nGetChar() == 0) || (nGetChar() > 1) )
1163  && (currRing->parameter==NULL))
1164  {
1165    setCharacteristic( nGetChar() );
1166    for(i=0;i<IDELEMS(I);i++)
1167    {
1168      L.append(convSingPClapP(I->m[i]));
1169    }
1170  }
1171  // and over Q(a) / Fp(a)
1172  else if (( nGetChar()==1 ) /* Q(a) */
1173  || (nGetChar() <-1))       /* Fp(a) */
1174  {
1175    if (nGetChar()==1) setCharacteristic( 0 );
1176    else               setCharacteristic( -nGetChar() );
1177    for(i=0;i<IDELEMS(I);i++)
1178    {
1179      L.append(convSingTrPClapP(I->m[i]));
1180    }
1181  }
1182  else
1183  {
1184    WerrorS( feNotImplemented );
1185    return NULL;
1186  }
1187
1188  List<int> IL=neworderint(L);
1189  ListIterator<int> Li;
1190  StringSetS("");
1191  Li = IL;
1192  int offs=rPar(currRing);
1193  int* mark=(int*)omAlloc0((pVariables+offs)*sizeof(int));
1194  int cnt=pVariables+offs;
1195  loop
1196  {
1197    if(! Li.hasItem()) break;
1198    BOOLEAN done=TRUE;
1199    i=Li.getItem()-1;
1200    mark[i]=1;
1201    if (i<offs)
1202    {
1203      done=FALSE;
1204      //StringAppendS(currRing->parameter[i]);
1205    }
1206    else
1207    {
1208      StringAppendS(currRing->names[i-offs]);
1209    }
1210    Li++;
1211    cnt--;
1212    if(cnt==0) break;
1213    if (done) StringAppendS(",");
1214  }
1215  for(i=0;i<pVariables+offs;i++)
1216  {
1217    BOOLEAN done=TRUE;
1218    if(mark[i]==0)
1219    {
1220      if (i<offs)
1221      {
1222        done=FALSE;
1223        //StringAppendS(currRing->parameter[i]);
1224      }
1225      else
1226      {
1227        StringAppendS(currRing->names[i-offs]);
1228      }
1229      cnt--;
1230      if(cnt==0) break;
1231      if (done) StringAppendS(",");
1232    }
1233  }
1234  char * s=omStrDup(StringAppendS(""));
1235  if (s[strlen(s)-1]==',') s[strlen(s)-1]='\0';
1236  return s;
1237#else
1238  return NULL;
1239#endif
1240}
1241
1242BOOLEAN singclap_isSqrFree(poly f)
1243{
1244  BOOLEAN b=FALSE;
1245  Off(SW_RATIONAL);
1246  //  Q / Fp
1247  if (((nGetChar() == 0) || (nGetChar() > 1) )
1248  &&(currRing->parameter==NULL))
1249  {
1250    setCharacteristic( nGetChar() );
1251    CanonicalForm F( convSingPClapP( f ) );
1252    if((nGetChar()>1)&&(!F.isUnivariate()))
1253      goto err;
1254    b=(BOOLEAN)isSqrFree(F);
1255  }
1256  // and over Q(a) / Fp(a)
1257  else if (( nGetChar()==1 ) /* Q(a) */
1258  || (nGetChar() <-1))       /* Fp(a) */
1259  {
1260    if (nGetChar()==1) setCharacteristic( 0 );
1261    else               setCharacteristic( -nGetChar() );
1262    //if (currRing->minpoly!=NULL)
1263    //{
1264    //  CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
1265    //  Variable a=rootOf(mipo);
1266    //  CanonicalForm F( convSingAPClapAP( f,a ) );
1267    //  ...
1268    //}
1269    //else
1270    {
1271      CanonicalForm F( convSingTrPClapP( f ) );
1272      b=(BOOLEAN)isSqrFree(F);
1273    }
1274    Off(SW_RATIONAL);
1275  }
1276  else
1277  {
1278err:
1279    WerrorS( feNotImplemented );
1280  }
1281  return b;
1282}
1283
1284poly singclap_det( const matrix m )
1285{
1286  int r=m->rows();
1287  if (r!=m->cols())
1288  {
1289    Werror("det of %d x %d matrix",r,m->cols());
1290    return NULL;
1291  }
1292  poly res=NULL;
1293  if (( nGetChar() == 0 || nGetChar() > 1 )
1294  && (currRing->parameter==NULL))
1295  {
1296    setCharacteristic( nGetChar() );
1297    CFMatrix M(r,r);
1298    int i,j;
1299    for(i=r;i>0;i--)
1300    {
1301      for(j=r;j>0;j--)
1302      {
1303        M(i,j)=convSingPClapP(MATELEM(m,i,j));
1304      }
1305    }
1306    res= convClapPSingP( determinant(M,r) ) ;
1307  }
1308  // and over Q(a) / Fp(a)
1309  else if (( nGetChar()==1 ) /* Q(a) */
1310  || (nGetChar() <-1))       /* Fp(a) */
1311  {
1312    if (nGetChar()==1) setCharacteristic( 0 );
1313    else               setCharacteristic( -nGetChar() );
1314    CFMatrix M(r,r);
1315    poly res;
1316    if (currRing->minpoly!=NULL)
1317    {
1318      CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
1319      Variable a=rootOf(mipo);
1320      int i,j;
1321      for(i=r;i>0;i--)
1322      {
1323        for(j=r;j>0;j--)
1324        {
1325          M(i,j)=convSingAPClapAP(MATELEM(m,i,j),a);
1326        }
1327      }
1328      res= convClapAPSingAP( determinant(M,r) ) ;
1329    }
1330    else
1331    {
1332      int i,j;
1333      for(i=r;i>0;i--)
1334      {
1335        for(j=r;j>0;j--)
1336        {
1337          M(i,j)=convSingTrPClapP(MATELEM(m,i,j));
1338        }
1339      }
1340      res= convClapPSingTrP( determinant(M,r) );
1341    }
1342  }
1343  else
1344    WerrorS( feNotImplemented );
1345  Off(SW_RATIONAL);
1346  return res;
1347}
1348
1349int singclap_det_i( intvec * m )
1350{
1351  setCharacteristic( 0 );
1352  CFMatrix M(m->rows(),m->cols());
1353  int i,j;
1354  for(i=m->rows();i>0;i--)
1355  {
1356    for(j=m->cols();j>0;j--)
1357    {
1358      M(i,j)=IMATELEM(*m,i,j);
1359    }
1360  }
1361  int res= convClapISingI( determinant(M,m->rows())) ;
1362  Off(SW_RATIONAL);
1363  return res;
1364}
1365napoly singclap_alglcm ( napoly f, napoly g )
1366{
1367 FACTORY_ALGOUT( "f", f );
1368 FACTORY_ALGOUT( "g", g );
1369
1370 // over Q(a) / Fp(a)
1371 if (nGetChar()==1) setCharacteristic( 0 );
1372 else               setCharacteristic( -nGetChar() );
1373 napoly res;
1374
1375 if (currRing->minpoly!=NULL)
1376 {
1377   CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
1378   Variable a=rootOf(mipo);
1379   CanonicalForm F( convSingAClapA( f,a ) ), G( convSingAClapA( g,a ) );
1380   CanonicalForm GCD;
1381
1382   TIMING_START( algLcmTimer );
1383   // calculate gcd
1384#ifdef FACTORY_GCD_TEST
1385   GCD = CFPrimitiveGcdUtil::gcd( F, G );
1386#else
1387   GCD = gcd( F, G );
1388#endif
1389   TIMING_END( algLcmTimer );
1390
1391   FACTORY_CFAOUT( "d", GCD );
1392   FACTORY_GCDSTAT( "alcm:", F, G, GCD );
1393
1394   // calculate lcm
1395   res= convClapASingA( (F/GCD)*G );
1396 }
1397 else
1398 {
1399   CanonicalForm F( convSingTrClapP( f ) ), G( convSingTrClapP( g ) );
1400   CanonicalForm GCD;
1401   TIMING_START( algLcmTimer );
1402   // calculate gcd
1403#ifdef FACTORY_GCD_TEST
1404   GCD = CFPrimitiveGcdUtil::gcd( F, G );
1405#else
1406   GCD = gcd( F, G );
1407#endif
1408   TIMING_END( algLcmTimer );
1409
1410   FACTORY_CFTROUT( "d", GCD );
1411   FACTORY_GCDSTAT( "alcm:", F, G, GCD );
1412
1413   // calculate lcm
1414   res= convClapPSingTr( (F/GCD)*G );
1415 }
1416
1417 Off(SW_RATIONAL);
1418 return res;
1419}
1420
1421void singclap_algdividecontent ( napoly f, napoly g, napoly &ff, napoly &gg )
1422{
1423 FACTORY_ALGOUT( "f", f );
1424 FACTORY_ALGOUT( "g", g );
1425
1426 // over Q(a) / Fp(a)
1427 if (nGetChar()==1) setCharacteristic( 0 );
1428 else               setCharacteristic( -nGetChar() );
1429 ff=gg=NULL;
1430 On(SW_RATIONAL);
1431
1432 if (currRing->minpoly!=NULL)
1433 {
1434   CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
1435   Variable a=rootOf(mipo);
1436   CanonicalForm F( convSingAClapA( f,a ) ), G( convSingAClapA( g,a ) );
1437   CanonicalForm GCD;
1438
1439   TIMING_START( algContentTimer );
1440#ifdef FACTORY_GCD_TEST
1441   GCD=CFPrimitiveGcdUtil::gcd( F, G );
1442#else
1443   GCD=gcd( F, G );
1444#endif
1445   TIMING_END( algContentTimer );
1446
1447   FACTORY_CFAOUT( "d", GCD );
1448   FACTORY_GCDSTAT( "acnt:", F, G, GCD );
1449
1450   if ((GCD!=1) && (GCD!=0))
1451   {
1452     ff= convClapASingA( F/ GCD );
1453     gg= convClapASingA( G/ GCD );
1454   }
1455 }
1456 else
1457 {
1458   CanonicalForm F( convSingTrClapP( f ) ), G( convSingTrClapP( g ) );
1459   CanonicalForm GCD;
1460
1461   TIMING_START( algContentTimer );
1462#ifdef FACTORY_GCD_TEST
1463   GCD=CFPrimitiveGcdUtil::gcd( F, G );
1464#else
1465   GCD=gcd( F, G );
1466#endif
1467   TIMING_END( algContentTimer );
1468
1469   FACTORY_CFTROUT( "d", GCD );
1470   FACTORY_GCDSTAT( "acnt:", F, G, GCD );
1471
1472   if ((GCD!=1) && (GCD!=0))
1473   {
1474     ff= convClapPSingTr( F/ GCD );
1475     gg= convClapPSingTr( G/ GCD );
1476   }
1477 }
1478
1479 Off(SW_RATIONAL);
1480}
1481
1482#if 0
1483lists singclap_chineseRemainder(lists x, lists q)
1484{
1485  //assume(x->nr == q->nr);
1486  //assume(x->nr >= 0);
1487  int n=x->nr+1;
1488  if ((x->nr<0) || (x->nr!=q->nr))
1489  {
1490    WerrorS("list are empty or not of equal length");
1491    return NULL;
1492  }
1493  lists res=(lists)omAlloc0Bin(slists_bin);
1494  CFArray X(1,n), Q(1,n);
1495  int i;
1496  for(i=0; i<n; i++)
1497  {
1498    if (x->m[i-1].Typ()==INT_CMD)
1499    {
1500      X[i]=(int)x->m[i-1].Data();
1501    }
1502    else if (x->m[i-1].Typ()==NUMBER_CMD)
1503    {
1504      number N=(number)x->m[i-1].Data();
1505      X[i]=convSingNClapN(N);
1506    }
1507    else
1508    {
1509      WerrorS("illegal type in chineseRemainder");
1510      omFreeBin(res,slists_bin);
1511      return NULL;
1512    }
1513    if (q->m[i-1].Typ()==INT_CMD)
1514    {
1515      Q[i]=(int)q->m[i-1].Data();
1516    }
1517    else if (q->m[i-1].Typ()==NUMBER_CMD)
1518    {
1519      number N=(number)x->m[i-1].Data();
1520      Q[i]=convSingNClapN(N);
1521    }
1522    else
1523    {
1524      WerrorS("illegal type in chineseRemainder");
1525      omFreeBin(res,slists_bin);
1526      return NULL;
1527    }
1528  }
1529  CanonicalForm r, prod;
1530  chineseRemainder( X, Q, r, prod );
1531  res->Init(2);
1532  res->m[0].rtyp=NUMBER_CMD;
1533  res->m[1].rtyp=NUMBER_CMD;
1534  res->m[0].data=(char *)convClapNSingN( r );
1535  res->m[1].data=(char *)convClapNSingN( prod );
1536  return res;
1537}
1538#endif
1539#endif
Note: See TracBrowser for help on using the repository browser.