source: git/Singular/clapsing.cc @ 867e302

fieker-DuValspielwiese
Last change on this file since 867e302 was 867e302, checked in by Hans Schönemann <hannes@…>, 27 years ago
* hannes: minor optimizastions in clapconv.cc clapsing.cc git-svn-id: file:///usr/local/Singular/svn/trunk@826 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 20.2 KB
Line 
1// emacs edit mode for this file is -*- C++ -*-
2/****************************************
3*  Computer Algebra System SINGULAR     *
4****************************************/
5// $Id: clapsing.cc,v 1.16 1997-10-20 15:27:25 Singular Exp $
6/*
7* ABSTRACT: interface between Singular and factory
8*/
9
10
11#include "mod2.h"
12#ifdef HAVE_FACTORY
13#define SI_DONT_HAVE_GLOBAL_VARS
14#include "tok.h"
15#include "clapsing.h"
16#include "ipid.h"
17#include "numbers.h"
18#include "subexpr.h"
19#include "ipshell.h"
20#include <factory.h>
21#include "clapconv.h"
22#ifdef HAVE_LIBFAC_P
23#include <factor.h>
24#endif
25
26poly singclap_gcd ( poly f, poly g )
27{
28  // for now there is only the possibility to handle polynomials over
29  // Q and Fp ...
30  if ( nGetChar() == 0 || nGetChar() > 1 )
31  {
32    setCharacteristic( nGetChar() );
33    CanonicalForm F( convSingPClapP( f ) ), G( convSingPClapP( g ) );
34    poly res=convClapPSingP( gcd( F, G ) );
35    Off(SW_RATIONAL);
36    return res;
37  }
38  // and over Q(a) / Fp(a)
39  else if (( nGetChar()==1 ) /* Q(a) */
40  || (nGetChar() <-1))       /* Fp(a) */
41  {
42    if (nGetChar()==1) setCharacteristic( 0 );
43    else               setCharacteristic( -nGetChar() );
44    poly res;
45    if (currRing->minpoly!=NULL)
46    {
47      CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
48      Variable a=rootOf(mipo);
49      CanonicalForm F( convSingAPClapAP( f,a ) ), G( convSingAPClapAP( g,a ) );
50      res= convClapAPSingAP( gcd( F, G ) );
51    }
52    else
53    {
54      CanonicalForm F( convSingTrPClapP( f ) ), G( convSingTrPClapP( g ) );
55      res= convClapPSingTrP( gcd( F, G ) );
56    }
57    Off(SW_RATIONAL);
58    return res;
59  }
60  else
61    WerrorS( "not implemented" );
62  return NULL;
63}
64
65//poly singclap_resultant ( poly f, poly g , poly x)
66//{
67//  int i=pIsPurePower(x);
68//  if (i==0)
69//  {
70//    WerrorS("3rd argument must be a ring variable");
71//    return NULL;
72//  }
73//  Variable X(i);
74//  // for now there is only the possibility to handle polynomials over
75//  // Q and Fp ...
76//  if ( nGetChar() == 0 || nGetChar() > 1 )
77//  {
78//    setCharacteristic( nGetChar() );
79//    CanonicalForm F( convSingPClapP( f ) ), G( convSingPClapP( g ) );
80//    poly res=convClapPSingP( resultant( F, G, X ) );
81//    Off(SW_RATIONAL);
82//    return res;
83//  }
84//  // and over Q(a) / Fp(a)
85//  else if (( nGetChar()==1 ) /* Q(a) */
86//  || (nGetChar() <-1))       /* Fp(a) */
87//  {
88//    if (nGetChar()==1) setCharacteristic( 0 );
89//    else               setCharacteristic( -nGetChar() );
90//    poly res;
91//    if (currRing->minpoly!=NULL)
92//    {
93//      CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
94//      Variable a=rootOf(mipo);
95//      CanonicalForm F( convSingAPClapAP( f,a ) ), G( convSingAPClapAP( g,a ) );
96//      res= convClapAPSingAP( resultant( F, G, X ) );
97//    }
98//    else
99//    {
100//      CanonicalForm F( convSingTrPClapP( f ) ), G( convSingTrPClapP( g ) );
101//      res= convClapPSingTrP( resultant( F, G, X ) );
102//    }
103//    Off(SW_RATIONAL);
104//    return res;
105//  }
106//  else
107//    WerrorS( "not implemented" );
108//  return NULL;
109//}
110poly singclap_resultant ( poly f, poly g , poly x)
111{
112  int i=pVar(x);
113  if (i==0)
114  {
115    WerrorS("ringvar expected");
116    return NULL;
117  }
118  ideal I=idInit(1,1);
119
120  // get the coeffs von f wrt. x:
121  I->m[0]=pCopy(f);
122  matrix ffi=mpCoeffs(I,i);
123  ffi->rank=1;
124  ffi->ncols=ffi->nrows;
125  ffi->nrows=1;
126  ideal fi=(ideal)ffi;
127
128  // get the coeffs von g wrt. x:
129  I->m[0]=pCopy(g);
130  matrix ggi=mpCoeffs(I,i);
131  ggi->rank=1;
132  ggi->ncols=ggi->nrows;
133  ggi->nrows=1;
134  ideal gi=(ideal)ggi;
135
136  // contruct the matrix:
137  int fn=IDELEMS(fi); //= deg(f,x)+1
138  int gn=IDELEMS(gi); //= deg(g,x)+1
139  matrix m=mpNew(fn+gn-2,fn+gn-2);
140  if(m==NULL)
141  {
142    return NULL;
143  }
144
145  // enter the coeffs into m:
146  int j;
147  for(i=0;i<gn-1;i++)
148  {
149    for(j=0;j<fn;j++)
150    {
151      MATELEM(m,i+1,fn-j+i)=pCopy(fi->m[j]);
152    }
153  }
154  for(i=0;i<fn-1;i++)
155  {
156    for(j=0;j<gn;j++)
157    {
158      MATELEM(m,gn+i,gn-j+i)=pCopy(gi->m[j]);
159    }
160  }
161
162  poly r=mpDet(m);
163
164  idDelete(&fi);
165  idDelete(&gi);
166  idDelete((ideal *)&m);
167  return r;
168}
169
170lists singclap_extgcd ( poly f, poly g )
171{
172  // for now there is only the possibility to handle univariate
173  // polynomials over
174  // Q and Fp ...
175  poly res=NULL,pa=NULL,pb=NULL;
176  On(SW_SYMMETRIC_FF);
177  if ( nGetChar() == 0 || nGetChar() > 1 )
178  {
179    setCharacteristic( nGetChar() );
180    CanonicalForm F( convSingPClapP( f ) ), G( convSingPClapP( g ) );
181    if (!F.isUnivariate() || !G.isUnivariate() || F.mvar()!=G.mvar())
182    {
183      Off(SW_RATIONAL);
184      WerrorS("not univariate");
185      return NULL;
186    }
187    CanonicalForm Fa,Gb;
188    res=convClapPSingP( extgcd( F, G, Fa, Gb ) );
189    pa=convClapPSingP(Fa);
190    pb=convClapPSingP(Gb);
191    Off(SW_RATIONAL);
192  }
193  // and over Q(a) / Fp(a)
194  else if (( nGetChar()==1 ) /* Q(a) */
195  || (nGetChar() <-1))       /* Fp(a) */
196  {
197    if (nGetChar()==1) setCharacteristic( 0 );
198    else               setCharacteristic( -nGetChar() );
199    CanonicalForm Fa,Gb;
200    if (currRing->minpoly!=NULL)
201    {
202      CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
203      Variable a=rootOf(mipo);
204      CanonicalForm F( convSingAPClapAP( f,a ) ), G( convSingAPClapAP( g,a ) );
205      if (!F.isUnivariate() || !G.isUnivariate() || F.mvar()!=G.mvar())
206      {
207        WerrorS("not univariate");
208        return NULL;
209      }
210      res= convClapAPSingAP( extgcd( F, G, Fa, Gb ) );
211      pa=convClapAPSingAP(Fa);
212      pb=convClapAPSingAP(Gb);
213    }
214    else
215    {
216      CanonicalForm F( convSingTrPClapP( f ) ), G( convSingTrPClapP( g ) );
217      if (!F.isUnivariate() || !G.isUnivariate() || F.mvar()!=G.mvar())
218      {
219        Off(SW_RATIONAL);
220        WerrorS("not univariate");
221        return NULL;
222      }
223      res= convClapPSingTrP( extgcd( F, G, Fa, Gb ) );
224      pa=convClapPSingTrP(Fa);
225      pb=convClapPSingTrP(Gb);
226    }
227    Off(SW_RATIONAL);
228  }
229  else
230  {
231    WerrorS( "not implemented" );
232    return NULL;
233  }
234  lists L=(lists)Alloc(sizeof(slists));
235  L->Init(3);
236  L->m[0].rtyp=POLY_CMD;
237  L->m[0].data=(void *)res;
238  L->m[1].rtyp=POLY_CMD;
239  L->m[1].data=(void *)pa;
240  L->m[2].rtyp=POLY_CMD;
241  L->m[2].data=(void *)pb;
242  return L;
243}
244
245poly singclap_pdivide ( poly f, poly g )
246{
247  // for now there is only the possibility to handle polynomials over
248  // Q and Fp ...
249  if ( nGetChar() == 0 || nGetChar() > 1 )
250  {
251    setCharacteristic( nGetChar() );
252    CanonicalForm F( convSingPClapP( f ) ), G( convSingPClapP( g ) );
253    return convClapPSingP( F / G );
254  }
255  // and over Q(a) / Fp(a)
256  else if (( nGetChar()==1 ) /* Q(a) */
257  || (nGetChar() <-1))       /* Fp(a) */
258  {
259    if (nGetChar()==1) setCharacteristic( 0 );
260    else               setCharacteristic( -nGetChar() );
261    poly res;
262    if (currRing->minpoly!=NULL)
263    {
264      CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
265      Variable a=rootOf(mipo);
266      CanonicalForm F( convSingAPClapAP( f,a ) ), G( convSingAPClapAP( g,a ) );
267      res= convClapAPSingAP(  F / G  );
268    }
269    else
270    {
271      CanonicalForm F( convSingTrPClapP( f ) ), G( convSingTrPClapP( g ) );
272      res= convClapPSingTrP(  F / G  );
273    }
274    Off(SW_RATIONAL);
275    return res;
276  }
277  else
278    WerrorS( "not implemented" );
279  return NULL;
280}
281
282void singclap_divide_content ( poly f )
283{
284  if ( nGetChar() == 1 )
285    setCharacteristic( 0 );
286  else  if ( nGetChar() == -1 )
287    return; /* not implemented for R */
288  else  if ( nGetChar() < 0 )
289    setCharacteristic( -nGetChar() );
290  else
291    setCharacteristic( nGetChar() );
292  if ( f==NULL )
293  {
294    return;
295  }
296  else  if ( pNext( f ) == NULL )
297  {
298    pSetCoeff( f, nInit( 1 ) );
299    return;
300  }
301  else
302  {
303    CFList L;
304    CanonicalForm g, h;
305    poly p = pNext(f);
306    nTest(pGetCoeff(f));
307    g = convSingTrClapP( ((lnumber)pGetCoeff(f))->z );
308    L.append( g );
309    while ( p && (g != 1) )
310    {
311      nTest(pGetCoeff(p));
312      h = convSingTrClapP( ((lnumber)pGetCoeff(p))->z );
313      p = pNext( p );
314      g = gcd( g, h );
315      L.append( h );
316    }
317    if ( g == 1 )
318    {
319      pTest(f);
320      return;
321    }
322    #ifdef LDEBUG
323    else if ( g == 0 )
324    {
325      pTest(f);
326      pWrite(f);
327      PrintS("=> gcd 0 in divide_content\n");
328      return;
329    }
330    #endif
331    else
332    {
333      CFListIterator i;
334      for ( i = L, p = f; i.hasItem(); i++, p=pNext(p) )
335      {
336        lnumber c=(lnumber)pGetCoeff(p);
337        napDelete(&c->z);
338        #ifdef LDEBUG
339        number nt=(number)Alloc0(sizeof(rnumber));
340        lnumber nnt=(lnumber)nt;
341        nnt->z=convClapPSingTr( i.getItem());
342        nTest(nt);
343        #endif
344        c->z=convClapPSingTr( i.getItem() / g );
345        nTest((number)c);
346        //#ifdef LDEBUG
347        //number cn=(number)c;
348        //StringSet(""); nWrite(nt); StringAppend(" ==> ");
349        //nWrite(cn);PrintS(StringAppend("\n"));
350        //#endif
351      }
352    }
353    pTest(f);
354  }
355}
356
357ideal singclap_factorize ( poly f, intvec ** v , int with_exps)
358{
359  // with_exps: 1 return only true factors
360  //            2 return true factors and exponents
361  //            0 return factors and exponents
362
363  ideal res=NULL;
364  if (f==NULL)
365  {
366    res=idInit(1,1);
367    if (with_exps!=1)
368    {
369      (*v)=new intvec(1);
370    }
371    return res;
372  }
373  Off(SW_RATIONAL);
374  On(SW_SYMMETRIC_FF);
375  CFFList L;
376  number N=NULL;
377
378  if ( (nGetChar() == 0) || (nGetChar() > 1) )
379  {
380    setCharacteristic( nGetChar() );
381    if (nGetChar()==0) /* Q */
382    {
383      if (f!=NULL)
384      {
385        if (with_exps==0)
386          N=nCopy(pGetCoeff(f));
387        pCleardenom(f);
388        if (with_exps==0)
389        {
390          number nn=nDiv(N,pGetCoeff(f));
391          nDelete(&N);
392          N=nn;
393        }
394      }
395    }
396    CanonicalForm F( convSingPClapP( f ) );
397    if (nGetChar()==0) /* Q */
398    {
399      L = factorize( F );
400    }
401    else /* Fp */
402    {
403#ifdef HAVE_LIBFAC_P
404      L = Factorize( F );
405#else
406      return NULL;
407#endif
408    }
409  }
410  // and over Q(a) / Fp(a)
411  else if (( nGetChar()==1 ) /* Q(a) */
412  || (nGetChar() <-1))       /* Fp(a) */
413  {
414    if (nGetChar()==1) setCharacteristic( 0 );
415    else               setCharacteristic( -nGetChar() );
416    if (currRing->minpoly!=NULL)
417    {
418      //if (nGetChar()==1)
419      //{
420      //  WerrorS("not implemented");
421      //  return NULL;
422      //}
423      CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
424      Variable a=rootOf(mipo);
425      CanonicalForm F( convSingAPClapAP( f,a ) );
426      L = factorize( F, a );
427    }
428    else
429    {
430      CanonicalForm F( convSingTrPClapP( f ) );
431      if (nGetChar()==1) /* Q(a) */
432      {
433        L = factorize( F );
434      }
435      else /* Fp(a) */
436      {
437#ifdef HAVE_LIBFAC_P
438        L = Factorize( F );
439#else
440        return NULL;
441#endif
442      }
443    }
444  }
445  else
446  {
447    WerrorS( "not implemented" );
448    goto end;
449  }
450  {
451    // the first factor should be a constant
452    if ( ! L.getFirst().factor().inCoeffDomain() )
453      L.insert(CFFactor(1,1));
454    // convert into ideal
455    int n = L.length();
456    CFFListIterator J=L;
457    int j=0;
458    if (with_exps!=1)
459    {
460      if ((with_exps==2)&&(n>1))
461      {
462        n--;
463        J++;
464      }
465      *v = new intvec( n );
466    }
467    res = idInit( n ,1);
468    for ( ; J.hasItem(); J++, j++ )
469    {
470      if (with_exps!=1) (**v)[j] = J.getItem().exp();
471      if ((nGetChar()==0)||(nGetChar()>1))           /* Q, Fp */
472        res->m[j] = convClapPSingP( J.getItem().factor() );
473      else if ((nGetChar()==1)||(nGetChar()<-1))     /* Q(a), Fp(a) */
474      {
475        if (currRing->minpoly==NULL)
476          res->m[j] = convClapPSingTrP( J.getItem().factor() );
477        else
478          res->m[j] = convClapAPSingAP( J.getItem().factor() );
479      }
480    }
481    if (N!=NULL)
482    {
483      pMultN(res->m[0],N);
484      nDelete(&N);
485    }
486    // delete constants
487    if ((with_exps!=0) && (res!=NULL))
488    {
489      int i=IDELEMS(res)-1;
490      for(;i>=0;i--)
491      {
492        if (pIsConstant(res->m[i]))
493          pDelete(&(res->m[i]));
494      }
495      idSkipZeroes(res);
496      if (res->m[0]==NULL)
497      {
498        res->m[0]=pOne();
499      }
500    }
501  }
502end:
503  return res;
504}
505
506matrix singclap_irrCharSeries ( ideal I)
507{
508#ifdef HAVE_LIBFAC_P
509  // for now there is only the possibility to handle polynomials over
510  // Q and Fp ...
511  matrix res=NULL;
512  int i;
513  Off(SW_RATIONAL);
514  On(SW_SYMMETRIC_FF);
515  CFList L;
516  ListCFList LL;
517  if ( (nGetChar() == 0) || (nGetChar() > 1) )
518  {
519    setCharacteristic( nGetChar() );
520    for(i=0;i<IDELEMS(I);i++)
521    {
522      L.append(convSingPClapP(I->m[i]));
523    }
524  }
525  // and over Q(a) / Fp(a)
526  else if (( nGetChar()==1 ) /* Q(a) */
527  || (nGetChar() <-1))       /* Fp(a) */
528  {
529    if (nGetChar()==1) setCharacteristic( 0 );
530    else               setCharacteristic( -nGetChar() );
531    for(i=0;i<IDELEMS(I);i++)
532    {
533      L.append(convSingTrPClapP(I->m[i]));
534    }
535  }
536  else
537  {
538    WerrorS("not implemented");
539    return res;
540  }
541
542  LL=IrrCharSeries(L);
543  int m= LL.length(); // Anzahl Zeilen
544  int n=0;
545  ListIterator<CFList> LLi;
546  CFListIterator Li;
547  for ( LLi = LL; LLi.hasItem(); LLi++ )
548  {
549    n = max(LLi.getItem().length(),n);
550  }
551  res=mpNew(m,n);
552  if ((m==0) || (n==0))
553  {
554    Warn("char_series returns %d x %d matrix from %d input polys (%d)\n",m,n,IDELEMS(I)+1,LL.length());
555    iiWriteMatrix((matrix)I,"I",2,0);
556  }
557  for ( m=1, LLi = LL; LLi.hasItem(); LLi++, m++ )
558  {
559    for (n=1, Li = LLi.getItem(); Li.hasItem(); Li++, n++)
560    {
561      if ( (nGetChar() == 0) || (nGetChar() > 1) )
562        MATELEM(res,m,n)=convClapPSingP(Li.getItem());
563      else
564        MATELEM(res,m,n)=convClapPSingTrP(Li.getItem());
565    }
566  }
567  Off(SW_RATIONAL);
568  return res;
569#else
570  return NULL;
571#endif
572}
573
574char* singclap_neworder ( ideal I)
575{
576#ifdef HAVE_LIBFAC_P
577  int i;
578  Off(SW_RATIONAL);
579  On(SW_SYMMETRIC_FF);
580  CFList L;
581  if ( (nGetChar() == 0) || (nGetChar() > 1) )
582  {
583    setCharacteristic( nGetChar() );
584    for(i=0;i<IDELEMS(I);i++)
585    {
586      L.append(convSingPClapP(I->m[i]));
587    }
588  }
589  // and over Q(a) / Fp(a)
590  else if (( nGetChar()==1 ) /* Q(a) */
591  || (nGetChar() <-1))       /* Fp(a) */
592  {
593    if (nGetChar()==1) setCharacteristic( 0 );
594    else               setCharacteristic( -nGetChar() );
595    for(i=0;i<IDELEMS(I);i++)
596    {
597      L.append(convSingTrPClapP(I->m[i]));
598    }
599  }
600  else
601  {
602    WerrorS("not implemented");
603    return NULL;
604  }
605
606  List<int> IL=neworderint(L);
607  ListIterator<int> Li;
608  StringSet("");
609  Li = IL;
610  int* mark=(int*)Alloc0(pVariables*sizeof(int));
611  int cnt=pVariables;
612  loop
613  {
614    i=Li.getItem()-1;
615    mark[i]=1;
616    StringAppend(currRing->names[i]);
617    Li++;
618    cnt--;
619    if(cnt==0) break;
620    StringAppend(",");
621    if(! Li.hasItem()) break;
622  }
623  for(i=0;i<pVariables;i++)
624  {
625    if(mark[i]==0)
626    {
627      StringAppend(currRing->names[i]);
628      cnt--;
629      if(cnt==0) break;
630      StringAppend(",");
631    }
632  }
633  return mstrdup(StringAppend(""));
634#else
635  return NULL;
636#endif
637}
638
639BOOLEAN singclap_isSqrFree(poly f)
640{
641  BOOLEAN b=FALSE;
642  Off(SW_RATIONAL);
643  //  Q / Fp
644  if ( (nGetChar() == 0) || (nGetChar() > 1) )
645  {
646    setCharacteristic( nGetChar() );
647    CanonicalForm F( convSingPClapP( f ) );
648    if((nGetChar()>1)&&(!F.isUnivariate()))
649      goto err;
650    b=(BOOLEAN)isSqrFree(F);
651  }
652  // and over Q(a) / Fp(a)
653  else if (( nGetChar()==1 ) /* Q(a) */
654  || (nGetChar() <-1))       /* Fp(a) */
655  {
656    if (nGetChar()==1) setCharacteristic( 0 );
657    else               setCharacteristic( -nGetChar() );
658    //if (currRing->minpoly!=NULL)
659    //{
660    //  CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
661    //  Variable a=rootOf(mipo);
662    //  CanonicalForm F( convSingAPClapAP( f,a ) );
663    //  ...
664    //}
665    //else
666    {
667      CanonicalForm F( convSingTrPClapP( f ) );
668      b=(BOOLEAN)isSqrFree(F);
669    }
670    Off(SW_RATIONAL);
671  }
672  else
673  {
674err:
675    WerrorS( "not implemented" );
676  }
677  return b;
678}
679
680poly singclap_det( const matrix m )
681{
682  int r=m->rows();
683  if (r!=m->cols())
684  {
685    Werror("det of %d x %d matrix",r,m->cols());
686    return NULL;
687  }
688  poly res=NULL;
689  if ( nGetChar() == 0 || nGetChar() > 1 )
690  {
691    setCharacteristic( nGetChar() );
692    CFMatrix M(r,r);
693    int i,j;
694    for(i=r;i>0;i--)
695    {
696      for(j=r;j>0;j--)
697      {
698        M(i,j)=convSingPClapP(MATELEM(m,i,j));
699      }
700    }
701    res= convClapPSingP( determinant(M,r) ) ;
702  }
703  // and over Q(a) / Fp(a)
704  else if (( nGetChar()==1 ) /* Q(a) */
705  || (nGetChar() <-1))       /* Fp(a) */
706  {
707    if (nGetChar()==1) setCharacteristic( 0 );
708    else               setCharacteristic( -nGetChar() );
709    CFMatrix M(r,r);
710    poly res;
711    if (currRing->minpoly!=NULL)
712    {
713      CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
714      Variable a=rootOf(mipo);
715      int i,j;
716      for(i=r;i>0;i--)
717      {
718        for(j=r;j>0;j--)
719        {
720          M(i,j)=convSingAPClapAP(MATELEM(m,i,j),a);
721        }
722      }
723      res= convClapAPSingAP( determinant(M,r) ) ;
724    }
725    else
726    {
727      int i,j;
728      for(i=r;i>0;i--)
729      {
730        for(j=r;j>0;j--)
731        {
732          M(i,j)=convSingTrPClapP(MATELEM(m,i,j));
733        }
734      }
735      res= convClapPSingTrP( determinant(M,r) );
736    }
737  }
738  else
739    WerrorS( "not implemented" );
740  Off(SW_RATIONAL);
741  return res;
742}
743
744int singclap_det_i( intvec * m )
745{
746  setCharacteristic( 0 );
747  CFMatrix M(m->rows(),m->cols());
748  int i,j;
749  for(i=m->rows();i>0;i--)
750  {
751    for(j=m->cols();j>0;j--)
752    {
753      M(i,j)=IMATELEM(*m,i,j);
754    }
755  }
756  int res= convClapISingI( determinant(M,m->rows())) ;
757  Off(SW_RATIONAL);
758  return res;
759}
760/*==============================================================*/
761/* interpreter interface : */
762BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
763{
764  res->data=(void *)singclap_gcd((poly)(u->Data()),((poly)v->Data()));
765  return FALSE;
766}
767
768BOOLEAN jjFAC_P(leftv res, leftv u)
769{
770  intvec *v=NULL;
771  ideal f=singclap_factorize((poly)(u->Data()), &v, 0);
772#ifndef HAVE_LIBFAC_P
773  if (f==NULL) return TRUE;
774#endif
775  lists l=(lists)Alloc(sizeof(slists));
776  l->Init(2);
777  l->m[0].rtyp=IDEAL_CMD;
778  l->m[0].data=(void *)f;
779  l->m[1].rtyp=INTVEC_CMD;
780  l->m[1].data=(void *)v;
781  res->data=(void *)l;
782  return FALSE;
783}
784
785BOOLEAN jjSQR_FREE_DEC(leftv res, leftv u,leftv dummy)
786{
787  intvec *v=NULL;
788  int sw=(int)dummy->Data();
789  ideal f=singclap_factorize((poly)(u->Data()), &v, sw);
790  switch(sw)
791  {
792    case 0:
793    case 2:
794    {
795      lists l=(lists)Alloc(sizeof(slists));
796      l->Init(2);
797      l->m[0].rtyp=IDEAL_CMD;
798      l->m[0].data=(void *)f;
799      l->m[1].rtyp=INTVEC_CMD;
800      l->m[1].data=(void *)v;
801      res->data=(void *)l;
802      res->rtyp=LIST_CMD;
803      return FALSE;
804    }
805    case 1:
806      res->data=(void *)f;
807      return f==NULL;
808  }
809  WerrorS("invalid switch");
810  return TRUE;
811}
812
813#if 0
814BOOLEAN jjIS_SQR_FREE(leftv res, leftv u)
815{
816  BOOLEAN b=singclap_factorize((poly)(u->Data()), &v, 0);
817  res->data=(void *)b;
818}
819#endif
820
821BOOLEAN jjEXTGCD_P(leftv res, leftv u, leftv v)
822{
823  res->data=singclap_extgcd((poly)u->Data(),(poly)v->Data());
824  return (res->data==NULL);
825}
826BOOLEAN jjRESULTANT(leftv res, leftv u, leftv v, leftv w)
827{
828  res->data=singclap_resultant((poly)u->Data(),(poly)v->Data(), (poly)w->Data());
829  return (res->data==NULL);
830}
831BOOLEAN jjCHARSERIES(leftv res, leftv u)
832{
833  res->data=singclap_irrCharSeries((ideal)u->Data());
834  return (res->data==NULL);
835}
836
837alg singclap_alglcm ( alg f, alg g )
838{
839  // over Q(a) / Fp(a)
840 if (nGetChar()==1) setCharacteristic( 0 );
841 else               setCharacteristic( -nGetChar() );
842 alg res;
843 if (currRing->minpoly!=NULL)
844 {
845   CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
846   Variable a=rootOf(mipo);
847   CanonicalForm F( convSingAClapA( f,a ) ), G( convSingAClapA( g,a ) );
848   res= convClapASingA( (F/ gcd( F, G ))*G );
849 }
850 else
851 {
852   CanonicalForm F( convSingTrClapP( f ) ), G( convSingTrClapP( g ) );
853   res= convClapPSingTr( (F/gcd( F, G ))*G );
854 }
855 Off(SW_RATIONAL);
856 return res;
857}
858
859void singclap_algdividecontent ( alg f, alg g, alg &ff, alg &gg )
860{
861  // over Q(a) / Fp(a)
862 if (nGetChar()==1) setCharacteristic( 0 );
863 else               setCharacteristic( -nGetChar() );
864 ff=gg=NULL;
865 if (currRing->minpoly!=NULL)
866 {
867   CanonicalForm mipo=convSingTrClapP(((lnumber)currRing->minpoly)->z);
868   Variable a=rootOf(mipo);
869   CanonicalForm F( convSingAClapA( f,a ) ), G( convSingAClapA( g,a ) );
870   CanonicalForm GCD=gcd( F, G );
871   if (GCD!=1)
872   {
873     ff= convClapASingA( F/ GCD );
874     gg= convClapASingA( G/ GCD );
875   }
876 }
877 else
878 {
879   CanonicalForm F( convSingTrClapP( f ) ), G( convSingTrClapP( g ) );
880   CanonicalForm GCD=gcd( F, G );
881   if (GCD!=1)
882   {
883     ff= convClapPSingTr( F/ GCD );
884     gg= convClapPSingTr( G/ GCD );
885   }
886 }
887 Off(SW_RATIONAL);
888}
889#endif
Note: See TracBrowser for help on using the repository browser.