source: git/kernel/ideals.cc @ a76d93d

spielwiese
Last change on this file since a76d93d was fc7902, checked in by Hans Schoenemann <hannes@…>, 13 years ago
removed some unsed variables, unused debug stuff git-svn-id: file:///usr/local/Singular/svn/trunk@14187 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 91.5 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id$ */
5/*
6* ABSTRACT - all basic methods to manipulate ideals
7*/
8
9/* includes */
10#include <kernel/mod2.h>
11
12#ifndef NDEBUG
13# define MYTEST 0
14#else /* ifndef NDEBUG */
15# define MYTEST 1
16#endif /* ifndef NDEBUG */
17
18#include <kernel/options.h>
19#include <omalloc/omalloc.h>
20#include <kernel/febase.h>
21#include <kernel/numbers.h>
22#include <kernel/longrat.h>
23#include <kernel/polys.h>
24#include <kernel/ring.h>
25#include <kernel/kstd1.h>
26#include <kernel/matpol.h>
27#include <kernel/weight.h>
28#include <kernel/intvec.h>
29#include <kernel/syz.h>
30#include <kernel/sparsmat.h>
31#include <kernel/ideals.h>
32#include <kernel/prCopy.h>
33#include <kernel/gring.h>
34
35
36omBin sip_sideal_bin = omGetSpecBin(sizeof(sip_sideal));
37
38/* #define WITH_OLD_MINOR */
39#define pCopy_noCheck(p) pCopy(p)
40
41static poly * idpower;
42/*collects the monomials in makemonoms, must be allocated befor*/
43static int idpowerpoint;
44/*index of the actual monomial in idpower*/
45static poly * givenideal;
46/*the ideal from which a power is computed*/
47
48/*0 implementation*/
49
50/*2
51* initialise an ideal
52*/
53ideal idInit(int idsize, int rank)
54{
55  /*- initialise an ideal -*/
56  ideal hh = (ideal )omAllocBin(sip_sideal_bin);
57  hh->nrows = 1;
58  hh->rank = rank;
59  IDELEMS(hh) = idsize;
60  if (idsize>0)
61  {
62    hh->m = (poly *)omAlloc0(idsize*sizeof(poly));
63  }
64  else
65    hh->m=NULL;
66  return hh;
67}
68
69#ifdef PDEBUG
70// this is only for outputting an ideal within the debugger
71void idShow(const ideal id, const ring lmRing, const ring tailRing, const int debugPrint)
72{
73  assume( debugPrint >= 0 );
74
75  if( id == NULL )
76    PrintS("(NULL)");
77  else
78  {
79    Print("Module of rank %ld,real rank %ld and %d generators.\n",
80          id->rank,idRankFreeModule(id, lmRing, tailRing),IDELEMS(id));
81
82    int j = (id->ncols*id->nrows) - 1;
83    while ((j > 0) && (id->m[j]==NULL)) j--;
84    for (int i = 0; i <= j; i++)
85    {
86      Print("generator %d: ",i); p_DebugPrint(id->m[i], lmRing, tailRing, debugPrint);
87    }
88  }
89}
90#endif
91
92/* index of generator with leading term in ground ring (if any);
93   otherwise -1 */
94int idPosConstant(ideal id)
95{
96  int k;
97  for (k = IDELEMS(id)-1; k>=0; k--)
98  {
99    if (p_LmIsConstantComp(id->m[k], currRing) == TRUE)
100      return k;
101  }
102  return -1;
103}
104
105/*2
106* initialise the maximal ideal (at 0)
107*/
108ideal idMaxIdeal (void)
109{
110  int l;
111  ideal hh=NULL;
112
113  hh=idInit(pVariables,1);
114  for (l=0; l<pVariables; l++)
115  {
116    hh->m[l] = pOne();
117    pSetExp(hh->m[l],l+1,1);
118    pSetm(hh->m[l]);
119  }
120  return hh;
121}
122
123/*2
124* deletes an ideal/matrix
125*/
126void id_Delete (ideal * h, ring r)
127{
128  int j,elems;
129  if (*h == NULL)
130    return;
131  elems=j=(*h)->nrows*(*h)->ncols;
132  if (j>0)
133  {
134    do
135    {
136      p_Delete(&((*h)->m[--j]), r);
137    }
138    while (j>0);
139    omFreeSize((ADDRESS)((*h)->m),sizeof(poly)*elems);
140  }
141  omFreeBin((ADDRESS)*h, sip_sideal_bin);
142  *h=NULL;
143}
144
145
146/*2
147* Shallowdeletes an ideal/matrix
148*/
149void id_ShallowDelete (ideal *h, ring r)
150{
151  int j,elems;
152  if (*h == NULL)
153    return;
154  elems=j=(*h)->nrows*(*h)->ncols;
155  if (j>0)
156  {
157    do
158    {
159      p_ShallowDelete(&((*h)->m[--j]), r);
160    }
161    while (j>0);
162    omFreeSize((ADDRESS)((*h)->m),sizeof(poly)*elems);
163  }
164  omFreeBin((ADDRESS)*h, sip_sideal_bin);
165  *h=NULL;
166}
167
168/*2
169*gives an ideal the minimal possible size
170*/
171void idSkipZeroes (ideal ide)
172{
173  int k;
174  int j = -1;
175  BOOLEAN change=FALSE;
176  for (k=0; k<IDELEMS(ide); k++)
177  {
178    if (ide->m[k] != NULL)
179    {
180      j++;
181      if (change)
182      {
183        ide->m[j] = ide->m[k];
184      }
185    }
186    else
187    {
188      change=TRUE;
189    }
190  }
191  if (change)
192  {
193    if (j == -1)
194      j = 0;
195    else
196    {
197      for (k=j+1; k<IDELEMS(ide); k++)
198        ide->m[k] = NULL;
199    }
200    pEnlargeSet(&(ide->m),IDELEMS(ide),j+1-IDELEMS(ide));
201    IDELEMS(ide) = j+1;
202  }
203}
204
205/*2
206* copies the first k (>= 1) entries of the given ideal
207* and returns these as a new ideal
208* (Note that the copied polynomials may be zero.)
209*/
210ideal idCopyFirstK (const ideal ide, const int k)
211{
212  ideal newI = idInit(k, 0);
213  for (int i = 0; i < k; i++)
214    newI->m[i] = pCopy(ide->m[i]);
215  return newI;
216}
217
218/*2
219* ideal id = (id[i])
220* result is leadcoeff(id[i]) = 1
221*/
222void idNorm(ideal id)
223{
224  for (int i=IDELEMS(id)-1; i>=0; i--)
225  {
226    if (id->m[i] != NULL)
227    {
228      pNorm(id->m[i]);
229    }
230  }
231}
232
233/*2
234* ideal id = (id[i]), c any unit
235* if id[i] = c*id[j] then id[j] is deleted for j > i
236*/
237void idDelMultiples(ideal id)
238{
239  int i, j;
240  int k = IDELEMS(id)-1;
241  for (i=k; i>=0; i--)
242  {
243    if (id->m[i]!=NULL)
244    {
245      for (j=k; j>i; j--)
246      {
247        if (id->m[j]!=NULL)
248        {
249#ifdef HAVE_RINGS
250          if (rField_is_Ring(currRing))
251          {
252            /* if id[j] = c*id[i] then delete id[j].
253               In the below cases of a ground field, we
254               check whether id[i] = c*id[j] and, if so,
255               delete id[j] for historical reasons (so
256               that previous output does not change) */
257            if (pComparePolys(id->m[j], id->m[i])) pDelete(&id->m[j]);
258          }
259          else
260          {
261            if (pComparePolys(id->m[i], id->m[j])) pDelete(&id->m[j]);
262          }
263#else
264          if (pComparePolys(id->m[i], id->m[j])) pDelete(&id->m[j]);
265#endif         
266        }
267      }
268    }
269  }
270}
271
272/*2
273* ideal id = (id[i])
274* if id[i] = id[j] then id[j] is deleted for j > i
275*/
276void idDelEquals(ideal id)
277{
278  int i, j;
279  int k = IDELEMS(id)-1;
280  for (i=k; i>=0; i--)
281  {
282    if (id->m[i]!=NULL)
283    {
284      for (j=k; j>i; j--)
285      {
286        if ((id->m[j]!=NULL)
287        && (pEqualPolys(id->m[i], id->m[j])))
288        {
289          pDelete(&id->m[j]);
290        }
291      }
292    }
293  }
294}
295
296//
297// Delete id[j], if Lm(j) == Lm(i) and both LC(j), LC(i) are units and j > i
298//
299void idDelLmEquals(ideal id)
300{
301  int i, j;
302  int k = IDELEMS(id)-1;
303  for (i=k; i>=0; i--)
304  {
305    if (id->m[i] != NULL)
306    {
307      for (j=k; j>i; j--)
308      {
309        if ((id->m[j] != NULL)
310        && pLmEqual(id->m[i], id->m[j])
311#ifdef HAVE_RINGS
312        && nIsUnit(pGetCoeff(id->m[i])) && nIsUnit(pGetCoeff(id->m[j]))
313#endif
314        )
315        {
316          pDelete(&id->m[j]);
317        }
318      }
319    }
320  }
321}
322
323//
324// delete id[j], if LT(j) == coeff*mon*LT(i) and vice versa, i.e.,
325// delete id[i], if LT(i) == coeff*mon*LT(j)
326//
327void idDelDiv(ideal id)
328{
329  int i, j;
330  int k = IDELEMS(id)-1;
331  for (i=k; i>=0; i--)
332  {
333    if (id->m[i] != NULL)
334    {
335      for (j=k; j>i; j--)
336      {
337        if (id->m[j]!=NULL)
338        {
339#ifdef HAVE_RINGS
340          if (rField_is_Ring(currRing))
341          {
342            if (pDivisibleByRingCase(id->m[i], id->m[j]))
343            {
344              pDelete(&id->m[j]);
345            }
346            else if (pDivisibleByRingCase(id->m[j], id->m[i]))
347          {
348            pDelete(&id->m[i]);
349            break;
350          }
351          }
352          else
353          {
354#endif
355          /* the case of a ground field: */
356          if (pDivisibleBy(id->m[i], id->m[j]))
357          {
358            pDelete(&id->m[j]);
359          }
360          else if (pDivisibleBy(id->m[j], id->m[i]))
361          {
362            pDelete(&id->m[i]);
363            break;
364          }
365#ifdef HAVE_RINGS
366          }
367#endif         
368        }
369      }
370    }
371  }
372}
373
374/*2
375*test if the ideal has only constant polynomials
376*/
377BOOLEAN idIsConstant(ideal id)
378{
379  int k;
380  for (k = IDELEMS(id)-1; k>=0; k--)
381  {
382    if (pIsConstantPoly(id->m[k]) == FALSE)
383      return FALSE;
384  }
385  return TRUE;
386}
387
388/*2
389* copy an ideal
390*/
391
392ideal id_Copy (ideal h1, const ring r)
393{
394  int i;
395  ideal h2;
396
397//#ifdef TEST
398  if (h1 == NULL)
399  {
400    h2=idInit(1,1);
401  }
402  else
403//#endif
404  {
405    h2=idInit(IDELEMS(h1),h1->rank);
406    for (i=IDELEMS(h1)-1; i>=0; i--)
407      h2->m[i] = p_Copy(h1->m[i],r);
408  }
409  return h2;
410}
411
412#ifdef PDEBUG
413void idDBTest(ideal h1, int level, const char *f,const int l)
414{
415  int i;
416
417  if (h1 != NULL)
418  {
419    // assume(IDELEMS(h1) > 0); for ideal/module, does not apply to matrix
420    omCheckAddrSize(h1,sizeof(*h1));
421    omdebugAddrSize(h1->m,h1->ncols*h1->nrows*sizeof(poly));
422    /* to be able to test matrices: */
423    for (i=(h1->ncols*h1->nrows)-1; i>=0; i--)
424      _p_Test(h1->m[i], currRing, level);
425    int new_rk=idRankFreeModule(h1);
426    if(new_rk > h1->rank)
427    {
428      dReportError("wrong rank %d (should be %d) in %s:%d\n",
429                   h1->rank, new_rk, f,l);
430      omPrintAddrInfo(stderr, h1, " for ideal");
431      h1->rank=new_rk;
432    }
433  }
434}
435#endif
436
437/*3
438* for idSort: compare a and b revlex inclusive module comp.
439*/
440static int pComp_RevLex(poly a, poly b,BOOLEAN nolex)
441{
442  if (b==NULL) return 1;
443  if (a==NULL) return -1;
444
445  if (nolex) 
446  {
447    int r=pLmCmp(a,b);
448    if (r!=0) return r;
449    number h=nSub(pGetCoeff(a),pGetCoeff(b));
450    r = -1+nIsZero(h)+2*nGreaterZero(h); /* -1: <, 0:==, 1: > */
451    nDelete(&h);
452    return r;
453  }
454  int l=pVariables;
455  while ((l>0) && (pGetExp(a,l)==pGetExp(b,l))) l--;
456  if (l==0)
457  {
458    if (pGetComp(a)==pGetComp(b))
459    {
460      number h=nSub(pGetCoeff(a),pGetCoeff(b));
461      int r = -1+nIsZero(h)+2*nGreaterZero(h); /* -1: <, 0:==, 1: > */
462      nDelete(&h);
463      return r;
464    }
465    if (pGetComp(a)>pGetComp(b)) return 1;
466  }
467  else if (pGetExp(a,l)>pGetExp(b,l))
468    return 1;
469  return -1;
470}
471
472/*2
473*sorts the ideal w.r.t. the actual ringordering
474*uses lex-ordering when nolex = FALSE
475*/
476intvec *idSort(ideal id,BOOLEAN nolex)
477{
478  poly p,q;
479  intvec * result = new intvec(IDELEMS(id));
480  int i, j, actpos=0, newpos, l;
481  int diff, olddiff, lastcomp, newcomp;
482  BOOLEAN notFound;
483
484  for (i=0;i<IDELEMS(id);i++)
485  {
486    if (id->m[i]!=NULL)
487    {
488      notFound = TRUE;
489      newpos = actpos / 2;
490      diff = (actpos+1) / 2;
491      diff = (diff+1) / 2;
492      lastcomp = pComp_RevLex(id->m[i],id->m[(*result)[newpos]],nolex);
493      if (lastcomp<0)
494      {
495        newpos -= diff;
496      }
497      else if (lastcomp>0)
498      {
499        newpos += diff;
500      }
501      else
502      {
503        notFound = FALSE;
504      }
505      //while ((newpos>=0) && (newpos<actpos) && (notFound))
506      while (notFound && (newpos>=0) && (newpos<actpos))
507      {
508        newcomp = pComp_RevLex(id->m[i],id->m[(*result)[newpos]],nolex);
509        olddiff = diff;
510        if (diff>1)
511        {
512          diff = (diff+1) / 2;
513          if ((newcomp==1)
514          && (actpos-newpos>1)
515          && (diff>1)
516          && (newpos+diff>=actpos))
517          {
518            diff = actpos-newpos-1;
519          }
520          else if ((newcomp==-1)
521          && (diff>1)
522          && (newpos<diff))
523          {
524            diff = newpos;
525          }
526        }
527        if (newcomp<0)
528        {
529          if ((olddiff==1) && (lastcomp>0))
530            notFound = FALSE;
531          else
532            newpos -= diff;
533        }
534        else if (newcomp>0)
535        {
536          if ((olddiff==1) && (lastcomp<0))
537          {
538            notFound = FALSE;
539            newpos++;
540          }
541          else
542          {
543            newpos += diff;
544          }
545        }
546        else
547        {
548          notFound = FALSE;
549        }
550        lastcomp = newcomp;
551        if (diff==0) notFound=FALSE; /*hs*/
552      }
553      if (newpos<0) newpos = 0;
554      if (newpos>actpos) newpos = actpos;
555      while ((newpos<actpos) && (pComp_RevLex(id->m[i],id->m[(*result)[newpos]],nolex)==0))
556        newpos++;
557      for (j=actpos;j>newpos;j--)
558      {
559        (*result)[j] = (*result)[j-1];
560      }
561      (*result)[newpos] = i;
562      actpos++;
563    }
564  }
565  for (j=0;j<actpos;j++) (*result)[j]++;
566  return result;
567}
568
569/*2
570* concat the lists h1 and h2 without zeros
571*/
572ideal idSimpleAdd (ideal h1,ideal h2)
573{
574  int i,j,r,l;
575  ideal result;
576
577  if (h1==NULL) return idCopy(h2);
578  if (h2==NULL) return idCopy(h1);
579  j = IDELEMS(h1)-1;
580  while ((j >= 0) && (h1->m[j] == NULL)) j--;
581  i = IDELEMS(h2)-1;
582  while ((i >= 0) && (h2->m[i] == NULL)) i--;
583  r = si_max(h1->rank,h2->rank);
584  if (i+j==(-2))
585    return idInit(1,r);
586  else
587    result=idInit(i+j+2,r);
588  for (l=j; l>=0; l--)
589  {
590    result->m[l] = pCopy(h1->m[l]);
591  }
592  r = i+j+1;
593  for (l=i; l>=0; l--, r--)
594  {
595    result->m[r] = pCopy(h2->m[l]);
596  }
597  return result;
598}
599
600/*2
601* insert h2 into h1 (if h2 is not the zero polynomial)
602* return TRUE iff h2 was indeed inserted
603*/
604BOOLEAN idInsertPoly (ideal h1, poly h2)
605{
606  if (h2==NULL) return FALSE;
607  int j = IDELEMS(h1)-1;
608  while ((j >= 0) && (h1->m[j] == NULL)) j--;
609  j++;
610  if (j==IDELEMS(h1))
611  {
612    pEnlargeSet(&(h1->m),IDELEMS(h1),16);
613    IDELEMS(h1)+=16;
614  }
615  h1->m[j]=h2;
616  return TRUE;
617}
618
619/*2
620* insert h2 into h1 depending on the two boolean parameters:
621* - if zeroOk is true, then h2 will also be inserted when it is zero
622* - if duplicateOk is true, then h2 will also be inserted when it is
623*   already present in h1
624* return TRUE iff h2 was indeed inserted
625*/
626BOOLEAN idInsertPolyWithTests (ideal h1, const int validEntries,
627  const poly h2, const bool zeroOk, const bool duplicateOk)
628{
629  if ((!zeroOk) && (h2 == NULL)) return FALSE;
630  if (!duplicateOk)
631  {
632    bool h2FoundInH1 = false;
633    int i = 0;
634    while ((i < validEntries) && (!h2FoundInH1))
635    {
636      h2FoundInH1 = pEqualPolys(h1->m[i], h2);
637      i++;
638    }
639    if (h2FoundInH1) return FALSE;
640  }
641  if (validEntries == IDELEMS(h1))
642  {
643    pEnlargeSet(&(h1->m), IDELEMS(h1), 16);
644    IDELEMS(h1) += 16;
645  }
646  h1->m[validEntries] = h2;
647  return TRUE;
648}
649
650/*2
651* h1 + h2
652*/
653ideal idAdd (ideal h1,ideal h2)
654{
655  ideal result = idSimpleAdd(h1,h2);
656  idCompactify(result);
657  return result;
658}
659
660/*2
661* h1 * h2
662*/
663ideal  idMult (ideal h1,ideal  h2)
664{
665  int i,j,k;
666  ideal  hh;
667
668  j = IDELEMS(h1);
669  while ((j > 0) && (h1->m[j-1] == NULL)) j--;
670  i = IDELEMS(h2);
671  while ((i > 0) && (h2->m[i-1] == NULL)) i--;
672  j = j * i;
673  if (j == 0)
674    hh = idInit(1,1);
675  else
676    hh=idInit(j,1);
677  if (h1->rank<h2->rank)
678    hh->rank = h2->rank;
679  else
680    hh->rank = h1->rank;
681  if (j==0) return hh;
682  k = 0;
683  for (i=0; i<IDELEMS(h1); i++)
684  {
685    if (h1->m[i] != NULL)
686    {
687      for (j=0; j<IDELEMS(h2); j++)
688      {
689        if (h2->m[j] != NULL)
690        {
691          hh->m[k] = ppMult_qq(h1->m[i],h2->m[j]);
692          k++;
693        }
694      }
695    }
696  }
697  {
698    idCompactify(hh);
699    return hh;
700  }
701}
702
703/*2
704*returns true if h is the zero ideal
705*/
706BOOLEAN idIs0 (ideal h)
707{
708  int i;
709
710  if (h == NULL) return TRUE;
711  i = IDELEMS(h)-1;
712  while ((i >= 0) && (h->m[i] == NULL))
713  {
714    i--;
715  }
716  if (i < 0)
717    return TRUE;
718  else
719    return FALSE;
720}
721
722/*2
723* return the maximal component number found in any polynomial in s
724*/
725long idRankFreeModule (ideal s, ring lmRing, ring tailRing)
726{
727  if (s!=NULL)
728  {
729    int  j=0;
730
731    if (rRing_has_Comp(tailRing) && rRing_has_Comp(lmRing))
732    {
733      int  l=IDELEMS(s);
734      poly *p=s->m;
735      int  k;
736      for (; l != 0; l--)
737      {
738        if (*p!=NULL)
739        {
740          pp_Test(*p, lmRing, tailRing);
741          k = p_MaxComp(*p, lmRing, tailRing);
742          if (k>j) j = k;
743        }
744        p++;
745      }
746    }
747    return j;
748  }
749  return -1;
750}
751
752BOOLEAN idIsModule(ideal id, ring r)
753{
754  if (id != NULL && rRing_has_Comp(r))
755  {
756    int j, l = IDELEMS(id);
757    for (j=0; j<l; j++)
758    {
759      if (id->m[j] != NULL && p_GetComp(id->m[j], r) > 0) return TRUE;
760    }
761  }
762  return FALSE;
763}
764
765
766/*2
767*returns true if id is homogenous with respect to the aktual weights
768*/
769BOOLEAN idHomIdeal (ideal id, ideal Q)
770{
771  int i;
772  BOOLEAN     b;
773  if ((id == NULL) || (IDELEMS(id) == 0)) return TRUE;
774  i = 0;
775  b = TRUE;
776  while ((i < IDELEMS(id)) && b)
777  {
778    b = pIsHomogeneous(id->m[i]);
779    i++;
780  }
781  if ((b) && (Q!=NULL) && (IDELEMS(Q)>0))
782  {
783    i=0;
784    while ((i < IDELEMS(Q)) && b)
785    {
786      b = pIsHomogeneous(Q->m[i]);
787      i++;
788    }
789  }
790  return b;
791}
792
793/*2
794*returns a minimized set of generators of h1
795*/
796ideal idMinBase (ideal h1)
797{
798  ideal h2, h3,h4,e;
799  int j,k;
800  int i,l,ll;
801  intvec * wth;
802  BOOLEAN homog;
803
804  homog = idHomModule(h1,currQuotient,&wth);
805  if (rHasGlobalOrdering_currRing())
806  {
807    if(!homog)
808    {
809      WarnS("minbase applies only to the local or homogeneous case");
810      e=idCopy(h1);
811      return e;
812    }
813    else
814    {
815      ideal re=kMin_std(h1,currQuotient,(tHomog)homog,&wth,h2,NULL,0,3);
816      idDelete(&re);
817      return h2;
818    }
819  }
820  e=idInit(1,h1->rank);
821  if (idIs0(h1))
822  {
823    return e;
824  }
825  pEnlargeSet(&(e->m),IDELEMS(e),15);
826  IDELEMS(e) = 16;
827  h2 = kStd(h1,currQuotient,isNotHomog,NULL);
828  h3 = idMaxIdeal();
829  h4=idMult(h2,h3);
830  idDelete(&h3);
831  h3=kStd(h4,currQuotient,isNotHomog,NULL);
832  k = IDELEMS(h3);
833  while ((k > 0) && (h3->m[k-1] == NULL)) k--;
834  j = -1;
835  l = IDELEMS(h2);
836  while ((l > 0) && (h2->m[l-1] == NULL)) l--;
837  for (i=l-1; i>=0; i--)
838  {
839    if (h2->m[i] != NULL)
840    {
841      ll = 0;
842      while ((ll < k) && ((h3->m[ll] == NULL)
843      || !pDivisibleBy(h3->m[ll],h2->m[i])))
844        ll++;
845      if (ll >= k)
846      {
847        j++;
848        if (j > IDELEMS(e)-1)
849        {
850          pEnlargeSet(&(e->m),IDELEMS(e),16);
851          IDELEMS(e) += 16;
852        }
853        e->m[j] = pCopy(h2->m[i]);
854      }
855    }
856  }
857  idDelete(&h2);
858  idDelete(&h3);
859  idDelete(&h4);
860  if (currQuotient!=NULL)
861  {
862    h3=idInit(1,e->rank);
863    h2=kNF(h3,currQuotient,e);
864    idDelete(&h3);
865    idDelete(&e);
866    e=h2;
867  }
868  idSkipZeroes(e);
869  return e;
870}
871
872/*2
873*the minimal index of used variables - 1
874*/
875int pLowVar (poly p)
876{
877  int k,l,lex;
878
879  if (p == NULL) return -1;
880
881  k = 32000;/*a very large dummy value*/
882  while (p != NULL)
883  {
884    l = 1;
885    lex = pGetExp(p,l);
886    while ((l < pVariables) && (lex == 0))
887    {
888      l++;
889      lex = pGetExp(p,l);
890    }
891    l--;
892    if (l < k) k = l;
893    pIter(p);
894  }
895  return k;
896}
897
898/*3
899*multiplies p with t (!cas) or  (t-1)
900*the index of t is:1, so we have to shift all variables
901*p is NOT in the actual ring, it has no t
902*/
903static poly pMultWithT (poly p,BOOLEAN cas)
904{
905  /*qp is the working pointer in p*/
906  /*result is the result, qresult is the working pointer*/
907  /*pp is p in the actual ring(shifted), qpp the working pointer*/
908  poly result,qp,pp;
909  poly qresult=NULL;
910  poly qpp=NULL;
911  int  i,j,lex;
912  number n;
913
914  pp = NULL;
915  result = NULL;
916  qp = p;
917  while (qp != NULL)
918  {
919    i = 0;
920    if (result == NULL)
921    {/*first monomial*/
922      result = pInit();
923      qresult = result;
924    }
925    else
926    {
927      qresult->next = pInit();
928      pIter(qresult);
929    }
930    for (j=pVariables-1; j>0; j--)
931    {
932      lex = pGetExp(qp,j);
933      pSetExp(qresult,j+1,lex);/*copy all variables*/
934    }
935    lex = pGetComp(qp);
936    pSetComp(qresult,lex);
937    n=nCopy(pGetCoeff(qp));
938    pSetCoeff0(qresult,n);
939    qresult->next = NULL;
940    pSetm(qresult);
941    /*qresult is now qp brought into the actual ring*/
942    if (cas)
943    { /*case: mult with t-1*/
944      pSetExp(qresult,1,0);
945      pSetm(qresult);
946      if (pp == NULL)
947      { /*first monomial*/
948        pp = pCopy(qresult);
949        qpp = pp;
950      }
951      else
952      {
953        qpp->next = pCopy(qresult);
954        pIter(qpp);
955      }
956      pGetCoeff(qpp)=nNeg(pGetCoeff(qpp));
957      /*now qpp contains -1*qp*/
958    }
959    pSetExp(qresult,1,1);/*this is mult. by t*/
960    pSetm(qresult);
961    pIter(qp);
962  }
963  /*
964  *now p is processed:
965  *result contains t*p
966  * if cas: pp contains -1*p (in the new ring)
967  */
968  if (cas)  qresult->next = pp;
969  /*  else      qresult->next = NULL;*/
970  return result;
971}
972
973/*2
974* verschiebt die Indizees der Modulerzeugenden um i
975*/
976void pShift (poly * p,int i)
977{
978  poly qp1 = *p,qp2 = *p;/*working pointers*/
979  int     j = pMaxComp(*p),k = pMinComp(*p);
980
981  if (j+i < 0) return ;
982  while (qp1 != NULL)
983  {
984    if ((pGetComp(qp1)+i > 0) || ((j == -i) && (j == k)))
985    {
986      pAddComp(qp1,i);
987      pSetmComp(qp1);
988      qp2 = qp1;
989      pIter(qp1);
990    }
991    else
992    {
993      if (qp2 == *p)
994      {
995        pIter(*p);
996        pLmDelete(&qp2);
997        qp2 = *p;
998        qp1 = *p;
999      }
1000      else
1001      {
1002        qp2->next = qp1->next;
1003        if (qp1!=NULL) pLmDelete(&qp1);
1004        qp1 = qp2->next;
1005      }
1006    }
1007  }
1008}
1009
1010/*2
1011*initialized a field with r numbers between beg and end for the
1012*procedure idNextChoise
1013*/
1014void idInitChoise (int r,int beg,int end,BOOLEAN  *endch,int * choise)
1015{
1016  /*returns the first choise of r numbers between beg and end*/
1017  int i;
1018  for (i=0; i<r; i++)
1019  {
1020    choise[i] = 0;
1021  }
1022  if (r <= end-beg+1)
1023    for (i=0; i<r; i++)
1024    {
1025      choise[i] = beg+i;
1026    }
1027  if (r > end-beg+1)
1028    *endch = TRUE;
1029  else
1030    *endch = FALSE;
1031}
1032
1033/*2
1034*returns the next choise of r numbers between beg and end
1035*/
1036void idGetNextChoise (int r,int end,BOOLEAN  *endch,int * choise)
1037{
1038  int i = r-1,j;
1039  while ((i >= 0) && (choise[i] == end))
1040  {
1041    i--;
1042    end--;
1043  }
1044  if (i == -1)
1045    *endch = TRUE;
1046  else
1047  {
1048    choise[i]++;
1049    for (j=i+1; j<r; j++)
1050    {
1051      choise[j] = choise[i]+j-i;
1052    }
1053    *endch = FALSE;
1054  }
1055}
1056
1057/*2
1058*takes the field choise of d numbers between beg and end, cancels the t-th
1059*entree and searches for the ordinal number of that d-1 dimensional field
1060* w.r.t. the algorithm of construction
1061*/
1062int idGetNumberOfChoise(int t, int d, int begin, int end, int * choise)
1063{
1064  int * localchoise,i,result=0;
1065  BOOLEAN b=FALSE;
1066
1067  if (d<=1) return 1;
1068  localchoise=(int*)omAlloc((d-1)*sizeof(int));
1069  idInitChoise(d-1,begin,end,&b,localchoise);
1070  while (!b)
1071  {
1072    result++;
1073    i = 0;
1074    while ((i<t) && (localchoise[i]==choise[i])) i++;
1075    if (i>=t)
1076    {
1077      i = t+1;
1078      while ((i<d) && (localchoise[i-1]==choise[i])) i++;
1079      if (i>=d)
1080      {
1081        omFreeSize((ADDRESS)localchoise,(d-1)*sizeof(int));
1082        return result;
1083      }
1084    }
1085    idGetNextChoise(d-1,end,&b,localchoise);
1086  }
1087  omFreeSize((ADDRESS)localchoise,(d-1)*sizeof(int));
1088  return 0;
1089}
1090
1091/*2
1092*computes the binomial coefficient
1093*/
1094int binom (int n,int r)
1095{
1096  int i,result;
1097
1098  if (r==0) return 1;
1099  if (n-r<r) return binom(n,n-r);
1100  result = n-r+1;
1101  for (i=2;i<=r;i++)
1102  {
1103    result *= n-r+i;
1104    if (result<0)
1105    {
1106      WarnS("overflow in binomials");
1107      return 0;
1108    }
1109    result /= i;
1110  }
1111  return result;
1112}
1113
1114/*2
1115*the free module of rank i
1116*/
1117ideal idFreeModule (int i)
1118{
1119  int j;
1120  ideal h;
1121
1122  h=idInit(i,i);
1123  for (j=0; j<i; j++)
1124  {
1125    h->m[j] = pOne();
1126    pSetComp(h->m[j],j+1);
1127    pSetmComp(h->m[j]);
1128  }
1129  return h;
1130}
1131
1132ideal idSectWithElim (ideal h1,ideal h2)
1133// does not destroy h1,h2
1134{
1135  if (TEST_OPT_PROT) PrintS("intersect by elimination method\n");
1136  assume(!idIs0(h1));
1137  assume(!idIs0(h2));
1138  assume(IDELEMS(h1)<=IDELEMS(h2));
1139  assume(idRankFreeModule(h1)==0);
1140  assume(idRankFreeModule(h2)==0);
1141  // add a new variable:
1142  int j;
1143  ring origRing=currRing;
1144  ring r=rCopy0(origRing);
1145  r->N++;
1146  r->block0[0]=1;
1147  r->block1[0]= r->N;
1148  omFree(r->order);
1149  r->order=(int*)omAlloc0(3*sizeof(int*));
1150  r->order[0]=ringorder_dp;
1151  r->order[1]=ringorder_C;
1152  char **names=(char**)omAlloc0(rVar(r) * sizeof(char_ptr));
1153  for (j=0;j<r->N-1;j++) names[j]=r->names[j];
1154  names[r->N-1]=omStrDup("@");
1155  omFree(r->names);
1156  r->names=names;
1157  rComplete(r,TRUE);
1158  // fetch h1, h2
1159  ideal h;
1160  h1=idrCopyR(h1,origRing,r);
1161  h2=idrCopyR(h2,origRing,r);
1162  // switch to temp. ring r
1163  rChangeCurrRing(r);
1164  // create 1-t, t
1165  poly omt=pOne();
1166  pSetExp(omt,r->N,1);
1167  poly t=pCopy(omt);
1168  pSetm(omt);
1169  omt=pNeg(omt);
1170  omt=pAdd(omt,pOne());
1171  // compute (1-t)*h1
1172  h1=(ideal)mpMultP((matrix)h1,omt);
1173  // compute t*h2
1174  h2=(ideal)mpMultP((matrix)h2,pCopy(t));
1175  // (1-t)h1 + t*h2
1176  h=idInit(IDELEMS(h1)+IDELEMS(h2),1);
1177  int l;
1178  for (l=IDELEMS(h1)-1; l>=0; l--)
1179  {
1180    h->m[l] = h1->m[l];  h1->m[l]=NULL;
1181  }
1182  j=IDELEMS(h1);
1183  for (l=IDELEMS(h2)-1; l>=0; l--)
1184  {
1185    h->m[l+j] = h2->m[l];  h2->m[l]=NULL;
1186  }
1187  idDelete(&h1);
1188  idDelete(&h2);
1189  // eliminate t:
1190
1191  ideal res=idElimination(h,t);
1192  // cleanup
1193  idDelete(&h);
1194  res=idrMoveR(res,r,origRing);
1195  rChangeCurrRing(origRing);
1196  rKill(r);
1197  return res;
1198}
1199/*2
1200* h3 := h1 intersect h2
1201*/
1202ideal idSect (ideal h1,ideal h2)
1203{
1204  int i,j,k,length;
1205  int flength = idRankFreeModule(h1);
1206  int slength = idRankFreeModule(h2);
1207  int rank=si_min(flength,slength);
1208  if ((idIs0(h1)) || (idIs0(h2)))  return idInit(1,rank);
1209
1210  ideal first,second,temp,temp1,result;
1211  poly p,q;
1212
1213  if (IDELEMS(h1)<IDELEMS(h2))
1214  {
1215    first = h1;
1216    second = h2;
1217  }
1218  else
1219  {
1220    first = h2;
1221    second = h1;
1222    int t=flength; flength=slength; slength=t;
1223  }
1224  length  = si_max(flength,slength);
1225  if (length==0)
1226  {
1227    if ((currQuotient==NULL)
1228    && (currRing->OrdSgn==1)
1229    && (!rIsPluralRing(currRing))
1230    && ((TEST_V_INTERSECT_ELIM) || (!TEST_V_INTERSECT_SYZ)))
1231      return idSectWithElim(first,second);
1232    else length = 1;
1233  }
1234  if (TEST_OPT_PROT) PrintS("intersect by syzygy methods\n");
1235  j = IDELEMS(first);
1236
1237  ring orig_ring=currRing;
1238  ring syz_ring=rCurrRingAssure_SyzComp();
1239  rSetSyzComp(length);
1240
1241  while ((j>0) && (first->m[j-1]==NULL)) j--;
1242  temp = idInit(j /*IDELEMS(first)*/+IDELEMS(second),length+j);
1243  k = 0;
1244  for (i=0;i<j;i++)
1245  {
1246    if (first->m[i]!=NULL)
1247    {
1248      if (syz_ring==orig_ring)
1249        temp->m[k] = pCopy(first->m[i]);
1250      else
1251        temp->m[k] = prCopyR(first->m[i], orig_ring);
1252      q = pOne();
1253      pSetComp(q,i+1+length);
1254      pSetmComp(q);
1255      if (flength==0) pShift(&(temp->m[k]),1);
1256      p = temp->m[k];
1257      while (pNext(p)!=NULL) pIter(p);
1258      pNext(p) = q;
1259      k++;
1260    }
1261  }
1262  for (i=0;i<IDELEMS(second);i++)
1263  {
1264    if (second->m[i]!=NULL)
1265    {
1266      if (syz_ring==orig_ring)
1267        temp->m[k] = pCopy(second->m[i]);
1268      else
1269        temp->m[k] = prCopyR(second->m[i], orig_ring);
1270      if (slength==0) pShift(&(temp->m[k]),1);
1271      k++;
1272    }
1273  }
1274  intvec *w=NULL;
1275  temp1 = kStd(temp,currQuotient,testHomog,&w,NULL,length);
1276  if (w!=NULL) delete w;
1277  idDelete(&temp);
1278  if(syz_ring!=orig_ring)
1279    rChangeCurrRing(orig_ring);
1280
1281  result = idInit(IDELEMS(temp1),rank);
1282  j = 0;
1283  for (i=0;i<IDELEMS(temp1);i++)
1284  {
1285    if ((temp1->m[i]!=NULL)
1286    && (p_GetComp(temp1->m[i],syz_ring)>length))
1287    {
1288      if(syz_ring==orig_ring)
1289      {
1290        p = temp1->m[i];
1291      }
1292      else
1293      {
1294        p = prMoveR(temp1->m[i], syz_ring);
1295      }
1296      temp1->m[i]=NULL;
1297      while (p!=NULL)
1298      {
1299        q = pNext(p);
1300        pNext(p) = NULL;
1301        k = pGetComp(p)-1-length;
1302        pSetComp(p,0);
1303        pSetmComp(p);
1304        /* Warning! multiply only from the left! it's very important for Plural */
1305        result->m[j] = pAdd(result->m[j],pMult(p,pCopy(first->m[k])));
1306        p = q;
1307      }
1308      j++;
1309    }
1310  }
1311  if(syz_ring!=orig_ring)
1312  {
1313    rChangeCurrRing(syz_ring);
1314    idDelete(&temp1);
1315    rChangeCurrRing(orig_ring);
1316    rKill(syz_ring);
1317  }
1318  else
1319  {
1320    idDelete(&temp1);
1321  }
1322
1323  idSkipZeroes(result);
1324  if (TEST_OPT_RETURN_SB)
1325  {
1326     w=NULL;
1327     temp1=kStd(result,currQuotient,testHomog,&w);
1328     if (w!=NULL) delete w;
1329     idDelete(&result);
1330     idSkipZeroes(temp1);
1331     return temp1;
1332  }
1333  else //temp1=kInterRed(result,currQuotient);
1334    return result;
1335}
1336
1337/*2
1338* ideal/module intersection for a list of objects
1339* given as 'resolvente'
1340*/
1341ideal idMultSect(resolvente arg, int length)
1342{
1343  int i,j=0,k=0,syzComp,l,maxrk=-1,realrki;
1344  ideal bigmat,tempstd,result;
1345  poly p;
1346  int isIdeal=0;
1347  intvec * w=NULL;
1348
1349  /* find 0-ideals and max rank -----------------------------------*/
1350  for (i=0;i<length;i++)
1351  {
1352    if (!idIs0(arg[i]))
1353    {
1354      realrki=idRankFreeModule(arg[i]);
1355      k++;
1356      j += IDELEMS(arg[i]);
1357      if (realrki>maxrk) maxrk = realrki;
1358    }
1359    else
1360    {
1361      if (arg[i]!=NULL)
1362      {
1363        return idInit(1,arg[i]->rank);
1364      }
1365    }
1366  }
1367  if (maxrk == 0)
1368  {
1369    isIdeal = 1;
1370    maxrk = 1;
1371  }
1372  /* init -----------------------------------------------------------*/
1373  j += maxrk;
1374  syzComp = k*maxrk;
1375
1376  ring orig_ring=currRing;
1377  ring syz_ring=rCurrRingAssure_SyzComp();
1378  rSetSyzComp(syzComp);
1379
1380  bigmat = idInit(j,(k+1)*maxrk);
1381  /* create unit matrices ------------------------------------------*/
1382  for (i=0;i<maxrk;i++)
1383  {
1384    for (j=0;j<=k;j++)
1385    {
1386      p = pOne();
1387      pSetComp(p,i+1+j*maxrk);
1388      pSetmComp(p);
1389      bigmat->m[i] = pAdd(bigmat->m[i],p);
1390    }
1391  }
1392  /* enter given ideals ------------------------------------------*/
1393  i = maxrk;
1394  k = 0;
1395  for (j=0;j<length;j++)
1396  {
1397    if (arg[j]!=NULL)
1398    {
1399      for (l=0;l<IDELEMS(arg[j]);l++)
1400      {
1401        if (arg[j]->m[l]!=NULL)
1402        {
1403          if (syz_ring==orig_ring)
1404            bigmat->m[i] = pCopy(arg[j]->m[l]);
1405          else
1406            bigmat->m[i] = prCopyR(arg[j]->m[l], orig_ring);
1407          pShift(&(bigmat->m[i]),k*maxrk+isIdeal);
1408          i++;
1409        }
1410      }
1411      k++;
1412    }
1413  }
1414  /* std computation --------------------------------------------*/
1415  tempstd = kStd(bigmat,currQuotient,testHomog,&w,NULL,syzComp);
1416  if (w!=NULL) delete w;
1417  idDelete(&bigmat);
1418
1419  if(syz_ring!=orig_ring)
1420    rChangeCurrRing(orig_ring);
1421
1422  /* interprete result ----------------------------------------*/
1423  result = idInit(IDELEMS(tempstd),maxrk);
1424  k = 0;
1425  for (j=0;j<IDELEMS(tempstd);j++)
1426  {
1427    if ((tempstd->m[j]!=NULL) && (p_GetComp(tempstd->m[j],syz_ring)>syzComp))
1428    {
1429      if (syz_ring==orig_ring)
1430        p = pCopy(tempstd->m[j]);
1431      else
1432        p = prCopyR(tempstd->m[j], syz_ring);
1433      pShift(&p,-syzComp-isIdeal);
1434      result->m[k] = p;
1435      k++;
1436    }
1437  }
1438  /* clean up ----------------------------------------------------*/
1439  if(syz_ring!=orig_ring)
1440    rChangeCurrRing(syz_ring);
1441  idDelete(&tempstd);
1442  if(syz_ring!=orig_ring)
1443  {
1444    rChangeCurrRing(orig_ring);
1445    rKill(syz_ring);
1446  }
1447  idSkipZeroes(result);
1448  return result;
1449}
1450
1451/*2
1452*computes syzygies of h1,
1453*if quot != NULL it computes in the quotient ring modulo "quot"
1454*works always in a ring with ringorder_s
1455*/
1456static ideal idPrepare (ideal  h1, tHomog hom, int syzcomp, intvec **w)
1457{
1458  ideal   h2, h3;
1459  int     i;
1460  int     j,jj=0,k;
1461  poly    p,q;
1462
1463  if (idIs0(h1)) return NULL;
1464  k = idRankFreeModule(h1);
1465  h2=idCopy(h1);
1466  i = IDELEMS(h2)-1;
1467  if (k == 0)
1468  {
1469    for (j=0; j<=i; j++) pShift(&(h2->m[j]),1);
1470    k = 1;
1471  }
1472  if (syzcomp<k)
1473  {
1474    Warn("syzcomp too low, should be %d instead of %d",k,syzcomp);
1475    syzcomp = k;
1476    rSetSyzComp(k);
1477  }
1478  h2->rank = syzcomp+i+1;
1479
1480  //if (hom==testHomog)
1481  //{
1482  //  if(idHomIdeal(h1,currQuotient))
1483  //  {
1484  //    hom=TRUE;
1485  //  }
1486  //}
1487
1488#if MYTEST
1489#ifdef RDEBUG
1490  Print("Prepare::h2: ");
1491  idPrint(h2);
1492
1493  for(j=0;j<IDELEMS(h2);j++) pTest(h2->m[j]);
1494
1495#endif
1496#endif
1497
1498  for (j=0; j<=i; j++)
1499  {
1500    p = h2->m[j];
1501    q = pOne();
1502    pSetComp(q,syzcomp+1+j);
1503    pSetmComp(q);
1504    if (p!=NULL)
1505    {
1506      while (pNext(p)) pIter(p);
1507      p->next = q;
1508    }
1509    else
1510      h2->m[j]=q;
1511  }
1512
1513#ifdef PDEBUG
1514  for(j=0;j<IDELEMS(h2);j++) pTest(h2->m[j]);
1515
1516#if MYTEST
1517#ifdef RDEBUG
1518  Print("Prepare::Input: ");
1519  idPrint(h2);
1520
1521  Print("Prepare::currQuotient: ");
1522  idPrint(currQuotient);
1523#endif
1524#endif
1525
1526#endif
1527
1528  idTest(h2);
1529
1530  h3 = kStd(h2,currQuotient,hom,w,NULL,syzcomp);
1531
1532#if MYTEST
1533#ifdef RDEBUG
1534  Print("Prepare::Output: ");
1535  idPrint(h3);
1536  for(j=0;j<IDELEMS(h2);j++) pTest(h3->m[j]);
1537#endif
1538#endif
1539
1540
1541  idDelete(&h2);
1542  return h3;
1543}
1544
1545/*2
1546* compute the syzygies of h1 in R/quot,
1547* weights of components are in w
1548* if setRegularity, return the regularity in deg
1549* do not change h1,  w
1550*/
1551ideal idSyzygies (ideal  h1, tHomog h,intvec **w, BOOLEAN setSyzComp,
1552                  BOOLEAN setRegularity, int *deg)
1553{
1554  ideal s_h1;
1555  poly  p;
1556  int   j, k, length=0,reg;
1557  BOOLEAN isMonomial=TRUE;
1558  int ii, idElemens_h1;
1559
1560  assume(h1 != NULL);
1561
1562  idElemens_h1=IDELEMS(h1);
1563#ifdef PDEBUG
1564  for(ii=0;ii<idElemens_h1 /*IDELEMS(h1)*/;ii++) pTest(h1->m[ii]);
1565#endif
1566  if (idIs0(h1))
1567  {
1568    ideal result=idFreeModule(idElemens_h1/*IDELEMS(h1)*/);
1569    int curr_syz_limit=rGetCurrSyzLimit();
1570    if (curr_syz_limit>0)
1571    for (ii=0;ii<idElemens_h1/*IDELEMS(h1)*/;ii++)
1572    {
1573      if (h1->m[ii]!=NULL)
1574        pShift(&h1->m[ii],curr_syz_limit);
1575    }
1576    return result;
1577  }
1578  int slength=(int)idRankFreeModule(h1);
1579  k=si_max(1,slength /*idRankFreeModule(h1)*/);
1580
1581  assume(currRing != NULL);
1582  ring orig_ring=currRing;
1583  ring syz_ring=rCurrRingAssure_SyzComp();
1584
1585  if (setSyzComp)
1586    rSetSyzComp(k);
1587
1588  if (orig_ring != syz_ring)
1589  {
1590    s_h1=idrCopyR_NoSort(h1,orig_ring);
1591  }
1592  else
1593  {
1594    s_h1 = h1;
1595  }
1596
1597  idTest(s_h1);
1598
1599  ideal s_h3=idPrepare(s_h1,h,k,w); // main (syz) GB computation
1600
1601  if (s_h3==NULL)
1602  {
1603    return idFreeModule( idElemens_h1 /*IDELEMS(h1)*/);
1604  }
1605
1606  if (orig_ring != syz_ring)
1607  {
1608    idDelete(&s_h1);
1609    for (j=0; j<IDELEMS(s_h3); j++)
1610    {
1611      if (s_h3->m[j] != NULL)
1612      {
1613        if (p_MinComp(s_h3->m[j],syz_ring) > k)
1614          pShift(&s_h3->m[j], -k);
1615        else
1616          pDelete(&s_h3->m[j]);
1617      }
1618    }
1619    idSkipZeroes(s_h3);
1620    s_h3->rank -= k;
1621    rChangeCurrRing(orig_ring);
1622    s_h3 = idrMoveR_NoSort(s_h3, syz_ring);
1623    rKill(syz_ring);
1624    #ifdef HAVE_PLURAL
1625    if (rIsPluralRing(currRing))
1626    {
1627      idDelMultiples(s_h3);
1628      idSkipZeroes(s_h3);
1629    }
1630    #endif
1631    idTest(s_h3);
1632    return s_h3;
1633  }
1634
1635  ideal e = idInit(IDELEMS(s_h3), s_h3->rank);
1636
1637  for (j=IDELEMS(s_h3)-1; j>=0; j--)
1638  {
1639    if (s_h3->m[j] != NULL)
1640    {
1641      if (p_MinComp(s_h3->m[j],syz_ring) <= k)
1642      {
1643        e->m[j] = s_h3->m[j];
1644        isMonomial=isMonomial && (pNext(s_h3->m[j])==NULL);
1645        pDelete(&pNext(s_h3->m[j]));
1646        s_h3->m[j] = NULL;
1647      }
1648    }
1649  }
1650
1651  idSkipZeroes(s_h3);
1652  idSkipZeroes(e);
1653
1654  if ((deg != NULL)
1655  && (!isMonomial)
1656  && (!TEST_OPT_NOTREGULARITY)
1657  && (setRegularity)
1658  && (h==isHomog)
1659  && (!rIsPluralRing(currRing))
1660  )
1661  {
1662    ring dp_C_ring = rCurrRingAssure_dp_C();
1663    if (dp_C_ring != syz_ring)
1664      e = idrMoveR_NoSort(e, syz_ring);
1665    resolvente res = sySchreyerResolvente(e,-1,&length,TRUE, TRUE);
1666    intvec * dummy = syBetti(res,length,&reg, *w);
1667    *deg = reg+2;
1668    delete dummy;
1669    for (j=0;j<length;j++)
1670    {
1671      if (res[j]!=NULL) idDelete(&(res[j]));
1672    }
1673    omFreeSize((ADDRESS)res,length*sizeof(ideal));
1674    idDelete(&e);
1675    if (dp_C_ring != syz_ring)
1676    {
1677      rChangeCurrRing(syz_ring);
1678      rKill(dp_C_ring);
1679    }
1680  }
1681  else
1682  {
1683    idDelete(&e);
1684  }
1685  idTest(s_h3);
1686  if (currQuotient != NULL)
1687  {
1688    ideal ts_h3=kStd(s_h3,currQuotient,h,w);
1689    idDelete(&s_h3);
1690    s_h3 = ts_h3;
1691  }
1692  return s_h3;
1693}
1694
1695/*2
1696*/
1697ideal idXXX (ideal  h1, int k)
1698{
1699  ideal s_h1;
1700  int j;
1701  intvec *w=NULL;
1702
1703  assume(currRing != NULL);
1704  ring orig_ring=currRing;
1705  ring syz_ring=rCurrRingAssure_SyzComp();
1706
1707  rSetSyzComp(k);
1708
1709  if (orig_ring != syz_ring)
1710  {
1711    s_h1=idrCopyR_NoSort(h1,orig_ring);
1712  }
1713  else
1714  {
1715    s_h1 = h1;
1716  }
1717
1718  ideal s_h3=kStd(s_h1,NULL,testHomog,&w,NULL,k);
1719
1720  if (s_h3==NULL)
1721  {
1722    return idFreeModule(IDELEMS(h1));
1723  }
1724
1725  if (orig_ring != syz_ring)
1726  {
1727    idDelete(&s_h1);
1728    idSkipZeroes(s_h3);
1729    rChangeCurrRing(orig_ring);
1730    s_h3 = idrMoveR_NoSort(s_h3, syz_ring);
1731    rKill(syz_ring);
1732    idTest(s_h3);
1733    return s_h3;
1734  }
1735
1736  idSkipZeroes(s_h3);
1737  idTest(s_h3);
1738  return s_h3;
1739}
1740
1741/*
1742*computes a standard basis for h1 and stores the transformation matrix
1743* in ma
1744*/
1745ideal idLiftStd (ideal  h1, matrix* ma, tHomog hi, ideal * syz)
1746{
1747  int   i, j, k, t, inputIsIdeal=idRankFreeModule(h1);
1748  poly  p=NULL, q, qq;
1749  intvec *w=NULL;
1750
1751  idDelete((ideal*)ma);
1752  BOOLEAN lift3=FALSE;
1753  if (syz!=NULL) { lift3=TRUE; idDelete(syz); }
1754  if (idIs0(h1))
1755  {
1756    *ma=mpNew(1,0);
1757    if (lift3)
1758    {
1759      *syz=idFreeModule(IDELEMS(h1));
1760      int curr_syz_limit=rGetCurrSyzLimit();
1761      if (curr_syz_limit>0)
1762      for (int ii=0;ii<IDELEMS(h1);ii++)
1763      {
1764        if (h1->m[ii]!=NULL)
1765          pShift(&h1->m[ii],curr_syz_limit);
1766      }
1767    }
1768    return idInit(1,h1->rank);
1769  }
1770
1771  BITSET save_verbose=verbose;
1772
1773  k=si_max(1,(int)idRankFreeModule(h1));
1774
1775  if ((k==1) && (!lift3)) verbose |=Sy_bit(V_IDLIFT);
1776
1777  ring orig_ring = currRing;
1778  ring syz_ring = rCurrRingAssure_SyzComp();
1779  rSetSyzComp(k);
1780
1781  ideal s_h1=h1;
1782
1783  if (orig_ring != syz_ring)
1784    s_h1 = idrCopyR_NoSort(h1,orig_ring);
1785  else
1786    s_h1 = h1;
1787
1788  ideal s_h3=idPrepare(s_h1,hi,k,&w); // main (syz) GB computation
1789
1790  ideal s_h2 = idInit(IDELEMS(s_h3), s_h3->rank);
1791
1792  if (lift3) (*syz)=idInit(IDELEMS(s_h3),IDELEMS(h1));
1793
1794  if (w!=NULL) delete w;
1795  i = 0;
1796
1797  // now sort the result, SB : leave in s_h3
1798  //                      T:  put in s_h2
1799  //                      syz: put in *syz
1800  for (j=0; j<IDELEMS(s_h3); j++)
1801  {
1802    if (s_h3->m[j] != NULL)
1803    {
1804      //if (p_MinComp(s_h3->m[j],syz_ring) <= k)
1805      if (pGetComp(s_h3->m[j]) <= k) // syz_ring == currRing
1806      {
1807        i++;
1808        q = s_h3->m[j];
1809        while (pNext(q) != NULL)
1810        {
1811          if (pGetComp(pNext(q)) > k)
1812          {
1813            s_h2->m[j] = pNext(q);
1814            pNext(q) = NULL;
1815          }
1816          else
1817          {
1818            pIter(q);
1819          }
1820        }
1821        if (!inputIsIdeal) pShift(&(s_h3->m[j]), -1);
1822      }
1823      else
1824      {
1825        // we a syzygy here:
1826        if (lift3)
1827        {
1828          pShift(&s_h3->m[j], -k);
1829          (*syz)->m[j]=s_h3->m[j];
1830          s_h3->m[j]=NULL;
1831        }
1832        else
1833          pDelete(&(s_h3->m[j]));
1834      }
1835    }
1836  }
1837  idSkipZeroes(s_h3);
1838  //extern char * iiStringMatrix(matrix im, int dim,char ch);
1839  //PrintS("SB: ----------------------------------------\n");
1840  //PrintS(iiStringMatrix((matrix)s_h3,k,'\n'));
1841  //PrintLn();
1842  //PrintS("T: ----------------------------------------\n");
1843  //PrintS(iiStringMatrix((matrix)s_h2,h1->rank,'\n'));
1844  //PrintLn();
1845
1846  if (lift3) idSkipZeroes(*syz);
1847
1848  j = IDELEMS(s_h1);
1849
1850
1851  if (syz_ring!=orig_ring)
1852  {
1853    idDelete(&s_h1);
1854    rChangeCurrRing(orig_ring);
1855  }
1856
1857  *ma = mpNew(j,i);
1858
1859  i = 1;
1860  for (j=0; j<IDELEMS(s_h2); j++)
1861  {
1862    if (s_h2->m[j] != NULL)
1863    {
1864      q = prMoveR( s_h2->m[j], syz_ring);
1865      s_h2->m[j] = NULL;
1866
1867      while (q != NULL)
1868      {
1869        p = q;
1870        pIter(q);
1871        pNext(p) = NULL;
1872        t=pGetComp(p);
1873        pSetComp(p,0);
1874        pSetmComp(p);
1875        MATELEM(*ma,t-k,i) = pAdd(MATELEM(*ma,t-k,i),p);
1876      }
1877      i++;
1878    }
1879  }
1880  idDelete(&s_h2);
1881
1882  for (i=0; i<IDELEMS(s_h3); i++)
1883  {
1884    s_h3->m[i] = prMoveR_NoSort(s_h3->m[i], syz_ring);
1885  }
1886  if (lift3)
1887  {
1888    for (i=0; i<IDELEMS(*syz); i++)
1889    {
1890      (*syz)->m[i] = prMoveR_NoSort((*syz)->m[i], syz_ring);
1891    }
1892  }
1893
1894  if (syz_ring!=orig_ring) rKill(syz_ring);
1895  verbose = save_verbose;
1896  return s_h3;
1897}
1898
1899static void idPrepareStd(ideal s_temp, int k)
1900{
1901  int j,rk=idRankFreeModule(s_temp);
1902  poly p,q;
1903
1904  if (rk == 0)
1905  {
1906    for (j=0; j<IDELEMS(s_temp); j++)
1907    {
1908      if (s_temp->m[j]!=NULL) pSetCompP(s_temp->m[j],1);
1909    }
1910    k = si_max(k,1);
1911  }
1912  for (j=0; j<IDELEMS(s_temp); j++)
1913  {
1914    if (s_temp->m[j]!=NULL)
1915    {
1916      p = s_temp->m[j];
1917      q = pOne();
1918      //pGetCoeff(q)=nNeg(pGetCoeff(q));   //set q to -1
1919      pSetComp(q,k+1+j);
1920      pSetmComp(q);
1921      while (pNext(p)) pIter(p);
1922      pNext(p) = q;
1923    }
1924  }
1925}
1926
1927/*2
1928*computes a representation of the generators of submod with respect to those
1929* of mod
1930*/
1931
1932ideal idLift(ideal mod, ideal submod,ideal *rest, BOOLEAN goodShape,
1933             BOOLEAN isSB, BOOLEAN divide, matrix *unit)
1934{
1935  int lsmod =idRankFreeModule(submod), i, j, k;
1936  int comps_to_add=0;
1937  poly p;
1938
1939  if (idIs0(submod))
1940  {
1941    if (unit!=NULL)
1942    {
1943      *unit=mpNew(1,1);
1944      MATELEM(*unit,1,1)=pOne();
1945    }
1946    if (rest!=NULL)
1947    {
1948      *rest=idInit(1,mod->rank);
1949    }
1950    return idInit(1,mod->rank);
1951  }
1952  if (idIs0(mod)) /* and not idIs0(submod) */
1953  {
1954    WerrorS("2nd module does not lie in the first");
1955    #if 0
1956    if (unit!=NULL)
1957    {
1958      i=IDELEMS(submod);
1959      *unit=mpNew(i,i);
1960      for (j=i;j>0;j--)
1961      {
1962        MATELEM(*unit,j,j)=pOne();
1963      }
1964    }
1965    if (rest!=NULL)
1966    {
1967      *rest=idCopy(submod);
1968    }
1969    return idInit(1,mod->rank);
1970    #endif
1971    return idInit(IDELEMS(submod),submod->rank);
1972  }
1973  if (unit!=NULL)
1974  {
1975    comps_to_add = IDELEMS(submod);
1976    while ((comps_to_add>0) && (submod->m[comps_to_add-1]==NULL))
1977      comps_to_add--;
1978  }
1979  k=si_max(idRankFreeModule(mod),idRankFreeModule(submod));
1980  if  ((k!=0) && (lsmod==0)) lsmod=1;
1981  k=si_max(k,(int)mod->rank);
1982  if (k<submod->rank) { WarnS("rk(submod) > rk(mod) ?");k=submod->rank; }
1983
1984  ring orig_ring=currRing;
1985  ring syz_ring=rCurrRingAssure_SyzComp();
1986  rSetSyzComp(k);
1987
1988  ideal s_mod, s_temp;
1989  if (orig_ring != syz_ring)
1990  {
1991    s_mod = idrCopyR_NoSort(mod,orig_ring);
1992    s_temp = idrCopyR_NoSort(submod,orig_ring);
1993  }
1994  else
1995  {
1996    s_mod = mod;
1997    s_temp = idCopy(submod);
1998  }
1999  ideal s_h3;
2000  if (isSB)
2001  {
2002    s_h3 = idCopy(s_mod);
2003    idPrepareStd(s_h3, k+comps_to_add);
2004  }
2005  else
2006  {
2007    s_h3 = idPrepare(s_mod,(tHomog)FALSE,k+comps_to_add,NULL);
2008  }
2009  if (!goodShape)
2010  {
2011    for (j=0;j<IDELEMS(s_h3);j++)
2012    {
2013      if ((s_h3->m[j] != NULL) && (pMinComp(s_h3->m[j]) > k))
2014        pDelete(&(s_h3->m[j]));
2015    }
2016  }
2017  idSkipZeroes(s_h3);
2018  if (lsmod==0)
2019  {
2020    for (j=IDELEMS(s_temp);j>0;j--)
2021    {
2022      if (s_temp->m[j-1]!=NULL)
2023        pShift(&(s_temp->m[j-1]),1);
2024    }
2025  }
2026  if (unit!=NULL)
2027  {
2028    for(j = 0;j<comps_to_add;j++)
2029    {
2030      p = s_temp->m[j];
2031      if (p!=NULL)
2032      {
2033        while (pNext(p)!=NULL) pIter(p);
2034        pNext(p) = pOne();
2035        pIter(p);
2036        pSetComp(p,1+j+k);
2037        pSetmComp(p);
2038        p = pNeg(p);
2039      }
2040    }
2041  }
2042  ideal s_result = kNF(s_h3,currQuotient,s_temp,k);
2043  s_result->rank = s_h3->rank;
2044  ideal s_rest = idInit(IDELEMS(s_result),k);
2045  idDelete(&s_h3);
2046  idDelete(&s_temp);
2047
2048  for (j=0;j<IDELEMS(s_result);j++)
2049  {
2050    if (s_result->m[j]!=NULL)
2051    {
2052      if (pGetComp(s_result->m[j])<=k)
2053      {
2054        if (!divide)
2055        {
2056          if (isSB)
2057          {
2058            WarnS("first module not a standardbasis\n"
2059              "// ** or second not a proper submodule");
2060          }
2061          else
2062            WerrorS("2nd module does not lie in the first");
2063          idDelete(&s_result);
2064          idDelete(&s_rest);
2065          s_result=idInit(IDELEMS(submod),submod->rank);
2066          break;
2067        }
2068        else
2069        {
2070          p = s_rest->m[j] = s_result->m[j];
2071          while ((pNext(p)!=NULL) && (pGetComp(pNext(p))<=k)) pIter(p);
2072          s_result->m[j] = pNext(p);
2073          pNext(p) = NULL;
2074        }
2075      }
2076      pShift(&(s_result->m[j]),-k);
2077      pNeg(s_result->m[j]);
2078    }
2079  }
2080  if ((lsmod==0) && (!idIs0(s_rest)))
2081  {
2082    for (j=IDELEMS(s_rest);j>0;j--)
2083    {
2084      if (s_rest->m[j-1]!=NULL)
2085      {
2086        pShift(&(s_rest->m[j-1]),-1);
2087        s_rest->m[j-1] = s_rest->m[j-1];
2088      }
2089    }
2090  }
2091  if(syz_ring!=orig_ring)
2092  {
2093    idDelete(&s_mod);
2094    rChangeCurrRing(orig_ring);
2095    s_result = idrMoveR_NoSort(s_result, syz_ring);
2096    s_rest = idrMoveR_NoSort(s_rest, syz_ring);
2097    rKill(syz_ring);
2098  }
2099  if (rest!=NULL)
2100    *rest = s_rest;
2101  else
2102    idDelete(&s_rest);
2103//idPrint(s_result);
2104  if (unit!=NULL)
2105  {
2106    *unit=mpNew(comps_to_add,comps_to_add);
2107    int i;
2108    for(i=0;i<IDELEMS(s_result);i++)
2109    {
2110      poly p=s_result->m[i];
2111      poly q=NULL;
2112      while(p!=NULL)
2113      {
2114        if(pGetComp(p)<=comps_to_add)
2115        {
2116          pSetComp(p,0);
2117          if (q!=NULL)
2118          {
2119            pNext(q)=pNext(p);
2120          }
2121          else
2122          {
2123            pIter(s_result->m[i]);
2124          }
2125          pNext(p)=NULL;
2126          MATELEM(*unit,i+1,i+1)=pAdd(MATELEM(*unit,i+1,i+1),p);
2127          if(q!=NULL)   p=pNext(q);
2128          else          p=s_result->m[i];
2129        }
2130        else
2131        {
2132          q=p;
2133          pIter(p);
2134        }
2135      }
2136      pShift(&s_result->m[i],-comps_to_add);
2137    }
2138  }
2139  return s_result;
2140}
2141
2142/*2
2143*computes division of P by Q with remainder up to (w-weighted) degree n
2144*P, Q, and w are not changed
2145*/
2146void idLiftW(ideal P,ideal Q,int n,matrix &T, ideal &R,short *w)
2147{
2148  long N=0;
2149  int i;
2150  for(i=IDELEMS(Q)-1;i>=0;i--)
2151    if(w==NULL)
2152      N=si_max(N,pDeg(Q->m[i]));
2153    else
2154      N=si_max(N,pDegW(Q->m[i],w));
2155  N+=n;
2156
2157  T=mpNew(IDELEMS(Q),IDELEMS(P));
2158  R=idInit(IDELEMS(P),P->rank);
2159
2160  for(i=IDELEMS(P)-1;i>=0;i--)
2161  {
2162    poly p;
2163    if(w==NULL)
2164      p=ppJet(P->m[i],N);
2165    else
2166      p=ppJetW(P->m[i],N,w);
2167
2168    int j=IDELEMS(Q)-1;
2169    while(p!=NULL)
2170    {
2171      if(pDivisibleBy(Q->m[j],p))
2172      {
2173        poly p0=pDivideM(pHead(p),pHead(Q->m[j]));
2174        if(w==NULL)
2175          p=pJet(pSub(p,ppMult_mm(Q->m[j],p0)),N);
2176        else
2177          p=pJetW(pSub(p,ppMult_mm(Q->m[j],p0)),N,w);
2178        pNormalize(p);
2179        if((w==NULL)&&(pDeg(p0)>n)||(w!=NULL)&&(pDegW(p0,w)>n))
2180          pDelete(&p0);
2181        else
2182          MATELEM(T,j+1,i+1)=pAdd(MATELEM(T,j+1,i+1),p0);
2183        j=IDELEMS(Q)-1;
2184      }
2185      else
2186      {
2187        if(j==0)
2188        {
2189          poly p0=p;
2190          pIter(p);
2191          pNext(p0)=NULL;
2192          if(((w==NULL)&&(pDeg(p0)>n))
2193          ||((w!=NULL)&&(pDegW(p0,w)>n)))
2194            pDelete(&p0);
2195          else
2196            R->m[i]=pAdd(R->m[i],p0);
2197          j=IDELEMS(Q)-1;
2198        }
2199        else
2200          j--;
2201      }
2202    }
2203  }
2204}
2205
2206/*2
2207*computes the quotient of h1,h2 : internal routine for idQuot
2208*BEWARE: the returned ideals may contain incorrectly ordered polys !
2209*
2210*/
2211static ideal idInitializeQuot (ideal  h1, ideal h2, BOOLEAN h1IsStb,
2212                               BOOLEAN *addOnlyOne, int *kkmax)
2213{
2214  ideal temph1;
2215  poly     p,q = NULL;
2216  int i,l,ll,k,kkk,kmax;
2217  int j = 0;
2218  int k1 = idRankFreeModule(h1);
2219  int k2 = idRankFreeModule(h2);
2220  tHomog   hom=isNotHomog;
2221
2222  k=si_max(k1,k2);
2223  if (k==0)
2224    k = 1;
2225  if ((k2==0) && (k>1)) *addOnlyOne = FALSE;
2226
2227  intvec * weights;
2228  hom = (tHomog)idHomModule(h1,currQuotient,&weights);
2229  if (/**addOnlyOne &&*/ (!h1IsStb))
2230    temph1 = kStd(h1,currQuotient,hom,&weights,NULL);
2231  else
2232    temph1 = idCopy(h1);
2233  if (weights!=NULL) delete weights;
2234  idTest(temph1);
2235/*--- making a single vector from h2 ---------------------*/
2236  for (i=0; i<IDELEMS(h2); i++)
2237  {
2238    if (h2->m[i] != NULL)
2239    {
2240      p = pCopy(h2->m[i]);
2241      if (k2 == 0)
2242        pShift(&p,j*k+1);
2243      else
2244        pShift(&p,j*k);
2245      q = pAdd(q,p);
2246      j++;
2247    }
2248  }
2249  *kkmax = kmax = j*k+1;
2250/*--- adding a monomial for the result (syzygy) ----------*/
2251  p = q;
2252  while (pNext(p)!=NULL) pIter(p);
2253  pNext(p) = pOne();
2254  pIter(p);
2255  pSetComp(p,kmax);
2256  pSetmComp(p);
2257/*--- constructing the big matrix ------------------------*/
2258  ideal h4 = idInit(16,kmax+k-1);
2259  h4->m[0] = q;
2260  if (k2 == 0)
2261  {
2262    if (k > IDELEMS(h4))
2263    {
2264      pEnlargeSet(&(h4->m),IDELEMS(h4),k-IDELEMS(h4));
2265      IDELEMS(h4) = k;
2266    }
2267    for (i=1; i<k; i++)
2268    {
2269      if (h4->m[i-1]!=NULL)
2270      {
2271        p = pCopy_noCheck(h4->m[i-1]);
2272        pShift(&p,1);
2273        h4->m[i] = p;
2274      }
2275    }
2276  }
2277  idSkipZeroes(h4);
2278  kkk = IDELEMS(h4);
2279  i = IDELEMS(temph1);
2280  for (l=0; l<i; l++)
2281  {
2282    if(temph1->m[l]!=NULL)
2283    {
2284      for (ll=0; ll<j; ll++)
2285      {
2286        p = pCopy(temph1->m[l]);
2287        if (k1 == 0)
2288          pShift(&p,ll*k+1);
2289        else
2290          pShift(&p,ll*k);
2291        if (kkk >= IDELEMS(h4))
2292        {
2293          pEnlargeSet(&(h4->m),IDELEMS(h4),16);
2294          IDELEMS(h4) += 16;
2295        }
2296        h4->m[kkk] = p;
2297        kkk++;
2298      }
2299    }
2300  }
2301/*--- if h2 goes in as single vector - the h1-part is just SB ---*/
2302  if (*addOnlyOne)
2303  {
2304    idSkipZeroes(h4);
2305    p = h4->m[0];
2306    for (i=0;i<IDELEMS(h4)-1;i++)
2307    {
2308      h4->m[i] = h4->m[i+1];
2309    }
2310    h4->m[IDELEMS(h4)-1] = p;
2311    test |= Sy_bit(OPT_SB_1);
2312  }
2313  idDelete(&temph1);
2314  return h4;
2315}
2316/*2
2317*computes the quotient of h1,h2
2318*/
2319ideal idQuot (ideal  h1, ideal h2, BOOLEAN h1IsStb, BOOLEAN resultIsIdeal)
2320{
2321  // first check for special case h1:(0)
2322  if (idIs0(h2))
2323  {
2324    ideal res;
2325    if (resultIsIdeal)
2326    {
2327      res = idInit(1,1);
2328      res->m[0] = pOne();
2329    }
2330    else
2331      res = idFreeModule(h1->rank);
2332    return res;
2333  }
2334  BITSET old_test=test;
2335  int i,l,ll,k,kkk,kmax;
2336  BOOLEAN  addOnlyOne=TRUE;
2337  tHomog   hom=isNotHomog;
2338  intvec * weights1;
2339
2340  ideal s_h4 = idInitializeQuot (h1,h2,h1IsStb,&addOnlyOne,&kmax);
2341
2342  hom = (tHomog)idHomModule(s_h4,currQuotient,&weights1);
2343
2344  ring orig_ring=currRing;
2345  ring syz_ring=rCurrRingAssure_SyzComp();
2346  rSetSyzComp(kmax-1);
2347  if (orig_ring!=syz_ring)
2348  //  s_h4 = idrMoveR_NoSort(s_h4,orig_ring);
2349    s_h4 = idrMoveR(s_h4,orig_ring);
2350  idTest(s_h4);
2351  #if 0
2352  void ipPrint_MA0(matrix m, const char *name);
2353  matrix m=idModule2Matrix(idCopy(s_h4));
2354  PrintS("start:\n");
2355  ipPrint_MA0(m,"Q");
2356  idDelete((ideal *)&m);
2357  PrintS("last elem:");wrp(s_h4->m[IDELEMS(s_h4)-1]);PrintLn();
2358  #endif
2359  ideal s_h3;
2360  if (addOnlyOne)
2361  {
2362    s_h3 = kStd(s_h4,currQuotient,hom,&weights1,NULL,0/*kmax-1*/,IDELEMS(s_h4)-1);
2363  }
2364  else
2365  {
2366    s_h3 = kStd(s_h4,currQuotient,hom,&weights1,NULL,kmax-1);
2367  }
2368  test = old_test;
2369  #if 0
2370  // only together with the above debug stuff
2371  idSkipZeroes(s_h3);
2372  m=idModule2Matrix(idCopy(s_h3));
2373  Print("result, kmax=%d:\n",kmax);
2374  ipPrint_MA0(m,"S");
2375  idDelete((ideal *)&m);
2376  #endif
2377  idTest(s_h3);
2378  if (weights1!=NULL) delete weights1;
2379  idDelete(&s_h4);
2380
2381  for (i=0;i<IDELEMS(s_h3);i++)
2382  {
2383    if ((s_h3->m[i]!=NULL) && (pGetComp(s_h3->m[i])>=kmax))
2384    {
2385      if (resultIsIdeal)
2386        pShift(&s_h3->m[i],-kmax);
2387      else
2388        pShift(&s_h3->m[i],-kmax+1);
2389    }
2390    else
2391      pDelete(&s_h3->m[i]);
2392  }
2393  if (resultIsIdeal)
2394    s_h3->rank = 1;
2395  else
2396    s_h3->rank = h1->rank;
2397  if(syz_ring!=orig_ring)
2398  {
2399    rChangeCurrRing(orig_ring);
2400    s_h3 = idrMoveR_NoSort(s_h3, syz_ring);
2401    rKill(syz_ring);
2402  }
2403  idSkipZeroes(s_h3);
2404  idTest(s_h3);
2405  return s_h3;
2406}
2407
2408/*2
2409*computes recursively all monomials of a certain degree
2410*in every step the actvar-th entry in the exponential
2411*vector is incremented and the other variables are
2412*computed by recursive calls of makemonoms
2413*if the last variable is reached, the difference to the
2414*degree is computed directly
2415*vars is the number variables
2416*actvar is the actual variable to handle
2417*deg is the degree of the monomials to compute
2418*monomdeg is the actual degree of the monomial in consideration
2419*/
2420static void makemonoms(int vars,int actvar,int deg,int monomdeg)
2421{
2422  poly p;
2423  int i=0;
2424
2425  if ((idpowerpoint == 0) && (actvar ==1))
2426  {
2427    idpower[idpowerpoint] = pOne();
2428    monomdeg = 0;
2429  }
2430  while (i<=deg)
2431  {
2432    if (deg == monomdeg)
2433    {
2434      pSetm(idpower[idpowerpoint]);
2435      idpowerpoint++;
2436      return;
2437    }
2438    if (actvar == vars)
2439    {
2440      pSetExp(idpower[idpowerpoint],actvar,deg-monomdeg);
2441      pSetm(idpower[idpowerpoint]);
2442      pTest(idpower[idpowerpoint]);
2443      idpowerpoint++;
2444      return;
2445    }
2446    else
2447    {
2448      p = pCopy(idpower[idpowerpoint]);
2449      makemonoms(vars,actvar+1,deg,monomdeg);
2450      idpower[idpowerpoint] = p;
2451    }
2452    monomdeg++;
2453    pSetExp(idpower[idpowerpoint],actvar,pGetExp(idpower[idpowerpoint],actvar)+1);
2454    pSetm(idpower[idpowerpoint]);
2455    pTest(idpower[idpowerpoint]);
2456    i++;
2457  }
2458}
2459
2460/*2
2461*returns the deg-th power of the maximal ideal of 0
2462*/
2463ideal idMaxIdeal(int deg)
2464{
2465  if (deg < 0)
2466  {
2467    WarnS("maxideal: power must be non-negative");
2468  }
2469  if (deg < 1)
2470  {
2471    ideal I=idInit(1,1);
2472    I->m[0]=pOne();
2473    return I;
2474  }
2475  if (deg == 1)
2476  {
2477    return idMaxIdeal();
2478  }
2479
2480  int vars = currRing->N;
2481  int i = binom(vars+deg-1,deg);
2482  if (i<=0) return idInit(1,1);
2483  ideal id=idInit(i,1);
2484  idpower = id->m;
2485  idpowerpoint = 0;
2486  makemonoms(vars,1,deg,0);
2487  idpower = NULL;
2488  idpowerpoint = 0;
2489  return id;
2490}
2491
2492/*2
2493*computes recursively all generators of a certain degree
2494*of the ideal "givenideal"
2495*elms is the number elements in the given ideal
2496*actelm is the actual element to handle
2497*deg is the degree of the power to compute
2498*gendeg is the actual degree of the generator in consideration
2499*/
2500static void makepotence(int elms,int actelm,int deg,int gendeg)
2501{
2502  poly p;
2503  int i=0;
2504
2505  if ((idpowerpoint == 0) && (actelm ==1))
2506  {
2507    idpower[idpowerpoint] = pOne();
2508    gendeg = 0;
2509  }
2510  while (i<=deg)
2511  {
2512    if (deg == gendeg)
2513    {
2514      idpowerpoint++;
2515      return;
2516    }
2517    if (actelm == elms)
2518    {
2519      p=pPower(pCopy(givenideal[actelm-1]),deg-gendeg);
2520      idpower[idpowerpoint]=pMult(idpower[idpowerpoint],p);
2521      idpowerpoint++;
2522      return;
2523    }
2524    else
2525    {
2526      p = pCopy(idpower[idpowerpoint]);
2527      makepotence(elms,actelm+1,deg,gendeg);
2528      idpower[idpowerpoint] = p;
2529    }
2530    gendeg++;
2531    idpower[idpowerpoint]=pMult(idpower[idpowerpoint],pCopy(givenideal[actelm-1]));
2532    i++;
2533  }
2534}
2535
2536/*2
2537*returns the deg-th power of the ideal gid
2538*/
2539//ideal idPower(ideal gid,int deg)
2540//{
2541//  int i;
2542//  ideal id;
2543//
2544//  if (deg < 1) deg = 1;
2545//  i = binom(IDELEMS(gid)+deg-1,deg);
2546//  id=idInit(i,1);
2547//  idpower = id->m;
2548//  givenideal = gid->m;
2549//  idpowerpoint = 0;
2550//  makepotence(IDELEMS(gid),1,deg,0);
2551//  idpower = NULL;
2552//  givenideal = NULL;
2553//  idpowerpoint = 0;
2554//  return id;
2555//}
2556static void idNextPotence(ideal given, ideal result,
2557  int begin, int end, int deg, int restdeg, poly ap)
2558{
2559  poly p;
2560  int i;
2561
2562  p = pPower(pCopy(given->m[begin]),restdeg);
2563  i = result->nrows;
2564  result->m[i] = pMult(pCopy(ap),p);
2565//PrintS(".");
2566  (result->nrows)++;
2567  if (result->nrows >= IDELEMS(result))
2568  {
2569    pEnlargeSet(&(result->m),IDELEMS(result),16);
2570    IDELEMS(result) += 16;
2571  }
2572  if (begin == end) return;
2573  for (i=restdeg-1;i>0;i--)
2574  {
2575    p = pPower(pCopy(given->m[begin]),i);
2576    p = pMult(pCopy(ap),p);
2577    idNextPotence(given, result, begin+1, end, deg, restdeg-i, p);
2578    pDelete(&p);
2579  }
2580  idNextPotence(given, result, begin+1, end, deg, restdeg, ap);
2581}
2582
2583ideal idPower(ideal given,int exp)
2584{
2585  ideal result,temp;
2586  poly p1;
2587  int i;
2588
2589  if (idIs0(given)) return idInit(1,1);
2590  temp = idCopy(given);
2591  idSkipZeroes(temp);
2592  i = binom(IDELEMS(temp)+exp-1,exp);
2593  result = idInit(i,1);
2594  result->nrows = 0;
2595//Print("ideal contains %d elements\n",i);
2596  p1=pOne();
2597  idNextPotence(temp,result,0,IDELEMS(temp)-1,exp,exp,p1);
2598  pDelete(&p1);
2599  idDelete(&temp);
2600  result->nrows = 1;
2601  idDelEquals(result);
2602  idSkipZeroes(result);
2603  return result;
2604}
2605
2606/*2
2607* eliminate delVar (product of vars) in h1
2608*/
2609ideal idElimination (ideal h1,poly delVar,intvec *hilb)
2610{
2611  int    i,j=0,k,l;
2612  ideal  h,hh, h3;
2613  int    *ord,*block0,*block1;
2614  int    ordersize=2;
2615  int    **wv;
2616  tHomog hom;
2617  intvec * w;
2618  ring tmpR;
2619  ring origR = currRing;
2620
2621  if (delVar==NULL)
2622  {
2623    return idCopy(h1);
2624  }
2625  if ((currQuotient!=NULL) && rIsPluralRing(origR))
2626  {
2627    WerrorS("cannot eliminate in a qring");
2628    return idCopy(h1);
2629  }
2630  if (idIs0(h1)) return idInit(1,h1->rank);
2631#ifdef HAVE_PLURAL
2632  if (rIsPluralRing(origR))
2633    /* in the NC case, we have to check the admissibility of */
2634    /* the subalgebra to be intersected with */
2635  {
2636    if ((ncRingType(origR) != nc_skew) && (ncRingType(origR) != nc_exterior)) /* in (quasi)-commutative algebras every subalgebra is admissible */
2637    {
2638      if (nc_CheckSubalgebra(delVar,origR))
2639      {
2640        WerrorS("no elimination is possible: subalgebra is not admissible");
2641        return idCopy(h1);
2642      }
2643    }
2644  }
2645#endif
2646  hom=(tHomog)idHomModule(h1,NULL,&w); //sets w to weight vector or NULL
2647  h3=idInit(16,h1->rank);
2648  for (k=0;; k++)
2649  {
2650    if (origR->order[k]!=0) ordersize++;
2651    else break;
2652  }
2653#if 0
2654  if (rIsPluralRing(origR)) // we have too keep the odering: it may be needed
2655                            // for G-algebra
2656  {
2657    for (k=0;k<ordersize-1; k++)
2658    {
2659      block0[k+1] = origR->block0[k];
2660      block1[k+1] = origR->block1[k];
2661      ord[k+1] = origR->order[k];
2662      if (origR->wvhdl[k]!=NULL) wv[k+1] = (int*) omMemDup(origR->wvhdl[k]);
2663    }
2664  }
2665  else
2666  {
2667    block0[1] = 1;
2668    block1[1] = pVariables;
2669    if (origR->OrdSgn==1) ord[1] = ringorder_wp;
2670    else                  ord[1] = ringorder_ws;
2671    wv[1]=(int*)omAlloc0(pVariables*sizeof(int));
2672    double wNsqr = (double)2.0 / (double)pVariables;
2673    wFunctional = wFunctionalBuch;
2674    int  *x= (int * )omAlloc(2 * (pVariables + 1) * sizeof(int));
2675    int sl=IDELEMS(h1) - 1;
2676    wCall(h1->m, sl, x, wNsqr);
2677    for (sl = pVariables; sl!=0; sl--)
2678      wv[1][sl-1] = x[sl + pVariables + 1];
2679    omFreeSize((ADDRESS)x, 2 * (pVariables + 1) * sizeof(int));
2680
2681    ord[2]=ringorder_C;
2682    ord[3]=0;
2683  }
2684#else
2685#endif
2686  if ((hom==TRUE) && (origR->OrdSgn==1) && (!rIsPluralRing(origR)))
2687  {
2688    #if 1
2689    // we change to an ordering:
2690    // aa(1,1,1,...,0,0,0),wp(...),C
2691    // this seems to be better than version 2 below,
2692    // according to Tst/../elimiate_[3568].tat (- 17 %)
2693    ord=(int*)omAlloc0(4*sizeof(int));
2694    block0=(int*)omAlloc0(4*sizeof(int));
2695    block1=(int*)omAlloc0(4*sizeof(int));
2696    wv=(int**) omAlloc0(4*sizeof(int**));
2697    block0[0] = block0[1] = 1;
2698    block1[0] = block1[1] = rVar(origR);
2699    wv[0]=(int*)omAlloc0((rVar(origR) + 1)*sizeof(int));
2700    // use this special ordering: like ringorder_a, except that pFDeg, pWeights
2701    // ignore it
2702    ord[0] = ringorder_aa;
2703    for (j=0;j<rVar(origR);j++)
2704      if (pGetExp(delVar,j+1)!=0) wv[0][j]=1;
2705    BOOLEAN wp=FALSE;
2706    for (j=0;j<rVar(origR);j++)
2707      if (pWeight(j+1,origR)!=1) { wp=TRUE;break; }
2708    if (wp)
2709    {
2710      wv[1]=(int*)omAlloc0((rVar(origR) + 1)*sizeof(int));
2711      for (j=0;j<rVar(origR);j++)
2712        wv[1][j]=pWeight(j+1,origR);
2713      ord[1] = ringorder_wp;
2714    }
2715    else
2716      ord[1] = ringorder_dp;
2717    #else
2718    // we change to an ordering:
2719    // a(w1,...wn),wp(1,...0.....),C
2720    ord=(int*)omAlloc0(4*sizeof(int));
2721    block0=(int*)omAlloc0(4*sizeof(int));
2722    block1=(int*)omAlloc0(4*sizeof(int));
2723    wv=(int**) omAlloc0(4*sizeof(int**));
2724    block0[0] = block0[1] = 1;
2725    block1[0] = block1[1] = rVar(origR);
2726    wv[0]=(int*)omAlloc0((rVar(origR) + 1)*sizeof(int));
2727    wv[1]=(int*)omAlloc0((rVar(origR) + 1)*sizeof(int));
2728    ord[0] = ringorder_a;
2729    for (j=0;j<rVar(origR);j++)
2730      wv[0][j]=pWeight(j+1,origR);
2731    ord[1] = ringorder_wp;
2732    for (j=0;j<rVar(origR);j++)
2733      if (pGetExp(delVar,j+1)!=0) wv[1][j]=1;
2734    #endif
2735    ord[2] = ringorder_C;
2736    ord[3] = 0;
2737  }
2738  else
2739  {
2740    // we change to an ordering:
2741    // aa(....),orig_ordering
2742    ord=(int*)omAlloc0(ordersize*sizeof(int));
2743    block0=(int*)omAlloc0(ordersize*sizeof(int));
2744    block1=(int*)omAlloc0(ordersize*sizeof(int));
2745    wv=(int**) omAlloc0(ordersize*sizeof(int**));
2746    for (k=0;k<ordersize-1; k++)
2747    {
2748      block0[k+1] = origR->block0[k];
2749      block1[k+1] = origR->block1[k];
2750      ord[k+1] = origR->order[k];
2751      if (origR->wvhdl[k]!=NULL) wv[k+1] = (int*) omMemDup(origR->wvhdl[k]);
2752    }
2753    block0[0] = 1;
2754    block1[0] = rVar(origR);
2755    wv[0]=(int*)omAlloc0((rVar(origR) + 1)*sizeof(int));
2756    for (j=0;j<rVar(origR);j++)
2757      if (pGetExp(delVar,j+1)!=0) wv[0][j]=1;
2758    // use this special ordering: like ringorder_a, except that pFDeg, pWeights
2759    // ignore it
2760    ord[0] = ringorder_aa;
2761  }
2762  // fill in tmp ring to get back the data later on
2763  tmpR  = rCopy0(origR,FALSE,FALSE); // qring==NULL
2764  //rUnComplete(tmpR);
2765  tmpR->p_Procs=NULL;
2766  tmpR->order = ord;
2767  tmpR->block0 = block0;
2768  tmpR->block1 = block1;
2769  tmpR->wvhdl = wv;
2770  rComplete(tmpR, 1);
2771
2772#ifdef HAVE_PLURAL
2773  /* update nc structure on tmpR */
2774  if (rIsPluralRing(origR))
2775  {
2776    if ( nc_rComplete(origR, tmpR, false) ) // no quotient ideal!
2777    {
2778      Werror("no elimination is possible: ordering condition is violated");
2779      // cleanup
2780      rDelete(tmpR);
2781      if (w!=NULL)
2782        delete w;
2783      return idCopy(h1);
2784    }
2785  }
2786#endif
2787  // change into the new ring
2788  //pChangeRing(pVariables,currRing->OrdSgn,ord,block0,block1,wv);
2789  rChangeCurrRing(tmpR);
2790
2791  //h = idInit(IDELEMS(h1),h1->rank);
2792  // fetch data from the old ring
2793  //for (k=0;k<IDELEMS(h1);k++) h->m[k] = prCopyR( h1->m[k], origR);
2794  h=idrCopyR(h1,origR,currRing);
2795  if (origR->qideal!=NULL)
2796  {
2797    WarnS("eliminate in q-ring: experimental");
2798    ideal q=idrCopyR(origR->qideal,origR,currRing);
2799    ideal s=idSimpleAdd(h,q);
2800    idDelete(&h);
2801    idDelete(&q);
2802    h=s;
2803  }
2804  // compute kStd
2805#if 1
2806  //rWrite(tmpR);PrintLn();
2807  BITSET save=test;
2808  //test |=1;
2809  //Print("h: %d gen, rk=%d\n",IDELEMS(h),h->rank);
2810  //extern char * showOption();
2811  //Print("%s\n",showOption());
2812  hh = kStd(h,NULL,hom,&w,hilb);
2813  test=save;
2814  idDelete(&h);
2815#else
2816  extern ideal kGroebner(ideal F, ideal Q);
2817  hh=kGroebner(h,NULL);
2818#endif
2819  // go back to the original ring
2820  rChangeCurrRing(origR);
2821  i = IDELEMS(hh)-1;
2822  while ((i >= 0) && (hh->m[i] == NULL)) i--;
2823  j = -1;
2824  // fetch data from temp ring
2825  for (k=0; k<=i; k++)
2826  {
2827    l=pVariables;
2828    while ((l>0) && (p_GetExp( hh->m[k],l,tmpR)*pGetExp(delVar,l)==0)) l--;
2829    if (l==0)
2830    {
2831      j++;
2832      if (j >= IDELEMS(h3))
2833      {
2834        pEnlargeSet(&(h3->m),IDELEMS(h3),16);
2835        IDELEMS(h3) += 16;
2836      }
2837      h3->m[j] = prMoveR( hh->m[k], tmpR);
2838      hh->m[k] = NULL;
2839    }
2840  }
2841  id_Delete(&hh, tmpR);
2842  idSkipZeroes(h3);
2843  rDelete(tmpR);
2844  if (w!=NULL)
2845    delete w;
2846  return h3;
2847}
2848
2849/*2
2850* compute the which-th ar-minor of the matrix a
2851*/
2852poly idMinor(matrix a, int ar, unsigned long which, ideal R)
2853{
2854  int     i,j,k,size;
2855  unsigned long curr;
2856  int *rowchoise,*colchoise;
2857  BOOLEAN rowch,colch;
2858  ideal result;
2859  matrix tmp;
2860  poly p,q;
2861
2862  i = binom(a->rows(),ar);
2863  j = binom(a->cols(),ar);
2864
2865  rowchoise=(int *)omAlloc(ar*sizeof(int));
2866  colchoise=(int *)omAlloc(ar*sizeof(int));
2867  if ((i>512) || (j>512) || (i*j >512)) size=512;
2868  else size=i*j;
2869  result=idInit(size,1);
2870  tmp=mpNew(ar,ar);
2871  k = 0; /* the index in result*/
2872  curr = 0; /* index of current minor */
2873  idInitChoise(ar,1,a->rows(),&rowch,rowchoise);
2874  while (!rowch)
2875  {
2876    idInitChoise(ar,1,a->cols(),&colch,colchoise);
2877    while (!colch)
2878    {
2879      if (curr == which)
2880      {
2881        for (i=1; i<=ar; i++)
2882        {
2883          for (j=1; j<=ar; j++)
2884          {
2885            MATELEM(tmp,i,j) = MATELEM(a,rowchoise[i-1],colchoise[j-1]);
2886          }
2887        }
2888        p = mpDetBareiss(tmp);
2889        if (p!=NULL)
2890        {
2891          if (R!=NULL)
2892          {
2893            q = p;
2894            p = kNF(R,currQuotient,q);
2895            pDelete(&q);
2896          }
2897          /*delete the matrix tmp*/
2898          for (i=1; i<=ar; i++)
2899          {
2900            for (j=1; j<=ar; j++) MATELEM(tmp,i,j) = NULL;
2901          }
2902          idDelete((ideal*)&tmp);
2903          omFreeSize((ADDRESS)rowchoise,ar*sizeof(int));
2904          omFreeSize((ADDRESS)colchoise,ar*sizeof(int));
2905          return (p);
2906        }
2907      }
2908      curr++;
2909      idGetNextChoise(ar,a->cols(),&colch,colchoise);
2910    }
2911    idGetNextChoise(ar,a->rows(),&rowch,rowchoise);
2912  }
2913  return (poly) 1;
2914}
2915
2916#ifdef WITH_OLD_MINOR
2917/*2
2918* compute all ar-minors of the matrix a
2919*/
2920ideal idMinors(matrix a, int ar, ideal R)
2921{
2922  int     i,j,k,size;
2923  int *rowchoise,*colchoise;
2924  BOOLEAN rowch,colch;
2925  ideal result;
2926  matrix tmp;
2927  poly p,q;
2928
2929  i = binom(a->rows(),ar);
2930  j = binom(a->cols(),ar);
2931
2932  rowchoise=(int *)omAlloc(ar*sizeof(int));
2933  colchoise=(int *)omAlloc(ar*sizeof(int));
2934  if ((i>512) || (j>512) || (i*j >512)) size=512;
2935  else size=i*j;
2936  result=idInit(size,1);
2937  tmp=mpNew(ar,ar);
2938  k = 0; /* the index in result*/
2939  idInitChoise(ar,1,a->rows(),&rowch,rowchoise);
2940  while (!rowch)
2941  {
2942    idInitChoise(ar,1,a->cols(),&colch,colchoise);
2943    while (!colch)
2944    {
2945      for (i=1; i<=ar; i++)
2946      {
2947        for (j=1; j<=ar; j++)
2948        {
2949          MATELEM(tmp,i,j) = MATELEM(a,rowchoise[i-1],colchoise[j-1]);
2950        }
2951      }
2952      p = mpDetBareiss(tmp);
2953      if (p!=NULL)
2954      {
2955        if (R!=NULL)
2956        {
2957          q = p;
2958          p = kNF(R,currQuotient,q);
2959          pDelete(&q);
2960        }
2961        if (p!=NULL)
2962        {
2963          if (k>=size)
2964          {
2965            pEnlargeSet(&result->m,size,32);
2966            size += 32;
2967          }
2968          result->m[k] = p;
2969          k++;
2970        }
2971      }
2972      idGetNextChoise(ar,a->cols(),&colch,colchoise);
2973    }
2974    idGetNextChoise(ar,a->rows(),&rowch,rowchoise);
2975  }
2976  /*delete the matrix tmp*/
2977  for (i=1; i<=ar; i++)
2978  {
2979    for (j=1; j<=ar; j++) MATELEM(tmp,i,j) = NULL;
2980  }
2981  idDelete((ideal*)&tmp);
2982  if (k==0)
2983  {
2984    k=1;
2985    result->m[0]=NULL;
2986  }
2987  omFreeSize((ADDRESS)rowchoise,ar*sizeof(int));
2988  omFreeSize((ADDRESS)colchoise,ar*sizeof(int));
2989  pEnlargeSet(&result->m,size,k-size);
2990  IDELEMS(result) = k;
2991  return (result);
2992}
2993#else
2994/*2
2995* compute all ar-minors of the matrix a
2996* the caller of mpRecMin
2997* the elements of the result are not in R (if R!=NULL)
2998*/
2999ideal idMinors(matrix a, int ar, ideal R)
3000{
3001  int elems=0;
3002  int r=a->nrows,c=a->ncols;
3003  int i;
3004  matrix b;
3005  ideal result,h;
3006  ring origR;
3007  ring tmpR;
3008  long bound;
3009
3010  if((ar<=0) || (ar>r) || (ar>c))
3011  {
3012    Werror("%d-th minor, matrix is %dx%d",ar,r,c);
3013    return NULL;
3014  }
3015  h = idMatrix2Module(mpCopy(a));
3016  bound = smExpBound(h,c,r,ar);
3017  idDelete(&h);
3018  tmpR=smRingChange(&origR,bound);
3019  b = mpNew(r,c);
3020  for (i=r*c-1;i>=0;i--)
3021  {
3022    if (a->m[i])
3023      b->m[i] = prCopyR(a->m[i],origR);
3024  }
3025  if (R!=NULL)
3026  {
3027    R = idrCopyR(R,origR);
3028    //if (ar>1) // otherwise done in mpMinorToResult
3029    //{
3030    //  matrix bb=(matrix)kNF(R,currQuotient,(ideal)b);
3031    //  bb->rank=b->rank; bb->nrows=b->nrows; bb->ncols=b->ncols;
3032    //  idDelete((ideal*)&b); b=bb;
3033    //}
3034  }
3035  result=idInit(32,1);
3036  if(ar>1) mpRecMin(ar-1,result,elems,b,r,c,NULL,R);
3037  else mpMinorToResult(result,elems,b,r,c,R);
3038  idDelete((ideal *)&b);
3039  if (R!=NULL) idDelete(&R);
3040  idSkipZeroes(result);
3041  rChangeCurrRing(origR);
3042  result = idrMoveR(result,tmpR);
3043  smKillModifiedRing(tmpR);
3044  idTest(result);
3045  return result;
3046}
3047#endif
3048
3049/*2
3050*skips all zeroes and double elements, searches also for units
3051*/
3052void idCompactify(ideal id)
3053{
3054  int i,j;
3055  BOOLEAN b=FALSE;
3056
3057  i = IDELEMS(id)-1;
3058  while ((! b) && (i>=0))
3059  {
3060    b=pIsUnit(id->m[i]);
3061    i--;
3062  }
3063  if (b)
3064  {
3065    for(i=IDELEMS(id)-1;i>=0;i--) pDelete(&id->m[i]);
3066    id->m[0]=pOne();
3067  }
3068  else
3069  {
3070    idDelMultiples(id);
3071  }
3072  idSkipZeroes(id);
3073}
3074
3075/*2
3076*returns TRUE if id1 is a submodule of id2
3077*/
3078BOOLEAN idIsSubModule(ideal id1,ideal id2)
3079{
3080  int i;
3081  poly p;
3082
3083  if (idIs0(id1)) return TRUE;
3084  for (i=0;i<IDELEMS(id1);i++)
3085  {
3086    if (id1->m[i] != NULL)
3087    {
3088      p = kNF(id2,currQuotient,id1->m[i]);
3089      if (p != NULL)
3090      {
3091        pDelete(&p);
3092        return FALSE;
3093      }
3094    }
3095  }
3096  return TRUE;
3097}
3098
3099/*2
3100* returns the ideals of initial terms
3101*/
3102ideal idHead(ideal h)
3103{
3104  ideal m = idInit(IDELEMS(h),h->rank);
3105  int i;
3106
3107  for (i=IDELEMS(h)-1;i>=0; i--)
3108  {
3109    if (h->m[i]!=NULL) m->m[i]=pHead(h->m[i]);
3110  }
3111  return m;
3112}
3113
3114ideal idHomogen(ideal h, int varnum)
3115{
3116  ideal m = idInit(IDELEMS(h),h->rank);
3117  int i;
3118
3119  for (i=IDELEMS(h)-1;i>=0; i--)
3120  {
3121    m->m[i]=pHomogen(h->m[i],varnum);
3122  }
3123  return m;
3124}
3125
3126/*------------------type conversions----------------*/
3127ideal idVec2Ideal(poly vec)
3128{
3129   ideal result=idInit(1,1);
3130   omFree((ADDRESS)result->m);
3131   result->m=NULL; // remove later
3132   pVec2Polys(vec, &(result->m), &(IDELEMS(result)));
3133   return result;
3134}
3135
3136#define NEW_STUFF
3137#ifndef NEW_STUFF
3138// converts mat to module, destroys mat
3139ideal idMatrix2Module(matrix mat)
3140{
3141  int mc=MATCOLS(mat);
3142  int mr=MATROWS(mat);
3143  ideal result = idInit(si_max(mc,1),si_max(mr,1));
3144  int i,j;
3145  poly h;
3146
3147  for(j=0;j<mc /*MATCOLS(mat)*/;j++) /* j is also index in result->m */
3148  {
3149    for (i=1;i<=mr /*MATROWS(mat)*/;i++)
3150    {
3151      h = MATELEM(mat,i,j+1);
3152      if (h!=NULL)
3153      {
3154        MATELEM(mat,i,j+1)=NULL;
3155        pSetCompP(h,i);
3156        result->m[j] = pAdd(result->m[j],h);
3157      }
3158    }
3159  }
3160  // obachman: need to clean this up
3161  idDelete((ideal*) &mat);
3162  return result;
3163}
3164#else
3165
3166#include <kernel/sbuckets.h>
3167
3168// converts mat to module, destroys mat
3169ideal idMatrix2Module(matrix mat)
3170{
3171  int mc=MATCOLS(mat);
3172  int mr=MATROWS(mat);
3173  ideal result = idInit(si_max(mc,1),si_max(mr,1));
3174  int i,j, l;
3175  poly h;
3176  poly p;
3177  sBucket_pt bucket = sBucketCreate(currRing);
3178
3179  for(j=0;j<mc /*MATCOLS(mat)*/;j++) /* j is also index in result->m */
3180  {
3181    for (i=1;i<=mr /*MATROWS(mat)*/;i++)
3182    {
3183      h = MATELEM(mat,i,j+1);
3184      if (h!=NULL)
3185      {
3186        l=pLength(h);
3187        MATELEM(mat,i,j+1)=NULL;
3188        p_SetCompP(h,i, currRing);
3189        sBucket_Merge_p(bucket, h, l);
3190      }
3191    }
3192    sBucketClearMerge(bucket, &(result->m[j]), &l);
3193  }
3194  sBucketDestroy(&bucket);
3195
3196  // obachman: need to clean this up
3197  idDelete((ideal*) &mat);
3198  return result;
3199}
3200#endif
3201
3202/*2
3203* converts a module into a matrix, destroyes the input
3204*/
3205matrix idModule2Matrix(ideal mod)
3206{
3207  matrix result = mpNew(mod->rank,IDELEMS(mod));
3208  int i,cp;
3209  poly p,h;
3210
3211  for(i=0;i<IDELEMS(mod);i++)
3212  {
3213    p=pReverse(mod->m[i]);
3214    mod->m[i]=NULL;
3215    while (p!=NULL)
3216    {
3217      h=p;
3218      pIter(p);
3219      pNext(h)=NULL;
3220//      cp = si_max(1,pGetComp(h));     // if used for ideals too
3221      cp = pGetComp(h);
3222      pSetComp(h,0);
3223      pSetmComp(h);
3224#ifdef TEST
3225      if (cp>mod->rank)
3226      {
3227        Print("## inv. rank %ld -> %d\n",mod->rank,cp);
3228        int k,l,o=mod->rank;
3229        mod->rank=cp;
3230        matrix d=mpNew(mod->rank,IDELEMS(mod));
3231        for (l=1; l<=o; l++)
3232        {
3233          for (k=1; k<=IDELEMS(mod); k++)
3234          {
3235            MATELEM(d,l,k)=MATELEM(result,l,k);
3236            MATELEM(result,l,k)=NULL;
3237          }
3238        }
3239        idDelete((ideal *)&result);
3240        result=d;
3241      }
3242#endif
3243      MATELEM(result,cp,i+1) = pAdd(MATELEM(result,cp,i+1),h);
3244    }
3245  }
3246  // obachman 10/99: added the following line, otherwise memory leack!
3247  idDelete(&mod);
3248  return result;
3249}
3250
3251matrix idModule2formatedMatrix(ideal mod,int rows, int cols)
3252{
3253  matrix result = mpNew(rows,cols);
3254  int i,cp,r=idRankFreeModule(mod),c=IDELEMS(mod);
3255  poly p,h;
3256
3257  if (r>rows) r = rows;
3258  if (c>cols) c = cols;
3259  for(i=0;i<c;i++)
3260  {
3261    p=pReverse(mod->m[i]);
3262    mod->m[i]=NULL;
3263    while (p!=NULL)
3264    {
3265      h=p;
3266      pIter(p);
3267      pNext(h)=NULL;
3268      cp = pGetComp(h);
3269      if (cp<=r)
3270      {
3271        pSetComp(h,0);
3272        pSetmComp(h);
3273        MATELEM(result,cp,i+1) = pAdd(MATELEM(result,cp,i+1),h);
3274      }
3275      else
3276        pDelete(&h);
3277    }
3278  }
3279  idDelete(&mod);
3280  return result;
3281}
3282
3283/*2
3284* substitute the n-th variable by the monomial e in id
3285* destroy id
3286*/
3287ideal  idSubst(ideal id, int n, poly e)
3288{
3289  int k=MATROWS((matrix)id)*MATCOLS((matrix)id);
3290  ideal res=(ideal)mpNew(MATROWS((matrix)id),MATCOLS((matrix)id));
3291
3292  res->rank = id->rank;
3293  for(k--;k>=0;k--)
3294  {
3295    res->m[k]=pSubst(id->m[k],n,e);
3296    id->m[k]=NULL;
3297  }
3298  idDelete(&id);
3299  return res;
3300}
3301
3302BOOLEAN idHomModule(ideal m, ideal Q, intvec **w)
3303{
3304  if (w!=NULL) *w=NULL;
3305  if ((Q!=NULL) && (!idHomIdeal(Q,NULL))) return FALSE;
3306  if (idIs0(m))
3307  {
3308    if (w!=NULL) (*w)=new intvec(m->rank);
3309    return TRUE;
3310  }
3311
3312  long cmax=1,order=0,ord,* diff,diffmin=32000;
3313  int *iscom;
3314  int i,j;
3315  poly p=NULL;
3316  pFDegProc d;
3317  if (pLexOrder && (currRing->order[0]==ringorder_lp))
3318     d=p_Totaldegree;
3319  else
3320     d=pFDeg;
3321  int length=IDELEMS(m);
3322  polyset P=m->m;
3323  polyset F=(polyset)omAlloc(length*sizeof(poly));
3324  for (i=length-1;i>=0;i--)
3325  {
3326    p=F[i]=P[i];
3327    cmax=si_max(cmax,(long)pMaxComp(p));
3328  }
3329  cmax++;
3330  diff = (long *)omAlloc0(cmax*sizeof(long));
3331  if (w!=NULL) *w=new intvec(cmax-1);
3332  iscom = (int *)omAlloc0(cmax*sizeof(int));
3333  i=0;
3334  while (i<=length)
3335  {
3336    if (i<length)
3337    {
3338      p=F[i];
3339      while ((p!=NULL) && (iscom[pGetComp(p)]==0)) pIter(p);
3340    }
3341    if ((p==NULL) && (i<length))
3342    {
3343      i++;
3344    }
3345    else
3346    {
3347      if (p==NULL) /* && (i==length) */
3348      {
3349        i=0;
3350        while ((i<length) && (F[i]==NULL)) i++;
3351        if (i>=length) break;
3352        p = F[i];
3353      }
3354      //if (pLexOrder && (currRing->order[0]==ringorder_lp))
3355      //  order=pTotaldegree(p);
3356      //else
3357      //  order = p->order;
3358      //  order = pFDeg(p,currRing);
3359      order = d(p,currRing) +diff[pGetComp(p)];
3360      //order += diff[pGetComp(p)];
3361      p = F[i];
3362//Print("Actual p=F[%d]: ",i);pWrite(p);
3363      F[i] = NULL;
3364      i=0;
3365    }
3366    while (p!=NULL)
3367    {
3368      if (pLexOrder && (currRing->order[0]==ringorder_lp))
3369        ord=pTotaldegree(p);
3370      else
3371      //  ord = p->order;
3372        ord = pFDeg(p,currRing);
3373      if (iscom[pGetComp(p)]==0)
3374      {
3375        diff[pGetComp(p)] = order-ord;
3376        iscom[pGetComp(p)] = 1;
3377/*
3378*PrintS("new diff: ");
3379*for (j=0;j<cmax;j++) Print("%d ",diff[j]);
3380*PrintLn();
3381*PrintS("new iscom: ");
3382*for (j=0;j<cmax;j++) Print("%d ",iscom[j]);
3383*PrintLn();
3384*Print("new set %d, order %d, ord %d, diff %d\n",pGetComp(p),order,ord,diff[pGetComp(p)]);
3385*/
3386      }
3387      else
3388      {
3389/*
3390*PrintS("new diff: ");
3391*for (j=0;j<cmax;j++) Print("%d ",diff[j]);
3392*PrintLn();
3393*Print("order %d, ord %d, diff %d\n",order,ord,diff[pGetComp(p)]);
3394*/
3395        if (order != (ord+diff[pGetComp(p)]))
3396        {
3397          omFreeSize((ADDRESS) iscom,cmax*sizeof(int));
3398          omFreeSize((ADDRESS) diff,cmax*sizeof(long));
3399          omFreeSize((ADDRESS) F,length*sizeof(poly));
3400          delete *w;*w=NULL;
3401          return FALSE;
3402        }
3403      }
3404      pIter(p);
3405    }
3406  }
3407  omFreeSize((ADDRESS) iscom,cmax*sizeof(int));
3408  omFreeSize((ADDRESS) F,length*sizeof(poly));
3409  for (i=1;i<cmax;i++) (**w)[i-1]=(int)(diff[i]);
3410  for (i=1;i<cmax;i++)
3411  {
3412    if (diff[i]<diffmin) diffmin=diff[i];
3413  }
3414  if (w!=NULL)
3415  {
3416    for (i=1;i<cmax;i++)
3417    {
3418      (**w)[i-1]=(int)(diff[i]-diffmin);
3419    }
3420  }
3421  omFreeSize((ADDRESS) diff,cmax*sizeof(long));
3422  return TRUE;
3423}
3424
3425BOOLEAN idTestHomModule(ideal m, ideal Q, intvec *w)
3426{
3427  if ((Q!=NULL) && (!idHomIdeal(Q,NULL)))  { PrintS(" Q not hom\n"); return FALSE;}
3428  if (idIs0(m)) return TRUE;
3429
3430  int cmax=-1;
3431  int i;
3432  poly p=NULL;
3433  int length=IDELEMS(m);
3434  polyset P=m->m;
3435  for (i=length-1;i>=0;i--)
3436  {
3437    p=P[i];
3438    if (p!=NULL) cmax=si_max(cmax,(int)pMaxComp(p)+1);
3439  }
3440  if (w != NULL)
3441  if (w->length()+1 < cmax)
3442  {
3443    // Print("length: %d - %d \n", w->length(),cmax);
3444    return FALSE;
3445  }
3446
3447  if(w!=NULL)
3448    pSetModDeg(w);
3449
3450  for (i=length-1;i>=0;i--)
3451  {
3452    p=P[i];
3453    poly q=p;
3454    if (p!=NULL)
3455    {
3456      int d=pFDeg(p,currRing);
3457      loop
3458      {
3459        pIter(p);
3460        if (p==NULL) break;
3461        if (d!=pFDeg(p,currRing))
3462        {
3463          //pWrite(q); wrp(p); Print(" -> %d - %d\n",d,pFDeg(p,currRing));
3464          if(w!=NULL)
3465            pSetModDeg(NULL);
3466          return FALSE;
3467        }
3468      }
3469    }
3470  }
3471
3472  if(w!=NULL)
3473    pSetModDeg(NULL);
3474
3475  return TRUE;
3476}
3477
3478ideal idJet(ideal i,int d)
3479{
3480  ideal r=idInit((i->nrows)*(i->ncols),i->rank);
3481  r->nrows = i-> nrows;
3482  r->ncols = i-> ncols;
3483  //r->rank = i-> rank;
3484  int k;
3485  for(k=(i->nrows)*(i->ncols)-1;k>=0; k--)
3486  {
3487    r->m[k]=ppJet(i->m[k],d);
3488  }
3489  return r;
3490}
3491
3492ideal idJetW(ideal i,int d, intvec * iv)
3493{
3494  ideal r=idInit(IDELEMS(i),i->rank);
3495  if (ecartWeights!=NULL)
3496  {
3497    WerrorS("cannot compute weighted jets now");
3498  }
3499  else
3500  {
3501    short *w=iv2array(iv);
3502    int k;
3503    for(k=0; k<IDELEMS(i); k++)
3504    {
3505      r->m[k]=ppJetW(i->m[k],d,w);
3506    }
3507    omFreeSize((ADDRESS)w,(pVariables+1)*sizeof(short));
3508  }
3509  return r;
3510}
3511
3512int idMinDegW(ideal M,intvec *w)
3513{
3514  int d=-1;
3515  for(int i=0;i<IDELEMS(M);i++)
3516  {
3517    int d0=pMinDeg(M->m[i],w);
3518    if(-1<d0&&(d0<d||d==-1))
3519      d=d0;
3520  }
3521  return d;
3522}
3523
3524ideal idSeries(int n,ideal M,matrix U,intvec *w)
3525{
3526  for(int i=IDELEMS(M)-1;i>=0;i--)
3527  {
3528    if(U==NULL)
3529      M->m[i]=pSeries(n,M->m[i],NULL,w);
3530    else
3531    {
3532      M->m[i]=pSeries(n,M->m[i],MATELEM(U,i+1,i+1),w);
3533      MATELEM(U,i+1,i+1)=NULL;
3534    }
3535  }
3536  if(U!=NULL)
3537    idDelete((ideal*)&U);
3538  return M;
3539}
3540
3541matrix idDiff(matrix i, int k)
3542{
3543  int e=MATCOLS(i)*MATROWS(i);
3544  matrix r=mpNew(MATROWS(i),MATCOLS(i));
3545  r->rank=i->rank;
3546  int j;
3547  for(j=0; j<e; j++)
3548  {
3549    r->m[j]=pDiff(i->m[j],k);
3550  }
3551  return r;
3552}
3553
3554matrix idDiffOp(ideal I, ideal J,BOOLEAN multiply)
3555{
3556  matrix r=mpNew(IDELEMS(I),IDELEMS(J));
3557  int i,j;
3558  for(i=0; i<IDELEMS(I); i++)
3559  {
3560    for(j=0; j<IDELEMS(J); j++)
3561    {
3562      MATELEM(r,i+1,j+1)=pDiffOp(I->m[i],J->m[j],multiply);
3563    }
3564  }
3565  return r;
3566}
3567
3568/*3
3569*handles for some ideal operations the ring/syzcomp managment
3570*returns all syzygies (componentwise-)shifted by -syzcomp
3571*or -syzcomp-1 (in case of ideals as input)
3572static ideal idHandleIdealOp(ideal arg,int syzcomp,int isIdeal=FALSE)
3573{
3574  ring orig_ring=currRing;
3575  ring syz_ring=rCurrRingAssure_SyzComp();
3576  rSetSyzComp(length);
3577
3578  ideal s_temp;
3579  if (orig_ring!=syz_ring)
3580    s_temp=idrMoveR_NoSort(arg,orig_ring);
3581  else
3582    s_temp=arg;
3583
3584  ideal s_temp1 = kStd(s_temp,currQuotient,testHomog,&w,NULL,length);
3585  if (w!=NULL) delete w;
3586
3587  if (syz_ring!=orig_ring)
3588  {
3589    idDelete(&s_temp);
3590    rChangeCurrRing(orig_ring);
3591  }
3592
3593  idDelete(&temp);
3594  ideal temp1=idRingCopy(s_temp1,syz_ring);
3595
3596  if (syz_ring!=orig_ring)
3597  {
3598    rChangeCurrRing(syz_ring);
3599    idDelete(&s_temp1);
3600    rChangeCurrRing(orig_ring);
3601    rKill(syz_ring);
3602  }
3603
3604  for (i=0;i<IDELEMS(temp1);i++)
3605  {
3606    if ((temp1->m[i]!=NULL)
3607    && (pGetComp(temp1->m[i])<=length))
3608    {
3609      pDelete(&(temp1->m[i]));
3610    }
3611    else
3612    {
3613      pShift(&(temp1->m[i]),-length);
3614    }
3615  }
3616  temp1->rank = rk;
3617  idSkipZeroes(temp1);
3618
3619  return temp1;
3620}
3621*/
3622/*2
3623* represents (h1+h2)/h2=h1/(h1 intersect h2)
3624*/
3625//ideal idModulo (ideal h2,ideal h1)
3626ideal idModulo (ideal h2,ideal h1, tHomog hom, intvec ** w)
3627{
3628  intvec *wtmp=NULL;
3629
3630  int i,j,k,rk,flength=0,slength,length;
3631  poly p,q;
3632
3633  if (idIs0(h2))
3634    return idFreeModule(si_max(1,h2->ncols));
3635  if (!idIs0(h1))
3636    flength = idRankFreeModule(h1);
3637  slength = idRankFreeModule(h2);
3638  length  = si_max(flength,slength);
3639  if (length==0)
3640  {
3641    length = 1;
3642  }
3643  ideal temp = idInit(IDELEMS(h2),length+IDELEMS(h2));
3644  if ((w!=NULL)&&((*w)!=NULL))
3645  {
3646    //Print("input weights:");(*w)->show(1);PrintLn();
3647    int d;
3648    int k;
3649    wtmp=new intvec(length+IDELEMS(h2));
3650    for (i=0;i<length;i++)
3651      ((*wtmp)[i])=(**w)[i];
3652    for (i=0;i<IDELEMS(h2);i++)
3653    {
3654      poly p=h2->m[i];
3655      if (p!=NULL)
3656      {
3657        d = pDeg(p);
3658        k= pGetComp(p);
3659        if (slength>0) k--;
3660        d +=((**w)[k]);
3661        ((*wtmp)[i+length]) = d;
3662      }
3663    }
3664    //Print("weights:");wtmp->show(1);PrintLn();
3665  }
3666  for (i=0;i<IDELEMS(h2);i++)
3667  {
3668    temp->m[i] = pCopy(h2->m[i]);
3669    q = pOne();
3670    pSetComp(q,i+1+length);
3671    pSetmComp(q);
3672    if(temp->m[i]!=NULL)
3673    {
3674      if (slength==0) pShift(&(temp->m[i]),1);
3675      p = temp->m[i];
3676      while (pNext(p)!=NULL) pIter(p);
3677      pNext(p) = q;
3678    }
3679    else
3680      temp->m[i]=q;
3681  }
3682  rk = k = IDELEMS(h2);
3683  if (!idIs0(h1))
3684  {
3685    pEnlargeSet(&(temp->m),IDELEMS(temp),IDELEMS(h1));
3686    IDELEMS(temp) += IDELEMS(h1);
3687    for (i=0;i<IDELEMS(h1);i++)
3688    {
3689      if (h1->m[i]!=NULL)
3690      {
3691        temp->m[k] = pCopy(h1->m[i]);
3692        if (flength==0) pShift(&(temp->m[k]),1);
3693        k++;
3694      }
3695    }
3696  }
3697
3698  ring orig_ring=currRing;
3699  ring syz_ring=rCurrRingAssure_SyzComp();
3700  rSetSyzComp(length);
3701  ideal s_temp;
3702
3703  if (syz_ring != orig_ring)
3704  {
3705    s_temp = idrMoveR_NoSort(temp, orig_ring);
3706  }
3707  else
3708  {
3709    s_temp = temp;
3710  }
3711
3712  idTest(s_temp);
3713  ideal s_temp1 = kStd(s_temp,currQuotient,hom,&wtmp,NULL,length);
3714
3715  //if (wtmp!=NULL)  Print("output weights:");wtmp->show(1);PrintLn();
3716  if ((w!=NULL) && (*w !=NULL) && (wtmp!=NULL))
3717  {
3718    delete *w;
3719    *w=new intvec(IDELEMS(h2));
3720    for (i=0;i<IDELEMS(h2);i++)
3721      ((**w)[i])=(*wtmp)[i+length];
3722  }
3723  if (wtmp!=NULL) delete wtmp;
3724
3725  for (i=0;i<IDELEMS(s_temp1);i++)
3726  {
3727    if ((s_temp1->m[i]!=NULL)
3728    && (pGetComp(s_temp1->m[i])<=length))
3729    {
3730      pDelete(&(s_temp1->m[i]));
3731    }
3732    else
3733    {
3734      pShift(&(s_temp1->m[i]),-length);
3735    }
3736  }
3737  s_temp1->rank = rk;
3738  idSkipZeroes(s_temp1);
3739
3740  if (syz_ring!=orig_ring)
3741  {
3742    rChangeCurrRing(orig_ring);
3743    s_temp1 = idrMoveR_NoSort(s_temp1, syz_ring);
3744    rKill(syz_ring);
3745    // Hmm ... here seems to be a memory leak
3746    // However, simply deleting it causes memory trouble
3747    // idDelete(&s_temp);
3748  }
3749  else
3750  {
3751    idDelete(&temp);
3752  }
3753  idTest(s_temp1);
3754  return s_temp1;
3755}
3756
3757int idElem(const ideal F)
3758{
3759  int i=0,j=IDELEMS(F)-1;
3760
3761  while(j>=0)
3762  {
3763    if ((F->m)[j]!=NULL) i++;
3764    j--;
3765  }
3766  return i;
3767}
3768
3769/*
3770*computes module-weights for liftings of homogeneous modules
3771*/
3772intvec * idMWLift(ideal mod,intvec * weights)
3773{
3774  if (idIs0(mod)) return new intvec(2);
3775  int i=IDELEMS(mod);
3776  while ((i>0) && (mod->m[i-1]==NULL)) i--;
3777  intvec *result = new intvec(i+1);
3778  while (i>0)
3779  {
3780    (*result)[i]=pFDeg(mod->m[i],currRing)+(*weights)[pGetComp(mod->m[i])];
3781  }
3782  return result;
3783}
3784
3785/*2
3786*sorts the kbase for idCoef* in a special way (lexicographically
3787*with x_max,...,x_1)
3788*/
3789ideal idCreateSpecialKbase(ideal kBase,intvec ** convert)
3790{
3791  int i;
3792  ideal result;
3793
3794  if (idIs0(kBase)) return NULL;
3795  result = idInit(IDELEMS(kBase),kBase->rank);
3796  *convert = idSort(kBase,FALSE);
3797  for (i=0;i<(*convert)->length();i++)
3798  {
3799    result->m[i] = pCopy(kBase->m[(**convert)[i]-1]);
3800  }
3801  return result;
3802}
3803
3804/*2
3805*returns the index of a given monom in the list of the special kbase
3806*/
3807int idIndexOfKBase(poly monom, ideal kbase)
3808{
3809  int j=IDELEMS(kbase);
3810
3811  while ((j>0) && (kbase->m[j-1]==NULL)) j--;
3812  if (j==0) return -1;
3813  int i=pVariables;
3814  while (i>0)
3815  {
3816    loop
3817    {
3818      if (pGetExp(monom,i)>pGetExp(kbase->m[j-1],i)) return -1;
3819      if (pGetExp(monom,i)==pGetExp(kbase->m[j-1],i)) break;
3820      j--;
3821      if (j==0) return -1;
3822    }
3823    if (i==1)
3824    {
3825      while(j>0)
3826      {
3827        if (pGetComp(monom)==pGetComp(kbase->m[j-1])) return j-1;
3828        if (pGetComp(monom)>pGetComp(kbase->m[j-1])) return -1;
3829        j--;
3830      }
3831    }
3832    i--;
3833  }
3834  return -1;
3835}
3836
3837/*2
3838*decomposes the monom in a part of coefficients described by the
3839*complement of how and a monom in variables occuring in how, the
3840*index of which in kbase is returned as integer pos (-1 if it don't
3841*exists)
3842*/
3843poly idDecompose(poly monom, poly how, ideal kbase, int * pos)
3844{
3845  int i;
3846  poly coeff=pOne(), base=pOne();
3847
3848  for (i=1;i<=pVariables;i++)
3849  {
3850    if (pGetExp(how,i)>0)
3851    {
3852      pSetExp(base,i,pGetExp(monom,i));
3853    }
3854    else
3855    {
3856      pSetExp(coeff,i,pGetExp(monom,i));
3857    }
3858  }
3859  pSetComp(base,pGetComp(monom));
3860  pSetm(base);
3861  pSetCoeff(coeff,nCopy(pGetCoeff(monom)));
3862  pSetm(coeff);
3863  *pos = idIndexOfKBase(base,kbase);
3864  if (*pos<0)
3865    pDelete(&coeff);
3866  pDelete(&base);
3867  return coeff;
3868}
3869
3870/*2
3871*returns a matrix A of coefficients with kbase*A=arg
3872*if all monomials in variables of how occur in kbase
3873*the other are deleted
3874*/
3875matrix idCoeffOfKBase(ideal arg, ideal kbase, poly how)
3876{
3877  matrix result;
3878  ideal tempKbase;
3879  poly p,q;
3880  intvec * convert;
3881  int i=IDELEMS(kbase),j=IDELEMS(arg),k,pos;
3882#if 0
3883  while ((i>0) && (kbase->m[i-1]==NULL)) i--;
3884  if (idIs0(arg))
3885    return mpNew(i,1);
3886  while ((j>0) && (arg->m[j-1]==NULL)) j--;
3887  result = mpNew(i,j);
3888#else
3889  result = mpNew(i, j);
3890  while ((j>0) && (arg->m[j-1]==NULL)) j--;
3891#endif
3892
3893  tempKbase = idCreateSpecialKbase(kbase,&convert);
3894  for (k=0;k<j;k++)
3895  {
3896    p = arg->m[k];
3897    while (p!=NULL)
3898    {
3899      q = idDecompose(p,how,tempKbase,&pos);
3900      if (pos>=0)
3901      {
3902        MATELEM(result,(*convert)[pos],k+1) =
3903            pAdd(MATELEM(result,(*convert)[pos],k+1),q);
3904      }
3905      else
3906        pDelete(&q);
3907      pIter(p);
3908    }
3909  }
3910  idDelete(&tempKbase);
3911  return result;
3912}
3913
3914/*3
3915* searches for the next unit in the components of the module arg and
3916* returns the first one;
3917*/
3918static int idReadOutPivot(ideal arg,int* comp)
3919{
3920  if (idIs0(arg)) return -1;
3921  int i=0,j, generator=-1;
3922  int rk_arg=arg->rank; //idRankFreeModule(arg);
3923  int * componentIsUsed =(int *)omAlloc((rk_arg+1)*sizeof(int));
3924  poly p;
3925
3926  while ((generator<0) && (i<IDELEMS(arg)))
3927  {
3928    memset(componentIsUsed,0,(rk_arg+1)*sizeof(int));
3929    p = arg->m[i];
3930    while (p!=NULL)
3931    {
3932      j = pGetComp(p);
3933      if (componentIsUsed[j]==0)
3934      {
3935#ifdef HAVE_RINGS
3936        if (pLmIsConstantComp(p) &&
3937            (!rField_is_Ring(currRing) || nIsUnit(pGetCoeff(p))))
3938        {
3939#else
3940        if (pLmIsConstantComp(p))
3941        {
3942#endif
3943          generator = i;
3944          componentIsUsed[j] = 1;
3945        }
3946        else
3947        {
3948          componentIsUsed[j] = -1;
3949        }
3950      }
3951      else if (componentIsUsed[j]>0)
3952      {
3953        (componentIsUsed[j])++;
3954      }
3955      pIter(p);
3956    }
3957    i++;
3958  }
3959  i = 0;
3960  *comp = -1;
3961  for (j=0;j<=rk_arg;j++)
3962  {
3963    if (componentIsUsed[j]>0)
3964    {
3965      if ((*comp==-1) || (componentIsUsed[j]<i))
3966      {
3967        *comp = j;
3968        i= componentIsUsed[j];
3969      }
3970    }
3971  }
3972  omFree(componentIsUsed);
3973  return generator;
3974}
3975
3976#if 0
3977static void idDeleteComp(ideal arg,int red_comp)
3978{
3979  int i,j;
3980  poly p;
3981
3982  for (i=IDELEMS(arg)-1;i>=0;i--)
3983  {
3984    p = arg->m[i];
3985    while (p!=NULL)
3986    {
3987      j = pGetComp(p);
3988      if (j>red_comp)
3989      {
3990        pSetComp(p,j-1);
3991        pSetm(p);
3992      }
3993      pIter(p);
3994    }
3995  }
3996  (arg->rank)--;
3997}
3998#endif
3999
4000static void idDeleteComps(ideal arg,int* red_comp,int del)
4001// red_comp is an array [0..args->rank]
4002{
4003  int i,j;
4004  poly p;
4005
4006  for (i=IDELEMS(arg)-1;i>=0;i--)
4007  {
4008    p = arg->m[i];
4009    while (p!=NULL)
4010    {
4011      j = pGetComp(p);
4012      if (red_comp[j]!=j)
4013      {
4014        pSetComp(p,red_comp[j]);
4015        pSetmComp(p);
4016      }
4017      pIter(p);
4018    }
4019  }
4020  (arg->rank) -= del;
4021}
4022
4023/*2
4024* returns the presentation of an isomorphic, minimally
4025* embedded  module (arg represents the quotient!)
4026*/
4027ideal idMinEmbedding(ideal arg,BOOLEAN inPlace, intvec **w)
4028{
4029  if (idIs0(arg)) return idInit(1,arg->rank);
4030  int i,next_gen,next_comp;
4031  ideal res=arg;
4032  if (!inPlace) res = idCopy(arg);
4033  res->rank=si_max(res->rank,idRankFreeModule(res));
4034  int *red_comp=(int*)omAlloc((res->rank+1)*sizeof(int));
4035  for (i=res->rank;i>=0;i--) red_comp[i]=i;
4036
4037  int del=0;
4038  loop
4039  {
4040    next_gen = idReadOutPivot(res,&next_comp);
4041    if (next_gen<0) break;
4042    del++;
4043    syGaussForOne(res,next_gen,next_comp,0,IDELEMS(res));
4044    for(i=next_comp+1;i<=arg->rank;i++) red_comp[i]--;
4045    if ((w !=NULL)&&(*w!=NULL))
4046    {
4047      for(i=next_comp;i<(*w)->length();i++) (**w)[i-1]=(**w)[i];
4048    }
4049  }
4050
4051  idDeleteComps(res,red_comp,del);
4052  idSkipZeroes(res);
4053  omFree(red_comp);
4054
4055  if ((w !=NULL)&&(*w!=NULL) &&(del>0))
4056  {
4057    intvec *wtmp=new intvec((*w)->length()-del);
4058    for(i=0;i<res->rank;i++) (*wtmp)[i]=(**w)[i];
4059    delete *w;
4060    *w=wtmp;
4061  }
4062  return res;
4063}
4064
4065/*2
4066* transpose a module
4067*/
4068ideal idTransp(ideal a)
4069{
4070  int r = a->rank, c = IDELEMS(a);
4071  ideal b =  idInit(r,c);
4072
4073  for (int i=c; i>0; i--)
4074  {
4075    poly p=a->m[i-1];
4076    while(p!=NULL)
4077    {
4078      poly h=pHead(p);
4079      int co=pGetComp(h)-1;
4080      pSetComp(h,i);
4081      pSetmComp(h);
4082      b->m[co]=pAdd(b->m[co],h);
4083      pIter(p);
4084    }
4085  }
4086  return b;
4087}
4088
4089intvec * idQHomWeight(ideal id)
4090{
4091  poly head, tail;
4092  int k;
4093  int in=IDELEMS(id)-1, ready=0, all=0,
4094      coldim=pVariables, rowmax=2*coldim;
4095  if (in<0) return NULL;
4096  intvec *imat=new intvec(rowmax+1,coldim,0);
4097
4098  do
4099  {
4100    head = id->m[in--];
4101    if (head!=NULL)
4102    {
4103      tail = pNext(head);
4104      while (tail!=NULL)
4105      {
4106        all++;
4107        for (k=1;k<=coldim;k++)
4108          IMATELEM(*imat,all,k) = pGetExpDiff(head,tail,k);
4109        if (all==rowmax)
4110        {
4111          ivTriangIntern(imat, ready, all);
4112          if (ready==coldim)
4113          {
4114            delete imat;
4115            return NULL;
4116          }
4117        }
4118        pIter(tail);
4119      }
4120    }
4121  } while (in>=0);
4122  if (all>ready)
4123  {
4124    ivTriangIntern(imat, ready, all);
4125    if (ready==coldim)
4126    {
4127      delete imat;
4128      return NULL;
4129    }
4130  }
4131  intvec *result = ivSolveKern(imat, ready);
4132  delete imat;
4133  return result;
4134}
4135
4136BOOLEAN idIsZeroDim(ideal I)
4137{
4138  BOOLEAN *UsedAxis=(BOOLEAN *)omAlloc0(pVariables*sizeof(BOOLEAN));
4139  int i,n;
4140  poly po;
4141  BOOLEAN res=TRUE;
4142  for(i=IDELEMS(I)-1;i>=0;i--)
4143  {
4144    po=I->m[i];
4145    if ((po!=NULL) &&((n=pIsPurePower(po))!=0)) UsedAxis[n-1]=TRUE;
4146  }
4147  for(i=pVariables-1;i>=0;i--)
4148  {
4149    if(UsedAxis[i]==FALSE) {res=FALSE; break;} // not zero-dim.
4150  }
4151  omFreeSize(UsedAxis,pVariables*sizeof(BOOLEAN));
4152  return res;
4153}
4154
4155void idNormalize(ideal I)
4156{
4157  if (rField_has_simple_inverse()) return; /* Z/p, GF(p,n), R, long R/C */
4158  int i;
4159  poly p;
4160  for(i=IDELEMS(I)-1;i>=0;i--)
4161  {
4162    p=I->m[i] ;
4163    while(p!=NULL)
4164    {
4165      nNormalize(pGetCoeff(p));
4166      pIter(p);
4167    }
4168  }
4169}
4170
4171#include <kernel/clapsing.h>
4172
4173#ifdef HAVE_FACTORY
4174poly id_GCD(poly f, poly g, const ring r)
4175{
4176  ring save_r=currRing;
4177  rChangeCurrRing(r);
4178  ideal I=idInit(2,1); I->m[0]=f; I->m[1]=g;
4179  intvec *w = NULL;
4180  ideal S=idSyzygies(I,testHomog,&w);
4181  if (w!=NULL) delete w;
4182  poly gg=pTakeOutComp(&(S->m[0]),2);
4183  idDelete(&S);
4184  poly gcd_p=singclap_pdivide(f,gg);
4185  pDelete(&gg);
4186  rChangeCurrRing(save_r);
4187  return gcd_p;
4188}
4189#endif
4190
4191/*2
4192* xx,q: arrays of length 0..rl-1
4193* xx[i]: SB mod q[i]
4194* assume: char=0
4195* assume: q[i]!=0
4196* destroys xx
4197*/
4198#ifdef HAVE_FACTORY
4199ideal idChineseRemainder(ideal *xx, number *q, int rl)
4200{
4201  int cnt=IDELEMS(xx[0])*xx[0]->nrows;
4202  ideal result=idInit(cnt,xx[0]->rank);
4203  result->nrows=xx[0]->nrows; // for lifting matrices
4204  result->ncols=xx[0]->ncols; // for lifting matrices
4205  int i,j;
4206  poly r,h,hh,res_p;
4207  number *x=(number *)omAlloc(rl*sizeof(number));
4208  for(i=cnt-1;i>=0;i--)
4209  {
4210    res_p=NULL;
4211    loop
4212    {
4213      r=NULL;
4214      for(j=rl-1;j>=0;j--)
4215      {
4216        h=xx[j]->m[i];
4217        if ((h!=NULL)
4218        &&((r==NULL)||(pLmCmp(r,h)==-1)))
4219          r=h;
4220      }
4221      if (r==NULL) break;
4222      h=pHead(r);
4223      for(j=rl-1;j>=0;j--)
4224      {
4225        hh=xx[j]->m[i];
4226        if ((hh!=NULL) && (pLmCmp(r,hh)==0))
4227        {
4228          x[j]=pGetCoeff(hh);
4229          hh=pLmFreeAndNext(hh);
4230          xx[j]->m[i]=hh;
4231        }
4232        else
4233          x[j]=nlInit(0, currRing);
4234      }
4235      number n=nlChineseRemainder(x,q,rl);
4236      for(j=rl-1;j>=0;j--)
4237      {
4238        x[j]=NULL; // nlInit(0...) takes no memory
4239      }
4240      if (nlIsZero(n)) pDelete(&h);
4241      else
4242      {
4243        pSetCoeff(h,n);
4244        //Print("new mon:");pWrite(h);
4245        res_p=pAdd(res_p,h);
4246      }
4247    }
4248    result->m[i]=res_p;
4249  }
4250  omFree(x);
4251  for(i=rl-1;i>=0;i--) idDelete(&(xx[i]));
4252  omFree(xx);
4253  return result;
4254}
4255#endif
4256/* currently unsed:
4257ideal idChineseRemainder(ideal *xx, intvec *iv)
4258{
4259  int rl=iv->length();
4260  number *q=(number *)omAlloc(rl*sizeof(number));
4261  int i;
4262  for(i=0; i<rl; i++)
4263  {
4264    q[i]=nInit((*iv)[i]);
4265  }
4266  return idChineseRemainder(xx,q,rl);
4267}
4268*/
4269/*
4270 * lift ideal with coeffs over Z (mod N) to Q via Farey
4271 */
4272ideal idFarey(ideal x, number N)
4273{
4274  int cnt=IDELEMS(x)*x->nrows;
4275  ideal result=idInit(cnt,x->rank);
4276  result->nrows=x->nrows; // for lifting matrices
4277  result->ncols=x->ncols; // for lifting matrices
4278
4279  int i;
4280  for(i=cnt-1;i>=0;i--)
4281  {
4282    poly h=pCopy(x->m[i]);
4283    result->m[i]=h;
4284    while(h!=NULL)
4285    {
4286      number c=pGetCoeff(h);
4287      pSetCoeff0(h,nlFarey(c,N));
4288      nDelete(&c);
4289      pIter(h);
4290    }
4291    while((result->m[i]!=NULL)&&(nIsZero(pGetCoeff(result->m[i]))))
4292    {
4293      pLmDelete(&(result->m[i]));
4294    }
4295    h=result->m[i];
4296    while((h!=NULL) && (pNext(h)!=NULL))
4297    {
4298      if(nIsZero(pGetCoeff(pNext(h))))
4299      {
4300        pLmDelete(&pNext(h));
4301      }
4302      else pIter(h);
4303    }
4304  }
4305  return result;
4306}
4307
4308/*2
4309* transpose a module
4310* NOTE: just a version of "ideal idTransp(ideal)" which works within specified ring.
4311*/
4312ideal id_Transp(ideal a, const ring rRing)
4313{
4314  int r = a->rank, c = IDELEMS(a);
4315  ideal b =  idInit(r,c);
4316
4317  for (int i=c; i>0; i--)
4318  {
4319    poly p=a->m[i-1];
4320    while(p!=NULL)
4321    {
4322      poly h=p_Head(p, rRing);
4323      int co=p_GetComp(h, rRing)-1;
4324      p_SetComp(h, i, rRing);
4325      p_Setm(h, rRing);
4326      b->m[co] = p_Add_q(b->m[co], h, rRing);
4327      pIter(p);
4328    }
4329  }
4330  return b;
4331}
4332
4333
4334
4335/*2
4336* The following is needed to compute the image of certain map used in
4337* the computation of cohomologies via BGG
4338* let M = { w_1, ..., w_k }, k = size(M) == ncols(M), n = nvars(currRing).
4339* assuming that nrows(M) <= m*n; the procedure computes:
4340* transpose(M) * transpose( var(1) I_m | ... | var(n) I_m ) :== transpose(module{f_1, ... f_k}),
4341* where f_i = \sum_{j=1}^{m} (w_i, v_j) gen(j),  (w_i, v_j) is a `scalar` multiplication.
4342* that is, if w_i = (a^1_1, ... a^1_m) | (a^2_1, ..., a^2_m) | ... | (a^n_1, ..., a^n_m) then
4343
4344  (a^1_1, ... a^1_m) | (a^2_1, ..., a^2_m) | ... | (a^n_1, ..., a^n_m)
4345*  var_1  ... var_1  |  var_2  ...  var_2  | ... |  var_n  ...  var(n)
4346*  gen_1  ... gen_m  |  gen_1  ...  gen_m  | ... |  gen_1  ...  gen_m
4347+ =>
4348  f_i =
4349
4350   a^1_1 * var(1) * gen(1) + ... + a^1_m * var(1) * gen(m) +
4351   a^2_1 * var(2) * gen(1) + ... + a^2_m * var(2) * gen(m) +
4352                             ...
4353   a^n_1 * var(n) * gen(1) + ... + a^n_m * var(n) * gen(m);
4354
4355   NOTE: for every f_i we run only ONCE along w_i saving partial sums into a temporary array of polys of size m
4356*/
4357ideal id_TensorModuleMult(const int m, const ideal M, const ring rRing)
4358{
4359// #ifdef DEBU
4360//  WarnS("tensorModuleMult!!!!");
4361
4362  assume(m > 0);
4363  assume(M != NULL);
4364
4365  const int n = rRing->N;
4366
4367  assume(M->rank <= m * n);
4368
4369  const int k = IDELEMS(M);
4370
4371  ideal idTemp =  idInit(k,m); // = {f_1, ..., f_k }
4372
4373  for( int i = 0; i < k; i++ ) // for every w \in M
4374  {
4375    poly pTempSum = NULL;
4376
4377    poly w = M->m[i];
4378
4379    while(w != NULL) // for each term of w...
4380    {
4381      poly h = p_Head(w, rRing);
4382
4383      const int  gen = p_GetComp(h, rRing); // 1 ...
4384
4385      assume(gen > 0);
4386      assume(gen <= n*m);
4387
4388      // TODO: write a formula with %, / instead of while!
4389      /*
4390      int c = gen;
4391      int v = 1;
4392      while(c > m)
4393      {
4394        c -= m;
4395        v++;
4396      }
4397      */
4398
4399      int cc = gen % m;
4400      if( cc == 0) cc = m;
4401      int vv = 1 + (gen - cc) / m;
4402
4403//      assume( cc == c );
4404//      assume( vv == v );
4405
4406      //  1<= c <= m
4407      assume( cc > 0 );
4408      assume( cc <= m );
4409
4410      assume( vv > 0 );
4411      assume( vv <= n );
4412
4413      assume( (cc + (vv-1)*m) == gen );
4414
4415      p_IncrExp(h, vv, rRing); // h *= var(j) && //      p_AddExp(h, vv, 1, rRing);
4416      p_SetComp(h, cc, rRing);
4417
4418      p_Setm(h, rRing);         // addjust degree after the previous steps!
4419
4420      pTempSum = p_Add_q(pTempSum, h, rRing); // it is slow since h will be usually put to the back of pTempSum!!!
4421
4422      pIter(w);
4423    }
4424
4425    idTemp->m[i] = pTempSum;
4426  }
4427
4428  // simplify idTemp???
4429
4430  ideal idResult = id_Transp(idTemp, rRing);
4431
4432  id_Delete(&idTemp, rRing);
4433
4434  return(idResult);
4435}
Note: See TracBrowser for help on using the repository browser.