source: git/kernel/ideals.cc @ 08dc13

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