source: git/kernel/ideals.cc @ 762407

spielwiese
Last change on this file since 762407 was 762407, checked in by Oleksandr Motsak <motsak@…>, 12 years ago
config.h is for sources files only FIX: config.h should only be used by source (not from inside kernel/mod2.h!) NOTE: each source file should better include mod2.h right after config.h, while headers should better not include mod2.h.
  • Property mode set to 100644
File size: 59.7 KB
RevLine 
[0f401f]1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: ideals.cc 14320 2011-07-04 14:48:27Z hannes $ */
5/*
6* ABSTRACT - all basic methods to manipulate ideals
7*/
8
9/* includes */
[762407]10#include "config.h"
[e6e2198]11#include "mod2.h"
12
[f11ea16]13#include <omalloc/omalloc.h>
14#include <misc/auxiliary.h>
15
[0f401f]16
17#ifndef NDEBUG
18# define MYTEST 0
19#else /* ifndef NDEBUG */
[e6e2198]20# define MYTEST 0
[0f401f]21#endif /* ifndef NDEBUG */
22
23#include <omalloc/omalloc.h>
[e6e2198]24
25#include <misc/options.h>
26#include <misc/intvec.h>
27
[76cfef]28#include <coeffs/coeffs.h>
29#include <coeffs/numbers.h>
[e6e2198]30
[737a68]31#include <kernel/polys.h>
[210e07]32#include <polys/monomials/ring.h>
[76cfef]33#include <polys/matpol.h>
34#include <polys/weight.h>
[210e07]35#include <polys/sparsmat.h>
[76cfef]36#include <polys/prCopy.h>
[210e07]37#include <polys/nc/nc.h>
[0f401f]38
[1f637e]39
[e6e2198]40#include <kernel/ideals.h>
41
42#include <kernel/febase.h>
43#include <kernel/kstd1.h>
44#include <kernel/syz.h>
45
46#include <kernel/longrat.h>
47
[0f401f]48
49/* #define WITH_OLD_MINOR */
50#define pCopy_noCheck(p) pCopy(p)
51
52static poly * idpower;
53/*collects the monomials in makemonoms, must be allocated befor*/
54static int idpowerpoint;
55/*index of the actual monomial in idpower*/
56static poly * givenideal;
57/*the ideal from which a power is computed*/
58
59/*0 implementation*/
60
61/*2
62*returns a minimized set of generators of h1
63*/
64ideal idMinBase (ideal h1)
65{
66  ideal h2, h3,h4,e;
67  int j,k;
68  int i,l,ll;
69  intvec * wth;
70  BOOLEAN homog;
71
72  homog = idHomModule(h1,currQuotient,&wth);
[b7cfaf]73  if (rHasGlobalOrdering(currRing))
[0f401f]74  {
75    if(!homog)
76    {
77      WarnS("minbase applies only to the local or homogeneous case");
78      e=idCopy(h1);
79      return e;
80    }
81    else
82    {
83      ideal re=kMin_std(h1,currQuotient,(tHomog)homog,&wth,h2,NULL,0,3);
84      idDelete(&re);
85      return h2;
86    }
87  }
88  e=idInit(1,h1->rank);
89  if (idIs0(h1))
90  {
91    return e;
92  }
93  pEnlargeSet(&(e->m),IDELEMS(e),15);
94  IDELEMS(e) = 16;
95  h2 = kStd(h1,currQuotient,isNotHomog,NULL);
[b7cfaf]96  h3 = idMaxIdeal(1);
[0f401f]97  h4=idMult(h2,h3);
98  idDelete(&h3);
99  h3=kStd(h4,currQuotient,isNotHomog,NULL);
100  k = IDELEMS(h3);
101  while ((k > 0) && (h3->m[k-1] == NULL)) k--;
102  j = -1;
103  l = IDELEMS(h2);
104  while ((l > 0) && (h2->m[l-1] == NULL)) l--;
105  for (i=l-1; i>=0; i--)
106  {
107    if (h2->m[i] != NULL)
108    {
109      ll = 0;
110      while ((ll < k) && ((h3->m[ll] == NULL)
111      || !pDivisibleBy(h3->m[ll],h2->m[i])))
112        ll++;
113      if (ll >= k)
114      {
115        j++;
116        if (j > IDELEMS(e)-1)
117        {
118          pEnlargeSet(&(e->m),IDELEMS(e),16);
119          IDELEMS(e) += 16;
120        }
121        e->m[j] = pCopy(h2->m[i]);
122      }
123    }
124  }
125  idDelete(&h2);
126  idDelete(&h3);
127  idDelete(&h4);
128  if (currQuotient!=NULL)
129  {
130    h3=idInit(1,e->rank);
131    h2=kNF(h3,currQuotient,e);
132    idDelete(&h3);
133    idDelete(&e);
134    e=h2;
135  }
136  idSkipZeroes(e);
137  return e;
138}
139
140
141/*3
142*multiplies p with t (!cas) or  (t-1)
143*the index of t is:1, so we have to shift all variables
144*p is NOT in the actual ring, it has no t
145*/
146static poly pMultWithT (poly p,BOOLEAN cas)
147{
148  /*qp is the working pointer in p*/
149  /*result is the result, qresult is the working pointer*/
150  /*pp is p in the actual ring(shifted), qpp the working pointer*/
151  poly result,qp,pp;
152  poly qresult=NULL;
153  poly qpp=NULL;
154  int  i,j,lex;
155  number n;
156
157  pp = NULL;
158  result = NULL;
159  qp = p;
160  while (qp != NULL)
161  {
162    i = 0;
163    if (result == NULL)
164    {/*first monomial*/
165      result = pInit();
166      qresult = result;
167    }
168    else
169    {
170      qresult->next = pInit();
171      pIter(qresult);
172    }
[1f637e]173    for (j=(currRing->N)-1; j>0; j--)
[0f401f]174    {
175      lex = pGetExp(qp,j);
176      pSetExp(qresult,j+1,lex);/*copy all variables*/
177    }
178    lex = pGetComp(qp);
179    pSetComp(qresult,lex);
180    n=nCopy(pGetCoeff(qp));
181    pSetCoeff0(qresult,n);
182    qresult->next = NULL;
183    pSetm(qresult);
184    /*qresult is now qp brought into the actual ring*/
185    if (cas)
186    { /*case: mult with t-1*/
187      pSetExp(qresult,1,0);
188      pSetm(qresult);
189      if (pp == NULL)
190      { /*first monomial*/
191        pp = pCopy(qresult);
192        qpp = pp;
193      }
194      else
195      {
196        qpp->next = pCopy(qresult);
197        pIter(qpp);
198      }
199      pGetCoeff(qpp)=nNeg(pGetCoeff(qpp));
200      /*now qpp contains -1*qp*/
201    }
202    pSetExp(qresult,1,1);/*this is mult. by t*/
203    pSetm(qresult);
204    pIter(qp);
205  }
206  /*
207  *now p is processed:
208  *result contains t*p
209  * if cas: pp contains -1*p (in the new ring)
210  */
211  if (cas)  qresult->next = pp;
212  /*  else      qresult->next = NULL;*/
213  return result;
214}
215
216/*2
217*initialized a field with r numbers between beg and end for the
218*procedure idNextChoise
219*/
220ideal idSectWithElim (ideal h1,ideal h2)
221// does not destroy h1,h2
222{
223  if (TEST_OPT_PROT) PrintS("intersect by elimination method\n");
224  assume(!idIs0(h1));
225  assume(!idIs0(h2));
226  assume(IDELEMS(h1)<=IDELEMS(h2));
[7b25fe]227  assume(id_RankFreeModule(h1,currRing)==0);
228  assume(id_RankFreeModule(h2,currRing)==0);
[0f401f]229  // add a new variable:
230  int j;
231  ring origRing=currRing;
232  ring r=rCopy0(origRing);
233  r->N++;
234  r->block0[0]=1;
235  r->block1[0]= r->N;
236  omFree(r->order);
237  r->order=(int*)omAlloc0(3*sizeof(int*));
238  r->order[0]=ringorder_dp;
239  r->order[1]=ringorder_C;
240  char **names=(char**)omAlloc0(rVar(r) * sizeof(char_ptr));
241  for (j=0;j<r->N-1;j++) names[j]=r->names[j];
242  names[r->N-1]=omStrDup("@");
243  omFree(r->names);
244  r->names=names;
245  rComplete(r,TRUE);
246  // fetch h1, h2
247  ideal h;
248  h1=idrCopyR(h1,origRing,r);
249  h2=idrCopyR(h2,origRing,r);
250  // switch to temp. ring r
251  rChangeCurrRing(r);
252  // create 1-t, t
[861529]253  poly omt=p_One(currRing);
254  p_SetExp(omt,r->N,1,currRing);
255  poly t=p_Copy(omt,currRing);
256  p_Setm(omt,currRing);
257  omt=p_Neg(omt,currRing);
258  omt=p_Add_q(omt,pOne(),currRing);
[0f401f]259  // compute (1-t)*h1
[861529]260  h1=(ideal)mp_MultP((matrix)h1,omt,currRing);
[0f401f]261  // compute t*h2
[861529]262  h2=(ideal)mp_MultP((matrix)h2,pCopy(t),currRing);
[0f401f]263  // (1-t)h1 + t*h2
264  h=idInit(IDELEMS(h1)+IDELEMS(h2),1);
265  int l;
266  for (l=IDELEMS(h1)-1; l>=0; l--)
267  {
268    h->m[l] = h1->m[l];  h1->m[l]=NULL;
269  }
270  j=IDELEMS(h1);
271  for (l=IDELEMS(h2)-1; l>=0; l--)
272  {
273    h->m[l+j] = h2->m[l];  h2->m[l]=NULL;
274  }
275  idDelete(&h1);
276  idDelete(&h2);
277  // eliminate t:
278
279  ideal res=idElimination(h,t);
[a5d181c]280  // cleanup
[0f401f]281  idDelete(&h);
[a5d181c]282  if (res!=NULL) res=idrMoveR(res,r,origRing);
[0f401f]283  rChangeCurrRing(origRing);
[5fe834]284  rDelete(r);
[0f401f]285  return res;
286}
287/*2
288* h3 := h1 intersect h2
289*/
290ideal idSect (ideal h1,ideal h2)
291{
292  int i,j,k,length;
[7b25fe]293  int flength = id_RankFreeModule(h1,currRing);
294  int slength = id_RankFreeModule(h2,currRing);
[0f401f]295  int rank=si_min(flength,slength);
296  if ((idIs0(h1)) || (idIs0(h2)))  return idInit(1,rank);
297
298  ideal first,second,temp,temp1,result;
299  poly p,q;
300
301  if (IDELEMS(h1)<IDELEMS(h2))
302  {
303    first = h1;
304    second = h2;
305  }
306  else
307  {
308    first = h2;
309    second = h1;
310    int t=flength; flength=slength; slength=t;
311  }
312  length  = si_max(flength,slength);
313  if (length==0)
314  {
315    if ((currQuotient==NULL)
316    && (currRing->OrdSgn==1)
317    && (!rIsPluralRing(currRing))
318    && ((TEST_V_INTERSECT_ELIM) || (!TEST_V_INTERSECT_SYZ)))
319      return idSectWithElim(first,second);
320    else length = 1;
321  }
322  if (TEST_OPT_PROT) PrintS("intersect by syzygy methods\n");
323  j = IDELEMS(first);
324
325  ring orig_ring=currRing;
[3f07d1]326  ring syz_ring=rAssure_SyzComp(orig_ring,TRUE); rChangeCurrRing(syz_ring);
[b7cfaf]327  rSetSyzComp(length, syz_ring);
[0f401f]328
329  while ((j>0) && (first->m[j-1]==NULL)) j--;
330  temp = idInit(j /*IDELEMS(first)*/+IDELEMS(second),length+j);
331  k = 0;
332  for (i=0;i<j;i++)
333  {
334    if (first->m[i]!=NULL)
335    {
336      if (syz_ring==orig_ring)
337        temp->m[k] = pCopy(first->m[i]);
338      else
[861529]339        temp->m[k] = prCopyR(first->m[i], orig_ring, syz_ring);
[0f401f]340      q = pOne();
341      pSetComp(q,i+1+length);
342      pSetmComp(q);
[861529]343      if (flength==0) p_Shift(&(temp->m[k]),1,currRing);
[0f401f]344      p = temp->m[k];
345      while (pNext(p)!=NULL) pIter(p);
346      pNext(p) = q;
347      k++;
348    }
349  }
350  for (i=0;i<IDELEMS(second);i++)
351  {
352    if (second->m[i]!=NULL)
353    {
354      if (syz_ring==orig_ring)
355        temp->m[k] = pCopy(second->m[i]);
356      else
[861529]357        temp->m[k] = prCopyR(second->m[i], orig_ring,currRing);
358      if (slength==0) p_Shift(&(temp->m[k]),1,currRing);
[0f401f]359      k++;
360    }
361  }
362  intvec *w=NULL;
363  temp1 = kStd(temp,currQuotient,testHomog,&w,NULL,length);
364  if (w!=NULL) delete w;
365  idDelete(&temp);
366  if(syz_ring!=orig_ring)
367    rChangeCurrRing(orig_ring);
368
369  result = idInit(IDELEMS(temp1),rank);
370  j = 0;
371  for (i=0;i<IDELEMS(temp1);i++)
372  {
373    if ((temp1->m[i]!=NULL)
374    && (p_GetComp(temp1->m[i],syz_ring)>length))
375    {
376      if(syz_ring==orig_ring)
377      {
378        p = temp1->m[i];
379      }
380      else
381      {
[b7cfaf]382        p = prMoveR(temp1->m[i], syz_ring,orig_ring);
[0f401f]383      }
384      temp1->m[i]=NULL;
385      while (p!=NULL)
386      {
387        q = pNext(p);
388        pNext(p) = NULL;
389        k = pGetComp(p)-1-length;
390        pSetComp(p,0);
391        pSetmComp(p);
392        /* Warning! multiply only from the left! it's very important for Plural */
393        result->m[j] = pAdd(result->m[j],pMult(p,pCopy(first->m[k])));
394        p = q;
395      }
396      j++;
397    }
398  }
399  if(syz_ring!=orig_ring)
400  {
401    rChangeCurrRing(syz_ring);
402    idDelete(&temp1);
403    rChangeCurrRing(orig_ring);
[5fe834]404    rDelete(syz_ring);
[0f401f]405  }
406  else
407  {
408    idDelete(&temp1);
409  }
410
411  idSkipZeroes(result);
412  if (TEST_OPT_RETURN_SB)
413  {
414     w=NULL;
415     temp1=kStd(result,currQuotient,testHomog,&w);
416     if (w!=NULL) delete w;
417     idDelete(&result);
418     idSkipZeroes(temp1);
419     return temp1;
420  }
421  else //temp1=kInterRed(result,currQuotient);
422    return result;
423}
424
425/*2
426* ideal/module intersection for a list of objects
427* given as 'resolvente'
428*/
429ideal idMultSect(resolvente arg, int length)
430{
431  int i,j=0,k=0,syzComp,l,maxrk=-1,realrki;
432  ideal bigmat,tempstd,result;
433  poly p;
434  int isIdeal=0;
435  intvec * w=NULL;
436
437  /* find 0-ideals and max rank -----------------------------------*/
438  for (i=0;i<length;i++)
439  {
440    if (!idIs0(arg[i]))
441    {
[7b25fe]442      realrki=id_RankFreeModule(arg[i],currRing);
[0f401f]443      k++;
444      j += IDELEMS(arg[i]);
445      if (realrki>maxrk) maxrk = realrki;
446    }
447    else
448    {
449      if (arg[i]!=NULL)
450      {
451        return idInit(1,arg[i]->rank);
452      }
453    }
454  }
455  if (maxrk == 0)
456  {
457    isIdeal = 1;
458    maxrk = 1;
459  }
460  /* init -----------------------------------------------------------*/
461  j += maxrk;
462  syzComp = k*maxrk;
463
464  ring orig_ring=currRing;
[3f07d1]465  ring syz_ring=rAssure_SyzComp(orig_ring,TRUE); rChangeCurrRing(syz_ring);
[b7cfaf]466  rSetSyzComp(syzComp, syz_ring);
[0f401f]467
468  bigmat = idInit(j,(k+1)*maxrk);
469  /* create unit matrices ------------------------------------------*/
470  for (i=0;i<maxrk;i++)
471  {
472    for (j=0;j<=k;j++)
473    {
474      p = pOne();
475      pSetComp(p,i+1+j*maxrk);
476      pSetmComp(p);
477      bigmat->m[i] = pAdd(bigmat->m[i],p);
478    }
479  }
480  /* enter given ideals ------------------------------------------*/
481  i = maxrk;
482  k = 0;
483  for (j=0;j<length;j++)
484  {
485    if (arg[j]!=NULL)
486    {
487      for (l=0;l<IDELEMS(arg[j]);l++)
488      {
489        if (arg[j]->m[l]!=NULL)
490        {
491          if (syz_ring==orig_ring)
492            bigmat->m[i] = pCopy(arg[j]->m[l]);
493          else
[861529]494            bigmat->m[i] = prCopyR(arg[j]->m[l], orig_ring,currRing);
495          p_Shift(&(bigmat->m[i]),k*maxrk+isIdeal,currRing);
[0f401f]496          i++;
497        }
498      }
499      k++;
500    }
501  }
502  /* std computation --------------------------------------------*/
503  tempstd = kStd(bigmat,currQuotient,testHomog,&w,NULL,syzComp);
504  if (w!=NULL) delete w;
505  idDelete(&bigmat);
506
507  if(syz_ring!=orig_ring)
508    rChangeCurrRing(orig_ring);
509
510  /* interprete result ----------------------------------------*/
511  result = idInit(IDELEMS(tempstd),maxrk);
512  k = 0;
513  for (j=0;j<IDELEMS(tempstd);j++)
514  {
515    if ((tempstd->m[j]!=NULL) && (p_GetComp(tempstd->m[j],syz_ring)>syzComp))
516    {
517      if (syz_ring==orig_ring)
518        p = pCopy(tempstd->m[j]);
519      else
[441a2e]520        p = prCopyR(tempstd->m[j], syz_ring,currRing);
[861529]521      p_Shift(&p,-syzComp-isIdeal,currRing);
[0f401f]522      result->m[k] = p;
523      k++;
524    }
525  }
526  /* clean up ----------------------------------------------------*/
527  if(syz_ring!=orig_ring)
528    rChangeCurrRing(syz_ring);
529  idDelete(&tempstd);
530  if(syz_ring!=orig_ring)
531  {
532    rChangeCurrRing(orig_ring);
[5fe834]533    rDelete(syz_ring);
[0f401f]534  }
535  idSkipZeroes(result);
536  return result;
537}
538
539/*2
540*computes syzygies of h1,
541*if quot != NULL it computes in the quotient ring modulo "quot"
542*works always in a ring with ringorder_s
543*/
544static ideal idPrepare (ideal  h1, tHomog hom, int syzcomp, intvec **w)
545{
546  ideal   h2, h3;
547  int     i;
548  int     j,jj=0,k;
549  poly    p,q;
550
551  if (idIs0(h1)) return NULL;
[7b25fe]552  k = id_RankFreeModule(h1,currRing);
[0f401f]553  h2=idCopy(h1);
554  i = IDELEMS(h2)-1;
555  if (k == 0)
556  {
[861529]557    for (j=0; j<=i; j++) p_Shift(&(h2->m[j]),1,currRing);
[0f401f]558    k = 1;
559  }
560  if (syzcomp<k)
561  {
562    Warn("syzcomp too low, should be %d instead of %d",k,syzcomp);
563    syzcomp = k;
[b7cfaf]564    rSetSyzComp(k,currRing);
[0f401f]565  }
566  h2->rank = syzcomp+i+1;
567
568  //if (hom==testHomog)
569  //{
570  //  if(idHomIdeal(h1,currQuotient))
571  //  {
572  //    hom=TRUE;
573  //  }
574  //}
575
576#if MYTEST
577#ifdef RDEBUG
578  Print("Prepare::h2: ");
579  idPrint(h2);
580
581  for(j=0;j<IDELEMS(h2);j++) pTest(h2->m[j]);
582
583#endif
584#endif
585
586  for (j=0; j<=i; j++)
587  {
588    p = h2->m[j];
589    q = pOne();
590    pSetComp(q,syzcomp+1+j);
591    pSetmComp(q);
592    if (p!=NULL)
593    {
594      while (pNext(p)) pIter(p);
595      p->next = q;
596    }
597    else
598      h2->m[j]=q;
599  }
600
601#ifdef PDEBUG
602  for(j=0;j<IDELEMS(h2);j++) pTest(h2->m[j]);
603
604#if MYTEST
605#ifdef RDEBUG
606  Print("Prepare::Input: ");
607  idPrint(h2);
608
609  Print("Prepare::currQuotient: ");
610  idPrint(currQuotient);
611#endif
612#endif
613
614#endif
615
616  idTest(h2);
617
618  h3 = kStd(h2,currQuotient,hom,w,NULL,syzcomp);
619
620#if MYTEST
621#ifdef RDEBUG
622  Print("Prepare::Output: ");
623  idPrint(h3);
624  for(j=0;j<IDELEMS(h2);j++) pTest(h3->m[j]);
625#endif
626#endif
627
628
629  idDelete(&h2);
630  return h3;
631}
632
633/*2
634* compute the syzygies of h1 in R/quot,
635* weights of components are in w
636* if setRegularity, return the regularity in deg
637* do not change h1,  w
638*/
639ideal idSyzygies (ideal  h1, tHomog h,intvec **w, BOOLEAN setSyzComp,
640                  BOOLEAN setRegularity, int *deg)
641{
642  ideal s_h1;
643  poly  p;
644  int   j, k, length=0,reg;
645  BOOLEAN isMonomial=TRUE;
646  int ii, idElemens_h1;
647
648  assume(h1 != NULL);
649
650  idElemens_h1=IDELEMS(h1);
651#ifdef PDEBUG
652  for(ii=0;ii<idElemens_h1 /*IDELEMS(h1)*/;ii++) pTest(h1->m[ii]);
653#endif
654  if (idIs0(h1))
655  {
656    ideal result=idFreeModule(idElemens_h1/*IDELEMS(h1)*/);
[861529]657    int curr_syz_limit=rGetCurrSyzLimit(currRing);
[0f401f]658    if (curr_syz_limit>0)
659    for (ii=0;ii<idElemens_h1/*IDELEMS(h1)*/;ii++)
660    {
661      if (h1->m[ii]!=NULL)
[861529]662        p_Shift(&h1->m[ii],curr_syz_limit,currRing);
[0f401f]663    }
664    return result;
665  }
[7b25fe]666  int slength=(int)id_RankFreeModule(h1,currRing);
667  k=si_max(1,slength /*id_RankFreeModule(h1)*/);
[0f401f]668
669  assume(currRing != NULL);
670  ring orig_ring=currRing;
[3f07d1]671  ring syz_ring=rAssure_SyzComp(orig_ring,TRUE); rChangeCurrRing(syz_ring);
[0f401f]672
673  if (setSyzComp)
[b7cfaf]674    rSetSyzComp(k,syz_ring);
[0f401f]675
676  if (orig_ring != syz_ring)
677  {
[441a2e]678    s_h1=idrCopyR_NoSort(h1,orig_ring,syz_ring);
[0f401f]679  }
680  else
681  {
682    s_h1 = h1;
683  }
684
685  idTest(s_h1);
686
687  ideal s_h3=idPrepare(s_h1,h,k,w); // main (syz) GB computation
688
689  if (s_h3==NULL)
690  {
691    return idFreeModule( idElemens_h1 /*IDELEMS(h1)*/);
692  }
693
694  if (orig_ring != syz_ring)
695  {
696    idDelete(&s_h1);
697    for (j=0; j<IDELEMS(s_h3); j++)
698    {
699      if (s_h3->m[j] != NULL)
700      {
701        if (p_MinComp(s_h3->m[j],syz_ring) > k)
[f9591a]702          p_Shift(&s_h3->m[j], -k,syz_ring);
[0f401f]703        else
[f9591a]704          p_Delete(&s_h3->m[j],syz_ring);
[0f401f]705      }
706    }
707    idSkipZeroes(s_h3);
708    s_h3->rank -= k;
709    rChangeCurrRing(orig_ring);
[b7cfaf]710    s_h3 = idrMoveR_NoSort(s_h3, syz_ring, orig_ring);
[5fe834]711    rDelete(syz_ring);
[0f401f]712    #ifdef HAVE_PLURAL
[6a4ba5f]713    if (rIsPluralRing(orig_ring))
[0f401f]714    {
[6a4ba5f]715      id_DelMultiples(s_h3,orig_ring);
[0f401f]716      idSkipZeroes(s_h3);
717    }
718    #endif
719    idTest(s_h3);
720    return s_h3;
721  }
722
723  ideal e = idInit(IDELEMS(s_h3), s_h3->rank);
724
725  for (j=IDELEMS(s_h3)-1; j>=0; j--)
726  {
727    if (s_h3->m[j] != NULL)
728    {
729      if (p_MinComp(s_h3->m[j],syz_ring) <= k)
730      {
731        e->m[j] = s_h3->m[j];
732        isMonomial=isMonomial && (pNext(s_h3->m[j])==NULL);
[f9591a]733        p_Delete(&pNext(s_h3->m[j]),syz_ring);
[0f401f]734        s_h3->m[j] = NULL;
735      }
736    }
737  }
738
739  idSkipZeroes(s_h3);
740  idSkipZeroes(e);
741
742  if ((deg != NULL)
743  && (!isMonomial)
744  && (!TEST_OPT_NOTREGULARITY)
745  && (setRegularity)
746  && (h==isHomog)
747  && (!rIsPluralRing(currRing))
748  )
749  {
[1da2a13]750    ring dp_C_ring = rAssure_dp_C(syz_ring); // will do rChangeCurrRing later
[0f401f]751    if (dp_C_ring != syz_ring)
[441a2e]752    {
753      rChangeCurrRing(dp_C_ring);
[b7cfaf]754      e = idrMoveR_NoSort(e, syz_ring, dp_C_ring);
[441a2e]755    }
[0f401f]756    resolvente res = sySchreyerResolvente(e,-1,&length,TRUE, TRUE);
757    intvec * dummy = syBetti(res,length,&reg, *w);
758    *deg = reg+2;
759    delete dummy;
760    for (j=0;j<length;j++)
761    {
762      if (res[j]!=NULL) idDelete(&(res[j]));
763    }
764    omFreeSize((ADDRESS)res,length*sizeof(ideal));
765    idDelete(&e);
766    if (dp_C_ring != syz_ring)
767    {
768      rChangeCurrRing(syz_ring);
[5fe834]769      rDelete(dp_C_ring);
[0f401f]770    }
771  }
772  else
773  {
774    idDelete(&e);
775  }
776  idTest(s_h3);
777  if (currQuotient != NULL)
778  {
779    ideal ts_h3=kStd(s_h3,currQuotient,h,w);
780    idDelete(&s_h3);
781    s_h3 = ts_h3;
782  }
783  return s_h3;
784}
785
786/*2
787*/
788ideal idXXX (ideal  h1, int k)
789{
790  ideal s_h1;
791  int j;
792  intvec *w=NULL;
793
794  assume(currRing != NULL);
795  ring orig_ring=currRing;
[3f07d1]796  ring syz_ring=rAssure_SyzComp(orig_ring,TRUE); rChangeCurrRing(syz_ring);
[0f401f]797
[b7cfaf]798  rSetSyzComp(k,syz_ring);
[0f401f]799
800  if (orig_ring != syz_ring)
801  {
[441a2e]802    s_h1=idrCopyR_NoSort(h1,orig_ring, syz_ring);
[0f401f]803  }
804  else
805  {
806    s_h1 = h1;
807  }
808
809  ideal s_h3=kStd(s_h1,NULL,testHomog,&w,NULL,k);
810
811  if (s_h3==NULL)
812  {
813    return idFreeModule(IDELEMS(h1));
814  }
815
816  if (orig_ring != syz_ring)
817  {
818    idDelete(&s_h1);
819    idSkipZeroes(s_h3);
820    rChangeCurrRing(orig_ring);
[b7cfaf]821    s_h3 = idrMoveR_NoSort(s_h3, syz_ring, orig_ring);
[5fe834]822    rDelete(syz_ring);
[0f401f]823    idTest(s_h3);
824    return s_h3;
825  }
826
827  idSkipZeroes(s_h3);
828  idTest(s_h3);
829  return s_h3;
830}
831
832/*
833*computes a standard basis for h1 and stores the transformation matrix
834* in ma
835*/
836ideal idLiftStd (ideal  h1, matrix* ma, tHomog hi, ideal * syz)
837{
[7b25fe]838  int   i, j, k, t, inputIsIdeal=id_RankFreeModule(h1,currRing);
[0f401f]839  poly  p=NULL, q, qq;
840  intvec *w=NULL;
841
842  idDelete((ideal*)ma);
843  BOOLEAN lift3=FALSE;
844  if (syz!=NULL) { lift3=TRUE; idDelete(syz); }
845  if (idIs0(h1))
846  {
847    *ma=mpNew(1,0);
848    if (lift3)
849    {
850      *syz=idFreeModule(IDELEMS(h1));
[861529]851      int curr_syz_limit=rGetCurrSyzLimit(currRing);
[0f401f]852      if (curr_syz_limit>0)
853      for (int ii=0;ii<IDELEMS(h1);ii++)
854      {
855        if (h1->m[ii]!=NULL)
[861529]856          p_Shift(&h1->m[ii],curr_syz_limit,currRing);
[0f401f]857      }
858    }
859    return idInit(1,h1->rank);
860  }
861
862  BITSET save_verbose=verbose;
863
[7b25fe]864  k=si_max(1,(int)id_RankFreeModule(h1,currRing));
[0f401f]865
866  if ((k==1) && (!lift3)) verbose |=Sy_bit(V_IDLIFT);
867
868  ring orig_ring = currRing;
[3f07d1]869  ring syz_ring = rAssure_SyzComp(orig_ring,TRUE);  rChangeCurrRing(syz_ring);
[b7cfaf]870  rSetSyzComp(k,syz_ring);
[0f401f]871
872  ideal s_h1=h1;
873
874  if (orig_ring != syz_ring)
[441a2e]875    s_h1 = idrCopyR_NoSort(h1,orig_ring,syz_ring);
[0f401f]876  else
877    s_h1 = h1;
878
879  ideal s_h3=idPrepare(s_h1,hi,k,&w); // main (syz) GB computation
880
881  ideal s_h2 = idInit(IDELEMS(s_h3), s_h3->rank);
882
883  if (lift3) (*syz)=idInit(IDELEMS(s_h3),IDELEMS(h1));
884
885  if (w!=NULL) delete w;
886  i = 0;
887
888  // now sort the result, SB : leave in s_h3
889  //                      T:  put in s_h2
890  //                      syz: put in *syz
891  for (j=0; j<IDELEMS(s_h3); j++)
892  {
893    if (s_h3->m[j] != NULL)
894    {
895      //if (p_MinComp(s_h3->m[j],syz_ring) <= k)
896      if (pGetComp(s_h3->m[j]) <= k) // syz_ring == currRing
897      {
898        i++;
899        q = s_h3->m[j];
900        while (pNext(q) != NULL)
901        {
902          if (pGetComp(pNext(q)) > k)
903          {
904            s_h2->m[j] = pNext(q);
905            pNext(q) = NULL;
906          }
907          else
908          {
909            pIter(q);
910          }
911        }
[861529]912        if (!inputIsIdeal) p_Shift(&(s_h3->m[j]), -1,currRing);
[0f401f]913      }
914      else
915      {
916        // we a syzygy here:
917        if (lift3)
918        {
[861529]919          p_Shift(&s_h3->m[j], -k,currRing);
[0f401f]920          (*syz)->m[j]=s_h3->m[j];
921          s_h3->m[j]=NULL;
922        }
923        else
[f9591a]924          p_Delete(&(s_h3->m[j]),currRing);
[0f401f]925      }
926    }
927  }
928  idSkipZeroes(s_h3);
929  //extern char * iiStringMatrix(matrix im, int dim,char ch);
930  //PrintS("SB: ----------------------------------------\n");
931  //PrintS(iiStringMatrix((matrix)s_h3,k,'\n'));
932  //PrintLn();
933  //PrintS("T: ----------------------------------------\n");
934  //PrintS(iiStringMatrix((matrix)s_h2,h1->rank,'\n'));
935  //PrintLn();
936
937  if (lift3) idSkipZeroes(*syz);
938
939  j = IDELEMS(s_h1);
940
941
942  if (syz_ring!=orig_ring)
943  {
944    idDelete(&s_h1);
945    rChangeCurrRing(orig_ring);
946  }
947
948  *ma = mpNew(j,i);
949
950  i = 1;
951  for (j=0; j<IDELEMS(s_h2); j++)
952  {
953    if (s_h2->m[j] != NULL)
954    {
[b7cfaf]955      q = prMoveR( s_h2->m[j], syz_ring,orig_ring);
[0f401f]956      s_h2->m[j] = NULL;
957
958      while (q != NULL)
959      {
960        p = q;
961        pIter(q);
962        pNext(p) = NULL;
963        t=pGetComp(p);
964        pSetComp(p,0);
965        pSetmComp(p);
966        MATELEM(*ma,t-k,i) = pAdd(MATELEM(*ma,t-k,i),p);
967      }
968      i++;
969    }
970  }
971  idDelete(&s_h2);
972
973  for (i=0; i<IDELEMS(s_h3); i++)
974  {
[b7cfaf]975    s_h3->m[i] = prMoveR_NoSort(s_h3->m[i], syz_ring,orig_ring);
[0f401f]976  }
977  if (lift3)
978  {
979    for (i=0; i<IDELEMS(*syz); i++)
980    {
[b7cfaf]981      (*syz)->m[i] = prMoveR_NoSort((*syz)->m[i], syz_ring,orig_ring);
[0f401f]982    }
983  }
984
[5fe834]985  if (syz_ring!=orig_ring) rDelete(syz_ring);
[0f401f]986  verbose = save_verbose;
987  return s_h3;
988}
989
990static void idPrepareStd(ideal s_temp, int k)
991{
[7b25fe]992  int j,rk=id_RankFreeModule(s_temp,currRing);
[0f401f]993  poly p,q;
994
995  if (rk == 0)
996  {
997    for (j=0; j<IDELEMS(s_temp); j++)
998    {
999      if (s_temp->m[j]!=NULL) pSetCompP(s_temp->m[j],1);
1000    }
1001    k = si_max(k,1);
1002  }
1003  for (j=0; j<IDELEMS(s_temp); j++)
1004  {
1005    if (s_temp->m[j]!=NULL)
1006    {
1007      p = s_temp->m[j];
1008      q = pOne();
1009      //pGetCoeff(q)=nNeg(pGetCoeff(q));   //set q to -1
1010      pSetComp(q,k+1+j);
1011      pSetmComp(q);
1012      while (pNext(p)) pIter(p);
1013      pNext(p) = q;
1014    }
1015  }
1016}
1017
1018/*2
1019*computes a representation of the generators of submod with respect to those
1020* of mod
1021*/
1022
1023ideal idLift(ideal mod, ideal submod,ideal *rest, BOOLEAN goodShape,
1024             BOOLEAN isSB, BOOLEAN divide, matrix *unit)
1025{
[7b25fe]1026  int lsmod =id_RankFreeModule(submod,currRing), i, j, k;
[0f401f]1027  int comps_to_add=0;
1028  poly p;
1029
1030  if (idIs0(submod))
1031  {
1032    if (unit!=NULL)
1033    {
1034      *unit=mpNew(1,1);
1035      MATELEM(*unit,1,1)=pOne();
1036    }
1037    if (rest!=NULL)
1038    {
1039      *rest=idInit(1,mod->rank);
1040    }
1041    return idInit(1,mod->rank);
1042  }
1043  if (idIs0(mod)) /* and not idIs0(submod) */
1044  {
1045    WerrorS("2nd module does not lie in the first");
[a5d181c]1046    return NULL;
[0f401f]1047  }
1048  if (unit!=NULL)
1049  {
1050    comps_to_add = IDELEMS(submod);
1051    while ((comps_to_add>0) && (submod->m[comps_to_add-1]==NULL))
1052      comps_to_add--;
1053  }
[7b25fe]1054  k=si_max(id_RankFreeModule(mod,currRing),id_RankFreeModule(submod,currRing));
[0f401f]1055  if  ((k!=0) && (lsmod==0)) lsmod=1;
1056  k=si_max(k,(int)mod->rank);
1057  if (k<submod->rank) { WarnS("rk(submod) > rk(mod) ?");k=submod->rank; }
1058
1059  ring orig_ring=currRing;
[3f07d1]1060  ring syz_ring=rAssure_SyzComp(orig_ring,TRUE);  rChangeCurrRing(syz_ring);
[b7cfaf]1061  rSetSyzComp(k,syz_ring);
[0f401f]1062
1063  ideal s_mod, s_temp;
1064  if (orig_ring != syz_ring)
1065  {
[441a2e]1066    s_mod = idrCopyR_NoSort(mod,orig_ring,syz_ring);
1067    s_temp = idrCopyR_NoSort(submod,orig_ring,syz_ring);
[0f401f]1068  }
1069  else
1070  {
1071    s_mod = mod;
1072    s_temp = idCopy(submod);
1073  }
1074  ideal s_h3;
1075  if (isSB)
1076  {
1077    s_h3 = idCopy(s_mod);
1078    idPrepareStd(s_h3, k+comps_to_add);
1079  }
1080  else
1081  {
1082    s_h3 = idPrepare(s_mod,(tHomog)FALSE,k+comps_to_add,NULL);
1083  }
1084  if (!goodShape)
1085  {
1086    for (j=0;j<IDELEMS(s_h3);j++)
1087    {
1088      if ((s_h3->m[j] != NULL) && (pMinComp(s_h3->m[j]) > k))
[f9591a]1089        p_Delete(&(s_h3->m[j]),currRing);
[0f401f]1090    }
1091  }
1092  idSkipZeroes(s_h3);
1093  if (lsmod==0)
1094  {
1095    for (j=IDELEMS(s_temp);j>0;j--)
1096    {
1097      if (s_temp->m[j-1]!=NULL)
[861529]1098        p_Shift(&(s_temp->m[j-1]),1,currRing);
[0f401f]1099    }
1100  }
1101  if (unit!=NULL)
1102  {
1103    for(j = 0;j<comps_to_add;j++)
1104    {
1105      p = s_temp->m[j];
1106      if (p!=NULL)
1107      {
1108        while (pNext(p)!=NULL) pIter(p);
1109        pNext(p) = pOne();
1110        pIter(p);
1111        pSetComp(p,1+j+k);
1112        pSetmComp(p);
1113        p = pNeg(p);
1114      }
1115    }
1116  }
1117  ideal s_result = kNF(s_h3,currQuotient,s_temp,k);
1118  s_result->rank = s_h3->rank;
1119  ideal s_rest = idInit(IDELEMS(s_result),k);
1120  idDelete(&s_h3);
1121  idDelete(&s_temp);
1122
1123  for (j=0;j<IDELEMS(s_result);j++)
1124  {
1125    if (s_result->m[j]!=NULL)
1126    {
1127      if (pGetComp(s_result->m[j])<=k)
1128      {
1129        if (!divide)
1130        {
1131          if (isSB)
1132          {
1133            WarnS("first module not a standardbasis\n"
1134              "// ** or second not a proper submodule");
1135          }
1136          else
1137            WerrorS("2nd module does not lie in the first");
1138          idDelete(&s_result);
1139          idDelete(&s_rest);
1140          s_result=idInit(IDELEMS(submod),submod->rank);
1141          break;
1142        }
1143        else
1144        {
1145          p = s_rest->m[j] = s_result->m[j];
1146          while ((pNext(p)!=NULL) && (pGetComp(pNext(p))<=k)) pIter(p);
1147          s_result->m[j] = pNext(p);
1148          pNext(p) = NULL;
1149        }
1150      }
[861529]1151      p_Shift(&(s_result->m[j]),-k,currRing);
[0f401f]1152      pNeg(s_result->m[j]);
1153    }
1154  }
1155  if ((lsmod==0) && (!idIs0(s_rest)))
1156  {
1157    for (j=IDELEMS(s_rest);j>0;j--)
1158    {
1159      if (s_rest->m[j-1]!=NULL)
1160      {
[861529]1161        p_Shift(&(s_rest->m[j-1]),-1,currRing);
[0f401f]1162        s_rest->m[j-1] = s_rest->m[j-1];
1163      }
1164    }
1165  }
1166  if(syz_ring!=orig_ring)
1167  {
1168    idDelete(&s_mod);
1169    rChangeCurrRing(orig_ring);
[b7cfaf]1170    s_result = idrMoveR_NoSort(s_result, syz_ring, orig_ring);
1171    s_rest = idrMoveR_NoSort(s_rest, syz_ring, orig_ring);
[5fe834]1172    rDelete(syz_ring);
[0f401f]1173  }
1174  if (rest!=NULL)
1175    *rest = s_rest;
1176  else
1177    idDelete(&s_rest);
1178//idPrint(s_result);
1179  if (unit!=NULL)
1180  {
1181    *unit=mpNew(comps_to_add,comps_to_add);
1182    int i;
1183    for(i=0;i<IDELEMS(s_result);i++)
1184    {
1185      poly p=s_result->m[i];
1186      poly q=NULL;
1187      while(p!=NULL)
1188      {
1189        if(pGetComp(p)<=comps_to_add)
1190        {
1191          pSetComp(p,0);
1192          if (q!=NULL)
1193          {
1194            pNext(q)=pNext(p);
1195          }
1196          else
1197          {
1198            pIter(s_result->m[i]);
1199          }
1200          pNext(p)=NULL;
1201          MATELEM(*unit,i+1,i+1)=pAdd(MATELEM(*unit,i+1,i+1),p);
1202          if(q!=NULL)   p=pNext(q);
1203          else          p=s_result->m[i];
1204        }
1205        else
1206        {
1207          q=p;
1208          pIter(p);
1209        }
1210      }
[861529]1211      p_Shift(&s_result->m[i],-comps_to_add,currRing);
[0f401f]1212    }
1213  }
1214  return s_result;
1215}
1216
1217/*2
1218*computes division of P by Q with remainder up to (w-weighted) degree n
1219*P, Q, and w are not changed
1220*/
1221void idLiftW(ideal P,ideal Q,int n,matrix &T, ideal &R,short *w)
1222{
1223  long N=0;
1224  int i;
1225  for(i=IDELEMS(Q)-1;i>=0;i--)
1226    if(w==NULL)
[31f1850]1227      N=si_max(N,p_Deg(Q->m[i],currRing));
[0f401f]1228    else
1229      N=si_max(N,pDegW(Q->m[i],w));
1230  N+=n;
1231
1232  T=mpNew(IDELEMS(Q),IDELEMS(P));
1233  R=idInit(IDELEMS(P),P->rank);
1234
1235  for(i=IDELEMS(P)-1;i>=0;i--)
1236  {
1237    poly p;
1238    if(w==NULL)
1239      p=ppJet(P->m[i],N);
1240    else
1241      p=ppJetW(P->m[i],N,w);
1242
1243    int j=IDELEMS(Q)-1;
1244    while(p!=NULL)
1245    {
1246      if(pDivisibleBy(Q->m[j],p))
1247      {
[441a2e]1248        poly p0=p_DivideM(pHead(p),pHead(Q->m[j]),currRing);
[0f401f]1249        if(w==NULL)
1250          p=pJet(pSub(p,ppMult_mm(Q->m[j],p0)),N);
1251        else
1252          p=pJetW(pSub(p,ppMult_mm(Q->m[j],p0)),N,w);
1253        pNormalize(p);
[31f1850]1254        if((w==NULL)&&(p_Deg(p0,currRing)>n)||(w!=NULL)&&(pDegW(p0,w)>n))
[f9591a]1255          p_Delete(&p0,currRing);
[0f401f]1256        else
1257          MATELEM(T,j+1,i+1)=pAdd(MATELEM(T,j+1,i+1),p0);
1258        j=IDELEMS(Q)-1;
1259      }
1260      else
1261      {
1262        if(j==0)
1263        {
1264          poly p0=p;
1265          pIter(p);
1266          pNext(p0)=NULL;
[31f1850]1267          if(((w==NULL)&&(p_Deg(p0,currRing)>n))
[0f401f]1268          ||((w!=NULL)&&(pDegW(p0,w)>n)))
[f9591a]1269            p_Delete(&p0,currRing);
[0f401f]1270          else
1271            R->m[i]=pAdd(R->m[i],p0);
1272          j=IDELEMS(Q)-1;
1273        }
1274        else
1275          j--;
1276      }
1277    }
1278  }
1279}
1280
1281/*2
1282*computes the quotient of h1,h2 : internal routine for idQuot
1283*BEWARE: the returned ideals may contain incorrectly ordered polys !
1284*
1285*/
1286static ideal idInitializeQuot (ideal  h1, ideal h2, BOOLEAN h1IsStb,
1287                               BOOLEAN *addOnlyOne, int *kkmax)
1288{
1289  ideal temph1;
1290  poly     p,q = NULL;
1291  int i,l,ll,k,kkk,kmax;
1292  int j = 0;
[7b25fe]1293  int k1 = id_RankFreeModule(h1,currRing);
1294  int k2 = id_RankFreeModule(h2,currRing);
[0f401f]1295  tHomog   hom=isNotHomog;
1296
1297  k=si_max(k1,k2);
1298  if (k==0)
1299    k = 1;
1300  if ((k2==0) && (k>1)) *addOnlyOne = FALSE;
1301
1302  intvec * weights;
1303  hom = (tHomog)idHomModule(h1,currQuotient,&weights);
1304  if (/**addOnlyOne &&*/ (!h1IsStb))
1305    temph1 = kStd(h1,currQuotient,hom,&weights,NULL);
1306  else
1307    temph1 = idCopy(h1);
1308  if (weights!=NULL) delete weights;
1309  idTest(temph1);
1310/*--- making a single vector from h2 ---------------------*/
1311  for (i=0; i<IDELEMS(h2); i++)
1312  {
1313    if (h2->m[i] != NULL)
1314    {
1315      p = pCopy(h2->m[i]);
1316      if (k2 == 0)
[861529]1317        p_Shift(&p,j*k+1,currRing);
[0f401f]1318      else
[861529]1319        p_Shift(&p,j*k,currRing);
[0f401f]1320      q = pAdd(q,p);
1321      j++;
1322    }
1323  }
1324  *kkmax = kmax = j*k+1;
1325/*--- adding a monomial for the result (syzygy) ----------*/
1326  p = q;
1327  while (pNext(p)!=NULL) pIter(p);
1328  pNext(p) = pOne();
1329  pIter(p);
1330  pSetComp(p,kmax);
1331  pSetmComp(p);
1332/*--- constructing the big matrix ------------------------*/
1333  ideal h4 = idInit(16,kmax+k-1);
1334  h4->m[0] = q;
1335  if (k2 == 0)
1336  {
1337    if (k > IDELEMS(h4))
1338    {
1339      pEnlargeSet(&(h4->m),IDELEMS(h4),k-IDELEMS(h4));
1340      IDELEMS(h4) = k;
1341    }
1342    for (i=1; i<k; i++)
1343    {
1344      if (h4->m[i-1]!=NULL)
1345      {
1346        p = pCopy_noCheck(h4->m[i-1]);
[861529]1347        p_Shift(&p,1,currRing);
[0f401f]1348        h4->m[i] = p;
1349      }
1350    }
1351  }
1352  idSkipZeroes(h4);
1353  kkk = IDELEMS(h4);
1354  i = IDELEMS(temph1);
1355  for (l=0; l<i; l++)
1356  {
1357    if(temph1->m[l]!=NULL)
1358    {
1359      for (ll=0; ll<j; ll++)
1360      {
1361        p = pCopy(temph1->m[l]);
1362        if (k1 == 0)
[861529]1363          p_Shift(&p,ll*k+1,currRing);
[0f401f]1364        else
[861529]1365          p_Shift(&p,ll*k,currRing);
[0f401f]1366        if (kkk >= IDELEMS(h4))
1367        {
1368          pEnlargeSet(&(h4->m),IDELEMS(h4),16);
1369          IDELEMS(h4) += 16;
1370        }
1371        h4->m[kkk] = p;
1372        kkk++;
1373      }
1374    }
1375  }
1376/*--- if h2 goes in as single vector - the h1-part is just SB ---*/
1377  if (*addOnlyOne)
1378  {
1379    idSkipZeroes(h4);
1380    p = h4->m[0];
1381    for (i=0;i<IDELEMS(h4)-1;i++)
1382    {
1383      h4->m[i] = h4->m[i+1];
1384    }
1385    h4->m[IDELEMS(h4)-1] = p;
1386    test |= Sy_bit(OPT_SB_1);
1387  }
1388  idDelete(&temph1);
1389  return h4;
1390}
1391/*2
1392*computes the quotient of h1,h2
1393*/
1394ideal idQuot (ideal  h1, ideal h2, BOOLEAN h1IsStb, BOOLEAN resultIsIdeal)
1395{
1396  // first check for special case h1:(0)
1397  if (idIs0(h2))
1398  {
1399    ideal res;
1400    if (resultIsIdeal)
1401    {
1402      res = idInit(1,1);
1403      res->m[0] = pOne();
1404    }
1405    else
1406      res = idFreeModule(h1->rank);
1407    return res;
1408  }
1409  BITSET old_test=test;
1410  int i,l,ll,k,kkk,kmax;
1411  BOOLEAN  addOnlyOne=TRUE;
1412  tHomog   hom=isNotHomog;
1413  intvec * weights1;
1414
1415  ideal s_h4 = idInitializeQuot (h1,h2,h1IsStb,&addOnlyOne,&kmax);
1416
1417  hom = (tHomog)idHomModule(s_h4,currQuotient,&weights1);
1418
1419  ring orig_ring=currRing;
[3f07d1]1420  ring syz_ring=rAssure_SyzComp(orig_ring,TRUE);  rChangeCurrRing(syz_ring);
[b7cfaf]1421  rSetSyzComp(kmax-1,syz_ring);
[0f401f]1422  if (orig_ring!=syz_ring)
[b7cfaf]1423  //  s_h4 = idrMoveR_NoSort(s_h4,orig_ring, syz_ring);
1424    s_h4 = idrMoveR(s_h4,orig_ring, syz_ring);
[0f401f]1425  idTest(s_h4);
1426  #if 0
1427  void ipPrint_MA0(matrix m, const char *name);
1428  matrix m=idModule2Matrix(idCopy(s_h4));
1429  PrintS("start:\n");
1430  ipPrint_MA0(m,"Q");
1431  idDelete((ideal *)&m);
1432  PrintS("last elem:");wrp(s_h4->m[IDELEMS(s_h4)-1]);PrintLn();
1433  #endif
1434  ideal s_h3;
1435  if (addOnlyOne)
1436  {
1437    s_h3 = kStd(s_h4,currQuotient,hom,&weights1,NULL,0/*kmax-1*/,IDELEMS(s_h4)-1);
1438  }
1439  else
1440  {
1441    s_h3 = kStd(s_h4,currQuotient,hom,&weights1,NULL,kmax-1);
1442  }
1443  test = old_test;
1444  #if 0
1445  // only together with the above debug stuff
1446  idSkipZeroes(s_h3);
1447  m=idModule2Matrix(idCopy(s_h3));
1448  Print("result, kmax=%d:\n",kmax);
1449  ipPrint_MA0(m,"S");
1450  idDelete((ideal *)&m);
1451  #endif
1452  idTest(s_h3);
1453  if (weights1!=NULL) delete weights1;
1454  idDelete(&s_h4);
1455
1456  for (i=0;i<IDELEMS(s_h3);i++)
1457  {
1458    if ((s_h3->m[i]!=NULL) && (pGetComp(s_h3->m[i])>=kmax))
1459    {
1460      if (resultIsIdeal)
[861529]1461        p_Shift(&s_h3->m[i],-kmax,currRing);
[0f401f]1462      else
[861529]1463        p_Shift(&s_h3->m[i],-kmax+1,currRing);
[0f401f]1464    }
1465    else
[f9591a]1466      p_Delete(&s_h3->m[i],currRing);
[0f401f]1467  }
1468  if (resultIsIdeal)
1469    s_h3->rank = 1;
1470  else
1471    s_h3->rank = h1->rank;
1472  if(syz_ring!=orig_ring)
1473  {
1474    rChangeCurrRing(orig_ring);
[b7cfaf]1475    s_h3 = idrMoveR_NoSort(s_h3, syz_ring, orig_ring);
[5fe834]1476    rDelete(syz_ring);
[0f401f]1477  }
1478  idSkipZeroes(s_h3);
1479  idTest(s_h3);
1480  return s_h3;
1481}
1482
1483/*2
1484* eliminate delVar (product of vars) in h1
1485*/
1486ideal idElimination (ideal h1,poly delVar,intvec *hilb)
1487{
1488  int    i,j=0,k,l;
1489  ideal  h,hh, h3;
1490  int    *ord,*block0,*block1;
1491  int    ordersize=2;
1492  int    **wv;
1493  tHomog hom;
1494  intvec * w;
1495  ring tmpR;
1496  ring origR = currRing;
1497
1498  if (delVar==NULL)
1499  {
1500    return idCopy(h1);
1501  }
1502  if ((currQuotient!=NULL) && rIsPluralRing(origR))
1503  {
1504    WerrorS("cannot eliminate in a qring");
[a5d181c]1505    return NULL;
[0f401f]1506  }
1507  if (idIs0(h1)) return idInit(1,h1->rank);
1508#ifdef HAVE_PLURAL
1509  if (rIsPluralRing(origR))
1510    /* in the NC case, we have to check the admissibility of */
1511    /* the subalgebra to be intersected with */
1512  {
1513    if ((ncRingType(origR) != nc_skew) && (ncRingType(origR) != nc_exterior)) /* in (quasi)-commutative algebras every subalgebra is admissible */
1514    {
1515      if (nc_CheckSubalgebra(delVar,origR))
1516      {
1517        WerrorS("no elimination is possible: subalgebra is not admissible");
[a5d181c]1518        return NULL;
[0f401f]1519      }
1520    }
1521  }
1522#endif
1523  hom=(tHomog)idHomModule(h1,NULL,&w); //sets w to weight vector or NULL
1524  h3=idInit(16,h1->rank);
1525  for (k=0;; k++)
1526  {
1527    if (origR->order[k]!=0) ordersize++;
1528    else break;
1529  }
1530#if 0
1531  if (rIsPluralRing(origR)) // we have too keep the odering: it may be needed
1532                            // for G-algebra
1533  {
1534    for (k=0;k<ordersize-1; k++)
1535    {
1536      block0[k+1] = origR->block0[k];
1537      block1[k+1] = origR->block1[k];
1538      ord[k+1] = origR->order[k];
1539      if (origR->wvhdl[k]!=NULL) wv[k+1] = (int*) omMemDup(origR->wvhdl[k]);
1540    }
1541  }
1542  else
1543  {
1544    block0[1] = 1;
[1f637e]1545    block1[1] = (currRing->N);
[0f401f]1546    if (origR->OrdSgn==1) ord[1] = ringorder_wp;
1547    else                  ord[1] = ringorder_ws;
[1f637e]1548    wv[1]=(int*)omAlloc0((currRing->N)*sizeof(int));
1549    double wNsqr = (double)2.0 / (double)(currRing->N);
[0f401f]1550    wFunctional = wFunctionalBuch;
[1f637e]1551    int  *x= (int * )omAlloc(2 * ((currRing->N) + 1) * sizeof(int));
[0f401f]1552    int sl=IDELEMS(h1) - 1;
1553    wCall(h1->m, sl, x, wNsqr);
[1f637e]1554    for (sl = (currRing->N); sl!=0; sl--)
1555      wv[1][sl-1] = x[sl + (currRing->N) + 1];
1556    omFreeSize((ADDRESS)x, 2 * ((currRing->N) + 1) * sizeof(int));
[0f401f]1557
1558    ord[2]=ringorder_C;
1559    ord[3]=0;
1560  }
1561#else
1562#endif
1563  if ((hom==TRUE) && (origR->OrdSgn==1) && (!rIsPluralRing(origR)))
1564  {
1565    #if 1
1566    // we change to an ordering:
1567    // aa(1,1,1,...,0,0,0),wp(...),C
1568    // this seems to be better than version 2 below,
1569    // according to Tst/../elimiate_[3568].tat (- 17 %)
1570    ord=(int*)omAlloc0(4*sizeof(int));
1571    block0=(int*)omAlloc0(4*sizeof(int));
1572    block1=(int*)omAlloc0(4*sizeof(int));
1573    wv=(int**) omAlloc0(4*sizeof(int**));
1574    block0[0] = block0[1] = 1;
1575    block1[0] = block1[1] = rVar(origR);
1576    wv[0]=(int*)omAlloc0((rVar(origR) + 1)*sizeof(int));
1577    // use this special ordering: like ringorder_a, except that pFDeg, pWeights
1578    // ignore it
1579    ord[0] = ringorder_aa;
1580    for (j=0;j<rVar(origR);j++)
1581      if (pGetExp(delVar,j+1)!=0) wv[0][j]=1;
1582    BOOLEAN wp=FALSE;
1583    for (j=0;j<rVar(origR);j++)
1584      if (pWeight(j+1,origR)!=1) { wp=TRUE;break; }
1585    if (wp)
1586    {
1587      wv[1]=(int*)omAlloc0((rVar(origR) + 1)*sizeof(int));
1588      for (j=0;j<rVar(origR);j++)
1589        wv[1][j]=pWeight(j+1,origR);
1590      ord[1] = ringorder_wp;
1591    }
1592    else
1593      ord[1] = ringorder_dp;
1594    #else
1595    // we change to an ordering:
1596    // a(w1,...wn),wp(1,...0.....),C
1597    ord=(int*)omAlloc0(4*sizeof(int));
1598    block0=(int*)omAlloc0(4*sizeof(int));
1599    block1=(int*)omAlloc0(4*sizeof(int));
1600    wv=(int**) omAlloc0(4*sizeof(int**));
1601    block0[0] = block0[1] = 1;
1602    block1[0] = block1[1] = rVar(origR);
1603    wv[0]=(int*)omAlloc0((rVar(origR) + 1)*sizeof(int));
1604    wv[1]=(int*)omAlloc0((rVar(origR) + 1)*sizeof(int));
1605    ord[0] = ringorder_a;
1606    for (j=0;j<rVar(origR);j++)
1607      wv[0][j]=pWeight(j+1,origR);
1608    ord[1] = ringorder_wp;
1609    for (j=0;j<rVar(origR);j++)
1610      if (pGetExp(delVar,j+1)!=0) wv[1][j]=1;
1611    #endif
1612    ord[2] = ringorder_C;
1613    ord[3] = 0;
1614  }
1615  else
1616  {
1617    // we change to an ordering:
1618    // aa(....),orig_ordering
1619    ord=(int*)omAlloc0(ordersize*sizeof(int));
1620    block0=(int*)omAlloc0(ordersize*sizeof(int));
1621    block1=(int*)omAlloc0(ordersize*sizeof(int));
1622    wv=(int**) omAlloc0(ordersize*sizeof(int**));
1623    for (k=0;k<ordersize-1; k++)
1624    {
1625      block0[k+1] = origR->block0[k];
1626      block1[k+1] = origR->block1[k];
1627      ord[k+1] = origR->order[k];
1628      if (origR->wvhdl[k]!=NULL) wv[k+1] = (int*) omMemDup(origR->wvhdl[k]);
1629    }
1630    block0[0] = 1;
1631    block1[0] = rVar(origR);
1632    wv[0]=(int*)omAlloc0((rVar(origR) + 1)*sizeof(int));
1633    for (j=0;j<rVar(origR);j++)
1634      if (pGetExp(delVar,j+1)!=0) wv[0][j]=1;
1635    // use this special ordering: like ringorder_a, except that pFDeg, pWeights
1636    // ignore it
1637    ord[0] = ringorder_aa;
1638  }
1639  // fill in tmp ring to get back the data later on
1640  tmpR  = rCopy0(origR,FALSE,FALSE); // qring==NULL
1641  //rUnComplete(tmpR);
1642  tmpR->p_Procs=NULL;
1643  tmpR->order = ord;
1644  tmpR->block0 = block0;
1645  tmpR->block1 = block1;
1646  tmpR->wvhdl = wv;
1647  rComplete(tmpR, 1);
1648
1649#ifdef HAVE_PLURAL
1650  /* update nc structure on tmpR */
1651  if (rIsPluralRing(origR))
1652  {
1653    if ( nc_rComplete(origR, tmpR, false) ) // no quotient ideal!
1654    {
1655      Werror("no elimination is possible: ordering condition is violated");
1656      // cleanup
1657      rDelete(tmpR);
1658      if (w!=NULL)
1659        delete w;
[a5d181c]1660      return NULL;
[0f401f]1661    }
1662  }
1663#endif
1664  // change into the new ring
[1f637e]1665  //pChangeRing((currRing->N),currRing->OrdSgn,ord,block0,block1,wv);
[0f401f]1666  rChangeCurrRing(tmpR);
1667
1668  //h = idInit(IDELEMS(h1),h1->rank);
1669  // fetch data from the old ring
1670  //for (k=0;k<IDELEMS(h1);k++) h->m[k] = prCopyR( h1->m[k], origR);
1671  h=idrCopyR(h1,origR,currRing);
1672  if (origR->qideal!=NULL)
1673  {
1674    WarnS("eliminate in q-ring: experimental");
1675    ideal q=idrCopyR(origR->qideal,origR,currRing);
1676    ideal s=idSimpleAdd(h,q);
1677    idDelete(&h);
1678    idDelete(&q);
1679    h=s;
1680  }
1681  // compute kStd
1682#if 1
1683  //rWrite(tmpR);PrintLn();
1684  BITSET save=test;
1685  //test |=1;
1686  //Print("h: %d gen, rk=%d\n",IDELEMS(h),h->rank);
1687  //extern char * showOption();
1688  //Print("%s\n",showOption());
1689  hh = kStd(h,NULL,hom,&w,hilb);
1690  test=save;
1691  idDelete(&h);
1692#else
1693  extern ideal kGroebner(ideal F, ideal Q);
1694  hh=kGroebner(h,NULL);
1695#endif
1696  // go back to the original ring
1697  rChangeCurrRing(origR);
1698  i = IDELEMS(hh)-1;
1699  while ((i >= 0) && (hh->m[i] == NULL)) i--;
1700  j = -1;
1701  // fetch data from temp ring
1702  for (k=0; k<=i; k++)
1703  {
[1f637e]1704    l=(currRing->N);
[0f401f]1705    while ((l>0) && (p_GetExp( hh->m[k],l,tmpR)*pGetExp(delVar,l)==0)) l--;
1706    if (l==0)
1707    {
1708      j++;
1709      if (j >= IDELEMS(h3))
1710      {
1711        pEnlargeSet(&(h3->m),IDELEMS(h3),16);
1712        IDELEMS(h3) += 16;
1713      }
[b7cfaf]1714      h3->m[j] = prMoveR( hh->m[k], tmpR,origR);
[0f401f]1715      hh->m[k] = NULL;
1716    }
1717  }
1718  id_Delete(&hh, tmpR);
1719  idSkipZeroes(h3);
1720  rDelete(tmpR);
1721  if (w!=NULL)
1722    delete w;
1723  return h3;
1724}
1725
1726/*2
1727* compute the which-th ar-minor of the matrix a
1728*/
1729poly idMinor(matrix a, int ar, unsigned long which, ideal R)
1730{
1731  int     i,j,k,size;
1732  unsigned long curr;
1733  int *rowchoise,*colchoise;
1734  BOOLEAN rowch,colch;
1735  ideal result;
1736  matrix tmp;
1737  poly p,q;
1738
1739  i = binom(a->rows(),ar);
1740  j = binom(a->cols(),ar);
1741
1742  rowchoise=(int *)omAlloc(ar*sizeof(int));
1743  colchoise=(int *)omAlloc(ar*sizeof(int));
1744  if ((i>512) || (j>512) || (i*j >512)) size=512;
1745  else size=i*j;
1746  result=idInit(size,1);
1747  tmp=mpNew(ar,ar);
1748  k = 0; /* the index in result*/
1749  curr = 0; /* index of current minor */
1750  idInitChoise(ar,1,a->rows(),&rowch,rowchoise);
1751  while (!rowch)
1752  {
1753    idInitChoise(ar,1,a->cols(),&colch,colchoise);
1754    while (!colch)
1755    {
1756      if (curr == which)
1757      {
1758        for (i=1; i<=ar; i++)
1759        {
1760          for (j=1; j<=ar; j++)
1761          {
1762            MATELEM(tmp,i,j) = MATELEM(a,rowchoise[i-1],colchoise[j-1]);
1763          }
1764        }
[441a2e]1765        p = mp_DetBareiss(tmp,currRing);
[0f401f]1766        if (p!=NULL)
1767        {
1768          if (R!=NULL)
1769          {
1770            q = p;
1771            p = kNF(R,currQuotient,q);
[f9591a]1772            p_Delete(&q,currRing);
[0f401f]1773          }
1774          /*delete the matrix tmp*/
1775          for (i=1; i<=ar; i++)
1776          {
1777            for (j=1; j<=ar; j++) MATELEM(tmp,i,j) = NULL;
1778          }
1779          idDelete((ideal*)&tmp);
1780          omFreeSize((ADDRESS)rowchoise,ar*sizeof(int));
1781          omFreeSize((ADDRESS)colchoise,ar*sizeof(int));
1782          return (p);
1783        }
1784      }
1785      curr++;
1786      idGetNextChoise(ar,a->cols(),&colch,colchoise);
1787    }
1788    idGetNextChoise(ar,a->rows(),&rowch,rowchoise);
1789  }
1790  return (poly) 1;
1791}
1792
1793#ifdef WITH_OLD_MINOR
1794/*2
1795* compute all ar-minors of the matrix a
1796*/
1797ideal idMinors(matrix a, int ar, ideal R)
1798{
1799  int     i,j,k,size;
1800  int *rowchoise,*colchoise;
1801  BOOLEAN rowch,colch;
1802  ideal result;
1803  matrix tmp;
1804  poly p,q;
1805
1806  i = binom(a->rows(),ar);
1807  j = binom(a->cols(),ar);
1808
1809  rowchoise=(int *)omAlloc(ar*sizeof(int));
1810  colchoise=(int *)omAlloc(ar*sizeof(int));
1811  if ((i>512) || (j>512) || (i*j >512)) size=512;
1812  else size=i*j;
1813  result=idInit(size,1);
1814  tmp=mpNew(ar,ar);
1815  k = 0; /* the index in result*/
1816  idInitChoise(ar,1,a->rows(),&rowch,rowchoise);
1817  while (!rowch)
1818  {
1819    idInitChoise(ar,1,a->cols(),&colch,colchoise);
1820    while (!colch)
1821    {
1822      for (i=1; i<=ar; i++)
1823      {
1824        for (j=1; j<=ar; j++)
1825        {
1826          MATELEM(tmp,i,j) = MATELEM(a,rowchoise[i-1],colchoise[j-1]);
1827        }
1828      }
[441a2e]1829      p = mp_DetBareiss(tmp,vcurrRing);
[0f401f]1830      if (p!=NULL)
1831      {
1832        if (R!=NULL)
1833        {
1834          q = p;
1835          p = kNF(R,currQuotient,q);
[f9591a]1836          p_Delete(&q,currRing);
[0f401f]1837        }
1838        if (p!=NULL)
1839        {
1840          if (k>=size)
1841          {
1842            pEnlargeSet(&result->m,size,32);
1843            size += 32;
1844          }
1845          result->m[k] = p;
1846          k++;
1847        }
1848      }
1849      idGetNextChoise(ar,a->cols(),&colch,colchoise);
1850    }
1851    idGetNextChoise(ar,a->rows(),&rowch,rowchoise);
1852  }
1853  /*delete the matrix tmp*/
1854  for (i=1; i<=ar; i++)
1855  {
1856    for (j=1; j<=ar; j++) MATELEM(tmp,i,j) = NULL;
1857  }
1858  idDelete((ideal*)&tmp);
1859  if (k==0)
1860  {
1861    k=1;
1862    result->m[0]=NULL;
1863  }
1864  omFreeSize((ADDRESS)rowchoise,ar*sizeof(int));
1865  omFreeSize((ADDRESS)colchoise,ar*sizeof(int));
1866  pEnlargeSet(&result->m,size,k-size);
1867  IDELEMS(result) = k;
1868  return (result);
1869}
1870#else
1871/*2
1872* compute all ar-minors of the matrix a
1873* the caller of mpRecMin
1874* the elements of the result are not in R (if R!=NULL)
1875*/
1876ideal idMinors(matrix a, int ar, ideal R)
1877{
1878  int elems=0;
1879  int r=a->nrows,c=a->ncols;
1880  int i;
1881  matrix b;
1882  ideal result,h;
[46008c]1883  ring origR=currRing;
[0f401f]1884  ring tmpR;
1885  long bound;
1886
1887  if((ar<=0) || (ar>r) || (ar>c))
1888  {
1889    Werror("%d-th minor, matrix is %dx%d",ar,r,c);
1890    return NULL;
1891  }
[46008c]1892  h = id_Matrix2Module(mp_Copy(a,origR),origR);
1893  bound = sm_ExpBound(h,c,r,ar,origR);
[0f401f]1894  idDelete(&h);
[441a2e]1895  tmpR=sm_RingChange(origR,bound);
[0f401f]1896  b = mpNew(r,c);
1897  for (i=r*c-1;i>=0;i--)
1898  {
1899    if (a->m[i])
[46008c]1900      b->m[i] = prCopyR(a->m[i],origR,tmpR);
[0f401f]1901  }
1902  if (R!=NULL)
1903  {
[46008c]1904    R = idrCopyR(R,origR,tmpR);
[0f401f]1905    //if (ar>1) // otherwise done in mpMinorToResult
1906    //{
1907    //  matrix bb=(matrix)kNF(R,currQuotient,(ideal)b);
1908    //  bb->rank=b->rank; bb->nrows=b->nrows; bb->ncols=b->ncols;
1909    //  idDelete((ideal*)&b); b=bb;
1910    //}
1911  }
1912  result=idInit(32,1);
[46008c]1913  if(ar>1) mp_RecMin(ar-1,result,elems,b,r,c,NULL,R,tmpR);
1914  else mp_MinorToResult(result,elems,b,r,c,R,tmpR);
[0f401f]1915  idDelete((ideal *)&b);
1916  if (R!=NULL) idDelete(&R);
1917  idSkipZeroes(result);
1918  rChangeCurrRing(origR);
[441a2e]1919  result = idrMoveR(result,tmpR,origR);
[d16ea9]1920  sm_KillModifiedRing(tmpR);
[0f401f]1921  idTest(result);
1922  return result;
1923}
1924#endif
1925
1926/*2
1927*returns TRUE if id1 is a submodule of id2
1928*/
1929BOOLEAN idIsSubModule(ideal id1,ideal id2)
1930{
1931  int i;
1932  poly p;
1933
1934  if (idIs0(id1)) return TRUE;
1935  for (i=0;i<IDELEMS(id1);i++)
1936  {
1937    if (id1->m[i] != NULL)
1938    {
1939      p = kNF(id2,currQuotient,id1->m[i]);
1940      if (p != NULL)
1941      {
[f9591a]1942        p_Delete(&p,currRing);
[0f401f]1943        return FALSE;
1944      }
1945    }
1946  }
1947  return TRUE;
1948}
1949
1950BOOLEAN idTestHomModule(ideal m, ideal Q, intvec *w)
1951{
1952  if ((Q!=NULL) && (!idHomIdeal(Q,NULL)))  { PrintS(" Q not hom\n"); return FALSE;}
1953  if (idIs0(m)) return TRUE;
1954
1955  int cmax=-1;
1956  int i;
1957  poly p=NULL;
1958  int length=IDELEMS(m);
1959  polyset P=m->m;
1960  for (i=length-1;i>=0;i--)
1961  {
1962    p=P[i];
1963    if (p!=NULL) cmax=si_max(cmax,(int)pMaxComp(p)+1);
1964  }
1965  if (w != NULL)
1966  if (w->length()+1 < cmax)
1967  {
1968    // Print("length: %d - %d \n", w->length(),cmax);
1969    return FALSE;
1970  }
1971
1972  if(w!=NULL)
[e1215e]1973    p_SetModDeg(w, currRing);
[0f401f]1974
1975  for (i=length-1;i>=0;i--)
1976  {
1977    p=P[i];
1978    poly q=p;
1979    if (p!=NULL)
1980    {
[b7cfaf]1981      int d=currRing->pFDeg(p,currRing);
[0f401f]1982      loop
1983      {
1984        pIter(p);
1985        if (p==NULL) break;
[b7cfaf]1986        if (d!=currRing->pFDeg(p,currRing))
[0f401f]1987        {
1988          //pWrite(q); wrp(p); Print(" -> %d - %d\n",d,pFDeg(p,currRing));
1989          if(w!=NULL)
[e1215e]1990            p_SetModDeg(NULL, currRing);
[0f401f]1991          return FALSE;
1992        }
1993      }
1994    }
1995  }
1996
1997  if(w!=NULL)
[e1215e]1998    p_SetModDeg(NULL, currRing);
[0f401f]1999
2000  return TRUE;
2001}
2002
2003ideal idSeries(int n,ideal M,matrix U,intvec *w)
2004{
2005  for(int i=IDELEMS(M)-1;i>=0;i--)
2006  {
2007    if(U==NULL)
2008      M->m[i]=pSeries(n,M->m[i],NULL,w);
2009    else
2010    {
2011      M->m[i]=pSeries(n,M->m[i],MATELEM(U,i+1,i+1),w);
2012      MATELEM(U,i+1,i+1)=NULL;
2013    }
2014  }
2015  if(U!=NULL)
2016    idDelete((ideal*)&U);
2017  return M;
2018}
2019
2020matrix idDiff(matrix i, int k)
2021{
2022  int e=MATCOLS(i)*MATROWS(i);
2023  matrix r=mpNew(MATROWS(i),MATCOLS(i));
2024  r->rank=i->rank;
2025  int j;
2026  for(j=0; j<e; j++)
2027  {
2028    r->m[j]=pDiff(i->m[j],k);
2029  }
2030  return r;
2031}
2032
2033matrix idDiffOp(ideal I, ideal J,BOOLEAN multiply)
2034{
2035  matrix r=mpNew(IDELEMS(I),IDELEMS(J));
2036  int i,j;
2037  for(i=0; i<IDELEMS(I); i++)
2038  {
2039    for(j=0; j<IDELEMS(J); j++)
2040    {
2041      MATELEM(r,i+1,j+1)=pDiffOp(I->m[i],J->m[j],multiply);
2042    }
2043  }
2044  return r;
2045}
2046
2047/*3
2048*handles for some ideal operations the ring/syzcomp managment
2049*returns all syzygies (componentwise-)shifted by -syzcomp
2050*or -syzcomp-1 (in case of ideals as input)
2051static ideal idHandleIdealOp(ideal arg,int syzcomp,int isIdeal=FALSE)
2052{
2053  ring orig_ring=currRing;
[3f07d1]2054  ring syz_ring=rAssure_SyzComp(orig_ring, TRUE); rChangeCurrRing(syz_ring);
2055  rSetSyzComp(length, syz_ring);
[0f401f]2056
2057  ideal s_temp;
2058  if (orig_ring!=syz_ring)
[b7cfaf]2059    s_temp=idrMoveR_NoSort(arg,orig_ring, syz_ring);
[0f401f]2060  else
2061    s_temp=arg;
2062
2063  ideal s_temp1 = kStd(s_temp,currQuotient,testHomog,&w,NULL,length);
2064  if (w!=NULL) delete w;
2065
2066  if (syz_ring!=orig_ring)
2067  {
2068    idDelete(&s_temp);
2069    rChangeCurrRing(orig_ring);
2070  }
2071
2072  idDelete(&temp);
2073  ideal temp1=idRingCopy(s_temp1,syz_ring);
2074
2075  if (syz_ring!=orig_ring)
2076  {
2077    rChangeCurrRing(syz_ring);
2078    idDelete(&s_temp1);
2079    rChangeCurrRing(orig_ring);
[5fe834]2080    rDelete(syz_ring);
[0f401f]2081  }
2082
2083  for (i=0;i<IDELEMS(temp1);i++)
2084  {
2085    if ((temp1->m[i]!=NULL)
2086    && (pGetComp(temp1->m[i])<=length))
2087    {
2088      pDelete(&(temp1->m[i]));
2089    }
2090    else
2091    {
[861529]2092      p_Shift(&(temp1->m[i]),-length,currRing);
[0f401f]2093    }
2094  }
2095  temp1->rank = rk;
2096  idSkipZeroes(temp1);
2097
2098  return temp1;
2099}
2100*/
2101/*2
2102* represents (h1+h2)/h2=h1/(h1 intersect h2)
2103*/
2104//ideal idModulo (ideal h2,ideal h1)
2105ideal idModulo (ideal h2,ideal h1, tHomog hom, intvec ** w)
2106{
2107  intvec *wtmp=NULL;
2108
2109  int i,j,k,rk,flength=0,slength,length;
2110  poly p,q;
2111
2112  if (idIs0(h2))
2113    return idFreeModule(si_max(1,h2->ncols));
2114  if (!idIs0(h1))
[7b25fe]2115    flength = id_RankFreeModule(h1,currRing);
2116  slength = id_RankFreeModule(h2,currRing);
[0f401f]2117  length  = si_max(flength,slength);
2118  if (length==0)
2119  {
2120    length = 1;
2121  }
2122  ideal temp = idInit(IDELEMS(h2),length+IDELEMS(h2));
2123  if ((w!=NULL)&&((*w)!=NULL))
2124  {
2125    //Print("input weights:");(*w)->show(1);PrintLn();
2126    int d;
2127    int k;
2128    wtmp=new intvec(length+IDELEMS(h2));
2129    for (i=0;i<length;i++)
2130      ((*wtmp)[i])=(**w)[i];
2131    for (i=0;i<IDELEMS(h2);i++)
2132    {
2133      poly p=h2->m[i];
2134      if (p!=NULL)
2135      {
[31f1850]2136        d = p_Deg(p,currRing);
[0f401f]2137        k= pGetComp(p);
2138        if (slength>0) k--;
2139        d +=((**w)[k]);
2140        ((*wtmp)[i+length]) = d;
2141      }
2142    }
2143    //Print("weights:");wtmp->show(1);PrintLn();
2144  }
2145  for (i=0;i<IDELEMS(h2);i++)
2146  {
2147    temp->m[i] = pCopy(h2->m[i]);
2148    q = pOne();
2149    pSetComp(q,i+1+length);
2150    pSetmComp(q);
2151    if(temp->m[i]!=NULL)
2152    {
[861529]2153      if (slength==0) p_Shift(&(temp->m[i]),1,currRing);
[0f401f]2154      p = temp->m[i];
2155      while (pNext(p)!=NULL) pIter(p);
2156      pNext(p) = q;
2157    }
2158    else
2159      temp->m[i]=q;
2160  }
2161  rk = k = IDELEMS(h2);
2162  if (!idIs0(h1))
2163  {
2164    pEnlargeSet(&(temp->m),IDELEMS(temp),IDELEMS(h1));
2165    IDELEMS(temp) += IDELEMS(h1);
2166    for (i=0;i<IDELEMS(h1);i++)
2167    {
2168      if (h1->m[i]!=NULL)
2169      {
2170        temp->m[k] = pCopy(h1->m[i]);
[861529]2171        if (flength==0) p_Shift(&(temp->m[k]),1,currRing);
[0f401f]2172        k++;
2173      }
2174    }
2175  }
2176
2177  ring orig_ring=currRing;
[3f07d1]2178  ring syz_ring=rAssure_SyzComp(orig_ring, TRUE); rChangeCurrRing(syz_ring);
[b7cfaf]2179  rSetSyzComp(length, syz_ring);
[0f401f]2180  ideal s_temp;
2181
2182  if (syz_ring != orig_ring)
2183  {
[b7cfaf]2184    s_temp = idrMoveR_NoSort(temp, orig_ring, syz_ring);
[0f401f]2185  }
2186  else
2187  {
2188    s_temp = temp;
2189  }
2190
2191  idTest(s_temp);
2192  ideal s_temp1 = kStd(s_temp,currQuotient,hom,&wtmp,NULL,length);
2193
2194  //if (wtmp!=NULL)  Print("output weights:");wtmp->show(1);PrintLn();
2195  if ((w!=NULL) && (*w !=NULL) && (wtmp!=NULL))
2196  {
2197    delete *w;
2198    *w=new intvec(IDELEMS(h2));
2199    for (i=0;i<IDELEMS(h2);i++)
2200      ((**w)[i])=(*wtmp)[i+length];
2201  }
2202  if (wtmp!=NULL) delete wtmp;
2203
2204  for (i=0;i<IDELEMS(s_temp1);i++)
2205  {
2206    if ((s_temp1->m[i]!=NULL)
2207    && (pGetComp(s_temp1->m[i])<=length))
2208    {
[f9591a]2209      p_Delete(&(s_temp1->m[i]),currRing);
[0f401f]2210    }
2211    else
2212    {
[861529]2213      p_Shift(&(s_temp1->m[i]),-length,currRing);
[0f401f]2214    }
2215  }
2216  s_temp1->rank = rk;
2217  idSkipZeroes(s_temp1);
2218
2219  if (syz_ring!=orig_ring)
2220  {
2221    rChangeCurrRing(orig_ring);
[b7cfaf]2222    s_temp1 = idrMoveR_NoSort(s_temp1, syz_ring, orig_ring);
[5fe834]2223    rDelete(syz_ring);
[0f401f]2224    // Hmm ... here seems to be a memory leak
2225    // However, simply deleting it causes memory trouble
2226    // idDelete(&s_temp);
2227  }
2228  else
2229  {
2230    idDelete(&temp);
2231  }
2232  idTest(s_temp1);
2233  return s_temp1;
2234}
2235
2236/*
2237*computes module-weights for liftings of homogeneous modules
2238*/
2239intvec * idMWLift(ideal mod,intvec * weights)
2240{
2241  if (idIs0(mod)) return new intvec(2);
2242  int i=IDELEMS(mod);
2243  while ((i>0) && (mod->m[i-1]==NULL)) i--;
2244  intvec *result = new intvec(i+1);
2245  while (i>0)
2246  {
[b7cfaf]2247    (*result)[i]=currRing->pFDeg(mod->m[i],currRing)+(*weights)[pGetComp(mod->m[i])];
[0f401f]2248  }
2249  return result;
2250}
2251
2252/*2
2253*sorts the kbase for idCoef* in a special way (lexicographically
2254*with x_max,...,x_1)
2255*/
2256ideal idCreateSpecialKbase(ideal kBase,intvec ** convert)
2257{
2258  int i;
2259  ideal result;
2260
2261  if (idIs0(kBase)) return NULL;
2262  result = idInit(IDELEMS(kBase),kBase->rank);
2263  *convert = idSort(kBase,FALSE);
2264  for (i=0;i<(*convert)->length();i++)
2265  {
2266    result->m[i] = pCopy(kBase->m[(**convert)[i]-1]);
2267  }
2268  return result;
2269}
2270
2271/*2
2272*returns the index of a given monom in the list of the special kbase
2273*/
2274int idIndexOfKBase(poly monom, ideal kbase)
2275{
2276  int j=IDELEMS(kbase);
2277
2278  while ((j>0) && (kbase->m[j-1]==NULL)) j--;
2279  if (j==0) return -1;
[1f637e]2280  int i=(currRing->N);
[0f401f]2281  while (i>0)
2282  {
2283    loop
2284    {
2285      if (pGetExp(monom,i)>pGetExp(kbase->m[j-1],i)) return -1;
2286      if (pGetExp(monom,i)==pGetExp(kbase->m[j-1],i)) break;
2287      j--;
2288      if (j==0) return -1;
2289    }
2290    if (i==1)
2291    {
2292      while(j>0)
2293      {
2294        if (pGetComp(monom)==pGetComp(kbase->m[j-1])) return j-1;
2295        if (pGetComp(monom)>pGetComp(kbase->m[j-1])) return -1;
2296        j--;
2297      }
2298    }
2299    i--;
2300  }
2301  return -1;
2302}
2303
2304/*2
2305*decomposes the monom in a part of coefficients described by the
2306*complement of how and a monom in variables occuring in how, the
2307*index of which in kbase is returned as integer pos (-1 if it don't
2308*exists)
2309*/
2310poly idDecompose(poly monom, poly how, ideal kbase, int * pos)
2311{
2312  int i;
2313  poly coeff=pOne(), base=pOne();
2314
[1f637e]2315  for (i=1;i<=(currRing->N);i++)
[0f401f]2316  {
2317    if (pGetExp(how,i)>0)
2318    {
2319      pSetExp(base,i,pGetExp(monom,i));
2320    }
2321    else
2322    {
2323      pSetExp(coeff,i,pGetExp(monom,i));
2324    }
2325  }
2326  pSetComp(base,pGetComp(monom));
2327  pSetm(base);
2328  pSetCoeff(coeff,nCopy(pGetCoeff(monom)));
2329  pSetm(coeff);
2330  *pos = idIndexOfKBase(base,kbase);
2331  if (*pos<0)
[f9591a]2332    p_Delete(&coeff,currRing);
2333  p_Delete(&base,currRing);
[0f401f]2334  return coeff;
2335}
2336
2337/*2
2338*returns a matrix A of coefficients with kbase*A=arg
2339*if all monomials in variables of how occur in kbase
2340*the other are deleted
2341*/
2342matrix idCoeffOfKBase(ideal arg, ideal kbase, poly how)
2343{
2344  matrix result;
2345  ideal tempKbase;
2346  poly p,q;
2347  intvec * convert;
2348  int i=IDELEMS(kbase),j=IDELEMS(arg),k,pos;
2349#if 0
2350  while ((i>0) && (kbase->m[i-1]==NULL)) i--;
2351  if (idIs0(arg))
2352    return mpNew(i,1);
2353  while ((j>0) && (arg->m[j-1]==NULL)) j--;
2354  result = mpNew(i,j);
2355#else
2356  result = mpNew(i, j);
2357  while ((j>0) && (arg->m[j-1]==NULL)) j--;
2358#endif
2359
2360  tempKbase = idCreateSpecialKbase(kbase,&convert);
2361  for (k=0;k<j;k++)
2362  {
2363    p = arg->m[k];
2364    while (p!=NULL)
2365    {
2366      q = idDecompose(p,how,tempKbase,&pos);
2367      if (pos>=0)
2368      {
2369        MATELEM(result,(*convert)[pos],k+1) =
2370            pAdd(MATELEM(result,(*convert)[pos],k+1),q);
2371      }
2372      else
[f9591a]2373        p_Delete(&q,currRing);
[0f401f]2374      pIter(p);
2375    }
2376  }
2377  idDelete(&tempKbase);
2378  return result;
2379}
2380
2381static void idDeleteComps(ideal arg,int* red_comp,int del)
2382// red_comp is an array [0..args->rank]
2383{
2384  int i,j;
2385  poly p;
2386
2387  for (i=IDELEMS(arg)-1;i>=0;i--)
2388  {
2389    p = arg->m[i];
2390    while (p!=NULL)
2391    {
2392      j = pGetComp(p);
2393      if (red_comp[j]!=j)
2394      {
2395        pSetComp(p,red_comp[j]);
2396        pSetmComp(p);
2397      }
2398      pIter(p);
2399    }
2400  }
2401  (arg->rank) -= del;
2402}
2403
2404/*2
2405* returns the presentation of an isomorphic, minimally
2406* embedded  module (arg represents the quotient!)
2407*/
2408ideal idMinEmbedding(ideal arg,BOOLEAN inPlace, intvec **w)
2409{
2410  if (idIs0(arg)) return idInit(1,arg->rank);
2411  int i,next_gen,next_comp;
2412  ideal res=arg;
2413  if (!inPlace) res = idCopy(arg);
[7b25fe]2414  res->rank=si_max(res->rank,id_RankFreeModule(res,currRing));
[0f401f]2415  int *red_comp=(int*)omAlloc((res->rank+1)*sizeof(int));
2416  for (i=res->rank;i>=0;i--) red_comp[i]=i;
2417
2418  int del=0;
2419  loop
2420  {
[d16ea9]2421    next_gen = id_ReadOutPivot(res, &next_comp, currRing);
[0f401f]2422    if (next_gen<0) break;
2423    del++;
2424    syGaussForOne(res,next_gen,next_comp,0,IDELEMS(res));
2425    for(i=next_comp+1;i<=arg->rank;i++) red_comp[i]--;
2426    if ((w !=NULL)&&(*w!=NULL))
2427    {
2428      for(i=next_comp;i<(*w)->length();i++) (**w)[i-1]=(**w)[i];
2429    }
2430  }
2431
2432  idDeleteComps(res,red_comp,del);
2433  idSkipZeroes(res);
2434  omFree(red_comp);
2435
2436  if ((w !=NULL)&&(*w!=NULL) &&(del>0))
2437  {
2438    intvec *wtmp=new intvec((*w)->length()-del);
2439    for(i=0;i<res->rank;i++) (*wtmp)[i]=(**w)[i];
2440    delete *w;
2441    *w=wtmp;
2442  }
2443  return res;
2444}
2445
[76cfef]2446#include <polys/clapsing.h>
[0f401f]2447
2448#ifdef HAVE_FACTORY
[7e6bfe]2449#if 0
[0f401f]2450poly id_GCD(poly f, poly g, const ring r)
2451{
2452  ring save_r=currRing;
2453  rChangeCurrRing(r);
2454  ideal I=idInit(2,1); I->m[0]=f; I->m[1]=g;
2455  intvec *w = NULL;
2456  ideal S=idSyzygies(I,testHomog,&w);
2457  if (w!=NULL) delete w;
2458  poly gg=pTakeOutComp(&(S->m[0]),2);
2459  idDelete(&S);
[b7cfaf]2460  poly gcd_p=singclap_pdivide(f,gg,r);
[f9591a]2461  p_Delete(&gg,r);
[0f401f]2462  rChangeCurrRing(save_r);
2463  return gcd_p;
2464}
[7e6bfe]2465#else
2466poly id_GCD(poly f, poly g, const ring r)
2467{
2468  ideal I=idInit(2,1); I->m[0]=f; I->m[1]=g;
2469  intvec *w = NULL;
2470
[a5d181c]2471  ring save_r = currRing; rChangeCurrRing(r); ideal S=idSyzygies(I,testHomog,&w); rChangeCurrRing(save_r);
2472
[7e6bfe]2473  if (w!=NULL) delete w;
2474  poly gg=p_TakeOutComp(&(S->m[0]), 2, r);
2475  id_Delete(&S, r);
2476  poly gcd_p=singclap_pdivide(f,gg, r);
2477  p_Delete(&gg, r);
[a5d181c]2478
[7e6bfe]2479  return gcd_p;
2480}
2481#endif
[0f401f]2482#endif
2483
2484/*2
2485* xx,q: arrays of length 0..rl-1
2486* xx[i]: SB mod q[i]
2487* assume: char=0
2488* assume: q[i]!=0
2489* destroys xx
2490*/
2491#ifdef HAVE_FACTORY
[f9591a]2492ideal id_ChineseRemainder(ideal *xx, number *q, int rl, const ring R)
[0f401f]2493{
2494  int cnt=IDELEMS(xx[0])*xx[0]->nrows;
2495  ideal result=idInit(cnt,xx[0]->rank);
2496  result->nrows=xx[0]->nrows; // for lifting matrices
2497  result->ncols=xx[0]->ncols; // for lifting matrices
2498  int i,j;
2499  poly r,h,hh,res_p;
2500  number *x=(number *)omAlloc(rl*sizeof(number));
2501  for(i=cnt-1;i>=0;i--)
2502  {
2503    res_p=NULL;
2504    loop
2505    {
2506      r=NULL;
2507      for(j=rl-1;j>=0;j--)
2508      {
2509        h=xx[j]->m[i];
2510        if ((h!=NULL)
[f9591a]2511        &&((r==NULL)||(p_LmCmp(r,h,R)==-1)))
[0f401f]2512          r=h;
2513      }
2514      if (r==NULL) break;
[f9591a]2515      h=p_Head(r,R);
[0f401f]2516      for(j=rl-1;j>=0;j--)
2517      {
2518        hh=xx[j]->m[i];
[f9591a]2519        if ((hh!=NULL) && (p_LmCmp(r,hh,R)==0))
[0f401f]2520        {
2521          x[j]=pGetCoeff(hh);
[f9591a]2522          hh=p_LmFreeAndNext(hh,R);
[0f401f]2523          xx[j]->m[i]=hh;
2524        }
2525        else
[f9591a]2526          x[j]=n_Init(0, R->cf);
[0f401f]2527      }
[f9591a]2528      number n=n_ChineseRemainder(x,q,rl,R->cf);
[0f401f]2529      for(j=rl-1;j>=0;j--)
2530      {
2531        x[j]=NULL; // nlInit(0...) takes no memory
2532      }
[f9591a]2533      if (n_IsZero(n,R->cf)) p_Delete(&h,R);
[0f401f]2534      else
2535      {
[f9591a]2536        p_SetCoeff(h,n,R);
[0f401f]2537        //Print("new mon:");pWrite(h);
[f9591a]2538        res_p=p_Add_q(res_p,h,R);
[0f401f]2539      }
2540    }
2541    result->m[i]=res_p;
2542  }
2543  omFree(x);
[f9591a]2544  for(i=rl-1;i>=0;i--) id_Delete(&(xx[i]),R);
[0f401f]2545  omFree(xx);
2546  return result;
2547}
2548#endif
[f11ea16]2549
2550#if 0
2551/*2
2552* xx,q: arrays of length 0..rl-1
2553* xx[i]: SB mod q[i]
2554* assume: char=0
2555* assume: q[i]!=0
2556* destroys xx
2557*/
2558#ifdef HAVE_FACTORY
2559ideal id_ChineseRemainder(ideal *xx, number *q, int rl, const ring R)
2560{
2561  int cnt=IDELEMS(xx[0])*xx[0]->nrows;
2562  ideal result=idInit(cnt,xx[0]->rank);
2563  result->nrows=xx[0]->nrows; // for lifting matrices
2564  result->ncols=xx[0]->ncols; // for lifting matrices
2565  int i,j;
2566  poly r,h,hh,res_p;
2567  number *x=(number *)omAlloc(rl*sizeof(number));
2568  for(i=cnt-1;i>=0;i--)
2569  {
2570    res_p=NULL;
2571    loop
2572    {
2573      r=NULL;
2574      for(j=rl-1;j>=0;j--)
2575      {
2576        h=xx[j]->m[i];
2577        if ((h!=NULL)
2578        &&((r==NULL)||(p_LmCmp(r,h,R)==-1)))
2579          r=h;
2580      }
2581      if (r==NULL) break;
2582      h=p_Head(r, R);
2583      for(j=rl-1;j>=0;j--)
2584      {
2585        hh=xx[j]->m[i];
2586        if ((hh!=NULL) && (p_LmCmp(r,hh, R)==0))
2587        {
2588          x[j]=p_GetCoeff(hh, R);
2589          hh=p_LmFreeAndNext(hh, R);
2590          xx[j]->m[i]=hh;
2591        }
2592        else
2593          x[j]=n_Init(0, R->cf); // is R->cf really n_Q???, yes!
2594      }
[a5d181c]2595
[7938a0f]2596      number n=n_ChineseRemainder(x,q,rl, R->cf);
[f11ea16]2597
2598      for(j=rl-1;j>=0;j--)
2599      {
2600        x[j]=NULL; // nlInit(0...) takes no memory
2601      }
2602      if (n_IsZero(n, R->cf)) p_Delete(&h, R);
2603      else
2604      {
2605        p_SetCoeff(h,n, R);
2606        //Print("new mon:");pWrite(h);
2607        res_p=p_Add_q(res_p, h, R);
2608      }
2609    }
2610    result->m[i]=res_p;
2611  }
2612  omFree(x);
2613  for(i=rl-1;i>=0;i--) id_Delete(&(xx[i]), R);
2614  omFree(xx);
2615  return result;
2616}
2617#endif
2618#endif
[0f401f]2619/* currently unsed:
2620ideal idChineseRemainder(ideal *xx, intvec *iv)
2621{
2622  int rl=iv->length();
2623  number *q=(number *)omAlloc(rl*sizeof(number));
2624  int i;
2625  for(i=0; i<rl; i++)
2626  {
2627    q[i]=nInit((*iv)[i]);
2628  }
2629  return idChineseRemainder(xx,q,rl);
2630}
2631*/
2632/*
2633 * lift ideal with coeffs over Z (mod N) to Q via Farey
2634 */
[f9591a]2635ideal id_Farey(ideal x, number N, const ring r)
[0f401f]2636{
2637  int cnt=IDELEMS(x)*x->nrows;
2638  ideal result=idInit(cnt,x->rank);
2639  result->nrows=x->nrows; // for lifting matrices
2640  result->ncols=x->ncols; // for lifting matrices
2641
2642  int i;
2643  for(i=cnt-1;i>=0;i--)
2644  {
[f9591a]2645    poly h=p_Copy(x->m[i],r);
[0f401f]2646    result->m[i]=h;
2647    while(h!=NULL)
2648    {
2649      number c=pGetCoeff(h);
[f9591a]2650      pSetCoeff0(h,n_Farey(c,N,r->cf));
2651      n_Delete(&c,r->cf);
[0f401f]2652      pIter(h);
2653    }
[f9591a]2654    while((result->m[i]!=NULL)&&(n_IsZero(pGetCoeff(result->m[i]),r->cf)))
[0f401f]2655    {
[f9591a]2656      p_LmDelete(&(result->m[i]),r);
[0f401f]2657    }
2658    h=result->m[i];
2659    while((h!=NULL) && (pNext(h)!=NULL))
2660    {
[f9591a]2661      if(n_IsZero(pGetCoeff(pNext(h)),r->cf))
[0f401f]2662      {
[f9591a]2663        p_LmDelete(&pNext(h),r);
[0f401f]2664      }
2665      else pIter(h);
2666    }
2667  }
2668  return result;
2669}
[38fc181]2670
2671
2672
2673
2674// uses glabl vars via pSetModDeg
2675/*
2676BOOLEAN idTestHomModule(ideal m, ideal Q, intvec *w)
2677{
2678  if ((Q!=NULL) && (!idHomIdeal(Q,NULL)))  { PrintS(" Q not hom\n"); return FALSE;}
2679  if (idIs0(m)) return TRUE;
2680
2681  int cmax=-1;
2682  int i;
2683  poly p=NULL;
2684  int length=IDELEMS(m);
2685  poly* P=m->m;
2686  for (i=length-1;i>=0;i--)
2687  {
2688    p=P[i];
2689    if (p!=NULL) cmax=si_max(cmax,(int)pMaxComp(p)+1);
2690  }
2691  if (w != NULL)
2692  if (w->length()+1 < cmax)
2693  {
2694    // Print("length: %d - %d \n", w->length(),cmax);
2695    return FALSE;
2696  }
2697
2698  if(w!=NULL)
2699    p_SetModDeg(w, currRing);
2700
2701  for (i=length-1;i>=0;i--)
2702  {
2703    p=P[i];
2704    poly q=p;
2705    if (p!=NULL)
2706    {
2707      int d=p_FDeg(p,currRing);
2708      loop
2709      {
2710        pIter(p);
2711        if (p==NULL) break;
2712        if (d!=p_FDeg(p,currRing))
2713        {
2714          //pWrite(q); wrp(p); Print(" -> %d - %d\n",d,pFDeg(p,currRing));
2715          if(w!=NULL)
2716            p_SetModDeg(NULL, currRing);
2717          return FALSE;
2718        }
2719      }
2720    }
2721  }
2722
2723  if(w!=NULL)
2724    p_SetModDeg(NULL, currRing);
2725
2726  return TRUE;
2727}
2728*/
2729
2730
2731
Note: See TracBrowser for help on using the repository browser.