source: git/Singular/walk.cc @ dbe2b0

spielwiese
Last change on this file since dbe2b0 was dbe2b0, checked in by Hans Schönemann <hannes@…>, 18 years ago
*hannes: solaris port git-svn-id: file:///usr/local/Singular/svn/trunk@8918 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 137.9 KB
Line 
1/*****************************************
2*  Computer Algebra System SINGULAR      *
3*****************************************/
4/* $Id: walk.cc,v 1.10 2006-01-31 15:23:38 Singular Exp $ */
5/*
6* ABSTRACT: Implementation of the Groebner walk
7*/
8
9// define if the Buchberger alg should be used
10//   to compute a reduced GB of a omega-homogenoues ideal
11// default: we use the hilbert driven algorithm.
12#define BUCHBERGER_ALG  //we use the improved Buchberger alg.
13
14//#define UPPER_BOUND //for the original "Tran" algorithm
15//#define REPRESENTATION_OF_SIGMA //if one perturbs sigma in Tran
16
17//#define TEST_OVERFLOW
18//#define CHECK_IDEAL
19//#define CHECK_IDEAL_MWALK
20
21//#define NEXT_VECTORS_CC
22//#define PRINT_VECTORS //to print vectors (sigma, tau, omega)
23
24#define INVEPS_SMALL_IN_FRACTAL  //to choose the small invers of epsilon
25#define INVEPS_SMALL_IN_MPERTVECTOR  //to choose the small invers of epsilon
26#define INVEPS_SMALL_IN_TRAN  //to choose the small invers of epsilon
27
28#define FIRST_STEP_FRACTAL // to define the first step of the fractal
29//#define MSTDCC_FRACTAL // apply Buchberger alg to compute a red GB, if
30//                          tau doesn't stay in the correct cone
31
32//#define TIME_TEST // print the used time of each subroutine
33//#define ENDWALKS //print the size of the last omega-homogenoues Gröbner basis
34
35/* includes */
36
37#include <stdio.h>
38// === Zeit & System (Holger Croeni ===
39#include <time.h>
40#include <sys/time.h>
41#include <sys/stat.h>
42#include <unistd.h>
43#include <stdio.h>
44#include <float.h>
45#include <limits.h>
46#include <sys/types.h>
47
48
49#include "mod2.h"
50#include "intvec.h"
51#include "cntrlc.h"
52#include "math.h"
53#include "structs.h"
54#include "omalloc.h"
55#include "febase.h"
56#include "ipshell.h"
57#include "ipconv.h"
58#include "longalg.h"
59#include "ffields.h"
60#include "subexpr.h"
61#include "p_Procs.h"
62
63#include "maps.h"
64
65/* include Hilbert-function */
66#include "stairc.h"
67
68/** kstd2.cc */
69#include "kutil.h"
70#include "khstd.h"
71
72#include "walk.h"
73#include "polys.h"
74#include "ideals.h"
75#include "ipid.h"
76#include "tok.h"
77#include "febase.h"
78#include "numbers.h"
79#include "ipid.h"
80#include "ring.h"
81#include "kstd1.h"
82#include "matpol.h"
83#include "weight.h"
84#include "intvec.h"
85#include "syz.h"
86#include "lists.h"
87#include "prCopy.h"
88#include "string.h"
89#include "longalg.h"
90#ifdef HAVE_FACTORY
91#include "clapsing.h"
92#endif
93
94#include "mpr_complex.h"
95
96ideal Gnull = NULL;
97int nstep;
98
99extern BOOLEAN ErrorCheck();
100
101extern BOOLEAN pSetm_error;
102
103void Set_Error( BOOLEAN f) { pSetm_error=f; }
104
105BOOLEAN Overflow_Error =  FALSE;
106
107clock_t xtif, xtstd, xtlift, xtred, xtnw;
108clock_t xftostd, xtextra, xftinput, to;
109
110/*2
111*utilities for TSet, LSet
112*/
113inline static intset initec (int maxnr)
114{
115  return (intset)omAlloc(maxnr*sizeof(int));
116}
117
118inline static unsigned long* initsevS (int maxnr)
119{
120  return (unsigned long*)omAlloc0(maxnr*sizeof(unsigned long));
121}
122inline static int* initS_2_R (int maxnr)
123{
124  return (int*)omAlloc0(maxnr*sizeof(int));
125}
126
127/*2
128*construct the set s from F u {P}
129*/
130static void initSSpecialCC (ideal F, ideal Q, ideal P,kStrategy strat)
131{
132  int   i,pos;
133
134  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
135  else i=setmaxT;
136
137  strat->ecartS=initec(i);
138  strat->sevS=initsevS(i);
139  strat->S_2_R=initS_2_R(i);
140  strat->fromQ=NULL;
141  strat->Shdl=idInit(i,F->rank);
142  strat->S=strat->Shdl->m;
143
144  /*- put polys into S -*/
145  if (Q!=NULL)
146  {
147    strat->fromQ=initec(i);
148    memset(strat->fromQ,0,i*sizeof(int));
149    for (i=0; i<IDELEMS(Q); i++)
150    {
151      if (Q->m[i]!=NULL)
152      {
153        LObject h;
154        h.p = pCopy(Q->m[i]);
155        //if (TEST_OPT_INTSTRATEGY)
156        //{
157        //  //pContent(h.p);
158        //  h.pCleardenom(); // also does a pContent
159        //}
160        //else
161        //{
162        //  h.pNorm();
163        //}
164        strat->initEcart(&h);
165        if (pOrdSgn==-1)
166        {
167          deleteHC(&h,strat);
168        }
169        if (h.p!=NULL)
170        {
171          if (strat->sl==-1)
172            pos =0;
173          else
174          {
175            pos = posInS(strat,strat->sl,h.p,h.ecart);
176          }
177          h.sev = pGetShortExpVector(h.p);
178          h.SetpFDeg();
179          strat->enterS(h,pos,strat, strat->tl+1);
180          enterT(h, strat);
181          strat->fromQ[pos]=1;
182        }
183      }
184    }
185  }
186  /*- put polys into S -*/
187  for (i=0; i<IDELEMS(F); i++)
188  {
189    if (F->m[i]!=NULL)
190    {
191      LObject h;
192      h.p = pCopy(F->m[i]);
193      if (pOrdSgn==1)
194      {
195        //h.p=redtailBba(h.p,strat->sl,strat);
196        h.p=redtailBba(h.p,strat->sl,strat);
197      }
198      strat->initEcart(&h);
199      if (pOrdSgn==-1)
200      {
201        deleteHC(&h,strat);
202      }
203      if (h.p!=NULL)
204      {
205        if (strat->sl==-1)
206          pos =0;
207        else
208          pos = posInS(strat,strat->sl,h.p,h.ecart);
209        h.sev = pGetShortExpVector(h.p);
210        strat->enterS(h,pos,strat, strat->tl+1);
211        h.length = pLength(h.p);
212        h.SetpFDeg();
213        enterT(h,strat);
214      }
215    }
216  }
217#ifdef INITSSPECIAL
218  for (i=0; i<IDELEMS(P); i++)
219  {
220    if (P->m[i]!=NULL)
221    {
222      LObject h;
223      h.p=pCopy(P->m[i]);
224      strat->initEcart(&h);
225      h.length = pLength(h.p);
226      if (TEST_OPT_INTSTRATEGY)
227      {
228        h.pCleardenom();
229      }
230      else
231      {
232        h.pNorm();
233      }
234      if(strat->sl>=0)
235      {
236        if (pOrdSgn==1)
237        {
238          h.p=redBba(h.p,strat->sl,strat);
239          if (h.p!=NULL)
240            h.p=redtailBba(h.p,strat->sl,strat);
241        }
242        else
243        {
244          h.p=redMora(h.p,strat->sl,strat);
245          strat->initEcart(&h);
246        }
247        if(h.p!=NULL)
248        {
249          if (TEST_OPT_INTSTRATEGY)
250          {
251            h.pCleardenom();
252          }
253          else
254          {
255            h.is_normalized = 0;
256            h.pNorm();
257          }
258          h.sev = pGetShortExpVector(h.p);
259          h.SetpFDeg();
260          pos = posInS(strat->S,strat->sl,h.p,h.ecart);
261          enterpairsSpecial(h.p,strat->sl,h.ecart,pos,strat,strat->tl+1);
262          strat->enterS(h,pos,strat, strat->tl+1);
263          enterT(h,strat);
264        }
265      }
266      else
267      {
268        h.sev = pGetShortExpVector(h.p);
269        h.SetpFDeg();
270        strat->enterS(h,0,strat, strat->tl+1);
271        enterT(h,strat);
272      }
273    }
274  }
275#endif
276}
277
278/*2
279*interreduces F
280*/
281static ideal kInterRedCC(ideal F, ideal Q)
282{
283  int j;
284  kStrategy strat = new skStrategy;
285
286//  if (TEST_OPT_PROT)
287//  {
288//    writeTime("start InterRed:");
289//    mflush();
290//  }
291  //strat->syzComp     = 0;
292  strat->kHEdgeFound = ppNoether != NULL;
293  strat->kNoether=pCopy(ppNoether);
294  strat->ak = idRankFreeModule(F);
295  initBuchMoraCrit(strat);
296  strat->NotUsedAxis = (BOOLEAN *)omAlloc((pVariables+1)*sizeof(BOOLEAN));
297  for (j=pVariables; j>0; j--) strat->NotUsedAxis[j] = TRUE;
298  strat->enterS      = enterSBba;
299  strat->posInT      = posInT0;
300  strat->initEcart   = initEcartNormal;
301  strat->sl   = -1;
302  strat->tl          = -1;
303  strat->tmax        = setmaxT;
304  strat->T           = initT();
305  strat->R           = initR();
306  strat->sevT        = initsevT();
307  if (pOrdSgn == -1)   strat->honey = TRUE;
308
309
310  //initSCC(F,Q,strat);
311  initS(F,Q,strat);
312
313  /*
314  timetmp=clock();//22.01.02
315  initSSpecialCC(F,Q,NULL,strat);
316  tininitS=tininitS+clock()-timetmp;//22.01.02
317  */
318  if (TEST_OPT_REDSB)
319    strat->noTailReduction=FALSE;
320
321  updateS(TRUE,strat);
322
323  if (TEST_OPT_REDSB && TEST_OPT_INTSTRATEGY)
324    completeReduce(strat);
325  pDelete(&strat->kHEdge);
326  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
327  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
328  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
329  omFreeSize((ADDRESS)strat->NotUsedAxis,(pVariables+1)*sizeof(BOOLEAN));
330  omfree(strat->sevT);
331  omfree(strat->S_2_R);
332  omfree(strat->R);
333
334  if (strat->fromQ)
335  {
336    for (j=0;j<IDELEMS(strat->Shdl);j++)
337    {
338      if(strat->fromQ[j]) pDelete(&strat->Shdl->m[j]);
339    }
340    omFreeSize((ADDRESS)strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
341    strat->fromQ=NULL;
342  }
343//  if (TEST_OPT_PROT)
344//  {
345//    writeTime("end Interred:");
346//    mflush();
347//  }
348  ideal shdl=strat->Shdl;
349  idSkipZeroes(shdl);
350  delete(strat);
351
352  return shdl;
353}
354
355static void TimeString(clock_t tinput, clock_t tostd, clock_t tif,clock_t tstd,
356                       clock_t tlf,clock_t tred, clock_t tnw, int step)
357{
358  double totm = ((double) (clock() - tinput))/1000000;
359  double ostd,mostd, mif, mstd, mextra, mlf, mred, mnw, mxif,mxstd,mxlf,mxred,mxnw,tot;
360
361  Print("\n// total time = %.2f sec", totm);
362  Print("\n// tostd = %.2f sec = %.2f %", ostd=((double) tostd)/1000000,
363        mostd=((((double) tostd)/1000000)/totm)*100);
364  Print("\n// tif   = %.2f sec = %.2f %", ((double) tif)/1000000,
365        mif=((((double) tif)/1000000)/totm)*100);
366  Print("\n// std   = %.2f sec = %.2f %", ((double) tstd)/1000000,
367        mstd=((((double) tstd)/1000000)/totm)*100);
368  Print("\n// lift  = %.2f sec = %.2f %", ((double) tlf)/1000000,
369        mlf=((((double) tlf)/1000000)/totm)*100);
370  Print("\n// ired  = %.2f sec = %.2f %", ((double) tred)/1000000,
371        mred=((((double) tred)/1000000)/totm)*100);
372  Print("\n// nextw = %.2f sec = %.2f %", ((double) tnw)/1000000,
373        mnw=((((double) tnw)/1000000)/totm)*100);
374  PrintS("\n Time for the last step:");
375  Print("\n// xinfo = %.2f sec = %.2f %", ((double) xtif)/1000000,
376        mxif=((((double) xtif)/1000000)/totm)*100);
377  Print("\n// xstd  = %.2f sec = %.2f %", ((double) xtstd)/1000000,
378        mxstd=((((double) xtstd)/1000000)/totm)*100);
379  Print("\n// xlift = %.2f sec = %.2f %", ((double) xtlift)/1000000,
380        mxlf=((((double) xtlift)/1000000)/totm)*100);
381  Print("\n// xired = %.2f sec = %.2f %", ((double) xtred)/1000000,
382        mxred=((((double) xtred)/1000000)/totm)*100);
383  Print("\n// xnextw= %.2f sec = %.2f %", ((double) xtnw)/1000000,
384        mxnw=((((double) xtnw)/1000000)/totm)*100);
385
386  tot=mostd+mif+mstd+mlf+mred+mnw+mxif+mxstd+mxlf+mxred+mxnw;
387  double res = (double) 100 - tot;
388  Print("\n// &%d&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f(%.2f)\\ \\",
389        step, ostd, totm, mostd,mif,mstd,mlf,mred,mnw,mxif,mxstd,mxlf,mxred,mxnw,tot,res,
390        ((((double) xtextra)/1000000)/totm)*100);
391}
392
393static void TimeStringFractal(clock_t tinput, clock_t tostd, clock_t tif,clock_t tstd,
394                       clock_t textra, clock_t tlf,clock_t tred, clock_t tnw)
395{
396
397  double totm = ((double) (clock() - tinput))/1000000;
398  double ostd, mostd, mif, mstd, mextra, mlf, mred, mnw, tot, res;
399  Print("\n// total time = %.2f sec", totm);
400  Print("\n// tostd = %.2f sec = %.2f %", ostd=((double) tostd)/1000000,
401        mostd=((((double) tostd)/1000000)/totm)*100);
402  Print("\n// tif   = %.2f sec = %.2f %", ((double) tif)/1000000,
403        mif=((((double) tif)/1000000)/totm)*100);
404  Print("\n// std   = %.2f sec = %.2f %", ((double) tstd)/1000000,
405        mstd=((((double) tstd)/1000000)/totm)*100);
406  Print("\n// xstd  = %.2f sec = %.2f %", ((double) textra)/1000000,
407        mextra=((((double) textra)/1000000)/totm)*100);
408  Print("\n// lift  = %.2f sec = %.2f %", ((double) tlf)/1000000,
409        mlf=((((double) tlf)/1000000)/totm)*100);
410  Print("\n// ired  = %.2f sec = %.2f %", ((double) tred)/1000000,
411        mred=((((double) tred)/1000000)/totm)*100);
412  Print("\n// nextw = %.2f sec = %.2f %", ((double) tnw)/1000000,
413        mnw=((((double) tnw)/1000000)/totm)*100);
414  tot = mostd+mif+mstd+mextra+mlf+mred+mnw;
415  res = (double) 100.00-tot;
416  Print("\n// &%.2f &%.2f&%.2f &%.2f &%.2f &%.2f &%.2f &%.2f &%.2f&%.2f&%.2f\\ \\ ",
417        ostd,totm,mostd,mif,mstd,mextra,mlf,mred,mnw,tot,res);
418}
419
420static void idString(ideal L, char* st)
421{
422  int i, nL = IDELEMS(L);
423
424  Print("\n//  ideal %s =  ", st);
425  for(i=0; i<nL-1; i++)
426    Print(" %s, ", pString(L->m[i]));
427
428  Print(" %s;", pString(L->m[nL-1]));
429}
430
431static void headidString(ideal L, char* st)
432{
433  int i, nL = IDELEMS(L);
434
435  Print("\n//  ideal %s =  ", st);
436  for(i=0; i<nL-1; i++)
437    Print(" %s, ", pString(pHead(L->m[i])));
438
439  Print(" %s;", pString(pHead(L->m[nL-1])));
440}
441
442static void idElements(ideal L, char* st)
443{
444  int i, nL = IDELEMS(L);
445  int *K=(int *)omAlloc(nL*sizeof(int));
446
447  Print("\n//  #monoms of %s =  ", st);
448  for(i=0; i<nL; i++)
449    K[i] = pLength(L->m[i]);
450
451  int j, nsame, nk=0;
452  for(i=0; i<nL; i++)
453  {
454    if(K[i]!=0)
455    {
456      nsame = 1;
457      for(j=i+1; j<nL; j++){
458        if(K[j]==K[i]){
459          nsame ++;
460          K[j]=0;
461        }
462      }
463      if(nsame == 1)
464        Print("%d, ",K[i]);
465      else
466        Print("%d[%d], ", K[i], nsame);
467    }
468  }
469  omFree(K);
470}
471
472
473
474static void ivString(intvec* iv, char* ch)
475{
476  int nV = iv->length()-1;
477  //Print("\n// vector %s =  (", ch);
478  Print("\n// intvec %s =  ", ch);
479
480  for(int i=0; i<nV; i++)
481    Print("%d, ", (*iv)[i]);
482  Print("%d;", (*iv)[nV]);
483}
484
485static void MivString(intvec* iva, intvec* ivb, intvec* ivc)
486{
487  int nV = iva->length()-1;
488  int i;
489  PrintS("\n//  (");
490  for(i=0; i<nV; i++)
491    Print("%d, ", (*iva)[i]);
492  Print("%d) ==> (", (*iva)[nV]);
493
494  for(i=0; i<nV; i++)
495    Print("%d, ", (*ivb)[i]);
496  Print("%d) := (", (*ivb)[nV]);
497
498  for(i=0; i<nV; i++)
499    Print("%d, ", (*ivc)[i]);
500  Print("%d)", (*ivc)[nV]);
501}
502
503
504// returns gcd of integers a and b
505static inline long gcd(const long a, const long b)
506{
507  long r, p0 = a, p1 = b;
508  //assume(p0 >= 0 && p1 >= 0);
509  if(p0 < 0)
510    p0 = -p0;
511
512  if(p1 < 0)
513    p1 = -p1;
514
515  while(p1 != 0)
516  {
517    r = p0 % p1;
518    p0 = p1;
519    p1 = r;
520  }
521  return p0;
522}
523
524// cancel gcd of integers zaehler and nenner
525static void cancel(mpz_t zaehler, mpz_t nenner)
526{
527//  assume(zaehler >= 0 && nenner > 0);
528  mpz_t g;
529  mpz_init(g);
530  mpz_gcd(g, zaehler, nenner);
531
532  mpz_div(zaehler , zaehler, g);
533  mpz_div(nenner ,  nenner, g);
534
535  mpz_clear(g);
536}
537
538/* 23.07.03 */
539static int isVectorNeg(intvec* omega)
540{
541  int i;
542
543  for(i=omega->length(); i>=0; i--)
544    if((*omega)[i]<0)
545      return 1;
546
547  return 0;
548}
549
550/********************************************************************
551 * compute a weight degree of a monomial p w.r.t. a weight_vector   *
552 ********************************************************************/
553static inline int MLmWeightedDegree(const poly p, intvec* weight)
554{
555  /* 2147483647 is max. integer representation in SINGULAR */
556  mpz_t sing_int;
557  mpz_init_set_ui(sing_int,  2147483647);
558
559  int i, wgrad;
560
561  mpz_t zmul;
562  mpz_init(zmul);
563  mpz_t zvec;
564  mpz_init(zvec);
565  mpz_t zsum;
566  mpz_init(zsum);
567
568  for (i=pVariables; i>0; i--)
569  {
570    mpz_set_si(zvec, (*weight)[i-1]);
571    mpz_mul_ui(zmul, zvec, pGetExp(p, i));
572    mpz_add(zsum, zsum, zmul);
573  }
574
575  wgrad = mpz_get_ui(zsum);
576
577  if(mpz_cmp(zsum, sing_int)>0)
578  {
579    if(Overflow_Error ==  FALSE) {
580      PrintLn();
581      PrintS("\n// ** OVERFLOW in \"MwalkInitialForm\": ");
582      mpz_out_str( stdout, 10, zsum);
583      PrintS(" is greater than 2147483647 (max. integer representation)");
584      Overflow_Error = TRUE;
585    }
586  }
587
588  return wgrad;
589}
590
591/********************************************************************
592 * compute a weight degree of a polynomial p w.r.t. a weight_vector *
593 ********************************************************************/
594static inline int MwalkWeightDegree(poly p, intvec* weight_vector)
595{
596  assume(weight_vector->length() >= pVariables);
597  int max = 0, maxtemp;
598
599  while(p != NULL)
600  {
601    maxtemp = MLmWeightedDegree(p, weight_vector);
602    pIter(p);
603
604    if (maxtemp > max)
605      max = maxtemp;
606  }
607  return max;
608}
609
610
611/********************************************************************
612 * compute a weight degree of a monomial p w.r.t. a weight_vector *
613 ********************************************************************/
614static  void  MLmWeightedDegree_gmp(mpz_t result, const poly p, intvec* weight)
615{
616  /* 2147483647 is max. integer representation in SINGULAR */
617  mpz_t sing_int;
618  mpz_init_set_ui(sing_int,  2147483647);
619
620  int i, wgrad;
621
622  mpz_t zmul;
623  mpz_init(zmul);
624  mpz_t zvec;
625  mpz_init(zvec);
626  mpz_t ztmp;
627  mpz_init(ztmp);
628
629  for (i=pVariables; i>0; i--)
630  {
631    mpz_set_si(zvec, (*weight)[i-1]);
632    mpz_mul_ui(zmul, zvec, pGetExp(p, i));
633    mpz_add(ztmp, ztmp, zmul);
634  }
635  mpz_init_set(result, ztmp);
636  mpz_clear(ztmp);
637  mpz_clear(sing_int);
638  mpz_clear(zvec);
639  mpz_clear(zmul);
640}
641
642
643/*****************************************************************************
644 * return an initial form of the polynom g w.r.t. a weight vector curr_weight *
645 *****************************************************************************/
646static poly MpolyInitialForm(poly g, intvec* curr_weight)
647{
648  if(g == NULL)
649    return NULL;
650
651  mpz_t max; mpz_init(max);
652  mpz_t maxtmp; mpz_init(maxtmp);
653
654  poly hg, in_w_g = NULL;
655
656  while(g != NULL)
657  {
658    hg = g;
659    pIter(g);
660    MLmWeightedDegree_gmp(maxtmp, hg, curr_weight);
661
662    if(mpz_cmp(maxtmp, max)>0)
663    {
664      mpz_init_set(max, maxtmp);
665      pDelete(&in_w_g);
666      in_w_g = pHead(hg);
667    }
668    else {
669      if(mpz_cmp(maxtmp, max)==0)
670        in_w_g = pAdd(in_w_g, pHead(hg));
671    }
672  }
673  return in_w_g;
674}
675
676/************************************************************************
677 * compute the initial form of an ideal <G> w.r.t. a weight vector iva  *
678 ************************************************************************/
679ideal MwalkInitialForm(ideal G, intvec* ivw)
680{
681  BOOLEAN nError =  Overflow_Error;
682  Overflow_Error = FALSE;
683
684  int i, nG = IDELEMS(G);
685  ideal Gomega = idInit(nG, 1);
686
687  for(i=nG-1; i>=0; i--)
688    Gomega->m[i] = MpolyInitialForm(G->m[i], ivw);
689
690  if(Overflow_Error == FALSE)
691    Overflow_Error = nError;
692
693  return Gomega;
694}
695
696/************************************************************************
697 * test whether the weight vector iv is in the cone of the ideal G      *
698 *            i.e. are in(in_w(g)) =? in(g), for all g in G             *
699 ************************************************************************/
700
701static int test_w_in_ConeCC(ideal G, intvec* iv)
702{
703  if(G->m[0] == NULL)
704  {
705    PrintS("//** the result may be WRONG, i.e. 0!!\n");
706    return 0;
707  }
708
709  BOOLEAN nError =  Overflow_Error;
710  Overflow_Error = FALSE;
711
712  int i, nG = IDELEMS(G);
713  poly mi, gi;
714
715  for(i=nG-1; i>=0; i--)
716  {
717    mi = MpolyInitialForm(G->m[i], iv);
718    gi = G->m[i];
719
720    if(mi == NULL)
721    {
722      pDelete(&mi);
723
724      if(Overflow_Error == FALSE)
725        Overflow_Error = nError;
726
727      return 0;
728    }
729    if(!pLmEqual(mi, gi))
730    {
731      pDelete(&mi);
732
733      if(Overflow_Error == FALSE)
734        Overflow_Error = nError;
735
736      return 0;
737    }
738
739    pDelete(&mi);
740  }
741
742  if(Overflow_Error == FALSE)
743    Overflow_Error = nError;
744
745  return 1;
746}
747
748
749//compute a least common multiple of two integers
750static inline long Mlcm(long &i1, long &i2)
751{
752  long temp = gcd(i1, i2);
753  return ((i1 / temp)* i2);
754}
755
756
757/***************************************************
758 * return  the dot product of two intvecs a and b  *
759 ***************************************************/
760static inline long  MivDotProduct(intvec* a, intvec* b)
761{
762  assume( a->length() ==  b->length());
763  int i, n = a->length();
764  long result = 0;
765
766  for(i=n-1; i>=0; i--)
767    result += (*a)[i] * (*b)[i];
768
769  return result;
770}
771
772
773static intvec* MivSub(intvec* a, intvec* b)
774{
775  assume( a->length() ==  b->length());
776  int i, n = a->length();
777  intvec* result = new intvec(n);
778
779  for(i=n-1; i>=0; i--)
780    (*result)[i] = (*a)[i] - (*b)[i];
781
782  return result;
783}
784
785/**21.10.00*******************************************
786 * return the "intvec" lead exponent of a polynomial *
787 *****************************************************/
788static intvec* MExpPol(poly f)
789{
790  int i, nR = currRing->N;
791  intvec* result = new intvec(nR);
792
793  for(i=nR-1; i>=0; i--)
794    (*result)[i] = pGetExp(f,i+1);
795
796  return result;
797}
798
799/* return 1, if two given intvecs are the same, otherwise 0*/
800int MivSame(intvec* u , intvec* v)
801{
802  assume(u->length() == v->length());
803
804  int i, niv = u->length();
805
806  for (i=0; i<niv; i++)
807    if ((*u)[i] != (*v)[i])
808      return 0;
809
810  return 1;
811}
812
813int M3ivSame(intvec* temp, intvec* u , intvec* v)
814{
815  assume(temp->length() == u->length() && u->length() == v->length());
816
817  if((MivSame(temp, u)) == 1)
818    return 0;
819
820  if((MivSame(temp, v)) == 1)
821    return 1;
822
823  return 2;
824}
825
826
827/* compute a Groebner basis of an ideal */
828static ideal MstdCC(ideal G)
829{
830  int save_test=test;
831  test|=(Sy_bit(OPT_REDTAIL)|Sy_bit(OPT_REDSB));
832  ideal G1 = kStd(G, NULL, testHomog, NULL);
833  test=save_test;
834
835  idSkipZeroes(G1);
836  return G1;
837}
838
839
840/* compute a Groebner basis of a homogenoues ideal */
841static ideal MstdhomCC(ideal G)
842{
843  int save_test=test;
844  test|=(Sy_bit(OPT_REDTAIL)|Sy_bit(OPT_REDSB));
845  ideal G1 = kStd(G, NULL, isHomog, NULL);
846  test=save_test;
847
848  idSkipZeroes(G1);
849  return G1;
850}
851
852
853/*****************************************************************************
854* create a weight matrix order as intvec of an extra weight vector (a(iv),lp)*
855******************************************************************************/
856intvec* MivMatrixOrder(intvec* iv)
857{
858  int i,j, nR = iv->length();
859  intvec* ivm = new intvec(nR*nR);
860
861  for(i=0; i<nR; i++)
862    (*ivm)[i] = (*iv)[i];
863
864  for(i=1; i<nR; i++)
865    (*ivm)[i*nR+i-1] = 1;
866
867  return ivm;
868}
869
870/* return intvec = (1, ..., 1) */
871intvec* Mivdp(int nR)
872{
873  int i;
874  intvec* ivm = new intvec(nR);
875
876  for(i=nR-1; i>=0; i--)
877    (*ivm)[i] = 1;
878
879  return ivm;
880}
881
882/* return intvvec = (1,0, ..., 0) */
883intvec* Mivlp(int nR)
884{
885  int i;
886  intvec* ivm = new intvec(nR);
887  (*ivm)[0] = 1;
888
889  return ivm;
890}
891
892/**** 28.10.02  print the max total degree and the max coefficient of G***/
893static void checkComplexity(ideal G, char* cG)
894{
895  int nV = currRing->N;
896  int nG = IDELEMS(G);
897  intvec* ivUnit = Mivdp(nV);//19.02
898  int i,j, tmpdeg, maxdeg=0;
899  number tmpcoeff , maxcoeff=nNULL;
900  poly p;
901  for(i=nG-1; i>=0; i--)
902  {
903    tmpdeg = MwalkWeightDegree(G->m[i], ivUnit);
904    if (tmpdeg > maxdeg )
905      maxdeg = tmpdeg;
906  }
907
908  for(i=nG-1; i>=0; i--)
909  {
910    p = pCopy(G->m[i]);
911    while(p != NULL)
912    {
913      //tmpcoeff = pGetCoeff(pHead(p));
914      tmpcoeff = pGetCoeff(p);
915      if(nGreater(tmpcoeff,maxcoeff))
916         maxcoeff = nCopy(tmpcoeff);
917      pIter(p);
918    }
919    pDelete(&p);
920  }
921  p = pNSet(maxcoeff);
922  char* pStr = pString(p);
923  Print("// max total degree of %s = %d\n",cG, maxdeg);
924  Print("// max coefficient of %s  = %s", cG, pStr);//ing(p));
925  Print(" which consists of %d digits", strlen(pStr));
926  PrintLn();
927}
928
929
930
931/*****************************************************************************
932* If target_ord = intmat(A1, ..., An) then calculate the perturbation        *
933* vectors                                                                    *
934*   tau_p_dep = inveps^(p_deg-1)*A1 + inveps^(p_deg-2)*A2 +... + A_p_deg     *
935* where                                                                      *
936*      inveps > totaldegree(G)*(max(A2)+...+max(A_p_deg))                    *
937* intmat target_ord is an integer order matrix of the monomial ordering of   *
938* basering.                                                                  *
939* This programm computes a perturbated vector with a p_deg perturbation      *
940* degree which smaller than the numbers of variables                         *
941******************************************************************************/
942/* ivtarget is a matrix order of a degree reverse lex. order */
943intvec* MPertVectors(ideal G, intvec* ivtarget, int pdeg)
944{
945  int nV = currRing->N;
946  //assume(pdeg <= nV && pdeg >= 0);
947
948  int i, j, nG = IDELEMS(G);
949  intvec* v_null =  new intvec(nV);
950
951
952  //Checking that the perturbed degree is valid
953  if(pdeg > nV || pdeg <= 0)
954  {
955    WerrorS("//** The perturbed degree is wrong!!");
956    return v_null;
957  }
958  delete v_null;
959
960  if(pdeg == 1)
961    return ivtarget;
962
963  mpz_t *pert_vector=(mpz_t*)omAlloc(nV*sizeof(mpz_t));
964
965  for(i=0; i<nV; i++)
966    mpz_init_set_si(pert_vector[i], (*ivtarget)[i]);
967
968
969  // Calculate max1 = Max(A2)+Max(A3)+...+Max(Apdeg),
970  // where the Ai are the i-te rows of the matrix target_ord.
971
972  int ntemp, maxAi, maxA=0;
973  for(i=1; i<pdeg; i++)
974  {
975    maxAi = (*ivtarget)[i*nV];
976    if(maxAi<0) maxAi = -maxAi;
977
978    for(j=i*nV+1; j<(i+1)*nV; j++)
979    {
980      ntemp = (*ivtarget)[j];
981      if(ntemp < 0) ntemp = -ntemp;
982
983      if(ntemp > maxAi)
984        maxAi = ntemp;
985    }
986    maxA += maxAi;
987  }
988
989  // Calculate inveps = 1/eps, where 1/eps > totaldeg(p)*max1 for all p in G.
990
991  intvec* ivUnit = Mivdp(nV);
992
993  mpz_t tot_deg; mpz_init(tot_deg);
994  mpz_t maxdeg; mpz_init(maxdeg);
995  mpz_t inveps; mpz_init(inveps);
996
997
998  for(i=nG-1; i>=0; i--)
999  {
1000    mpz_set_ui(maxdeg, MwalkWeightDegree(G->m[i], ivUnit));
1001    if (mpz_cmp(maxdeg,  tot_deg) > 0 )
1002      mpz_set(tot_deg, maxdeg);
1003  }
1004
1005  delete ivUnit;
1006  mpz_mul_ui(inveps, tot_deg, maxA);
1007  mpz_add_ui(inveps, inveps, 1);
1008
1009
1010  //xx1.06.02 takes  "small" inveps
1011#ifdef INVEPS_SMALL_IN_MPERTVECTOR
1012  if(mpz_cmp_ui(inveps, pdeg)>0 && pdeg > 3)
1013  {
1014    /*
1015      Print("\n// choose the\"small\" inverse epsilon := %d / %d = ",
1016      mpz_get_si(inveps), pdeg);
1017    */
1018    mpz_fdiv_q_ui(inveps, inveps, pdeg);
1019    //mpz_out_str(stdout, 10, inveps);
1020  }
1021#else
1022  //PrintS("\n// the \"big\" inverse epsilon: ");
1023  mpz_out_str(stdout, 10, inveps);
1024#endif
1025
1026  // pert(A1) = inveps^(pdeg-1)*A1 + inveps^(pdeg-2)*A2+...+A_pdeg,
1027  // pert_vector := A1
1028  for ( i=1; i < pdeg; i++ )
1029    for(j=0; j<nV; j++)
1030    {
1031      mpz_mul(pert_vector[j], pert_vector[j], inveps);
1032      if((*ivtarget)[i*nV+j]<0)
1033        mpz_sub_ui(pert_vector[j], pert_vector[j],-(*ivtarget)[i*nV+j]);
1034      else
1035        mpz_add_ui(pert_vector[j], pert_vector[j],(*ivtarget)[i*nV+j]);
1036    }
1037
1038  mpz_t ztemp;
1039  mpz_init(ztemp);
1040  mpz_set(ztemp, pert_vector[0]);
1041  for(i=1; i<nV; i++)
1042  {
1043    mpz_gcd(ztemp, ztemp, pert_vector[i]);
1044    if(mpz_cmp_si(ztemp, 1)  == 0)
1045      break;
1046  }
1047  if(mpz_cmp_si(ztemp, 1) != 0)
1048    for(i=0; i<nV; i++)
1049      mpz_divexact(pert_vector[i], pert_vector[i], ztemp);
1050
1051  intvec* result = new intvec(nV);
1052  /* 2147483647 is max. integer representation in SINGULAR */
1053  mpz_t sing_int;
1054  mpz_init_set_ui(sing_int,  2147483647);
1055
1056  int ntrue=0;
1057  for(i=0; i<nV; i++)
1058  {
1059    (*result)[i] = mpz_get_si(pert_vector[i]);
1060
1061    if(mpz_cmp(pert_vector[i], sing_int)>=0)
1062    {
1063      ntrue++;
1064      if(Overflow_Error == FALSE)
1065      {
1066        Overflow_Error = TRUE;
1067        PrintS("\n// ** OVERFLOW in \"MPertvectors\": ");
1068        mpz_out_str( stdout, 10, pert_vector[i]);
1069        PrintS(" is greater than 2147483647 (max. integer representation)");
1070        Print("\n//  So vector[%d] := %d is wrong!!", i+1, (*result)[i]);
1071      }
1072    }
1073  }
1074
1075  if(Overflow_Error == TRUE)
1076  {
1077    ivString(result, "pert_vector");
1078    Print("\n// %d element(s) of it is overflow!!", ntrue);
1079  }
1080
1081  mpz_clear(ztemp);
1082  mpz_clear(sing_int);
1083  omFree(pert_vector);
1084  return result;
1085}
1086
1087
1088/* ivtarget is a matrix order of the lex. order */
1089intvec* MPertVectorslp(ideal G, intvec* ivtarget, int pdeg)
1090{
1091  int nV = currRing->N;
1092  //assume(pdeg <= nV && pdeg >= 0);
1093
1094  int i, j, nG = IDELEMS(G);
1095  intvec* pert_vector =  new intvec(nV);
1096
1097  //Checking that the perturbated degree is valid
1098  if(pdeg > nV || pdeg <= 0)
1099  {
1100    WerrorS("//** The perturbed degree is wrong!!");
1101    return pert_vector;
1102  }
1103  for(i=0; i<nV; i++)
1104    (*pert_vector)[i]=(*ivtarget)[i];
1105
1106  if(pdeg == 1)
1107    return pert_vector;
1108
1109  // Calculate max1 = Max(A2)+Max(A3)+...+Max(Apdeg),
1110  // where the Ai are the i-te rows of the matrix target_ord.
1111  int ntemp, maxAi, maxA=0;
1112  for(i=1; i<pdeg; i++)
1113  {
1114    maxAi = (*ivtarget)[i*nV];
1115    for(j=i*nV+1; j<(i+1)*nV; j++)
1116    {
1117      ntemp = (*ivtarget)[j];
1118      if(ntemp > maxAi)
1119        maxAi = ntemp;
1120    }
1121    maxA += maxAi;
1122  }
1123
1124  // Calculate inveps := 1/eps, where 1/eps > deg(p)*max1 for all p in G.
1125  int inveps, tot_deg = 0, maxdeg;
1126
1127  intvec* ivUnit = Mivdp(nV);//19.02
1128  for(i=nG-1; i>=0; i--)
1129  {
1130    //maxdeg = pTotaldegree(G->m[i], currRing); //it's wrong for ex1,2,rose
1131    maxdeg = MwalkWeightDegree(G->m[i], ivUnit);
1132    if (maxdeg > tot_deg )
1133      tot_deg = maxdeg;
1134  }
1135  delete ivUnit;
1136
1137  inveps = (tot_deg * maxA) + 1;
1138
1139  //9.10.01
1140#ifdef INVEPS_SMALL_IN_FRACTAL
1141  /*
1142    Print("\n// choose the\"small\" inverse epsilon := %d / %d = ",
1143    inveps, pdeg);
1144  */
1145  if(inveps > pdeg && pdeg > 3)
1146    inveps = inveps / pdeg;
1147
1148  //Print(" %d", inveps);
1149#else
1150  PrintS("\n// the \"big\" inverse epsilon %d", inveps);
1151#endif
1152
1153  // Pert(A1) = inveps^(pdeg-1)*A1 + inveps^(pdeg-2)*A2+...+A_pdeg,
1154  for ( i=1; i < pdeg; i++ )
1155    for(j=0; j<nV; j++)
1156      (*pert_vector)[j] = inveps*((*pert_vector)[j]) + (*ivtarget)[i*nV+j];
1157
1158  int temp = (*pert_vector)[0];
1159  for(i=1; i<nV; i++)
1160  {
1161    temp = gcd(temp, (*pert_vector)[i]);
1162    if(temp == 1)
1163      break;
1164  }
1165  if(temp != 1)
1166    for(i=0; i<nV; i++)
1167      (*pert_vector)[i] = (*pert_vector)[i] / temp;
1168
1169  intvec* result = pert_vector;
1170  pert_vector = NULL;
1171  return result;
1172}
1173
1174
1175/* define a lexicographic order matrix as intvec */
1176intvec* MivMatrixOrderlp(int nV)
1177{
1178  int i;
1179  intvec* ivM = new intvec(nV*nV);
1180
1181  for(i=0; i<nV; i++)
1182    (*ivM)[i*nV + i] = 1;
1183
1184  return(ivM);
1185}
1186
1187/* define a rlex order (dp) matrix as intvec */
1188intvec* MivMatrixOrderdp(int nV)
1189{
1190  int i;
1191  intvec* ivM = new intvec(nV*nV);
1192
1193  for(i=0; i<nV; i++)
1194    (*ivM)[i] = 1;
1195
1196  for(i=1; i<nV; i++)
1197    (*ivM)[(i+1)*nV - i] = -1;
1198
1199  return(ivM);
1200}
1201
1202//creates an intvec of the monomial order Wp(ivstart)
1203intvec* MivWeightOrderlp(intvec* ivstart)
1204{
1205  int i;
1206  int nV = ivstart->length();
1207  intvec* ivM = new intvec(nV*nV);
1208
1209  for(i=0; i<nV; i++)
1210    (*ivM)[i] = (*ivstart)[i];
1211
1212  for(i=1; i<nV; i++)
1213    (*ivM)[i*nV + i-1] = 1;
1214
1215  return(ivM);
1216}
1217
1218intvec* MivWeightOrderdp(intvec* ivstart)
1219{
1220  int i;
1221  int nV = ivstart->length();
1222  intvec* ivM = new intvec(nV*nV);
1223
1224  for(i=0; i<nV; i++)
1225    (*ivM)[i] = (*ivstart)[i];
1226
1227  for(i=0; i<nV; i++)
1228    (*ivM)[nV+i] = 1;
1229
1230  for(i=2; i<nV; i++)
1231    (*ivM)[(i+1)*nV - i] = -1;
1232
1233  return(ivM);
1234}
1235
1236static intvec* MatrixOrderdp(int nV)
1237{
1238  int i;
1239  intvec* ivM = new intvec(nV*nV);
1240
1241  for(i=0; i<nV; i++)
1242    (*ivM)[i] = 1;
1243
1244  for(i=1; i<nV; i++)
1245    (*ivM)[(i+1)*nV - i] = -1;
1246
1247  return(ivM);
1248}
1249
1250intvec* MivUnit(int nV)
1251{
1252  int i;
1253  intvec* ivM = new intvec(nV);
1254
1255  for(i=nV-1; i>=0; i--)
1256    (*ivM)[i] = 1;
1257
1258  return(ivM);
1259}
1260
1261
1262/************************************************************************
1263*  compute a perturbed weight vector of a matrix order w.r.t. an ideal  *
1264*************************************************************************/
1265int Xnlev;
1266
1267intvec* Mfpertvector(ideal G, intvec* ivtarget)
1268{
1269  int i, j, nG = IDELEMS(G);
1270  int nV = currRing->N;
1271  int niv = nV*nV;
1272
1273  // Calculate max1 = Max(A2) + Max(A3) + ... + Max(AnV),
1274  // where the Ai are the i-te rows of the matrix 'targer_ord'.
1275  int ntemp, maxAi, maxA=0;
1276  for(i=1; i<nV; i++)
1277  {
1278    maxAi = (*ivtarget)[i*nV];
1279    if(maxAi<0) maxAi = -maxAi;
1280
1281    for(j=i*nV+1; j<(i+1)*nV; j++)
1282    {
1283      ntemp = (*ivtarget)[j];
1284      if(ntemp < 0) ntemp = -ntemp;
1285
1286      if(ntemp > maxAi)
1287        maxAi = ntemp;
1288    }
1289    maxA = maxA + maxAi;
1290  }
1291  intvec* ivUnit = Mivdp(nV);
1292
1293  // Calculate inveps = 1/eps, where 1/eps > deg(p)*max1 for all p in G.
1294  mpz_t tot_deg; mpz_init(tot_deg);
1295  mpz_t maxdeg; mpz_init(maxdeg);
1296  mpz_t inveps; mpz_init(inveps);
1297
1298
1299  for(i=nG-1; i>=0; i--)
1300  {
1301    mpz_set_ui(maxdeg, MwalkWeightDegree(G->m[i], ivUnit));
1302    if (mpz_cmp(maxdeg,  tot_deg) > 0 )
1303      mpz_set(tot_deg, maxdeg);
1304  }
1305
1306  delete ivUnit;
1307  //inveps = (tot_deg * maxA) + 1;
1308  mpz_mul_ui(inveps, tot_deg, maxA);
1309  mpz_add_ui(inveps, inveps, 1);
1310
1311  //xx1.06.02 takes  "small" inveps
1312#ifdef INVEPS_SMALL_IN_FRACTAL
1313  if(mpz_cmp_ui(inveps, nV)>0 && nV > 3)
1314    mpz_cdiv_q_ui(inveps, inveps, nV);
1315
1316  //PrintS("\n// choose the \"small\" inverse epsilon!");
1317#endif
1318
1319  // PrintLn();  mpz_out_str(stdout, 10, inveps);
1320
1321  // Calculate the perturbed target orders:
1322  mpz_t *ivtemp=(mpz_t *)omAlloc(nV*sizeof(mpz_t));
1323  mpz_t *pert_vector=(mpz_t *)omAlloc(niv*sizeof(mpz_t));
1324
1325  for(i=0; i<nV; i++)
1326  {
1327    mpz_init_set_si(ivtemp[i], (*ivtarget)[i]);
1328    mpz_init_set_si(pert_vector[i], (*ivtarget)[i]);
1329  }
1330
1331  mpz_t ztmp; mpz_init(ztmp);
1332  BOOLEAN isneg = FALSE;
1333
1334  for(i=1; i<nV; i++)
1335  {
1336    for(j=0; j<nV; j++)
1337    {
1338      mpz_mul(ztmp, inveps, ivtemp[j]);
1339
1340      if((*ivtarget)[i*nV+j]<0)
1341        mpz_sub_ui(ivtemp[j], ztmp, -(*ivtarget)[i*nV+j]);
1342      else
1343        mpz_add_ui(ivtemp[j], ztmp,(*ivtarget)[i*nV+j]);
1344    }
1345
1346    for(j=0; j<nV; j++)
1347      mpz_init_set(pert_vector[i*nV+j],ivtemp[j]);
1348  }
1349
1350  /* 2147483647 is max. integer representation in SINGULAR */
1351  mpz_t sing_int;
1352  mpz_init_set_ui(sing_int,  2147483647);
1353
1354  intvec* result = new intvec(niv);
1355  BOOLEAN nflow = FALSE;
1356
1357  // computes gcd
1358  mpz_set(ztmp, pert_vector[0]);
1359  for(i=0; i<niv; i++)
1360  {
1361    mpz_gcd(ztmp, ztmp, pert_vector[i]);
1362    if(mpz_cmp_si(ztmp, 1)==0)
1363      break;
1364  }
1365
1366  for(i=0; i<niv; i++)
1367  {
1368    mpz_divexact(pert_vector[i], pert_vector[i], ztmp);
1369    (* result)[i] = mpz_get_si(pert_vector[i]);
1370
1371    if(mpz_cmp(pert_vector[i], sing_int)>0)
1372      if(nflow == FALSE)
1373      {
1374        Xnlev = i / nV;
1375        nflow = TRUE;
1376        Overflow_Error = TRUE;
1377
1378        Print("\n// Xlev = %d and the %d-th element is", Xnlev,  i+1);
1379        PrintS("\n// ** OVERFLOW in \"Mfpertvector\": ");
1380        mpz_out_str( stdout, 10, pert_vector[i]);
1381        PrintS(" is greater than 2147483647 (max. integer representation)");
1382        Print("\n//  So vector[%d] := %d is wrong!!", i+1, (*result)[i]);
1383      }
1384  }
1385
1386  if(Overflow_Error == TRUE)
1387    ivString(result, "new_vector");
1388
1389  omFree(pert_vector);
1390  omFree(ivtemp);
1391  mpz_clear(ztmp);
1392
1393  return result;
1394}
1395
1396/****************************************************************
1397 * Multiplikation of two ideals by elementwise                  *
1398 * i.e. Let be A := (a_i) and B := (b_i), return C := (a_i*b_i) *
1399 *  destroy A, keeps B                                          *
1400 ****************************************************************/
1401static ideal MidMult(ideal A, ideal B)
1402{
1403  int mA = IDELEMS(A), mB = IDELEMS(B);
1404
1405  if(A==NULL || B==NULL)
1406    return NULL;
1407
1408  if(mB < mA)
1409    mA = mB;
1410
1411  ideal result = idInit(mA, 1);
1412
1413  int i, k=0;
1414  for(i=0; i<mA; i++)
1415    {
1416      result->m[k] = pMult(A->m[i], pCopy(B->m[i]));
1417      A->m[i]=NULL;
1418      if (result->m[k]!=NULL) k++;
1419    }
1420
1421  idDelete(&A);
1422  idSkipZeroes(result);
1423  return result;
1424}
1425
1426/*********************************************************************
1427 * G is a red. Groebner basis w.r.t. <_1                             *
1428 * Gomega is an initial form ideal of <G> w.r.t. a weight vector w   *
1429 * M is a subideal of <Gomega> and M selft is a red. Groebner basis  *
1430 *    of the ideal <Gomega> w.r.t. <_w                               *
1431 * Let m_i = h1.gw1 + ... + hs.gws for each m_i in M; gwi in Gomega  *
1432 * return F with n(F) = n(M) and f_i = h1.g1 + ... + hs.gs for each i*
1433 ********************************************************************/
1434static ideal MLifttwoIdeal(ideal Gw, ideal M, ideal G)
1435{
1436  ideal Mtmp = idLift(Gw, M, NULL, FALSE, TRUE, TRUE, NULL);
1437
1438  //3.12.02 Note: if Gw is a GB, then isSB = TRUE, otherwise FALSE
1439  //So, it is better, if one tests whether Gw is a GB
1440  //in ideals.cc:
1441  //idLift (ideal mod, ideal submod,ideal * rest, BOOLEAN goodShape,
1442  //           BOOLEAN isSB,BOOLEAN divide,matrix * unit)
1443
1444  /* Let be Mtmp = {m1,...,ms}, where mi=sum hij.in_gj, for all i=1,...,s
1445     We compute F = {f1,...,fs}, where fi=sum hij.gj */
1446  int i, j, nM = IDELEMS(Mtmp);
1447  ideal idpol, idLG;
1448  ideal F = idInit(nM, 1);
1449
1450  for(i=0; i<nM; i++)
1451  {
1452     idpol = idVec2Ideal(Mtmp->m[i]);
1453     idLG = MidMult(idpol, G);
1454     idpol = NULL;
1455     F->m[i] = NULL;
1456     for(j=IDELEMS(idLG)-1; j>=0; j--)
1457     {
1458       F->m[i] = pAdd(F->m[i], idLG->m[j]);
1459       idLG->m[j]=NULL;
1460     }
1461     idDelete(&idLG);
1462  }
1463  idDelete(&Mtmp);
1464  return F;
1465}
1466
1467
1468static void checkidealCC(ideal G, char* Ch)
1469{
1470  int i,nmon=0,ntmp;
1471  int nG = IDELEMS(G);
1472  int n = nG-1;
1473  Print("\n//** Ideal %s besteht aus %d Polynomen mit ", Ch, nG);
1474
1475  for(i=0; i<nG; i++)
1476  {
1477    ntmp =  pLength(G->m[i]);
1478    nmon += ntmp;
1479
1480    if(i != n)
1481      Print("%d, ", ntmp);
1482    else
1483      Print(" bzw. %d ", ntmp);
1484  }
1485  PrintS(" Monomen.\n");
1486  Print("//** %s besitzt %d Monome.", Ch, nmon);
1487  PrintLn();
1488}
1489
1490static void HeadidString(ideal L, char* st)
1491{
1492  int i, nL = IDELEMS(L)-1;
1493
1494  Print("//  The head terms of the ideal %s = ", st);
1495  for(i=0; i<nL; i++)
1496    Print(" %s, ", pString(pHead(L->m[i])));
1497
1498  Print(" %s;\n", pString(pHead(L->m[nL])));
1499}
1500
1501static inline int MivComp(intvec* iva, intvec* ivb)
1502{
1503  assume(iva->length() == ivb->length());
1504  int i;
1505
1506  for(i=iva->length()-1; i>=0; i--)
1507    if((*iva)[i] - (*ivb)[i] != 0)
1508      return 0;
1509
1510  return 1;
1511}
1512
1513
1514/*
1515  compute a next weight vector between curr_weight and target_weight
1516  with respect to an ideal G.
1517*/
1518static intvec* MwalkNextWeightCC(intvec* curr_weight, intvec* target_weight,
1519                                 ideal G)
1520{
1521  BOOLEAN nError = Overflow_Error;
1522  Overflow_Error = FALSE;
1523
1524  assume(currRing != NULL && curr_weight != NULL &&
1525         target_weight != NULL && G != NULL);
1526
1527  int nRing = currRing->N;
1528  int j, nG = IDELEMS(G);
1529  intvec* ivtemp;
1530
1531  mpz_t t_zaehler, t_nenner;
1532  mpz_init(t_zaehler);
1533  mpz_init(t_nenner);
1534
1535  mpz_t s_zaehler, s_nenner, temp, MwWd;
1536  mpz_init(s_zaehler);
1537  mpz_init(s_nenner);
1538  mpz_init(temp);
1539  mpz_init(MwWd);
1540
1541
1542  mpz_t deg_w0_p1, deg_d0_p1;
1543  mpz_init(deg_w0_p1);
1544  mpz_init(deg_d0_p1);
1545
1546  mpz_t sztn, sntz;
1547  mpz_init(sztn);
1548  mpz_init(sntz);
1549  mpz_t t_null;
1550  mpz_init(t_null);
1551
1552  mpz_t ggt;
1553
1554  int tn0, tn1, tz1, ncmp, gcd_tmp, ntmp;
1555  intvec* diff_weight = MivSub(target_weight, curr_weight);
1556
1557  poly g, gw;
1558  for (j=0; j<nG; j++)
1559  {
1560    g = G->m[j];
1561    if (g != NULL)
1562    {
1563      ivtemp = MExpPol(g);
1564      mpz_set_si(deg_w0_p1, MivDotProduct(ivtemp, curr_weight));
1565      mpz_set_si(deg_d0_p1, MivDotProduct(ivtemp, diff_weight));
1566      delete ivtemp;
1567
1568      pIter(g);
1569      while (g != NULL)
1570      {
1571        ivtemp = MExpPol(g);
1572        mpz_set_si(MwWd, MivDotProduct(ivtemp, curr_weight));
1573        mpz_sub(s_zaehler, deg_w0_p1, MwWd);
1574
1575        if(mpz_cmp(s_zaehler, t_null) != 0)
1576        {
1577          mpz_set_si(MwWd, MivDotProduct(ivtemp, diff_weight));
1578          mpz_sub(s_nenner, MwWd, deg_d0_p1);
1579
1580          // check for 0 < s <= 1
1581          if( (mpz_cmp(s_zaehler,t_null) > 0 &&
1582               mpz_cmp(s_nenner, s_zaehler)>=0) ||
1583              (mpz_cmp(s_zaehler, t_null) < 0 &&
1584               mpz_cmp(s_nenner, s_zaehler)<=0))
1585          {
1586            // make both positive
1587            if (mpz_cmp(s_zaehler, t_null) < 0)
1588            {
1589              mpz_neg(s_zaehler, s_zaehler);
1590              mpz_neg(s_nenner, s_nenner);
1591            }
1592
1593            //compute a simply fraction of s
1594            cancel(s_zaehler, s_nenner);
1595
1596            if(mpz_cmp(t_nenner, t_null) != 0)
1597            {
1598              mpz_mul(sztn, s_zaehler, t_nenner);
1599              mpz_mul(sntz, s_nenner, t_zaehler);
1600
1601              if(mpz_cmp(sztn,sntz) < 0)
1602              {
1603                mpz_add(t_nenner, t_null, s_nenner);
1604                mpz_add(t_zaehler,t_null, s_zaehler);
1605              }
1606            }
1607            else
1608            {
1609              mpz_add(t_nenner, t_null, s_nenner);
1610              mpz_add(t_zaehler,t_null, s_zaehler);
1611            }
1612          }
1613        }
1614        pIter(g);
1615        delete ivtemp;
1616      }
1617    }
1618  }
1619
1620  mpz_t *vec=(mpz_t*)omAlloc(nRing*sizeof(mpz_t));
1621
1622  /* there is no 0<t<1 and define the next weight vector that is equal to
1623     the current weight vector */
1624  if(mpz_cmp(t_nenner, t_null) == 0)
1625  {
1626    delete diff_weight;
1627    diff_weight = ivCopy(curr_weight);//take memory
1628    goto FINISH;
1629  }
1630
1631  /* define the target vector as the next weight vector, if t = 1 */
1632  if(mpz_cmp_si(t_nenner, 1)==0 && mpz_cmp_si(t_zaehler,1)==0)
1633  {
1634    delete diff_weight;
1635    diff_weight = ivCopy(target_weight); //this takes memory
1636    goto FINISH;
1637  }
1638
1639
1640  //14.08.03 simplify the both vectors  curr_weight and diff_weight (C-int)
1641  gcd_tmp = (*curr_weight)[0];
1642
1643  for (j=1; j<nRing; j++)
1644  {
1645    gcd_tmp = gcd(gcd_tmp, (*curr_weight)[j]);
1646    if(gcd_tmp == 1)
1647      break;
1648  }
1649
1650  if(gcd_tmp != 1)
1651    for (j=0; j<nRing; j++)
1652    {
1653      gcd_tmp = gcd(gcd_tmp, (*diff_weight)[j]);
1654      if(gcd_tmp == 1)
1655        break;
1656    }
1657
1658  if(gcd_tmp != 1)
1659    for (j=0; j<nRing; j++)
1660    {
1661      (*curr_weight)[j] =  (*curr_weight)[j]/gcd_tmp;
1662      (*diff_weight)[j] =  (*diff_weight)[j]/gcd_tmp;
1663    }
1664#ifdef  NEXT_VECTORS_CC
1665  Print("\n// gcd of the weight vectors (current and target) = %d", gcd_tmp);
1666  ivString(curr_weight, "new cw");
1667  ivString(diff_weight, "new dw");
1668
1669  PrintS("\n// t_zaehler: ");  mpz_out_str( stdout, 10, t_zaehler);
1670  PrintS(", t_nenner: ");  mpz_out_str( stdout, 10, t_nenner);
1671#endif
1672
1673  mpz_t ddf; mpz_init(ddf);
1674  mpz_t dcw; mpz_init(dcw);
1675  BOOLEAN isdwpos;
1676
1677  // construct a new weight vector
1678  for (j=0; j<nRing; j++)
1679  {
1680    mpz_set_si(dcw, (*curr_weight)[j]);
1681    mpz_mul(s_nenner, t_nenner, dcw);
1682
1683    if( (*diff_weight)[j]>0)
1684      mpz_mul_ui(s_zaehler, t_zaehler, (*diff_weight)[j]);
1685    else
1686    {
1687      mpz_mul_ui(s_zaehler, t_zaehler, -(*diff_weight)[j]);
1688      mpz_neg(s_zaehler, s_zaehler);
1689    }
1690
1691    mpz_add(sntz, s_nenner, s_zaehler);
1692
1693    mpz_init_set(vec[j], sntz);
1694
1695#ifdef NEXT_VECTORS_CC
1696    Print("\n//   j = %d ==> ", j);
1697    PrintS("(");
1698    mpz_out_str( stdout, 10, t_nenner);
1699    Print(" * %d)", (*curr_weight)[j]);
1700    Print(" + ("); mpz_out_str( stdout, 10, t_zaehler);
1701    Print(" * %d) =  ",  (*diff_weight)[j]);
1702    mpz_out_str( stdout, 10, s_nenner);
1703    PrintS(" + ");
1704    mpz_out_str( stdout, 10, s_zaehler);
1705    PrintS(" = "); mpz_out_str( stdout, 10, sntz);
1706    Print(" ==> vector[%d]: ", j); mpz_out_str(stdout, 10, vec[j]);
1707#endif
1708
1709    if(j==0)
1710      mpz_init_set(ggt, sntz);
1711    else
1712      if(mpz_cmp_si(ggt,1) != 0)
1713        mpz_gcd(ggt, ggt, sntz);
1714
1715  }
1716
1717#ifdef  NEXT_VECTORS_CC
1718  PrintS("\n// gcd of elements of the vector: ");
1719  mpz_out_str( stdout, 10, ggt);
1720#endif
1721
1722  mpz_t omega;
1723  mpz_t sing_int;
1724  mpz_init_set_ui(sing_int,  2147483647);
1725
1726  /* construct a new weight vector and check whether vec[j] is overflow!!
1727     i.e. vec[j] > 2^31.
1728     If vec[j] doesn't overflow, define a weight vector
1729     otherwise, report that overflow appears.
1730     In the second case test whether the defined new vector correct is
1731     plays an important rolle */
1732
1733  for (j=0; j<nRing; j++)
1734  {
1735    if(mpz_cmp_si(ggt,1)==0)
1736      (*diff_weight)[j] = mpz_get_si(vec[j]);
1737    else
1738    {
1739      mpz_divexact(vec[j], vec[j], ggt);
1740      (*diff_weight)[j] = mpz_get_si(vec[j]);
1741    }
1742
1743    if(mpz_cmp(vec[j], sing_int)>=0)
1744      if(Overflow_Error == FALSE)
1745      {
1746        Overflow_Error = TRUE;
1747
1748        PrintS("\n// ** OVERFLOW in \"NextVector\": ");
1749        mpz_out_str( stdout, 10, vec[j]);
1750        PrintS(" is greater than 2147483647 (max. integer representation)");
1751        Print("\n//  So vector[%d] := %d is wrong!!\n",j+1, (*diff_weight)[j]);
1752      }
1753  }
1754
1755 FINISH:
1756
1757   mpz_clear(t_zaehler);
1758   mpz_clear(t_nenner);
1759   mpz_clear(sntz);
1760   mpz_clear(sztn);
1761   mpz_clear(temp);
1762   mpz_clear(MwWd);
1763   mpz_clear(deg_w0_p1);
1764   mpz_clear(deg_d0_p1);
1765   omFree(vec);
1766
1767  if(Overflow_Error == FALSE)
1768    Overflow_Error = nError;
1769
1770   return diff_weight;
1771}
1772
1773/*
1774   compute an intermediate weight vector from iva to ivb w.r.t.
1775   the reduced Groebner basis G.
1776   Return NULL, if it is equal to iva or iva = avb.
1777*/
1778intvec* MkInterRedNextWeight(intvec* iva, intvec* ivb, ideal G)
1779{
1780  intvec* tmp = new intvec(iva->length());
1781  intvec* result;
1782
1783  if(G == NULL)
1784    return tmp;
1785
1786  if(MivComp(iva, ivb) == 1)
1787    return tmp;
1788
1789  result = MwalkNextWeightCC(iva, ivb, G);
1790
1791  if(MivComp(result, iva) == 1)
1792  {
1793    delete result;
1794    return tmp;
1795  }
1796
1797  delete tmp;
1798  return result;
1799}
1800
1801/* 01.11.01 */
1802/* define and execute a new ring which order is (a(va),lp,C) */
1803static void VMrDefault(intvec* va)
1804{
1805  idhdl tmp = enterid(IDID(currRingHdl),IDLEV(currRingHdl)+1,RING_CMD,&IDROOT,TRUE);
1806  //3.11.01
1807
1808  if (ppNoether!=NULL)
1809    pDelete(&ppNoether);
1810
1811  if (((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING)) ||
1812      ((sLastPrinted.rtyp==LIST_CMD)&&(lRingDependend((lists)sLastPrinted.data))))
1813
1814  {
1815    sLastPrinted.CleanUp();
1816    memset(&sLastPrinted,0,sizeof(sleftv));
1817  }
1818
1819  ring r = IDRING(tmp);
1820  int i, nv = currRing->N;
1821
1822  r->ch  = currRing->ch;
1823  r->N   = currRing->N;
1824  int nb = rBlocks(currRing) + 1;//31.10.01 (+1)
1825
1826  /*names*/
1827  char* Q; //30.10.01 to avoid the corrupted memory, NOT change!!
1828  r->names = (char **) omAlloc0(nv * sizeof(char_ptr));
1829  for(i=0; i<nv; i++)
1830  {
1831    Q = currRing->names[i];
1832    r->names[i]  = omStrDup(Q);
1833  }
1834
1835  intvec* iva = va;  //why?
1836  /*weights: entries for 3 blocks: NULL Made:???*/
1837  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
1838  r->wvhdl[0] = (int*) omAlloc(nv*sizeof(int));
1839  for(i=0; i<nv; i++)
1840    r->wvhdl[0][i] = (*iva)[i];
1841
1842  /* order: a,lp,C,0 */
1843  r->order = (int *) omAlloc(nb * sizeof(int *));
1844  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
1845  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
1846
1847  /* ringorder a for the first block: var 1..nv */
1848  r->order[0]  = ringorder_a;
1849  r->block0[0] = 1;
1850  r->block1[0] = nv;
1851
1852  /* ringorder lp for the second block: var 1..nv */
1853  r->order[1]  = ringorder_lp;
1854  r->block0[1] = 1;
1855  r->block1[1] = nv;
1856
1857  /* ringorder C for the third block */
1858  // it is very important within "idLift",
1859  // especially, by ring syz_ring=rCurrRingAssure_SyzComp();
1860  // therefore, nb  must be (nBlocks(currRing)  + 1)
1861  r->order[2]  = ringorder_C;
1862
1863  /* the last block: everything is 0 */
1864  r->order[3]  = 0;
1865
1866  /*polynomial ring*/
1867  r->OrdSgn    = 1;
1868
1869  /* complete ring intializations */
1870  rComplete(r);
1871
1872  rChangeCurrRing(r);
1873  currRingHdl = tmp;
1874}
1875
1876/* 03.11.01 */
1877/* define and execute a new ring which order is  a lexicographic order */
1878static void VMrDefaultlp(void)
1879{
1880  idhdl tmp = enterid(IDID(currRingHdl),IDLEV(currRingHdl)+1,RING_CMD,&IDROOT,TRUE);
1881
1882
1883  if (ppNoether!=NULL)
1884    pDelete(&ppNoether);
1885
1886  if (((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING)) ||
1887      ((sLastPrinted.rtyp==LIST_CMD)&&(lRingDependend((lists)sLastPrinted.data))))
1888
1889  {
1890    sLastPrinted.CleanUp();
1891    memset(&sLastPrinted,0,sizeof(sleftv));
1892  }
1893
1894  ring r = IDRING(tmp);
1895  int i, nv = currRing->N;
1896
1897  r->ch  = currRing->ch;
1898  r->N   = currRing->N;
1899  int nb = rBlocks(currRing) + 1;//31.10.01 (+1)
1900
1901  /*names*/
1902  char* Q; //30.10.01 to avoid the corrupted memory, NOT change!!
1903  r->names = (char **) omAlloc0(nv * sizeof(char_ptr));
1904  for(i=0; i<nv; i++)
1905  {
1906    Q = currRing->names[i];
1907    r->names[i]  = omStrDup(Q);
1908  }
1909
1910  /*weights: entries for 3 blocks: NULL Made:???*/
1911
1912  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
1913
1914  /* order: lp,C,0 */
1915  r->order = (int *) omAlloc(nb * sizeof(int *));
1916  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
1917  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
1918
1919  /* ringorder lp for the first block: var 1..nv */
1920  r->order[0]  = ringorder_lp;
1921  r->block0[0] = 1;
1922  r->block1[0] = nv;
1923
1924  /* ringorder C for the second block */
1925  r->order[1]  = ringorder_C;
1926
1927  /* the last block: everything is 0 */
1928  r->order[2]  = 0;
1929
1930  /*polynomial ring*/
1931  r->OrdSgn    = 1;
1932
1933  /* complete ring intializations */
1934  rComplete(r);
1935
1936  //rSetHdl(tmp);
1937
1938  rChangeCurrRing(r);
1939  currRingHdl = tmp;
1940}
1941
1942
1943/* define a ring with parameters und change to it */
1944/* DefRingPar and DefRingParlp corrupt still memory */
1945static void DefRingPar(intvec* va)
1946{
1947  int i, nv = currRing->N;
1948  int nb = rBlocks(currRing) + 1;
1949
1950  ring res=(ring)omAllocBin(ip_sring_bin);
1951
1952  memcpy4(res,currRing,sizeof(ip_sring));
1953
1954  res->VarOffset = NULL;
1955  res->ref=0;
1956  if (currRing->algring!=NULL)
1957    currRing->algring->ref++;
1958
1959  if (currRing->parameter!=NULL)
1960  {
1961    res->minpoly=nCopy(currRing->minpoly);
1962    int l=rPar(currRing);
1963    res->parameter=(char **)omAlloc(l*sizeof(char_ptr));
1964
1965    for(i=l-1;i>=0;i--)
1966      res->parameter[i]=omStrDup(currRing->parameter[i]);
1967  }
1968
1969  intvec* iva = va;
1970
1971  /*weights: entries for 3 blocks: NULL Made:???*/
1972  res->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
1973  res->wvhdl[0] = (int*) omAlloc(nv*sizeof(int));
1974  for(i=0; i<nv; i++)
1975    res->wvhdl[0][i] = (*iva)[i];
1976
1977  /* order: a,lp,C,0 */
1978  res->order = (int *) omAlloc(nb * sizeof(int *));
1979  res->block0 = (int *)omAlloc0(nb * sizeof(int *));
1980  res->block1 = (int *)omAlloc0(nb * sizeof(int *));
1981
1982  /* ringorder a for the first block: var 1..nv */
1983  res->order[0]  = ringorder_a;
1984  res->block0[0] = 1;
1985  res->block1[0] = nv;
1986
1987  /* ringorder lp for the second block: var 1..nv */
1988  res->order[1]  = ringorder_lp;
1989  res->block0[1] = 1;
1990  res->block1[1] = nv;
1991
1992  /* ringorder C for the third block */
1993  // it is very important within "idLift",
1994  // especially, by ring syz_ring=rCurrRingAssure_SyzComp();
1995  // therefore, nb  must be (nBlocks(currRing)  + 1)
1996  res->order[2]  = ringorder_C;
1997
1998  /* the last block: everything is 0 */
1999  res->order[3]  = 0;
2000
2001  /*polynomial ring*/
2002  res->OrdSgn    = 1;
2003
2004
2005  res->names   = (char **)omAlloc0(nv * sizeof(char_ptr));
2006  for (i=nv-1; i>=0; i--)
2007    res->names[i] = omStrDup(currRing->names[i]);
2008
2009  /* complete ring intializations */
2010   rComplete(res);
2011
2012
2013  // clean up history
2014  if (sLastPrinted.RingDependend())
2015  {
2016    sLastPrinted.CleanUp();
2017    memset(&sLastPrinted,0,sizeof(sleftv));
2018  }
2019
2020
2021  /* execute the created ring */
2022  rChangeCurrRing(res);
2023}
2024
2025
2026static void DefRingParlp(void)
2027{
2028  int i, nv = currRing->N;
2029
2030  ring r=(ring)omAllocBin(ip_sring_bin);
2031
2032  memcpy4(r,currRing,sizeof(ip_sring));
2033
2034  r->VarOffset = NULL;
2035  r->ref=0;
2036  if (currRing->algring!=NULL)
2037    currRing->algring->ref++;
2038
2039  if (currRing->parameter!=NULL)
2040  {
2041    r->minpoly=nCopy(currRing->minpoly);
2042    int l=rPar(currRing);
2043    r->parameter=(char **)omAlloc(l*sizeof(char_ptr));
2044
2045    for(i=l-1;i>=0;i--)
2046      r->parameter[i]=omStrDup(currRing->parameter[i]);
2047  }
2048
2049
2050  r->ch  = currRing->ch;
2051  r->N   = currRing->N;
2052  int nb = rBlocks(currRing) + 1;//31.10.01 (+1)
2053
2054  /*names*/
2055  char* Q;
2056  r->names = (char **) omAlloc0(nv * sizeof(char_ptr));
2057  for(i=nv-1; i>=0; i--)
2058  {
2059    Q = currRing->names[i];
2060    r->names[i]  = omStrDup(Q);
2061  }
2062
2063  /*weights: entries for 3 blocks: NULL Made:???*/
2064
2065  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
2066
2067  /* order: lp,C,0 */
2068  r->order = (int *) omAlloc(nb * sizeof(int *));
2069  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
2070  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
2071
2072  /* ringorder lp for the first block: var 1..nv */
2073  r->order[0]  = ringorder_lp;
2074  r->block0[0] = 1;
2075  r->block1[0] = nv;
2076
2077  /* ringorder C for the second block */
2078  r->order[1]  = ringorder_C;
2079
2080  /* the last block: everything is 0 */
2081  r->order[2]  = 0;
2082
2083  /*polynomial ring*/
2084  r->OrdSgn    = 1;
2085
2086
2087  if (currRing->parameter!=NULL)
2088  {
2089    r->minpoly=nCopy(currRing->minpoly);
2090    int l=rPar(currRing);
2091    r->parameter=(char **)omAlloc(l*sizeof(char_ptr));
2092
2093    for(i=l-1;i>=0;i--)
2094      r->parameter[i]=omStrDup(currRing->parameter[i]);
2095  }
2096
2097  /* complete ring intializations */
2098  rComplete(r);
2099
2100  // clean up history
2101  if (sLastPrinted.RingDependend())
2102  {
2103    sLastPrinted.CleanUp();
2104    memset(&sLastPrinted,0,sizeof(sleftv));
2105  }
2106
2107  /* execute the created ring */
2108  rChangeCurrRing(r);
2109}
2110
2111/* check wheather one or more components of a vector are zero */
2112static int isNolVector(intvec* hilb)
2113{
2114  int i;
2115  for(i=hilb->length()-1; i>=0; i--)
2116    if((* hilb)[i]==0)
2117      return 1;
2118
2119  return 0;
2120}
2121
2122
2123/******************************  Februar 2002  ****************************
2124 * G is a Groebner basis w.r.t. (a(curr_weight),lp) and                   *
2125 * we compute a GB of <G> w.r.t. the lex. order by the perturbation walk  *
2126 * its perturbation degree is tp_deg                                      *
2127 * We call the following subfunction LastGB, if                           *
2128 *     the computed intermediate weight vector or                         *
2129 *     the perturbed target weight vector                                 *
2130 * does NOT in the correct cone.                                          *
2131 **************************************************************************/
2132
2133static ideal LastGB(ideal G, intvec* curr_weight,int tp_deg)
2134{
2135  BOOLEAN nError = Overflow_Error;
2136  Overflow_Error = FALSE;
2137
2138  int i, nV = currRing->N;
2139  int nwalk=0, endwalks=0, nnwinC=1;
2140  int nlast = 0;
2141  ideal Gomega, M, F, Gomega1, Gomega2, M1,F1,result,ssG;
2142  ring newRing, oldRing, TargetRing;
2143  intvec* iv_M_lp;
2144  intvec* target_weight;
2145  intvec* iv_lp = Mivlp(nV); //define (1,0,...,0)
2146  intvec* pert_target_vector;
2147  intvec* ivNull = new intvec(nV);
2148  intvec* extra_curr_weight = new intvec(nV);
2149  intvec* hilb_func;
2150  intvec* next_weight;
2151
2152  /* to avoid (1,0,...,0) as the target vector */
2153  intvec* last_omega = new intvec(nV);
2154  for(i=nV-1; i>0; i--)
2155    (*last_omega)[i] = 1;
2156  (*last_omega)[0] = 10000;
2157
2158  ring EXXRing = currRing;
2159
2160  /* compute a pertubed weight vector of the target weight vector */
2161  if(tp_deg > 1 && tp_deg <= nV)
2162  {
2163    //..25.03.03 VMrDefaultlp();//    VMrDefault(target_weight);
2164    if (currRing->parameter != NULL)
2165      DefRingParlp();
2166    else
2167      VMrDefaultlp();
2168
2169    TargetRing = currRing;
2170    ssG = idrMoveR(G,EXXRing);
2171    iv_M_lp = MivMatrixOrderlp(nV);
2172    //target_weight = MPertVectorslp(ssG, iv_M_lp, tp_deg);
2173    target_weight = MPertVectors(ssG, iv_M_lp, tp_deg);
2174    delete iv_M_lp;
2175    pert_target_vector = target_weight;
2176
2177    rChangeCurrRing(EXXRing);
2178    G = idrMoveR(ssG, TargetRing);
2179  }
2180  else
2181    target_weight = Mivlp(nV);
2182
2183  //Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
2184
2185  while(1)
2186  {
2187    nwalk++;
2188    nstep++;
2189    to=clock();
2190    /* compute a next weight vector */
2191    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
2192    xtnw=xtnw+clock()-to;
2193#ifdef PRINT_VECTORS
2194    MivString(curr_weight, target_weight, next_weight);
2195#endif
2196
2197    if(Overflow_Error == TRUE){
2198      newRing = currRing;
2199      nnwinC = 0;
2200      if(tp_deg == 1)
2201        nlast = 1;
2202      delete next_weight;
2203
2204      //idElements(G, "G");
2205      //Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
2206
2207      break;
2208    }
2209
2210    if(MivComp(next_weight, ivNull) == 1){
2211      //Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
2212      newRing = currRing;
2213      delete next_weight;
2214      break;
2215    }
2216
2217    if(MivComp(next_weight, target_weight) == 1)
2218      endwalks = 1;
2219
2220    for(i=nV-1; i>=0; i--)
2221        (*extra_curr_weight)[i] = (*curr_weight)[i];
2222
2223    /* 06.11.01 NOT Changed */
2224    for(i=nV-1; i>=0; i--)
2225      (*curr_weight)[i] = (*next_weight)[i];
2226
2227    oldRing = currRing;
2228    to=clock();
2229    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
2230    Gomega = MwalkInitialForm(G, curr_weight);
2231    xtif=xtif+clock()-to;
2232
2233#ifdef ENDWALKS
2234    if(endwalks == 1){
2235      Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
2236      idElements(Gomega, "Gw");
2237      headidString(Gomega, "Gw");
2238    }
2239#endif
2240
2241#ifndef  BUCHBERGER_ALG
2242    if(isNolVector(curr_weight) == 0)
2243      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
2244    else
2245      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
2246#endif // BUCHBERGER_ALG
2247
2248    /* define a new ring that its ordering is "(a(curr_weight),lp) */
2249    //..25.03.03 VMrDefault(curr_weight);
2250    if (currRing->parameter != NULL)
2251      DefRingPar(curr_weight);
2252    else
2253      VMrDefault(curr_weight);
2254
2255    newRing = currRing;
2256    Gomega1 = idrMoveR(Gomega, oldRing);
2257
2258    to=clock();
2259    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
2260#ifdef  BUCHBERGER_ALG
2261    M = MstdhomCC(Gomega1);
2262#else
2263    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
2264    delete hilb_func;
2265#endif // BUCHBERGER_ALG
2266    xtstd=xtstd+clock()-to;
2267    /* change the ring to oldRing */
2268    rChangeCurrRing(oldRing);
2269    M1 =  idrMoveR(M, newRing);
2270    Gomega2 =  idrMoveR(Gomega1, newRing);
2271
2272    to=clock();
2273    /* compute a reduced Groebner basis of <G> w.r.t. "newRing" */
2274    F = MLifttwoIdeal(Gomega2, M1, G);
2275    xtlift=xtlift+clock()-to;
2276
2277    idDelete(&M1);
2278    idDelete(&G);
2279
2280    /* change the ring to newRing */
2281    rChangeCurrRing(newRing);
2282    F1 = idrMoveR(F, oldRing);
2283
2284    to=clock();
2285    /* reduce the Groebner basis <G> w.r.t. new ring */
2286    G = kInterRedCC(F1, NULL);
2287    xtred=xtred+clock()-to;
2288    idDelete(&F1);
2289
2290    if(endwalks == 1){
2291      //Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
2292      break;
2293    }
2294
2295    delete next_weight;
2296  }//while
2297
2298  delete ivNull;
2299
2300  if(tp_deg != 1)
2301  {
2302    //..25.03.03 VMrDefaultlp();//define and execute the ring "lp"
2303    if (currRing->parameter != NULL)
2304      DefRingParlp();
2305    else
2306      VMrDefaultlp();
2307
2308    F1 = idrMoveR(G, newRing);
2309
2310    if(nnwinC == 0 || test_w_in_ConeCC(F1, pert_target_vector) != 1)
2311    {
2312      oldRing = currRing;
2313      rChangeCurrRing(newRing);
2314      G = idrMoveR(F1, oldRing);
2315      Print("\n// takes %d steps and calls the recursion of level %d:",
2316             nwalk, tp_deg-1);
2317
2318      F1 = LastGB(G,curr_weight, tp_deg-1);
2319    }
2320
2321    TargetRing = currRing;
2322    rChangeCurrRing(EXXRing);
2323    result = idrMoveR(F1, TargetRing);
2324  }
2325  else
2326  {
2327    if(nlast == 1)
2328    {
2329      //OMEGA_OVERFLOW_LASTGB:
2330      /*
2331      if(MivSame(curr_weight, iv_lp) == 1)
2332        if (currRing->parameter != NULL)
2333          DefRingParlp();
2334        else
2335          VMrDefaultlp();
2336      else
2337        if (currRing->parameter != NULL)
2338          DefRingPar(curr_weight);
2339        else
2340          VMrDefault(curr_weight);
2341      */
2342
2343        //..25.03.03 VMrDefaultlp();//define and execute the ring "lp"
2344        if (currRing->parameter != NULL)
2345          DefRingParlp();
2346        else
2347          VMrDefaultlp();
2348
2349
2350      F1 = idrMoveR(G, newRing);
2351      //Print("\n// Apply \"std\" in ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
2352
2353      G = MstdCC(F1);
2354      idDelete(&F1);
2355      newRing = currRing;
2356    }
2357
2358    rChangeCurrRing(EXXRing);
2359    result = idrMoveR(G, newRing);
2360  }
2361  delete target_weight;
2362  delete last_omega;
2363  delete iv_lp;
2364
2365  if(Overflow_Error == FALSE)
2366    Overflow_Error = nError;
2367
2368  return(result);
2369}
2370
2371
2372/* check whether a polynomial of G has least 3 monomials */
2373static int lengthpoly(ideal G)
2374{
2375  int i;
2376  for(i=IDELEMS(G)-1; i>=0; i--)
2377#if 0
2378    if(pLength(G->m[i])>2)
2379      return 1;
2380#else
2381    if((G->m[i]!=NULL) /* len >=0 */
2382       && (G->m[i]->next!=NULL) /* len >=1 */
2383       && (G->m[i]->next->next!=NULL) /* len >=2 */
2384       && (G->m[i]->next->next->next!=NULL) /* len >=3 */
2385      //&& (G->m[i]->next->next->next->next!=NULL) /* len >=4 */
2386       ) return 1;
2387#endif
2388  return 0;
2389}
2390
2391/* check whether a polynomial of G has least 2 monomials */
2392static int islengthpoly2(ideal G)
2393{
2394  int i;
2395  for(i=IDELEMS(G)-1; i>=0; i--)
2396    if((G->m[i]!=NULL) /* len >=0 */
2397       && (G->m[i]->next!=NULL) /* len >=1 */
2398       && (G->m[i]->next->next!=NULL)) /* len >=2 */
2399      return 1;
2400
2401  return 0;
2402}
2403
2404
2405
2406/* Implementation of the improved Groebner walk algorithm which is written
2407   by Quoc-Nam Tran (2000).
2408   One perturbs the original target weight vector, only if
2409   the next intermediate weight vector is equal to the current target weight
2410   vector. This must be repeated until the wanted reduced Groebner basis
2411   to reach.
2412   If the numbers of variables is big enough, the representation of the origin
2413   weight vector may be very big. Therefore, it is possible the intermediate
2414   weight vector doesn't stay in the correct Groebner cone.
2415   In this case we have just a reduced Groebner basis of the given ideal
2416   with respect to another monomial order. Then we have to compute
2417   a wanted reduced Groebner basis of it with respect to the given order.
2418   At the following subroutine we use the improved Buchberger algorithm or
2419   the changed perturbation walk algorithm with a decrased degree.
2420 */
2421
2422/*2
2423* return the initial term of an ideal
2424*/
2425static ideal idHeadCC(ideal h)
2426{
2427  int i, nH =IDELEMS(h);
2428
2429  ideal m = idInit(nH,h->rank);
2430
2431  for (i=nH-1;i>=0; i--)
2432  {
2433    if (h->m[i]!=NULL)
2434      m->m[i]=pHead(h->m[i]);
2435  }
2436  return m;
2437}
2438
2439/* check whether two head-ideals are the same */
2440static inline int test_G_GB_walk(ideal H0, ideal H1)
2441{
2442  int i, nG = IDELEMS(H0);
2443
2444  if(nG != IDELEMS(H1))
2445    return 0;
2446
2447  for(i=nG-1; i>=0; i--)
2448  {
2449#if 0
2450    poly t;
2451    if((t=pSub(pCopy(H0->m[i]), pCopy(H1->m[i]))) != NULL)
2452    {
2453      pDelete(&t);
2454      return 0;
2455    }
2456    pDelete(&t);
2457#else
2458    if(!pEqualPolys(H0->m[i],H1->m[i]))
2459      return 0;
2460#endif
2461  }
2462
2463  return 1;
2464}
2465
2466/* 19.11.01 */
2467/* find the maximal total degree of polynomials in G */
2468static int Trandegreebound(ideal G)
2469{
2470  int i, nG = IDELEMS(G);
2471  int np=1, nV = currRing->N;
2472  int degtmp, result = 0;
2473  intvec* ivUnit = Mivdp(nV);
2474
2475  for(i=nG-1; i>=0; i--)
2476  {
2477    /* find the maximal total degree of the polynomial G[i] */
2478    degtmp = MwalkWeightDegree(G->m[i], ivUnit);
2479    if(degtmp > result)
2480      result = degtmp;
2481  }
2482  delete ivUnit;
2483  return result;
2484}
2485
2486/* perturb the weight vector iva w.r.t. the ideal G.
2487   the monomial order of the current ring is the w_1 weight lex. order.
2488   define w := d^(n-1)w_1+ d^(n-2)w_2, ...+ dw_(n-1)+ w_n
2489   where d := 1 + max{totdeg(g):g in G}*m, or
2490   d := (2*maxdeg*maxdeg + (nV+1)*maxdeg)*m;
2491*/
2492
2493//GMP
2494static intvec* TranPertVector(ideal G, intvec* iva)
2495{
2496  BOOLEAN nError = Overflow_Error;
2497  Overflow_Error = FALSE;
2498
2499  int i, j,  nG = IDELEMS(G);
2500  int nV = currRing->N;
2501
2502  // define the sequence which expresses the current monomial ordering
2503  // w_1 = iva; w_2 = (1,0,..,0); w_n = (0,...,0,1,0)
2504  intvec* ivMat = MivMatrixOrder(iva);
2505
2506  int  mtmp, m=(*iva)[0];
2507
2508  for(i=ivMat->length(); i>=0; i--)
2509  {
2510    mtmp = (*ivMat)[i];
2511
2512    if(mtmp <0) mtmp = -mtmp;
2513
2514    if(mtmp > m)
2515      m = mtmp;
2516  }
2517
2518  /* define the maximal total degree of polynomials of G */
2519  mpz_t ndeg;
2520  mpz_init(ndeg);
2521
2522 // 12 Juli 03
2523#ifndef UPPER_BOUND
2524  mpz_set_si(ndeg, Trandegreebound(G)+1);
2525#else
2526  mpz_t ztmp;
2527  mpz_init(ztmp);
2528
2529  mpz_t maxdeg;
2530  mpz_init_set_si(maxdeg, Trandegreebound(G));
2531
2532  //ndeg = (2*maxdeg*maxdeg + (nV+1)*maxdeg)*m;//Kalkbrenner (1999)
2533  mpz_pow_ui(ztmp, maxdeg, 2);
2534  mpz_mul_ui(ztmp, ztmp, 2);
2535  mpz_mul_ui(maxdeg, maxdeg, nV+1);
2536  mpz_add(ndeg, ztmp, maxdeg);
2537  mpz_mul_ui(ndeg, ndeg, m);
2538
2539  //PrintS("\n// with the new upper degree bound (2d^2+(n+1)d)*m ");
2540  //Print("\n//         where d = %d, n = %d and bound = %d", maxdeg, nV, ndeg);
2541#endif //UPPER_BOUND
2542
2543  /* 29.08.03*/
2544#ifdef INVEPS_SMALL_IN_TRAN
2545 if(mpz_cmp_ui(ndeg, nV)>0 && nV > 3)
2546    mpz_cdiv_q_ui(ndeg, ndeg, nV);
2547
2548 //PrintS("\n// choose the \"small\" inverse epsilon:");
2549 //mpz_out_str(stdout, 10, ndeg);
2550#endif
2551  mpz_t deg_tmp;
2552  mpz_init_set(deg_tmp, ndeg);
2553
2554  mpz_t *ivres=( mpz_t *) omAlloc(nV*sizeof(mpz_t));
2555  mpz_init_set_si(ivres[nV-1],1);
2556
2557  for(i=nV-2; i>=0; i--)
2558  {
2559    mpz_init_set(ivres[i], deg_tmp);
2560    mpz_mul(deg_tmp, deg_tmp, ndeg);
2561  }
2562
2563  mpz_t *ivtmp=(mpz_t *)omAlloc(nV*sizeof(mpz_t));
2564  for(i=0; i<nV; i++)
2565    mpz_init(ivtmp[i]);
2566
2567  mpz_t sing_int;
2568  mpz_init_set_ui(sing_int,  2147483647);
2569
2570  intvec* repr_vector = new intvec(nV);
2571
2572  /* define ivtmp := ndeg^(n-1).w_1 + ndeg^(n-2).w_2 + ... + w_n */
2573  for(i=0; i<nV; i++)
2574    for(j=0; j<nV; j++)
2575    {
2576      if( (*ivMat)[i*nV+j] >= 0 )
2577        mpz_mul_ui(ivres[i], ivres[i], (*ivMat)[i*nV+j]);
2578      else
2579      {
2580        mpz_mul_ui(ivres[i], ivres[i], -(*ivMat)[i*nV+j]);
2581        mpz_neg(ivres[i], ivres[i]);
2582      }
2583      mpz_add(ivtmp[j], ivtmp[j], ivres[i]);
2584    }
2585
2586  delete ivMat;
2587
2588  int ntrue=0;
2589  for(i=0; i<nV; i++)
2590  {
2591    (*repr_vector)[i] = mpz_get_si(ivtmp[i]);
2592    if(mpz_cmp(ivtmp[i], sing_int)>=0)
2593    {
2594      ntrue++;
2595      if(Overflow_Error == FALSE)
2596      {
2597        Overflow_Error = TRUE;
2598
2599        PrintS("\n// ** OVERFLOW in \"Repr.Vector\": ");
2600        mpz_out_str( stdout, 10, ivtmp[i]);
2601        PrintS(" is greater than 2147483647 (max. integer representation)");
2602        Print("\n//  So vector[%d] := %d is wrong!!\n",i+1,(*repr_vector)[i]);
2603      }
2604    }
2605  }
2606  if(Overflow_Error == TRUE)
2607  {
2608    ivString(repr_vector, "repvector");
2609    Print("\n// %d element(s) of it are overflow!!", ntrue);
2610  }
2611
2612  if(Overflow_Error == FALSE)
2613    Overflow_Error=nError;
2614
2615  omFree(ivres);
2616  omFree(ivtmp);
2617  return repr_vector;
2618}
2619
2620
2621
2622static intvec* TranPertVector_lp(ideal G)
2623{
2624  BOOLEAN nError = Overflow_Error;
2625  Overflow_Error = FALSE;
2626
2627  int i, j,  nG = IDELEMS(G);
2628  int nV = currRing->N;
2629
2630  /* define the maximal total degree of polynomials of G */
2631  mpz_t ndeg;
2632  mpz_init(ndeg);
2633
2634 // 12 Juli 03
2635#ifndef UPPER_BOUND
2636  mpz_set_si(ndeg, Trandegreebound(G)+1);
2637#else
2638  mpz_t ztmp;
2639  mpz_init(ztmp);
2640
2641  mpz_t maxdeg;
2642  mpz_init_set_si(maxdeg, Trandegreebound(G));
2643
2644  //ndeg = (2*maxdeg*maxdeg + (nV+1)*maxdeg);//Kalkbrenner (1999)
2645  mpz_pow_ui(ztmp, maxdeg, 2);
2646  mpz_mul_ui(ztmp, ztmp, 2);
2647  mpz_mul_ui(maxdeg, maxdeg, nV+1);
2648  mpz_add(ndeg, ztmp, maxdeg);
2649  /*
2650    PrintS("\n// with the new upper degree bound (2d^2+(n+1)d)*m ");
2651    Print("\n//         where d = %d, n = %d and bound = %d",
2652    mpz_get_si(maxdeg), nV, mpz_get_si(ndeg));
2653  */
2654#endif //UPPER_BOUND
2655
2656#ifdef INVEPS_SMALL_IN_TRAN
2657 if(mpz_cmp_ui(ndeg, nV)>0 && nV > 3)
2658    mpz_cdiv_q_ui(ndeg, ndeg, nV);
2659
2660 //PrintS("\n// choose the \"small\" inverse epsilon:");
2661 // mpz_out_str(stdout, 10, ndeg);
2662#endif
2663
2664  mpz_t deg_tmp;
2665  mpz_init_set(deg_tmp, ndeg);
2666
2667  mpz_t *ivres=(mpz_t *)omAlloc(nV*sizeof(mpz_t));
2668  mpz_init_set_si(ivres[nV-1], 1);
2669
2670  for(i=nV-2; i>=0; i--)
2671  {
2672    mpz_init_set(ivres[i], deg_tmp);
2673    mpz_mul(deg_tmp, deg_tmp, ndeg);
2674  }
2675
2676  mpz_t sing_int;
2677  mpz_init_set_ui(sing_int,  2147483647);
2678
2679  intvec* repr_vector = new intvec(nV);
2680  int ntrue;
2681  for(i=0; i<nV; i++)
2682  {
2683    (*repr_vector)[i] = mpz_get_si(ivres[i]);
2684
2685    if(mpz_cmp(ivres[i], sing_int)>=0)
2686    {
2687      ntrue++;
2688      if(Overflow_Error == FALSE)
2689      {
2690        Overflow_Error = TRUE;
2691        PrintS("\n// ** OVERFLOW in \"Repr.Vector\": ");
2692        mpz_out_str( stdout, 10, ivres[i]);
2693        PrintS(" is greater than 2147483647 (max. integer representation)");
2694        Print("\n//  So vector[%d] := %d is wrong!!\n",i+1,(*repr_vector)[i]);
2695      }
2696    }
2697  }
2698  if(Overflow_Error == TRUE)
2699  {
2700    ivString(repr_vector, "repvector");
2701    Print("\n// %d element(s) of it are overflow!!", ntrue);
2702  }
2703  if(Overflow_Error == FALSE)
2704    Overflow_Error = nError;
2705
2706  omFree(ivres);
2707  return repr_vector;
2708}
2709
2710
2711//GMP
2712static intvec* RepresentationMatrix_Dp(ideal G, intvec* M)
2713{
2714  BOOLEAN nError = Overflow_Error;
2715  Overflow_Error = FALSE;
2716
2717  int i, j;
2718  int nV = currRing->N;
2719
2720  intvec* ivUnit = Mivdp(nV);
2721  int degtmp, maxdeg = 0;
2722
2723  for(i=IDELEMS(G)-1; i>=0; i--)
2724  {
2725    /* find the maximal total degree of the polynomial G[i] */
2726    degtmp = MwalkWeightDegree(G->m[i], ivUnit);
2727    if(degtmp > maxdeg)
2728      maxdeg = degtmp;
2729  }
2730
2731  mpz_t ztmp;
2732  mpz_init_set_si(ztmp, maxdeg);
2733  mpz_t *ivres=(mpz_t *)omAlloc(nV*sizeof(mpz_t));
2734  mpz_init_set_si(ivres[nV-1], 1); // (*ivres)[nV-1] = 1;
2735
2736  for(i=nV-2; i>=0; i--)
2737  {
2738    mpz_init_set(ivres[i], ztmp); //(*ivres)[i] = ztmp;
2739    mpz_mul_ui(ztmp, ztmp, maxdeg); //ztmp *=maxdeg;
2740  }
2741
2742  mpz_t *ivtmp=(mpz_t*)omAlloc(nV*sizeof(mpz_t));
2743  for(i=0; i<nV; i++)
2744    mpz_init(ivtmp[i]);
2745
2746  /* define ivtmp := ndeg^(n-1).w_1 + ndeg^(n-2).w_2 + ... + w_n */
2747  for(i=0; i<nV; i++)
2748    for(j=0; j<nV; j++)
2749    {
2750      if((*M)[i*nV+j] < 0)
2751      {
2752        mpz_mul_ui(ztmp, ivres[i], -(*M)[i*nV+j]);
2753        mpz_neg(ztmp, ztmp);
2754      }
2755      else
2756        mpz_mul_ui(ztmp, ivres[i], (*M)[i*nV+j]);
2757
2758      mpz_add(ivtmp[j], ivtmp[j], ztmp);
2759    }
2760
2761  mpz_t sing_int;
2762  mpz_init_set_ui(sing_int,  2147483647);
2763
2764  int ntrue;
2765  intvec* repvector = new intvec(nV);
2766  for(i=0; i<nV; i++)
2767  {
2768    (*repvector)[i] = mpz_get_si(ivtmp[i]);
2769    if(mpz_cmp(ivtmp[i], sing_int)>0)
2770    {
2771      ntrue++;
2772      if(Overflow_Error == FALSE)
2773      {
2774        Overflow_Error = TRUE;
2775        PrintS("\n// ** OVERFLOW in \"Repr.Matrix\": ");
2776        mpz_out_str( stdout, 10, ivtmp[i]);
2777        PrintS(" is greater than 2147483647 (max. integer representation)");
2778        Print("\n//  So vector[%d] := %d is wrong!!\n",i+1,(*repvector)[i]);
2779      }
2780    }
2781  }
2782  if(Overflow_Error == TRUE)
2783  {
2784    ivString(repvector, "repvector");
2785    Print("\n// %d element(s) of it are overflow!!", ntrue);
2786  }
2787
2788  if(Overflow_Error == FALSE)
2789    Overflow_Error = nError;
2790
2791  mpz_clear(ztmp);
2792  omFree(ivtmp);
2793  omFree(ivres);
2794  return repvector;
2795}
2796
2797
2798
2799
2800
2801/* The following subroutine is the implementation of our first improved
2802   Groebner walk algorithm, i.e. the first altervative algorithm.
2803   First we use the Grobner walk algorithm and then we call the changed
2804   perturbation walk algorithm with decreased degree, if an intermediate
2805   weight vector is equal to the current target weight vector.
2806   This call will be only repeated until we get the wanted reduced Groebner
2807   basis or n times, where n is the numbers of variables.
2808*/
2809
2810// 19 Juni 2003
2811static int testnegintvec(intvec* v)
2812{
2813  int n = v->length();
2814  int i;
2815  for(i=0; i<n; i++){
2816    if((*v)[i]<0)
2817      return(1);
2818  }
2819  return(0);
2820}
2821
2822
2823/* 7 Februar 2002 */
2824/* npwinc = 0, if curr_weight doesn't stay in the correct Groebner cone */
2825static ideal Rec_LastGB(ideal G, intvec* curr_weight,
2826                        intvec* orig_target_weight, int tp_deg, int npwinc)
2827{
2828  BOOLEAN nError = Overflow_Error;
2829  Overflow_Error = FALSE;
2830  BOOLEAN nOverflow_Error = FALSE;
2831
2832  clock_t tproc=0;
2833  clock_t tinput = clock();
2834
2835  int i,  nV = currRing->N;
2836  int nwalk=0, endwalks=0, nnwinC=1;
2837  int nlast = 0;
2838  ideal Gomega, M, F, Gomega1, Gomega2, M1,F1,result,ssG;
2839  ring newRing, oldRing, TargetRing;
2840  intvec* iv_M_lp;
2841  intvec* target_weight;
2842  intvec* ivNull = new intvec(nV); //define (0,...,0)
2843  ring EXXRing = currRing;
2844  int NEG=0; //19 juni 03
2845  intvec* extra_curr_weight = new intvec(nV);
2846  intvec* next_weight;
2847
2848  //08 Juli 03
2849  intvec* hilb_func;
2850  /* to avoid (1,0,...,0) as the target vector */
2851  intvec* last_omega = new intvec(nV);
2852  for(i=nV-1; i>0; i--)
2853    (*last_omega)[i] = 1;
2854  (*last_omega)[0] = 10000;
2855
2856  BOOLEAN isGB = FALSE;
2857
2858  /* compute a pertubed weight vector of the target weight vector */
2859  if(tp_deg > 1 && tp_deg <= nV) {
2860    ideal H0 = idHeadCC(G);
2861
2862    if (currRing->parameter != NULL)
2863      DefRingParlp();
2864    else
2865      VMrDefaultlp();
2866
2867    TargetRing = currRing;
2868    ssG = idrMoveR(G,EXXRing);
2869
2870    ideal H0_tmp = idrMoveR(H0,EXXRing);
2871    ideal H1 = idHeadCC(ssG);
2872
2873    /* Apply Lemma 2.2 in Collart et. al (1997) to check whether
2874       cone(k-1) is equal to cone(k) */
2875    if(test_G_GB_walk(H0_tmp,H1)==1) {
2876      idDelete(&H0_tmp);
2877      idDelete(&H1);
2878      G = ssG;
2879      ssG = NULL;
2880      newRing = currRing;
2881      delete ivNull;
2882
2883      if(npwinc != 0)
2884        goto LastGB_Finish;
2885      else {
2886        isGB = TRUE;
2887        goto KSTD_Finish;
2888      }
2889    }
2890    idDelete(&H0_tmp);
2891    idDelete(&H1);
2892
2893    iv_M_lp = MivMatrixOrderlp(nV);
2894    target_weight  = MPertVectors(ssG, iv_M_lp, tp_deg);
2895    delete iv_M_lp;
2896    //PrintS("\n// Input is not GB!!");
2897    rChangeCurrRing(EXXRing);
2898    G = idrMoveR(ssG, TargetRing);
2899
2900    if(Overflow_Error == TRUE)  {
2901      nOverflow_Error = Overflow_Error;
2902      NEG = 1;
2903      newRing = currRing;
2904      goto JUNI_STD;
2905    }
2906  }
2907
2908  while(1)
2909  {
2910    nwalk ++;
2911    nstep++;
2912
2913    if(nwalk==1)
2914      goto FIRST_STEP;
2915
2916    to=clock();
2917    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
2918    Gomega = MwalkInitialForm(G, curr_weight);
2919    xtif=xtif+clock()-to;
2920
2921#ifndef  BUCHBERGER_ALG
2922    if(isNolVector(curr_weight) == 0)
2923      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
2924    else
2925      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
2926#endif // BUCHBERGER_ALG
2927
2928    oldRing = currRing;
2929
2930    /* defiNe a new ring that its ordering is "(a(curr_weight),lp) */
2931    if (currRing->parameter != NULL)
2932      DefRingPar(curr_weight);
2933    else
2934      VMrDefault(curr_weight);
2935
2936    newRing = currRing;
2937    Gomega1 = idrMoveR(Gomega, oldRing);
2938    to=clock();
2939    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
2940#ifdef  BUCHBERGER_ALG
2941    M = MstdhomCC(Gomega1);
2942#else
2943    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
2944    delete hilb_func;
2945#endif // BUCHBERGER_ALG
2946    xtstd=xtstd+clock()-to;
2947    /* change the ring to oldRing */
2948    rChangeCurrRing(oldRing);
2949    M1 =  idrMoveR(M, newRing);
2950    Gomega2 =  idrMoveR(Gomega1, newRing);
2951
2952     to=clock();
2953    /* compute a reduced Groebner basis of <G> w.r.t. "newRing" by the
2954       lifting process*/
2955    F = MLifttwoIdeal(Gomega2, M1, G);
2956    xtlift=xtlift+clock()-to;
2957    idDelete(&M1);
2958    idDelete(&Gomega2);
2959    idDelete(&G);
2960
2961    /* change the ring to newRing */
2962    rChangeCurrRing(newRing);
2963    F1 = idrMoveR(F, oldRing);
2964
2965    to=clock();
2966    /* reduce the Groebner basis <G> w.r.t. new ring */
2967    G = kInterRedCC(F1, NULL);
2968    xtred=xtred+clock()-to;
2969    idDelete(&F1);
2970
2971    if(endwalks == 1)
2972      break;
2973
2974  FIRST_STEP:
2975    to=clock();
2976    Overflow_Error = FALSE;
2977    /* compute a next weight vector */
2978    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
2979    xtnw=xtnw+clock()-to;
2980#ifdef PRINT_VECTORS
2981    MivString(curr_weight, target_weight, next_weight);
2982#endif
2983
2984    if(Overflow_Error == TRUE) {
2985      //PrintS("\n// ** The next vector does NOT stay in Cone!!\n");
2986#ifdef TEST_OVERFLOW
2987      goto  LastGB_Finish;
2988#endif
2989
2990      nnwinC = 0;
2991      if(tp_deg == nV)
2992        nlast = 1;
2993
2994      delete next_weight;
2995      break;
2996    }
2997
2998    if(MivComp(next_weight, ivNull) == 1) {
2999      //newRing = currRing;
3000      delete next_weight;
3001      break;
3002    }
3003
3004    if(MivComp(next_weight, target_weight) == 1)  {
3005      if(tp_deg == nV)
3006        endwalks = 1;
3007      else {
3008      REC_LAST_GB_ALT2:
3009        nOverflow_Error = Overflow_Error;
3010        tproc=tproc+clock()-tinput;
3011        /*
3012          Print("\n// takes %d steps and calls \"Rec_LastGB\" (%d):",
3013          nwalk, tp_deg+1);
3014        */
3015        G = Rec_LastGB(G,curr_weight, orig_target_weight, tp_deg+1,nnwinC);
3016        newRing = currRing;
3017        delete next_weight;
3018        break;
3019      }
3020    }
3021
3022    for(i=nV-1; i>=0; i--) {
3023      //(*extra_curr_weight)[i] = (*curr_weight)[i];
3024      (*curr_weight)[i] = (*next_weight)[i];
3025    }
3026    delete next_weight;
3027  }//while
3028
3029  delete ivNull;
3030
3031  if(tp_deg != nV) {
3032    newRing = currRing;
3033
3034    if (currRing->parameter != NULL)
3035      DefRingParlp();
3036    else
3037      VMrDefaultlp();
3038
3039    F1 = idrMoveR(G, newRing);
3040
3041    if(nnwinC == 0 || test_w_in_ConeCC(F1, target_weight) != 1 ) {
3042      nOverflow_Error = Overflow_Error;
3043      //Print("\n//  takes %d steps and calls \"Rec_LastGB (%d):", tp_deg+1);
3044      tproc=tproc+clock()-tinput;
3045      F1 = Rec_LastGB(F1,curr_weight, orig_target_weight, tp_deg+1,nnwinC);
3046    }
3047    delete target_weight;
3048
3049    TargetRing = currRing;
3050    rChangeCurrRing(EXXRing);
3051    result = idrMoveR(F1, TargetRing);
3052  }
3053  else  {
3054    if(nlast == 1) {
3055      JUNI_STD:
3056
3057      newRing = currRing;
3058      if (currRing->parameter != NULL)
3059        DefRingParlp();
3060      else
3061        VMrDefaultlp();
3062
3063      KSTD_Finish:
3064      if(isGB == FALSE)
3065        F1 = idrMoveR(G, newRing);
3066      else
3067        F1 = G;
3068      to=clock();
3069      // Print("\n// apply the Buchberger's alg in ring = %s",rString(currRing));
3070      // idElements(F1, "F1");
3071      G = MstdCC(F1);
3072      xtextra=xtextra+clock()-to;
3073
3074
3075      idDelete(&F1);
3076      newRing = currRing;
3077    }
3078
3079    LastGB_Finish:
3080    rChangeCurrRing(EXXRing);
3081    result = idrMoveR(G, newRing);
3082  }
3083
3084  if(Overflow_Error == FALSE)
3085    Overflow_Error=nError;
3086  /*
3087  Print("\n// \"Rec_LastGB\" (%d) took %d steps and %.2f sec.Overflow_Error (%d)", tp_deg,
3088        nwalk, ((double) tproc)/1000000, nOverflow_Error);
3089  */
3090  return(result);
3091}
3092
3093/* The following subroutine is the implementation of our second improved
3094   Groebner walk algorithm, i.e. the second altervative algorithm.
3095   First we use the Grobner walk algorithm and then we call the changed
3096   perturbation walk algorithm with increased degree, if an intermediate
3097   weight vector is equal to the current target weight vector.
3098   This call will be only repeated until we get the wanted reduced Groebner
3099   basis or n times, where n is the numbers of variables.
3100*/
3101/* walk + recursive LastGB */
3102ideal MAltwalk2(ideal Go, intvec* curr_weight, intvec* target_weight)
3103{
3104  Set_Error(FALSE);
3105  Overflow_Error = FALSE;
3106  BOOLEAN nOverflow_Error = FALSE;
3107  //Print("// pSetm_Error = (%d)", ErrorCheck());
3108
3109  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0; xtextra=0;
3110  xftinput = clock();
3111  clock_t tostd, tproc;
3112
3113  nstep = 0;
3114  int i, nV = currRing->N;
3115  int nwalk=0, endwalks=0, nhilb=1;
3116
3117  ideal Gomega, M, F, Gomega1, Gomega2, M1, F1, G, G1;
3118  ring endRing, newRing, oldRing;
3119  intvec* ivNull = new intvec(nV);
3120  intvec* next_weight;
3121  intvec* extra_curr_weight = new intvec(nV);
3122  intvec* hilb_func;
3123  intvec* exivlp = Mivlp(nV);
3124
3125  ring XXRing = currRing;
3126
3127  //Print("\n// ring r_input = %s;", rString(currRing));
3128  to = clock();
3129  /* compute the reduced Groebner basis of the given ideal w.r.t.
3130     a "fast" monomial order, e.g. degree reverse lex. order (dp) */
3131  G = MstdCC(Go);
3132  tostd=clock()-to;
3133
3134  /*
3135  Print("\n// Computation of the first std took = %.2f sec",
3136        ((double) tostd)/1000000);
3137  */
3138  if(currRing->order[0] == ringorder_a)
3139    goto NEXT_VECTOR;
3140
3141  while(1)
3142  {
3143    nwalk ++;
3144    nstep ++;
3145    to = clock();
3146    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
3147    Gomega = MwalkInitialForm(G, curr_weight);
3148    xtif=xtif+clock()-to;
3149#if 0
3150    if(Overflow_Error == TRUE)
3151    {
3152      for(i=nV-1; i>=0; i--)
3153        (*curr_weight)[i] = (*extra_curr_weight)[i];
3154      delete extra_curr_weight;
3155      goto LAST_GB_ALT2;
3156    }
3157#endif
3158    oldRing = currRing;
3159
3160    /* define a new ring that its ordering is "(a(curr_weight),lp) */
3161    if (currRing->parameter != NULL)
3162      DefRingPar(curr_weight);
3163    else
3164      VMrDefault(curr_weight);
3165
3166    newRing = currRing;
3167    Gomega1 = idrMoveR(Gomega, oldRing);
3168    to = clock();
3169    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
3170    M = MstdhomCC(Gomega1);
3171    xtstd=xtstd+clock()-to;
3172    /* change the ring to oldRing */
3173    rChangeCurrRing(oldRing);
3174    M1 =  idrMoveR(M, newRing);
3175    Gomega2 =  idrMoveR(Gomega1, newRing);
3176
3177    to = clock();
3178    /* compute the reduced Groebner basis of <G> w.r.t. "newRing"
3179       by the liftig process */
3180    F = MLifttwoIdeal(Gomega2, M1, G);
3181    xtlift=xtlift+clock()-to;
3182    idDelete(&M1);
3183    idDelete(&Gomega2);
3184    idDelete(&G);
3185
3186    /* change the ring to newRing */
3187    rChangeCurrRing(newRing);
3188    F1 = idrMoveR(F, oldRing);
3189
3190    to = clock();
3191    /* reduce the Groebner basis <G> w.r.t. newRing */
3192    G = kInterRedCC(F1, NULL);
3193    xtred=xtred+clock()-to;
3194    idDelete(&F1);
3195
3196    if(endwalks == 1)
3197      break;
3198
3199  NEXT_VECTOR:
3200    to = clock();
3201    /* compute a next weight vector */
3202    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
3203    xtnw=xtnw+clock()-to;
3204#ifdef PRINT_VECTORS
3205    MivString(curr_weight, target_weight, next_weight);
3206#endif
3207
3208    if(Overflow_Error == TRUE)
3209    {
3210      /*
3211        ivString(next_weight, "omega");
3212        PrintS("\n// ** The weight vector does NOT stay in Cone!!\n");
3213      */
3214#ifdef TEST_OVERFLOW
3215      goto  TEST_OVERFLOW_OI;
3216#endif
3217
3218
3219      newRing = currRing;
3220      if (currRing->parameter != NULL)
3221        DefRingPar(target_weight);
3222      else
3223        VMrDefault(target_weight);
3224
3225      F1 = idrMoveR(G, newRing);
3226      G = MstdCC(F1);
3227      idDelete(&F1);
3228      newRing = currRing;
3229      break;
3230    }
3231
3232    if(MivComp(next_weight, ivNull) == 1)
3233    {
3234      newRing = currRing;
3235      delete next_weight;
3236      break;
3237    }
3238
3239    if(MivComp(next_weight, target_weight) == 1)
3240    {
3241      if(MivSame(target_weight, exivlp)==1)
3242      {
3243      LAST_GB_ALT2:
3244        nOverflow_Error = Overflow_Error;
3245        tproc = clock()-xftinput;
3246        //Print("\n// takes %d steps and calls the recursion of level 2:",  nwalk);
3247        /* call the changed perturbation walk algorithm with degree 2 */
3248        G = Rec_LastGB(G, curr_weight, target_weight, 2,1);
3249        newRing = currRing;
3250        delete next_weight;
3251        break;
3252      }
3253      endwalks = 1;
3254    }
3255
3256    for(i=nV-1; i>=0; i--)
3257    {
3258      //(*extra_curr_weight)[i] = (*curr_weight)[i];
3259      (*curr_weight)[i] = (*next_weight)[i];
3260    }
3261    delete next_weight;
3262  }
3263 TEST_OVERFLOW_OI:
3264  rChangeCurrRing(XXRing);
3265  G = idrMoveR(G, newRing);
3266  delete ivNull;
3267  delete exivlp;
3268
3269#ifdef TIME_TEST
3270  Print("\n// \"Main procedure\"  took %d steps dnd %.2f sec. Overflow_Error (%d)", nwalk,
3271        ((double) tproc)/1000000, nOverflow_Error);
3272
3273  TimeStringFractal(xftinput, tostd, xtif, xtstd, xtextra,xtlift, xtred,xtnw);
3274
3275  Print("\n// pSetm_Error = (%d)", ErrorCheck());
3276  //Print("\n// Overflow_Error? (%d)", nOverflow_Error);
3277  Print("\n// Awalk2 took %d steps!!", nstep);
3278#endif
3279
3280  return(G);
3281}
3282
3283
3284/* 5.5.02 */
3285/* The implementation of the fractal walk algorithmus */
3286
3287/* The main procedur Mfwalk calls the recursive Subroutine
3288   rec_fractal_call to compute the wanted Gröbner basis.
3289   At the main procedur we compute the reduced Gröbner basis w.r.t. a "fast"
3290   order, e.g. "dp" and a sequence of weight vectors which are row vectors
3291   of a matrix. This matrix defines the given monomial order, e.g. "lp"
3292*/
3293
3294
3295
3296
3297/* perturb the matrix order of  "lex" */
3298static intvec* NewVectorlp(ideal I)
3299{
3300  int nV = currRing->N;
3301  intvec* iv_wlp =  MivMatrixOrderlp(nV);
3302  intvec* result = Mfpertvector(I, iv_wlp);
3303  delete iv_wlp;
3304  return result;
3305}
3306
3307int ngleich;
3308intvec* Xsigma;
3309intvec* Xtau;
3310int xn;
3311intvec* Xivinput;
3312intvec* Xivlp;
3313
3314
3315
3316/***********************************************************************
3317  The procedur REC_GB_Mwalk computes a GB for <G> w.r.t. the weight order
3318  otw, where G is a reduced GB w.r.t. the weight order cw.
3319  The new procedur Mwalk calls REC_GB.
3320************************************************************************/
3321static ideal REC_GB_Mwalk(ideal G, intvec* curr_weight, intvec* orig_target_weight,
3322                          int tp_deg, int npwinc)
3323{
3324  BOOLEAN nError = Overflow_Error;
3325  Overflow_Error = FALSE;
3326
3327  int i,  nV = currRing->N, ntwC,  npwinC;
3328  int nwalk=0, endwalks=0, nnwinC=1, nlast = 0;
3329  ideal Gomega, M, F, Gomega1, Gomega2, M1,F1,result,ssG;
3330  ring newRing, oldRing, TargetRing;
3331  intvec* iv_M_lp;
3332  intvec* target_weight;
3333  intvec* ivNull = new intvec(nV);
3334  intvec* hilb_func;
3335  BOOLEAN isGB = FALSE;
3336
3337  /* to avoid (1,0,...,0) as the target vector */
3338  intvec* last_omega = new intvec(nV);
3339  for(i=nV-1; i>0; i--)
3340    (*last_omega)[i] = 1;
3341  (*last_omega)[0] = 10000;
3342
3343  ring EXXRing = currRing;
3344
3345  /* compute a pertubed weight vector of the target weight vector */
3346  if(tp_deg > 1 && tp_deg <= nV)
3347  {
3348    ideal H0 = idHeadCC(G);
3349    if (currRing->parameter != NULL)
3350      DefRingPar(orig_target_weight);
3351    else
3352      VMrDefault(orig_target_weight);
3353
3354    TargetRing = currRing;
3355    ssG = idrMoveR(G,EXXRing);
3356
3357    ideal H0_tmp = idrMoveR(H0,EXXRing);
3358    ideal H1 = idHeadCC(ssG);
3359    id_Delete(&H0,EXXRing);
3360
3361    if(test_G_GB_walk(H0_tmp,H1)==1)
3362    {
3363      //Print("//input in %d-th recursive is a GB",tp_deg);
3364      idDelete(&H0_tmp);idDelete(&H1);
3365      G = ssG;
3366      ssG = NULL;
3367      newRing = currRing;
3368      delete ivNull;
3369      if(npwinc == 0)
3370      {
3371        isGB = TRUE;
3372        goto KSTD_Finish;
3373      }
3374      else
3375        goto LastGB_Finish;
3376    }
3377    idDelete(&H0_tmp);   idDelete(&H1);
3378
3379    intvec* ivlp = Mivlp(nV);
3380    if( MivSame(orig_target_weight, ivlp)==1 )
3381      iv_M_lp = MivMatrixOrderlp(nV);
3382    else
3383      iv_M_lp = MivMatrixOrder(orig_target_weight);
3384
3385    //target_weight  = MPertVectorslp(ssG, iv_M_lp, tp_deg);
3386    target_weight  = MPertVectors(ssG, iv_M_lp, tp_deg);
3387
3388    delete ivlp;
3389    delete iv_M_lp;
3390
3391    rChangeCurrRing(EXXRing);
3392    G = idrMoveR(ssG, TargetRing);
3393  }
3394
3395  while(1)
3396  {
3397    nwalk ++;
3398    nstep++;
3399    if(nwalk == 1)
3400      goto NEXT_STEP;
3401
3402    //Print("\n// Entering the %d-th step in the %d-th recursive:",nwalk,tp_deg);
3403    to = clock();
3404    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
3405    Gomega = MwalkInitialForm(G, curr_weight);
3406    xtif = xtif + clock()-to;
3407
3408#ifndef  BUCHBERGER_ALG
3409    if(isNolVector(curr_weight) == 0)
3410      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
3411    else
3412      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
3413#endif // BUCHBERGER_ALG
3414
3415    oldRing = currRing;
3416
3417    /* define a new ring that its ordering is "(a(curr_weight),lp) */
3418    if (currRing->parameter != NULL)
3419      DefRingPar(curr_weight);
3420    else
3421      VMrDefault(curr_weight);
3422
3423    newRing = currRing;
3424    Gomega1 = idrMoveR(Gomega, oldRing);
3425
3426    to = clock();
3427    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
3428#ifdef  BUCHBERGER_ALG
3429    M = MstdhomCC(Gomega1);
3430#else
3431    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
3432    delete hilb_func;
3433#endif // BUCHBERGER_ALG
3434    xtstd = xtstd + clock() - to;
3435
3436    /* change the ring to oldRing */
3437    rChangeCurrRing(oldRing);
3438
3439    M1 =  idrMoveR(M, newRing);
3440    Gomega2 =  idrMoveR(Gomega1, newRing);
3441
3442    to = clock();
3443    F = MLifttwoIdeal(Gomega2, M1, G);
3444    xtlift = xtlift + clock() -to;
3445
3446    idDelete(&M1);
3447    idDelete(&Gomega2);
3448    idDelete(&G);
3449
3450
3451    /* change the ring to newRing */
3452    rChangeCurrRing(newRing);
3453    F1 = idrMoveR(F, oldRing);
3454
3455    to = clock();
3456    /* reduce the Groebner basis <G> w.r.t. new ring */
3457    G = kInterRedCC(F1, NULL);
3458    xtred = xtred + clock() -to;
3459
3460    idDelete(&F1);
3461
3462    if(endwalks == 1)
3463      break;
3464
3465  NEXT_STEP:
3466    to = clock();
3467    /* compute a next weight vector */
3468    intvec* next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
3469    xtnw = xtnw + clock() - to;
3470
3471#ifdef PRINT_VECTORS
3472    MivString(curr_weight, target_weight, next_weight);
3473#endif
3474
3475    /*check whether the computed vector does in the correct cone */
3476    //ntwC = test_w_in_ConeCC(G, next_weight);
3477    //if(ntwC != 1)
3478    if(Overflow_Error == TRUE)
3479    {
3480      PrintS("\n// ** The computed vector does NOT stay in Cone!!\n");
3481      nnwinC = 0;
3482      if(tp_deg == nV)
3483        nlast = 1;
3484      delete next_weight;
3485      break;
3486    }
3487    if(MivComp(next_weight, ivNull) == 1)
3488    {
3489      newRing = currRing;
3490      delete next_weight;
3491      break;
3492    }
3493
3494    if(MivComp(next_weight, target_weight) == 1)
3495    {
3496      if(tp_deg == nV)
3497        endwalks = 1;
3498      else {
3499        G = REC_GB_Mwalk(G,curr_weight, orig_target_weight, tp_deg+1,nnwinC);
3500        newRing = currRing;
3501        delete next_weight;
3502        break;
3503      }
3504    }
3505
3506    /* 06.11.01 NOT Changed */
3507    for(i=nV-1; i>=0; i--)
3508      (*curr_weight)[i] = (*next_weight)[i];
3509
3510    delete next_weight;
3511  }//while
3512
3513  delete ivNull;
3514
3515  if(tp_deg != nV)
3516  {
3517    //28.07.03
3518    newRing = currRing;
3519
3520    if (currRing->parameter != NULL)
3521      //  DefRingParlp(); //
3522      DefRingPar(orig_target_weight);
3523    else
3524      VMrDefault(orig_target_weight);
3525
3526
3527    F1 = idrMoveR(G, newRing);
3528
3529    if(nnwinC == 0)
3530      F1 = REC_GB_Mwalk(F1,curr_weight, orig_target_weight, tp_deg+1,nnwinC);
3531    else
3532      if(test_w_in_ConeCC(F1, target_weight) != 1)
3533        F1 = REC_GB_Mwalk(F1,curr_weight, orig_target_weight,tp_deg+1,nnwinC);
3534
3535    delete target_weight;
3536
3537    TargetRing = currRing;
3538    rChangeCurrRing(EXXRing);
3539    result = idrMoveR(F1, TargetRing);
3540  }
3541  else
3542  {
3543    if(nlast == 1)
3544    {
3545      if (currRing->parameter != NULL)
3546        DefRingPar(orig_target_weight);
3547      else
3548        VMrDefault(orig_target_weight);
3549
3550
3551    KSTD_Finish:
3552      if(isGB == FALSE)
3553        F1 = idrMoveR(G, newRing);
3554      else
3555        F1 = G;
3556      to=clock();
3557      /* apply Buchberger alg to compute a red. GB of F1 */
3558      G = MstdCC(F1);
3559      xtextra=clock()-to;
3560      idDelete(&F1);
3561      newRing = currRing;
3562    }
3563
3564  LastGB_Finish:
3565    rChangeCurrRing(EXXRing);
3566    result = idrMoveR(G, newRing);
3567  }
3568
3569  if(Overflow_Error == FALSE)
3570    Overflow_Error = nError;
3571
3572  return(result);
3573}
3574
3575
3576/* 08.09.02 */
3577/******** THE NEW GRÖBNER WALK ALGORITHM **********/
3578/* Gröbnerwalk with a recursive "second" alternative GW, REC_GB_Mwalk
3579   that only computes the last reduced GB */
3580ideal Mwalk(ideal Go, intvec* curr_weight, intvec* target_weight)
3581{
3582  Set_Error(FALSE);
3583  Overflow_Error = FALSE;
3584  //Print("// pSetm_Error = (%d)", ErrorCheck());
3585
3586  clock_t tinput, tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0;
3587  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0;
3588  tinput = clock();
3589  clock_t tim;
3590  nstep=0;
3591  int i, nV = currRing->N;
3592  int nwalk=0, endwalks=0;
3593
3594  ideal Gomega, M, F, Gomega1, Gomega2, M1, F1, G, G1;
3595  ring endRing, newRing, oldRing;
3596  intvec* ivNull = new intvec(nV);
3597  intvec* exivlp = Mivlp(nV);
3598  intvec* hilb_func;
3599
3600  intvec* tmp_weight = new intvec(nV);
3601  for(i=nV-1; i>=0; i--)
3602    (*tmp_weight)[i] = (*curr_weight)[i];
3603
3604   /* to avoid (1,0,...,0) as the target vector */
3605  intvec* last_omega = new intvec(nV);
3606  for(i=nV-1; i>0; i--)
3607    (*last_omega)[i] = 1;
3608  (*last_omega)[0] = 10000;
3609
3610  ring XXRing = currRing;
3611
3612  to = clock();
3613  /* the monomial ordering of this current ring would be "dp" */
3614  G = MstdCC(Go);
3615  tostd = clock()-to;
3616
3617  if(currRing->order[0] == ringorder_a)
3618    goto NEXT_VECTOR;
3619
3620  while(1)
3621  {
3622    nwalk ++;
3623    nstep ++;
3624    to = clock();
3625    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
3626    Gomega = MwalkInitialForm(G, curr_weight);
3627    tif = tif + clock()-to;
3628    oldRing = currRing;
3629
3630    if(endwalks == 1)
3631    {
3632      /* compute a reduced Groebner basis of Gomega w.r.t. >>_cw by
3633         the recursive changed perturbation walk alg. */
3634      tim = clock();
3635      /*
3636        Print("\n// **** Gröbnerwalk took %d steps and ", nwalk);
3637        PrintS("\n// **** call the rec. Pert. Walk to compute a red GB of:");
3638        idElements(Gomega, "G_omega");
3639      */
3640
3641      if(MivSame(exivlp, target_weight)==1)
3642        M = REC_GB_Mwalk(idCopy(Gomega), tmp_weight, curr_weight, 2,1);
3643      else
3644        goto NORMAL_GW;
3645      /*
3646        Print("\n//  time for the last std(Gw)  = %.2f sec",
3647        ((double) (clock()-tim)/1000000));
3648        PrintS("\n// ***************************************************\n");
3649      */
3650#ifdef CHECK_IDEAL_MWALK
3651      idElements(Gomega, "G_omega");
3652      headidString(Gomega, "Gw");
3653      idElements(M, "M");
3654      //headidString(M, "M");
3655#endif
3656      to = clock();
3657      F = MLifttwoIdeal(Gomega, M, G);
3658      xtlift = xtlift + clock() - to;
3659
3660      idDelete(&Gomega);
3661      idDelete(&M);
3662      idDelete(&G);
3663
3664      oldRing = currRing;
3665
3666      /* create a new ring newRing */
3667       if (currRing->parameter != NULL)
3668         DefRingPar(curr_weight);
3669       else
3670         VMrDefault(curr_weight);
3671
3672      newRing = currRing;
3673      F1 = idrMoveR(F, oldRing);
3674    }
3675    else
3676    {
3677    NORMAL_GW:
3678#ifndef  BUCHBERGER_ALG
3679      if(isNolVector(curr_weight) == 0)
3680        hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
3681      else
3682        hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
3683#endif // BUCHBERGER_ALG
3684
3685      /* define a new ring that its ordering is "(a(curr_weight),lp) */
3686      if (currRing->parameter != NULL)
3687        DefRingPar(curr_weight);
3688      else
3689        VMrDefault(curr_weight);
3690
3691      newRing = currRing;
3692      Gomega1 = idrMoveR(Gomega, oldRing);
3693
3694      to = clock();
3695      /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
3696#ifdef  BUCHBERGER_ALG
3697      M = MstdhomCC(Gomega1);
3698#else
3699      M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
3700      delete hilb_func;
3701#endif // BUCHBERGER_ALG
3702      tstd = tstd + clock() - to;
3703
3704      /* change the ring to oldRing */
3705      rChangeCurrRing(oldRing);
3706      M1 =  idrMoveR(M, newRing);
3707      Gomega2 =  idrMoveR(Gomega1, newRing);
3708
3709      to = clock();
3710      /* compute a representation of the generators of submod (M)
3711         with respect to those of mod (Gomega).
3712         Gomega is a reduced Groebner basis w.r.t. the current ring */
3713      F = MLifttwoIdeal(Gomega2, M1, G);
3714      tlift = tlift + clock() - to;
3715
3716      idDelete(&M1);
3717      idDelete(&Gomega2);
3718      idDelete(&G);
3719
3720      /* change the ring to newRing */
3721      rChangeCurrRing(newRing);
3722      F1 = idrMoveR(F, oldRing);
3723    }
3724
3725    to = clock();
3726    /* reduce the Groebner basis <G> w.r.t. new ring */
3727    G = kInterRedCC(F1, NULL);
3728    if(endwalks != 1)
3729      tred = tred + clock() - to;
3730    else
3731      xtred = xtred + clock() - to;
3732
3733    idDelete(&F1);
3734    if(endwalks == 1)
3735      break;
3736
3737  NEXT_VECTOR:
3738    to = clock();
3739    /* compute a next weight vector */
3740    intvec* next_weight = MkInterRedNextWeight(curr_weight,target_weight,G);
3741    tnw = tnw + clock() - to;
3742#ifdef PRINT_VECTORS
3743    MivString(curr_weight, target_weight, next_weight);
3744#endif
3745
3746    //if(test_w_in_ConeCC(G, next_weight) != 1)
3747    if(Overflow_Error == TRUE)
3748    {
3749      newRing = currRing;
3750      PrintS("\n// ** The computed vector does NOT stay in Cone!!\n");
3751
3752      if (currRing->parameter != NULL)
3753        DefRingPar(target_weight);
3754      else
3755        VMrDefault(target_weight);
3756
3757      F1 = idrMoveR(G, newRing);
3758      G = MstdCC(F1);
3759      idDelete(&F1);
3760
3761      newRing = currRing;
3762      break;
3763    }
3764
3765    if(MivComp(next_weight, ivNull) == 1)
3766    {
3767      newRing = currRing;
3768      delete next_weight;
3769      break;
3770    }
3771    if(MivComp(next_weight, target_weight) == 1)
3772      endwalks = 1;
3773
3774    for(i=nV-1; i>=0; i--) {
3775      (*tmp_weight)[i] = (*curr_weight)[i];
3776      (*curr_weight)[i] = (*next_weight)[i];
3777    }
3778    delete next_weight;
3779  }
3780  rChangeCurrRing(XXRing);
3781  G = idrMoveR(G, newRing);
3782
3783  delete tmp_weight;
3784  delete ivNull;
3785  delete exivlp;
3786
3787#ifdef TIME_TEST
3788  TimeString(tinput, tostd, tif, tstd, tlift, tred, tnw, nstep);
3789
3790  Print("\n// pSetm_Error = (%d)", ErrorCheck());
3791  Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
3792#endif
3793  return(G);
3794}
3795
3796  /* 2.12.02*/
3797ideal Mwalk_tst(ideal Go, intvec* curr_weight, intvec* target_weight)
3798{
3799  clock_t tinput=clock();
3800  //idString(Go,"Ginp");
3801  int i, nV = currRing->N;
3802  int nwalk=0, endwalks=0;
3803
3804  ideal Gomega, M, F, Gomega1, Gomega2, M1, F1, G, G1;
3805  ring endRing, newRing, oldRing;
3806  intvec* ivNull = new intvec(nV);
3807  ring XXRing = currRing;
3808
3809  intvec* tmp_weight = new intvec(nV);
3810  for(i=nV-1; i>=0; i--)
3811    (*tmp_weight)[i] = (*curr_weight)[i];
3812
3813  /* the monomial ordering of this current ring would be "dp" */
3814  G = MstdCC(Go);
3815
3816  intvec* hilb_func;
3817
3818  /* to avoid (1,0,...,0) as the target vector */
3819  intvec* last_omega = new intvec(nV);
3820  for(i=nV-1; i>0; i--)
3821    (*last_omega)[i] = 1;
3822  (*last_omega)[0] = 10000;
3823
3824  while(1)
3825  {
3826    nwalk ++;
3827    //Print("\n// Entering the %d-th step:", nwalk);
3828    //Print("\n// ring r[%d] = %s;", nwalk, rString(currRing));
3829    idString(G,"G");
3830    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
3831    Gomega = MwalkInitialForm(G, curr_weight);
3832    //ivString(curr_weight, "omega");
3833    idString(Gomega,"Gw");
3834
3835#ifndef  BUCHBERGER_ALG
3836    if(isNolVector(curr_weight) == 0)
3837      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
3838    else
3839      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
3840#endif // BUCHBERGER_ALG
3841
3842
3843    oldRing = currRing;
3844
3845    /* define a new ring that its ordering is "(a(curr_weight),lp) */
3846    VMrDefault(curr_weight);
3847    newRing = currRing;
3848
3849    Gomega1 = idrMoveR(Gomega, oldRing);
3850
3851    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
3852#ifdef  BUCHBERGER_ALG
3853    M = MstdhomCC(Gomega1);
3854#else
3855    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
3856    delete hilb_func;
3857#endif // BUCHBERGER_ALG
3858
3859    idString(M,"M");
3860
3861      /* change the ring to oldRing */
3862    rChangeCurrRing(oldRing);
3863    M1 =  idrMoveR(M, newRing);
3864    Gomega2 =  idrMoveR(Gomega1, newRing);
3865
3866      /* compute a representation of the generators of submod (M)
3867         with respect to those of mod (Gomega).
3868         Gomega is a reduced Groebner basis w.r.t. the current ring */
3869    F = MLifttwoIdeal(Gomega2, M1, G);
3870    idDelete(&M1);
3871    idDelete(&Gomega2);
3872    idDelete(&G);
3873    idString(F,"F");
3874
3875    /* change the ring to newRing */
3876    rChangeCurrRing(newRing);
3877    F1 = idrMoveR(F, oldRing);
3878
3879    /* reduce the Groebner basis <G> w.r.t. new ring */
3880    G = kInterRedCC(F1, NULL);
3881    //idSkipZeroes(G);//done by kInterRed
3882    idDelete(&F1);
3883    idString(G,"G");
3884    if(endwalks == 1)
3885      break;
3886
3887    /* compute a next weight vector */
3888    intvec* next_weight = MkInterRedNextWeight(curr_weight,target_weight,G);
3889#ifdef PRINT_VECTORS
3890    MivString(curr_weight, target_weight, next_weight);
3891#endif
3892
3893    if(MivComp(next_weight, ivNull) == 1)
3894    {
3895      delete next_weight;
3896      break;
3897    }
3898    if(MivComp(next_weight, target_weight) == 1)
3899      endwalks = 1;
3900
3901    for(i=nV-1; i>=0; i--)
3902      (*tmp_weight)[i] = (*curr_weight)[i];
3903
3904    /* 06.11.01 to free the memory: NOT Changed!!*/
3905    for(i=nV-1; i>=0; i--)
3906      (*curr_weight)[i] = (*next_weight)[i];
3907    delete next_weight;
3908  }
3909  rChangeCurrRing(XXRing);
3910  G = idrMoveR(G, newRing);
3911
3912  delete tmp_weight;
3913  delete ivNull;
3914  PrintLn();
3915  return(G);
3916}
3917
3918
3919
3920/**************************************************************/
3921/*     Implementation of the perturbation walk algorithm      */
3922/**************************************************************/
3923/* If the perturbed target weight vector or an intermediate weight vector
3924   doesn't stay in the correct Groebner cone, we have only
3925   a reduced Groebner basis for the given ideal with respect to
3926   a monomial order which differs to the given order.
3927   Then we have to compute the wanted  reduced Groebner basis for it.
3928   For this, we can use
3929   1) the improved Buchberger algorithm or
3930   2) the changed perturbation walk algorithm with a decreased degree.
3931*/
3932/* use kStd, if nP = 0, else call LastGB */
3933ideal Mpwalk(ideal Go, int op_deg, int tp_deg,intvec* curr_weight,
3934             intvec* target_weight, int nP)
3935{
3936  Set_Error(FALSE  );
3937  Overflow_Error = FALSE;
3938  //Print("// pSetm_Error = (%d)", ErrorCheck());
3939
3940  clock_t  tinput, tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0;
3941  xtextra=0;
3942  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0;
3943  tinput = clock();
3944
3945  clock_t tim;
3946
3947  nstep = 0;
3948  int i, ntwC=1, ntestw=1,  nV = currRing->N, op_tmp = op_deg;
3949  int endwalks=0, nhilb=0, ntestomega=0;
3950
3951  ideal Gomega, M, F, G, Gomega1, Gomega2, M1,F1,Eresult,ssG;
3952  ring newRing, oldRing, TargetRing;
3953  intvec* iv_M_dp;
3954  intvec* iv_M_lp;
3955  intvec* exivlp = Mivlp(nV);
3956  intvec* orig_target = target_weight;
3957  intvec* pert_target_vector = target_weight;
3958  intvec* ivNull = new intvec(nV);
3959  intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
3960  intvec* cw_tmp = curr_weight;
3961  intvec* hilb_func;
3962  intvec* next_weight;
3963  intvec* extra_curr_weight = new intvec(nV);
3964
3965  /* to avoid (1,0,...,0) as the target vector */
3966  intvec* last_omega = new intvec(nV);
3967  for(i=nV-1; i>0; i--)
3968    (*last_omega)[i] = 1;
3969  (*last_omega)[0] = 10000;
3970
3971  ring XXRing = currRing;
3972
3973
3974  to = clock();
3975  /* perturbs the original vector */
3976  if(MivComp(curr_weight, iv_dp) == 1) //rOrdStr(currRing) := "dp"
3977  {
3978    G = MstdCC(Go);
3979    tostd = clock()-to;
3980    if(op_deg != 1){
3981      iv_M_dp = MivMatrixOrderdp(nV);
3982      //ivString(iv_M_dp, "iv_M_dp");
3983      curr_weight = MPertVectors(G, iv_M_dp, op_deg);
3984    }
3985  }
3986  else
3987  {
3988    //ring order := (a(curr_weight),lp);
3989    if (currRing->parameter != NULL)
3990      DefRingPar(curr_weight);
3991    else
3992      VMrDefault(curr_weight);
3993
3994    G = idrMoveR(Go, XXRing);
3995    G = MstdCC(G);
3996    tostd = clock()-to;
3997    if(op_deg != 1){
3998      iv_M_dp = MivMatrixOrder(curr_weight);
3999      curr_weight = MPertVectors(G, iv_M_dp, op_deg);
4000    }
4001  }
4002  delete iv_dp;
4003  if(op_deg != 1) delete iv_M_dp;
4004
4005  ring HelpRing = currRing;
4006
4007  /* perturbs the target weight vector */
4008  if(tp_deg > 1 && tp_deg <= nV)
4009  {
4010    if (currRing->parameter != NULL)
4011      DefRingPar(target_weight);
4012    else
4013      VMrDefault(target_weight);
4014
4015    TargetRing = currRing;
4016    ssG = idrMoveR(G,HelpRing);
4017    if(MivSame(target_weight, exivlp) == 1)
4018    {
4019      iv_M_lp = MivMatrixOrderlp(nV);
4020      //ivString(iv_M_lp, "iv_M_lp");
4021      //target_weight = MPertVectorslp(ssG, iv_M_lp, tp_deg);
4022      target_weight = MPertVectors(ssG, iv_M_lp, tp_deg);
4023    }
4024    else
4025    {
4026      iv_M_lp = MivMatrixOrder(target_weight);
4027      //target_weight = MPertVectorslp(ssG, iv_M_lp, tp_deg);
4028      target_weight = MPertVectors(ssG, iv_M_lp, tp_deg);
4029    }
4030    delete iv_M_lp;
4031    pert_target_vector = target_weight; //vor 19. mai 2003//test 19 Junu 03
4032    rChangeCurrRing(HelpRing);
4033    G = idrMoveR(ssG, TargetRing);
4034  }
4035  /*
4036    Print("\n// Perturbationwalkalg. vom Gradpaar (%d,%d):",op_deg,tp_deg);
4037    ivString(curr_weight, "new sigma");
4038    ivString(target_weight, "new tau");
4039  */
4040  while(1)
4041  {
4042    nstep ++;
4043    to = clock();
4044    /* compute an initial form ideal of <G> w.r.t. the weight vector
4045       "curr_weight" */
4046    Gomega = MwalkInitialForm(G, curr_weight);
4047
4048
4049#ifdef ENDWALKS
4050    if(endwalks == 1){
4051      Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
4052      idElements(G, "G");
4053      // idElements(Gomega, "Gw");
4054      headidString(G, "G");
4055      //headidString(Gomega, "Gw");
4056    }
4057#endif
4058
4059    tif = tif + clock()-to;
4060
4061#ifndef  BUCHBERGER_ALG
4062    if(isNolVector(curr_weight) == 0)
4063      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
4064    else
4065      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
4066#endif // BUCHBERGER_ALG
4067
4068    oldRing = currRing;
4069
4070    /* define a new ring that its ordering is "(a(curr_weight),lp) */
4071    if (currRing->parameter != NULL)
4072      DefRingPar(curr_weight);
4073    else
4074      VMrDefault(curr_weight);
4075
4076    newRing = currRing;
4077    Gomega1 = idrMoveR(Gomega, oldRing);
4078
4079#ifdef ENDWALKS
4080    if(endwalks==1)
4081    {
4082      Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
4083      idElements(Gomega1, "Gw");
4084      headidString(Gomega1, "headGw");
4085      PrintS("\n// compute a rGB of Gw:\n");
4086
4087#ifndef  BUCHBERGER_ALG
4088      ivString(hilb_func, "w");
4089#endif
4090    }
4091#endif
4092
4093    tim = clock();
4094    to = clock();
4095    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
4096#ifdef  BUCHBERGER_ALG
4097    M = MstdhomCC(Gomega1);
4098#else
4099    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
4100    delete hilb_func;
4101#endif // BUCHBERGER_ALG
4102
4103    if(endwalks == 1){
4104      xtstd = xtstd+clock()-to;
4105#ifdef ENDWALKS
4106      Print("\n// time for the last std(Gw)  = %.2f sec\n",
4107            ((double) clock())/1000000 -((double)tim) /1000000);
4108#endif
4109    }
4110    else
4111      tstd=tstd+clock()-to;
4112
4113    /* change the ring to oldRing */
4114    rChangeCurrRing(oldRing);
4115    M1 =  idrMoveR(M, newRing);
4116    Gomega2 =  idrMoveR(Gomega1, newRing);
4117
4118    //if(endwalks==1)  PrintS("\n// Lifting is working:..");
4119
4120    to=clock();
4121    /* compute a representation of the generators of submod (M)
4122       with respect to those of mod (Gomega).
4123       Gomega is a reduced Groebner basis w.r.t. the current ring */
4124    F = MLifttwoIdeal(Gomega2, M1, G);
4125    if(endwalks != 1)
4126      tlift = tlift+clock()-to;
4127    else
4128      xtlift=clock()-to;
4129
4130    idDelete(&M1);
4131    idDelete(&Gomega2);
4132    idDelete(&G);
4133
4134    /* change the ring to newRing */
4135    rChangeCurrRing(newRing);
4136    F1 = idrMoveR(F, oldRing);
4137
4138    //if(endwalks==1)PrintS("\n// InterRed is working now:");
4139
4140    to=clock();
4141    /* reduce the Groebner basis <G> w.r.t. new ring */
4142    G = kInterRedCC(F1, NULL);
4143    if(endwalks != 1)
4144      tred = tred+clock()-to;
4145    else
4146      xtred=clock()-to;
4147
4148    idDelete(&F1);
4149
4150    if(endwalks == 1)
4151      break;
4152
4153    to=clock();
4154    /* compute a next weight vector */
4155    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
4156    tnw=tnw+clock()-to;
4157#ifdef PRINT_VECTORS
4158    MivString(curr_weight, target_weight, next_weight);
4159#endif
4160
4161    if(Overflow_Error == TRUE)
4162    {
4163      ntwC = 0;
4164      ntestomega = 1;
4165      //Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
4166      //idElements(G, "G");
4167      delete next_weight;
4168      goto FINISH_160302;
4169    }
4170    if(MivComp(next_weight, ivNull) == 1){
4171      newRing = currRing;
4172      delete next_weight;//16.03.02
4173      //Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
4174      break;
4175    }
4176    if(MivComp(next_weight, target_weight) == 1)
4177      endwalks = 1;
4178
4179    for(i=nV-1; i>=0; i--)
4180      (*curr_weight)[i] = (*next_weight)[i];
4181
4182    delete next_weight;
4183  }//while
4184
4185  if(tp_deg != 1)
4186  {
4187  FINISH_160302://16.03.02
4188    if(MivSame(orig_target, exivlp) == 1)
4189      if (currRing->parameter != NULL)
4190        DefRingParlp();
4191      else
4192        VMrDefaultlp();
4193    else
4194      if (currRing->parameter != NULL)
4195        DefRingPar(orig_target);
4196      else
4197        VMrDefault(orig_target);
4198
4199    TargetRing=currRing;
4200    F1 = idrMoveR(G, newRing);
4201#ifdef CHECK_IDEAL
4202      headidString(G, "G");
4203#endif
4204
4205
4206    // check whether the pertubed target vector stays in the correct cone
4207    if(ntwC != 0){
4208      ntestw = test_w_in_ConeCC(F1, pert_target_vector);
4209    }
4210
4211    if( ntestw != 1 || ntwC == 0)
4212    {
4213      /*
4214      if(ntestw != 1){
4215        ivString(pert_target_vector, "tau");
4216        PrintS("\n// ** perturbed target vector doesn't stay in cone!!");
4217        Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
4218        idElements(F1, "G");
4219      }
4220      */
4221      /* LastGB is "better" than the kStd subroutine */
4222      to=clock();
4223      ideal eF1;
4224      if(nP == 0 || tp_deg == 1 || MivSame(orig_target, exivlp) != 1){
4225        // PrintS("\n// ** calls \"std\" to compute a GB");
4226        eF1 = MstdCC(F1);
4227        idDelete(&F1);
4228      }
4229      else {
4230        // PrintS("\n// ** calls \"LastGB\" to compute a GB");
4231        rChangeCurrRing(newRing);
4232        ideal F2 = idrMoveR(F1, TargetRing);
4233        eF1 = LastGB(F2, curr_weight, tp_deg-1);
4234        F2=NULL;
4235      }
4236      xtextra=clock()-to;
4237      ring exTargetRing = currRing;
4238
4239      rChangeCurrRing(XXRing);
4240      Eresult = idrMoveR(eF1, exTargetRing);
4241    }
4242    else{
4243      rChangeCurrRing(XXRing);
4244      Eresult = idrMoveR(F1, TargetRing);
4245    }
4246  }
4247  else {
4248    rChangeCurrRing(XXRing);
4249    Eresult = idrMoveR(G, newRing);
4250  }
4251  delete ivNull;
4252  if(tp_deg != 1)
4253    delete target_weight;
4254
4255  if(op_deg != 1 )
4256    delete curr_weight;
4257
4258  delete exivlp;
4259  delete last_omega;
4260
4261#ifdef TIME_TEST
4262  TimeStringFractal(tinput, tostd, tif+xtif, tstd+xtstd,0, tlift+xtlift, tred+xtred,
4263             tnw+xtnw);
4264
4265  Print("\n// pSetm_Error = (%d)", ErrorCheck());
4266  Print("\n// It took %d steps and Overflow_Error? (%d)\n", nstep,  Overflow_Error);
4267#endif
4268  return(Eresult);
4269}
4270
4271intvec* XivNull;
4272
4273/* define a matrix (1 ... 1) */
4274intvec* MMatrixone(int nV)
4275{
4276  int i,j;
4277  intvec* ivM = new intvec(nV*nV);
4278
4279  for(i=0; i<nV; i++)
4280    for(j=0; j<nV; j++)
4281    (*ivM)[i*nV + j] = 1;
4282
4283  return(ivM);
4284}
4285
4286int nnflow;
4287int Xcall;
4288int Xngleich;
4289
4290/* 27.07.03 */
4291/* Perturb the start weight vector at the top level, i.e. nlev = 1 */
4292static ideal rec_fractal_call(ideal G, int nlev, intvec* omtmp)
4293{
4294  Overflow_Error =  FALSE;
4295  //Print("\n\n// Entering the %d-th recursion:", nlev);
4296
4297  int i, nV = currRing->N;
4298  ring new_ring, testring, extoRing;
4299  ideal Gomega, Gomega1, Gomega2, F, F1, Gresult, Gresult1, G1, Gt;
4300  int nwalks = 0;
4301  intvec* Mwlp;
4302  intvec* hilb_func;
4303  intvec* extXtau;
4304  intvec* next_vect;
4305  intvec* omega2 = new intvec(nV);
4306  intvec* altomega = new intvec(nV);
4307
4308  BOOLEAN isnewtarget = FALSE;
4309
4310  /* to avoid (1,0,...,0) as the target vector (Hans) */
4311  intvec* last_omega = new intvec(nV);
4312  for(i=nV-1; i>0; i--)
4313    (*last_omega)[i] = 1;
4314  (*last_omega)[0] = 10000;
4315
4316  intvec* omega = new intvec(nV);
4317  for(i=0; i<nV; i++) {
4318    if(Xsigma->length() == nV)
4319      (*omega)[i] =  (*Xsigma)[i];
4320    else
4321      (*omega)[i] = (*Xsigma)[(nV*(nlev-1))+i];
4322
4323    (*omega2)[i] = (*Xtau)[(nlev-1)*nV+i];
4324  }
4325
4326   if(nlev == 1)  Xcall = 1;
4327   else Xcall = 0;
4328
4329  ring oRing = currRing;
4330
4331  while(1)
4332  {
4333#ifdef FIRST_STEP_FRACTAL
4334    // perturb the current weight vector only on the top level or
4335    // after perturbation of the both vectors, nlev = 2 as the top level
4336    if((nlev == 1 && Xcall == 0) || (nlev == 2 && Xngleich == 1))
4337      if(islengthpoly2(G) == 1)
4338      {
4339        Mwlp = MivWeightOrderlp(omega);
4340        Xsigma = Mfpertvector(G, Mwlp);
4341        delete Mwlp;
4342        Overflow_Error = FALSE;
4343      }
4344#endif
4345    nwalks ++;
4346    NEXT_VECTOR_FRACTAL:
4347    to=clock();
4348    /* determine the next border */
4349    next_vect = MkInterRedNextWeight(omega,omega2,G);
4350    xtnw=xtnw+clock()-to;
4351#ifdef PRINT_VECTORS
4352    MivString(omega, omega2, next_vect);
4353#endif
4354    oRing = currRing;
4355
4356    /* We only perturb the current target vector at the recursion  level 1 */
4357    if(Xngleich == 0 && nlev == 1) //(ngleich == 0) important, e.g. ex2, ex3
4358      if (MivComp(next_vect, omega2) == 1)
4359      {
4360        /* to dispense with taking initial (and lifting/interreducing
4361           after the call of recursion */
4362        //Print("\n\n// ** Perturb the both vectors with degree %d with",nlev);
4363        //idElements(G, "G");
4364
4365        Xngleich = 1;
4366        nlev +=1;
4367
4368        if (currRing->parameter != NULL)
4369          DefRingPar(omtmp);
4370        else
4371          VMrDefault(omtmp);
4372
4373        testring = currRing;
4374        Gt = idrMoveR(G, oRing);
4375
4376        /* perturb the original target vector w.r.t. the current GB */
4377        delete Xtau;
4378        Xtau = NewVectorlp(Gt);
4379
4380        rChangeCurrRing(oRing);
4381        G = idrMoveR(Gt, testring);
4382
4383        /* perturb the current vector w.r.t. the current GB */
4384        Mwlp = MivWeightOrderlp(omega);
4385        Xsigma = Mfpertvector(G, Mwlp);
4386        delete Mwlp;
4387
4388        for(i=nV-1; i>=0; i--) {
4389          (*omega2)[i] = (*Xtau)[nV+i];
4390          (*omega)[i] = (*Xsigma)[nV+i];
4391        }
4392
4393        delete next_vect;
4394        to=clock();
4395
4396        /* to avoid the value of Overflow_Error that occur in Mfpertvector*/
4397        Overflow_Error = FALSE;
4398
4399        next_vect = MkInterRedNextWeight(omega,omega2,G);
4400        xtnw=xtnw+clock()-to;
4401
4402#ifdef PRINT_VECTORS
4403        MivString(omega, omega2, next_vect);
4404#endif
4405      }
4406
4407
4408    /* check whether the the computed vector is in the correct cone */
4409    /* If no, the reduced GB of an omega-homogeneous ideal will be
4410       computed by Buchberger algorithm and stop this recursion step*/
4411    //if(test_w_in_ConeCC(G, next_vect) != 1) //e.g. Example s7, cyc6
4412    if(Overflow_Error == TRUE)
4413    {
4414      delete next_vect;
4415
4416    OVERFLOW_IN_NEXT_VECTOR:
4417      if (currRing->parameter != NULL)
4418        DefRingPar(omtmp);
4419      else
4420        VMrDefault(omtmp);
4421
4422#ifdef TEST_OVERFLOW
4423      Gt = idrMoveR(G, oRing);
4424      Gt = NULL; return(Gt);
4425#endif
4426
4427      //Print("\n\n// apply BB's alg. in ring r = %s;", rString(currRing));
4428      to=clock();
4429      Gt = idrMoveR(G, oRing);
4430      G1 = MstdCC(Gt);
4431      xtextra=xtextra+clock()-to;
4432      Gt = NULL;
4433
4434      delete omega2;
4435      delete altomega;
4436
4437      //Print("\n// Leaving the %d-th recursion with %d steps", nlev, nwalks);
4438      //Print("  ** Overflow_Error? (%d)", Overflow_Error);
4439      nnflow ++;
4440
4441      Overflow_Error = FALSE;
4442      return (G1);
4443    }
4444
4445
4446    /* If the perturbed target vector stays in the correct cone,
4447       return the current GB,
4448       otherwise, return the computed  GB by the Buchberger-algorithm.
4449       Then we update the perturbed target vectors w.r.t. this GB. */
4450
4451    /* the computed vector is equal to the origin vector, since
4452       t is not defined */
4453    if (MivComp(next_vect, XivNull) == 1)
4454    {
4455      if (currRing->parameter != NULL)
4456        DefRingPar(omtmp);
4457      else
4458        VMrDefault(omtmp);
4459
4460      testring = currRing;
4461      Gt = idrMoveR(G, oRing);
4462
4463      if(test_w_in_ConeCC(Gt, omega2) == 1) {
4464        delete omega2;
4465        delete next_vect;
4466        delete altomega;
4467        //Print("\n// Leaving the %d-th recursion with %d steps ",nlev, nwalks);
4468        //Print(" ** Overflow_Error? (%d)", Overflow_Error);
4469
4470        return (Gt);
4471      }
4472      else
4473      {
4474        //ivString(omega2, "tau'");
4475        //Print("\n//  tau' doesn't stay in the correct cone!!");
4476
4477#ifndef  MSTDCC_FRACTAL
4478        //07.08.03
4479        //ivString(Xtau, "old Xtau");
4480        intvec* Xtautmp = Mfpertvector(Gt, MivMatrixOrder(omtmp));
4481#ifdef TEST_OVERFLOW
4482      if(Overflow_Error == TRUE)
4483      Gt = NULL; return(Gt);
4484#endif
4485
4486        if(MivSame(Xtau, Xtautmp) == 1)
4487        {
4488          //PrintS("\n// Update vectors are equal to the old vectors!!");
4489          delete Xtautmp;
4490          goto FRACTAL_MSTDCC;
4491        }
4492
4493        Xtau = Xtautmp;
4494        Xtautmp = NULL;
4495        //ivString(Xtau, "new  Xtau");
4496
4497        for(i=nV-1; i>=0; i--)
4498          (*omega2)[i] = (*Xtau)[(nlev-1)*nV+i];
4499
4500        //Print("\n//  ring tau = %s;", rString(currRing));
4501        rChangeCurrRing(oRing);
4502        G = idrMoveR(Gt, testring);
4503
4504        goto NEXT_VECTOR_FRACTAL;
4505#endif
4506
4507      FRACTAL_MSTDCC:
4508        //Print("\n//  apply BB-Alg in ring = %s;", rString(currRing));
4509        to=clock();
4510        G = MstdCC(Gt);
4511        xtextra=xtextra+clock()-to;
4512
4513        oRing = currRing;
4514
4515        // update the original target vector w.r.t. the current GB
4516        if(MivSame(Xivinput, Xivlp) == 1)
4517          if (currRing->parameter != NULL)
4518            DefRingParlp();
4519          else
4520            VMrDefaultlp();
4521        else
4522          if (currRing->parameter != NULL)
4523            DefRingPar(Xivinput);
4524          else
4525            VMrDefault(Xivinput);
4526
4527        testring = currRing;
4528        Gt = idrMoveR(G, oRing);
4529
4530        delete Xtau;
4531        Xtau = NewVectorlp(Gt);
4532
4533        rChangeCurrRing(oRing);
4534        G = idrMoveR(Gt, testring);
4535
4536        delete omega2;
4537        delete next_vect;
4538        delete altomega;
4539        /*
4540          Print("\n// Leaving the %d-th recursion with %d steps,", nlev,nwalks);
4541          Print(" ** Overflow_Error? (%d)", Overflow_Error);
4542        */
4543        if(Overflow_Error == TRUE)
4544          nnflow ++;
4545
4546        Overflow_Error = FALSE;
4547        return(G);
4548      }
4549    }
4550
4551    for(i=nV-1; i>=0; i--) {
4552      (*altomega)[i] = (*omega)[i];
4553      (*omega)[i] = (*next_vect)[i];
4554    }
4555    delete next_vect;
4556
4557    to=clock();
4558    /* Take the initial form of <G> w.r.t. omega */
4559    Gomega = MwalkInitialForm(G, omega);
4560    xtif=xtif+clock()-to;
4561
4562#ifndef  BUCHBERGER_ALG
4563    if(isNolVector(omega) == 0)
4564      hilb_func = hFirstSeries(Gomega,NULL,NULL,omega,currRing);
4565    else
4566      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
4567#endif // BUCHBERGER_ALG
4568
4569    if (currRing->parameter != NULL)
4570      DefRingPar(omega);
4571    else
4572      VMrDefault(omega);
4573
4574    Gomega1 = idrMoveR(Gomega, oRing);
4575
4576    /* Maximal recursion depth, to compute a red. GB */
4577    /* Fractal walk with the alternative recursion */
4578    /* alternative recursion */
4579    // if(nlev == nV || lengthpoly(Gomega1) == 0)
4580    if(nlev == Xnlev || lengthpoly(Gomega1) == 0)
4581      //if(nlev == nV) // blind recursion
4582    {
4583      /*
4584      if(Xnlev != nV)
4585      {
4586        Print("\n// ** Xnlev = %d", Xnlev);
4587        ivString(Xtau, "Xtau");
4588      }
4589      */
4590      to=clock();
4591#ifdef  BUCHBERGER_ALG
4592      Gresult = MstdhomCC(Gomega1);
4593#else
4594      Gresult =kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,omega);
4595      delete hilb_func;
4596#endif // BUCHBERGER_ALG
4597      xtstd=xtstd+clock()-to;
4598    }
4599    else {
4600      rChangeCurrRing(oRing);
4601      Gomega1 = idrMoveR(Gomega1, oRing);
4602      Gresult = rec_fractal_call(idCopy(Gomega1),nlev+1,omega);
4603    }
4604
4605    //convert a Groebner basis from a ring to another ring,
4606    new_ring = currRing;
4607
4608    rChangeCurrRing(oRing);
4609    Gresult1 = idrMoveR(Gresult, new_ring);
4610    Gomega2 = idrMoveR(Gomega1, new_ring);
4611
4612    to=clock();
4613    /* Lifting process */
4614    F = MLifttwoIdeal(Gomega2, Gresult1, G);
4615    xtlift=xtlift+clock()-to;
4616    idDelete(&Gresult1);
4617    idDelete(&Gomega2);
4618    idDelete(&G);
4619
4620    rChangeCurrRing(new_ring);
4621    F1 = idrMoveR(F, oRing);
4622
4623    to=clock();
4624    /* Interreduce G */
4625    G = kInterRedCC(F1, NULL);
4626    xtred=xtred+clock()-to;
4627    idDelete(&F1);
4628  }
4629}
4630
4631ideal Mfwalk(ideal G, intvec* ivstart, intvec* ivtarget)
4632{
4633  Set_Error(FALSE);
4634  Overflow_Error = FALSE;
4635  //Print("// pSetm_Error = (%d)", ErrorCheck());
4636  //Print("\n// ring ro = %s;", rString(currRing));
4637
4638  nnflow = 0;
4639  Xngleich = 0;
4640  Xcall = 0;
4641  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0; xtextra=0;
4642  xftinput = clock();
4643
4644  ring  oldRing = currRing;
4645  int i, nV = currRing->N;
4646  XivNull = new intvec(nV);
4647  Xivinput = ivtarget;
4648  ngleich = 0;
4649  to=clock();
4650  ideal I = MstdCC(G);
4651  G = NULL;
4652  xftostd=clock()-to;
4653  Xsigma = ivstart;
4654
4655  Xnlev=nV;
4656
4657#ifdef FIRST_STEP_FRACTAL
4658  ideal Gw = MwalkInitialForm(I, ivstart);
4659  for(i=IDELEMS(Gw)-1; i>=0; i--)
4660  {
4661    if((Gw->m[i]!=NULL) /* len >=0 */
4662    && (Gw->m[i]->next!=NULL) /* len >=1 */
4663    && (Gw->m[i]->next->next!=NULL)) /* len >=2 */
4664    {
4665      intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
4666      intvec* Mdp;
4667
4668      if(MivSame(ivstart, iv_dp) != 1)
4669        Mdp = MivWeightOrderdp(ivstart);
4670      else
4671        Mdp = MivMatrixOrderdp(nV);
4672
4673      Xsigma = Mfpertvector(I, Mdp);
4674      Overflow_Error = FALSE;
4675
4676      delete Mdp;
4677      delete iv_dp;
4678      break;
4679    }
4680  }
4681  idDelete(&Gw);
4682#endif
4683
4684  ideal I1;
4685  intvec* Mlp;
4686  Xivlp = Mivlp(nV);
4687
4688  if(MivComp(ivtarget, Xivlp)  != 1)
4689  {
4690    if (currRing->parameter != NULL)
4691      DefRingPar(ivtarget);
4692    else
4693      VMrDefault(ivtarget);
4694
4695    I1 = idrMoveR(I, oldRing);
4696    Mlp = MivWeightOrderlp(ivtarget);
4697    Xtau = Mfpertvector(I1, Mlp);
4698  }
4699  else
4700  {
4701    if (currRing->parameter != NULL)
4702      DefRingParlp();
4703    else
4704      VMrDefaultlp();
4705
4706    I1 = idrMoveR(I, oldRing);
4707    Mlp =  MivMatrixOrderlp(nV);
4708    Xtau = Mfpertvector(I1, Mlp);
4709  }
4710  delete Mlp;
4711  Overflow_Error = FALSE;
4712
4713  //ivString(Xsigma, "Xsigma");
4714  //ivString(Xtau, "Xtau");
4715
4716  id_Delete(&I, oldRing);
4717  ring tRing = currRing;
4718
4719  if (currRing->parameter != NULL)
4720    DefRingPar(ivstart);
4721  else
4722    VMrDefault(ivstart);
4723
4724  I = idrMoveR(I1,tRing);
4725  to=clock();
4726  ideal J = MstdCC(I);
4727  idDelete(&I);
4728  xftostd=xftostd+clock()-to;
4729
4730  ideal resF;
4731  ring helpRing = currRing;
4732
4733  J = rec_fractal_call(J, 1, ivtarget);
4734
4735  rChangeCurrRing(oldRing);
4736  resF = idrMoveR(J, helpRing);
4737  idSkipZeroes(resF);
4738
4739  delete Xivlp;
4740  delete Xsigma;
4741  delete Xtau;
4742  delete XivNull;
4743
4744#ifdef TIME_TEST
4745  TimeStringFractal(xftinput, xftostd, xtif, xtstd, xtextra,
4746                    xtlift, xtred, xtnw);
4747
4748
4749  Print("\n// pSetm_Error = (%d)", ErrorCheck());
4750  Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
4751  Print("\n// the numbers of Overflow_Error (%d)", nnflow);
4752#endif
4753
4754  return(resF);
4755}
4756
4757/* Tran algorithm */
4758/* use kStd, if nP = 0, else call Ab_Rec_Pert (LastGB) */
4759ideal TranMImprovwalk(ideal G,intvec* curr_weight,intvec* target_tmp, int nP)
4760{
4761  clock_t mtim = clock();
4762  Set_Error(FALSE  );
4763  Overflow_Error =  FALSE;
4764  //Print("// pSetm_Error = (%d)", ErrorCheck());
4765  //Print("\n// ring ro = %s;", rString(currRing));
4766
4767  clock_t tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0, textra=0;
4768  clock_t tinput = clock();
4769
4770  int nsteppert=0, i, nV = currRing->N, nwalk=0, npert_tmp=0;
4771  int *npert=(int*)omAlloc(2*nV*sizeof(int));
4772  ideal Gomega, M,F,  G1, Gomega1, Gomega2, M1, F1;
4773  ring endRing, newRing, oldRing, lpRing;
4774  intvec* next_weight;
4775  intvec* ivNull = new intvec(nV); //define (0,...,0)
4776  intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
4777  intvec* iv_lp = Mivlp(nV); //define (1,0,...,0)
4778  ideal H0, H1, H2, Glp;
4779  int nGB, endwalks = 0,  nwalkpert=0,  npertstep=0;
4780  intvec* Mlp =  MivMatrixOrderlp(nV);
4781  intvec* vector_tmp = new intvec(nV);
4782  intvec* hilb_func;
4783
4784  /* to avoid (1,0,...,0) as the target vector */
4785  intvec* last_omega = new intvec(nV);
4786  for(i=nV-1; i>0; i--)
4787    (*last_omega)[i] = 1;
4788  (*last_omega)[0] = 10000;
4789
4790  //  intvec* extra_curr_weight = new intvec(nV);
4791  intvec* target_weight = new intvec(nV);
4792  for(i=nV-1; i>=0; i--)
4793    (*target_weight)[i] = (*target_tmp)[i];
4794
4795  ring XXRing = currRing;
4796  newRing = currRing;
4797
4798  to=clock();
4799  /* compute a red. GB w.r.t. the help ring */
4800  if(MivComp(curr_weight, iv_dp) == 1) //rOrdStr(currRing) = "dp"
4801    G = MstdCC(G);
4802  else
4803  {
4804    //rOrdStr(currRing) = (a(.c_w..),lp,C)
4805    if (currRing->parameter != NULL)
4806      DefRingPar(curr_weight);
4807    else
4808      VMrDefault(curr_weight);
4809    G = idrMoveR(G, XXRing);
4810    G = MstdCC(G);
4811  }
4812  tostd=clock()-to;
4813
4814#ifdef REPRESENTATION_OF_SIGMA
4815  ideal Gw = MwalkInitialForm(G, curr_weight);
4816
4817  if(islengthpoly2(Gw)==1)
4818  {
4819    intvec* MDp;
4820    if(MivComp(curr_weight, iv_dp) == 1)
4821      MDp = MatrixOrderdp(nV); //MivWeightOrderlp(iv_dp);
4822    else
4823      MDp = MivWeightOrderlp(curr_weight);
4824
4825    curr_weight = RepresentationMatrix_Dp(G, MDp);
4826
4827    delete MDp;
4828
4829    ring exring = currRing;
4830
4831    if (currRing->parameter != NULL)
4832      DefRingPar(curr_weight);
4833    else
4834      VMrDefault(curr_weight);
4835    to=clock();
4836    Gw = idrMoveR(G, exring);
4837    G = MstdCC(Gw);
4838    Gw = NULL;
4839    tostd=tostd+clock()-to;
4840    //ivString(curr_weight,"rep. sigma");
4841    goto COMPUTE_NEW_VECTOR;
4842  }
4843
4844  idDelete(&Gw);
4845  delete iv_dp;
4846#endif
4847
4848
4849  while(1)
4850  {
4851    to=clock();
4852    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
4853    Gomega = MwalkInitialForm(G, curr_weight);
4854    tif=tif+clock()-to;
4855
4856#ifndef  BUCHBERGER_ALG
4857    if(isNolVector(curr_weight) == 0)
4858      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
4859    else
4860      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
4861#endif // BUCHBERGER_ALG
4862
4863    oldRing = currRing;
4864
4865    /* define a new ring that its ordering is "(a(curr_weight),lp) */
4866    if (currRing->parameter != NULL)
4867      DefRingPar(curr_weight);
4868    else
4869      VMrDefault(curr_weight);
4870
4871    newRing = currRing;
4872    Gomega1 = idrMoveR(Gomega, oldRing);
4873
4874    to=clock();
4875    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
4876#ifdef  BUCHBERGER_ALG
4877    M = MstdhomCC(Gomega1);
4878#else
4879    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
4880    delete hilb_func;
4881#endif // BUCHBERGER_ALG
4882    tstd=tstd+clock()-to;
4883
4884    /* change the ring to oldRing */
4885    rChangeCurrRing(oldRing);
4886    M1 =  idrMoveR(M, newRing);
4887    Gomega2 =  idrMoveR(Gomega1, newRing);
4888
4889    to=clock();
4890    /* compute a representation of the generators of submod (M)
4891       with respect to those of mod (Gomega).
4892       Gomega is a reduced Groebner basis w.r.t. the current ring */
4893    F = MLifttwoIdeal(Gomega2, M1, G);
4894    tlift=tlift+clock()-to;
4895
4896    idDelete(&M1);
4897    idDelete(&Gomega2);
4898    idDelete(&G);
4899
4900    /* change the ring to newRing */
4901    rChangeCurrRing(newRing);
4902    F1 = idrMoveR(F, oldRing);
4903
4904    to=clock();
4905    /* reduce the Groebner basis <G> w.r.t. new ring */
4906    G = kInterRedCC(F1, NULL);
4907    tred=tred+clock()-to;
4908    idDelete(&F1);
4909
4910
4911  COMPUTE_NEW_VECTOR:
4912    newRing = currRing;
4913    nwalk++;
4914    nwalkpert++;
4915    to=clock();
4916    /* compute a next weight vector */
4917    next_weight = MwalkNextWeightCC(curr_weight,target_weight, G);
4918    tnw=tnw+clock()-to;
4919#ifdef PRINT_VECTORS
4920    MivString(curr_weight, target_weight, next_weight);
4921#endif
4922
4923
4924    /* check whether the computed intermediate weight vector in
4925       the correct cone is, since sometimes it is very big e.g. s7, cyc7.
4926       If it is NOT in the cone, then one has directly to compute
4927       a reduced Groebner basis with respect to the lexicographic ordering
4928       for the known Groebner basis that it is computed in the last step.
4929    */
4930    //if(test_w_in_ConeCC(G, next_weight) != 1)
4931    if(Overflow_Error == TRUE)
4932    {
4933    OMEGA_OVERFLOW_TRAN_NEW:
4934      //Print("\n//  takes %d steps!", nwalk-1);
4935      //Print("\n//ring lastRing = %s;", rString(currRing));
4936#ifdef TEST_OVERFLOW
4937      goto  BE_FINISH;
4938#endif
4939
4940#ifdef CHECK_IDEAL_MWALK
4941      idElements(G, "G");
4942      //headidString(G, "G");
4943#endif
4944
4945      if(MivSame(target_tmp, iv_lp) == 1)
4946        if (currRing->parameter != NULL)
4947          DefRingParlp();
4948        else
4949          VMrDefaultlp();
4950      else
4951        if (currRing->parameter != NULL)
4952          DefRingPar(target_tmp);
4953        else
4954          VMrDefault(target_tmp);
4955
4956      lpRing = currRing;
4957      G1 = idrMoveR(G, newRing);
4958
4959      to=clock();
4960      /*apply kStd or LastGB to compute  a lex. red. Groebner basis of <G>*/
4961      if(nP == 0 || MivSame(target_tmp, iv_lp) == 0){
4962        //Print("\n\n// calls \"std in ring r_%d = %s;", nwalk, rString(currRing));
4963        G = MstdCC(G1);//no result for qnt1
4964      }
4965      else {
4966        rChangeCurrRing(newRing);
4967        G1 = idrMoveR(G1, lpRing);
4968
4969        //Print("\n\n// calls \"LastGB\" (%d) to compute a GB", nV-1);
4970        G = LastGB(G1, curr_weight, nV-1); //no result for kats7
4971
4972        rChangeCurrRing(lpRing);
4973        G = idrMoveR(G, newRing);
4974      }
4975      textra=clock()-to;
4976      npert[endwalks]=nwalk-npert_tmp;
4977      npert_tmp = nwalk;
4978      endwalks ++;
4979      break;
4980    }
4981
4982    /* check whether the computed Groebner basis a really Groebner basis is.
4983       if no, we perturb the target vector with the maximal "perturbation"
4984       degree.*/
4985    if(MivComp(next_weight, target_weight) == 1 ||
4986       MivComp(next_weight, curr_weight) == 1 )
4987    {
4988      //Print("\n//ring r_%d = %s;", nwalk, rString(currRing));
4989
4990
4991      //compute the number of perturbations and its step
4992      npert[endwalks]=nwalk-npert_tmp;
4993      npert_tmp = nwalk;
4994
4995      endwalks ++;
4996
4997      /*it is very important if the walk only uses one step, e.g. Fate, liu*/
4998      if(endwalks == 1 && MivComp(next_weight, curr_weight) == 1){
4999        rChangeCurrRing(XXRing);
5000        G = idrMoveR(G, newRing);
5001        goto FINISH;
5002      }
5003      H0 = idHead(G);
5004
5005      if(MivSame(target_tmp, iv_lp) == 1)
5006        if (currRing->parameter != NULL)
5007          DefRingParlp();
5008        else
5009          VMrDefaultlp();
5010      else
5011        if (currRing->parameter != NULL)
5012          DefRingPar(target_tmp);
5013        else
5014          VMrDefault(target_tmp);
5015
5016      lpRing = currRing;
5017      Glp = idrMoveR(G, newRing);
5018      H2 = idrMoveR(H0, newRing);
5019
5020      /* Apply Lemma 2.2 in Collart et. al (1997) to check whether
5021         cone(k-1) is equal to cone(k) */
5022      nGB = 1;
5023      for(i=IDELEMS(Glp)-1; i>=0; i--)
5024      {
5025        poly t;
5026        if((t=pSub(pHead(Glp->m[i]), pCopy(H2->m[i]))) != NULL)
5027        {
5028          pDelete(&t);
5029          idDelete(&H2);//5.5.02
5030          nGB = 0; //i.e. Glp is no reduced Groebner basis
5031          break;
5032        }
5033        pDelete(&t);
5034      }
5035
5036      idDelete(&H2);//5.5.02
5037
5038      if(nGB == 1)
5039      {
5040        G = Glp;
5041        Glp = NULL;
5042        break;
5043      }
5044
5045       /* perturb the target weight vector, if the vector target_tmp
5046          stays in many cones */
5047      poly p;
5048      BOOLEAN plength3 = FALSE;
5049      for(i=IDELEMS(Glp)-1; i>=0; i--)
5050      {
5051        p = MpolyInitialForm(Glp->m[i], target_tmp);
5052        if(p->next != NULL &&
5053           p->next->next != NULL &&
5054           p->next->next->next != NULL)
5055        {
5056          Overflow_Error = FALSE;
5057
5058          for(i=0; i<nV; i++)
5059            (*vector_tmp)[i] = (*target_weight)[i];
5060
5061          delete target_weight;
5062          target_weight = MPertVectors(Glp, Mlp, nV);
5063
5064          if(MivComp(vector_tmp, target_weight)==1)
5065          {
5066            //PrintS("\n// The old and new representaion vector are the same!!");
5067            G = Glp;
5068            newRing = currRing;
5069            goto OMEGA_OVERFLOW_TRAN_NEW;
5070           }
5071
5072          if(Overflow_Error == TRUE)
5073          {
5074            rChangeCurrRing(newRing);
5075            G = idrMoveR(Glp, lpRing);
5076            goto OMEGA_OVERFLOW_TRAN_NEW;
5077          }
5078
5079          plength3 = TRUE;
5080          pDelete(&p);
5081          break;
5082        }
5083        pDelete(&p);
5084      }
5085
5086      if(plength3 == FALSE)
5087      {
5088        rChangeCurrRing(newRing);
5089        G = idrMoveR(Glp, lpRing);
5090        goto TRAN_LIFTING;
5091      }
5092
5093
5094      npertstep = nwalk;
5095      nwalkpert = 1;
5096      nsteppert ++;
5097
5098      /*
5099      Print("\n// Subroutine needs (%d) steps.", nwalk);
5100      idElements(Glp, "last G in walk:");
5101      PrintS("\n//****************************************");
5102      Print("\n// Perturb the original target vector (%d): ", nsteppert);
5103      ivString(target_weight, "new target");
5104      PrintS("\n//****************************************\n");
5105      */
5106      rChangeCurrRing(newRing);
5107      G = idrMoveR(Glp, lpRing);
5108
5109      delete next_weight;
5110
5111      //Print("\n// ring rNEW = %s;", rString(currRing));
5112      goto COMPUTE_NEW_VECTOR;
5113    }
5114
5115  TRAN_LIFTING:
5116    for(i=nV-1; i>=0; i--)
5117      (*curr_weight)[i] = (*next_weight)[i];
5118
5119    delete next_weight;
5120  }//while
5121
5122 BE_FINISH:
5123  rChangeCurrRing(XXRing);
5124  G = idrMoveR(G, lpRing);
5125
5126 FINISH:
5127  delete ivNull;
5128  delete next_weight;
5129  delete iv_lp;
5130  omFree(npert);
5131
5132#ifdef TIME_TEST
5133  Print("\n// Computation took %d steps and %.2f sec",
5134        nwalk, ((double) (clock()-mtim)/1000000));
5135
5136  TimeStringFractal(tinput, tostd, tif, tstd, textra, tlift, tred, tnw);
5137
5138  Print("\n// pSetm_Error = (%d)", ErrorCheck());
5139  Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
5140#endif
5141
5142  return(G);
5143}
5144
5145
5146/* compute the reduced Gröbner basis of an ideal <Go> w.r.t. lp */
5147static ideal Mpwalk_MAltwalk1(ideal Go, intvec* curr_weight, int tp_deg)
5148{
5149  Overflow_Error = FALSE;
5150  BOOLEAN nOverflow_Error = FALSE;
5151  clock_t tproc=0;
5152  clock_t tinput=clock();
5153  int i, nV = currRing->N;
5154  int nwalk=0, endwalks=0, ntestwinC=1;
5155  int tp_deg_tmp = tp_deg;
5156  ideal Gomega, M, F, G, M1, F1, Gomega1, Gomega2, G1;
5157  ring endRing, newRing, oldRing, TargetRing;
5158  intvec* next_weight;
5159  intvec* ivNull = new intvec(nV);
5160  intvec* extra_curr_weight = new intvec(nV);
5161
5162  ring YXXRing = currRing;
5163
5164  intvec* iv_M_dpp = MivMatrixOrderlp(nV);
5165  intvec* target_weight;// = Mivlp(nV);
5166  ideal ssG;
5167
5168  /* perturb the target vector */
5169  while(1)
5170  {
5171    if(Overflow_Error == FALSE)
5172    {
5173      if (currRing->parameter != NULL)
5174        DefRingParlp();
5175      else
5176        VMrDefaultlp();
5177
5178      TargetRing = currRing;
5179      ssG = idrMoveR(Go,YXXRing);
5180    }
5181    Overflow_Error = FALSE;
5182    if(tp_deg != 1)
5183      target_weight = MPertVectors(ssG, iv_M_dpp, tp_deg);
5184    else
5185    {
5186      target_weight = Mivlp(nV);
5187      break;
5188    }
5189    if(Overflow_Error == FALSE)
5190      break;
5191
5192    Overflow_Error = TRUE;
5193    tp_deg --;
5194  }
5195  if(tp_deg != tp_deg_tmp)
5196  {
5197    Overflow_Error = TRUE;
5198    nOverflow_Error = TRUE;
5199  }
5200
5201  //  Print("\n// tp_deg = %d", tp_deg);
5202  // ivString(target_weight, "pert target");
5203
5204  delete iv_M_dpp;
5205  intvec* hilb_func;
5206
5207  /* to avoid (1,0,...,0) as the target vector */
5208  intvec* last_omega = new intvec(nV);
5209  for(i=nV-1; i>0; i--)
5210    (*last_omega)[i] = 1;
5211  (*last_omega)[0] = 10000;
5212
5213  rChangeCurrRing(YXXRing);
5214  G = idrMoveR(ssG, TargetRing);
5215
5216  while(1)
5217  {
5218    nwalk ++;
5219    nstep ++;
5220
5221    if(nwalk==1)
5222      goto FIRST_STEP;
5223
5224    to=clock();
5225    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
5226    Gomega = MwalkInitialForm(G, curr_weight);
5227    xtif=xtif+clock()-to;
5228#if 0
5229    if(Overflow_Error == TRUE)
5230    {
5231      for(i=nV-1; i>=0; i--)
5232        (*curr_weight)[i] = (*extra_curr_weight)[i];
5233      delete extra_curr_weight;
5234      goto LASTGB_ALT1;
5235    }
5236#endif
5237#ifndef  BUCHBERGER_ALG
5238    if(isNolVector(curr_weight) == 0)
5239      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
5240    else
5241      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
5242#endif // BUCHBERGER_ALG
5243
5244    oldRing = currRing;
5245
5246    /* define a new ring that its ordering is "(a(curr_weight),lp) */
5247    if (currRing->parameter != NULL)
5248      DefRingPar(curr_weight);
5249    else
5250      VMrDefault(curr_weight);
5251
5252    newRing = currRing;
5253    Gomega1 = idrMoveR(Gomega, oldRing);
5254
5255#ifdef ENDWALKS
5256    if(endwalks == 1)
5257    {
5258      Print("\n//  it is  %d-th step!!", nwalk);
5259      idElements(Gomega1, "Gw");
5260      PrintS("\n//  compute a rGB of Gw:");
5261    }
5262#endif
5263
5264    to=clock();
5265    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
5266#ifdef  BUCHBERGER_ALG
5267    M = MstdhomCC(Gomega1);
5268#else
5269    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
5270    delete hilb_func;
5271#endif // BUCHBERGER_ALG
5272    xtstd=xtstd+clock()-to;
5273
5274    /* change the ring to oldRing */
5275    rChangeCurrRing(oldRing);
5276    M1 =  idrMoveR(M, newRing);
5277    Gomega2 =  idrMoveR(Gomega1, newRing);
5278    to=clock();
5279
5280    // if(endwalks == 1) PrintS("\n//  Lifting is still working:");
5281
5282    /* compute a reduced Groebner basis of <G> w.r.t. "newRing" by the
5283     lifting process */
5284    F = MLifttwoIdeal(Gomega2, M1, G);
5285    xtlift=xtlift+clock()-to;
5286
5287    idDelete(&M1);
5288    idDelete(&Gomega2);
5289    idDelete(&G);
5290
5291    /* change the ring to newRing */
5292    rChangeCurrRing(newRing);
5293    F1 = idrMoveR(F, oldRing);
5294    to=clock();
5295    //if(endwalks == 1) PrintS("\n//  InterRed is still working:");
5296    /* reduce the Groebner basis <G> w.r.t. the new ring */
5297    G = kInterRedCC(F1, NULL);
5298    xtred=xtred+clock()-to;
5299    idDelete(&F1);
5300
5301    if(endwalks == 1)
5302      break;
5303
5304  FIRST_STEP:
5305    Overflow_Error=FALSE;
5306    to=clock();
5307    /* compute a next weight vector */
5308    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
5309    xtnw=xtnw+clock()-to;
5310#ifdef PRINT_VECTORS
5311    MivString(curr_weight, target_weight, next_weight);
5312#endif
5313
5314    if(Overflow_Error == TRUE)
5315    {
5316      delete next_weight;
5317
5318      LASTGB_ALT1:
5319      if(tp_deg > 1){
5320        nOverflow_Error = Overflow_Error;
5321        tproc = tproc+clock()-tinput;
5322        /*
5323          Print("\n// A subroutine takes %d steps and calls \"Mpwalk\" (1,%d):",
5324          nwalk, tp_deg-1);
5325        */
5326        G1 = Mpwalk_MAltwalk1(G, curr_weight, tp_deg-1);
5327        goto MPW_Finish;
5328      }
5329      else {
5330        newRing = currRing;
5331        ntestwinC = 0;
5332        break;
5333      }
5334    }
5335
5336    if(MivComp(next_weight, ivNull) == 1)
5337    {
5338      newRing = currRing;
5339      delete next_weight;
5340      break;
5341    }
5342    if(MivComp(next_weight, target_weight) == 1)
5343      endwalks = 1;
5344
5345    for(i=nV-1; i>=0; i--)
5346    {
5347      //(*extra_curr_weight)[i] = (*curr_weight)[i];
5348      (*curr_weight)[i] = (*next_weight)[i];
5349    }
5350    delete next_weight;
5351  }//while
5352
5353  /* check wheather the pertubed target vector is correct */
5354
5355  //define and execute ring with lex. order
5356  if (currRing->parameter != NULL)
5357    DefRingParlp();
5358  else
5359    VMrDefaultlp();
5360
5361  G1 = idrMoveR(G, newRing);
5362
5363  if( test_w_in_ConeCC(G1, target_weight) != 1 || ntestwinC == 0)
5364  {
5365    PrintS("\n// The perturbed target vector doesn't STAY in the correct cone!!");
5366    if(tp_deg == 1){
5367      //Print("\n// subroutine takes %d steps and applys \"std\"", nwalk);
5368      to=clock();
5369      ideal G2 = MstdCC(G1);
5370      xtextra=xtextra+clock()-to;
5371      idDelete(&G1);
5372      G1 = G2;
5373      G2 = NULL;
5374    }
5375    else {
5376      nOverflow_Error = Overflow_Error;
5377      tproc = tproc+clock()-tinput;
5378      /*
5379        Print("\n// B subroutine takes %d steps and calls \"Mpwalk\" (1,%d) :",
5380            nwalk,  tp_deg-1);
5381      */
5382      G1 = Mpwalk_MAltwalk1(G1, curr_weight, tp_deg-1);
5383    }
5384  }
5385
5386 MPW_Finish:
5387  newRing = currRing;
5388  rChangeCurrRing(YXXRing);
5389  ideal result = idrMoveR(G1, newRing);
5390
5391  delete ivNull;
5392  delete target_weight;
5393
5394  /*
5395  Print("\n// \"Mpwalk\" (1,%d) took %d steps and %.2f sec. Overflow_Error (%d)", tp_deg,
5396        nwalk, ((double) clock()-tinput)/1000000, nOverflow_Error);
5397  */
5398
5399  return(result);
5400}
5401
5402/* August 2003 */
5403ideal MAltwalk1(ideal Go, int op_deg, int tp_deg, intvec* curr_weight,
5404                intvec* target_weight)
5405{
5406  Set_Error(FALSE  );
5407  Overflow_Error = FALSE;
5408  BOOLEAN nOverflow_Error = FALSE;
5409  // Print("// pSetm_Error = (%d)", ErrorCheck());
5410
5411  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0; xtextra=0;
5412  xftinput = clock();
5413  clock_t tostd, tproc;
5414
5415  nstep = 0;
5416  int i, nV = currRing->N;
5417  int nwalk=0, endwalks=0;
5418  int op_tmp = op_deg;
5419  ideal Gomega, M, F, G, G1, Gomega1, Gomega2, M1, F1;
5420  ring endRing, newRing, oldRing, TargetRing;
5421  intvec* next_weight;
5422  intvec* iv_M_dp;
5423  intvec* ivNull = new intvec(nV);
5424  intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
5425  intvec* exivlp = Mivlp(nV);
5426  intvec* extra_curr_weight = new intvec(nV);
5427  intvec* hilb_func;
5428
5429  intvec* cw_tmp = curr_weight;
5430
5431  /* to avoid (1,0,...,0) as the target vector */
5432  intvec* last_omega = new intvec(nV);
5433  for(i=nV-1; i>0; i--)
5434    (*last_omega)[i] = 1;
5435  (*last_omega)[0] = 10000;
5436
5437  ring XXRing = currRing;
5438
5439  to=clock();
5440  /* compute a pertubed weight vector of the original weight vector.
5441     The perturbation degree is recursive decrease until that vector
5442     stays inn the correct cone. */
5443  while(1)
5444  {
5445    if(Overflow_Error == FALSE)
5446    {
5447      if(MivComp(curr_weight, iv_dp) == 1) //rOrdStr(currRing) = "dp"
5448        if(op_tmp == op_deg) {
5449          G = MstdCC(Go);
5450          if(op_deg != 1)
5451            iv_M_dp = MivMatrixOrderdp(nV);
5452        }
5453    }
5454    else
5455    {
5456      if(op_tmp == op_deg) {
5457        //rOrdStr(currRing) = (a(...),lp,C)
5458        if (currRing->parameter != NULL)
5459          DefRingPar(cw_tmp);
5460        else
5461          VMrDefault(cw_tmp);
5462
5463        G = idrMoveR(Go, XXRing);
5464        G = MstdCC(G);
5465        if(op_deg != 1)
5466          iv_M_dp = MivMatrixOrder(cw_tmp);
5467      }
5468    }
5469    Overflow_Error = FALSE;
5470    if(op_deg != 1)
5471      curr_weight = MPertVectors(G, iv_M_dp, op_deg);
5472    else {
5473      curr_weight =  cw_tmp;
5474      break;
5475    }
5476    if(Overflow_Error == FALSE)
5477      break;
5478
5479    Overflow_Error = TRUE;
5480    op_deg --;
5481  }
5482  tostd=clock()-to;
5483
5484  if(op_tmp != 1 )
5485    delete iv_M_dp;
5486  delete iv_dp;
5487
5488  if(currRing->order[0] == ringorder_a)
5489    goto NEXT_VECTOR;
5490
5491  while(1)
5492  {
5493    nwalk ++;
5494    nstep ++;
5495
5496    to = clock();
5497    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
5498    Gomega = MwalkInitialForm(G, curr_weight);
5499    xtif=xtif+clock()-to;
5500#if 0
5501    if(Overflow_Error == TRUE)
5502    {
5503      for(i=nV-1; i>=0; i--)
5504        (*curr_weight)[i] = (*extra_curr_weight)[i];
5505      delete extra_curr_weight;
5506
5507      newRing = currRing;
5508      goto MSTD_ALT1;
5509    }
5510#endif
5511#ifndef  BUCHBERGER_ALG
5512    if(isNolVector(curr_weight) == 0)
5513      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
5514    else
5515      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
5516#endif // BUCHBERGER_ALG
5517
5518    oldRing = currRing;
5519
5520    /* define a new ring which ordering is "(a(curr_weight),lp) */
5521    if (currRing->parameter != NULL)
5522      DefRingPar(curr_weight);
5523    else
5524      VMrDefault(curr_weight);
5525
5526    newRing = currRing;
5527    Gomega1 = idrMoveR(Gomega, oldRing);
5528
5529    to=clock();
5530    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
5531#ifdef  BUCHBERGER_ALG
5532    M = MstdhomCC(Gomega1);
5533#else
5534    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
5535    delete hilb_func;
5536#endif // BUCHBERGER_ALG
5537    xtstd=xtstd+clock()-to;
5538
5539    /* change the ring to oldRing */
5540    rChangeCurrRing(oldRing);
5541    M1 =  idrMoveR(M, newRing);
5542    Gomega2 =  idrMoveR(Gomega1, newRing);
5543
5544    to=clock();
5545    /* compute a reduced Groebner basis of <G> w.r.t. "newRing" by the
5546     lifting process */
5547    F = MLifttwoIdeal(Gomega2, M1, G);
5548    xtlift=xtlift+clock()-to;
5549
5550    idDelete(&M1);
5551    idDelete(&Gomega2);
5552    idDelete(&G);
5553
5554   /* change the ring to newRing */
5555    rChangeCurrRing(newRing);
5556    F1 = idrMoveR(F, oldRing);
5557
5558    to=clock();
5559    /* reduce the Groebner basis <G> w.r.t. new ring */
5560    G = kInterRedCC(F1, NULL);
5561    xtred=xtred+clock()-to;
5562    idDelete(&F1);
5563
5564    if(endwalks == 1)
5565      break;
5566
5567  NEXT_VECTOR:
5568    to=clock();
5569    /* compute a next weight vector */
5570    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
5571    xtnw=xtnw+clock()-to;
5572#ifdef PRINT_VECTORS
5573    MivString(curr_weight, target_weight, next_weight);
5574#endif
5575
5576    if(Overflow_Error == TRUE)
5577    {
5578      newRing = currRing;
5579
5580      if (currRing->parameter != NULL)
5581        DefRingPar(target_weight);
5582      else
5583        VMrDefault(target_weight);
5584
5585      F1 = idrMoveR(G, newRing);
5586      G = MstdCC(F1);
5587      idDelete(&F1);
5588      newRing = currRing;
5589      break; //for while
5590    }
5591
5592
5593    /* G is the wanted Groebner basis if next_weight == curr_weight */
5594    if(MivComp(next_weight, ivNull) == 1)
5595    {
5596      newRing = currRing;
5597      delete next_weight;
5598      break; //for while
5599    }
5600
5601    if(MivComp(next_weight, target_weight) == 1)
5602    {
5603      if(tp_deg == 1 || MivSame(target_weight, exivlp) == 0)
5604        endwalks = 1;
5605      else
5606      {
5607        MSTD_ALT1:
5608        nOverflow_Error = Overflow_Error;
5609        tproc = clock()-xftinput;
5610        /*
5611        Print("\n//  main routine takes %d steps and calls \"Mpwalk\" (1,%d):",
5612              nwalk,  tp_deg);
5613        */
5614        // compute the red. GB of <G> w.r.t. the lex order by
5615        // the "recursive-modified" perturbation walk alg (1,tp_deg)
5616        G = Mpwalk_MAltwalk1(G, curr_weight, tp_deg);
5617        delete next_weight;
5618        break; // for while
5619      }
5620    }
5621
5622    /* 06.11.01 NOT Changed, to free memory*/
5623    for(i=nV-1; i>=0; i--)
5624    {
5625      //(*extra_curr_weight)[i] = (*curr_weight)[i];
5626      (*curr_weight)[i] = (*next_weight)[i];
5627    }
5628    delete next_weight;
5629  }//while
5630
5631  rChangeCurrRing(XXRing);
5632  ideal result = idrMoveR(G, newRing);
5633  id_Delete(&G, newRing);
5634
5635  delete ivNull;
5636  if(op_deg != 1 )
5637    delete curr_weight;
5638
5639  delete exivlp;
5640#ifdef TIME_TEST
5641
5642  Print("\n// \"Main procedure\"  took %d steps, %.2f sec. and Overflow_Error(%d)",
5643        nwalk, ((double) tproc)/1000000, nOverflow_Error);
5644
5645  TimeStringFractal(xftinput, tostd, xtif, xtstd,xtextra, xtlift, xtred, xtnw);
5646
5647  Print("\n// pSetm_Error = (%d)", ErrorCheck());
5648  Print("\n// Overflow_Error? (%d)", Overflow_Error);
5649  Print("\n// Awalk1 took %d steps.\n", nstep);
5650#endif
5651  return(result);
5652}
5653
Note: See TracBrowser for help on using the repository browser.