source: git/kernel/clapsing.cc @ e707b8

spielwiese
Last change on this file since e707b8 was e707b8, checked in by Hans Schönemann <hannes@…>, 19 years ago
*hannes: factory switches centralized git-svn-id: file:///usr/local/Singular/svn/trunk@7802 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 34.4 KB
Line 
1// emacs edit mode for this file is -*- C++ -*-
2/****************************************
3*  Computer Algebra System SINGULAR     *
4****************************************/
5// $Id: clapsing.cc,v 1.5 2005-03-30 13:17:08 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
665ideal singclap_factorize ( poly f, intvec ** v , int with_exps)
666{
667  // with_exps: 3,1 return only true factors, no exponents
668  //            2 return true factors and exponents
669  //            0 return coeff, factors and exponents
670
671
672  ideal res=NULL;
673
674  // handle factorize(0) =========================================
675  if (f==NULL)
676  {
677    res=idInit(1,1);
678    if (with_exps!=1)
679    {
680      (*v)=new intvec(1);
681      (**v)[0]=1;
682    }
683    return res;
684  }
685  // handle factorize(mon) =========================================
686  if (pNext(f)==NULL)
687  {
688    int i=0;
689    int n=0;
690    int e;
691    for(i=pVariables;i>0;i--) if(pGetExp(f,i)!=0) n++;
692    if (with_exps==0) n++; // with coeff
693    res=idInit(si_max(n,1),1);
694    switch(with_exps)
695    {
696      case 0: // with coef & exp.
697        res->m[0]=pOne();
698        pSetCoeff(res->m[0],nCopy(pGetCoeff(f)));
699        // no break
700      case 2: // with exp.
701        (*v)=new intvec(si_max(n,1));
702        (**v)[0]=1;
703        // no break
704      case 1: ;
705      #ifdef TEST
706      default: ;
707      #endif
708    }
709    if (n==0)
710    {
711      res->m[0]=pOne();
712      // (**v)[0]=1; is already done
713      return res;
714    }
715    for(i=pVariables;i>0;i--)
716    {
717      e=pGetExp(f,i);
718      if(e!=0)
719      {
720        n--;
721        poly p=pOne();
722        pSetExp(p,i,1);
723        pSetm(p);
724        res->m[n]=p;
725        if (with_exps!=1) (**v)[n]=e;
726      }
727    }
728    return res;
729  }
730  //PrintS("S:");pWrite(f);PrintLn();
731  // use factory/liffac in general ==============================
732  Off(SW_RATIONAL);
733  On(SW_SYMMETRIC_FF);
734  #ifdef HAVE_NTL
735  extern int prime_number;
736  if(rField_is_Q()) prime_number=0;
737  #endif
738  CFFList L;
739  number N=NULL;
740  number NN=NULL;
741  number old_lead_coeff=nCopy(pGetCoeff(f));
742
743  if (rField_is_Q() || rField_is_Zp())
744  {
745    setCharacteristic( nGetChar() );
746    if (nGetChar()==0) /* Q */
747    {
748      //if (f!=NULL) // already tested at start of routine
749      {
750        number n0=nCopy(pGetCoeff(f));
751        if (with_exps==0)
752          N=nCopy(n0);
753        pCleardenom(f);
754        NN=nDiv(n0,pGetCoeff(f));
755        nDelete(&n0);
756        if (with_exps==0)
757        {
758          nDelete(&N);
759          N=nCopy(NN);
760        }
761      }
762    }
763    CanonicalForm F( convSingPClapP( f ) );
764    if (nGetChar()==0) /* Q */
765    {
766      L = factorize( F );
767    }
768    else /* Fp */
769    {
770#ifdef HAVE_LIBFAC_P
771      L = Factorize( F );
772#else
773      goto notImpl;
774#endif
775    }
776  }
777  #if 0
778  else if (rField_is_GF())
779  {
780    int c=rChar(currRing);
781    setCharacteristic( c, primepower(c) );
782    CanonicalForm F( convSingGFClapGF( f ) );
783    if (F.isUnivariate())
784    {
785      L = factorize( F );
786    }
787    else
788    {
789      goto notImpl;
790    }
791  }
792  #endif
793  // and over Q(a) / Fp(a)
794  else if (rField_is_Extension())
795  {
796    if (rField_is_Q_a()) setCharacteristic( 0 );
797    else                 setCharacteristic( -nGetChar() );
798    if (currRing->minpoly!=NULL)
799    {
800      CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
801      Variable a=rootOf(mipo);
802      CanonicalForm F( convSingAPClapAP( f,a ) );
803      L.insert(F);
804      if (rField_is_Zp_a() && F.isUnivariate())
805      {
806        L = factorize( F, a );
807      }
808      else
809      {
810        CanonicalForm G( convSingTrPClapP( f ) );
811#ifdef HAVE_LIBFAC_P
812        if (rField_is_Q_a())
813        {
814          CFList as(mipo);
815          L = newfactoras( G, as, 1);
816        }
817        else
818        {
819          L=Factorize(G, mipo);
820        }
821#else
822        WarnS("complete factorization only for univariate polynomials");
823        if (rField_is_Q_a()||(!F.isUnivariate()) /* Q(a) */
824        {
825          L = factorize( G );
826        }
827        else
828        {
829          L = factorize( G, a );
830        }
831#endif
832      }
833    }
834    else
835    {
836      CanonicalForm F( convSingTrPClapP( f ) );
837      if (rField_is_Q_a())
838      {
839        L = factorize( F );
840      }
841      else /* Fp(a) */
842      {
843#ifdef HAVE_LIBFAC_P
844        L = Factorize( F );
845        //L = factorize( F );
846#else
847        goto notImpl;
848#endif
849      }
850    }
851  }
852  else
853  {
854    goto notImpl;
855  }
856  {
857    // the first factor should be a constant
858    if ( ! L.getFirst().factor().inCoeffDomain() )
859      L.insert(CFFactor(1,1));
860    // convert into ideal
861    int n = L.length();
862    CFFListIterator J=L;
863    int j=0;
864    if (with_exps!=1)
865    {
866      if ((with_exps==2)&&(n>1))
867      {
868        n--;
869        J++;
870      }
871      *v = new intvec( n );
872    }
873    res = idInit( n ,1);
874    for ( ; J.hasItem(); J++, j++ )
875    {
876      if (with_exps!=1) (**v)[j] = J.getItem().exp();
877      if (rField_is_Zp() || rField_is_Q())           /* Q, Fp */
878        res->m[j] = convClapPSingP( J.getItem().factor() );
879      #if 0
880      else if (rField_is_GF())
881        res->m[j] = convClapGFSingGF( J.getItem().factor() );
882      #endif
883      else if (rField_is_Extension())     /* Q(a), Fp(a) */
884      {
885        if (currRing->minpoly==NULL)
886          res->m[j] = convClapPSingTrP( J.getItem().factor() );
887        else
888          res->m[j] = convClapAPSingAP( J.getItem().factor() );
889      }
890    }
891    if (N!=NULL)
892    {
893      pMult_nn(res->m[0],N);
894      nDelete(&N);
895      N=NULL;
896    }
897    // delete constants
898    if (res!=NULL)
899    {
900      int i=IDELEMS(res)-1;
901      int j=0;
902      for(;i>=0;i--)
903      {
904        if ((res->m[i]!=NULL)
905        && (pNext(res->m[i])==NULL)
906        && (pIsConstant(res->m[i])))
907        {
908          if (with_exps!=0)
909          {
910            pDelete(&(res->m[i]));
911            if ((v!=NULL) && ((*v)!=NULL))
912              (**v)[i]=0;
913            j++;
914          }
915          else if (i!=0)
916          {
917            while ((v!=NULL) && ((*v)!=NULL) && ((**v)[i]>1))
918            {
919              res->m[0]=pMult(res->m[0],pCopy(res->m[i]));
920              (**v)[i]--;
921            }
922            res->m[0]=pMult(res->m[0],res->m[i]);
923            res->m[i]=NULL;
924            if ((v!=NULL) && ((*v)!=NULL))
925              (**v)[i]=0;
926            j++;
927          }
928        }
929      }
930      if (j>0)
931      {
932        idSkipZeroes(res);
933        if ((v!=NULL) && ((*v)!=NULL))
934        {
935          intvec *w=*v;
936          *v = new intvec( si_max(n-j,1) );
937          for (i=0,j=0;i<w->length();i++)
938          {
939            if((*w)[i]!=0)
940            {
941              (**v)[j]=(*w)[i]; j++;
942            }
943          }
944          delete w;
945        }
946      }
947      if (res->m[0]==NULL)
948      {
949        res->m[0]=pOne();
950      }
951    }
952  }
953  if (rField_is_Q_a() && (currRing->minpoly!=NULL))
954  {
955    int i=IDELEMS(res)-1;
956    int stop=1;
957    if (with_exps!=0) stop=0;
958    for(;i>=stop;i--)
959    {
960      pNorm(res->m[i]);
961    }
962    if (with_exps==0) pSetCoeff(res->m[0],old_lead_coeff);
963    else nDelete(&old_lead_coeff);
964  }
965  else
966    nDelete(&old_lead_coeff);
967notImpl:
968  if (res==NULL)
969    WerrorS( feNotImplemented );
970  if (NN!=NULL)
971  {
972    pMult_nn(f,NN);
973    nDelete(&NN);
974  }
975  if (N!=NULL)
976  {
977    nDelete(&N);
978  }
979  //PrintS("......S\n");
980  return res;
981}
982
983matrix singclap_irrCharSeries ( ideal I)
984{
985#ifdef HAVE_LIBFAC_P
986  if (idIs0(I)) return mpNew(1,1);
987
988  // for now there is only the possibility to handle polynomials over
989  // Q and Fp ...
990  matrix res=NULL;
991  int i;
992  Off(SW_RATIONAL);
993  On(SW_SYMMETRIC_FF);
994  CFList L;
995  ListCFList LL;
996  if (((nGetChar() == 0) || (nGetChar() > 1) )
997  && (currRing->parameter==NULL))
998  {
999    setCharacteristic( nGetChar() );
1000    for(i=0;i<IDELEMS(I);i++)
1001    {
1002      poly p=I->m[i];
1003      if (p!=NULL)
1004      {
1005        p=pCopy(p);
1006        pCleardenom(p);
1007        L.append(convSingPClapP(p));
1008      }
1009    }
1010  }
1011  // and over Q(a) / Fp(a)
1012  else if (( nGetChar()==1 ) /* Q(a) */
1013  || (nGetChar() <-1))       /* Fp(a) */
1014  {
1015    if (nGetChar()==1) setCharacteristic( 0 );
1016    else               setCharacteristic( -nGetChar() );
1017    for(i=0;i<IDELEMS(I);i++)
1018    {
1019      poly p=I->m[i];
1020      if (p!=NULL)
1021      {
1022        p=pCopy(p);
1023        pCleardenom(p);
1024        L.append(convSingTrPClapP(p));
1025      }
1026    }
1027  }
1028  else
1029  {
1030    WerrorS( feNotImplemented );
1031    return res;
1032  }
1033
1034  // a very bad work-around --- FIX IT in libfac
1035  // should be fixed as of 2001/6/27
1036  int tries=0;
1037  int m,n;
1038  ListIterator<CFList> LLi;
1039  loop
1040  {
1041    LL=IrrCharSeries(L);
1042    m= LL.length(); // Anzahl Zeilen
1043    n=0;
1044    for ( LLi = LL; LLi.hasItem(); LLi++ )
1045    {
1046      n = si_max(LLi.getItem().length(),n);
1047    }
1048    if ((m!=0) && (n!=0)) break;
1049    tries++;
1050    if (tries>=5) break;
1051  }
1052  if ((m==0) || (n==0))
1053  {
1054    Warn("char_series returns %d x %d matrix from %d input polys (%d)",
1055      m,n,IDELEMS(I)+1,LL.length());
1056    iiWriteMatrix((matrix)I,"I",2,0);
1057    m=si_max(m,1);
1058    n=si_max(n,1);
1059  }
1060  res=mpNew(m,n);
1061  CFListIterator Li;
1062  for ( m=1, LLi = LL; LLi.hasItem(); LLi++, m++ )
1063  {
1064    for (n=1, Li = LLi.getItem(); Li.hasItem(); Li++, n++)
1065    {
1066      if ( (nGetChar() == 0) || (nGetChar() > 1) )
1067        MATELEM(res,m,n)=convClapPSingP(Li.getItem());
1068      else
1069        MATELEM(res,m,n)=convClapPSingTrP(Li.getItem());
1070    }
1071  }
1072  Off(SW_RATIONAL);
1073  return res;
1074#else
1075  return NULL;
1076#endif
1077}
1078
1079char* singclap_neworder ( ideal I)
1080{
1081#ifdef HAVE_LIBFAC_P
1082  int i;
1083  Off(SW_RATIONAL);
1084  On(SW_SYMMETRIC_FF);
1085  CFList L;
1086  if (((nGetChar() == 0) || (nGetChar() > 1) )
1087  && (currRing->parameter==NULL))
1088  {
1089    setCharacteristic( nGetChar() );
1090    for(i=0;i<IDELEMS(I);i++)
1091    {
1092      L.append(convSingPClapP(I->m[i]));
1093    }
1094  }
1095  // and over Q(a) / Fp(a)
1096  else if (( nGetChar()==1 ) /* Q(a) */
1097  || (nGetChar() <-1))       /* Fp(a) */
1098  {
1099    if (nGetChar()==1) setCharacteristic( 0 );
1100    else               setCharacteristic( -nGetChar() );
1101    for(i=0;i<IDELEMS(I);i++)
1102    {
1103      L.append(convSingTrPClapP(I->m[i]));
1104    }
1105  }
1106  else
1107  {
1108    WerrorS( feNotImplemented );
1109    return NULL;
1110  }
1111
1112  List<int> IL=neworderint(L);
1113  ListIterator<int> Li;
1114  StringSetS("");
1115  Li = IL;
1116  int offs=rPar(currRing);
1117  int* mark=(int*)omAlloc0((pVariables+offs)*sizeof(int));
1118  int cnt=pVariables+offs;
1119  loop
1120  {
1121    if(! Li.hasItem()) break;
1122    BOOLEAN done=TRUE;
1123    i=Li.getItem()-1;
1124    mark[i]=1;
1125    if (i<offs)
1126    {
1127      done=FALSE;
1128      //StringAppendS(currRing->parameter[i]);
1129    }
1130    else
1131    {
1132      StringAppendS(currRing->names[i-offs]);
1133    }
1134    Li++;
1135    cnt--;
1136    if(cnt==0) break;
1137    if (done) StringAppendS(",");
1138  }
1139  for(i=0;i<pVariables+offs;i++)
1140  {
1141    BOOLEAN done=TRUE;
1142    if(mark[i]==0)
1143    {
1144      if (i<offs)
1145      {
1146        done=FALSE;
1147        //StringAppendS(currRing->parameter[i]);
1148      }
1149      else
1150      {
1151        StringAppendS(currRing->names[i-offs]);
1152      }
1153      cnt--;
1154      if(cnt==0) break;
1155      if (done) StringAppendS(",");
1156    }
1157  }
1158  char * s=omStrDup(StringAppendS(""));
1159  if (s[strlen(s)-1]==',') s[strlen(s)-1]='\0';
1160  return s;
1161#else
1162  return NULL;
1163#endif
1164}
1165
1166BOOLEAN singclap_isSqrFree(poly f)
1167{
1168  BOOLEAN b=FALSE;
1169  Off(SW_RATIONAL);
1170  //  Q / Fp
1171  if (((nGetChar() == 0) || (nGetChar() > 1) )
1172  &&(currRing->parameter==NULL))
1173  {
1174    setCharacteristic( nGetChar() );
1175    CanonicalForm F( convSingPClapP( f ) );
1176    if((nGetChar()>1)&&(!F.isUnivariate()))
1177      goto err;
1178    b=(BOOLEAN)isSqrFree(F);
1179  }
1180  // and over Q(a) / Fp(a)
1181  else if (( nGetChar()==1 ) /* Q(a) */
1182  || (nGetChar() <-1))       /* Fp(a) */
1183  {
1184    if (nGetChar()==1) setCharacteristic( 0 );
1185    else               setCharacteristic( -nGetChar() );
1186    //if (currRing->minpoly!=NULL)
1187    //{
1188    //  CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
1189    //  Variable a=rootOf(mipo);
1190    //  CanonicalForm F( convSingAPClapAP( f,a ) );
1191    //  ...
1192    //}
1193    //else
1194    {
1195      CanonicalForm F( convSingTrPClapP( f ) );
1196      b=(BOOLEAN)isSqrFree(F);
1197    }
1198    Off(SW_RATIONAL);
1199  }
1200  else
1201  {
1202err:
1203    WerrorS( feNotImplemented );
1204  }
1205  return b;
1206}
1207
1208poly singclap_det( const matrix m )
1209{
1210  int r=m->rows();
1211  if (r!=m->cols())
1212  {
1213    Werror("det of %d x %d matrix",r,m->cols());
1214    return NULL;
1215  }
1216  poly res=NULL;
1217  if (( nGetChar() == 0 || nGetChar() > 1 )
1218  && (currRing->parameter==NULL))
1219  {
1220    setCharacteristic( nGetChar() );
1221    CFMatrix M(r,r);
1222    int i,j;
1223    for(i=r;i>0;i--)
1224    {
1225      for(j=r;j>0;j--)
1226      {
1227        M(i,j)=convSingPClapP(MATELEM(m,i,j));
1228      }
1229    }
1230    res= convClapPSingP( determinant(M,r) ) ;
1231  }
1232  // and over Q(a) / Fp(a)
1233  else if (( nGetChar()==1 ) /* Q(a) */
1234  || (nGetChar() <-1))       /* Fp(a) */
1235  {
1236    if (nGetChar()==1) setCharacteristic( 0 );
1237    else               setCharacteristic( -nGetChar() );
1238    CFMatrix M(r,r);
1239    poly res;
1240    if (currRing->minpoly!=NULL)
1241    {
1242      CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
1243      Variable a=rootOf(mipo);
1244      int i,j;
1245      for(i=r;i>0;i--)
1246      {
1247        for(j=r;j>0;j--)
1248        {
1249          M(i,j)=convSingAPClapAP(MATELEM(m,i,j),a);
1250        }
1251      }
1252      res= convClapAPSingAP( determinant(M,r) ) ;
1253    }
1254    else
1255    {
1256      int i,j;
1257      for(i=r;i>0;i--)
1258      {
1259        for(j=r;j>0;j--)
1260        {
1261          M(i,j)=convSingTrPClapP(MATELEM(m,i,j));
1262        }
1263      }
1264      res= convClapPSingTrP( determinant(M,r) );
1265    }
1266  }
1267  else
1268    WerrorS( feNotImplemented );
1269  Off(SW_RATIONAL);
1270  return res;
1271}
1272
1273int singclap_det_i( intvec * m )
1274{
1275  setCharacteristic( 0 );
1276  CFMatrix M(m->rows(),m->cols());
1277  int i,j;
1278  for(i=m->rows();i>0;i--)
1279  {
1280    for(j=m->cols();j>0;j--)
1281    {
1282      M(i,j)=IMATELEM(*m,i,j);
1283    }
1284  }
1285  int res= convClapISingI( determinant(M,m->rows())) ;
1286  Off(SW_RATIONAL);
1287  return res;
1288}
1289napoly singclap_alglcm ( napoly f, napoly g )
1290{
1291 FACTORY_ALGOUT( "f", f );
1292 FACTORY_ALGOUT( "g", g );
1293
1294 // over Q(a) / Fp(a)
1295 if (nGetChar()==1) setCharacteristic( 0 );
1296 else               setCharacteristic( -nGetChar() );
1297 napoly res;
1298
1299 if (currRing->minpoly!=NULL)
1300 {
1301   CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
1302   Variable a=rootOf(mipo);
1303   CanonicalForm F( convSingAClapA( f,a ) ), G( convSingAClapA( g,a ) );
1304   CanonicalForm GCD;
1305
1306   TIMING_START( algLcmTimer );
1307   // calculate gcd
1308#ifdef FACTORY_GCD_TEST
1309   GCD = CFPrimitiveGcdUtil::gcd( F, G );
1310#else
1311   GCD = gcd( F, G );
1312#endif
1313   TIMING_END( algLcmTimer );
1314
1315   FACTORY_CFAOUT( "d", GCD );
1316   FACTORY_GCDSTAT( "alcm:", F, G, GCD );
1317
1318   // calculate lcm
1319   res= convClapASingA( (F/GCD)*G );
1320 }
1321 else
1322 {
1323   CanonicalForm F( convSingTrClapP( f ) ), G( convSingTrClapP( g ) );
1324   CanonicalForm GCD;
1325   TIMING_START( algLcmTimer );
1326   // calculate gcd
1327#ifdef FACTORY_GCD_TEST
1328   GCD = CFPrimitiveGcdUtil::gcd( F, G );
1329#else
1330   GCD = gcd( F, G );
1331#endif
1332   TIMING_END( algLcmTimer );
1333
1334   FACTORY_CFTROUT( "d", GCD );
1335   FACTORY_GCDSTAT( "alcm:", F, G, GCD );
1336
1337   // calculate lcm
1338   res= convClapPSingTr( (F/GCD)*G );
1339 }
1340
1341 Off(SW_RATIONAL);
1342 return res;
1343}
1344
1345void singclap_algdividecontent ( napoly f, napoly g, napoly &ff, napoly &gg )
1346{
1347 FACTORY_ALGOUT( "f", f );
1348 FACTORY_ALGOUT( "g", g );
1349
1350 // over Q(a) / Fp(a)
1351 if (nGetChar()==1) setCharacteristic( 0 );
1352 else               setCharacteristic( -nGetChar() );
1353 ff=gg=NULL;
1354 On(SW_RATIONAL);
1355
1356 if (currRing->minpoly!=NULL)
1357 {
1358   CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
1359   Variable a=rootOf(mipo);
1360   CanonicalForm F( convSingAClapA( f,a ) ), G( convSingAClapA( g,a ) );
1361   CanonicalForm GCD;
1362
1363   TIMING_START( algContentTimer );
1364#ifdef FACTORY_GCD_TEST
1365   GCD=CFPrimitiveGcdUtil::gcd( F, G );
1366#else
1367   GCD=gcd( F, G );
1368#endif
1369   TIMING_END( algContentTimer );
1370
1371   FACTORY_CFAOUT( "d", GCD );
1372   FACTORY_GCDSTAT( "acnt:", F, G, GCD );
1373
1374   if ((GCD!=1) && (GCD!=0))
1375   {
1376     ff= convClapASingA( F/ GCD );
1377     gg= convClapASingA( G/ GCD );
1378   }
1379 }
1380 else
1381 {
1382   CanonicalForm F( convSingTrClapP( f ) ), G( convSingTrClapP( g ) );
1383   CanonicalForm GCD;
1384
1385   TIMING_START( algContentTimer );
1386#ifdef FACTORY_GCD_TEST
1387   GCD=CFPrimitiveGcdUtil::gcd( F, G );
1388#else
1389   GCD=gcd( F, G );
1390#endif
1391   TIMING_END( algContentTimer );
1392
1393   FACTORY_CFTROUT( "d", GCD );
1394   FACTORY_GCDSTAT( "acnt:", F, G, GCD );
1395
1396   if ((GCD!=1) && (GCD!=0))
1397   {
1398     ff= convClapPSingTr( F/ GCD );
1399     gg= convClapPSingTr( G/ GCD );
1400   }
1401 }
1402
1403 Off(SW_RATIONAL);
1404}
1405
1406#if 0
1407lists singclap_chineseRemainder(lists x, lists q)
1408{
1409  //assume(x->nr == q->nr);
1410  //assume(x->nr >= 0);
1411  int n=x->nr+1;
1412  if ((x->nr<0) || (x->nr!=q->nr))
1413  {
1414    WerrorS("list are empty or not of equal length");
1415    return NULL;
1416  }
1417  lists res=(lists)omAlloc0Bin(slists_bin);
1418  CFArray X(1,n), Q(1,n);
1419  int i;
1420  for(i=0; i<n; i++)
1421  {
1422    if (x->m[i-1].Typ()==INT_CMD)
1423    {
1424      X[i]=(int)x->m[i-1].Data();
1425    }
1426    else if (x->m[i-1].Typ()==NUMBER_CMD)
1427    {
1428      number N=(number)x->m[i-1].Data();
1429      X[i]=convSingNClapN(N);
1430    }
1431    else
1432    {
1433      WerrorS("illegal type in chineseRemainder");
1434      omFreeBin(res,slists_bin);
1435      return NULL;
1436    }
1437    if (q->m[i-1].Typ()==INT_CMD)
1438    {
1439      Q[i]=(int)q->m[i-1].Data();
1440    }
1441    else if (q->m[i-1].Typ()==NUMBER_CMD)
1442    {
1443      number N=(number)x->m[i-1].Data();
1444      Q[i]=convSingNClapN(N);
1445    }
1446    else
1447    {
1448      WerrorS("illegal type in chineseRemainder");
1449      omFreeBin(res,slists_bin);
1450      return NULL;
1451    }
1452  }
1453  CanonicalForm r, prod;
1454  chineseRemainder( X, Q, r, prod );
1455  res->Init(2);
1456  res->m[0].rtyp=NUMBER_CMD;
1457  res->m[1].rtyp=NUMBER_CMD;
1458  res->m[0].data=(char *)convClapNSingN( r );
1459  res->m[1].data=(char *)convClapNSingN( prod );
1460  return res;
1461}
1462#endif
1463#endif
Note: See TracBrowser for help on using the repository browser.