source: git/kernel/clapsing.cc @ c95632f

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