source: git/kernel/ideals.cc @ 36dd34

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