source: git/Singular/walk.cc @ a3f0fea

spielwiese
Last change on this file since a3f0fea was a3f0fea, checked in by Reimer Behrends <behrends@…>, 5 years ago
Modify variable declarions for pSingular.
  • Property mode set to 100644
File size: 238.3 KB
Line 
1/*****************************************
2*  Computer Algebra System SINGULAR      *
3*****************************************/
4/*
5* ABSTRACT: Implementation of the Groebner walk
6*/
7
8// define if the Buchberger alg should be used
9//   to compute a reduced GB of a omega-homogenoues ideal
10// default: we use the hilbert driven algorithm.
11#define BUCHBERGER_ALG  //we use the improved Buchberger alg.
12
13//#define UPPER_BOUND //for the original "Tran" algorithm
14//#define REPRESENTATION_OF_SIGMA //if one perturbs sigma in Tran
15
16//#define TEST_OVERFLOW
17
18#define CHECK_IDEAL_MWALK //to print intermediate results
19
20//#define NEXT_VECTORS_CC
21//#define PRINT_VECTORS //to print weight vectors
22
23#define INVEPS_SMALL_IN_FRACTAL  //to choose the small invers of epsilon
24#define INVEPS_SMALL_IN_MPERTVECTOR  //to choose the small invers of epsilon
25#define INVEPS_SMALL_IN_TRAN  //to choose the small invers of epsilon
26
27#define FIRST_STEP_FRACTAL // to define the first step of the fractal
28#define MSTDCC_FRACTAL // apply Buchberger alg to compute a red GB, if tau doesn't stay in the correct cone
29
30//#define TIME_TEST // print the used time of each subroutine
31//#define ENDWALKS //print the size of the last omega-homogenoues Groebner basis
32
33/* includes */
34
35#include "kernel/mod2.h"
36#include "misc/intvec.h"
37#include "Singular/cntrlc.h"
38#include "misc/options.h"
39#include "omalloc/omalloc.h"
40#include "Singular/ipshell.h"
41#include "Singular/ipconv.h"
42#include "coeffs/ffields.h"
43#include "coeffs/coeffs.h"
44#include "Singular/subexpr.h"
45#include "polys/templates/p_Procs.h"
46
47#include "polys/monomials/maps.h"
48
49/* include Hilbert-function */
50#include "kernel/combinatorics/stairc.h"
51
52/** kstd2.cc */
53#include "kernel/GBEngine/kutil.h"
54#include "kernel/GBEngine/khstd.h"
55
56#include "Singular/walk.h"
57#include "kernel/polys.h"
58#include "kernel/ideals.h"
59#include "Singular/ipid.h"
60#include "Singular/tok.h"
61#include "coeffs/numbers.h"
62#include "Singular/ipid.h"
63#include "polys/monomials/ring.h"
64#include "kernel/GBEngine/kstd1.h"
65#include "polys/matpol.h"
66#include "polys/weight.h"
67#include "misc/intvec.h"
68#include "kernel/GBEngine/syz.h"
69#include "Singular/lists.h"
70#include "polys/prCopy.h"
71#include "polys/monomials/ring.h"
72//#include "polys/ext_fields/longalg.h"
73#include "polys/clapsing.h"
74
75#include "coeffs/mpr_complex.h"
76
77#include <cmath>
78#include "misc/mylimits.h"
79
80VAR int nstep;
81
82extern BOOLEAN ErrorCheck();
83
84EXTERN_VAR BOOLEAN pSetm_error;
85
86void Set_Error( BOOLEAN f) { pSetm_error=f; }
87
88VAR BOOLEAN Overflow_Error =  FALSE;
89
90#ifdef TIME_TEST
91VAR clock_t xtif, xtstd, xtlift, xtred, xtnw;
92VAR clock_t xftostd, xtextra, xftinput, to;
93#endif
94
95/****************************
96 * utilities for TSet, LSet *
97 ****************************/
98inline static intset initec (int maxnr)
99{
100  return (intset)omAlloc(maxnr*sizeof(int));
101}
102
103inline static unsigned long* initsevS (int maxnr)
104{
105  return (unsigned long*)omAlloc0(maxnr*sizeof(unsigned long));
106}
107inline static int* initS_2_R (int maxnr)
108{
109  return (int*)omAlloc0(maxnr*sizeof(int));
110}
111
112/************************************
113 * construct the set s from F u {P} *
114 ************************************/
115// unused
116/*
117static void initSSpecialCC (ideal F, ideal Q, ideal P,kStrategy strat)
118{
119  int   i,pos;
120
121  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
122  else i=setmaxT;
123
124  strat->ecartS=initec(i);
125  strat->sevS=initsevS(i);
126  strat->S_2_R=initS_2_R(i);
127  strat->fromQ=NULL;
128  strat->Shdl=idInit(i,F->rank);
129  strat->S=strat->Shdl->m;
130
131  // - put polys into S -
132  if (Q!=NULL)
133  {
134    strat->fromQ=initec(i);
135    memset(strat->fromQ,0,i*sizeof(int));
136    for (i=0; i<IDELEMS(Q); i++)
137    {
138      if (Q->m[i]!=NULL)
139      {
140        LObject h;
141        h.p = pCopy(Q->m[i]);
142        //if (TEST_OPT_INTSTRATEGY)
143        //{
144        //  h.pCleardenom(); // also does a Content
145        //}
146        //else
147        //{
148        //  h.pNorm();
149        //}
150        strat->initEcart(&h);
151        if (rHasLocalOrMixedOrdering(currRing))
152        {
153          deleteHC(&h,strat);
154        }
155        if (h.p!=NULL)
156        {
157          if (strat->sl==-1)
158            pos =0;
159          else
160          {
161            pos = posInS(strat,strat->sl,h.p,h.ecart);
162          }
163          h.sev = pGetShortExpVector(h.p);
164          h.SetpFDeg();
165          strat->enterS(h,pos,strat, strat->tl+1);
166          enterT(h, strat);
167          strat->fromQ[pos]=1;
168        }
169      }
170    }
171  }
172  //- put polys into S -
173  for (i=0; i<IDELEMS(F); i++)
174  {
175    if (F->m[i]!=NULL)
176    {
177      LObject h;
178      h.p = pCopy(F->m[i]);
179      if (rHasGlobalOrdering(currRing))
180      {
181        //h.p=redtailBba(h.p,strat->sl,strat);
182        h.p=redtailBba(h.p,strat->sl,strat);
183      }
184      else
185      {
186        deleteHC(&h,strat);
187      }
188      strat->initEcart(&h);
189      if (h.p!=NULL)
190      {
191        if (strat->sl==-1)
192          pos =0;
193        else
194          pos = posInS(strat,strat->sl,h.p,h.ecart);
195        h.sev = pGetShortExpVector(h.p);
196        strat->enterS(h,pos,strat, strat->tl+1);
197        h.length = pLength(h.p);
198        h.SetpFDeg();
199        enterT(h,strat);
200      }
201    }
202  }
203#ifdef INITSSPECIAL
204  for (i=0; i<IDELEMS(P); i++)
205  {
206    if (P->m[i]!=NULL)
207    {
208      LObject h;
209      h.p=pCopy(P->m[i]);
210      strat->initEcart(&h);
211      h.length = pLength(h.p);
212      if (TEST_OPT_INTSTRATEGY)
213      {
214        h.pCleardenom();
215      }
216      else
217      {
218        h.pNorm();
219      }
220      if(strat->sl>=0)
221      {
222        if (rHasGlobalOrdering(currRing))
223        {
224          h.p=redBba(h.p,strat->sl,strat);
225          if (h.p!=NULL)
226            h.p=redtailBba(h.p,strat->sl,strat);
227        }
228        else
229        {
230          h.p=redMora(h.p,strat->sl,strat);
231          strat->initEcart(&h);
232        }
233        if(h.p!=NULL)
234        {
235          if (TEST_OPT_INTSTRATEGY)
236          {
237            h.pCleardenom();
238          }
239          else
240          {
241            h.is_normalized = 0;
242            h.pNorm();
243          }
244          h.sev = pGetShortExpVector(h.p);
245          h.SetpFDeg();
246          pos = posInS(strat->S,strat->sl,h.p,h.ecart);
247          enterpairsSpecial(h.p,strat->sl,h.ecart,pos,strat,strat->tl+1);
248          strat->enterS(h,pos,strat, strat->tl+1);
249          enterT(h,strat);
250        }
251      }
252      else
253      {
254        h.sev = pGetShortExpVector(h.p);
255        h.SetpFDeg();
256        strat->enterS(h,0,strat, strat->tl+1);
257        enterT(h,strat);
258      }
259    }
260  }
261#endif
262}
263*/
264
265/*****************
266 *interreduce F  *
267 *****************/
268static ideal kInterRedCC(ideal F, ideal Q)
269{
270  int j;
271  kStrategy strat = new skStrategy;
272/*
273  if (TEST_OPT_PROT)
274  {
275    writeTime("start InterRed:");
276    mflush();
277  }
278  strat->syzComp     = 0;
279*/
280  strat->kHEdgeFound = (currRing->ppNoether) != NULL;
281  strat->kNoether=pCopy((currRing->ppNoether));
282  strat->ak = id_RankFreeModule(F, currRing);
283  initBuchMoraCrit(strat);
284  strat->NotUsedAxis = (BOOLEAN *)omAlloc((currRing->N+1)*sizeof(BOOLEAN));
285  for(j=currRing->N; j>0; j--)
286  {
287    strat->NotUsedAxis[j] = TRUE;
288  }
289  strat->enterS      = enterSBba;
290  strat->posInT      = posInT0;
291  strat->initEcart   = initEcartNormal;
292  strat->sl   = -1;
293  strat->tl          = -1;
294  strat->tmax        = setmaxT;
295  strat->T           = initT();
296  strat->R           = initR();
297  strat->sevT        = initsevT();
298  if(rHasLocalOrMixedOrdering(currRing))
299  {
300    strat->honey = TRUE;
301  }
302
303  //initSCC(F,Q,strat);
304  initS(F,Q,strat);
305
306  /*
307  timetmp=clock();//22.01.02
308  initSSpecialCC(F,Q,NULL,strat);
309  tininitS=tininitS+clock()-timetmp;//22.01.02
310  */
311  if(TEST_OPT_REDSB)
312  {
313    strat->noTailReduction=FALSE;
314  }
315  updateS(TRUE,strat);
316
317  if(TEST_OPT_REDSB && TEST_OPT_INTSTRATEGY)
318  {
319    completeReduce(strat);
320  }
321  if(strat->kHEdge!=NULL) pLmFree(&strat->kHEdge);
322  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
323  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
324  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
325  omFreeSize((ADDRESS)strat->NotUsedAxis,(currRing->N+1)*sizeof(BOOLEAN));
326  omfree(strat->sevT);
327  omfree(strat->S_2_R);
328  omfree(strat->R);
329
330  if(strat->fromQ)
331  {
332    for(j=0; j<IDELEMS(strat->Shdl); j++)
333    {
334      if(strat->fromQ[j])
335      {
336        pDelete(&strat->Shdl->m[j]);
337      }
338    }
339    omFreeSize((ADDRESS)strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
340    strat->fromQ = NULL;
341  }
342/*
343  if (TEST_OPT_PROT)
344  {
345    writeTime("end Interred:");
346    mflush();
347  }
348*/
349  ideal shdl=strat->Shdl;
350  idSkipZeroes(shdl);
351  delete(strat);
352
353  return shdl;
354}
355
356#ifdef TIME_TEST
357static void TimeString(clock_t tinput, clock_t tostd, clock_t tif,clock_t tstd,
358                       clock_t tlf,clock_t tred, clock_t tnw, int step)
359{
360  double totm = ((double) (clock() - tinput))/1000000;
361  double ostd,mostd, mif, mstd, mlf, mred, mnw, mxif,mxstd,mxlf,mxred,mxnw,tot;
362  // double mextra
363  Print("\n// total time = %.2f sec", totm);
364  Print("\n// tostd = %.2f sec = %.2f", ostd=((double) tostd)/1000000,
365        mostd=((((double) tostd)/1000000)/totm)*100);
366  Print("\n// tif   = %.2f sec = %.2f", ((double) tif)/1000000,
367        mif=((((double) tif)/1000000)/totm)*100);
368  Print("\n// std   = %.2f sec = %.2f", ((double) tstd)/1000000,
369        mstd=((((double) tstd)/1000000)/totm)*100);
370  Print("\n// lift  = %.2f sec = %.2f", ((double) tlf)/1000000,
371        mlf=((((double) tlf)/1000000)/totm)*100);
372  Print("\n// ired  = %.2f sec = %.2f", ((double) tred)/1000000,
373        mred=((((double) tred)/1000000)/totm)*100);
374  Print("\n// nextw = %.2f sec = %.2f", ((double) tnw)/1000000,
375        mnw=((((double) tnw)/1000000)/totm)*100);
376  PrintS("\n Time for the last step:");
377  Print("\n// xinfo = %.2f sec = %.2f", ((double) xtif)/1000000,
378        mxif=((((double) xtif)/1000000)/totm)*100);
379  Print("\n// xstd  = %.2f sec = %.2f", ((double) xtstd)/1000000,
380        mxstd=((((double) xtstd)/1000000)/totm)*100);
381  Print("\n// xlift = %.2f sec = %.2f", ((double) xtlift)/1000000,
382        mxlf=((((double) xtlift)/1000000)/totm)*100);
383  Print("\n// xired = %.2f sec = %.2f", ((double) xtred)/1000000,
384        mxred=((((double) xtred)/1000000)/totm)*100);
385  Print("\n// xnextw= %.2f sec = %.2f", ((double) xtnw)/1000000,
386        mxnw=((((double) xtnw)/1000000)/totm)*100);
387
388  tot=mostd+mif+mstd+mlf+mred+mnw+mxif+mxstd+mxlf+mxred+mxnw;
389  double res = (double) 100 - tot;
390  Print("\n// &%d&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f(%.2f)\\ \\",
391        step, ostd, totm, mostd,mif,mstd,mlf,mred,mnw,mxif,mxstd,mxlf,mxred,mxnw,tot,res,
392        ((((double) xtextra)/1000000)/totm)*100);
393}
394
395static void TimeStringFractal(clock_t tinput, clock_t tostd, clock_t tif,clock_t tstd,
396                       clock_t textra, clock_t tlf,clock_t tred, clock_t tnw)
397{
398
399  double totm = ((double) (clock() - tinput))/1000000;
400  double ostd, mostd, mif, mstd, mextra, mlf, mred, mnw, tot, res;
401  Print("\n// total time = %.2f sec", totm);
402  Print("\n// tostd = %.2f sec = %.2f", ostd=((double) tostd)/1000000,
403        mostd=((((double) tostd)/1000000)/totm)*100);
404  Print("\n// tif   = %.2f sec = %.2f", ((double) tif)/1000000,
405        mif=((((double) tif)/1000000)/totm)*100);
406  Print("\n// std   = %.2f sec = %.2f", ((double) tstd)/1000000,
407        mstd=((((double) tstd)/1000000)/totm)*100);
408  Print("\n// xstd  = %.2f sec = %.2f", ((double) textra)/1000000,
409        mextra=((((double) textra)/1000000)/totm)*100);
410  Print("\n// lift  = %.2f sec = %.2f", ((double) tlf)/1000000,
411        mlf=((((double) tlf)/1000000)/totm)*100);
412  Print("\n// ired  = %.2f sec = %.2f", ((double) tred)/1000000,
413        mred=((((double) tred)/1000000)/totm)*100);
414  Print("\n// nextw = %.2f sec = %.2f", ((double) tnw)/1000000,
415        mnw=((((double) tnw)/1000000)/totm)*100);
416  tot = mostd+mif+mstd+mextra+mlf+mred+mnw;
417  res = (double) 100.00-tot;
418  Print("\n// &%.2f &%.2f&%.2f &%.2f &%.2f &%.2f &%.2f &%.2f &%.2f&%.2f&%.2f\\ \\ ",
419        ostd,totm,mostd,mif,mstd,mextra,mlf,mred,mnw,tot,res);
420}
421#endif
422
423#ifdef CHECK_IDEAL_MWALK
424static void idString(ideal L, const char* st)
425{
426  int i, nL = IDELEMS(L);
427
428  Print("\n//  ideal %s =  ", st);
429  for(i=0; i<nL-1; i++)
430  {
431    Print(" %s, ", pString(L->m[i]));
432  }
433  Print(" %s;", pString(L->m[nL-1]));
434}
435#endif
436/*
437#if defined(CHECK_IDEAL_MWALK) || defined(ENDWALKS)
438static void headidString(ideal L, char* st)
439{
440  int i, nL = IDELEMS(L);
441
442  Print("\n//  ideal %s =  ", st);
443  for(i=0; i<nL-1; i++)
444  {
445    Print(" %s, ", pString(pHead(L->m[i])));
446  }
447  Print(" %s;", pString(pHead(L->m[nL-1])));
448}
449#endif
450
451#if defined(CHECK_IDEAL_MWALK) || defined(ENDWALKS)
452static void idElements(ideal L, char* st)
453{
454  int i, nL = IDELEMS(L);
455  int *K=(int *)omAlloc(nL*sizeof(int));
456
457  Print("\n//  #monoms of %s =  ", st);
458  for(i=0; i<nL; i++)
459  {
460    K[i] = pLength(L->m[i]);
461  }
462  int j, nsame;
463  // int  nk=0;
464  for(i=0; i<nL; i++)
465  {
466    if(K[i]!=0)
467    {
468      nsame = 1;
469      for(j=i+1; j<nL; j++)
470      {
471        if(K[j]==K[i])
472        {
473          nsame ++;
474          K[j]=0;
475        }
476      }
477      if(nsame == 1)
478      {
479        Print("%d, ",K[i]);
480      }
481      else
482      {
483        Print("%d[%d], ", K[i], nsame);
484      }
485    }
486  }
487  omFree(K);
488}
489#endif
490*/
491
492static void ivString(intvec* iv, const char* ch)
493{
494  int nV = iv->length()-1;
495  Print("\n// intvec %s =  ", ch);
496
497  for(int i=0; i<nV; i++)
498  {
499    Print("%d, ", (*iv)[i]);
500  }
501  Print("%d;", (*iv)[nV]);
502}
503
504#ifdef PRINT_VECTORS
505static void MivString(intvec* iva, intvec* ivb, intvec* ivc)
506{
507  int nV = iva->length()-1;
508  int i;
509  PrintS("\n//  (");
510  for(i=0; i<nV; i++)
511  {
512    Print("%d, ", (*iva)[i]);
513  }
514  Print("%d) ==> (", (*iva)[nV]);
515  for(i=0; i<nV; i++)
516  {
517    Print("%d, ", (*ivb)[i]);
518  }
519  Print("%d) := (", (*ivb)[nV]);
520
521  for(i=0; i<nV; i++)
522  {
523    Print("%d, ", (*ivc)[i]);
524  }
525  Print("%d)", (*ivc)[nV]);
526}
527#endif
528
529/********************************************************************
530 * returns gcd of integers a and b                                  *
531 ********************************************************************/
532static inline long gcd(const long a, const long b)
533{
534  long r, p0 = a, p1 = b;
535  //assume(p0 >= 0 && p1 >= 0);
536  if(p0 < 0)
537  {
538    p0 = -p0;
539  }
540  if(p1 < 0)
541  {
542    p1 = -p1;
543  }
544  while(p1 != 0)
545  {
546    r = p0 % p1;
547    p0 = p1;
548    p1 = r;
549  }
550  return p0;
551}
552
553/*****************************************************************************
554 * compute the gcd of the entries of the vectors curr_weight and diff_weight *
555 *****************************************************************************/
556/* unused:
557static int simplify_gcd(intvec* curr_weight, intvec* diff_weight)
558{
559  int j;
560  int nRing = currRing->N;
561  int gcd_tmp = (*curr_weight)[0];
562  for (j=1; j<nRing; j++)
563  {
564    gcd_tmp = gcd(gcd_tmp, (*curr_weight)[j]);
565    if(gcd_tmp == 1)
566    {
567      break;
568    }
569  }
570  if(gcd_tmp != 1)
571  {
572    for (j=0; j<nRing; j++)
573    {
574    gcd_tmp = gcd(gcd_tmp, (*diff_weight)[j]);
575    if(gcd_tmp == 1)
576      {
577        break;
578      }
579    }
580  }
581  return gcd_tmp;
582}
583*/
584
585/*********************************************
586 * cancel gcd of integers zaehler and nenner *
587 *********************************************/
588static void cancel(mpz_t zaehler, mpz_t nenner)
589{
590//  assume(zaehler >= 0 && nenner > 0);
591  mpz_t g;
592  mpz_init(g);
593  mpz_gcd(g, zaehler, nenner);
594
595  mpz_div(zaehler , zaehler, g);
596  mpz_div(nenner ,  nenner, g);
597
598  mpz_clear(g);
599}
600
601//unused
602#if 0
603static int isVectorNeg(intvec* omega)
604{
605  int i;
606
607  for(i=omega->length(); i>=0; i--)
608  {
609    if((*omega)[i]<0)
610    {
611      return 1;
612    }
613  }
614  return 0;
615}
616#endif
617
618/********************************************************************
619 * compute a weight degree of a monomial p w.r.t. a weight_vector   *
620 ********************************************************************/
621static inline int MLmWeightedDegree(const poly p, intvec* weight)
622{
623  /* 2147483647 is max. integer representation in SINGULAR */
624  mpz_t sing_int;
625  mpz_init_set_ui(sing_int,  2147483647);
626
627  int i, wgrad;
628
629  mpz_t zmul;
630  mpz_init(zmul);
631  mpz_t zvec;
632  mpz_init(zvec);
633  mpz_t zsum;
634  mpz_init(zsum);
635
636  for (i=currRing->N; i>0; i--)
637  {
638    mpz_set_si(zvec, (*weight)[i-1]);
639    mpz_mul_ui(zmul, zvec, pGetExp(p, i));
640    mpz_add(zsum, zsum, zmul);
641  }
642
643  wgrad = mpz_get_ui(zsum);
644
645  if(mpz_cmp(zsum, sing_int)>0)
646  {
647    if(Overflow_Error ==  FALSE)
648    {
649      PrintLn();
650      PrintS("\n// ** OVERFLOW in \"MwalkInitialForm\": ");
651      mpz_out_str( stdout, 10, zsum);
652      PrintS(" is greater than 2147483647 (max. integer representation)");
653      Overflow_Error = TRUE;
654    }
655  }
656
657  mpz_clear(zmul);
658  mpz_clear(zvec);
659  mpz_clear(zsum);
660  mpz_clear(sing_int);
661
662  return wgrad;
663}
664
665/********************************************************************
666 * compute a weight degree of a polynomial p w.r.t. a weight_vector *
667 ********************************************************************/
668static inline int MwalkWeightDegree(poly p, intvec* weight_vector)
669{
670  assume(weight_vector->length() >= currRing->N);
671  int max = 0, maxtemp;
672
673  while(p != NULL)
674  {
675    maxtemp = MLmWeightedDegree(p, weight_vector);
676    pIter(p);
677
678    if (maxtemp > max)
679    {
680      max = maxtemp;
681    }
682  }
683  return max;
684}
685
686
687/********************************************************************
688 * compute a weight degree of a monomial p w.r.t. a weight_vector   *
689 ********************************************************************/
690static  void  MLmWeightedDegree_gmp(mpz_t result, const poly p, intvec* weight)
691{
692  /* 2147483647 is max. integer representation in SINGULAR */
693  mpz_t sing_int;
694  mpz_init_set_ui(sing_int,  2147483647);
695
696  int i;
697
698  mpz_t zmul;
699  mpz_init(zmul);
700  mpz_t zvec;
701  mpz_init(zvec);
702  mpz_t ztmp;
703  mpz_init(ztmp);
704
705  for (i=currRing->N; i>0; i--)
706  {
707    mpz_set_si(zvec, (*weight)[i-1]);
708    mpz_mul_ui(zmul, zvec, pGetExp(p, i));
709    mpz_add(ztmp, ztmp, zmul);
710  }
711  mpz_init_set(result, ztmp);
712  mpz_clear(ztmp);
713  mpz_clear(sing_int);
714  mpz_clear(zvec);
715  mpz_clear(zmul);
716}
717
718
719/*****************************************************************************
720 * return an initial form of the polynom g w.r.t. a weight vector curr_weight *
721 *****************************************************************************/
722static poly MpolyInitialForm(poly g, intvec* curr_weight)
723{
724  if(g == NULL)
725  {
726    return NULL;
727  }
728  mpz_t max; mpz_init(max);
729  mpz_t maxtmp; mpz_init(maxtmp);
730
731  poly hg, in_w_g = NULL;
732
733  while(g != NULL)
734  {
735    hg = g;
736    pIter(g);
737    MLmWeightedDegree_gmp(maxtmp, hg, curr_weight);
738
739    if(mpz_cmp(maxtmp, max)>0)
740    {
741      mpz_set(max, maxtmp);
742      if (in_w_g!=NULL) pDelete(&in_w_g);
743      in_w_g = pHead(hg);
744    }
745    else
746    {
747      if(mpz_cmp(maxtmp, max)==0)
748      {
749        in_w_g = pAdd(in_w_g, pHead(hg));
750      }
751    }
752  }
753  mpz_clear(maxtmp);
754  mpz_clear(max);
755  return in_w_g;
756}
757
758/************************************************************************
759 * compute the initial form of an ideal <G> w.r.t. a weight vector iva  *
760 ************************************************************************/
761ideal MwalkInitialForm(ideal G, intvec* ivw)
762{
763  BOOLEAN nError =  Overflow_Error;
764  Overflow_Error = FALSE;
765
766  int i, nG = IDELEMS(G);
767  ideal Gomega = idInit(nG, 1);
768
769  for(i=nG-1; i>=0; i--)
770  {
771    Gomega->m[i] = MpolyInitialForm(G->m[i], ivw);
772  }
773  if(Overflow_Error == FALSE)
774  {
775    Overflow_Error = nError;
776  }
777  return Gomega;
778}
779
780/************************************************************************
781 * test whether the weight vector iv is in the cone of the ideal G      *
782 *     i.e. test whether in(in_w(g)) = in(g) for all g in G             *
783 ************************************************************************/
784
785static int test_w_in_ConeCC(ideal G, intvec* iv)
786{
787  if(G->m[0] == NULL)
788  {
789    PrintS("//** the result may be WRONG, i.e. 0!!\n");
790    return 0;
791  }
792
793  BOOLEAN nError =  Overflow_Error;
794  Overflow_Error = FALSE;
795
796  int i, nG = IDELEMS(G);
797  poly mi, gi;
798
799  for(i=nG-1; i>=0; i--)
800  {
801    mi = MpolyInitialForm(G->m[i], iv);
802    //Print("\n **// test_w_in_ConeCC: lm(initial)= %s \n",pString(mi));
803    gi = G->m[i];
804    //Print("\n **// test_w_in_ConeCC: lm(ideal)= %s \n",pString(gi));
805    if(mi == NULL)
806    {
807      if(Overflow_Error == FALSE)
808      {
809        Overflow_Error = nError;
810      }
811      return 0;
812    }
813    if(!pLmEqual(mi, gi))
814    {
815      pDelete(&mi);
816      if(Overflow_Error == FALSE)
817      {
818        Overflow_Error = nError;
819      }
820      return 0;
821    }
822    pDelete(&mi);
823  }
824
825  if(Overflow_Error == FALSE)
826  {
827    Overflow_Error = nError;
828  }
829  return 1;
830}
831
832/***************************************************
833 * compute a least common multiple of two integers *
834 ***************************************************/
835static inline long Mlcm(long &i1, long &i2)
836{
837  long temp = gcd(i1, i2);
838  return ((i1 / temp)* i2);
839}
840
841
842/***************************************************
843 * return  the dot product of two intvecs a and b  *
844 ***************************************************/
845static inline long  MivDotProduct(intvec* a, intvec* b)
846{
847  assume( a->length() ==  b->length());
848  int i, n = a->length();
849  long result = 0;
850
851  for(i=n-1; i>=0; i--)
852    {
853    result += (*a)[i] * (*b)[i];
854    }
855  return result;
856}
857
858/*****************************************************
859 * Substract two given intvecs componentwise         *
860 *****************************************************/
861static intvec* MivSub(intvec* a, intvec* b)
862{
863  assume( a->length() ==  b->length());
864  int i, n = a->length();
865  intvec* result = new intvec(n);
866
867  for(i=n-1; i>=0; i--)
868  {
869    (*result)[i] = (*a)[i] - (*b)[i];
870  }
871  return result;
872}
873
874/*****************************************************
875 * return the "intvec" lead exponent of a polynomial *
876 *****************************************************/
877static intvec* MExpPol(poly f)
878{
879  int i, nR = currRing->N;
880  intvec* result = new intvec(nR);
881
882  for(i=nR-1; i>=0; i--)
883  {
884    (*result)[i] = pGetExp(f,i+1);
885  }
886  return result;
887}
888
889/*****************************************************
890 * Compare two given intvecs and return 1, if they   *
891 * are the same, otherwise 0                         *
892 *****************************************************/
893int MivSame(intvec* u , intvec* v)
894{
895  assume(u->length() == v->length());
896
897  int i, niv = u->length();
898
899  for (i=0; i<niv; i++)
900  {
901    if ((*u)[i] != (*v)[i])
902    {
903      return 0;
904    }
905  }
906  return 1;
907}
908
909/******************************************************
910 * Compare 3 given intvecs and return 0, if the first *
911 * and the second are the same. Return 1, if the      *
912 * the second and the third are the same, otherwise 2 *
913 ******************************************************/
914int M3ivSame(intvec* temp, intvec* u , intvec* v)
915{
916  assume(temp->length() == u->length() && u->length() == v->length());
917
918  if((MivSame(temp, u)) == 1)
919  {
920    return 0;
921  }
922  if((MivSame(temp, v)) == 1)
923  {
924    return 1;
925  }
926  return 2;
927}
928
929/*****************************************************
930 * compute a Groebner basis of an ideal              *
931 *****************************************************/
932static ideal MstdCC(ideal G)
933{
934  BITSET save1,save2;
935  SI_SAVE_OPT(save1,save2);
936  si_opt_1|=(Sy_bit(OPT_REDTAIL)|Sy_bit(OPT_REDSB));
937  ideal G1 = kStd(G, NULL, testHomog, NULL);
938  SI_RESTORE_OPT(save1,save2);
939
940  idSkipZeroes(G1);
941  return G1;
942}
943
944/*****************************************************
945 * compute a Groebner basis of an homogeneous ideal  *
946 *****************************************************/
947static ideal MstdhomCC(ideal G)
948{
949  BITSET save1,save2;
950  SI_SAVE_OPT(save1,save2);
951  si_opt_1|=(Sy_bit(OPT_REDTAIL)|Sy_bit(OPT_REDSB));
952  ideal G1 = kStd(G, NULL, isHomog, NULL);
953  SI_RESTORE_OPT(save1,save2);
954
955  idSkipZeroes(G1);
956  return G1;
957}
958
959
960/*****************************************************************************
961* create a weight matrix order as intvec of an extra weight vector (a(iv),lp)*
962******************************************************************************/
963intvec* MivMatrixOrder(intvec* iv)
964{
965  int i, nR = iv->length();
966
967  intvec* ivm = new intvec(nR*nR);
968
969  for(i=0; i<nR; i++)
970  {
971    (*ivm)[i] = (*iv)[i];
972  }
973  for(i=1; i<nR; i++)
974  {
975    (*ivm)[i*nR+i-1] = 1;
976  }
977  return ivm;
978}
979
980/*********************************************************************************
981* create a weight matrix order as intvec of an extra weight vector (a(iv),M(iw)) *
982**********************************************************************************/
983intvec* MivMatrixOrderRefine(intvec* iv, intvec* iw)
984{
985  assume((iv->length())*(iv->length()) == iw->length());
986  int i,j, nR = iv->length();
987
988  intvec* ivm = new intvec(nR*nR);
989
990  for(i=0; i<nR; i++)
991  {
992    (*ivm)[i] = (*iv)[i];
993  }
994  for(i=1; i<nR; i++)
995  {
996    for(j=0; j<nR; j++)
997    {
998      (*ivm)[j+i*nR] = (*iw)[j+i*nR];
999    }
1000  }
1001  return ivm;
1002}
1003
1004/*******************************
1005 * return intvec = (1, ..., 1) *
1006 *******************************/
1007intvec* Mivdp(int nR)
1008{
1009  int i;
1010  intvec* ivm = new intvec(nR);
1011
1012  for(i=nR-1; i>=0; i--)
1013  {
1014    (*ivm)[i] = 1;
1015  }
1016  return ivm;
1017}
1018
1019/**********************************
1020 * return intvvec = (1,0, ..., 0) *
1021 **********************************/
1022intvec* Mivlp(int nR)
1023{
1024  intvec* ivm = new intvec(nR);
1025  (*ivm)[0] = 1;
1026
1027  return ivm;
1028}
1029
1030//unused
1031/*****************************************************************************
1032 * print the max total degree and the max coefficient of G                   *
1033 *****************************************************************************/
1034/*
1035static void checkComplexity(ideal G, char* cG)
1036{
1037  int nV = currRing->N;
1038  int nG = IDELEMS(G);
1039  intvec* ivUnit = Mivdp(nV);
1040  int i, tmpdeg, maxdeg=0;
1041  number tmpcoeff , maxcoeff=nInit(0);
1042  poly p;
1043  for(i=nG-1; i>=0; i--)
1044  {
1045    tmpdeg = MwalkWeightDegree(G->m[i], ivUnit);
1046    if(tmpdeg > maxdeg )
1047    {
1048      maxdeg = tmpdeg;
1049    }
1050  }
1051
1052  for(i=nG-1; i>=0; i--)
1053  {
1054    p = pCopy(G->m[i]);
1055    while(p != NULL)
1056    {
1057      //tmpcoeff = pGetCoeff(pHead(p));
1058      tmpcoeff = pGetCoeff(p);
1059      if(nGreater(tmpcoeff,maxcoeff))
1060      {
1061         maxcoeff = nCopy(tmpcoeff);
1062      }
1063      pIter(p);
1064    }
1065    pDelete(&p);
1066  }
1067  p = pNSet(maxcoeff);
1068  char* pStr = pString(p);
1069  delete ivUnit;
1070  Print("// max total degree of %s = %d\n",cG, maxdeg);
1071  Print("// max coefficient of %s  = %s", cG, pStr);//ing(p));
1072  Print(" which consists of %d digits", (int)strlen(pStr));
1073  PrintLn();
1074}
1075*/
1076
1077/*****************************************************************************
1078* If target_ord = intmat(A1, ..., An) then calculate the perturbation        *
1079* vectors                                                                    *
1080*   tau_p_dep = inveps^(p_deg-1)*A1 + inveps^(p_deg-2)*A2 +... + A_p_deg     *
1081* where                                                                      *
1082*      inveps > totaldegree(G)*(max(A2)+...+max(A_p_deg))                    *
1083* intmat target_ord is an integer order matrix of the monomial ordering of   *
1084* basering.                                                                  *
1085* This programm computes a perturbated vector with a p_deg perturbation      *
1086* degree which smaller than the numbers of variables                         *
1087******************************************************************************/
1088intvec* MPertVectors(ideal G, intvec* ivtarget, int pdeg)
1089{
1090  // ivtarget is a matrix order of a degree reverse lex. order
1091  int nV = currRing->N;
1092  //assume(pdeg <= nV && pdeg >= 0);
1093
1094  int i, j, nG = IDELEMS(G);
1095  intvec* v_null =  new intvec(nV);
1096
1097  // Check that the perturbed degree is valid
1098  if(pdeg > nV || pdeg <= 0)
1099  {
1100    WerrorS("//** The perturbed degree is wrong!!");
1101    return v_null;
1102  }
1103  delete v_null;
1104
1105  if(pdeg == 1)
1106  {
1107    return ivtarget;
1108  }
1109  mpz_t *pert_vector = (mpz_t*)omAlloc(nV*sizeof(mpz_t));
1110  mpz_t *pert_vector1 = (mpz_t*)omAlloc(nV*sizeof(mpz_t));
1111
1112  for(i=0; i<nV; i++)
1113  {
1114    mpz_init_set_si(pert_vector[i], (*ivtarget)[i]);
1115    mpz_init_set_si(pert_vector1[i], (*ivtarget)[i]);
1116  }
1117  // Calculate max1 = Max(A2)+Max(A3)+...+Max(Apdeg),
1118  // where the Ai are the i-te rows of the matrix target_ord.
1119  int ntemp, maxAi, maxA=0;
1120  for(i=1; i<pdeg; i++)
1121  {
1122    maxAi = (*ivtarget)[i*nV];
1123    if(maxAi<0)
1124    {
1125      maxAi = -maxAi;
1126    }
1127    for(j=i*nV+1; j<(i+1)*nV; j++)
1128    {
1129      ntemp = (*ivtarget)[j];
1130      if(ntemp < 0)
1131      {
1132        ntemp = -ntemp;
1133      }
1134      if(ntemp > maxAi)
1135      {
1136        maxAi = ntemp;
1137      }
1138    }
1139    maxA += maxAi;
1140  }
1141
1142  // Calculate inveps = 1/eps, where 1/eps > totaldeg(p)*max1 for all p in G.
1143
1144  intvec* ivUnit = Mivdp(nV);
1145
1146  mpz_t tot_deg; mpz_init(tot_deg);
1147  mpz_t maxdeg; mpz_init(maxdeg);
1148  mpz_t inveps; mpz_init(inveps);
1149
1150
1151  for(i=nG-1; i>=0; i--)
1152  {
1153     mpz_set_ui(maxdeg, MwalkWeightDegree(G->m[i], ivUnit));
1154     if (mpz_cmp(maxdeg,  tot_deg) > 0 )
1155     {
1156       mpz_set(tot_deg, maxdeg);
1157     }
1158  }
1159
1160  delete ivUnit;
1161  mpz_mul_ui(inveps, tot_deg, maxA);
1162  mpz_add_ui(inveps, inveps, 1);
1163
1164
1165  // takes  "small" inveps
1166#ifdef INVEPS_SMALL_IN_MPERTVECTOR
1167  if(mpz_cmp_ui(inveps, pdeg)>0 && pdeg > 3)
1168  {
1169    //  Print("\n// choose the\"small\" inverse epsilon := %d / %d = ", mpz_get_si(inveps), pdeg);
1170    mpz_fdiv_q_ui(inveps, inveps, pdeg);
1171    // mpz_out_str(stdout, 10, inveps);
1172  }
1173#else
1174  // PrintS("\n// the \"big\" inverse epsilon: ");
1175  mpz_out_str(stdout, 10, inveps);
1176#endif
1177
1178  // pert(A1) = inveps^(pdeg-1)*A1 + inveps^(pdeg-2)*A2+...+A_pdeg,
1179  // pert_vector := A1
1180  for( i=1; i < pdeg; i++ )
1181  {
1182    for(j=0; j<nV; j++)
1183    {
1184      mpz_mul(pert_vector[j], pert_vector[j], inveps);
1185      if((*ivtarget)[i*nV+j]<0)
1186      {
1187        mpz_sub_ui(pert_vector[j], pert_vector[j],-(*ivtarget)[i*nV+j]);
1188      }
1189      else
1190      {
1191        mpz_add_ui(pert_vector[j], pert_vector[j],(*ivtarget)[i*nV+j]);
1192      }
1193    }
1194  }
1195
1196  // 2147483647 is max. integer representation in SINGULAR
1197  mpz_t sing_int;
1198  mpz_init_set_ui(sing_int,  2147483647);
1199
1200  mpz_t check_int;
1201  mpz_init_set_ui(check_int,  100000);
1202
1203  mpz_t ztemp;
1204  mpz_init(ztemp);
1205  mpz_set(ztemp, pert_vector[0]);
1206  for(i=1; i<nV; i++)
1207  {
1208    mpz_gcd(ztemp, ztemp, pert_vector[i]);
1209    if(mpz_cmp_si(ztemp, 1)  == 0)
1210    {
1211      break;
1212    }
1213  }
1214  if(mpz_cmp_si(ztemp, 1) != 0)
1215  {
1216    for(i=0; i<nV; i++)
1217    {
1218      mpz_divexact(pert_vector[i], pert_vector[i], ztemp);
1219    }
1220  }
1221
1222  for(i=0; i<nV; i++)
1223  {
1224    if(mpz_cmp(pert_vector[i], check_int)>=0)
1225    {
1226      for(j=0; j<nV; j++)
1227      {
1228        mpz_fdiv_q_ui(pert_vector1[j], pert_vector[j], 100);
1229      }
1230    }
1231  }
1232
1233  intvec* result = new intvec(nV);
1234
1235  int ntrue=0;
1236
1237  for(i=0; i<nV; i++)
1238  {
1239    (*result)[i] = mpz_get_si(pert_vector1[i]);
1240    if(mpz_cmp(pert_vector1[i], sing_int)>=0)
1241    {
1242      ntrue++;
1243    }
1244  }
1245  if(ntrue > 0 || test_w_in_ConeCC(G,result)==0)
1246  {
1247    ntrue=0;
1248    for(i=0; i<nV; i++)
1249    {
1250      (*result)[i] = mpz_get_si(pert_vector[i]);
1251      if(mpz_cmp(pert_vector[i], sing_int)>=0)
1252      {
1253        ntrue++;
1254        if(Overflow_Error == FALSE)
1255        {
1256          Overflow_Error = TRUE;
1257          PrintS("\n// ** OVERFLOW in \"MPertvectors\": ");
1258          mpz_out_str( stdout, 10, pert_vector[i]);
1259          PrintS(" is greater than 2147483647 (max. integer representation)");
1260          Print("\n//  So vector[%d] := %d is wrong!!", i+1, (*result)[i]);
1261        }
1262      }
1263    }
1264
1265    if(Overflow_Error == TRUE)
1266    {
1267      ivString(result, "pert_vector");
1268      Print("\n// %d element(s) of it is overflow!!", ntrue);
1269    }
1270  }
1271
1272  mpz_clear(ztemp);
1273  mpz_clear(sing_int);
1274  mpz_clear(check_int);
1275  omFree(pert_vector);
1276  omFree(pert_vector1);
1277  mpz_clear(tot_deg);
1278  mpz_clear(maxdeg);
1279  mpz_clear(inveps);
1280
1281  rComplete(currRing);
1282  for(j=0; j<IDELEMS(G); j++)
1283  {
1284    poly p=G->m[j];
1285    while(p!=NULL)
1286    {
1287      p_Setm(p,currRing); pIter(p);
1288    }
1289  }
1290  return result;
1291}
1292
1293/*****************************************************************************
1294 * The following procedure returns                                           *
1295 *     Pert(A1) = 1/eps^(pdeg-1)*A_1 + 1/eps^(pdeg-2)*A_2+...+A_pdeg,        *
1296 * where the A_i are the i-th rows of the matrix target_ord and              *
1297 *     1/eps > deg(p)*(max(A_2) + max(A_3)+...+max(A_pdeg))                  *
1298 *****************************************************************************/
1299intvec* MPertVectorslp(ideal G, intvec* ivtarget, int pdeg)
1300{
1301  // ivtarget is a matrix order of the lex. order
1302  int nV = currRing->N;
1303  //assume(pdeg <= nV && pdeg >= 0);
1304
1305  int i, j, nG = IDELEMS(G);
1306  intvec* pert_vector =  new intvec(nV);
1307
1308  //Checking that the perturbated degree is valid
1309  if(pdeg > nV || pdeg <= 0)
1310  {
1311    WerrorS("//** The perturbed degree is wrong!!");
1312    return pert_vector;
1313  }
1314  for(i=0; i<nV; i++)
1315  {
1316    (*pert_vector)[i]=(*ivtarget)[i];
1317  }
1318  if(pdeg == 1)
1319  {
1320    return pert_vector;
1321  }
1322  // Calculate max1 = Max(A2)+Max(A3)+...+Max(Apdeg),
1323  // where the Ai are the i-te rows of the matrix target_ord.
1324  int ntemp, maxAi, maxA=0;
1325  for(i=1; i<pdeg; i++)
1326  {
1327    maxAi = (*ivtarget)[i*nV];
1328    for(j=i*nV+1; j<(i+1)*nV; j++)
1329    {
1330      ntemp = (*ivtarget)[j];
1331      if(ntemp > maxAi)
1332      {
1333        maxAi = ntemp;
1334      }
1335    }
1336    maxA += maxAi;
1337  }
1338
1339  // Calculate inveps := 1/eps, where 1/eps > deg(p)*max1 for all p in G.
1340  int inveps, tot_deg = 0, maxdeg;
1341
1342  intvec* ivUnit = Mivdp(nV);//19.02
1343  for(i=nG-1; i>=0; i--)
1344  {
1345    // maxdeg = pTotaldegree(G->m[i], currRing); //it's wrong for ex1,2,rose
1346    maxdeg = MwalkWeightDegree(G->m[i], ivUnit);
1347    if (maxdeg > tot_deg )
1348    {
1349      tot_deg = maxdeg;
1350    }
1351  }
1352  delete ivUnit;
1353
1354  inveps = (tot_deg * maxA) + 1;
1355
1356#ifdef INVEPS_SMALL_IN_FRACTAL
1357  //  Print("\n// choose the\"small\" inverse epsilon := %d / %d = ", inveps, pdeg);
1358  if(inveps > pdeg && pdeg > 3)
1359  {
1360    inveps = inveps / pdeg;
1361  }
1362  // Print(" %d", inveps);
1363#else
1364  PrintS("\n// the \"big\" inverse epsilon %d", inveps);
1365#endif
1366
1367  // Pert(A1) = inveps^(pdeg-1)*A1 + inveps^(pdeg-2)*A2+...+A_pdeg
1368  for ( i=1; i < pdeg; i++ )
1369  {
1370    for(j=0; j<nV; j++)
1371    {
1372      (*pert_vector)[j] = inveps*((*pert_vector)[j]) + (*ivtarget)[i*nV+j];
1373    }
1374  }
1375
1376  int temp = (*pert_vector)[0];
1377  for(i=1; i<nV; i++)
1378  {
1379    temp = gcd(temp, (*pert_vector)[i]);
1380    if(temp == 1)
1381    {
1382      break;
1383    }
1384  }
1385  if(temp != 1)
1386  {
1387    for(i=0; i<nV; i++)
1388    {
1389      (*pert_vector)[i] = (*pert_vector)[i] / temp;
1390    }
1391  }
1392
1393  intvec* result = pert_vector;
1394  delete pert_vector;
1395  return result;
1396}
1397
1398/*****************************************************************************
1399 * define a lexicographic order matrix as intvec                             *
1400 *****************************************************************************/
1401intvec* MivMatrixOrderlp(int nV)
1402{
1403  int i;
1404  intvec* ivM = new intvec(nV*nV);
1405
1406  for(i=0; i<nV; i++)
1407  {
1408    (*ivM)[i*nV + i] = 1;
1409  }
1410  return(ivM);
1411}
1412
1413
1414/*****************************************************************************
1415 * define a reverse lexicographic order (dp) matrix as intvec                *
1416 *****************************************************************************/
1417intvec* MivMatrixOrderdp(int nV)
1418{
1419  int i;
1420  intvec* ivM = new intvec(nV*nV);
1421
1422  for(i=0; i<nV; i++)
1423  {
1424    (*ivM)[i] = 1;
1425  }
1426  for(i=1; i<nV; i++)
1427  {
1428    (*ivM)[(i+1)*nV - i] = -1;
1429  }
1430  return(ivM);
1431}
1432
1433/*****************************************************************************
1434 * creates an intvec of the monomial order Wp(ivstart)                       *
1435 *****************************************************************************/
1436intvec* MivWeightOrderlp(intvec* ivstart)
1437{
1438  int i;
1439  int nV = ivstart->length();
1440  intvec* ivM = new intvec(nV*nV);
1441
1442  for(i=0; i<nV; i++)
1443  {
1444    (*ivM)[i] = (*ivstart)[i];
1445  }
1446  for(i=1; i<nV; i++)
1447  {
1448    (*ivM)[i*nV + i-1] = 1;
1449  }
1450  return(ivM);
1451}
1452
1453/*****************************************************************************
1454 * creates an intvec of the monomial order dp(ivstart)                       *
1455 *****************************************************************************/
1456intvec* MivWeightOrderdp(intvec* ivstart)
1457{
1458  int i;
1459  int nV = ivstart->length();
1460  intvec* ivM = new intvec(nV*nV);
1461
1462  for(i=0; i<nV; i++)
1463  {
1464    (*ivM)[i] = (*ivstart)[i];
1465  }
1466  for(i=0; i<nV; i++)
1467  {
1468    (*ivM)[nV+i] = 1;
1469  }
1470  for(i=2; i<nV; i++)
1471  {
1472    (*ivM)[(i+1)*nV - i] = -1;
1473  }
1474  return(ivM);
1475}
1476
1477//unused
1478/*
1479static intvec* MatrixOrderdp(int nV)
1480{
1481  int i;
1482  intvec* ivM = new intvec(nV*nV);
1483
1484  for(i=0; i<nV; i++)
1485  {
1486    (*ivM)[i] = 1;
1487  }
1488  for(i=1; i<nV; i++)
1489  {
1490    (*ivM)[(i+1)*nV - i] = -1;
1491  }
1492  return(ivM);
1493}
1494*/
1495
1496intvec* MivUnit(int nV)
1497{
1498  int i;
1499  intvec* ivM = new intvec(nV);
1500  for(i=nV-1; i>=0; i--)
1501  {
1502    (*ivM)[i] = 1;
1503  }
1504  return(ivM);
1505}
1506
1507
1508/************************************************************************
1509*  compute a perturbed weight vector of a matrix order w.r.t. an ideal  *
1510*************************************************************************/
1511VAR int Xnlev;
1512intvec* Mfpertvector(ideal G, intvec* ivtarget)
1513{
1514  int i, j, nG = IDELEMS(G);
1515  int nV = currRing->N;
1516  int niv = nV*nV;
1517
1518
1519  // Calculate maxA = Max(A2) + Max(A3) + ... + Max(AnV),
1520  // where the Ai are the i-te rows of the matrix 'targer_ord'.
1521  int ntemp, maxAi, maxA=0;
1522  for(i=1; i<nV; i++)
1523  {
1524    maxAi = (*ivtarget)[i*nV];
1525    if(maxAi<0)
1526    {
1527      maxAi = -maxAi;
1528    }
1529    for(j=i*nV+1; j<(i+1)*nV; j++)
1530    {
1531      ntemp = (*ivtarget)[j];
1532      if(ntemp < 0)
1533      {
1534        ntemp = -ntemp;
1535      }
1536      if(ntemp > maxAi)
1537      {
1538        maxAi = ntemp;
1539      }
1540    }
1541    maxA = maxA + maxAi;
1542  }
1543  intvec* ivUnit = Mivdp(nV);
1544
1545  // Calculate inveps = 1/eps, where 1/eps > deg(p)*maxA for all p in G.
1546  mpz_t tot_deg; mpz_init(tot_deg);
1547  mpz_t maxdeg; mpz_init(maxdeg);
1548  mpz_t inveps; mpz_init(inveps);
1549
1550
1551  for(i=nG-1; i>=0; i--)
1552  {
1553    mpz_set_ui(maxdeg, MwalkWeightDegree(G->m[i], ivUnit));
1554    if (mpz_cmp(maxdeg,  tot_deg) > 0 )
1555    {
1556      mpz_set(tot_deg, maxdeg);
1557    }
1558  }
1559
1560  delete ivUnit;
1561  //inveps = (tot_deg * maxA) + 1;
1562  mpz_mul_ui(inveps, tot_deg, maxA);
1563  mpz_add_ui(inveps, inveps, 1);
1564
1565  // takes  "small" inveps
1566#ifdef INVEPS_SMALL_IN_FRACTAL
1567  if(mpz_cmp_ui(inveps, nV)>0 && nV > 3)
1568  {
1569    mpz_cdiv_q_ui(inveps, inveps, nV);
1570  }
1571  // choose the small inverse epsilon
1572#endif
1573
1574  // PrintLn();  mpz_out_str(stdout, 10, inveps);
1575
1576  // Calculate the perturbed target orders:
1577  mpz_t *ivtemp=(mpz_t *)omAlloc(nV*sizeof(mpz_t));
1578  mpz_t *pert_vector=(mpz_t *)omAlloc(niv*sizeof(mpz_t));
1579
1580  for(i=0; i < nV; i++)
1581  {
1582    mpz_init_set_si(ivtemp[i], (*ivtarget)[i]);
1583    mpz_init_set_si(pert_vector[i], (*ivtarget)[i]);
1584  }
1585
1586  mpz_t ztmp; mpz_init(ztmp);
1587  // BOOLEAN isneg = FALSE;
1588
1589  for(i=1; i<nV; i++)
1590  {
1591    for(j=0; j<nV; j++)
1592    {
1593      mpz_mul(ztmp, inveps, ivtemp[j]);
1594      if((*ivtarget)[i*nV+j]<0)
1595      {
1596        mpz_sub_ui(ivtemp[j], ztmp, -(*ivtarget)[i*nV+j]);
1597      }
1598      else
1599      {
1600        mpz_add_ui(ivtemp[j], ztmp,(*ivtarget)[i*nV+j]);
1601      }
1602    }
1603
1604    for(j=0; j<nV; j++)
1605    {
1606      mpz_init_set(pert_vector[i*nV+j],ivtemp[j]);
1607    }
1608  }
1609
1610  // 2147483647 is max. integer representation in SINGULAR
1611  mpz_t sing_int;
1612  mpz_init_set_ui(sing_int,  2147483647);
1613
1614  intvec* result = new intvec(niv);
1615  BOOLEAN nflow = FALSE;
1616
1617  // computes gcd
1618  mpz_set(ztmp, pert_vector[0]);
1619  for(i=0; i<niv; i++)
1620  {
1621    mpz_gcd(ztmp, ztmp, pert_vector[i]);
1622    if(mpz_cmp_si(ztmp, 1)==0)
1623    {
1624      break;
1625    }
1626  }
1627
1628  for(i=0; i<niv; i++)
1629  {
1630    mpz_divexact(pert_vector[i], pert_vector[i], ztmp);
1631    (* result)[i] = mpz_get_si(pert_vector[i]);
1632  }
1633
1634  CHECK_OVERFLOW:
1635
1636  for(i=0; i<niv; i++)
1637  {
1638    if(mpz_cmp(pert_vector[i], sing_int)>0)
1639    {
1640      if(nflow == FALSE)
1641      {
1642        Xnlev = i / nV;
1643        nflow = TRUE;
1644        Overflow_Error = TRUE;
1645        Print("\n// Xlev = %d and the %d-th element is", Xnlev,  i+1);
1646        PrintS("\n// ** OVERFLOW in \"Mfpertvector\": ");
1647        mpz_out_str( stdout, 10, pert_vector[i]);
1648        PrintS(" is greater than 2147483647 (max. integer representation)");
1649        Print("\n//  So vector[%d] := %d is wrong!!", i+1, (*result)[i]);
1650      }
1651    }
1652  }
1653  if(Overflow_Error == TRUE)
1654  {
1655    ivString(result, "new_vector");
1656  }
1657  omFree(pert_vector);
1658  omFree(ivtemp);
1659  mpz_clear(ztmp);
1660  mpz_clear(tot_deg);
1661  mpz_clear(maxdeg);
1662  mpz_clear(inveps);
1663  mpz_clear(sing_int);
1664
1665  rComplete(currRing);
1666  for(j=0; j<IDELEMS(G); j++)
1667  {
1668    poly p=G->m[j];
1669    while(p!=NULL)
1670    {
1671      p_Setm(p,currRing);
1672      pIter(p);
1673    }
1674  }
1675  return result;
1676}
1677
1678/****************************************************************
1679 * Multiplication of two ideals element by element              *
1680 * i.e. Let be A := (a_i) and B := (b_i), return C := (a_i*b_i) *
1681 *  destroy A, keeps B                                          *
1682 ****************************************************************/
1683static ideal MidMult(ideal A, ideal B)
1684{
1685  int mA = IDELEMS(A), mB = IDELEMS(B);
1686
1687  if(A==NULL || B==NULL)
1688  {
1689    return NULL;
1690  }
1691  if(mB < mA)
1692  {
1693    mA = mB;
1694  }
1695  ideal result = idInit(mA, 1);
1696
1697  int i, k=0;
1698  for(i=0; i<mA; i++)
1699    {
1700      result->m[k] = pMult(A->m[i], pCopy(B->m[i]));
1701      A->m[i]=NULL;
1702      if (result->m[k]!=NULL)
1703      {
1704        k++;
1705      }
1706    }
1707
1708  idDelete(&A);
1709  idSkipZeroes(result);
1710  return result;
1711}
1712
1713/*********************************************************************
1714 * G is a red. Groebner basis w.r.t. <_1                             *
1715 * Gomega is an initial form ideal of <G> w.r.t. a weight vector w   *
1716 * M is a subideal of <Gomega> and M selft is a red. Groebner basis  *
1717 *    of the ideal <Gomega> w.r.t. <_w                               *
1718 * Let m_i = h1.gw1 + ... + hs.gws for each m_i in M; gwi in Gomega  *
1719 * return F with n(F) = n(M) and f_i = h1.g1 + ... + hs.gs for each i*
1720 ********************************************************************/
1721static ideal MLifttwoIdeal(ideal Gw, ideal M, ideal G)
1722{
1723  ideal Mtmp = idLift(Gw, M, NULL, FALSE, TRUE, TRUE, NULL);
1724
1725  // If Gw is a GB, then isSB = TRUE, otherwise FALSE
1726  // So, it is better, if one tests whether Gw is a GB
1727  // in ideals.cc:
1728  // idLift (ideal mod, ideal submod,ideal * rest, BOOLEAN goodShape,
1729  //           BOOLEAN isSB,BOOLEAN divide,matrix * unit)
1730
1731  // Let be Mtmp = {m1,...,ms}, where mi=sum hij.in_gj, for all i=1,...,s
1732  // We compute F = {f1,...,fs}, where fi=sum hij.gj
1733  int i, j, nM = IDELEMS(Mtmp);
1734  ideal idpol, idLG;
1735  ideal F = idInit(nM, 1);
1736
1737  for(i=0; i<nM; i++)
1738  {
1739     idpol = idVec2Ideal(Mtmp->m[i]);
1740     idLG = MidMult(idpol, G);
1741     idpol = NULL;
1742     F->m[i] = NULL;
1743     for(j=IDELEMS(idLG)-1; j>=0; j--)
1744     {
1745       F->m[i] = pAdd(F->m[i], idLG->m[j]);
1746       idLG->m[j]=NULL;
1747     }
1748     idDelete(&idLG);
1749  }
1750  idDelete(&Mtmp);
1751  return F;
1752}
1753
1754//unused
1755/*
1756static void checkidealCC(ideal G, char* Ch)
1757{
1758  int i,nmon=0,ntmp;
1759  int nG = IDELEMS(G);
1760  int n = nG-1;
1761  Print("\n// ** Ideal %s besteht aus %d Polynomen mit ", Ch, nG);
1762
1763  for(i=0; i<nG; i++)
1764  {
1765    ntmp =  pLength(G->m[i]);
1766    nmon += ntmp;
1767
1768    if(i != n)
1769    {
1770      Print("%d, ", ntmp);
1771    }
1772    else
1773    {
1774      Print(" bzw. %d ", ntmp);
1775    }
1776  }
1777  PrintS(" Monomen.\n");
1778  Print("// ** %s besitzt %d Monome.", Ch, nmon);
1779  PrintLn();
1780}
1781*/
1782
1783//unused
1784/*
1785static void HeadidString(ideal L, char* st)
1786{
1787  int i, nL = IDELEMS(L)-1;
1788
1789  Print("//  The head terms of the ideal %s = ", st);
1790  for(i=0; i<nL; i++)
1791  {
1792    Print(" %s, ", pString(pHead(L->m[i])));
1793  }
1794  Print(" %s;\n", pString(pHead(L->m[nL])));
1795}
1796
1797*/
1798static inline int MivComp(intvec* iva, intvec* ivb)
1799{
1800  assume(iva->length() == ivb->length());
1801  int i;
1802  for(i=iva->length()-1; i>=0; i--)
1803  {
1804    if((*iva)[i] - (*ivb)[i] != 0)
1805    {
1806      return 0;
1807    }
1808  }
1809  return 1;
1810}
1811
1812/**********************************************
1813 * Look for the smallest absolut value in vec *
1814 **********************************************/
1815static int MivAbsMax(intvec* vec)
1816{
1817  int i,k;
1818  if((*vec)[0] < 0)
1819  {
1820    k = -(*vec)[0];
1821  }
1822  else
1823  {
1824    k = (*vec)[0];
1825  }
1826  for(i=1; i < (vec->length()); i++)
1827  {
1828    if((*vec)[i] < 0)
1829    {
1830      if(-(*vec)[i] > k)
1831      {
1832        k = -(*vec)[i];
1833      }
1834    }
1835    else
1836    {
1837      if((*vec)[i] > k)
1838      {
1839        k = (*vec)[i];
1840      }
1841    }
1842  }
1843  return k;
1844}
1845
1846
1847/**************************************************************
1848 * Look for the position of the smallest absolut value in vec *
1849 **************************************************************/
1850static int MivAbsMaxArg(intvec* vec)
1851{
1852  int k = MivAbsMax(vec);
1853  int i=0;
1854  while(1)
1855  {
1856    if((*vec)[i] == k || (*vec)[i] == -k)
1857    {
1858      break;
1859    }
1860    i++;
1861  }
1862  return i;
1863}
1864
1865
1866/**********************************************************************
1867 * Compute a next weight vector between curr_weight and target_weight *
1868 * with respect to an ideal <G>.                                      *
1869**********************************************************************/
1870/*
1871static intvec* MwalkNextWeightCC(intvec* curr_weight, intvec* target_weight,
1872                                 ideal G)
1873{
1874  BOOLEAN nError = Overflow_Error;
1875  Overflow_Error = FALSE;
1876
1877  assume(currRing != NULL && curr_weight != NULL &&
1878         target_weight != NULL && G != NULL);
1879
1880  int nRing = currRing->N;
1881  int checkRed, j, nG = IDELEMS(G);
1882  intvec* ivtemp;
1883
1884  mpz_t t_zaehler, t_nenner;
1885  mpz_init(t_zaehler);
1886  mpz_init(t_nenner);
1887
1888  mpz_t s_zaehler, s_nenner, temp, MwWd;
1889  mpz_init(s_zaehler);
1890  mpz_init(s_nenner);
1891  mpz_init(temp);
1892  mpz_init(MwWd);
1893
1894  mpz_t sing_int;
1895  mpz_init(sing_int);
1896  mpz_set_ui(sing_int,  2147483647);
1897
1898  mpz_t sing_int_half;
1899  mpz_init(sing_int_half);
1900  mpz_set_ui(sing_int_half,  3*(1073741824/2));
1901
1902  mpz_t deg_w0_p1, deg_d0_p1;
1903  mpz_init(deg_w0_p1);
1904  mpz_init(deg_d0_p1);
1905
1906  mpz_t sztn, sntz;
1907  mpz_init(sztn);
1908  mpz_init(sntz);
1909
1910  mpz_t t_null;
1911  mpz_init(t_null);
1912
1913  mpz_t ggt;
1914  mpz_init(ggt);
1915
1916  mpz_t dcw;
1917  mpz_init(dcw);
1918
1919  int gcd_tmp;
1920  intvec* diff_weight = MivSub(target_weight, curr_weight);
1921
1922  intvec* diff_weight1 = MivSub(target_weight, curr_weight);
1923  poly g;
1924
1925  for (j=0; j<nG; j++)
1926  {
1927    g = G->m[j];
1928    if (g != NULL)
1929    {
1930      ivtemp = MExpPol(g);
1931      mpz_set_si(deg_w0_p1, MivDotProduct(ivtemp, curr_weight));
1932      mpz_set_si(deg_d0_p1, MivDotProduct(ivtemp, diff_weight));
1933      delete ivtemp;
1934
1935      pIter(g);
1936      while (g != NULL)
1937      {
1938        ivtemp = MExpPol(g);
1939        mpz_set_si(MwWd, MivDotProduct(ivtemp, curr_weight));
1940        mpz_sub(s_zaehler, deg_w0_p1, MwWd);
1941        if(mpz_cmp(s_zaehler, t_null) != 0)
1942        {
1943          mpz_set_si(MwWd, MivDotProduct(ivtemp, diff_weight));
1944          mpz_sub(s_nenner, MwWd, deg_d0_p1);
1945          // check for 0 < s <= 1
1946          if( (mpz_cmp(s_zaehler,t_null) > 0 &&
1947               mpz_cmp(s_nenner, s_zaehler)>=0) ||
1948              (mpz_cmp(s_zaehler, t_null) < 0 &&
1949               mpz_cmp(s_nenner, s_zaehler)<=0))
1950          {
1951            // make both positive
1952            if (mpz_cmp(s_zaehler, t_null) < 0)
1953            {
1954              mpz_neg(s_zaehler, s_zaehler);
1955              mpz_neg(s_nenner, s_nenner);
1956            }
1957
1958            //compute a simple fraction of s
1959            cancel(s_zaehler, s_nenner);
1960
1961            if(mpz_cmp(t_nenner, t_null) != 0)
1962            {
1963              mpz_mul(sztn, s_zaehler, t_nenner);
1964              mpz_mul(sntz, s_nenner, t_zaehler);
1965
1966              if(mpz_cmp(sztn,sntz) < 0)
1967              {
1968                mpz_add(t_nenner, t_null, s_nenner);
1969                mpz_add(t_zaehler,t_null, s_zaehler);
1970              }
1971            }
1972            else
1973            {
1974              mpz_add(t_nenner, t_null, s_nenner);
1975              mpz_add(t_zaehler,t_null, s_zaehler);
1976            }
1977          }
1978        }
1979        pIter(g);
1980        delete ivtemp;
1981      }
1982    }
1983  }
1984  //Print("\n// Alloc Size = %d \n", nRing*sizeof(mpz_t));
1985  mpz_t *vec=(mpz_t*)omAlloc(nRing*sizeof(mpz_t));
1986
1987
1988  // there is no 0<t<1 and define the next weight vector that is equal
1989  // to the current weight vector
1990  if(mpz_cmp(t_nenner, t_null) == 0)
1991  {
1992#ifndef SING_NDEBUG
1993    PrintS("\n//MwalkNextWeightCC: t_nenner=0\n");
1994#endif
1995    delete diff_weight;
1996    diff_weight = ivCopy(curr_weight);//take memory
1997    goto FINISH;
1998  }
1999
2000  // define the target vector as the next weight vector, if t = 1
2001  if(mpz_cmp_si(t_nenner, 1)==0 && mpz_cmp_si(t_zaehler,1)==0)
2002  {
2003    delete diff_weight;
2004    diff_weight = ivCopy(target_weight); //this takes memory
2005    goto FINISH;
2006  }
2007
2008   checkRed = 0;
2009
2010  SIMPLIFY_GCD:
2011
2012  // simplify the vectors curr_weight and diff_weight (C-int)
2013  gcd_tmp = (*curr_weight)[0];
2014
2015  for (j=1; j<nRing; j++)
2016  {
2017    gcd_tmp = gcd(gcd_tmp, (*curr_weight)[j]);
2018    if(gcd_tmp == 1)
2019    {
2020      break;
2021    }
2022  }
2023  if(gcd_tmp != 1)
2024  {
2025    for (j=0; j<nRing; j++)
2026    {
2027      gcd_tmp = gcd(gcd_tmp, (*diff_weight)[j]);
2028      if(gcd_tmp == 1)
2029      {
2030        break;
2031      }
2032    }
2033  }
2034  if(gcd_tmp != 1)
2035  {
2036    for (j=0; j<nRing; j++)
2037    {
2038      (*curr_weight)[j] =  (*curr_weight)[j]/gcd_tmp;
2039      (*diff_weight)[j] =  (*diff_weight)[j]/gcd_tmp;
2040    }
2041  }
2042  if(checkRed > 0)
2043  {
2044    for (j=0; j<nRing; j++)
2045    {
2046      mpz_set_si(vec[j], (*diff_weight)[j]);
2047    }
2048    goto TEST_OVERFLOW;
2049  }
2050
2051#ifdef  NEXT_VECTORS_CC
2052  Print("\n// gcd of the weight vectors (current and target) = %d", gcd_tmp);
2053  ivString(curr_weight, "new cw");
2054  ivString(diff_weight, "new dw");
2055
2056  PrintS("\n// t_zaehler: ");  mpz_out_str( stdout, 10, t_zaehler);
2057  PrintS(", t_nenner: ");  mpz_out_str( stdout, 10, t_nenner);
2058#endif
2059
2060// construct a new weight vector and check whether vec[j] is overflow,
2061// i.e. vec[j] > 2^31.
2062// If vec[j] doesn't overflow, define a weight vector. Otherwise,
2063// report that overflow appears. In the second case, test whether the
2064// the correctness of the new vector plays an important role
2065
2066  for (j=0; j<nRing; j++)
2067  {
2068    mpz_set_si(dcw, (*curr_weight)[j]);
2069    mpz_mul(s_nenner, t_nenner, dcw);
2070
2071    if( (*diff_weight)[j]>0)
2072    {
2073      mpz_mul_ui(s_zaehler, t_zaehler, (*diff_weight)[j]);
2074    }
2075    else
2076    {
2077      mpz_mul_ui(s_zaehler, t_zaehler, -(*diff_weight)[j]);
2078      mpz_neg(s_zaehler, s_zaehler);
2079    }
2080    mpz_add(sntz, s_nenner, s_zaehler);
2081    mpz_init_set(vec[j], sntz);
2082
2083#ifdef NEXT_VECTORS_CC
2084    Print("\n//   j = %d ==> ", j);
2085    PrintS("(");
2086    mpz_out_str( stdout, 10, t_nenner);
2087    Print(" * %d)", (*curr_weight)[j]);
2088    PrintS(" + ("); mpz_out_str( stdout, 10, t_zaehler);
2089    Print(" * %d) =  ",  (*diff_weight)[j]);
2090    mpz_out_str( stdout, 10, s_nenner);
2091    PrintS(" + ");
2092    mpz_out_str( stdout, 10, s_zaehler);
2093    PrintS(" = "); mpz_out_str( stdout, 10, sntz);
2094    Print(" ==> vector[%d]: ", j); mpz_out_str(stdout, 10, vec[j]);
2095#endif
2096
2097    if(j==0)
2098    {
2099      mpz_set(ggt, sntz);
2100    }
2101    else
2102    {
2103      if(mpz_cmp_si(ggt,1) != 0)
2104      {
2105        mpz_gcd(ggt, ggt, sntz);
2106      }
2107    }
2108  }
2109  // reduce the vector with the gcd
2110  if(mpz_cmp_si(ggt,1) != 0)
2111  {
2112    for (j=0; j<nRing; j++)
2113    {
2114      mpz_divexact(vec[j], vec[j], ggt);
2115    }
2116  }
2117#ifdef  NEXT_VECTORS_CC
2118  PrintS("\n// gcd of elements of the vector: ");
2119  mpz_out_str( stdout, 10, ggt);
2120#endif
2121
2122  for(j=0; j<nRing; j++)
2123  {
2124    if(mpz_cmp(vec[j], sing_int_half) >= 0)
2125    {
2126      goto REDUCTION;
2127    }
2128  }
2129  checkRed = 1;
2130  for (j=0; j<nRing; j++)
2131    {
2132      (*diff_weight)[j] = mpz_get_si(vec[j]);
2133    }
2134  goto SIMPLIFY_GCD;
2135
2136  REDUCTION:
2137  checkRed = 1;
2138  for (j=0; j<nRing; j++)
2139  {
2140    (*diff_weight1)[j] = mpz_get_si(vec[j]);
2141  }
2142  while(test_w_in_ConeCC(G,diff_weight1))
2143  {
2144    for(j=0; j<nRing; j++)
2145    {
2146      (*diff_weight)[j] = (*diff_weight1)[j];
2147      mpz_set_si(vec[j], (*diff_weight)[j]);
2148    }
2149    for(j=0; j<nRing; j++)
2150    {
2151      (*diff_weight1)[j] = floor(0.1*(*diff_weight)[j] + 0.5);
2152    }
2153  }
2154  if(MivAbsMax(diff_weight)>10000)
2155  {
2156    for(j=0; j<nRing; j++)
2157    {
2158      (*diff_weight1)[j] = (*diff_weight)[j];
2159    }
2160    j = 0;
2161    while(test_w_in_ConeCC(G,diff_weight1))
2162    {
2163      (*diff_weight)[j] = (*diff_weight1)[j];
2164      mpz_set_si(vec[j], (*diff_weight)[j]);
2165      j = MivAbsMaxArg(diff_weight1);
2166      (*diff_weight1)[j] = floor(0.1*(*diff_weight1)[j] + 0.5);
2167    }
2168    goto SIMPLIFY_GCD;
2169  }
2170
2171 TEST_OVERFLOW:
2172
2173  for (j=0; j<nRing; j++)
2174  {
2175    if(mpz_cmp(vec[j], sing_int)>=0)
2176    {
2177      if(Overflow_Error == FALSE)
2178      {
2179        Overflow_Error = TRUE;
2180        PrintS("\n// ** OVERFLOW in \"MwalkNextWeightCC\": ");
2181        mpz_out_str( stdout, 10, vec[j]);
2182        PrintS(" is greater than 2147483647 (max. integer representation)\n");
2183        //Print("//  So vector[%d] := %d is wrong!!\n",j+1, vec[j]);// vec[j] is mpz_t
2184      }
2185    }
2186  }
2187
2188 FINISH:
2189   delete diff_weight1;
2190   mpz_clear(t_zaehler);
2191   mpz_clear(t_nenner);
2192   mpz_clear(s_zaehler);
2193   mpz_clear(s_nenner);
2194   mpz_clear(sntz);
2195   mpz_clear(sztn);
2196   mpz_clear(temp);
2197   mpz_clear(MwWd);
2198   mpz_clear(deg_w0_p1);
2199   mpz_clear(deg_d0_p1);
2200   mpz_clear(ggt);
2201   omFree(vec);
2202   mpz_clear(sing_int_half);
2203   mpz_clear(sing_int);
2204   mpz_clear(dcw);
2205   mpz_clear(t_null);
2206
2207  if(Overflow_Error == FALSE)
2208  {
2209    Overflow_Error = nError;
2210  }
2211  rComplete(currRing);
2212  for(j=0; j<IDELEMS(G); j++)
2213  {
2214    poly p=G->m[j];
2215    while(p!=NULL)
2216    {
2217      p_Setm(p,currRing);
2218      pIter(p);
2219    }
2220  }
2221return diff_weight;
2222}
2223*/
2224/**********************************************************************
2225 * Compute a next weight vector between curr_weight and target_weight *
2226 * with respect to an ideal <G>.                                      *
2227**********************************************************************/
2228static intvec* MwalkNextWeightCC(intvec* curr_weight, intvec* target_weight,
2229                                 ideal G)
2230{
2231  BOOLEAN nError = Overflow_Error;
2232  Overflow_Error = FALSE;
2233
2234  assume(currRing != NULL && curr_weight != NULL &&
2235         target_weight != NULL && G != NULL);
2236
2237  int nRing = currRing->N;
2238  int j, nG = IDELEMS(G);
2239  intvec* ivtemp;
2240
2241  mpz_t t_zaehler, t_nenner;
2242  mpz_init(t_zaehler);
2243  mpz_init(t_nenner);
2244
2245  mpz_t s_zaehler, s_nenner, temp, MwWd;
2246  mpz_init(s_zaehler);
2247  mpz_init(s_nenner);
2248  mpz_init(temp);
2249  mpz_init(MwWd);
2250
2251  mpz_t sing_int;
2252  mpz_init(sing_int);
2253  mpz_set_ui(sing_int,  2147483647);
2254
2255  mpz_t sing_int_half;
2256  mpz_init(sing_int_half);
2257  mpz_set_ui(sing_int_half,  3*(1073741824/2));
2258
2259  mpz_t deg_w0_p1, deg_d0_p1;
2260  mpz_init(deg_w0_p1);
2261  mpz_init(deg_d0_p1);
2262
2263  mpz_t sztn, sntz;
2264  mpz_init(sztn);
2265  mpz_init(sntz);
2266
2267  mpz_t t_null;
2268  mpz_init(t_null);
2269
2270  mpz_t ggt;
2271  mpz_init(ggt);
2272
2273  mpz_t dcw;
2274  mpz_init(dcw);
2275
2276  int gcd_tmp;
2277  //intvec* diff_weight = MivSub(target_weight, curr_weight);
2278
2279  intvec* diff_weight1 = new intvec(nRing); //MivSub(target_weight, curr_weight);
2280  poly g;
2281
2282  // reduce the size of the entries of the current weight vector
2283  if(TEST_OPT_REDSB)
2284  {
2285    for (j=0; j<nRing; j++)
2286    {
2287      (*diff_weight1)[j] = (*curr_weight)[j];
2288    }
2289    while(MivAbsMax(diff_weight1)>10000 && test_w_in_ConeCC(G,diff_weight1)==1)
2290    {
2291      for(j=0; j<nRing; j++)
2292      {
2293        (*curr_weight)[j] = (*diff_weight1)[j];
2294      }
2295      for(j=0; j<nRing; j++)
2296      {
2297        (*diff_weight1)[j] = ((*diff_weight1)[j] + 5) / 10;
2298      }
2299    }
2300
2301    if(MivAbsMax(curr_weight)>100000)
2302    {
2303      for(j=0; j<nRing; j++)
2304      {
2305        (*diff_weight1)[j] = (*curr_weight)[j];
2306      }
2307      j = 0;
2308      while(test_w_in_ConeCC(G,diff_weight1)==1 && MivAbsMax(diff_weight1)>1000)
2309      {
2310        (*curr_weight)[j] = (*diff_weight1)[j];
2311        j = MivAbsMaxArg(diff_weight1);
2312        (*diff_weight1)[j] = ((*diff_weight1)[j] + 5) / 10;
2313      }
2314    }
2315
2316  }
2317  intvec* diff_weight = MivSub(target_weight, curr_weight);
2318
2319  // compute a suitable next weight vector
2320  for (j=0; j<nG; j++)
2321  {
2322    g = G->m[j];
2323    if (g != NULL)
2324    {
2325      ivtemp = MExpPol(g);
2326      mpz_set_si(deg_w0_p1, MivDotProduct(ivtemp, curr_weight));
2327      mpz_set_si(deg_d0_p1, MivDotProduct(ivtemp, diff_weight));
2328      delete ivtemp;
2329
2330      pIter(g);
2331      while (g != NULL)
2332      {
2333        ivtemp = MExpPol(g);
2334        mpz_set_si(MwWd, MivDotProduct(ivtemp, curr_weight));
2335        mpz_sub(s_zaehler, deg_w0_p1, MwWd);
2336        if(mpz_cmp(s_zaehler, t_null) != 0)
2337        {
2338          mpz_set_si(MwWd, MivDotProduct(ivtemp, diff_weight));
2339          mpz_sub(s_nenner, MwWd, deg_d0_p1);
2340          // check for 0 < s <= 1
2341          if( (mpz_cmp(s_zaehler,t_null) > 0 &&
2342               mpz_cmp(s_nenner, s_zaehler)>=0) ||
2343              (mpz_cmp(s_zaehler, t_null) < 0 &&
2344               mpz_cmp(s_nenner, s_zaehler)<=0))
2345          {
2346            // make both positive
2347            if (mpz_cmp(s_zaehler, t_null) < 0)
2348            {
2349              mpz_neg(s_zaehler, s_zaehler);
2350              mpz_neg(s_nenner, s_nenner);
2351            }
2352
2353            //compute a simple fraction of s
2354            cancel(s_zaehler, s_nenner);
2355
2356            if(mpz_cmp(t_nenner, t_null) != 0)
2357            {
2358              mpz_mul(sztn, s_zaehler, t_nenner);
2359              mpz_mul(sntz, s_nenner, t_zaehler);
2360
2361              if(mpz_cmp(sztn,sntz) < 0)
2362              {
2363                mpz_add(t_nenner, t_null, s_nenner);
2364                mpz_add(t_zaehler,t_null, s_zaehler);
2365              }
2366            }
2367            else
2368            {
2369              mpz_add(t_nenner, t_null, s_nenner);
2370              mpz_add(t_zaehler,t_null, s_zaehler);
2371            }
2372          }
2373        }
2374        pIter(g);
2375        delete ivtemp;
2376      }
2377    }
2378  }
2379  //Print("\n// Alloc Size = %d \n", nRing*sizeof(mpz_t));
2380  mpz_t *vec=(mpz_t*)omAlloc(nRing*sizeof(mpz_t));
2381
2382
2383  // there is no 0<t<1 and define the next weight vector that is equal
2384  // to the current weight vector
2385  if(mpz_cmp(t_nenner, t_null) == 0)
2386  {
2387#ifndef SING_NDEBUG
2388    PrintS("\n//MwalkNextWeightCC: t_nenner=0\n");
2389#endif
2390    delete diff_weight;
2391    diff_weight = ivCopy(curr_weight);//take memory
2392    goto FINISH;
2393  }
2394
2395  // define the target vector as the next weight vector, if t = 1
2396  if(mpz_cmp_si(t_nenner, 1)==0 && mpz_cmp_si(t_zaehler,1)==0)
2397  {
2398    delete diff_weight;
2399    diff_weight = ivCopy(target_weight); //this takes memory
2400    goto FINISH;
2401  }
2402
2403  SIMPLIFY_GCD:
2404
2405  // simplify the vectors curr_weight and diff_weight (C-int)
2406  gcd_tmp = (*curr_weight)[0];
2407
2408  for (j=1; j<nRing; j++)
2409  {
2410    gcd_tmp = gcd(gcd_tmp, (*curr_weight)[j]);
2411    if(gcd_tmp == 1)
2412    {
2413      break;
2414    }
2415  }
2416  if(gcd_tmp != 1)
2417  {
2418    for (j=0; j<nRing; j++)
2419    {
2420      gcd_tmp = gcd(gcd_tmp, (*diff_weight)[j]);
2421      if(gcd_tmp == 1)
2422      {
2423        break;
2424      }
2425    }
2426  }
2427  if(gcd_tmp != 1)
2428  {
2429    for (j=0; j<nRing; j++)
2430    {
2431      (*curr_weight)[j] =  (*curr_weight)[j]/gcd_tmp;
2432      (*diff_weight)[j] =  (*diff_weight)[j]/gcd_tmp;
2433    }
2434  }
2435
2436#ifdef  NEXT_VECTORS_CC
2437  Print("\n// gcd of the weight vectors (current and target) = %d", gcd_tmp);
2438  ivString(curr_weight, "new cw");
2439  ivString(diff_weight, "new dw");
2440
2441  PrintS("\n// t_zaehler: ");  mpz_out_str( stdout, 10, t_zaehler);
2442  PrintS(", t_nenner: ");  mpz_out_str( stdout, 10, t_nenner);
2443#endif
2444
2445// construct a new weight vector and check whether vec[j] is overflow, i.e. vec[j] > 2^31.
2446// If vec[j] doesn't overflow, define a weight vector. Otherwise, report that overflow
2447// appears. In the second case, test whether the the correctness of the new vector plays
2448// an important role
2449
2450  for (j=0; j<nRing; j++)
2451  {
2452    mpz_set_si(dcw, (*curr_weight)[j]);
2453    mpz_mul(s_nenner, t_nenner, dcw);
2454
2455    if( (*diff_weight)[j]>0)
2456    {
2457      mpz_mul_ui(s_zaehler, t_zaehler, (*diff_weight)[j]);
2458    }
2459    else
2460    {
2461      mpz_mul_ui(s_zaehler, t_zaehler, -(*diff_weight)[j]);
2462      mpz_neg(s_zaehler, s_zaehler);
2463    }
2464    mpz_add(sntz, s_nenner, s_zaehler);
2465    mpz_init_set(vec[j], sntz);
2466
2467#ifdef NEXT_VECTORS_CC
2468    Print("\n//   j = %d ==> ", j);
2469    PrintS("(");
2470    mpz_out_str( stdout, 10, t_nenner);
2471    Print(" * %d)", (*curr_weight)[j]);
2472    PrintS(" + ("); mpz_out_str( stdout, 10, t_zaehler);
2473    Print(" * %d) =  ",  (*diff_weight)[j]);
2474    mpz_out_str( stdout, 10, s_nenner);
2475    PrintS(" + ");
2476    mpz_out_str( stdout, 10, s_zaehler);
2477    PrintS(" = "); mpz_out_str( stdout, 10, sntz);
2478    Print(" ==> vector[%d]: ", j); mpz_out_str(stdout, 10, vec[j]);
2479#endif
2480
2481    if(j==0)
2482    {
2483      mpz_set(ggt, sntz);
2484    }
2485    else
2486    {
2487      if(mpz_cmp_si(ggt,1) != 0)
2488      {
2489        mpz_gcd(ggt, ggt, sntz);
2490      }
2491    }
2492  }
2493  // reduce the vector with the gcd
2494  if(mpz_cmp_si(ggt,1) != 0)
2495  {
2496    for (j=0; j<nRing; j++)
2497    {
2498      mpz_divexact(vec[j], vec[j], ggt);
2499    }
2500  }
2501#ifdef  NEXT_VECTORS_CC
2502  PrintS("\n// gcd of elements of the vector: ");
2503  mpz_out_str( stdout, 10, ggt);
2504#endif
2505
2506  for (j=0; j<nRing; j++)
2507  {
2508    (*diff_weight)[j] = mpz_get_si(vec[j]);
2509  }
2510
2511 TEST_OVERFLOW:
2512
2513  for (j=0; j<nRing; j++)
2514  {
2515    if(mpz_cmp(vec[j], sing_int)>=0)
2516    {
2517      if(Overflow_Error == FALSE)
2518      {
2519        Overflow_Error = TRUE;
2520        PrintS("\n// ** OVERFLOW in \"MwalkNextWeightCC\": ");
2521        mpz_out_str( stdout, 10, vec[j]);
2522        PrintS(" is greater than 2147483647 (max. integer representation)\n");
2523        //Print("//  So vector[%d] := %d is wrong!!\n",j+1, vec[j]);// vec[j] is mpz_t
2524      }
2525    }
2526  }
2527
2528 FINISH:
2529   delete diff_weight1;
2530   mpz_clear(t_zaehler);
2531   mpz_clear(t_nenner);
2532   mpz_clear(s_zaehler);
2533   mpz_clear(s_nenner);
2534   mpz_clear(sntz);
2535   mpz_clear(sztn);
2536   mpz_clear(temp);
2537   mpz_clear(MwWd);
2538   mpz_clear(deg_w0_p1);
2539   mpz_clear(deg_d0_p1);
2540   mpz_clear(ggt);
2541   omFree(vec);
2542   mpz_clear(sing_int_half);
2543   mpz_clear(sing_int);
2544   mpz_clear(dcw);
2545   mpz_clear(t_null);
2546
2547  if(Overflow_Error == FALSE)
2548  {
2549    Overflow_Error = nError;
2550  }
2551  rComplete(currRing);
2552  for(j=0; j<IDELEMS(G); j++)
2553  {
2554    poly p=G->m[j];
2555    while(p!=NULL)
2556    {
2557      p_Setm(p,currRing);
2558      pIter(p);
2559    }
2560  }
2561return diff_weight;
2562}
2563
2564
2565/**********************************************************************
2566* Compute an intermediate weight vector from iva to ivb w.r.t.        *
2567* the reduced Groebner basis G.                                       *
2568* Return NULL, if it is equal to iva or iva = avb.                    *
2569**********************************************************************/
2570intvec* MkInterRedNextWeight(intvec* iva, intvec* ivb, ideal G)
2571{
2572  intvec* tmp = new intvec(iva->length());
2573  intvec* result;
2574
2575  if(G == NULL)
2576  {
2577    return tmp;
2578  }
2579  if(MivComp(iva, ivb) == 1)
2580  {
2581    return tmp;
2582  }
2583  result = MwalkNextWeightCC(iva, ivb, G);
2584
2585  if(MivComp(result, iva) == 1)
2586  {
2587    delete result;
2588    return tmp;
2589  }
2590
2591  delete tmp;
2592  return result;
2593}
2594
2595/********************************************************************
2596 * define and execute a new ring which order is (a(vb),a(va),lp,C)  *
2597 * ******************************************************************/
2598/*static ring VMrHomogeneous(intvec* va, intvec* vb)
2599{
2600
2601  if ((currRing->ppNoether)!=NULL)
2602  {
2603    pDelete(&(currRing->ppNoether));
2604  }
2605  if (((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING)) ||
2606      ((sLastPrinted.rtyp==LIST_CMD)&&(lRingDependend((lists)sLastPrinted.data))))
2607  {
2608    sLastPrinted.CleanUp();
2609  }
2610
2611  ring r = (ring) omAlloc0Bin(sip_sring_bin);
2612  int i, nv = currRing->N;
2613
2614  r->cf  = currRing->cf;
2615  r->N   = currRing->N;
2616  int nb = 4;
2617
2618
2619  //names
2620  char* Q; // In order to avoid the corrupted memory, do not change.
2621  r->names = (char **) omAlloc0(nv * sizeof(char_ptr));
2622  for(i=0; i<nv; i++)
2623  {
2624    Q = currRing->names[i];
2625    r->names[i]  = omStrDup(Q);
2626  }
2627
2628  //weights: entries for 3 blocks: NULL Made:???
2629  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
2630  r->wvhdl[0] = (int*) omAlloc(nv*sizeof(int));
2631  r->wvhdl[1] = (int*) omAlloc((nv)*sizeof(int));
2632
2633  for(i=0; i<nv; i++)
2634  {
2635    r->wvhdl[1][i] = (*vb)[i];
2636    r->wvhdl[0][i] = (*va)[i];
2637  }
2638  r->wvhdl[0][nv] = (*va)[nv];
2639
2640  // order: (1..1),a,lp,C
2641  r->order = (int *) omAlloc(nb * sizeof(int *));
2642  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
2643  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
2644
2645  // ringorder a for the first block: var 1..nv
2646  r->order[0]  = ringorder_a;
2647  r->block0[0] = 1;
2648  r->block1[0] = nv;
2649
2650 // ringorder a for the second block: var 2..nv
2651  r->order[1]  = ringorder_a;
2652  r->block0[1] = 1;
2653  r->block1[1] = nv;
2654
2655  // ringorder lp for the third block: var 2..nv
2656  r->order[2]  = ringorder_lp;
2657  r->block0[2] = 1;
2658  r->block1[2] = nv;
2659
2660  // ringorder C for the 4th block
2661  // it is very important within "idLift",
2662  // especially, by ring syz_ring=rCurrRingAssure_SyzComp();
2663  // therefore, nb  must be (nBlocks(currRing)  + 1)
2664  r->order[3]  = ringorder_C;
2665
2666  // polynomial ring
2667  r->OrdSgn    = 1;
2668
2669  // complete ring intializations
2670
2671  rComplete(r);
2672  return r;
2673  //rChangeCurrRing(r);
2674}
2675*/
2676
2677/**************************************************************
2678 * define and execute a new ring which order is (a(va),lp,C)  *
2679 * ************************************************************/
2680static ring VMrDefault(intvec* va)
2681{
2682
2683  ring r = rCopy0(currRing,FALSE,FALSE);
2684  int i, nv = currRing->N;
2685
2686  int nb = 4;
2687
2688  /*weights: entries for 3 blocks: NULL Made:???*/
2689  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
2690  r->wvhdl[0] = (int*) omAlloc(nv*sizeof(int));
2691  for(i=0; i<nv; i++)
2692    r->wvhdl[0][i] = (*va)[i];
2693
2694  /* order: a,lp,C,0 */
2695  r->order = (rRingOrder_t *) omAlloc(nb * sizeof(rRingOrder_t *));
2696  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
2697  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
2698
2699  // ringorder a for the first block: var 1..nv
2700  r->order[0]  = ringorder_a;
2701  r->block0[0] = 1;
2702  r->block1[0] = nv;
2703
2704  // ringorder lp for the second block: var 1..nv
2705  r->order[1]  = ringorder_lp;
2706  r->block0[1] = 1;
2707  r->block1[1] = nv;
2708
2709  // ringorder C for the third block
2710  // it is very important within "idLift",
2711  // especially, by ring syz_ring=rCurrRingAssure_SyzComp();
2712  // therefore, nb  must be (nBlocks(currRing)  + 1)
2713  r->order[2]  = ringorder_C;
2714
2715  // the last block: everything is 0
2716  r->order[3]  = (rRingOrder_t)0;
2717
2718  // polynomial ring
2719  r->OrdSgn    = 1;
2720
2721  // complete ring intializations
2722
2723  rComplete(r);
2724  return r;
2725  //rChangeCurrRing(r);
2726}
2727
2728/****************************************************************
2729 * define and execute a new ring with ordering (a(va),Wp(vb),C) *
2730 * **************************************************************/
2731static ring VMrRefine(intvec* va, intvec* vb)
2732{
2733
2734  ring r = rCopy0(currRing,FALSE,FALSE);
2735  int i, nv = currRing->N;
2736
2737  int nb = 5;
2738
2739  //weights: entries for 3 blocks: NULL Made:???
2740  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
2741  r->wvhdl[0] = (int*) omAlloc(nv*sizeof(int));
2742  r->wvhdl[1] = (int*) omAlloc(nv*sizeof(int));
2743
2744  for(i=0; i<nv; i++)
2745  {
2746    r->wvhdl[0][i] = (*vb)[i];
2747    r->wvhdl[1][i] = (*va)[i];
2748  }
2749
2750  // order: (1..1),a,lp,C
2751  r->order = (rRingOrder_t *) omAlloc(nb * sizeof(rRingOrder_t *));
2752  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
2753  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
2754
2755  // ringorder a for the first block: var 1..nv
2756  r->order[0]  = ringorder_a;
2757  r->block0[0] = 1;
2758  r->block1[0] = nv;
2759
2760 // ringorder Wp for the second block: var 1..nv
2761  r->order[1]  = ringorder_a;
2762  r->block0[1] = 1;
2763  r->block1[1] = nv;
2764
2765  // ringorder lp for the third block: var 1..nv
2766  r->order[2]  = ringorder_lp;
2767  r->block0[2] = 1;
2768  r->block1[2] = nv;
2769
2770  // ringorder C for the 4th block
2771  // it is very important within "idLift",
2772  // especially, by ring syz_ring=rCurrRingAssure_SyzComp();
2773  // therefore, nb  must be (nBlocks(currRing)  + 1)
2774  r->order[3]  = ringorder_C;
2775
2776  // the last block: everything is 0
2777  r->order[4]  = (rRingOrder_t)0;
2778
2779  // complete ring intializations
2780
2781  rComplete(r);
2782
2783  //rChangeCurrRing(r);
2784  return r;
2785}
2786
2787/*****************************************************
2788 * define and execute a new ring with ordering (M,C) *
2789 *****************************************************/
2790static ring VMatrDefault(intvec* va)
2791{
2792
2793  ring r = rCopy0(currRing,FALSE,FALSE);
2794  int i, nv = currRing->N;
2795
2796  int nb = 4;
2797
2798  /*weights: entries for 3 blocks: NULL Made:???*/
2799  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
2800  r->wvhdl[0] = (int*) omAlloc(nv*nv*sizeof(int));
2801  r->wvhdl[1] =NULL; // (int*) omAlloc(nv*sizeof(int));
2802  r->wvhdl[2]=NULL;
2803  r->wvhdl[3]=NULL;
2804  for(i=0; i<nv*nv; i++)
2805    r->wvhdl[0][i] = (*va)[i];
2806
2807  /* order: a,lp,C,0 */
2808  r->order = (rRingOrder_t*) omAlloc(nb * sizeof(rRingOrder_t*));
2809  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
2810  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
2811
2812  // ringorder a for the first block: var 1..nv
2813  r->order[0]  = ringorder_M;
2814  r->block0[0] = 1;
2815  r->block1[0] = nv;
2816
2817  // ringorder C for the second block
2818  r->order[1]  = ringorder_C;
2819  r->block0[1] = 1;
2820  r->block1[1] = nv;
2821
2822// ringorder C for the third block: var 1..nv
2823  r->order[2]  = ringorder_C;
2824  r->block0[2] = 1;
2825  r->block1[2] = nv;
2826
2827  // the last block: everything is 0
2828  r->order[3]  = (rRingOrder_t)0;
2829
2830  // complete ring intializations
2831
2832  rComplete(r);
2833
2834  //rChangeCurrRing(r);
2835  return r;
2836}
2837
2838/***********************************************************
2839 * define and execute a new ring with ordering (a(vb),M,C) *
2840 ***********************************************************/
2841static ring VMatrRefine(intvec* va, intvec* vb)
2842{
2843
2844  ring r = rCopy0(currRing,FALSE,FALSE);
2845  int i, nv = currRing->N;
2846  int nvs = nv*nv;
2847
2848  int nb = 4;
2849
2850  /*weights: entries for 3 blocks: NULL Made:???*/
2851  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
2852  r->wvhdl[0] = (int*) omAlloc(nv*sizeof(int));
2853  r->wvhdl[1] = (int*) omAlloc(nvs*sizeof(int));
2854  r->wvhdl[2]=NULL;
2855  r->wvhdl[3]=NULL;
2856  for(i=0; i<nvs; i++)
2857  {
2858    r->wvhdl[1][i] = (*va)[i];
2859  }
2860  for(i=0; i<nv; i++)
2861  {
2862    r->wvhdl[0][i] = (*vb)[i];
2863  }
2864  /* order: a,lp,C,0 */
2865  r->order = (rRingOrder_t *) omAlloc(nb * sizeof(rRingOrder_t *));
2866  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
2867  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
2868
2869  // ringorder a for the first block: var 1..nv
2870  r->order[0]  = ringorder_a;
2871  r->block0[0] = 1;
2872  r->block1[0] = nv;
2873
2874  // ringorder M for the second block: var 1..nv
2875  r->order[1]  = ringorder_M;
2876  r->block0[1] = 1;
2877  r->block1[1] = nv;
2878
2879  // ringorder C for the third block: var 1..nv
2880  r->order[2]  = ringorder_C;
2881  r->block0[2] = 1;
2882  r->block1[2] = nv;
2883
2884  // the last block: everything is 0
2885  r->order[3]  = (rRingOrder_t)0;
2886
2887  // complete ring intializations
2888
2889  rComplete(r);
2890
2891  //rChangeCurrRing(r);
2892  return r;
2893}
2894
2895/**********************************************************************
2896* define and execute a new ring which order is  a lexicographic order *
2897***********************************************************************/
2898static void VMrDefaultlp(void)
2899{
2900  ring r = rCopy0(currRing,FALSE,FALSE);
2901  int nv = currRing->N;
2902
2903  int nb = rBlocks(currRing) + 1;
2904
2905  /*weights: entries for 3 blocks: NULL Made:???*/
2906
2907  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
2908
2909  /* order: lp,C,0 */
2910  r->order = (rRingOrder_t *) omAlloc(nb * sizeof(rRingOrder_t *));
2911  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
2912  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
2913
2914  /* ringorder lp for the first block: var 1..nv */
2915  r->order[0]  = ringorder_lp;
2916  r->block0[0] = 1;
2917  r->block1[0] = nv;
2918
2919  /* ringorder C for the second block */
2920  r->order[1]  = ringorder_C;
2921
2922  /* the last block: everything is 0 */
2923  r->order[2]  = (rRingOrder_t)0;
2924
2925  /*polynomial ring*/
2926  r->OrdSgn    = 1;
2927
2928  /* complete ring intializations */
2929
2930  rComplete(r);
2931
2932  rChangeCurrRing(r);
2933}
2934
2935/***************************************************
2936* define a ring with parameters und change to it   *
2937* DefRingPar and DefRingParlp corrupt still memory *
2938****************************************************/
2939static void DefRingPar(intvec* va)
2940{
2941  int nv = currRing->N;
2942  int nb = rBlocks(currRing) + 1;
2943
2944  ring res=rCopy0(currRing,FALSE,FALSE);
2945
2946  /*weights: entries for 3 blocks: NULL Made:???*/
2947  res->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
2948  res->wvhdl[0] = (int*) omAlloc(nv*sizeof(int));
2949  for(int i=0; i<nv; i++)
2950    res->wvhdl[0][i] = (*va)[i];
2951
2952  /* order: a,lp,C,0 */
2953
2954  res->order = (rRingOrder_t *) omAlloc(nb * sizeof(rRingOrder_t *));
2955  res->block0 = (int *)omAlloc0(nb * sizeof(int *));
2956  res->block1 = (int *)omAlloc0(nb * sizeof(int *));
2957
2958  // ringorder a for the first block: var 1..nv
2959  res->order[0]  = ringorder_a;
2960  res->block0[0] = 1;
2961  res->block1[0] = nv;
2962
2963  // ringorder lp for the second block: var 1..nv
2964  res->order[1]  = ringorder_lp;
2965  res->block0[1] = 1;
2966  res->block1[1] = nv;
2967
2968  // ringorder C for the third block
2969  // it is very important within "idLift",
2970  // especially, by ring syz_ring=rCurrRingAssure_SyzComp();
2971  // therefore, nb  must be (nBlocks(currRing)  + 1)
2972  res->order[2]  = ringorder_C;
2973
2974  // the last block: everything is 0
2975  res->order[3]  = (rRingOrder_t)0;
2976
2977  // polynomial ring
2978  res->OrdSgn    = 1;
2979
2980
2981  // complete ring intializations
2982  rComplete(res);
2983
2984  // execute the created ring
2985  rChangeCurrRing(res);
2986}
2987
2988static void DefRingParlp(void)
2989{
2990  int nv = currRing->N;
2991
2992  ring r=rCopy0(currRing,FALSE,FALSE);
2993
2994  int nb = rBlocks(currRing) + 1;
2995
2996  /*weights: entries for 3 blocks: NULL Made:???*/
2997
2998  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
2999
3000  /* order: lp,C,0 */
3001  r->order = (rRingOrder_t *) omAlloc(nb * sizeof(rRingOrder_t *));
3002  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
3003  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
3004
3005  /* ringorder lp for the first block: var 1..nv */
3006  r->order[0]  = ringorder_lp;
3007  r->block0[0] = 1;
3008  r->block1[0] = nv;
3009
3010  /* ringorder C for the second block */
3011  r->order[1]  = ringorder_C;
3012
3013  /* the last block: everything is 0 */
3014  r->order[2]  = (rRingOrder_t)0;
3015
3016  /*polynomial ring*/
3017  r->OrdSgn    = 1;
3018
3019
3020//   if (rParameter(currRing)!=NULL)
3021//   {
3022//     r->cf->extRing->qideal->m[0]=p_Copy(currRing->cf->extRing->qideal->m[0], currRing->cf->extRing);
3023//     int l=rPar(currRing);
3024//     r->cf->extRing->names=(char **)omAlloc(l*sizeof(char_ptr));
3025//
3026//     for(int i=l-1;i>=0;i--)
3027//     {
3028//       rParameter(r)[i]=omStrDup(rParameter(currRing)[i]);
3029//     }
3030//   }
3031
3032  // complete ring intializations
3033
3034  rComplete(r);
3035
3036  // execute the created ring
3037  rChangeCurrRing(r);
3038}
3039
3040/*************************************************************
3041 * check whether one or more components of a vector are zero *
3042 *************************************************************/
3043/* unused:
3044static int isNolVector(intvec* hilb)
3045{
3046  int i;
3047  for(i=hilb->length()-1; i>=0; i--)
3048  {
3049    if((* hilb)[i]==0)
3050    {
3051      return 1;
3052    }
3053  }
3054  return 0;
3055}
3056*/
3057
3058/*************************************************************
3059 * check whether one or more components of a vector are <= 0 *
3060 *************************************************************/
3061static int isNegNolVector(intvec* hilb)
3062{
3063  int i;
3064  for(i=hilb->length()-1; i>=0; i--)
3065  {
3066    if((* hilb)[i]<=0)
3067    {
3068      return 1;
3069    }
3070  }
3071  return 0;
3072}
3073
3074/**************************************************************************
3075* Gomega is the initial ideal of G w. r. t. the current weight vector     *
3076* curr_weight. Check whether curr_weight lies on a border of the Groebner *
3077* cone, i. e. check whether a monomial is divisible by a leading monomial *
3078***************************************************************************/
3079static ideal middleOfCone(ideal G, ideal Gomega)
3080{
3081  BOOLEAN middle = FALSE;
3082  int i,j,N = IDELEMS(Gomega);
3083  poly p,lm,factor1,factor2;
3084
3085  ideal Go = idCopy(G);
3086
3087  // check whether leading monomials of G and Gomega coincide
3088  // and return NULL if not
3089  for(i=0; i<N; i++)
3090  {
3091    if(!pIsConstant(pSub(pCopy(Gomega->m[i]),pCopy(pHead(G->m[i])))))
3092    {
3093      idDelete(&Go);
3094      return NULL;
3095    }
3096  }
3097  for(i=0; i<N; i++)
3098  {
3099    for(j=0; j<N; j++)
3100    {
3101      if(i!=j)
3102      {
3103        p = pCopy(Gomega->m[i]);
3104        lm = pCopy(Gomega->m[j]);
3105        pIter(p);
3106        while(p!=NULL)
3107        {
3108          if(pDivisibleBy(lm,p))
3109          {
3110            if(middle == FALSE)
3111            {
3112              middle = TRUE;
3113            }
3114            factor1 = singclap_pdivide(pHead(p),lm,currRing);
3115            factor2 = pMult(pCopy(factor1),pCopy(Go->m[j]));
3116            pDelete(&factor1);
3117            Go->m[i] = pAdd((Go->m[i]),pNeg(pCopy(factor2)));
3118            pDelete(&factor2);
3119          }
3120          pIter(p);
3121        }
3122        pDelete(&lm);
3123        pDelete(&p);
3124      }
3125    }
3126  }
3127
3128  if(middle == TRUE)
3129  {
3130    return Go;
3131  }
3132  idDelete(&Go);
3133  return NULL;
3134}
3135
3136/******************************  Februar 2002  ****************************
3137 * G is a Groebner basis w.r.t. (a(curr_weight),lp) and                   *
3138 * we compute a GB of <G> w.r.t. the lex. order by the perturbation walk  *
3139 * its perturbation degree is tp_deg                                      *
3140 * We call the following subfunction LastGB, if                           *
3141 * the computed intermediate weight vector or                             *
3142 * if the perturbed target weight vector does NOT lie n the correct cone  *
3143 **************************************************************************/
3144
3145static ideal LastGB(ideal G, intvec* curr_weight,int tp_deg)
3146{
3147  BOOLEAN nError = Overflow_Error;
3148  Overflow_Error = FALSE;
3149
3150  int i, nV = currRing->N;
3151  int nwalk=0, endwalks=0, nnwinC=1;
3152  int nlast = 0;
3153  ideal Gomega, M, F, Gomega1, Gomega2, M1,F1,result,ssG;
3154  ring newRing, oldRing, TargetRing;
3155  intvec* iv_M_lp;
3156  intvec* target_weight;
3157  intvec* iv_lp = Mivlp(nV); //define (1,0,...,0)
3158  intvec* pert_target_vector;
3159  intvec* ivNull = new intvec(nV);
3160  intvec* extra_curr_weight = new intvec(nV);
3161  intvec* next_weight;
3162
3163#ifndef  BUCHBERGER_ALG
3164  intvec* hilb_func;
3165#endif
3166
3167  // to avoid (1,0,...,0) as the target vector
3168  intvec* last_omega = new intvec(nV);
3169  for(i=nV-1; i>0; i--)
3170  {
3171    (*last_omega)[i] = 1;
3172  }
3173  (*last_omega)[0] = 10000;
3174
3175  ring EXXRing = currRing;
3176
3177  // compute a pertubed weight vector of the target weight vector
3178  if(tp_deg > 1 && tp_deg <= nV)
3179  {
3180    //..25.03.03 VMrDefaultlp();//    VMrDefault(target_weight);
3181    if (rParameter (currRing) != NULL)
3182    {
3183      DefRingParlp();
3184    }
3185    else
3186    {
3187      VMrDefaultlp();
3188    }
3189    TargetRing = currRing;
3190    ssG = idrMoveR(G,EXXRing,currRing);
3191    iv_M_lp = MivMatrixOrderlp(nV);
3192    //target_weight = MPertVectorslp(ssG, iv_M_lp, tp_deg);
3193    target_weight = MPertVectors(ssG, iv_M_lp, tp_deg);
3194    delete iv_M_lp;
3195    pert_target_vector = target_weight;
3196
3197    rChangeCurrRing(EXXRing);
3198    G = idrMoveR(ssG, TargetRing,currRing);
3199  }
3200  else
3201  {
3202    target_weight = Mivlp(nV);
3203  }
3204  //Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
3205
3206  while(1)
3207  {
3208    nwalk++;
3209    nstep++;
3210#ifdef TIME_TEST
3211    to=clock();
3212#endif
3213   // compute a next weight vector
3214    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
3215#ifdef TIME_TEST
3216    xtnw=xtnw+clock()-to;
3217#endif
3218
3219#ifdef PRINT_VECTORS
3220    MivString(curr_weight, target_weight, next_weight);
3221#endif
3222
3223    if(Overflow_Error == TRUE)
3224    {
3225      newRing = currRing;
3226      nnwinC = 0;
3227      if(tp_deg == 1)
3228      {
3229        nlast = 1;
3230      }
3231      delete next_weight;
3232
3233      //idElements(G, "G");
3234      //Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
3235
3236      break;
3237    }
3238
3239    if(MivComp(next_weight, ivNull) == 1)
3240    {
3241      //Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
3242      newRing = currRing;
3243      delete next_weight;
3244      break;
3245    }
3246
3247    if(MivComp(next_weight, target_weight) == 1)
3248      endwalks = 1;
3249
3250    for(i=nV-1; i>=0; i--)
3251    {
3252      (*extra_curr_weight)[i] = (*curr_weight)[i];
3253    }
3254    /* 06.11.01 NOT Changed */
3255    for(i=nV-1; i>=0; i--)
3256    {
3257      (*curr_weight)[i] = (*next_weight)[i];
3258    }
3259    oldRing = currRing;
3260#ifdef TIME_TEST
3261    to=clock();
3262#endif
3263    // compute an initial form ideal of <G> w.r.t. "curr_vector"
3264    Gomega = MwalkInitialForm(G, curr_weight);
3265#ifdef TIME_TEST
3266    xtif=xtif+clock()-to;
3267#endif
3268
3269#ifdef ENDWALKS
3270    if(endwalks == 1)
3271    {
3272      Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
3273/*
3274      idElements(Gomega, "Gw");
3275      headidString(Gomega, "Gw");
3276*/
3277    }
3278#endif
3279
3280#ifndef  BUCHBERGER_ALG
3281    if(isNolVector(curr_weight) == 0)
3282    {
3283      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
3284    }
3285    else
3286    {
3287      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
3288    }
3289#endif // BUCHBERGER_ALG
3290
3291    /* define a new ring that its ordering is "(a(curr_weight),lp) */
3292    //..25.03.03 VMrDefault(curr_weight);
3293    if (rParameter (currRing) != NULL)
3294    {
3295      DefRingPar(curr_weight);
3296    }
3297    else
3298    {
3299      rChangeCurrRing(VMrDefault(curr_weight));
3300    }
3301    newRing = currRing;
3302    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
3303
3304#ifdef TIME_TEST
3305    to=clock();
3306#endif
3307    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
3308#ifdef  BUCHBERGER_ALG
3309    M = MstdhomCC(Gomega1);
3310#else
3311    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
3312    delete hilb_func;
3313#endif // BUCHBERGER_ALG
3314#ifdef TIME_TEST
3315    xtstd=xtstd+clock()-to;
3316#endif
3317    /* change the ring to oldRing */
3318    rChangeCurrRing(oldRing);
3319    M1 =  idrMoveR(M, newRing,currRing);
3320    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
3321
3322#ifdef TIME_TEST
3323    to=clock();
3324#endif
3325    /* compute a reduced Groebner basis of <G> w.r.t. "newRing" */
3326    F = MLifttwoIdeal(Gomega2, M1, G);
3327#ifdef TIME_TEST
3328    xtlift=xtlift+clock()-to;
3329#endif
3330
3331    idDelete(&M1);
3332    idDelete(&G);
3333
3334    /* change the ring to newRing */
3335    rChangeCurrRing(newRing);
3336    F1 = idrMoveR(F, oldRing,currRing);
3337
3338#ifdef TIME_TEST
3339    to=clock();
3340#endif
3341    /* reduce the Groebner basis <G> w.r.t. new ring */
3342    G = kInterRedCC(F1, NULL);
3343#ifdef TIME_TEST
3344    xtred=xtred+clock()-to;
3345#endif
3346    idDelete(&F1);
3347
3348    if(endwalks == 1)
3349    {
3350      //Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
3351      break;
3352    }
3353
3354    delete next_weight;
3355  }//while
3356
3357  delete ivNull;
3358
3359  if(tp_deg != 1)
3360  {
3361    //..25.03.03 VMrDefaultlp();//define and execute the ring "lp"
3362    if (rParameter (currRing) != NULL)
3363    {
3364      DefRingParlp();
3365    }
3366    else
3367    {
3368      VMrDefaultlp();
3369    }
3370    F1 = idrMoveR(G, newRing,currRing);
3371
3372    if(nnwinC == 0 || test_w_in_ConeCC(F1, pert_target_vector) != 1)
3373    {
3374      oldRing = currRing;
3375      rChangeCurrRing(newRing);
3376      G = idrMoveR(F1, oldRing,currRing);
3377      Print("\n// takes %d steps and calls the recursion of level %d:",
3378             nwalk, tp_deg-1);
3379
3380      F1 = LastGB(G,curr_weight, tp_deg-1);
3381    }
3382
3383    TargetRing = currRing;
3384    rChangeCurrRing(EXXRing);
3385    result = idrMoveR(F1, TargetRing,currRing);
3386  }
3387  else
3388  {
3389    if(nlast == 1)
3390    {
3391      //OMEGA_OVERFLOW_LASTGB:
3392      /*
3393      if(MivSame(curr_weight, iv_lp) == 1)
3394        if (rParameter(currRing) != NULL)
3395          DefRingParlp();
3396        else
3397          VMrDefaultlp();
3398      else
3399        if (rParameter(currRing) != NULL)
3400          DefRingPar(curr_weight);
3401        else
3402          VMrDefault(curr_weight);
3403      */
3404
3405        //..25.03.03 VMrDefaultlp();//define and execute the ring "lp"
3406        if (rParameter (currRing) != NULL)
3407        {
3408          DefRingParlp();
3409        }
3410        else
3411        {
3412          VMrDefaultlp();
3413        }
3414
3415      F1 = idrMoveR(G, newRing,currRing);
3416      //Print("\n// Apply \"std\" in ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
3417
3418      G = MstdCC(F1);
3419      idDelete(&F1);
3420      newRing = currRing;
3421    }
3422
3423    rChangeCurrRing(EXXRing);
3424    result = idrMoveR(G, newRing,currRing);
3425  }
3426  delete target_weight;
3427  delete last_omega;
3428  delete iv_lp;
3429
3430  if(Overflow_Error == FALSE)
3431  {
3432    Overflow_Error = nError;
3433  }
3434  return(result);
3435}
3436
3437/**********************************************************
3438 * check whether a polynomial of G has least 4 monomials  *
3439 **********************************************************/
3440static int lengthpoly(ideal G)
3441{
3442  int i;
3443  for(i=IDELEMS(G)-1; i>=0; i--)
3444  {
3445    if((G->m[i]!=NULL) /* len >=0 */
3446       && (G->m[i]->next!=NULL) /* len >=1 */
3447       && (G->m[i]->next->next!=NULL) /* len >=2 */
3448       && (G->m[i]->next->next->next!=NULL) /* len >=3 */
3449       && (G->m[i]->next->next->next->next!=NULL) /* len >=4*/ )
3450    {
3451      return 1;
3452    }
3453  }
3454  return 0;
3455}
3456
3457/*****************************************
3458 * return maximal polynomial length of G *
3459 *****************************************/
3460static int maxlengthpoly(ideal G)
3461{
3462  int i,k,length=0;
3463  for(i=IDELEMS(G)-1; i>=0; i--)
3464  {
3465    k = pLength(G->m[i]);
3466    if(k>length)
3467    {
3468      length = k;
3469    }
3470  }
3471  return length;
3472}
3473
3474/*********************************************************
3475 * check whether a polynomial of G has least 2 monomials *
3476**********************************************************/
3477static int islengthpoly2(ideal G)
3478{
3479  int i;
3480  for(i=IDELEMS(G)-1; i>=0; i--)
3481  {
3482    if((G->m[i]!=NULL) /* len >=0 */
3483       && (G->m[i]->next!=NULL) /* len >=1 */
3484       && (G->m[i]->next->next!=NULL)) /* len >=2 */
3485    {
3486      return 1;
3487    }
3488  }
3489  return 0;
3490}
3491
3492
3493
3494/* Implementation of the improved Groebner walk algorithm which is written
3495   by Quoc-Nam Tran (2000).
3496   One perturbs the original target weight vector, only if
3497   the next intermediate weight vector is equal to the current target weight
3498   vector. This must be repeated until the wanted reduced Groebner basis
3499   to reach.
3500   If the numbers of variables is big enough, the representation of the origin
3501   weight vector may be very big. Therefore, it is possible the intermediate
3502   weight vector doesn't stay in the correct Groebner cone.
3503   In this case we have just a reduced Groebner basis of the given ideal
3504   with respect to another monomial order. Then we have to compute
3505   a wanted reduced Groebner basis of it with respect to the given order.
3506   At the following subroutine we use the improved Buchberger algorithm or
3507   the changed perturbation walk algorithm with a decrased degree.
3508 */
3509
3510/***************************************
3511 * return the initial term of an ideal *
3512 ***************************************/
3513static ideal idHeadCC(ideal h)
3514{
3515  int i, nH =IDELEMS(h);
3516
3517  ideal m = idInit(nH,h->rank);
3518
3519  for (i=nH-1;i>=0; i--)
3520  {
3521    if (h->m[i]!=NULL)
3522    {
3523      m->m[i]=pHead(h->m[i]);
3524    }
3525  }
3526  return m;
3527}
3528
3529/**********************************************
3530 * check whether two head-ideals are the same *
3531 **********************************************/
3532static inline int test_G_GB_walk(ideal H0, ideal H1)
3533{
3534  int i, nG = IDELEMS(H0);
3535
3536  if(nG != IDELEMS(H1))
3537  {
3538    return 0;
3539  }
3540  for(i=nG-1; i>=0; i--)
3541  {
3542/*
3543    poly t;
3544    if((t=pSub(pCopy(H0->m[i]), pCopy(H1->m[i]))) != NULL)
3545    {
3546      pDelete(&t);
3547      return 0;
3548    }
3549    pDelete(&t);
3550*/
3551    if(!pEqualPolys(H0->m[i],H1->m[i]))
3552    {
3553      return 0;
3554    }
3555  }
3556  return 1;
3557}
3558
3559//unused
3560/*****************************************************
3561 * find the maximal total degree of polynomials in G *
3562 *****************************************************/
3563/*
3564static int Trandegreebound(ideal G)
3565{
3566  int i, nG = IDELEMS(G);
3567  // int np=1;
3568  int nV = currRing->N;
3569  int degtmp, result = 0;
3570  intvec* ivUnit = Mivdp(nV);
3571
3572  for(i=nG-1; i>=0; i--)
3573  {
3574    // find the maximal total degree of the polynomial G[i]
3575    degtmp = MwalkWeightDegree(G->m[i], ivUnit);
3576    if(degtmp > result)
3577    {
3578      result = degtmp;
3579    }
3580  }
3581  delete ivUnit;
3582  return result;
3583}
3584*/
3585
3586//unused
3587/************************************************************************
3588 * perturb the weight vector iva w.r.t. the ideal G.                    *
3589 *  the monomial order of the current ring is the w_1 weight lex. order *
3590 *  define w := d^(n-1)w_1+ d^(n-2)w_2, ...+ dw_(n-1)+ w_n              *
3591 *  where d := 1 + max{totdeg(g):g in G}*m, or                          *
3592 *  d := (2*maxdeg*maxdeg + (nV+1)*maxdeg)*m;                           *
3593 ************************************************************************/
3594#if 0
3595static intvec* TranPertVector(ideal G, intvec* iva)
3596{
3597  BOOLEAN nError = Overflow_Error;
3598  Overflow_Error = FALSE;
3599
3600  int i, j;
3601  // int nG = IDELEMS(G);
3602  int nV = currRing->N;
3603
3604  // define the sequence which expresses the current monomial ordering
3605  // w_1 = iva; w_2 = (1,0,..,0); w_n = (0,...,0,1,0)
3606  intvec* ivMat = MivMatrixOrder(iva);
3607
3608  int  mtmp, m=(*iva)[0];
3609
3610  for(i=ivMat->length(); i>=0; i--)
3611  {
3612    mtmp = (*ivMat)[i];
3613    if(mtmp <0)
3614    {
3615      mtmp = -mtmp;
3616    }
3617    if(mtmp > m)
3618    {
3619      m = mtmp;
3620    }
3621  }
3622
3623  // define the maximal total degree of polynomials of G
3624  mpz_t ndeg;
3625  mpz_init(ndeg);
3626
3627 // 12 Juli 03
3628#ifndef UPPER_BOUND
3629  mpz_set_si(ndeg, Trandegreebound(G)+1);
3630#else
3631  mpz_t ztmp;
3632  mpz_init(ztmp);
3633
3634  mpz_t maxdeg;
3635  mpz_init_set_si(maxdeg, Trandegreebound(G));
3636
3637  //ndeg = (2*maxdeg*maxdeg + (nV+1)*maxdeg)*m;//Kalkbrenner (1999)
3638  mpz_pow_ui(ztmp, maxdeg, 2);
3639  mpz_mul_ui(ztmp, ztmp, 2);
3640  mpz_mul_ui(maxdeg, maxdeg, nV+1);
3641  mpz_add(ndeg, ztmp, maxdeg);
3642  mpz_mul_ui(ndeg, ndeg, m);
3643
3644  mpz_clear(ztmp);
3645
3646  //PrintS("\n// with the new upper degree bound (2d^2+(n+1)d)*m ");
3647  //Print("\n//         where d = %d, n = %d and bound = %d", maxdeg, nV, ndeg);
3648#endif //UPPER_BOUND
3649
3650#ifdef INVEPS_SMALL_IN_TRAN
3651  if(mpz_cmp_ui(ndeg, nV)>0 && nV > 3)
3652  {
3653    mpz_cdiv_q_ui(ndeg, ndeg, nV);
3654  }
3655 //PrintS("\n// choose the \"small\" inverse epsilon:");
3656 //mpz_out_str(stdout, 10, ndeg);
3657#endif
3658  VAR mpz_t deg_tmp;
3659  mpz_init_set(deg_tmp, ndeg);
3660
3661  VAR mpz_t *ivres=( mpz_t *) omAlloc(nV*sizeof(mpz_t));
3662  mpz_init_set_ui(ivres[nV-1],1);
3663
3664  for(i=nV-2; i>=0; i--)
3665  {
3666    mpz_init_set(ivres[i], deg_tmp);
3667    mpz_mul(deg_tmp, deg_tmp, ndeg);
3668  }
3669
3670  VAR mpz_t *ivtmp=(mpz_t *)omAlloc(nV*sizeof(mpz_t));
3671  for(i=0; i<nV; i++)
3672  {
3673    mpz_init(ivtmp[i]);
3674  }
3675  VAR mpz_t sing_int;
3676  mpz_init_set_ui(sing_int,  2147483647);
3677
3678  VAR intvec* repr_vector = new intvec(nV);
3679
3680  // define ivtmp := ndeg^(n-1).w_1 + ndeg^(n-2).w_2 + ... + w_n
3681  for(i=0; i<nV; i++)
3682  {
3683    for(j=0; j<nV; j++)
3684    {
3685      if( (*ivMat)[i*nV+j] >= 0 )
3686      {
3687        mpz_mul_ui(ivres[i], ivres[i], (*ivMat)[i*nV+j]);
3688      }
3689      else
3690      {
3691        mpz_mul_ui(ivres[i], ivres[i], -(*ivMat)[i*nV+j]);
3692        mpz_neg(ivres[i], ivres[i]);
3693      }
3694      mpz_add(ivtmp[j], ivtmp[j], ivres[i]);
3695    }
3696  }
3697  VAR delete ivMat;
3698
3699  VAR int ntrue=0;
3700  for(i=0; i<nV; i++)
3701  {
3702    (*repr_vector)[i] = mpz_get_si(ivtmp[i]);
3703    if(mpz_cmp(ivtmp[i], sing_int)>=0)
3704    {
3705      ntrue++;
3706      if(Overflow_Error == FALSE)
3707      {
3708        Overflow_Error = TRUE;
3709
3710        PrintS("\n// ** OVERFLOW in \"Repr.Vector\": ");
3711        mpz_out_str( stdout, 10, ivtmp[i]);
3712        PrintS(" is greater than 2147483647 (max. integer representation)");
3713        Print("\n//  So vector[%d] := %d is wrong!!\n",i+1,(*repr_vector)[i]);
3714      }
3715    }
3716  }
3717  if(Overflow_Error == TRUE)
3718  {
3719    ivString(repr_vector, "repvector");
3720    Print("\n// %d element(s) of it are overflow!!", ntrue);
3721  }
3722
3723  if(Overflow_Error == FALSE)
3724    Overflow_Error=nError;
3725
3726  omFree(ivres);
3727  omFree(ivtmp);
3728
3729  mpz_clear(sing_int);
3730  mpz_clear(deg_tmp);
3731  mpz_clear(ndeg);
3732
3733  VAR return repr_vector;
3734}
3735#endif
3736
3737//unused
3738#if 0
3739static intvec* TranPertVector_lp(ideal G)
3740{
3741  BOOLEAN nError = Overflow_Error;
3742  Overflow_Error = FALSE;
3743  // int j, nG = IDELEMS(G);
3744  int i;
3745  int nV = currRing->N;
3746
3747  // define the maximal total degree of polynomials of G
3748  mpz_t ndeg;
3749  mpz_init(ndeg);
3750
3751 // 12 Juli 03
3752#ifndef UPPER_BOUND
3753  mpz_set_si(ndeg, Trandegreebound(G)+1);
3754#else
3755  mpz_t ztmp;
3756  mpz_init(ztmp);
3757
3758  mpz_t maxdeg;
3759  mpz_init_set_si(maxdeg, Trandegreebound(G));
3760
3761  //ndeg = (2*maxdeg*maxdeg + (nV+1)*maxdeg);//Kalkbrenner (1999)
3762  mpz_pow_ui(ztmp, maxdeg, 2);
3763  mpz_mul_ui(ztmp, ztmp, 2);
3764  mpz_mul_ui(maxdeg, maxdeg, nV+1);
3765  mpz_add(ndeg, ztmp, maxdeg);
3766  // PrintS("\n// with the new upper degree bound (2d^2+(n+1)d)*m ");
3767  // Print("\n//         where d = %d, n = %d and bound = %d",
3768  // mpz_get_si(maxdeg), nV, mpz_get_si(ndeg));
3769
3770 mpz_clear(ztmp);
3771
3772#endif
3773
3774#ifdef INVEPS_SMALL_IN_TRAN
3775 if(mpz_cmp_ui(ndeg, nV)>0 && nV > 3)
3776    mpz_cdiv_q_ui(ndeg, ndeg, nV);
3777
3778 //PrintS("\n// choose the \"small\" inverse epsilon:");
3779 // mpz_out_str(stdout, 10, ndeg);
3780#endif
3781
3782  VAR mpz_t deg_tmp;
3783  mpz_init_set(deg_tmp, ndeg);
3784
3785  VAR mpz_t *ivres=(mpz_t *)omAlloc(nV*sizeof(mpz_t));
3786  mpz_init_set_ui(ivres[nV-1], 1);
3787
3788  for(i=nV-2; i>=0; i--)
3789  {
3790    mpz_init_set(ivres[i], deg_tmp);
3791    mpz_mul(deg_tmp, deg_tmp, ndeg);
3792  }
3793
3794  VAR mpz_t sing_int;
3795  mpz_init_set_ui(sing_int,  2147483647);
3796
3797  VAR intvec* repr_vector = new intvec(nV);
3798  VAR int ntrue=0;
3799  for(i=0; i<nV; i++)
3800  {
3801    (*repr_vector)[i] = mpz_get_si(ivres[i]);
3802
3803    if(mpz_cmp(ivres[i], sing_int)>=0)
3804    {
3805      ntrue++;
3806      if(Overflow_Error == FALSE)
3807      {
3808        Overflow_Error = TRUE;
3809        PrintS("\n// ** OVERFLOW in \"Repr.Vector\": ");
3810        mpz_out_str( stdout, 10, ivres[i]);
3811        PrintS(" is greater than 2147483647 (max. integer representation)");
3812        Print("\n//  So vector[%d] := %d is wrong!!\n",i+1,(*repr_vector)[i]);
3813      }
3814    }
3815  }
3816  if(Overflow_Error == TRUE)
3817  {
3818    ivString(repr_vector, "repvector");
3819    Print("\n// %d element(s) of it are overflow!!", ntrue);
3820  }
3821  if(Overflow_Error == FALSE)
3822    Overflow_Error = nError;
3823
3824  omFree(ivres);
3825
3826  mpz_clear(ndeg);
3827  mpz_clear(sing_int);
3828
3829  VAR return repr_vector;
3830}
3831#endif
3832
3833//unused
3834#if 0
3835static intvec* RepresentationMatrix_Dp(ideal G, intvec* M)
3836{
3837  BOOLEAN nError = Overflow_Error;
3838  Overflow_Error = FALSE;
3839
3840  int i, j;
3841  int nV = currRing->N;
3842
3843  intvec* ivUnit = Mivdp(nV);
3844  int degtmp, maxdeg = 0;
3845
3846  for(i=IDELEMS(G)-1; i>=0; i--)
3847  {
3848    // find the maximal total degree of the polynomial G[i]
3849    degtmp = MwalkWeightDegree(G->m[i], ivUnit);
3850    if(degtmp > maxdeg)
3851      maxdeg = degtmp;
3852  }
3853
3854  mpz_t ztmp;
3855  mpz_init_set_si(ztmp, maxdeg);
3856  mpz_t *ivres=(mpz_t *)omAlloc(nV*sizeof(mpz_t));
3857  mpz_init_set_ui(ivres[nV-1], 1); // (*ivres)[nV-1] = 1;
3858
3859  for(i=nV-2; i>=0; i--)
3860  {
3861    mpz_init_set(ivres[i], ztmp); //(*ivres)[i] = ztmp;
3862    mpz_mul_ui(ztmp, ztmp, maxdeg); //ztmp *=maxdeg;
3863  }
3864
3865  mpz_t *ivtmp=(mpz_t*)omAlloc(nV*sizeof(mpz_t));
3866  for(i=0; i<nV; i++)
3867    mpz_init(ivtmp[i]);
3868
3869  // define ivtmp := ndeg^(n-1).w_1 + ndeg^(n-2).w_2 + ... + w_n
3870  for(i=0; i<nV; i++)
3871    for(j=0; j<nV; j++)
3872    {
3873      if((*M)[i*nV+j] < 0)
3874      {
3875        mpz_mul_ui(ztmp, ivres[i], -(*M)[i*nV+j]);
3876        mpz_neg(ztmp, ztmp);
3877      }
3878      else
3879        mpz_mul_ui(ztmp, ivres[i], (*M)[i*nV+j]);
3880
3881      mpz_add(ivtmp[j], ivtmp[j], ztmp);
3882    }
3883  delete ivres;
3884  mpz_t sing_int;
3885  mpz_init_set_ui(sing_int,  2147483647);
3886
3887  int ntrue=0;
3888  intvec* repvector = new intvec(nV);
3889  for(i=0; i<nV; i++)
3890  {
3891    (*repvector)[i] = mpz_get_si(ivtmp[i]);
3892    if(mpz_cmp(ivtmp[i], sing_int)>0)
3893    {
3894      ntrue++;
3895      if(Overflow_Error == FALSE)
3896      {
3897        Overflow_Error = TRUE;
3898        PrintS("\n// ** OVERFLOW in \"Repr.Matrix\": ");
3899        mpz_out_str( stdout, 10, ivtmp[i]);
3900        PrintS(" is greater than 2147483647 (max. integer representation)");
3901        Print("\n//  So vector[%d] := %d is wrong!!\n",i+1,(*repvector)[i]);
3902      }
3903    }
3904  }
3905  if(Overflow_Error == TRUE)
3906  {
3907    ivString(repvector, "repvector");
3908    Print("\n// %d element(s) of it are overflow!!", ntrue);
3909  }
3910
3911  if(Overflow_Error == FALSE)
3912    Overflow_Error = nError;
3913
3914  mpz_clear(sing_int);
3915  mpz_clear(ztmp);
3916  omFree(ivtmp);
3917  omFree(ivres);
3918  return repvector;
3919}
3920#endif
3921
3922/*****************************************************************************
3923 * The following subroutine is the implementation of our first improved      *
3924 * Groebner walk algorithm, i.e. the first altervative algorithm.            *
3925 * First we use the Grobner walk algorithm and then we call the changed      *
3926 * perturbation walk algorithm with decreased degree, if an intermediate     *
3927 * weight vector is equal to the current target weight vector.               *
3928 * This call will be only repeated until we get the wanted reduced Groebner  *
3929 * basis or n times, where n is the numbers of variables.                    *
3930 *****************************************************************************/
3931
3932// npwinc = 0, if curr_weight doesn't stay in the correct Groebner cone
3933static ideal Rec_LastGB(ideal G, intvec* curr_weight,
3934                        intvec* orig_target_weight, int tp_deg, int npwinc)
3935{
3936  BOOLEAN nError = Overflow_Error;
3937  Overflow_Error = FALSE;
3938  // BOOLEAN nOverflow_Error = FALSE;
3939
3940#ifdef TIME_TEST
3941  clock_t tproc=0;
3942  clock_t tinput = clock();
3943#endif
3944
3945  int i,  nV = currRing->N;
3946  int nwalk=0, endwalks=0, nnwinC=1;
3947  int nlast = 0;
3948  ideal Gomega, M, F, Gomega1, Gomega2, M1,F1,result,ssG;
3949  ring newRing, oldRing, TargetRing;
3950  intvec* iv_M_lp;
3951  intvec* target_weight;
3952  intvec* ivNull = new intvec(nV); //define (0,...,0)
3953  ring EXXRing = currRing;
3954  //int NEG=0; //19 juni 03
3955  intvec* next_weight;
3956#ifndef  BUCHBERGER_ALG
3957  //08 Juli 03
3958  intvec* hilb_func;
3959#endif
3960  // to avoid (1,0,...,0) as the target vector
3961  intvec* last_omega = new intvec(nV);
3962  for(i=nV-1; i>0; i--)
3963    (*last_omega)[i] = 1;
3964  (*last_omega)[0] = 10000;
3965
3966  BOOLEAN isGB = FALSE;
3967
3968  // compute a pertubed weight vector of the target weight vector
3969  if(tp_deg > 1 && tp_deg <= nV)
3970  {
3971    ideal H0 = idHeadCC(G);
3972
3973    if (rParameter (currRing) != NULL)
3974    {
3975      DefRingParlp();
3976    }
3977    else
3978    {
3979      VMrDefaultlp();
3980    }
3981    TargetRing = currRing;
3982    ssG = idrMoveR(G,EXXRing,currRing);
3983
3984    ideal H0_tmp = idrMoveR(H0,EXXRing,currRing);
3985    ideal H1 = idHeadCC(ssG);
3986
3987    // Apply Lemma 2.2 in Collart et. al (1997) to check whether cone(k-1) is equal to cone(k)
3988    if(test_G_GB_walk(H0_tmp,H1)==1)
3989    {
3990      idDelete(&H0_tmp);
3991      idDelete(&H1);
3992      G = ssG;
3993      ssG = NULL;
3994      newRing = currRing;
3995      delete ivNull;
3996
3997      if(npwinc != 0)
3998      {
3999        goto LastGB_Finish;
4000      }
4001      else
4002      {
4003        isGB = TRUE;
4004        goto KSTD_Finish;
4005      }
4006    }
4007    idDelete(&H0_tmp);
4008    idDelete(&H1);
4009
4010    iv_M_lp = MivMatrixOrderlp(nV);
4011    target_weight  = MPertVectors(ssG, iv_M_lp, tp_deg);
4012    delete iv_M_lp;
4013    //PrintS("\n// Input is not GB!!");
4014    rChangeCurrRing(EXXRing);
4015    G = idrMoveR(ssG, TargetRing,currRing);
4016
4017    if(Overflow_Error == TRUE)
4018    {
4019      //nOverflow_Error = Overflow_Error;
4020      //NEG = 1;
4021      newRing = currRing;
4022      goto JUNI_STD;
4023    }
4024  }
4025
4026  while(1)
4027  {
4028    nwalk ++;
4029    nstep++;
4030
4031    if(nwalk==1)
4032    {
4033      goto FIRST_STEP;
4034    }
4035#ifdef TIME_TEST
4036    to=clock();
4037#endif
4038    // compute an initial form ideal of <G> w.r.t. "curr_vector"
4039    Gomega = MwalkInitialForm(G, curr_weight);
4040#ifdef TIME_TEST
4041    xtif=xtif+clock()-to;
4042#endif
4043
4044#ifndef  BUCHBERGER_ALG
4045    if(isNolVector(curr_weight) == 0)
4046    {
4047      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
4048    }
4049    else
4050    {
4051      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
4052    }
4053#endif // BUCHBERGER_ALG
4054
4055    oldRing = currRing;
4056
4057    // defiNe a new ring that its ordering is "(a(curr_weight),lp)
4058    if (rParameter(currRing) != NULL)
4059    {
4060      DefRingPar(curr_weight);
4061    }
4062    else
4063    {
4064      rChangeCurrRing(VMrDefault(curr_weight));
4065    }
4066    newRing = currRing;
4067    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
4068#ifdef TIME_TEST
4069    to=clock();
4070#endif
4071    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
4072#ifdef  BUCHBERGER_ALG
4073    M = MstdhomCC(Gomega1);
4074#else
4075    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
4076    delete hilb_func;
4077#endif // BUCHBERGER_ALG
4078#ifdef TIME_TEST
4079    xtstd=xtstd+clock()-to;
4080#endif
4081    // change the ring to oldRing
4082    rChangeCurrRing(oldRing);
4083    M1 =  idrMoveR(M, newRing,currRing);
4084    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
4085
4086#ifdef TIME_TEST
4087     to=clock();
4088#endif
4089    // compute a reduced Groebner basis of <G> w.r.t. "newRing" by the lifting process
4090    F = MLifttwoIdeal(Gomega2, M1, G);
4091#ifdef TIME_TEST
4092    xtlift=xtlift+clock()-to;
4093#endif
4094    idDelete(&M1);
4095    idDelete(&Gomega2);
4096    idDelete(&G);
4097
4098    // change the ring to newRing
4099    rChangeCurrRing(newRing);
4100    F1 = idrMoveR(F, oldRing,currRing);
4101
4102#ifdef TIME_TEST
4103    to=clock();
4104#endif
4105    // reduce the Groebner basis <G> w.r.t. new ring
4106    G = kInterRedCC(F1, NULL);
4107#ifdef TIME_TEST
4108    xtred=xtred+clock()-to;
4109#endif
4110    idDelete(&F1);
4111
4112    if(endwalks == 1)
4113    {
4114      break;
4115    }
4116  FIRST_STEP:
4117#ifdef TIME_TEST
4118    to=clock();
4119#endif
4120    Overflow_Error = FALSE;
4121    // compute a next weight vector
4122    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
4123#ifdef TIME_TEST
4124    xtnw=xtnw+clock()-to;
4125#endif
4126#ifdef PRINT_VECTORS
4127    MivString(curr_weight, target_weight, next_weight);
4128#endif
4129    if(Overflow_Error == TRUE)
4130    {
4131      //PrintS("\n// ** The next vector does NOT stay in Cone!!\n");
4132#ifdef TEST_OVERFLOW
4133      goto  LastGB_Finish;
4134#endif
4135
4136      nnwinC = 0;
4137      if(tp_deg == nV)
4138      {
4139        nlast = 1;
4140      }
4141      delete next_weight;
4142      break;
4143    }
4144
4145    if(MivComp(next_weight, ivNull) == 1)
4146    {
4147      //newRing = currRing;
4148      delete next_weight;
4149      break;
4150    }
4151
4152    if(MivComp(next_weight, target_weight) == 1)
4153    {
4154      if(tp_deg == nV)
4155      {
4156        endwalks = 1;
4157      }
4158      else
4159      {
4160        // REC_LAST_GB_ALT2:
4161        //nOverflow_Error = Overflow_Error;
4162#ifdef TIME_TEST
4163        tproc=tproc+clock()-tinput;
4164#endif
4165
4166        /*Print("\n// takes %d steps and calls \"Rec_LastGB\" (%d):",
4167        nwalk, tp_deg+1);
4168        */
4169        G = Rec_LastGB(G,curr_weight, orig_target_weight, tp_deg+1,nnwinC);
4170        newRing = currRing;
4171        delete next_weight;
4172        break;
4173      }
4174    }
4175
4176    for(i=nV-1; i>=0; i--)
4177    {
4178      (*curr_weight)[i] = (*next_weight)[i];
4179    }
4180    delete next_weight;
4181  }//while
4182
4183  delete ivNull;
4184
4185  if(tp_deg != nV)
4186  {
4187    newRing = currRing;
4188
4189    if (rParameter(currRing) != NULL)
4190    {
4191      DefRingParlp();
4192    }
4193    else
4194    {
4195      VMrDefaultlp();
4196    }
4197    F1 = idrMoveR(G, newRing,currRing);
4198
4199    if(nnwinC == 0 || test_w_in_ConeCC(F1, target_weight) != 1 )
4200    {
4201      // nOverflow_Error = Overflow_Error;
4202      //Print("\n//  takes %d steps and calls \"Rec_LastGB (%d):", tp_deg+1);
4203#ifdef TIME_TEST
4204      tproc=tproc+clock()-tinput;
4205#endif
4206      F1 = Rec_LastGB(F1,curr_weight, orig_target_weight, tp_deg+1,nnwinC);
4207    }
4208    delete target_weight;
4209
4210    TargetRing = currRing;
4211    rChangeCurrRing(EXXRing);
4212    result = idrMoveR(F1, TargetRing,currRing);
4213  }
4214  else
4215  {
4216    if(nlast == 1)
4217    {
4218      JUNI_STD:
4219
4220      newRing = currRing;
4221      if (rParameter(currRing) != NULL)
4222      {
4223        DefRingParlp();
4224      }
4225      else
4226      {
4227        VMrDefaultlp();
4228      }
4229      KSTD_Finish:
4230      if(isGB == FALSE)
4231      {
4232        F1 = idrMoveR(G, newRing,currRing);
4233      }
4234      else
4235      {
4236        F1 = G;
4237      }
4238#ifdef TIME_TEST
4239      to=clock();
4240#endif
4241      // Print("\n// apply the Buchberger's alg in ring = %s",rString(currRing));
4242      // idElements(F1, "F1");
4243      G = MstdCC(F1);
4244#ifdef TIME_TEST
4245      xtextra=xtextra+clock()-to;
4246#endif
4247
4248
4249      idDelete(&F1);
4250      newRing = currRing;
4251    }
4252
4253    LastGB_Finish:
4254    rChangeCurrRing(EXXRing);
4255    result = idrMoveR(G, newRing,currRing);
4256  }
4257
4258  if(Overflow_Error == FALSE)
4259    {
4260    Overflow_Error=nError;
4261    }
4262#ifdef TIME_TEST
4263   //Print("\n// \"Rec_LastGB\" (%d) took %d steps and %.2f sec.Overflow_Error (%d)", tp_deg, nwalk, ((double) tproc)/1000000, nOverflow_Error);
4264#endif
4265  return(result);
4266}
4267
4268/* The following subroutine is the implementation of our second improved
4269   Groebner walk algorithm, i.e. the second altervative algorithm.
4270   First we use the Grobner walk algorithm and then we call the changed
4271   perturbation walk algorithm with increased degree, if an intermediate
4272   weight vector is equal to the current target weight vector.
4273   This call will be only repeated until we get the wanted reduced Groebner
4274   basis or n times, where n is the numbers of variables.
4275*/
4276
4277/******************************
4278 * walk + recursive LastGB    *
4279 ******************************/
4280ideal MAltwalk2(ideal Go, intvec* curr_weight, intvec* target_weight)
4281{
4282  Set_Error(FALSE);
4283  Overflow_Error = FALSE;
4284  //BOOLEAN nOverflow_Error = FALSE;
4285  //Print("// pSetm_Error = (%d)", ErrorCheck());
4286#ifdef TIME_TEST
4287  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0; xtextra=0;
4288  xftinput = clock();
4289  clock_t tostd, tproc;
4290#endif
4291  nstep = 0;
4292  int i, nV = currRing->N;
4293  int nwalk=0, endwalks=0;
4294  // int nhilb = 1;
4295  ideal Gomega, M, F, Gomega1, Gomega2, M1, F1, G;
4296  //ideal  G1;
4297  //ring endRing;
4298  ring newRing, oldRing;
4299  intvec* ivNull = new intvec(nV);
4300  intvec* next_weight;
4301  //intvec* extra_curr_weight = new intvec(nV);
4302  //intvec* hilb_func;
4303  intvec* exivlp = Mivlp(nV);
4304  ring XXRing = currRing;
4305
4306  //Print("\n// ring r_input = %s;", rString(currRing));
4307#ifdef TIME_TEST
4308  to = clock();
4309#endif
4310  /* compute the reduced Groebner basis of the given ideal w.r.t.
4311     a "fast" monomial order, e.g. degree reverse lex. order (dp) */
4312  G = MstdCC(Go);
4313#ifdef TIME_TEST
4314  tostd=clock()-to;
4315
4316  Print("\n// Computation of the first std took = %.2f sec",
4317        ((double) tostd)/1000000);
4318#endif
4319  if(currRing->order[0] == ringorder_a)
4320  {
4321    goto NEXT_VECTOR;
4322  }
4323  while(1)
4324  {
4325    nwalk ++;
4326    nstep ++;
4327#ifdef TIME_TEST
4328    to = clock();
4329#endif
4330    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
4331    Gomega = MwalkInitialForm(G, curr_weight);
4332#ifdef TIME_TEST
4333    xtif=xtif+clock()-to;
4334#endif
4335/*
4336    if(Overflow_Error == TRUE)
4337    {
4338      for(i=nV-1; i>=0; i--)
4339        (*curr_weight)[i] = (*extra_curr_weight)[i];
4340      delete extra_curr_weight;
4341      goto LAST_GB_ALT2;
4342    }
4343*/
4344    oldRing = currRing;
4345
4346    /* define a new ring that its ordering is "(a(curr_weight),lp) */
4347    if (rParameter(currRing) != NULL)
4348    {
4349      DefRingPar(curr_weight);
4350    }
4351    else
4352    {
4353      rChangeCurrRing(VMrDefault(curr_weight));
4354    }
4355    newRing = currRing;
4356    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
4357#ifdef TIME_TEST
4358    to = clock();
4359#endif
4360    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
4361    M = MstdhomCC(Gomega1);
4362#ifdef TIME_TEST
4363    xtstd=xtstd+clock()-to;
4364#endif
4365    /* change the ring to oldRing */
4366    rChangeCurrRing(oldRing);
4367    M1 =  idrMoveR(M, newRing,currRing);
4368    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
4369#ifdef TIME_TEST
4370    to = clock();
4371#endif
4372    /* compute the reduced Groebner basis of <G> w.r.t. "newRing"
4373       by the liftig process */
4374    F = MLifttwoIdeal(Gomega2, M1, G);
4375#ifdef TIME_TEST
4376    xtlift=xtlift+clock()-to;
4377#endif
4378    idDelete(&M1);
4379    idDelete(&Gomega2);
4380    idDelete(&G);
4381
4382    /* change the ring to newRing */
4383    rChangeCurrRing(newRing);
4384    F1 = idrMoveR(F, oldRing,currRing);
4385#ifdef TIME_TEST
4386    to = clock();
4387#endif
4388    /* reduce the Groebner basis <G> w.r.t. newRing */
4389    G = kInterRedCC(F1, NULL);
4390#ifdef TIME_TEST
4391    xtred=xtred+clock()-to;
4392#endif
4393    idDelete(&F1);
4394
4395    if(endwalks == 1)
4396      break;
4397
4398  NEXT_VECTOR:
4399#ifdef TIME_TEST
4400    to = clock();
4401#endif
4402    /* compute a next weight vector */
4403    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
4404#ifdef TIME_TEST
4405    xtnw=xtnw+clock()-to;
4406#endif
4407#ifdef PRINT_VECTORS
4408    MivString(curr_weight, target_weight, next_weight);
4409#endif
4410
4411    if(Overflow_Error == TRUE)
4412    {
4413      /*
4414        ivString(next_weight, "omega");
4415        PrintS("\n// ** The weight vector does NOT stay in Cone!!\n");
4416      */
4417#ifdef TEST_OVERFLOW
4418      goto  TEST_OVERFLOW_OI;
4419#endif
4420
4421      newRing = currRing;
4422      if (rParameter(currRing) != NULL)
4423      {
4424        DefRingPar(target_weight);
4425      }
4426      else
4427      {
4428        rChangeCurrRing(VMrDefault(target_weight)); // Aenderung
4429      }
4430      F1 = idrMoveR(G, newRing,currRing);
4431      G = MstdCC(F1);
4432      idDelete(&F1);
4433      newRing = currRing;
4434      break;
4435    }
4436
4437    if(MivComp(next_weight, ivNull) == 1)
4438    {
4439      newRing = currRing;
4440      delete next_weight;
4441      break;
4442    }
4443
4444    if(MivComp(next_weight, target_weight) == 1)
4445    {
4446      if(MivSame(target_weight, exivlp)==1)
4447      {
4448     // LAST_GB_ALT2:
4449        //nOverflow_Error = Overflow_Error;
4450#ifdef TIME_TEST
4451        tproc = clock()-xftinput;
4452#endif
4453        //Print("\n// takes %d steps and calls the recursion of level 2:",  nwalk);
4454        /* call the changed perturbation walk algorithm with degree 2 */
4455        G = Rec_LastGB(G, curr_weight, target_weight, 2,1);
4456        newRing = currRing;
4457        delete next_weight;
4458        break;
4459      }
4460      endwalks = 1;
4461    }
4462
4463    for(i=nV-1; i>=0; i--)
4464    {
4465      //(*extra_curr_weight)[i] = (*curr_weight)[i];
4466      (*curr_weight)[i] = (*next_weight)[i];
4467    }
4468    delete next_weight;
4469  }
4470#ifdef TEST_OVERFLOW
4471 TEST_OVERFLOW_OI:
4472#endif
4473  rChangeCurrRing(XXRing);
4474  G = idrMoveR(G, newRing,currRing);
4475  delete ivNull;
4476  delete exivlp;
4477
4478#ifdef TIME_TEST
4479  /*Print("\n// \"Main procedure\"  took %d steps dnd %.2f sec. Overflow_Error (%d)",
4480        nwalk, ((double) tproc)/1000000, nOverflow_Error);
4481*/
4482  TimeStringFractal(xftinput, tostd, xtif, xtstd, xtextra,xtlift, xtred,xtnw);
4483
4484  //Print("\n// pSetm_Error = (%d)", ErrorCheck());
4485  //Print("\n// Overflow_Error? (%d)", nOverflow_Error);
4486  //Print("\n// Awalk2 took %d steps!!", nstep);
4487#endif
4488
4489  return(G);
4490}
4491
4492
4493/**************************************
4494 * perturb the matrix order of  "lex" *
4495 **************************************/
4496static intvec* NewVectorlp(ideal I)
4497{
4498  int nV = currRing->N;
4499  intvec* iv_wlp =  MivMatrixOrderlp(nV);
4500  intvec* result = Mfpertvector(I, iv_wlp);
4501  delete iv_wlp;
4502  return result;
4503}
4504
4505VAR int ngleich;
4506VAR intvec* Xsigma;
4507VAR intvec* Xtau;
4508VAR int xn;
4509VAR intvec* Xivinput;
4510VAR intvec* Xivlp;
4511
4512
4513/********************************
4514 * compute a next weight vector *
4515 ********************************/
4516static intvec* MWalkRandomNextWeight(ideal G, intvec* orig_M, intvec* target_weight,
4517       int weight_rad, int pert_deg)
4518{
4519  assume(currRing != NULL && orig_M != NULL &&
4520         target_weight != NULL && G->m[0] != NULL);
4521
4522  //BOOLEAN nError = Overflow_Error;
4523  Overflow_Error = FALSE;
4524
4525  BOOLEAN found_random_weight = FALSE;
4526  int i,nV = currRing->N;
4527  intvec* curr_weight = new intvec(nV);
4528
4529  for(i=0; i<nV; i++)
4530  {
4531    (*curr_weight)[i] = (*orig_M)[i];
4532  }
4533
4534  int k=0,weight_norm;
4535  intvec* next_weight;
4536  intvec* next_weight1 = MkInterRedNextWeight(curr_weight,target_weight,G);
4537  intvec* next_weight2 = new intvec(nV);
4538  intvec* result = new intvec(nV);
4539  intvec* curr_weight1;
4540  ideal G_test, G_test1, G_test2;
4541
4542  //try to find a random next weight vector "next_weight2"
4543  if(weight_rad > 0)
4544  {
4545    while(k<10)
4546    {
4547      weight_norm = 0;
4548      while(weight_norm == 0)
4549      {
4550        for(i=0; i<nV; i++)
4551        {
4552          (*next_weight2)[i] = rand() % 60000 - 30000;
4553          weight_norm = weight_norm + (*next_weight2)[i]*(*next_weight2)[i];
4554        }
4555        weight_norm = 1 + static_cast<int>(sqrt(double(weight_norm)));
4556      }
4557      for(i=0; i<nV; i++)
4558      {
4559        if((*next_weight2)[i] < 0)
4560        {
4561          (*next_weight2)[i] = 1 + (*curr_weight)[i] + weight_rad*(*next_weight2)[i]/weight_norm;
4562        }
4563        else
4564        {
4565          (*next_weight2)[i] = (*curr_weight)[i] + weight_rad*(*next_weight2)[i]/weight_norm;
4566        }
4567      }
4568      if(test_w_in_ConeCC(G,next_weight2) == 1)
4569      {
4570        if(maxlengthpoly(MwalkInitialForm(G,next_weight2))<2)
4571        {
4572          next_weight2 = MkInterRedNextWeight(next_weight2,target_weight,G);
4573        }
4574        G_test2 = MwalkInitialForm(G, next_weight2);
4575        found_random_weight = TRUE;
4576        break;
4577      }
4578      k++;
4579    }
4580  }
4581
4582  // compute "perturbed" next weight vector
4583  if(pert_deg > 1)
4584  {
4585    curr_weight1 = MPertVectors(G,orig_M,pert_deg);
4586    next_weight = MkInterRedNextWeight(curr_weight1,target_weight,G);
4587    delete curr_weight1;
4588  }
4589  else
4590  {
4591    next_weight = MkInterRedNextWeight(curr_weight,target_weight,G);
4592  }
4593  if(MivSame(curr_weight,next_weight)==1 || Overflow_Error == TRUE)
4594  {
4595    Overflow_Error = FALSE;
4596    delete next_weight;
4597    next_weight = MkInterRedNextWeight(curr_weight,target_weight,G);
4598  }
4599  G_test=MwalkInitialForm(G,next_weight);
4600  G_test1=MwalkInitialForm(G,next_weight1);
4601
4602  // compare next weights
4603  if(Overflow_Error == FALSE)
4604  {
4605    if(found_random_weight == TRUE)
4606    {
4607    // random next weight vector found
4608      if(G_test1->m[0] != NULL && maxlengthpoly(G_test1) < maxlengthpoly(G_test))
4609      {
4610        if(G_test2->m[0] != NULL && maxlengthpoly(G_test2) < maxlengthpoly(G_test1))
4611        {
4612          for(i=0; i<nV; i++)
4613          {
4614            (*result)[i] = (*next_weight2)[i];
4615          }
4616        }
4617        else
4618        {
4619          for(i=0; i<nV; i++)
4620          {
4621            (*result)[i] = (*next_weight1)[i];
4622          }
4623        }
4624      }
4625      else
4626      {
4627        if(G_test2->m[0] != NULL && maxlengthpoly(G_test2) < maxlengthpoly(G_test))
4628        {
4629          for(i=0; i<nV; i++)
4630          {
4631            (*result)[i] = (*next_weight2)[i];
4632          }
4633        }
4634        else
4635        {
4636          for(i=0; i<nV; i++)
4637          {
4638            (*result)[i] = (*next_weight)[i];
4639          }
4640        }
4641      }
4642    }
4643    else
4644    {
4645      // no random next weight vector found
4646      if(G_test1->m[0] != NULL && maxlengthpoly(G_test1) < maxlengthpoly(G_test))
4647      {
4648       for(i=0; i<nV; i++)
4649        {
4650          (*result)[i] = (*next_weight1)[i];
4651        }
4652      }
4653      else
4654      {
4655        for(i=0; i<nV; i++)
4656        {
4657          (*result)[i] = (*next_weight)[i];
4658        }
4659      }
4660    }
4661  }
4662  else
4663  {
4664    Overflow_Error = FALSE;
4665    if(found_random_weight == TRUE)
4666    {
4667      if(G_test2->m[0] != NULL && maxlengthpoly(G_test2) < maxlengthpoly(G_test))
4668      {
4669        for(i=1; i<nV; i++)
4670        {
4671          (*result)[i] = (*next_weight2)[i];
4672        }
4673      }
4674      else
4675      {
4676        for(i=0; i<nV; i++)
4677        {
4678          (*result)[i] = (*next_weight)[i];
4679        }
4680      }
4681    }
4682    else
4683    {
4684      for(i=0; i<nV; i++)
4685      {
4686        (*result)[i] = (*next_weight)[i];
4687      }
4688    }
4689  }
4690
4691  delete next_weight;
4692  delete next_weight2;
4693  idDelete(&G_test);
4694  idDelete(&G_test1);
4695  if(found_random_weight == TRUE)
4696  {
4697    idDelete(&G_test2);
4698  }
4699  if(test_w_in_ConeCC(G, result) == 1 && MivSame(curr_weight,result)==0)
4700  {
4701    delete curr_weight;
4702    delete next_weight1;
4703    return result;
4704  }
4705  else
4706  {
4707    delete curr_weight;
4708    delete result;
4709    return next_weight1;
4710  }
4711}
4712
4713
4714/***************************************************************************
4715 * The procedur REC_GB_Mwalk computes a GB for <G> w.r.t. the weight order *
4716 * otw, where G is a reduced GB w.r.t. the weight order cw.                *
4717 * The new procedure Mwalk calls REC_GB.                                   *
4718 ***************************************************************************/
4719static ideal REC_GB_Mwalk(ideal G, intvec* curr_weight, intvec* orig_target_weight,
4720                          int tp_deg, int npwinc)
4721{
4722  BOOLEAN nError = Overflow_Error;
4723  Overflow_Error = FALSE;
4724
4725  int i,  nV = currRing->N;
4726  int nwalk=0, endwalks=0, nnwinC=1, nlast = 0;
4727  ideal Gomega, M, F, Gomega1, Gomega2, M1,F1,result,ssG;
4728  ring newRing, oldRing, TargetRing;
4729  intvec* target_weight;
4730  intvec* ivNull = new intvec(nV);
4731#ifndef BUCHBERGER_ALG
4732  intvec* hilb_func;
4733  // to avoid (1,0,...,0) as the target vector
4734  intvec* last_omega = new intvec(nV);
4735  for(i=nV-1; i>0; i--)
4736  {
4737    (*last_omega)[i] = 1;
4738  }
4739  (*last_omega)[0] = 10000;
4740#endif
4741  BOOLEAN isGB = FALSE;
4742
4743  ring EXXRing = currRing;
4744
4745  // compute a pertubed weight vector of the target weight vector
4746  if(tp_deg > 1 && tp_deg <= nV)
4747  {
4748    ideal H0 = idHeadCC(G);
4749    if (rParameter(currRing) != NULL)
4750    {
4751      DefRingPar(orig_target_weight);
4752    }
4753    else
4754    {
4755      rChangeCurrRing(VMrDefault(orig_target_weight));
4756    }
4757    TargetRing = currRing;
4758    ssG = idrMoveR(G,EXXRing,currRing);
4759
4760    ideal H0_tmp = idrMoveR(H0,EXXRing,currRing);
4761    ideal H1 = idHeadCC(ssG);
4762    id_Delete(&H0,EXXRing);
4763
4764    if(test_G_GB_walk(H0_tmp,H1)==1)
4765    {
4766      //Print("\n//REC_GB_Mwalk: input in %d-th recursive is a GB!\n",tp_deg);
4767      idDelete(&H0_tmp);
4768      idDelete(&H1);
4769      G = ssG;
4770      ssG = NULL;
4771      newRing = currRing;
4772      delete ivNull;
4773      if(npwinc == 0)
4774      {
4775        isGB = TRUE;
4776        goto KSTD_Finish;
4777      }
4778      else
4779      {
4780        goto LastGB_Finish;
4781      }
4782    }
4783    idDelete(&H0_tmp);
4784    idDelete(&H1);
4785
4786    target_weight  = MPertVectors(ssG, MivMatrixOrder(orig_target_weight), tp_deg);
4787
4788    rChangeCurrRing(EXXRing);
4789    G = idrMoveR(ssG, TargetRing,currRing);
4790  }
4791
4792  while(1)
4793  {
4794    nwalk ++;
4795    nstep++;
4796    if(nwalk == 1)
4797    {
4798      goto NEXT_STEP;
4799    }
4800    //Print("\n//REC_GB_Mwalk: Entering the %d-th step in the %d-th recursive:\n",nwalk,tp_deg);
4801#ifdef TIME_TEST
4802    to = clock();
4803#endif
4804    // compute an initial form ideal of <G> w.r.t. "curr_vector"
4805    Gomega = MwalkInitialForm(G, curr_weight);
4806#ifdef TIME_TEST
4807    xtif = xtif + clock()-to;
4808#endif
4809
4810#ifndef  BUCHBERGER_ALG
4811    if(isNolVector(curr_weight) == 0)
4812    {
4813      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
4814    }
4815    else
4816    {
4817      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
4818    }
4819#endif
4820
4821    oldRing = currRing;
4822
4823    // define a new ring with ordering "(a(curr_weight),lp)
4824    if (rParameter(currRing) != NULL)
4825    {
4826      DefRingPar(curr_weight);
4827    }
4828    else
4829    {
4830      rChangeCurrRing(VMrDefault(curr_weight));
4831    }
4832    newRing = currRing;
4833    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
4834
4835#ifdef TIME_TEST
4836    to = clock();
4837#endif
4838    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
4839#ifdef  BUCHBERGER_ALG
4840    M = MstdhomCC(Gomega1);
4841#else
4842    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
4843    delete hilb_func;
4844#endif
4845#ifdef TIME_TEST
4846    xtstd = xtstd + clock() - to;
4847#endif
4848
4849    // change the ring to oldRing
4850    rChangeCurrRing(oldRing);
4851
4852    M1 =  idrMoveR(M, newRing,currRing);
4853    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
4854
4855#ifdef TIME_TEST
4856    to = clock();
4857#endif
4858    F = MLifttwoIdeal(Gomega2, M1, G);
4859#ifdef TIME_TEST
4860    xtlift = xtlift + clock() -to;
4861#endif
4862
4863    idDelete(&M1);
4864    idDelete(&Gomega2);
4865    idDelete(&G);
4866
4867
4868    // change the ring to newRing
4869    rChangeCurrRing(newRing);
4870    F1 = idrMoveR(F, oldRing,currRing);
4871
4872#ifdef TIME_TEST
4873    to = clock();
4874#endif
4875    // reduce the Groebner basis <G> w.r.t. new ring
4876    G = kInterRedCC(F1, NULL);
4877#ifdef TIME_TEST
4878    xtred = xtred + clock() -to;
4879#endif
4880
4881    idDelete(&F1);
4882
4883    if(endwalks == 1)
4884    {
4885      break;
4886    }
4887  NEXT_STEP:
4888#ifdef TIME_TEST
4889    to = clock();
4890#endif
4891    // compute a next weight vector
4892    intvec* next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
4893
4894
4895#ifdef TIME_TEST
4896    xtnw = xtnw + clock() - to;
4897#endif
4898
4899#ifdef PRINT_VECTORS
4900    MivString(curr_weight, target_weight, next_weight);
4901#endif
4902
4903    if(Overflow_Error == TRUE)
4904    {
4905      //PrintS("\n//REC_GB_Mwalk: The computed vector does NOT stay in the correct cone!!\n");
4906      nnwinC = 0;
4907      if(tp_deg == nV)
4908      {
4909        nlast = 1;
4910      }
4911      delete next_weight;
4912      break;
4913    }
4914    if(MivComp(next_weight, ivNull) == 1)
4915    {
4916      newRing = currRing;
4917      delete next_weight;
4918      break;
4919    }
4920
4921    if(MivComp(next_weight, target_weight) == 1)
4922    {
4923      if(tp_deg == nV)
4924      {
4925        endwalks = 1;
4926      }
4927      else
4928      {
4929        G = REC_GB_Mwalk(G,curr_weight, orig_target_weight, tp_deg+1,nnwinC);
4930        newRing = currRing;
4931        delete next_weight;
4932        break;
4933      }
4934    }
4935
4936    for(i=nV-1; i>=0; i--)
4937    {
4938      (*curr_weight)[i] = (*next_weight)[i];
4939    }
4940    delete next_weight;
4941  }
4942
4943  delete ivNull;
4944
4945  if(tp_deg != nV)
4946  {
4947    newRing = currRing;
4948
4949    if (rParameter(currRing) != NULL)
4950    {
4951      DefRingPar(orig_target_weight);
4952    }
4953    else
4954    {
4955      rChangeCurrRing(VMrDefault(orig_target_weight));
4956    }
4957    F1 = idrMoveR(G, newRing,currRing);
4958
4959    if(nnwinC == 0)
4960    {
4961      F1 = REC_GB_Mwalk(F1,curr_weight, orig_target_weight, tp_deg+1,nnwinC);
4962    }
4963    else
4964    {
4965      if(test_w_in_ConeCC(F1, target_weight) != 1)
4966      {
4967        F1 = REC_GB_Mwalk(F1,curr_weight, orig_target_weight,tp_deg+1,nnwinC);
4968      }
4969    }
4970    delete target_weight;
4971
4972    TargetRing = currRing;
4973    rChangeCurrRing(EXXRing);
4974    result = idrMoveR(F1, TargetRing,currRing);
4975  }
4976  else
4977  {
4978    if(nlast == 1)
4979    {
4980      if (rParameter(currRing) != NULL)
4981      {
4982        DefRingPar(orig_target_weight);
4983      }
4984      else
4985      {
4986        rChangeCurrRing(VMrDefault(orig_target_weight));
4987      }
4988    KSTD_Finish:
4989      if(isGB == FALSE)
4990      {
4991        F1 = idrMoveR(G, newRing,currRing);
4992      }
4993      else
4994      {
4995        F1 = G;
4996      }
4997#ifdef TIME_TEST
4998      to=clock();
4999#endif
5000      // apply Buchberger alg to compute a red. GB of F1
5001      G = MstdCC(F1);
5002#ifdef TIME_TEST
5003      xtextra=clock()-to;
5004#endif
5005      idDelete(&F1);
5006      newRing = currRing;
5007    }
5008
5009  LastGB_Finish:
5010    rChangeCurrRing(EXXRing);
5011    result = idrMoveR(G, newRing,currRing);
5012  }
5013
5014  if(Overflow_Error == FALSE)
5015    {
5016    Overflow_Error = nError;
5017    }
5018#ifndef BUCHBERGER_ALG
5019  delete last_omega;
5020#endif
5021  return(result);
5022}
5023
5024
5025// THE NEW GROEBNER WALK ALGORITHM
5026// Groebnerwalk with a recursive "second" alternative GW, called REC_GB_Mwalk that only computes the last reduced GB
5027ideal MwalkAlt(ideal Go, intvec* curr_weight, intvec* target_weight)
5028{
5029  Set_Error(FALSE);
5030  Overflow_Error = FALSE;
5031  //Print("// pSetm_Error = (%d)", ErrorCheck());
5032
5033#ifdef TIME_TEST
5034  clock_t tinput, tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0;
5035  tinput = clock();
5036  clock_t tim;
5037  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0;
5038#endif
5039  nstep=0;
5040  int i;
5041  int nV = currRing->N;
5042  int nwalk=0;
5043  int endwalks=0;
5044
5045  ideal Gomega, M, F, Gomega1, Gomega2, M1, F1, G;
5046
5047  ring newRing, oldRing;
5048  intvec* ivNull = new intvec(nV);
5049  intvec* exivlp = Mivlp(nV);
5050#ifndef BUCHBERGER_ALG
5051  intvec* hilb_func;
5052#endif
5053  intvec* tmp_weight = new intvec(nV);
5054  for(i=nV-1; i>=0; i--)
5055    (*tmp_weight)[i] = (*curr_weight)[i];
5056
5057   // to avoid (1,0,...,0) as the target vector
5058  intvec* last_omega = new intvec(nV);
5059  for(i=nV-1; i>0; i--)
5060    (*last_omega)[i] = 1;
5061  (*last_omega)[0] = 10000;
5062
5063  ring XXRing = currRing;
5064
5065#ifdef TIME_TEST
5066  to = clock();
5067#endif
5068  // the monomial ordering of this current ring would be "dp"
5069  G = MstdCC(Go);
5070#ifdef TIME_TEST
5071  tostd = clock()-to;
5072#endif
5073
5074  if(currRing->order[0] == ringorder_a)
5075    goto NEXT_VECTOR;
5076
5077  while(1)
5078  {
5079    nwalk ++;
5080    nstep ++;
5081#ifdef TIME_TEST
5082    to = clock();
5083#endif
5084    // compute an initial form ideal of <G> w.r.t. "curr_vector"
5085    Gomega = MwalkInitialForm(G, curr_weight);
5086#ifdef TIME_TEST
5087    tif = tif + clock()-to;
5088#endif
5089    oldRing = currRing;
5090
5091    if(endwalks == 1)
5092    {
5093      /* compute a reduced Groebner basis of Gomega w.r.t. >>_cw by
5094         the recursive changed perturbation walk alg. */
5095#ifdef TIME_TEST
5096      tim = clock();
5097#endif
5098#ifdef CHECK_IDEAL_MWALK
5099        Print("\n// **** Groebnerwalk took %d steps and ", nwalk);
5100        PrintS("\n// **** call the rec. Pert. Walk to compute a red GB of:");
5101        idString(Gomega, "Gomega");
5102#endif
5103
5104      if(MivSame(exivlp, target_weight)==1)
5105        M = REC_GB_Mwalk(idCopy(Gomega), tmp_weight, curr_weight, 2,1);
5106      else
5107        goto NORMAL_GW;
5108#ifdef TIME_TEST
5109        Print("\n//  time for the last std(Gw)  = %.2f sec",
5110        ((double) (clock()-tim)/1000000));
5111#endif
5112/*
5113#ifdef CHECK_IDEAL_MWALK
5114      idElements(Gomega, "G_omega");
5115      headidString(Gomega, "Gw");
5116      idElements(M, "M");
5117      //headidString(M, "M");
5118#endif
5119*/
5120#ifdef TIME_TEST
5121      to = clock();
5122#endif
5123      F = MLifttwoIdeal(Gomega, M, G);
5124#ifdef TIME_TEST
5125      xtlift = xtlift + clock() - to;
5126#endif
5127
5128      idDelete(&Gomega);
5129      idDelete(&M);
5130      idDelete(&G);
5131
5132      oldRing = currRing;
5133
5134      // create a new ring newRing
5135       if (rParameter(currRing) != NULL)
5136       {
5137         DefRingPar(curr_weight);
5138       }
5139       else
5140       {
5141         rChangeCurrRing(VMrDefault(curr_weight));
5142       }
5143      newRing = currRing;
5144      F1 = idrMoveR(F, oldRing,currRing);
5145    }
5146    else
5147    {
5148    NORMAL_GW:
5149#ifndef  BUCHBERGER_ALG
5150      if(isNolVector(curr_weight) == 0)
5151      {
5152        hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
5153      }
5154      else
5155      {
5156        hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
5157      }
5158#endif // BUCHBERGER_ALG
5159
5160      // define a new ring that its ordering is "(a(curr_weight),lp)
5161      if (rParameter(currRing) != NULL)
5162      {
5163        DefRingPar(curr_weight);
5164      }
5165      else
5166      {
5167        rChangeCurrRing(VMrDefault(curr_weight));
5168      }
5169      newRing = currRing;
5170      Gomega1 = idrMoveR(Gomega, oldRing,currRing);
5171
5172#ifdef TIME_TEST
5173      to = clock();
5174#endif
5175      // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
5176#ifdef  BUCHBERGER_ALG
5177      M = MstdhomCC(Gomega1);
5178#else
5179      M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
5180      delete hilb_func;
5181#endif
5182#ifdef TIME_TEST
5183      tstd = tstd + clock() - to;
5184#endif
5185
5186      // change the ring to oldRing
5187      rChangeCurrRing(oldRing);
5188      M1 =  idrMoveR(M, newRing,currRing);
5189      Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
5190
5191#ifdef TIME_TEST
5192      to = clock();
5193#endif
5194      // compute a representation of the generators of submod (M) with respect
5195      // to those of mod (Gomega).
5196      // Gomega is a reduced Groebner basis w.r.t. the current ring.
5197      F = MLifttwoIdeal(Gomega2, M1, G);
5198#ifdef TIME_TEST
5199      tlift = tlift + clock() - to;
5200#endif
5201
5202      idDelete(&M1);
5203      idDelete(&Gomega2);
5204      idDelete(&G);
5205
5206      // change the ring to newRing
5207      rChangeCurrRing(newRing);
5208      F1 = idrMoveR(F, oldRing,currRing);
5209    }
5210
5211#ifdef TIME_TEST
5212    to = clock();
5213#endif
5214    // reduce the Groebner basis <G> w.r.t. new ring
5215    G = kInterRedCC(F1, NULL);
5216#ifdef TIME_TEST
5217    if(endwalks != 1)
5218    {
5219      tred = tred + clock() - to;
5220    }
5221    else
5222    {
5223      xtred = xtred + clock() - to;
5224    }
5225#endif
5226    idDelete(&F1);
5227    if(endwalks == 1)
5228    {
5229      break;
5230    }
5231  NEXT_VECTOR:
5232#ifdef TIME_TEST
5233    to = clock();
5234#endif
5235    // compute a next weight vector
5236    intvec* next_weight = MkInterRedNextWeight(curr_weight,target_weight,G);
5237#ifdef TIME_TEST
5238    tnw = tnw + clock() - to;
5239#endif
5240#ifdef PRINT_VECTORS
5241    MivString(curr_weight, target_weight, next_weight);
5242#endif
5243
5244    //if(test_w_in_ConeCC(G, next_weight) != 1)
5245    if(Overflow_Error == TRUE)
5246    {
5247      newRing = currRing;
5248      PrintS("\n// ** The computed vector does NOT stay in Cone!!\n");
5249
5250      if (rParameter(currRing) != NULL)
5251      {
5252        DefRingPar(target_weight);
5253      }
5254      else
5255      {
5256        rChangeCurrRing(VMrDefault(target_weight));
5257      }
5258      F1 = idrMoveR(G, newRing,currRing);
5259      G = MstdCC(F1);
5260      idDelete(&F1);
5261
5262      newRing = currRing;
5263      break;
5264    }
5265
5266    if(MivComp(next_weight, ivNull) == 1)
5267    {
5268      newRing = currRing;
5269      delete next_weight;
5270      break;
5271    }
5272    if(MivComp(next_weight, target_weight) == 1)
5273    {
5274      endwalks = 1;
5275    }
5276    for(i=nV-1; i>=0; i--)
5277    {
5278      (*tmp_weight)[i] = (*curr_weight)[i];
5279      (*curr_weight)[i] = (*next_weight)[i];
5280    }
5281    delete next_weight;
5282  }
5283  rChangeCurrRing(XXRing);
5284  G = idrMoveR(G, newRing,currRing);
5285
5286  delete tmp_weight;
5287  delete ivNull;
5288  delete exivlp;
5289
5290#ifdef TIME_TEST
5291  TimeString(tinput, tostd, tif, tstd, tlift, tred, tnw, nstep);
5292
5293  //Print("\n// pSetm_Error = (%d)", ErrorCheck());
5294  Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
5295#endif
5296  return(G);
5297}
5298
5299/*******************************
5300 * THE GROEBNER WALK ALGORITHM *
5301 *******************************/
5302ideal Mwalk(ideal Go, intvec* orig_M, intvec* target_M,
5303            ring baseRing, int reduction, int printout)
5304{
5305  // save current options
5306  BITSET save1 = si_opt_1;
5307  if(reduction == 0)
5308  {
5309    si_opt_1 &= (~Sy_bit(OPT_REDSB)); // no reduced Groebner basis
5310    si_opt_1 &= (~Sy_bit(OPT_REDTAIL)); // not tail reductions
5311  }
5312  Set_Error(FALSE);
5313  Overflow_Error = FALSE;
5314  //BOOLEAN endwalks = FALSE;
5315#ifdef TIME_TEST
5316  clock_t tinput, tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0;
5317  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0;
5318  tinput = clock();
5319  clock_t tim;
5320#endif
5321  nstep=0;
5322  int i,nwalk;
5323  int nV = baseRing->N;
5324
5325  ideal Gomega, M, F, FF, Gomega1, Gomega2, M1;
5326  ring newRing;
5327  ring XXRing = baseRing;
5328  ring targetRing;
5329  intvec* ivNull = new intvec(nV);
5330  intvec* curr_weight = new intvec(nV);
5331  intvec* target_weight = new intvec(nV);
5332  intvec* exivlp = Mivlp(nV);
5333/*
5334  intvec* tmp_weight = new intvec(nV);
5335  for(i=0; i<nV; i++)
5336  {
5337    (*tmp_weight)[i] = (*orig_M)[i];
5338  }
5339*/
5340  for(i=0; i<nV; i++)
5341  {
5342    (*curr_weight)[i] = (*orig_M)[i];
5343    (*target_weight)[i] = (*target_M)[i];
5344  }
5345#ifndef BUCHBERGER_ALG
5346  intvec* hilb_func;
5347   // to avoid (1,0,...,0) as the target vector
5348  intvec* last_omega = new intvec(nV);
5349  for(i=nV-1; i>0; i--)
5350  {
5351    (*last_omega)[i] = 1;
5352  }
5353  (*last_omega)[0] = 10000;
5354#endif
5355  rComplete(currRing);
5356#ifdef CHECK_IDEAL_MWALK
5357  if(printout > 2)
5358  {
5359    idString(Go,"//** Mwalk: Go");
5360  }
5361#endif
5362
5363  if(target_M->length() == nV)
5364  {
5365   // define the target ring
5366    targetRing = VMrDefault(target_weight);
5367  }
5368  else
5369  {
5370    targetRing = VMatrDefault(target_M);
5371  }
5372  if(orig_M->length() == nV)
5373  {
5374    // define a new ring with ordering "(a(curr_weight),lp)
5375    //newRing = VMrDefault(curr_weight);
5376    newRing=VMrRefine(target_weight, curr_weight);
5377  }
5378  else
5379  {
5380    newRing = VMatrRefine(target_M,curr_weight); //newRing = VMatrDefault(orig_M);
5381  }
5382  rChangeCurrRing(newRing);
5383  if(printout > 2)
5384  {
5385    Print("\n//** Mrwalk: Current ring r = %s;\n", rString(currRing));
5386  }
5387#ifdef TIME_TEST
5388  to = clock();
5389#endif
5390  ideal G = MstdCC(idrMoveR(Go,baseRing,currRing));
5391#ifdef TIME_TEST
5392  tostd = clock()-to;
5393#endif
5394
5395  baseRing = currRing;
5396  nwalk = 0;
5397
5398  while(1)
5399  {
5400    nwalk ++;
5401    nstep ++;
5402    //compute an initial form ideal of <G> w.r.t. "curr_vector"
5403#ifdef TIME_TEST
5404    to = clock();
5405#endif
5406    Gomega = MwalkInitialForm(G, curr_weight);
5407#ifdef TIME_TEST
5408    tif = tif + clock()-to;
5409#endif
5410
5411#ifdef CHECK_IDEAL_MWALK
5412    if(printout > 1)
5413    {
5414      idString(Gomega,"//** Mwalk: Gomega");
5415    }
5416#endif
5417
5418    if(reduction == 0)
5419    {
5420      FF = middleOfCone(G,Gomega);
5421      if(FF != NULL)
5422      {
5423      PrintS("middle of Cone");
5424        idDelete(&G);
5425        G = idCopy(FF);
5426        idDelete(&FF);
5427        goto NEXT_VECTOR;
5428      }
5429    }
5430
5431#ifndef  BUCHBERGER_ALG
5432    if(isNolVector(curr_weight) == 0)
5433    {
5434      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
5435    }
5436    else
5437    {
5438      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
5439    }
5440#endif
5441
5442    if(nwalk == 1)
5443    {
5444      if(orig_M->length() == nV)
5445      {
5446        // define a new ring with ordering "(a(curr_weight),lp)
5447        //newRing = VMrDefault(curr_weight);
5448        newRing=VMrRefine(target_weight, curr_weight);
5449      }
5450      else
5451      {
5452        newRing = VMatrRefine(target_M,curr_weight);//newRing = VMatrDefault(orig_M);
5453      }
5454    }
5455    else
5456    {
5457     if(target_M->length() == nV)
5458     {
5459       //define a new ring with ordering "(a(curr_weight),lp)"
5460       //newRing = VMrDefault(curr_weight);
5461       newRing=VMrRefine(target_weight, curr_weight);
5462     }
5463     else
5464     {
5465       //define a new ring with matrix ordering
5466       newRing = VMatrRefine(target_M,curr_weight);
5467     }
5468    }
5469    rChangeCurrRing(newRing);
5470    if(printout > 2)
5471    {
5472      Print("\n// Current ring r = %s;\n", rString(currRing));
5473    }
5474    Gomega1 = idrMoveR(Gomega, baseRing,currRing);
5475    idDelete(&Gomega);
5476    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
5477#ifdef TIME_TEST
5478    to = clock();
5479#endif
5480#ifndef  BUCHBERGER_ALG
5481    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
5482    delete hilb_func;
5483#else
5484    M = kStd(Gomega1,NULL,testHomog,NULL,NULL,0,0,NULL);
5485#endif
5486#ifdef TIME_TEST
5487    tstd = tstd + clock() - to;
5488#endif
5489    idSkipZeroes(M);
5490#ifdef CHECK_IDEAL_MWALK
5491    if(printout > 2)
5492    {
5493      idString(M, "//** Mwalk: M");
5494    }
5495#endif
5496    //change the ring to baseRing
5497    rChangeCurrRing(baseRing);
5498    M1 =  idrMoveR(M, newRing,currRing);
5499    idDelete(&M);
5500    Gomega2 = idrMoveR(Gomega1, newRing,currRing);
5501    idDelete(&Gomega1);
5502#ifdef TIME_TEST
5503    to = clock();
5504#endif
5505    // compute a representation of the generators of submod (M) with respect to those of mod (Gomega),
5506    // where Gomega is a reduced Groebner basis w.r.t. the current ring
5507    F = MLifttwoIdeal(Gomega2, M1, G);
5508#ifdef TIME_TEST
5509    tlift = tlift + clock() - to;
5510#endif
5511#ifdef CHECK_IDEAL_MWALK
5512    if(printout > 2)
5513    {
5514      idString(F, "//** Mwalk: F");
5515    }
5516#endif
5517    idDelete(&Gomega2);
5518    idDelete(&M1);
5519
5520    rChangeCurrRing(newRing); // change the ring to newRing
5521    G = idrMoveR(F,baseRing,currRing);
5522    idDelete(&F);
5523    idSkipZeroes(G);
5524
5525#ifdef CHECK_IDEAL_MWALK
5526    if(printout > 2)
5527    {
5528      idString(G, "//** Mwalk: G");
5529    }
5530#endif
5531
5532    rChangeCurrRing(targetRing);
5533    G = idrMoveR(G,newRing,currRing);
5534    // test whether target cone is reached
5535    if(reduction !=0 && test_w_in_ConeCC(G,curr_weight) == 1)
5536    {
5537      baseRing = currRing;
5538      break;
5539      //endwalks = TRUE;
5540    }
5541
5542    rChangeCurrRing(newRing);
5543    G = idrMoveR(G,targetRing,currRing);
5544    baseRing = currRing;
5545
5546    NEXT_VECTOR:
5547#ifdef TIME_TEST
5548    to = clock();
5549#endif
5550    intvec* next_weight = MwalkNextWeightCC(curr_weight,target_weight,G);
5551#ifdef TIME_TEST
5552    tnw = tnw + clock() - to;
5553#endif
5554#ifdef PRINT_VECTORS
5555    if(printout > 0)
5556    {
5557      MivString(curr_weight, target_weight, next_weight);
5558    }
5559#endif
5560    if(reduction ==0)
5561    {
5562      if(MivComp(curr_weight,next_weight)==1)
5563      {
5564        break;
5565      }
5566    }
5567    if(MivComp(target_weight,curr_weight) == 1)
5568    {
5569      break;
5570    }
5571
5572    for(i=nV-1; i>=0; i--)
5573    {
5574      //(*tmp_weight)[i] = (*curr_weight)[i];
5575      (*curr_weight)[i] = (*next_weight)[i];
5576    }
5577    delete next_weight;
5578  }
5579  rChangeCurrRing(XXRing);
5580  ideal result = idrMoveR(G,baseRing,currRing);
5581  idDelete(&Go);
5582  idDelete(&G);
5583  //delete tmp_weight;
5584  delete ivNull;
5585  delete exivlp;
5586#ifndef BUCHBERGER_ALG
5587  delete last_omega;
5588#endif
5589#ifdef TIME_TEST
5590  TimeString(tinput, tostd, tif, tstd, tlift, tred, tnw, nstep);
5591  //Print("\n// pSetm_Error = (%d)", ErrorCheck());
5592  //Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
5593#endif
5594  if(printout > 0)
5595  {
5596    Print("\n//** Mwalk: Groebner Walk took %d steps.\n", nstep);
5597  }
5598  si_opt_1 = save1; //set original options
5599  return(result);
5600}
5601
5602// THE RANDOM WALK ALGORITHM
5603ideal Mrwalk(ideal Go, intvec* orig_M, intvec* target_M, int weight_rad, int pert_deg,
5604             int reduction, int printout)
5605{
5606  BITSET save1 = si_opt_1; // save current options
5607  if(reduction == 0)
5608  {
5609    si_opt_1 &= (~Sy_bit(OPT_REDSB)); // no reduced Groebner basis
5610    si_opt_1 &= (~Sy_bit(OPT_REDTAIL)); // not tail reductions
5611  }
5612
5613  Set_Error(FALSE);
5614  Overflow_Error = FALSE;
5615#ifdef TIME_TEST
5616  clock_t tinput, tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0;
5617  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0;
5618  tinput = clock();
5619  clock_t tim;
5620#endif
5621  nstep=0;
5622  int i,nwalk;//polylength;
5623  int nV = currRing->N;
5624
5625  //check that weight radius is valid
5626  if(weight_rad < 0)
5627  {
5628    WerrorS("Invalid radius.\n");
5629    return NULL;
5630  }
5631
5632  //check that perturbation degree is valid
5633  if(pert_deg > nV || pert_deg < 1)
5634  {
5635    WerrorS("Invalid perturbation degree.\n");
5636    return NULL;
5637  }
5638
5639  ideal Gomega, M, F,FF, Gomega1, Gomega2, M1;
5640  ring newRing;
5641  ring targetRing;
5642  ring baseRing = currRing;
5643  ring XXRing = currRing;
5644  intvec* iv_M;
5645  intvec* ivNull = new intvec(nV);
5646  intvec* curr_weight = new intvec(nV);
5647  intvec* target_weight = new intvec(nV);
5648  intvec* next_weight= new intvec(nV);
5649
5650  for(i=0; i<nV; i++)
5651  {
5652    (*curr_weight)[i] = (*orig_M)[i];
5653    (*target_weight)[i] = (*target_M)[i];
5654  }
5655
5656#ifndef BUCHBERGER_ALG
5657  intvec* hilb_func;
5658   // to avoid (1,0,...,0) as the target vector
5659  intvec* last_omega = new intvec(nV);
5660  for(i=nV-1; i>0; i--)
5661  {
5662    (*last_omega)[i] = 1;
5663  }
5664  (*last_omega)[0] = 10000;
5665#endif
5666  rComplete(currRing);
5667
5668  if(target_M->length() == nV)
5669  {
5670    targetRing = VMrDefault(target_weight); // define the target ring
5671  }
5672  else
5673  {
5674    targetRing = VMatrDefault(target_M);
5675  }
5676  if(orig_M->length() == nV)
5677  {
5678    //newRing = VMrDefault(curr_weight); // define a new ring with ordering "(a(curr_weight),lp)
5679    newRing=VMrRefine(target_weight, curr_weight);
5680  }
5681  else
5682  {
5683    newRing = VMatrRefine(target_M,curr_weight);//newRing = VMatrDefault(orig_M);
5684  }
5685  rChangeCurrRing(newRing);
5686#ifdef TIME_TEST
5687  to = clock();
5688#endif
5689  ideal G = MstdCC(idrMoveR(Go,baseRing,currRing));
5690#ifdef TIME_TEST
5691  tostd = clock()-to;
5692#endif
5693  baseRing = currRing;
5694  nwalk = 0;
5695
5696#ifdef TIME_TEST
5697  to = clock();
5698#endif
5699  Gomega = MwalkInitialForm(G, curr_weight); // compute an initial form ideal of <G> w.r.t. "curr_vector"
5700#ifdef TIME_TEST
5701  tif = tif + clock()-to; //time for computing initial form ideal
5702#endif
5703
5704  while(1)
5705  {
5706    nwalk ++;
5707    nstep ++;
5708#ifdef CHECK_IDEAL_MWALK
5709    if(printout > 1)
5710    {
5711      idString(Gomega,"//** Mrwalk: Gomega");
5712    }
5713#endif
5714    if(reduction == 0)
5715    {
5716      FF = middleOfCone(G,Gomega);
5717      if(FF != NULL)
5718      {
5719        idDelete(&G);
5720        G = idCopy(FF);
5721        idDelete(&FF);
5722        goto NEXT_VECTOR;
5723      }
5724    }
5725#ifndef  BUCHBERGER_ALG
5726    if(isNolVector(curr_weight) == 0)
5727    {
5728      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
5729    }
5730    else
5731    {
5732      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
5733    }
5734#endif
5735    if(nwalk == 1)
5736    {
5737      if(orig_M->length() == nV)
5738      {
5739        /*newRing = VMrDefault(curr_weight); // define a new ring with ordering "(a(curr_weight),lp)*/
5740        newRing=VMrRefine(target_weight, curr_weight);
5741      }
5742      else
5743      {
5744        newRing = VMatrRefine(target_M,curr_weight);//newRing = VMatrDefault(orig_M);
5745      }
5746    }
5747    else
5748    {
5749     if(target_M->length() == nV)
5750     {
5751       /*newRing = VMrDefault(curr_weight); // define a new ring with ordering "(a(curr_weight),lp)*/
5752       newRing=VMrRefine(target_weight, curr_weight);
5753     }
5754     else
5755     {
5756       newRing = VMatrRefine(target_M,curr_weight);
5757     }
5758    }
5759    rChangeCurrRing(newRing);
5760    Gomega1 = idrMoveR(Gomega, baseRing,currRing);
5761    idDelete(&Gomega);
5762    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
5763#ifdef TIME_TEST
5764    to = clock();
5765#endif
5766#ifndef BUCHBERGER_ALG
5767    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
5768    delete hilb_func;
5769#else
5770    M = kStd(Gomega1,NULL,testHomog,NULL,NULL,0,0,NULL);
5771#endif
5772#ifdef TIME_TEST
5773    tstd = tstd + clock() - to;
5774#endif
5775    idSkipZeroes(M);
5776#ifdef CHECK_IDEAL_MWALK
5777    if(printout > 2)
5778    {
5779      idString(M, "//** Mrwalk: M");
5780    }
5781#endif
5782    //change the ring to baseRing
5783    rChangeCurrRing(baseRing);
5784    M1 =  idrMoveR(M, newRing,currRing);
5785    idDelete(&M);
5786    Gomega2 = idrMoveR(Gomega1, newRing,currRing);
5787    idDelete(&Gomega1);
5788#ifdef TIME_TEST
5789    to = clock();
5790#endif
5791    // compute a representation of the generators of submod (M) with respect to those of mod (Gomega),
5792    // where Gomega is a reduced Groebner basis w.r.t. the current ring
5793    F = MLifttwoIdeal(Gomega2, M1, G);
5794#ifdef TIME_TEST
5795    tlift = tlift + clock() - to;
5796#endif
5797#ifdef CHECK_IDEAL_MWALK
5798    if(printout > 2)
5799    {
5800      idString(F,"//** Mrwalk: F");
5801    }
5802#endif
5803    idDelete(&Gomega2);
5804    idDelete(&M1);
5805    rChangeCurrRing(newRing); // change the ring to newRing
5806    G = idrMoveR(F,baseRing,currRing);
5807    idDelete(&F);
5808    baseRing = currRing;
5809#ifdef TIME_TEST
5810    to = clock();
5811    tstd = tstd + clock() - to;
5812#endif
5813    idSkipZeroes(G);
5814#ifdef CHECK_IDEAL_MWALK
5815    if(printout > 2)
5816    {
5817      idString(G,"//** Mrwalk: G");
5818    }
5819#endif
5820
5821    rChangeCurrRing(targetRing);
5822    G = idrMoveR(G,newRing,currRing);
5823
5824    // test whether target cone is reached
5825    if(reduction !=0 && test_w_in_ConeCC(G,curr_weight) == 1)
5826    {
5827      baseRing = currRing;
5828      break;
5829    }
5830
5831    rChangeCurrRing(newRing);
5832    G = idrMoveR(G,targetRing,currRing);
5833    baseRing = currRing;
5834
5835    NEXT_VECTOR:
5836#ifdef TIME_TEST
5837    to = clock();
5838#endif
5839    next_weight = MwalkNextWeightCC(curr_weight,target_weight,G);
5840#ifdef TIME_TEST
5841    tnw = tnw + clock() - to;
5842#endif
5843
5844#ifdef TIME_TEST
5845    to = clock();
5846#endif
5847    Gomega = MwalkInitialForm(G, next_weight); // compute an initial form ideal of <G> w.r.t. "curr_vector"
5848#ifdef TIME_TEST
5849    tif = tif + clock()-to; //time for computing initial form ideal
5850#endif
5851
5852    //lengthpoly(Gomega) = 1 if there is a polynomial in Gomega with at least 3 monomials and 0 otherwise
5853    //polylength = lengthpoly(Gomega);
5854    if(lengthpoly(Gomega) > 0)
5855    {
5856      //there is a polynomial in Gomega with at least 3 monomials,
5857      //low-dimensional facet of the cone
5858      delete next_weight;
5859      if(target_M->length() == nV)
5860      {
5861        //iv_M = MivMatrixOrder(curr_weight);
5862        iv_M = MivMatrixOrderRefine(curr_weight,target_M);
5863      }
5864      else
5865      {
5866        iv_M = MivMatrixOrderRefine(curr_weight,target_M);
5867      }
5868#ifdef TIME_TEST
5869      to = clock();
5870#endif
5871      next_weight = MWalkRandomNextWeight(G, iv_M, target_weight, weight_rad, pert_deg);
5872#ifdef TIME_TEST
5873      tnw = tnw + clock() - to;
5874#endif
5875      idDelete(&Gomega);
5876#ifdef TIME_TEST
5877      to = clock();
5878#endif
5879      Gomega = MwalkInitialForm(G, next_weight);
5880#ifdef TIME_TEST
5881      tif = tif + clock()-to; //time for computing initial form ideal
5882#endif
5883      delete iv_M;
5884    }
5885
5886    // test whether target weight vector is reached
5887    if(MivComp(next_weight, ivNull) == 1 || MivComp(target_weight,curr_weight) == 1)
5888    {
5889      baseRing = currRing;
5890      delete next_weight;
5891      break;
5892    }
5893    if(reduction ==0)
5894    {
5895      if(MivComp(curr_weight,next_weight)==1)
5896      {
5897        break;
5898      }
5899    }
5900#ifdef PRINT_VECTORS
5901    if(printout > 0)
5902    {
5903      MivString(curr_weight, target_weight, next_weight);
5904    }
5905#endif
5906
5907    for(i=nV-1; i>=0; i--)
5908    {
5909      (*curr_weight)[i] = (*next_weight)[i];
5910    }
5911    delete next_weight;
5912  }
5913  baseRing = currRing;
5914  rChangeCurrRing(XXRing);
5915  ideal result = idrMoveR(G,baseRing,currRing);
5916  idDelete(&G);
5917  delete ivNull;
5918#ifndef BUCHBERGER_ALG
5919  delete last_omega;
5920#endif
5921  if(printout > 0)
5922  {
5923    Print("\n//** Mrwalk: Groebner Walk took %d steps.\n", nstep);
5924  }
5925#ifdef TIME_TEST
5926  TimeString(tinput, tostd, tif, tstd, tlift, tred, tnw, nstep);
5927  //Print("\n// pSetm_Error = (%d)", ErrorCheck());
5928  //Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
5929#endif
5930  si_opt_1 = save1; //set original options
5931  return(result);
5932}
5933
5934/**************************************************************/
5935/*     Implementation of the perturbation walk algorithm      */
5936/**************************************************************/
5937/* If the perturbed target weight vector or an intermediate weight vector
5938   doesn't stay in the correct Groebner cone, we have only
5939   a reduced Groebner basis for the given ideal with respect to
5940   a monomial order which differs to the given order.
5941   Then we have to compute the wanted  reduced Groebner basis for it.
5942   For this, we can use
5943   1) the improved Buchberger algorithm or
5944   2) the changed perturbation walk algorithm with a decreased degree.
5945*/
5946// if nP = 0 use kStd, else call LastGB
5947ideal Mpwalk(ideal Go, int op_deg, int tp_deg,intvec* curr_weight,
5948             intvec* target_weight, int nP, int reduction, int printout)
5949{
5950  BITSET save1 = si_opt_1; // save current options
5951  if(reduction == 0)
5952  {
5953    si_opt_1 &= (~Sy_bit(OPT_REDSB)); // no reduced Groebner basis
5954    si_opt_1 &= (~Sy_bit(OPT_REDTAIL)); // not tail reductions
5955  }
5956  Set_Error(FALSE  );
5957  Overflow_Error = FALSE;
5958  //Print("// pSetm_Error = (%d)", ErrorCheck());
5959#ifdef TIME_TEST
5960  clock_t  tinput, tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0;
5961  xtextra=0;
5962  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0;
5963  tinput = clock();
5964
5965  clock_t tim;
5966#endif
5967  nstep = 0;
5968  int i, ntwC=1, ntestw=1,  nV = currRing->N;
5969
5970  //check that perturbation degree is valid
5971  if(op_deg < 1 || tp_deg < 1 || op_deg > nV || tp_deg > nV)
5972  {
5973    WerrorS("Invalid perturbation degree.\n");
5974    return NULL;
5975  }
5976
5977  BOOLEAN endwalks = FALSE;
5978  ideal Gomega, M, F, FF, G, Gomega1, Gomega2, M1,F1,Eresult,ssG;
5979  ring newRing, oldRing, TargetRing;
5980  intvec* iv_M_dp;
5981  intvec* iv_M_lp;
5982  intvec* exivlp = Mivlp(nV);
5983  intvec* orig_target = target_weight;
5984  intvec* pert_target_vector = target_weight;
5985  intvec* ivNull = new intvec(nV);
5986  intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
5987#ifndef BUCHBERGER_ALG
5988  intvec* hilb_func;
5989#endif
5990  intvec* next_weight;
5991
5992  // to avoid (1,0,...,0) as the target vector
5993  intvec* last_omega = new intvec(nV);
5994  for(i=nV-1; i>0; i--)
5995    (*last_omega)[i] = 1;
5996  (*last_omega)[0] = 10000;
5997
5998  ring XXRing = currRing;
5999#ifdef TIME_TEST
6000  to = clock();
6001#endif
6002  // perturbs the original vector
6003  if(MivComp(curr_weight, iv_dp) == 1) //rOrdStr(currRing) := "dp"
6004  {
6005    G = MstdCC(Go);
6006#ifdef TIME_TEST
6007    tostd = clock()-to;
6008#endif
6009    if(op_deg != 1){
6010      iv_M_dp = MivMatrixOrderdp(nV);
6011      //ivString(iv_M_dp, "iv_M_dp");
6012      curr_weight = MPertVectors(G, iv_M_dp, op_deg);
6013    }
6014  }
6015  else
6016  {
6017    //define ring order := (a(curr_weight),lp);
6018/*
6019    if (rParameter(currRing) != NULL)
6020      DefRingPar(curr_weight);
6021    else
6022      rChangeCurrRing(VMrDefault(curr_weight));
6023*/
6024    rChangeCurrRing(VMrRefine(target_weight,curr_weight));
6025
6026    G = idrMoveR(Go, XXRing,currRing);
6027    G = MstdCC(G);
6028#ifdef TIME_TEST
6029    tostd = clock()-to;
6030#endif
6031    if(op_deg != 1){
6032      iv_M_dp = MivMatrixOrder(curr_weight);
6033      curr_weight = MPertVectors(G, iv_M_dp, op_deg);
6034    }
6035  }
6036  delete iv_dp;
6037  if(op_deg != 1) delete iv_M_dp;
6038
6039  ring HelpRing = currRing;
6040
6041  // perturbs the target weight vector
6042  if(tp_deg > 1 && tp_deg <= nV)
6043  {
6044/*
6045    if (rParameter(currRing) != NULL)
6046      DefRingPar(target_weight);
6047    else
6048      rChangeCurrRing(VMrDefault(target_weight));
6049*/
6050    rChangeCurrRing(VMrRefine(target_weight,curr_weight));
6051
6052    TargetRing = currRing;
6053    ssG = idrMoveR(G,HelpRing,currRing);
6054    if(MivSame(target_weight, exivlp) == 1)
6055    {
6056      iv_M_lp = MivMatrixOrderlp(nV);
6057      target_weight = MPertVectors(ssG, iv_M_lp, tp_deg);
6058    }
6059    else
6060    {
6061      iv_M_lp = MivMatrixOrder(target_weight);
6062      target_weight = MPertVectors(ssG, iv_M_lp, tp_deg);
6063    }
6064    delete iv_M_lp;
6065    pert_target_vector = target_weight;
6066    rChangeCurrRing(HelpRing);
6067    G = idrMoveR(ssG, TargetRing,currRing);
6068  }
6069  if(printout > 0)
6070  {
6071    Print("\n//** Mpwalk: Perturbation Walk of degree (%d,%d):",op_deg,tp_deg);
6072#ifdef PRINT_VECTORS
6073    ivString(curr_weight, "//** Mpwalk: new current weight");
6074    ivString(target_weight, "//** Mpwalk: new target weight");
6075#endif
6076  }
6077  while(1)
6078  {
6079    nstep ++;
6080#ifdef TIME_TEST
6081    to = clock();
6082#endif
6083    // compute an initial form ideal of <G> w.r.t. the weight vector
6084    // "curr_weight"
6085    Gomega = MwalkInitialForm(G, curr_weight);
6086#ifdef TIME_TEST
6087    tif = tif + clock()-to;
6088#endif
6089#ifdef CHECK_IDEAL_MWALK
6090    if(printout > 1)
6091    {
6092      idString(Gomega,"//** Mpwalk: Gomega");
6093    }
6094#endif
6095    if(reduction == 0 && nstep > 1)
6096    {
6097      FF = middleOfCone(G,Gomega);
6098      if(FF != NULL)
6099      {
6100        idDelete(&G);
6101        G = idCopy(FF);
6102        idDelete(&FF);
6103        goto NEXT_VECTOR;
6104      }
6105    }
6106
6107#ifdef ENDWALKS
6108    if(endwalks == TRUE)
6109    {
6110      if(printout > 0)
6111      {
6112        Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6113      }
6114      //idElements(G, "G");
6115      //headidString(G, "G");
6116    }
6117#endif
6118
6119#ifndef  BUCHBERGER_ALG
6120    if(isNolVector(curr_weight) == 0)
6121      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
6122    else
6123      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
6124#endif // BUCHBERGER_ALG
6125
6126    oldRing = currRing;
6127
6128    // define a new ring with ordering "(a(curr_weight),lp)
6129/*
6130    if (rParameter(currRing) != NULL)
6131      DefRingPar(curr_weight);
6132    else
6133      rChangeCurrRing(VMrDefault(curr_weight));
6134*/
6135    rChangeCurrRing(VMrRefine(target_weight,curr_weight));
6136
6137    newRing = currRing;
6138    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
6139
6140#ifdef ENDWALKS
6141    if(endwalks==TRUE)
6142    {
6143      if(printout > 0)
6144      {
6145        Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6146        //idElements(Gomega1, "Gw");
6147        //headidString(Gomega1, "headGw");
6148        PrintS("\n// compute a rGB of Gw:\n");
6149      }
6150#ifndef  BUCHBERGER_ALG
6151      ivString(hilb_func, "w");
6152#endif
6153    }
6154#endif
6155#ifdef TIME_TEST
6156    tim = clock();
6157    to = clock();
6158#endif
6159    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
6160#ifdef  BUCHBERGER_ALG
6161    M = MstdhomCC(Gomega1);
6162#else
6163    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
6164    delete hilb_func;
6165#endif
6166
6167    if(endwalks == TRUE)
6168    {
6169#ifdef TIME_TEST
6170      xtstd = xtstd+clock()-to;
6171#endif
6172#ifdef ENDWALKS
6173#ifdef TIME_TEST
6174      if(printout > 1)
6175      {
6176        Print("\n// time for the last std(Gw)  = %.2f sec\n",
6177            ((double) clock())/1000000 -((double)tim) /1000000);
6178      }
6179#endif
6180#endif
6181    }
6182    else
6183    {
6184#ifdef TIME_TEST
6185      tstd=tstd+clock()-to;
6186#endif
6187    }
6188#ifdef CHECK_IDEAL_MWALK
6189    if(printout > 2)
6190    {
6191      idString(M,"//** Mpwalk: M");
6192    }
6193#endif
6194    // change the ring to oldRing
6195    rChangeCurrRing(oldRing);
6196    M1 =  idrMoveR(M, newRing,currRing);
6197    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
6198#ifdef TIME_TEST
6199    to=clock();
6200#endif
6201    /* compute a representation of the generators of submod (M)
6202       with respect to those of mod (Gomega).
6203       Gomega is a reduced Groebner basis w.r.t. the current ring */
6204    F = MLifttwoIdeal(Gomega2, M1, G);
6205#ifdef TIME_TEST
6206    if(endwalks == FALSE)
6207      tlift = tlift+clock()-to;
6208    else
6209      xtlift=clock()-to;
6210#endif
6211#ifdef CHECK_IDEAL_MWALK
6212    if(printout > 2)
6213    {
6214      idString(F,"//** Mpwalk: F");
6215    }
6216#endif
6217
6218    idDelete(&M1);
6219    idDelete(&Gomega2);
6220    idDelete(&G);
6221
6222    // change the ring to newRing
6223    rChangeCurrRing(newRing);
6224    if(reduction == 0)
6225    {
6226      G = idrMoveR(F,oldRing,currRing);
6227    }
6228    else
6229    {
6230      F1 = idrMoveR(F, oldRing,currRing);
6231      if(printout > 2)
6232      {
6233        PrintS("\n //** Mpwalk: reduce the Groebner basis.\n");
6234      }
6235#ifdef TIME_TEST
6236      to=clock();
6237#endif
6238      G = kInterRedCC(F1, NULL);
6239#ifdef TIME_TEST
6240      if(endwalks == FALSE)
6241        tred = tred+clock()-to;
6242      else
6243        xtred=clock()-to;
6244#endif
6245      idDelete(&F1);
6246    }
6247    if(endwalks == TRUE)
6248      break;
6249
6250    NEXT_VECTOR:
6251#ifdef TIME_TEST
6252    to=clock();
6253#endif
6254    // compute a next weight vector
6255    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
6256#ifdef TIME_TEST
6257    tnw=tnw+clock()-to;
6258#endif
6259#ifdef PRINT_VECTORS
6260    if(printout > 0)
6261    {
6262      MivString(curr_weight, target_weight, next_weight);
6263    }
6264#endif
6265
6266    if(Overflow_Error == TRUE)
6267    {
6268      ntwC = 0;
6269      //ntestomega = 1;
6270      //Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6271      //idElements(G, "G");
6272      delete next_weight;
6273      goto FINISH_160302;
6274    }
6275    if(MivComp(next_weight, ivNull) == 1){
6276      newRing = currRing;
6277      delete next_weight;
6278      //Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6279      break;
6280    }
6281    if(MivComp(next_weight, target_weight) == 1)
6282      endwalks = TRUE;
6283
6284    for(i=nV-1; i>=0; i--)
6285      (*curr_weight)[i] = (*next_weight)[i];
6286
6287    delete next_weight;
6288  }//end of while-loop
6289
6290  if(tp_deg != 1)
6291  {
6292  FINISH_160302:
6293    if(MivSame(orig_target, exivlp) == 1) {
6294    /*  if (rParameter(currRing) != NULL)
6295        DefRingParlp();
6296      else
6297        VMrDefaultlp();
6298    else
6299      if (rParameter(currRing) != NULL)
6300        DefRingPar(orig_target);
6301      else*/
6302        rChangeCurrRing(VMrDefault(orig_target));
6303    }
6304    TargetRing=currRing;
6305    F1 = idrMoveR(G, newRing,currRing);
6306/*
6307#ifdef CHECK_IDEAL_MWALK
6308      headidString(G, "G");
6309#endif
6310*/
6311
6312    // check whether the pertubed target vector stays in the correct cone
6313    if(ntwC != 0){
6314      ntestw = test_w_in_ConeCC(F1, pert_target_vector);
6315    }
6316
6317    if( ntestw != 1 || ntwC == 0)
6318    {
6319      if(ntestw != 1 && printout >2)
6320      {
6321        ivString(pert_target_vector, "tau");
6322        PrintS("\n// ** perturbed target vector doesn't stay in cone!!");
6323        Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6324        //idElements(F1, "G");
6325      }
6326      // LastGB is "better" than the kStd subroutine
6327#ifdef TIME_TEST
6328      to=clock();
6329#endif
6330      ideal eF1;
6331      if(nP == 0 || tp_deg == 1 || MivSame(orig_target, exivlp) != 1){
6332        // PrintS("\n// ** calls \"std\" to compute a GB");
6333        eF1 = MstdCC(F1);
6334        idDelete(&F1);
6335      }
6336      else {
6337        // PrintS("\n// ** calls \"LastGB\" to compute a GB");
6338        rChangeCurrRing(newRing);
6339        ideal F2 = idrMoveR(F1, TargetRing,currRing);
6340        eF1 = LastGB(F2, curr_weight, tp_deg-1);
6341        F2=NULL;
6342      }
6343#ifdef TIME_TEST
6344      xtextra=clock()-to;
6345#endif
6346      ring exTargetRing = currRing;
6347
6348      rChangeCurrRing(XXRing);
6349      Eresult = idrMoveR(eF1, exTargetRing,currRing);
6350    }
6351    else{
6352      rChangeCurrRing(XXRing);
6353      Eresult = idrMoveR(F1, TargetRing,currRing);
6354    }
6355  }
6356  else {
6357    rChangeCurrRing(XXRing);
6358    Eresult = idrMoveR(G, newRing,currRing);
6359  }
6360  si_opt_1 = save1; //set original options, e. g. option(RedSB)
6361  delete ivNull;
6362  if(tp_deg != 1)
6363    delete target_weight;
6364
6365  if(op_deg != 1 )
6366    delete curr_weight;
6367
6368  delete exivlp;
6369  delete last_omega;
6370
6371#ifdef TIME_TEST
6372  TimeStringFractal(tinput, tostd, tif+xtif, tstd+xtstd,0, tlift+xtlift, tred+xtred,
6373             tnw+xtnw);
6374
6375  //Print("\n// pSetm_Error = (%d)", ErrorCheck());
6376  //Print("\n// It took %d steps and Overflow_Error? (%d)\n", nstep,  Overflow_Error);
6377#endif
6378  if(printout > 0)
6379  {
6380    Print("\n//** Mpwalk: Perturbation Walk took %d steps.\n", nstep);
6381  }
6382  return(Eresult);
6383}
6384
6385/*******************************************************
6386 * THE PERTURBATION WALK ALGORITHM WITH RANDOM ELEMENT *
6387 *******************************************************/
6388ideal Mprwalk(ideal Go, intvec* orig_M, intvec* target_M, int weight_rad,
6389              int op_deg, int tp_deg, int nP, int reduction, int printout)
6390{
6391  BITSET save1 = si_opt_1; // save current options
6392  if(reduction == 0)
6393  {
6394    si_opt_1 &= (~Sy_bit(OPT_REDSB)); // no reduced Groebner basis
6395    si_opt_1 &= (~Sy_bit(OPT_REDTAIL)); // not tail reductions
6396  }
6397  Set_Error(FALSE);
6398  Overflow_Error = FALSE;
6399  //Print("// pSetm_Error = (%d)", ErrorCheck());
6400#ifdef TIME_TEST
6401  clock_t  tinput, tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0;
6402  xtextra=0;
6403  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0;
6404  tinput = clock();
6405
6406  clock_t tim;
6407#endif
6408  nstep = 0;
6409  int i, ntwC=1, ntestw=1, nV = currRing->N; //polylength
6410
6411  //check that weight radius is valid
6412  if(weight_rad < 0)
6413  {
6414    WerrorS("Invalid radius.\n");
6415    return NULL;
6416  }
6417
6418  //check that perturbation degree is valid
6419  if(op_deg < 1 || tp_deg < 1 || op_deg > nV || tp_deg > nV)
6420  {
6421    WerrorS("Invalid perturbation degree.\n");
6422    return NULL;
6423  }
6424
6425  BOOLEAN endwalks = FALSE;
6426
6427  ideal Gomega, M, F, FF, G, Gomega1, Gomega2, M1,F1,Eresult,ssG;
6428  ring newRing, oldRing, TargetRing;
6429  intvec* iv_M;
6430  intvec* iv_M_dp;
6431  intvec* iv_M_lp;
6432  intvec* exivlp = Mivlp(nV);
6433  intvec* curr_weight = new intvec(nV);
6434  intvec* target_weight = new intvec(nV);
6435  for(i=0; i<nV; i++)
6436  {
6437    (*curr_weight)[i] = (*orig_M)[i];
6438    (*target_weight)[i] = (*target_M)[i];
6439  }
6440  intvec* orig_target = target_weight;
6441  intvec* pert_target_vector = target_weight;
6442  intvec* ivNull = new intvec(nV);
6443  intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
6444#ifndef BUCHBERGER_ALG
6445  intvec* hilb_func;
6446#endif
6447  intvec* next_weight;
6448
6449  // to avoid (1,0,...,0) as the target vector
6450  intvec* last_omega = new intvec(nV);
6451  for(i=nV-1; i>0; i--)
6452    (*last_omega)[i] = 1;
6453  (*last_omega)[0] = 10000;
6454
6455  ring XXRing = currRing;
6456
6457  // perturbs the original vector
6458  if(orig_M->length() == nV)
6459  {
6460    if(MivComp(curr_weight, iv_dp) == 1) //rOrdStr(currRing) := "dp"
6461    {
6462#ifdef TIME_TEST
6463  to = clock();
6464#endif
6465      G = MstdCC(Go);
6466#ifdef TIME_TEST
6467      tostd = clock()-to;
6468#endif
6469      if(op_deg != 1)
6470      {
6471        iv_M_dp = MivMatrixOrderdp(nV);
6472        curr_weight = MPertVectors(G, iv_M_dp, op_deg);
6473      }
6474    }
6475    else
6476    {
6477      //define ring order := (a(curr_weight),lp);
6478      if (rParameter(currRing) != NULL)
6479        DefRingPar(curr_weight);
6480      else
6481        rChangeCurrRing(VMrDefault(curr_weight));
6482
6483      G = idrMoveR(Go, XXRing,currRing);
6484#ifdef TIME_TEST
6485  to = clock();
6486#endif
6487      G = MstdCC(G);
6488#ifdef TIME_TEST
6489      tostd = clock()-to;
6490#endif
6491      if(op_deg != 1)
6492      {
6493        iv_M_dp = MivMatrixOrder(curr_weight);
6494        curr_weight = MPertVectors(G, iv_M_dp, op_deg);
6495      }
6496    }
6497  }
6498  else
6499  {
6500    rChangeCurrRing(VMatrDefault(orig_M));
6501    G = idrMoveR(Go, XXRing,currRing);
6502#ifdef TIME_TEST
6503    to = clock();
6504#endif
6505    G = MstdCC(G);
6506#ifdef TIME_TEST
6507    tostd = clock()-to;
6508#endif
6509    if(op_deg != 1)
6510    {
6511      curr_weight = MPertVectors(G, orig_M, op_deg);
6512    }
6513  }
6514
6515  delete iv_dp;
6516  if(op_deg != 1) delete iv_M_dp;
6517
6518  ring HelpRing = currRing;
6519
6520  // perturbs the target weight vector
6521  if(target_M->length() == nV)
6522  {
6523    if(tp_deg > 1 && tp_deg <= nV)
6524    {
6525      if (rParameter(currRing) != NULL)
6526        DefRingPar(target_weight);
6527      else
6528        rChangeCurrRing(VMrDefault(target_weight));
6529
6530      TargetRing = currRing;
6531      ssG = idrMoveR(G,HelpRing,currRing);
6532      if(MivSame(target_weight, exivlp) == 1)
6533      {
6534        iv_M_lp = MivMatrixOrderlp(nV);
6535        target_weight = MPertVectors(ssG, iv_M_lp, tp_deg);
6536      }
6537      else
6538      {
6539        iv_M_lp = MivMatrixOrder(target_weight);
6540        target_weight = MPertVectors(ssG, iv_M_lp, tp_deg);
6541      }
6542      delete iv_M_lp;
6543      pert_target_vector = target_weight;
6544      rChangeCurrRing(HelpRing);
6545      G = idrMoveR(ssG, TargetRing,currRing);
6546    }
6547  }
6548  else
6549  {
6550    if(tp_deg > 1 && tp_deg <= nV)
6551    {
6552      rChangeCurrRing(VMatrDefault(target_M));
6553      TargetRing = currRing;
6554      ssG = idrMoveR(G,HelpRing,currRing);
6555      target_weight = MPertVectors(ssG, target_M, tp_deg);
6556    }
6557  }
6558  if(printout > 0)
6559  {
6560    Print("\n//** Mprwalk: Random Perturbation Walk of degree (%d,%d):",op_deg,tp_deg);
6561    ivString(curr_weight, "//** Mprwalk: new current weight");
6562    ivString(target_weight, "//** Mprwalk: new target weight");
6563  }
6564
6565#ifdef TIME_TEST
6566  to = clock();
6567#endif
6568  Gomega = MwalkInitialForm(G, curr_weight); // compute an initial form ideal of <G> w.r.t. "curr_vector"
6569#ifdef TIME_TEST
6570  tif = tif + clock()-to; //time for computing initial form ideal
6571#endif
6572
6573  while(1)
6574  {
6575    nstep ++;
6576#ifdef CHECK_IDEAL_MWALK
6577    if(printout > 1)
6578    {
6579      idString(Gomega,"//** Mprwalk: Gomega");
6580    }
6581#endif
6582
6583    if(reduction == 0 && nstep > 1)
6584    {
6585      FF = middleOfCone(G,Gomega);
6586      if(FF != NULL)
6587      {
6588        idDelete(&G);
6589        G = idCopy(FF);
6590        idDelete(&FF);
6591        goto NEXT_VECTOR;
6592      }
6593    }
6594
6595#ifdef ENDWALKS
6596    if(endwalks == TRUE)
6597    {
6598      if(printout > 0)
6599      {
6600        Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6601        //idElements(G, "G");
6602        //headidString(G, "G");
6603      }
6604    }
6605#endif
6606
6607#ifndef  BUCHBERGER_ALG
6608    if(isNolVector(curr_weight) == 0)
6609      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
6610    else
6611      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
6612#endif // BUCHBERGER_ALG
6613
6614    oldRing = currRing;
6615
6616    if(target_M->length() == nV)
6617    {/*
6618      // define a new ring with ordering "(a(curr_weight),lp)
6619      if (rParameter(currRing) != NULL)
6620        DefRingPar(curr_weight);
6621      else
6622        rChangeCurrRing(VMrDefault(curr_weight));
6623*/
6624      rChangeCurrRing(VMrRefine(target_M,curr_weight));
6625    }
6626    else
6627    {
6628      rChangeCurrRing(VMatrRefine(target_M,curr_weight));
6629    }
6630    newRing = currRing;
6631    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
6632#ifdef ENDWALKS
6633    if(endwalks == TRUE)
6634    {
6635      if(printout > 0)
6636      {
6637        Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6638
6639        //idElements(Gomega1, "Gw");
6640        //headidString(Gomega1, "headGw");
6641
6642        PrintS("\n// compute a rGB of Gw:\n");
6643      }
6644#ifndef  BUCHBERGER_ALG
6645      ivString(hilb_func, "w");
6646#endif
6647    }
6648#endif
6649#ifdef TIME_TEST
6650    tim = clock();
6651    to = clock();
6652#endif
6653    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
6654#ifdef  BUCHBERGER_ALG
6655    M = MstdhomCC(Gomega1);
6656#else
6657    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
6658    delete hilb_func;
6659#endif
6660#ifdef CHECK_IDEAL_MWALK
6661    if(printout > 2)
6662    {
6663      idString(M,"//** Mprwalk: M");
6664    }
6665#endif
6666#ifdef TIME_TEST
6667    if(endwalks == TRUE)
6668    {
6669      xtstd = xtstd+clock()-to;
6670#ifdef ENDWALKS
6671      Print("\n// time for the last std(Gw)  = %.2f sec\n",
6672            ((double) clock())/1000000 -((double)tim) /1000000);
6673#endif
6674    }
6675    else
6676      tstd=tstd+clock()-to;
6677#endif
6678    /* change the ring to oldRing */
6679    rChangeCurrRing(oldRing);
6680    M1 =  idrMoveR(M, newRing,currRing);
6681    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
6682#ifdef TIME_TEST
6683    to=clock();
6684#endif
6685    /* compute a representation of the generators of submod (M)
6686       with respect to those of mod (Gomega).
6687       Gomega is a reduced Groebner basis w.r.t. the current ring */
6688    F = MLifttwoIdeal(Gomega2, M1, G);
6689#ifdef TIME_TEST
6690    if(endwalks == FALSE)
6691      tlift = tlift+clock()-to;
6692    else
6693      xtlift=clock()-to;
6694#endif
6695#ifdef CHECK_IDEAL_MWALK
6696    if(printout > 2)
6697    {
6698      idString(F,"//** Mprwalk: F");
6699    }
6700#endif
6701
6702    idDelete(&M1);
6703    idDelete(&Gomega2);
6704    idDelete(&G);
6705
6706    // change the ring to newRing
6707    rChangeCurrRing(newRing);
6708    if(reduction == 0)
6709    {
6710      G = idrMoveR(F,oldRing,currRing);
6711    }
6712    else
6713    {
6714      F1 = idrMoveR(F, oldRing,currRing);
6715      if(printout > 2)
6716      {
6717        PrintS("\n //** Mprwalk: reduce the Groebner basis.\n");
6718      }
6719#ifdef TIME_TEST
6720      to=clock();
6721#endif
6722      G = kInterRedCC(F1, NULL);
6723#ifdef TIME_TEST
6724      if(endwalks == FALSE)
6725        tred = tred+clock()-to;
6726      else
6727        xtred=clock()-to;
6728#endif
6729      idDelete(&F1);
6730    }
6731
6732    if(endwalks == TRUE)
6733      break;
6734
6735    NEXT_VECTOR:
6736#ifdef TIME_TEST
6737    to = clock();
6738#endif
6739    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
6740#ifdef TIME_TEST
6741    tnw = tnw + clock() - to;
6742#endif
6743
6744#ifdef TIME_TEST
6745    to = clock();
6746#endif
6747    // compute an initial form ideal of <G> w.r.t. "next_vector"
6748    Gomega = MwalkInitialForm(G, next_weight);
6749#ifdef TIME_TEST
6750    tif = tif + clock()-to; //time for computing initial form ideal
6751#endif
6752
6753    //lengthpoly(Gomega) = 1 if there is a polynomial in Gomega with at least 3 monomials and 0 otherwise
6754    if(lengthpoly(Gomega) > 0)
6755    {
6756      if(printout > 1)
6757      {
6758        PrintS("\n Mpwalk: there is a polynomial in Gomega with at least 3 monomials.\n");
6759      }
6760      // low-dimensional facet of the cone
6761      delete next_weight;
6762      if(target_M->length() == nV)
6763      {
6764        iv_M = MivMatrixOrder(curr_weight);
6765      }
6766      else
6767      {
6768        iv_M = MivMatrixOrderRefine(curr_weight,target_M);
6769      }
6770#ifdef TIME_TEST
6771      to = clock();
6772#endif
6773      next_weight = MWalkRandomNextWeight(G, iv_M, target_weight, weight_rad, op_deg);
6774#ifdef TIME_TEST
6775      tnw = tnw + clock() - to;
6776#endif
6777      idDelete(&Gomega);
6778#ifdef TIME_TEST
6779      to = clock();
6780#endif
6781      Gomega = MwalkInitialForm(G, next_weight);
6782#ifdef TIME_TEST
6783      tif = tif + clock()-to; //time for computing initial form ideal
6784#endif
6785      delete iv_M;
6786    }
6787
6788#ifdef PRINT_VECTORS
6789    if(printout > 0)
6790    {
6791      MivString(curr_weight, target_weight, next_weight);
6792    }
6793#endif
6794
6795    if(Overflow_Error == TRUE)
6796    {
6797      ntwC = 0;
6798      //Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6799      //idElements(G, "G");
6800      delete next_weight;
6801      goto FINISH_160302;
6802    }
6803    if(MivComp(next_weight, ivNull) == 1){
6804      newRing = currRing;
6805      delete next_weight;
6806      //Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6807      break;
6808    }
6809    if(MivComp(next_weight, target_weight) == 1)
6810      endwalks = TRUE;
6811
6812    for(i=nV-1; i>=0; i--)
6813      (*curr_weight)[i] = (*next_weight)[i];
6814
6815    delete next_weight;
6816  }// end of while-loop
6817
6818  if(tp_deg != 1)
6819  {
6820    FINISH_160302:
6821    if(target_M->length() == nV)
6822    {
6823      if(MivSame(orig_target, exivlp) == 1)
6824        if (rParameter(currRing) != NULL)
6825          DefRingParlp();
6826        else
6827          VMrDefaultlp();
6828      else
6829        if (rParameter(currRing) != NULL)
6830          DefRingPar(orig_target);
6831        else
6832          rChangeCurrRing(VMrDefault(orig_target));
6833    }
6834    else
6835    {
6836      rChangeCurrRing(VMatrDefault(target_M));
6837    }
6838    TargetRing=currRing;
6839    F1 = idrMoveR(G, newRing,currRing);
6840
6841    // check whether the pertubed target vector stays in the correct cone
6842    if(ntwC != 0)
6843    {
6844      ntestw = test_w_in_ConeCC(F1, pert_target_vector);
6845    }
6846    if(ntestw != 1 || ntwC == 0)
6847    {
6848      if(ntestw != 1 && printout > 2)
6849      {
6850#ifdef PRINT_VECTORS
6851        ivString(pert_target_vector, "tau");
6852#endif
6853        PrintS("\n// **Mprwalk: perturbed target vector doesn't stay in cone.");
6854        Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6855        //idElements(F1, "G");
6856      }
6857      // LastGB is "better" than the kStd subroutine
6858#ifdef TIME_TEST
6859      to=clock();
6860#endif
6861      ideal eF1;
6862      if(nP == 0 || tp_deg == 1 || MivSame(orig_target, exivlp) != 1 || target_M->length() != nV)
6863      {
6864        if(printout > 2)
6865        {
6866          PrintS("\n// ** Mprwalk: Call \"std\" to compute a Groebner basis.\n");
6867        }
6868        eF1 = MstdCC(F1);
6869        idDelete(&F1);
6870      }
6871      else
6872      {
6873        if(printout > 2)
6874        {
6875          PrintS("\n// **Mprwalk: Call \"LastGB\" to compute a Groebner basis.\n");
6876        }
6877        rChangeCurrRing(newRing);
6878        ideal F2 = idrMoveR(F1, TargetRing,currRing);
6879        eF1 = LastGB(F2, curr_weight, tp_deg-1);
6880        F2=NULL;
6881      }
6882#ifdef TIME_TEST
6883      xtextra=clock()-to;
6884#endif
6885      ring exTargetRing = currRing;
6886
6887      rChangeCurrRing(XXRing);
6888      Eresult = idrMoveR(eF1, exTargetRing,currRing);
6889    }
6890    else
6891    {
6892      rChangeCurrRing(XXRing);
6893      Eresult = idrMoveR(F1, TargetRing,currRing);
6894    }
6895  }
6896  else
6897  {
6898    rChangeCurrRing(XXRing);
6899    Eresult = idrMoveR(G, newRing,currRing);
6900  }
6901  si_opt_1 = save1; //set original options, e. g. option(RedSB)
6902  delete ivNull;
6903  if(tp_deg != 1)
6904    delete target_weight;
6905
6906  if(op_deg != 1 )
6907    delete curr_weight;
6908
6909  delete exivlp;
6910  delete last_omega;
6911
6912#ifdef TIME_TEST
6913  TimeStringFractal(tinput, tostd, tif+xtif, tstd+xtstd,0, tlift+xtlift, tred+xtred,
6914             tnw+xtnw);
6915
6916  //Print("\n// pSetm_Error = (%d)", ErrorCheck());
6917  //Print("\n// It took %d steps and Overflow_Error? (%d)\n", nstep,  Overflow_Error);
6918#endif
6919
6920  if(printout > 0)
6921  {
6922    Print("\n//** Mprwalk: Perturbation Walk took %d steps.\n", nstep);
6923  }
6924  return(Eresult);
6925}
6926
6927VAR intvec* XivNull;
6928
6929/*****************************
6930 * define a matrix (1 ... 1) *
6931 *****************************/
6932intvec* MMatrixone(int nV)
6933{
6934  int i,j;
6935  intvec* ivM = new intvec(nV*nV);
6936
6937  for(i=0; i<nV; i++)
6938    for(j=0; j<nV; j++)
6939    (*ivM)[i*nV + j] = 1;
6940
6941  return(ivM);
6942}
6943
6944VAR int nnflow;
6945VAR int Xcall;
6946VAR int Xngleich;
6947
6948/***********************************************************************
6949 * Perturb the start weight vector at the top level, i.e. nlev = 1     *
6950 ***********************************************************************/
6951static ideal rec_fractal_call(ideal G, int nlev, intvec* ivtarget,
6952             int reduction, int printout)
6953{
6954  Overflow_Error =  FALSE;
6955  if(printout >0)
6956  {
6957    Print("\n\n// Entering the %d-th recursion:", nlev);
6958  }
6959  int i, nV = currRing->N;
6960  ring new_ring, testring;
6961  //ring extoRing;
6962  ideal Gomega, Gomega1, Gomega2, FF, F, Gresult, Gresult1, G1, Gt;
6963  int nwalks = 0;
6964  intvec* Mwlp;
6965#ifndef BUCHBERGER_ALG
6966  intvec* hilb_func;
6967#endif
6968  //intvec* extXtau;
6969  intvec* next_vect;
6970  intvec* omega2 = new intvec(nV);
6971  intvec* omtmp = new intvec(nV);
6972  //intvec* altomega = new intvec(nV);
6973
6974  for(i = nV -1; i>=0; i--)//Aenderung!!
6975  {
6976    (*omtmp)[i] = (*ivtarget)[i];
6977  }
6978  //BOOLEAN isnewtarget = FALSE;
6979
6980  // to avoid (1,0,...,0) as the target vector (Hans)
6981  intvec* last_omega = new intvec(nV);
6982  for(i=nV-1; i>0; i--)
6983    (*last_omega)[i] = 1;
6984  (*last_omega)[0] = 10000;
6985
6986  intvec* omega = new intvec(nV);
6987  for(i=0; i<nV; i++) {
6988    if(Xsigma->length() == nV)
6989      (*omega)[i] =  (*Xsigma)[i];
6990    else
6991      (*omega)[i] = (*Xsigma)[(nV*(nlev-1))+i];
6992
6993    (*omega2)[i] = (*Xtau)[(nlev-1)*nV+i];
6994  }
6995
6996   if(nlev == 1)  Xcall = 1;
6997   else Xcall = 0;
6998
6999  ring oRing = currRing;
7000
7001  while(1)
7002  {
7003#ifdef FIRST_STEP_FRACTAL
7004    // perturb the current weight vector only on the top level or
7005    // after perturbation of the both vectors, nlev = 2 as the top level
7006    if((nlev == 1 && Xcall == 0) || (nlev == 2 && Xngleich == 1))
7007      if(islengthpoly2(G) == 1)
7008      {
7009        Mwlp = MivWeightOrderlp(omega);
7010        Xsigma = Mfpertvector(G, Mwlp);
7011        delete Mwlp;
7012        Overflow_Error = FALSE;
7013      }
7014#endif
7015    nwalks ++;
7016    NEXT_VECTOR_FRACTAL:
7017#ifdef TIME_TEST
7018    to=clock();
7019#endif
7020    // determine the next border
7021    next_vect = MkInterRedNextWeight(omega,omega2,G);
7022#ifdef TIME_TEST
7023    xtnw=xtnw+clock()-to;
7024#endif
7025    oRing = currRing;
7026
7027    // We only perturb the current target vector at the recursion level 1
7028    if(Xngleich == 0 && nlev == 1) //(ngleich == 0) important, e.g. ex2, ex3
7029      if (MivComp(next_vect, omega2) == 1)
7030      {
7031        // to dispense with taking initial (and lifting/interreducing
7032        // after the call of recursion
7033        if(printout > 0)
7034        {
7035          Print("\n//** rec_fractal_call: Perturb the both vectors with degree %d.",nlev);
7036          //idElements(G, "G");
7037        }
7038
7039        Xngleich = 1;
7040        nlev +=1;
7041
7042        if(ivtarget->length() == nV)
7043        {
7044/*
7045          if (rParameter(currRing) != NULL)
7046            DefRingPar(omtmp);
7047          else
7048            rChangeCurrRing(VMrDefault(omtmp));
7049*/
7050          rChangeCurrRing(VMrRefine(ivtarget,omtmp));
7051        }
7052        else
7053        {
7054          //rChangeCurrRing(VMatrDefault(ivtarget));
7055          rChangeCurrRing(VMatrRefine(ivtarget,omtmp));
7056        }
7057        testring = currRing;
7058        Gt = idrMoveR(G, oRing,currRing);
7059
7060        // perturb the original target vector w.r.t. the current GB
7061        if(ivtarget->length() == nV)
7062        {
7063          delete Xtau;
7064          Xtau = NewVectorlp(Gt);
7065        }
7066        else
7067        {
7068          delete Xtau;
7069          Xtau = Mfpertvector(Gt,ivtarget);
7070        }
7071
7072        rChangeCurrRing(oRing);
7073        G = idrMoveR(Gt, testring,currRing);
7074
7075        // perturb the current vector w.r.t. the current GB
7076        Mwlp = MivWeightOrderlp(omega);
7077        Xsigma = Mfpertvector(G, Mwlp);
7078        delete Mwlp;
7079
7080        for(i=nV-1; i>=0; i--) {
7081          (*omega2)[i] = (*Xtau)[nV+i];
7082          (*omega)[i] = (*Xsigma)[nV+i];
7083        }
7084
7085        delete next_vect;
7086#ifdef TIME_TEST
7087        to=clock();
7088#endif
7089        // to avoid the value of Overflow_Error that occur in Mfpertvector
7090        Overflow_Error = FALSE;
7091        next_vect = MkInterRedNextWeight(omega,omega2,G);
7092#ifdef TIME_TEST
7093        xtnw=xtnw+clock()-to;
7094#endif
7095      }// end of (if MivComp(next_vect, omega2) == 1)
7096
7097#ifdef PRINT_VECTORS
7098      if(printout > 0)
7099      {
7100        MivString(omega, omega2, next_vect);
7101      }
7102#endif
7103
7104    // check whether the the computed vector is in the correct cone.
7105    // If no, compute the reduced Groebner basis of an omega-homogeneous
7106    // ideal with Buchberger's algorithm and stop this recursion step
7107    if(Overflow_Error == TRUE || test_w_in_ConeCC(G, next_vect) != 1)  //e.g. Example s7, cyc6
7108    {
7109      delete next_vect;
7110      if(ivtarget->length() == nV)
7111      {
7112/*
7113        if (rParameter(currRing) != NULL)
7114          DefRingPar(omtmp);
7115        else
7116          rChangeCurrRing(VMrDefault(omtmp));
7117*/
7118        rChangeCurrRing(VMrRefine(ivtarget,omtmp));
7119      }
7120      else
7121      {
7122        //rChangeCurrRing(VMatrDefault(ivtarget));
7123        rChangeCurrRing(VMatrRefine(ivtarget,omtmp));
7124      }
7125#ifdef TEST_OVERFLOW
7126      Gt = idrMoveR(G, oRing,currRing);
7127      Gt = NULL; return(Gt);
7128#endif
7129      if(printout > 0)
7130      {
7131        Print("\n//** rec_fractal_call: Applying Buchberger's algorithm in ring r = %s;",
7132              rString(currRing));
7133      }
7134#ifdef TIME_TEST
7135      to=clock();
7136#endif
7137      Gt = idrMoveR(G, oRing,currRing);
7138      G1 = MstdCC(Gt);
7139#ifdef TIME_TEST
7140      xtextra=xtextra+clock()-to;
7141#endif
7142      Gt = NULL;
7143
7144      delete omega2;
7145      //delete altomega;
7146      if(printout > 0)
7147      {
7148        Print("\n//** rec_fractal_call: Overflow. (4) Leaving the %d-th recursion with %d steps.\n",
7149              nlev, nwalks);
7150        //Print(" ** Overflow_Error? (%d)", Overflow_Error);
7151      }
7152
7153      nnflow ++;
7154      Overflow_Error = FALSE;
7155      return (G1);
7156    }
7157
7158    /* If the perturbed target vector stays in the correct cone,
7159       return the current GB,
7160       otherwise, return the computed  GB by the Buchberger-algorithm.
7161       Then we update the perturbed target vectors w.r.t. this GB. */
7162
7163    /* the computed vector is equal to the origin vector, since
7164       t is not defined */
7165
7166    if (MivComp(next_vect, XivNull) == 1)
7167    {
7168      if(ivtarget->length() == nV)
7169      {
7170/*
7171        if (rParameter(currRing) != NULL)
7172          DefRingPar(omtmp);
7173        else
7174          rChangeCurrRing(VMrDefault(omtmp));
7175*/
7176        rChangeCurrRing(VMrRefine(ivtarget,omtmp));
7177      }
7178      else
7179      {
7180        //rChangeCurrRing(VMatrDefault(ivtarget));
7181        rChangeCurrRing(VMatrRefine(ivtarget,omtmp));
7182      }
7183
7184      testring = currRing;
7185      Gt = idrMoveR(G, oRing,currRing);
7186      if(test_w_in_ConeCC(Gt, omega2) == 1)
7187      {
7188        delete omega2;
7189        delete next_vect;
7190        //delete altomega;
7191        if(printout > 0)
7192        {
7193          Print("\n//** rec_fractal_call: Correct cone. (5) Leaving the %d-th recursion with %d steps.\n",
7194              nlev, nwalks);
7195        }
7196        if(printout>2)
7197        {
7198          idString(Gt,"//** rec_fractal_call: Gt");
7199        }
7200        return (Gt);
7201      }
7202      else
7203      {
7204        if(printout > 0)
7205        {
7206          PrintS("\n//** rec_fractal_call: Wrong cone. Tau doesn't stay in the correct cone.\n");
7207        }
7208
7209#ifndef  MSTDCC_FRACTAL
7210        intvec* Xtautmp;
7211        if(ivtarget->length() == nV)
7212        {
7213          Xtautmp = Mfpertvector(Gt, MivMatrixOrder(omtmp));
7214        }
7215        else
7216        {
7217          Xtautmp = Mfpertvector(Gt, ivtarget);
7218        }
7219#ifdef TEST_OVERFLOW
7220      if(Overflow_Error == TRUE)
7221      Gt = NULL; return(Gt);
7222#endif
7223
7224        if(MivSame(Xtau, Xtautmp) == 1)
7225        {
7226          if(printout > 0)
7227          {
7228            PrintS("\n//** rec_fractal_call: Updated vectors are equal to the old vectors.\n");
7229          }
7230          delete Xtautmp;
7231          goto FRACTAL_MSTDCC;
7232        }
7233
7234        Xtau = Xtautmp;
7235        Xtautmp = NULL;
7236
7237        for(i=nV-1; i>=0; i--)
7238          (*omega2)[i] = (*Xtau)[(nlev-1)*nV+i];
7239
7240        rChangeCurrRing(oRing);
7241        G = idrMoveR(Gt, testring,currRing);
7242
7243        goto NEXT_VECTOR_FRACTAL;
7244#endif
7245
7246      FRACTAL_MSTDCC:
7247        if(printout > 0)
7248        {
7249          Print("\n//** rec_fractal_call: Wrong cone. Applying Buchberger's algorithm in ring = %s.\n",
7250                rString(currRing));
7251        }
7252#ifdef TIME_TEST
7253        to=clock();
7254#endif
7255        G = MstdCC(Gt);
7256#ifdef TIME_TEST
7257        xtextra=xtextra+clock()-to;
7258#endif
7259        oRing = currRing;
7260
7261        // update the original target vector w.r.t. the current GB
7262        if(ivtarget->length() == nV)
7263        {
7264/*
7265          if(MivSame(Xivinput, Xivlp) == 1)
7266            if (rParameter(currRing) != NULL)
7267              DefRingParlp();
7268            else
7269              VMrDefaultlp();
7270          else
7271            if (rParameter(currRing) != NULL)
7272              DefRingPar(Xivinput);
7273            else
7274              rChangeCurrRing(VMrDefault(Xivinput));
7275*/
7276          rChangeCurrRing(VMrRefine(ivtarget,Xivinput));
7277        }
7278        else
7279        {
7280          rChangeCurrRing(VMatrRefine(ivtarget,Xivinput));
7281        }
7282        testring = currRing;
7283        Gt = idrMoveR(G, oRing,currRing);
7284
7285        // perturb the original target vector w.r.t. the current GB
7286        if(ivtarget->length() == nV)
7287        {
7288          delete Xtau;
7289          Xtau = NewVectorlp(Gt);
7290        }
7291        else
7292        {
7293          delete Xtau;
7294          Xtau = Mfpertvector(Gt,ivtarget);
7295        }
7296
7297        rChangeCurrRing(oRing);
7298        G = idrMoveR(Gt, testring,currRing);
7299
7300        delete omega2;
7301        delete next_vect;
7302        //delete altomega;
7303        if(printout > 0)
7304        {
7305          Print("\n//** rec_fractal_call: Vectors updated. (6) Leaving the %d-th recursion with %d steps.\n",
7306              nlev, nwalks);
7307          //Print(" ** Overflow_Error? (%d)", Overflow_Error);
7308        }
7309        if(Overflow_Error == TRUE)
7310          nnflow ++;
7311
7312        Overflow_Error = FALSE;
7313        return(G);
7314      }
7315    }// end of (if next_vect==nullvector)
7316
7317    for(i=nV-1; i>=0; i--) {
7318      //(*altomega)[i] = (*omega)[i];
7319      (*omega)[i] = (*next_vect)[i];
7320    }
7321    delete next_vect;
7322#ifdef TIME_TEST
7323    to=clock();
7324#endif
7325    // Take the initial form of <G> w.r.t. omega
7326    Gomega = MwalkInitialForm(G, omega);
7327#ifdef TIME_TEST
7328    xtif=xtif+clock()-to;
7329#endif
7330#ifdef CHECK_IDEAL_MWALK
7331    if(printout > 1)
7332    {
7333      idString(Gomega,"//** rec_fractal_call: Gomega");
7334    }
7335#endif
7336    if(reduction == 0)
7337    {
7338      // Check whether the intermediate weight vector lies in the interior of the cone.
7339      // If so, only perform reductions. Otherwise apply Buchberger's algorithm.
7340      FF = middleOfCone(G,Gomega);
7341      if( FF != NULL)
7342      {
7343        idDelete(&G);
7344        G = idCopy(FF);
7345        idDelete(&FF);
7346        // Compue next vector.
7347        goto NEXT_VECTOR_FRACTAL;
7348      }
7349    }
7350
7351#ifndef  BUCHBERGER_ALG
7352    if(isNolVector(omega) == 0)
7353      hilb_func = hFirstSeries(Gomega,NULL,NULL,omega,currRing);
7354    else
7355      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
7356#endif
7357
7358    if(ivtarget->length() == nV)
7359    {
7360/*
7361      if (rParameter(currRing) != NULL)
7362        DefRingPar(omega);
7363      else
7364        rChangeCurrRing(VMrDefault(omega));
7365*/
7366      rChangeCurrRing(VMrRefine(ivtarget,omega));
7367    }
7368    else
7369    {
7370      rChangeCurrRing(VMatrRefine(ivtarget,omega));
7371    }
7372    Gomega1 = idrMoveR(Gomega, oRing,currRing);
7373
7374    // Maximal recursion depth, to compute a red. GB
7375    // Fractal walk with the alternative recursion
7376    // alternative recursion
7377    if(nlev == Xnlev || lengthpoly(Gomega1) == 0)
7378    {
7379      if(printout > 1)
7380      {
7381        PrintS("\n//** rec_fractal_call: Maximal recursion depth.\n");
7382      }
7383#ifdef TIME_TEST
7384      to=clock();
7385#endif
7386#ifdef  BUCHBERGER_ALG
7387      Gresult = MstdhomCC(Gomega1);
7388#else
7389      Gresult =kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,omega);
7390      delete hilb_func;
7391#endif
7392#ifdef TIME_TEST
7393      xtstd=xtstd+clock()-to;
7394#endif
7395    }
7396    else
7397    {
7398      rChangeCurrRing(oRing);
7399      Gomega1 = idrMoveR(Gomega1, oRing,currRing);
7400      Gresult = rec_fractal_call(idCopy(Gomega1),nlev+1,omega,reduction,printout);
7401    }
7402#ifdef CHECK_IDEAL_MWALK
7403    if(printout > 2)
7404    {
7405      idString(Gresult,"//** rec_fractal_call: M");
7406    }
7407#endif
7408    //convert a Groebner basis from a ring to another ring
7409    new_ring = currRing;
7410
7411    rChangeCurrRing(oRing);
7412    Gresult1 = idrMoveR(Gresult, new_ring,currRing);
7413    Gomega2 = idrMoveR(Gomega1, new_ring,currRing);
7414#ifdef TIME_TEST
7415    to=clock();
7416#endif
7417    // Lifting process
7418    F = MLifttwoIdeal(Gomega2, Gresult1, G);
7419#ifdef TIME_TEST
7420    xtlift=xtlift+clock()-to;
7421#endif
7422#ifdef CHECK_IDEAL_MWALK
7423    if(printout > 2)
7424    {
7425      idString(F,"//** rec_fractal_call: F");
7426    }
7427#endif
7428    id_Normalize(F,currRing);
7429    idDelete(&Gresult1);
7430    idDelete(&Gomega2);
7431    idDelete(&G);
7432
7433    rChangeCurrRing(new_ring);
7434    G = idrMoveR(F,oRing,currRing);
7435/*
7436    ideal F1 = idrMoveR(F, oRing,currRing);
7437#ifdef TIME_TEST
7438    to=clock();
7439#endif
7440    // Interreduce G
7441    G = kInterRedCC(F1, NULL);
7442#ifdef TIME_TEST
7443    xtred=xtred+clock()-to;
7444#endif
7445    idDelete(&F1);
7446*/
7447  }
7448}
7449
7450/************************************************************************
7451 * Perturb the start weight vector at the top level with random element *
7452 ************************************************************************/
7453static ideal rec_r_fractal_call(ideal G, int nlev, intvec* ivtarget,
7454                int weight_rad, int reduction, int printout)
7455{
7456  Overflow_Error =  FALSE;
7457  //Print("\n\n// Entering the %d-th recursion:", nlev);
7458
7459  int nwalks = 0,i,nV=currRing->N;//polylength
7460  ring new_ring, testring;
7461  //ring extoRing;
7462  ideal Gomega, Gomega1, Gomega2, F, FF, Gresult, Gresult1, G1, Gt;
7463#ifdef TIME_TEST
7464  ideal F1;
7465#endif
7466  intvec* Mwlp;
7467#ifndef BUCHBERGER_ALG
7468  intvec* hilb_func;
7469#endif
7470//  intvec* extXtau;
7471  intvec* next_vect;
7472  intvec* iv_M;
7473  intvec* omega2 = new intvec(nV);
7474  intvec* omtmp = new intvec(nV);
7475  intvec* altomega = new intvec(nV);
7476
7477  //BOOLEAN isnewtarget = FALSE;
7478
7479  for(i = nV -1; i>=0; i--)
7480  {
7481    (*omtmp)[i] = (*ivtarget)[i];
7482  }
7483  // to avoid (1,0,...,0) as the target vector (Hans)
7484  intvec* last_omega = new intvec(nV);
7485  for(i=nV-1; i>0; i--)
7486    (*last_omega)[i] = 1;
7487  (*last_omega)[0] = 10000;
7488
7489  intvec* omega = new intvec(nV);
7490  for(i=0; i<nV; i++) {
7491    if(Xsigma->length() == nV)
7492      (*omega)[i] =  (*Xsigma)[i];
7493    else
7494      (*omega)[i] = (*Xsigma)[(nV*(nlev-1))+i];
7495
7496    (*omega2)[i] = (*Xtau)[(nlev-1)*nV+i];
7497  }
7498
7499   if(nlev == 1)  Xcall = 1;
7500   else Xcall = 0;
7501
7502  ring oRing = currRing;
7503
7504  while(1)
7505  {
7506#ifdef FIRST_STEP_FRACTAL
7507    /*
7508    perturb the current weight vector only on the top level or
7509    after perturbation of the both vectors, nlev = 2 as the top level
7510    */
7511    if((nlev == 1 && Xcall == 0) || (nlev == 2 && Xngleich == 1))
7512      if(islengthpoly2(G) == 1)
7513      {
7514        Mwlp = MivWeightOrderlp(omega);
7515        Xsigma = Mfpertvector(G, Mwlp);
7516        delete Mwlp;
7517        Overflow_Error = FALSE;
7518      }
7519#endif
7520    nwalks ++;
7521    NEXT_VECTOR_FRACTAL:
7522#ifdef TIME_TEST
7523    to=clock();
7524#endif
7525    /* determine the next border */
7526    next_vect = MkInterRedNextWeight(omega,omega2,G);
7527#ifdef TIME_TEST
7528    xtnw=xtnw+clock()-to;
7529#endif
7530    if(lengthpoly(MwalkInitialForm(G, next_vect)) > 0 && G->m[0] != NULL)
7531    {
7532      if(printout > 0)
7533      {
7534        PrintS("\n**// rec_r_fractal_call: there is a polynomial in Gomega with at least 3 monomials.\n");
7535      }
7536      delete next_vect;
7537      iv_M = MivMatrixOrder(omega);
7538#ifdef TIME_TEST
7539      to=clock();
7540#endif
7541      next_vect = MWalkRandomNextWeight(G,iv_M,omega2,weight_rad,nlev);
7542#ifdef TIME_TEST
7543      xtnw=xtnw+clock()-to;
7544#endif
7545      if(isNegNolVector(next_vect) == 1)
7546      {
7547        delete next_vect;
7548#ifdef TIME_TEST
7549        to=clock();
7550#endif
7551        next_vect = MkInterRedNextWeight(omega,omega2,G);
7552#ifdef TIME_TEST
7553        xtnw=xtnw+clock()-to;
7554#endif
7555      }
7556    }
7557    oRing = currRing;
7558
7559    // We only perturb the current target vector at the recursion  level 1
7560    if(Xngleich == 0 && nlev == 1) //(ngleich == 0) important, e.g. ex2, ex3
7561      if (MivComp(next_vect, omega2) == 1)
7562      {
7563        // to dispense with taking initials and lifting/interreducing
7564        // after the call of recursion.
7565        if(printout > 0)
7566        {
7567          Print("\n//** rec_r_fractal_call: Perturb both vectors with degree %d.",nlev);
7568          //idElements(G, "G");
7569        }
7570        Xngleich = 1;
7571        nlev +=1;
7572        if(ivtarget->length() == nV)
7573        {
7574/*
7575          if (rParameter(currRing) != NULL)
7576            DefRingPar(omtmp);
7577          else
7578            rChangeCurrRing(VMrDefault(omtmp));
7579*/
7580          rChangeCurrRing(VMrRefine(ivtarget,omtmp));
7581        }
7582        else
7583        {
7584          //rChangeCurrRing(VMatrDefault(ivtarget));
7585          rChangeCurrRing(VMatrRefine(ivtarget,omtmp));
7586        }
7587        testring = currRing;
7588        Gt = idrMoveR(G, oRing,currRing);
7589
7590        // perturb the original target vector w.r.t. the current GB
7591        if(ivtarget->length() == nV)
7592        {
7593          delete Xtau;
7594          Xtau = NewVectorlp(Gt);
7595        }
7596        else
7597        {
7598          delete Xtau;
7599          Xtau = Mfpertvector(Gt,ivtarget);
7600        }
7601
7602        rChangeCurrRing(oRing);
7603        G = idrMoveR(Gt,testring,currRing);
7604
7605        // perturb the current vector w.r.t. the current GB
7606        Mwlp = MivWeightOrderlp(omega);
7607        if(ivtarget->length() > nV)
7608        {
7609          delete Mwlp;
7610          Mwlp = MivMatrixOrderRefine(omega,ivtarget);
7611        }
7612        Xsigma = Mfpertvector(G, Mwlp);
7613        delete Mwlp;
7614
7615        for(i=nV-1; i>=0; i--)
7616        {
7617          (*omega2)[i] = (*Xtau)[nV+i];
7618          (*omega)[i] = (*Xsigma)[nV+i];
7619        }
7620
7621        delete next_vect;
7622
7623   //to avoid the value of Overflow_Error that occur in Mfpertvector
7624        Overflow_Error = FALSE;
7625#ifdef TIME_TEST
7626        to=clock();
7627#endif
7628        next_vect = MkInterRedNextWeight(omega,omega2,G);
7629#ifdef TIME_TEST
7630        xtnw=xtnw+clock()-to;
7631#endif
7632        if(lengthpoly(MwalkInitialForm(G, next_vect)) > 0 && G->m[0] != NULL)
7633        {
7634          // there is a polynomial in Gomega with at least 3 monomials
7635          iv_M = MivMatrixOrder(omega);
7636          delete next_vect;
7637#ifdef TIME_TEST
7638          to=clock();
7639#endif
7640          next_vect = MWalkRandomNextWeight(G,iv_M,omega2,weight_rad,nlev);
7641#ifdef TIME_TEST
7642          xtnw=xtnw+clock()-to;
7643#endif
7644          delete iv_M;
7645          if(isNegNolVector(next_vect) == 1)
7646          {
7647            delete next_vect;
7648#ifdef TIME_TEST
7649            to=clock();
7650#endif
7651            next_vect = MkInterRedNextWeight(omega,omega2,G);
7652#ifdef TIME_TEST
7653        xtnw=xtnw+clock()-to;
7654#endif
7655          }
7656        }
7657      }
7658#ifdef PRINT_VECTORS
7659      if(printout > 0)
7660      {
7661        MivString(omega, omega2, next_vect);
7662      }
7663#endif
7664
7665/*     check whether the the computed vector is in the correct cone
7666       If no, the reduced GB of an omega-homogeneous ideal will be
7667       computed by Buchberger algorithm and stop this recursion step
7668*/
7669    if(Overflow_Error == TRUE || test_w_in_ConeCC(G,next_vect) != 1)//e.g. Example s7, cyc6
7670    {
7671      delete next_vect;
7672      if(ivtarget->length() == nV)
7673      {
7674/*
7675        if (rParameter(currRing) != NULL)
7676        {
7677          DefRingPar(omtmp);
7678        }
7679        else
7680        {
7681          rChangeCurrRing(VMrDefault(omtmp));
7682        }
7683*/
7684        rChangeCurrRing(VMrRefine(ivtarget,omtmp));
7685      }
7686      else
7687      {
7688        //rChangeCurrRing(VMatrDefault(ivtarget));
7689        rChangeCurrRing(VMatrRefine(ivtarget,omtmp));
7690      }
7691#ifdef TEST_OVERFLOW
7692      Gt = idrMoveR(G, oRing,currRing);
7693      Gt = NULL;
7694      return(Gt);
7695#endif
7696      if(printout > 0)
7697      {
7698        Print("\n//** rec_r_fractal_call: applying Buchberger's algorithm in ring r = %s;",
7699              rString(currRing));
7700      }
7701      Gt = idrMoveR(G, oRing,currRing);
7702#ifdef TIME_TEST
7703      to=clock();
7704#endif
7705      G1 = MstdCC(Gt);
7706#ifdef TIME_TEST
7707      xtextra=xtextra+clock()-to;
7708#endif
7709      Gt = NULL;
7710
7711      delete omega2;
7712      delete altomega;
7713      if(printout > 0)
7714      {
7715        Print("\n//** rec_r_fractal_call: (1) Leaving the %d-th recursion with %d steps.\n",
7716              nlev, nwalks);
7717        //Print(" ** Overflow_Error? (%d)", Overflow_Error);
7718      }
7719      nnflow ++;
7720      Overflow_Error = FALSE;
7721      return (G1);
7722    }
7723    /*
7724       If the perturbed target vector stays in the correct cone,
7725       return the current Groebner basis.
7726       Otherwise, return the Groebner basis computed with Buchberger's
7727       algorithm.
7728       Then we update the perturbed target vectors w.r.t. this GB.
7729    */
7730    if (MivComp(next_vect, XivNull) == 1)
7731    {
7732      // The computed vector is equal to the origin vector,
7733      // because t is not defined
7734      if(ivtarget->length() == nV)
7735      {
7736/*
7737        if (rParameter(currRing) != NULL)
7738          DefRingPar(omtmp);
7739        else
7740          rChangeCurrRing(VMrDefault(omtmp));
7741*/
7742        rChangeCurrRing(VMrRefine(ivtarget,omtmp));
7743      }
7744      else
7745      {
7746        //rChangeCurrRing(VMatrDefault(ivtarget));
7747        rChangeCurrRing(VMatrRefine(ivtarget,omtmp));
7748      }
7749      testring = currRing;
7750      Gt = idrMoveR(G, oRing,currRing);
7751
7752      if(test_w_in_ConeCC(Gt, omega2) == 1)
7753      {
7754        delete omega2;
7755        delete next_vect;
7756        delete altomega;
7757        if(printout > 0)
7758        {
7759          Print("\n//** rec_r_fractal_call: (2) Leaving the %d-th recursion with %d steps.\n",
7760                nlev, nwalks);
7761          //Print(" ** Overflow_Error? (%d)", Overflow_Error);
7762        }
7763        return (Gt);
7764      }
7765      else
7766      {
7767        if(printout > 0)
7768        {
7769          Print("\n//** rec_r_fractal_call: target weight doesn't stay in the correct cone.\n");
7770        }
7771
7772#ifndef  MSTDCC_FRACTAL
7773#ifdef PRINT_VECTORS
7774        if(printout > 0)
7775        {
7776          ivString(Xtau, "old Xtau");
7777        }
7778#endif
7779        intvec* Xtautmp;
7780        if(ivtarget->length() == nV)
7781        {
7782          Xtautmp = Mfpertvector(Gt, MivMatrixOrder(omtmp));
7783        }
7784        else
7785        {
7786          Xtautmp = Mfpertvector(Gt, ivtarget);
7787        }
7788#ifdef TEST_OVERFLOW
7789      if(Overflow_Error == TRUE)
7790      Gt = NULL; return(Gt);
7791#endif
7792
7793        if(MivSame(Xtau, Xtautmp) == 1)
7794        {
7795          //PrintS("\n// Update vectors are equal to the old vectors!!");
7796          delete Xtautmp;
7797          goto FRACTAL_MSTDCC;
7798        }
7799
7800        Xtau = Xtautmp;
7801        Xtautmp = NULL;
7802#ifdef PRINT_VECTORS
7803        if(printout > 0)
7804        {
7805          ivString(Xtau, "new  Xtau");
7806        }
7807#endif
7808
7809        for(i=nV-1; i>=0; i--)
7810          (*omega2)[i] = (*Xtau)[(nlev-1)*nV+i];
7811
7812        //Print("\n//  ring tau = %s;", rString(currRing));
7813        rChangeCurrRing(oRing);
7814        G = idrMoveR(Gt, testring,currRing);
7815
7816        goto NEXT_VECTOR_FRACTAL;
7817#endif
7818
7819      FRACTAL_MSTDCC:
7820        if(printout > 0)
7821        {
7822          Print("\n//** rec_r_fractal_call: apply Buchberger's algorithm in ring = %s.\n",
7823                rString(currRing));
7824        }
7825#ifdef TIME_TEST
7826        to=clock();
7827#endif
7828        G = MstdCC(Gt);
7829#ifdef TIME_TEST
7830        xtextra=xtextra+clock()-to;
7831#endif
7832        oRing = currRing;
7833
7834        // update the original target vector w.r.t. the current GB
7835        if(ivtarget->length() == nV)
7836        {
7837/*
7838          if(MivSame(Xivinput, Xivlp) == 1)
7839            if (rParameter(currRing) != NULL)
7840              DefRingParlp();
7841            else
7842              VMrDefaultlp();
7843          else
7844            if (rParameter(currRing) != NULL)
7845              DefRingPar(Xivinput);
7846            else
7847              rChangeCurrRing(VMrDefault(Xivinput));
7848*/
7849          rChangeCurrRing(VMrRefine(ivtarget,Xivinput));
7850        }
7851        else
7852        {
7853          rChangeCurrRing(VMatrRefine(ivtarget,Xivinput));
7854        }
7855        testring = currRing;
7856        Gt = idrMoveR(G, oRing,currRing);
7857
7858        // perturb the original target vector w.r.t. the current GB
7859        if(ivtarget->length() == nV)
7860        {
7861          delete Xtau;
7862          Xtau = NewVectorlp(Gt);
7863        }
7864        else
7865        {
7866          delete Xtau;
7867          Xtau = Mfpertvector(Gt,ivtarget);
7868        }
7869
7870        rChangeCurrRing(oRing);
7871        G = idrMoveR(Gt, testring,currRing);
7872
7873        delete omega2;
7874        delete next_vect;
7875        delete altomega;
7876        if(printout > 0)
7877        {
7878          Print("\n//** rec_r_fractal_call: (3) Leaving the %d-th recursion with %d steps.\n",
7879                nlev,nwalks);
7880          //Print(" ** Overflow_Error? (%d)", Overflow_Error);
7881        }
7882        if(Overflow_Error == TRUE)
7883          nnflow ++;
7884
7885        Overflow_Error = FALSE;
7886        return(G);
7887      }
7888    } //end of if(MivComp(next_vect, XivNull) == 1)
7889
7890    for(i=nV-1; i>=0; i--)
7891    {
7892      (*altomega)[i] = (*omega)[i];
7893      (*omega)[i] = (*next_vect)[i];
7894    }
7895    delete next_vect;
7896#ifdef TIME_TEST
7897    to=clock();
7898#endif
7899    // Take the initial form of <G> w.r.t. omega
7900    Gomega = MwalkInitialForm(G, omega);
7901#ifdef TIME_TEST
7902    xtif=xtif+clock()-to;
7903#endif
7904    //polylength = 1 if there is a polynomial in Gomega with at least 3 monomials and 0 otherwise
7905    //polylength = lengthpoly(Gomega);
7906#ifdef CHECK_IDEAL_MWALK
7907    if(printout > 1)
7908    {
7909      idString(Gomega,"//** rec_r_fractal_call: Gomega");
7910    }
7911#endif
7912    if(reduction == 0)
7913    {
7914      /* Check whether the intermediate weight vector lies in the interior of the cone.
7915       * If so, only perform reductions. Otherwise apply Buchberger's algorithm. */
7916      FF = middleOfCone(G,Gomega);
7917      if( FF != NULL)
7918      {
7919        idDelete(&G);
7920        G = idCopy(FF);
7921        idDelete(&FF);
7922        /* Compue next vector. */
7923        goto NEXT_VECTOR_FRACTAL;
7924      }
7925    }
7926
7927#ifndef  BUCHBERGER_ALG
7928    if(isNolVector(omega) == 0)
7929      hilb_func = hFirstSeries(Gomega,NULL,NULL,omega,currRing);
7930    else
7931      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
7932#endif
7933    if(ivtarget->length() == nV)
7934    {
7935/*
7936      if (rParameter(currRing) != NULL)
7937        DefRingPar(omega);
7938      else
7939        rChangeCurrRing(VMrDefault(omega));
7940*/
7941      rChangeCurrRing(VMrRefine(ivtarget,omega));
7942    }
7943    else
7944    {
7945      rChangeCurrRing(VMatrRefine(ivtarget,omega));
7946    }
7947    Gomega1 = idrMoveR(Gomega, oRing,currRing);
7948
7949    // Maximal recursion depth, to compute a red. GB
7950    // Fractal walk with the alternative recursion
7951    // alternative recursion
7952    if(nlev == Xnlev || lengthpoly(Gomega1) == 0)
7953    {
7954#ifdef TIME_TEST
7955      to=clock();
7956#endif
7957#ifdef  BUCHBERGER_ALG
7958      Gresult = MstdhomCC(Gomega1);
7959#else
7960      Gresult =kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,omega);
7961      delete hilb_func;
7962#endif
7963#ifdef TIME_TEST
7964      xtstd=xtstd+clock()-to;
7965#endif
7966    }
7967    else
7968    {
7969      rChangeCurrRing(oRing);
7970      Gomega1 = idrMoveR(Gomega1, oRing,currRing);
7971      Gresult = rec_r_fractal_call(idCopy(Gomega1),nlev+1,omega,weight_rad,reduction,printout);
7972    }
7973#ifdef CHECK_IDEAL_MWALK
7974    if(printout > 2)
7975    {
7976      idString(Gresult,"//** rec_r_fractal_call: M");
7977    }
7978#endif
7979    //convert a Groebner basis from a ring to another ring
7980    new_ring = currRing;
7981
7982    rChangeCurrRing(oRing);
7983    Gresult1 = idrMoveR(Gresult, new_ring,currRing);
7984    Gomega2 = idrMoveR(Gomega1, new_ring,currRing);
7985#ifdef TIME_TEST
7986    to=clock();
7987#endif
7988    // Lifting process
7989    F = MLifttwoIdeal(Gomega2, Gresult1, G);
7990#ifdef TIME_TEST
7991    xtlift=xtlift+clock()-to;
7992#endif
7993#ifdef CHECK_IDEAL_MWALK
7994    if(printout > 2)
7995    {
7996      idString(F,"//** rec_r_fractal_call: F");
7997    }
7998#endif
7999    id_Normalize(F,currRing);
8000    idDelete(&Gresult1);
8001    idDelete(&Gomega2);
8002    idDelete(&G);
8003
8004    rChangeCurrRing(new_ring);
8005    //F1 = idrMoveR(F, oRing,currRing);
8006    G = idrMoveR(F,oRing,currRing);
8007/*
8008#ifdef TIME_TEST
8009    to=clock();
8010#endif
8011    // Interreduce G
8012    G = kInterRedCC(F1, NULL);
8013#ifdef TIME_TEST
8014    xtred=xtred+clock()-to;
8015#endif
8016    idDelete(&F1);
8017*/
8018  }
8019}
8020
8021
8022/*******************************************************************************
8023 * The implementation of the fractal walk algorithm                            *
8024 *                                                                             *
8025 * The main procedure Mfwalk calls the recursive Subroutine                    *
8026 * rec_fractal_call to compute the wanted Groebner basis.                      *
8027 * At the main procedur we compute the reduced Groebner basis w.r.t. a "fast"  *
8028 * order, e.g. "dp" and a sequence of weight vectors which are row vectors     *
8029 * of a matrix. This matrix defines the given monomial order, e.g. "lp"        *
8030 *******************************************************************************/
8031ideal Mfwalk(ideal G, intvec* ivstart, intvec* ivtarget,
8032             int reduction, int printout)
8033{
8034  BITSET save1 = si_opt_1; // save current options
8035  if(reduction == 0)
8036  {
8037    si_opt_1 &= (~Sy_bit(OPT_REDSB)); // no reduced Groebner basis
8038    //si_opt_1 &= (~Sy_bit(OPT_REDTAIL)); // not tail reductions
8039  }
8040  Set_Error(FALSE);
8041  Overflow_Error = FALSE;
8042  //Print("// pSetm_Error = (%d)", ErrorCheck());
8043  //Print("\n// ring ro = %s;", rString(currRing));
8044
8045  nnflow = 0;
8046  Xngleich = 0;
8047  Xcall = 0;
8048#ifdef TIME_TEST
8049  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0; xtextra=0;
8050  xftinput = clock();
8051#endif
8052  ring  oldRing = currRing;
8053  int i, nV = currRing->N;
8054  XivNull = new intvec(nV);
8055  Xivinput = ivtarget;
8056  ngleich = 0;
8057#ifdef TIME_TEST
8058  to=clock();
8059#endif
8060  ideal I = MstdCC(G);
8061  G = NULL;
8062#ifdef TIME_TEST
8063  xftostd=clock()-to;
8064#endif
8065  Xsigma = ivstart;
8066
8067  Xnlev=nV;
8068
8069#ifdef FIRST_STEP_FRACTAL
8070  ideal Gw = MwalkInitialForm(I, ivstart);
8071  for(i=IDELEMS(Gw)-1; i>=0; i--)
8072  {
8073    if((Gw->m[i]!=NULL) // len >=0
8074    && (Gw->m[i]->next!=NULL) // len >=1
8075    && (Gw->m[i]->next->next!=NULL)) // len >=2
8076    {
8077      intvec* iv_dp = MivUnit(nV); // define (1,1,...,1)
8078      intvec* Mdp;
8079      if(ivstart->length() == nV)
8080      {
8081        if(MivSame(ivstart, iv_dp) != 1)
8082          Mdp = MivWeightOrderdp(ivstart);
8083        else
8084          Mdp = MivMatrixOrderdp(nV);
8085      }
8086      else
8087      {
8088        Mdp = ivstart;
8089      }
8090
8091      Xsigma = Mfpertvector(I, Mdp);
8092      Overflow_Error = FALSE;
8093
8094      delete Mdp;
8095      delete iv_dp;
8096      break;
8097    }
8098  }
8099  idDelete(&Gw);
8100#endif
8101
8102  ideal I1;
8103  intvec* Mlp;
8104  Xivlp = Mivlp(nV);
8105
8106  if(ivtarget->length() == nV)
8107  {
8108    if(MivComp(ivtarget, Xivlp)  != 1)
8109    {
8110      if (rParameter(currRing) != NULL)
8111        DefRingPar(ivtarget);
8112      else
8113        rChangeCurrRing(VMrDefault(ivtarget));
8114
8115      I1 = idrMoveR(I, oldRing,currRing);
8116      Mlp = MivWeightOrderlp(ivtarget);
8117      Xtau = Mfpertvector(I1, Mlp);
8118    }
8119    else
8120    {
8121      if (rParameter(currRing) != NULL)
8122        DefRingParlp();
8123      else
8124        VMrDefaultlp();
8125
8126      I1 = idrMoveR(I, oldRing,currRing);
8127      Mlp =  MivMatrixOrderlp(nV);
8128      Xtau = Mfpertvector(I1, Mlp);
8129    }
8130  }
8131  else
8132  {
8133    rChangeCurrRing(VMatrDefault(ivtarget));
8134    I1 = idrMoveR(I,oldRing,currRing);
8135    Mlp =  ivtarget;
8136    Xtau = Mfpertvector(I1, Mlp);
8137  }
8138  delete Mlp;
8139  Overflow_Error = FALSE;
8140
8141  //ivString(Xsigma, "Xsigma");
8142  //ivString(Xtau, "Xtau");
8143
8144  id_Delete(&I, oldRing);
8145  ring tRing = currRing;
8146  if(ivtarget->length() == nV)
8147  {
8148/*
8149    if (rParameter(currRing) != NULL)
8150      DefRingPar(ivstart);
8151    else
8152      rChangeCurrRing(VMrDefault(ivstart));
8153*/
8154    rChangeCurrRing(VMrRefine(ivtarget,ivstart));
8155  }
8156  else
8157  {
8158    //rChangeCurrRing(VMatrDefault(ivstart));
8159    rChangeCurrRing(VMatrRefine(ivtarget,ivstart));
8160  }
8161
8162  I = idrMoveR(I1,tRing,currRing);
8163#ifdef TIME_TEST
8164  to=clock();
8165#endif
8166  ideal J = MstdCC(I);
8167  idDelete(&I);
8168#ifdef TIME_TEST
8169  xftostd=xftostd+clock()-to;
8170#endif
8171  ideal resF;
8172  ring helpRing = currRing;
8173
8174  J = rec_fractal_call(J,1,ivtarget,reduction,printout);
8175  //idString(J,"//** Mfwalk: J");
8176  rChangeCurrRing(oldRing);
8177  //Print("\n//Mfwalk: (2)\n");
8178  resF = idrMoveR(J, helpRing,currRing);
8179  //Print("\n//Mfwalk: (3)\n");
8180  idSkipZeroes(resF);
8181  //Print("\n//Mfwalk: (4)\n");
8182
8183  si_opt_1 = save1; //set original options, e. g. option(RedSB)
8184  delete Xivlp;
8185  //delete Xsigma;
8186  delete Xtau;
8187  delete XivNull;
8188  //Print("\n//Mfwalk: (5)\n");
8189#ifdef TIME_TEST
8190  TimeStringFractal(xftinput, xftostd, xtif, xtstd, xtextra,
8191                    xtlift, xtred, xtnw);
8192
8193
8194  //Print("\n// pSetm_Error = (%d)", ErrorCheck());
8195  Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
8196  Print("\n// the numbers of Overflow_Error (%d)", nnflow);
8197#endif
8198  //Print("\n//Mfwalk: (6)\n");
8199  //idString(resF,"//** Mfwalk: resF");
8200  return(idCopy(resF));
8201}
8202
8203/*******************************************************************************
8204 * The implementation of the fractal walk algorithm with random element        *
8205 *                                                                             *
8206 * The main procedur Mfwalk calls the recursive Subroutine                     *
8207 * rec_r_fractal_call to compute the wanted Groebner basis.                    *
8208 * At the main procedure we compute the reduced Groebner basis w.r.t. a "fast" *
8209 * order, e.g. "dp" and a sequence of weight vectors which are row vectors     *
8210 * of a matrix. This matrix defines the given monomial order, e.g. "lp"        *
8211 *******************************************************************************/
8212ideal Mfrwalk(ideal G, intvec* ivstart, intvec* ivtarget,
8213              int weight_rad, int reduction, int printout)
8214{
8215  BITSET save1 = si_opt_1; // save current options
8216  //check that weight radius is valid
8217  if(weight_rad < 0)
8218  {
8219    WerrorS("Invalid radius.\n");
8220    return NULL;
8221  }
8222  if(reduction == 0)
8223  {
8224    si_opt_1 &= (~Sy_bit(OPT_REDSB)); // no reduced Groebner basis
8225    si_opt_1 &= (~Sy_bit(OPT_REDTAIL)); // not tail reductions
8226  }
8227  Set_Error(FALSE);
8228  Overflow_Error = FALSE;
8229  //Print("// pSetm_Error = (%d)", ErrorCheck());
8230  //Print("\n// ring ro = %s;", rString(currRing));
8231
8232  nnflow = 0;
8233  Xngleich = 0;
8234  Xcall = 0;
8235#ifdef TIME_TEST
8236  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0; xtextra=0;
8237  xftinput = clock();
8238#endif
8239  ring  oldRing = currRing;
8240  int i, nV = currRing->N;
8241  XivNull = new intvec(nV);
8242  Xivinput = ivtarget;
8243  ngleich = 0;
8244#ifdef TIME_TEST
8245  to=clock();
8246#endif
8247  ideal I = MstdCC(G);
8248  G = NULL;
8249#ifdef TIME_TEST
8250  xftostd=clock()-to;
8251#endif
8252  Xsigma = ivstart;
8253
8254  Xnlev=nV;
8255
8256#ifdef FIRST_STEP_FRACTAL
8257  ideal Gw = MwalkInitialForm(I, ivstart);
8258  for(i=IDELEMS(Gw)-1; i>=0; i--)
8259  {
8260    if((Gw->m[i]!=NULL) // len >=0
8261    && (Gw->m[i]->next!=NULL) // len >=1
8262    && (Gw->m[i]->next->next!=NULL)) // len >=2
8263    {
8264      intvec* iv_dp = MivUnit(nV); // define (1,1,...,1)
8265      intvec* Mdp;
8266      if(ivstart->length() == nV)
8267      {
8268        if(MivSame(ivstart, iv_dp) != 1)
8269          Mdp = MivWeightOrderdp(ivstart);
8270        else
8271          Mdp = MivMatrixOrderdp(nV);
8272      }
8273      else
8274      {
8275        Mdp = ivstart;
8276      }
8277
8278      Xsigma = Mfpertvector(I, Mdp);
8279      Overflow_Error = FALSE;
8280
8281      delete Mdp;
8282      delete iv_dp;
8283      break;
8284    }
8285  }
8286  idDelete(&Gw);
8287#endif
8288
8289  ideal I1;
8290  intvec* Mlp;
8291  Xivlp = Mivlp(nV);
8292
8293  if(ivtarget->length() == nV)
8294  {
8295    if(MivComp(ivtarget, Xivlp)  != 1)
8296    {
8297      if (rParameter(currRing) != NULL)
8298        DefRingPar(ivtarget);
8299      else
8300        rChangeCurrRing(VMrDefault(ivtarget));
8301
8302      I1 = idrMoveR(I, oldRing,currRing);
8303      Mlp = MivWeightOrderlp(ivtarget);
8304      Xtau = Mfpertvector(I1, Mlp);
8305    }
8306    else
8307    {
8308      if (rParameter(currRing) != NULL)
8309        DefRingParlp();
8310      else
8311        VMrDefaultlp();
8312
8313      I1 = idrMoveR(I, oldRing,currRing);
8314      Mlp =  MivMatrixOrderlp(nV);
8315      Xtau = Mfpertvector(I1, Mlp);
8316    }
8317  }
8318  else
8319  {
8320    rChangeCurrRing(VMatrDefault(ivtarget));
8321    I1 = idrMoveR(I,oldRing,currRing);
8322    Mlp =  ivtarget;
8323    Xtau = Mfpertvector(I1, Mlp);
8324  }
8325  delete Mlp;
8326  Overflow_Error = FALSE;
8327
8328  //ivString(Xsigma, "Xsigma");
8329  //ivString(Xtau, "Xtau");
8330
8331  id_Delete(&I, oldRing);
8332  ring tRing = currRing;
8333  if(ivtarget->length() == nV)
8334  {
8335/*
8336    if (rParameter(currRing) != NULL)
8337      DefRingPar(ivstart);
8338    else
8339      rChangeCurrRing(VMrDefault(ivstart));
8340*/
8341    rChangeCurrRing(VMrRefine(ivtarget,ivstart));
8342  }
8343  else
8344  {
8345    //rChangeCurrRing(VMatrDefault(ivstart));
8346    rChangeCurrRing(VMatrRefine(ivtarget,ivstart));
8347  }
8348
8349  I = idrMoveR(I1,tRing,currRing);
8350#ifdef TIME_TEST
8351  to=clock();
8352#endif
8353  ideal J = MstdCC(I);
8354  idDelete(&I);
8355#ifdef TIME_TEST
8356  xftostd=xftostd+clock()-to;
8357#endif
8358  ideal resF;
8359  ring helpRing = currRing;
8360
8361  J = rec_r_fractal_call(J,1,ivtarget,weight_rad,reduction,printout);
8362  //idString(J,"//*** Mfrwalk: J");
8363  //Print("\n//** Mfrwalk hier (1)\n");
8364  rChangeCurrRing(oldRing);
8365  //Print("\n//** Mfrwalk hier (2)\n");
8366  resF = idrMoveR(J, helpRing,currRing);
8367  //Print("\n//** Mfrwalk hier (3)\n");
8368  //idSkipZeroes(resF);
8369  //Print("\n//** Mfrwalk hier (4)\n");
8370  si_opt_1 = save1; //set original options, e. g. option(RedSB)
8371  delete Xivlp;
8372  //delete Xsigma;
8373  delete Xtau;
8374  delete XivNull;
8375  //Print("\n//** Mfrwalk hier (5)\n");
8376#ifdef TIME_TEST
8377  TimeStringFractal(xftinput, xftostd, xtif, xtstd, xtextra,
8378                    xtlift, xtred, xtnw);
8379
8380
8381 // Print("\n// pSetm_Error = (%d)", ErrorCheck());
8382  Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
8383  Print("\n// the numbers of Overflow_Error (%d)", nnflow);
8384#endif
8385  //Print("\n//** Mfrwalk hier (6)\n");
8386  //idString(resF,"resF");
8387  //Print("\n//** Mfrwalk hier (7)\n");
8388  return(resF);
8389}
8390
8391/*******************************************************
8392 * Tran's algorithm                                    *
8393 *                                                     *
8394 * use kStd, if nP = 0, else call Ab_Rec_Pert (LastGB) *
8395 *******************************************************/
8396ideal TranMImprovwalk(ideal G,intvec* curr_weight,intvec* target_tmp, int nP)
8397{
8398#ifdef TIME_TEST
8399  clock_t mtim = clock();
8400#endif
8401  Set_Error(FALSE  );
8402  Overflow_Error =  FALSE;
8403  //Print("// pSetm_Error = (%d)", ErrorCheck());
8404  //Print("\n// ring ro = %s;", rString(currRing));
8405
8406#ifdef TIME_TEST
8407  clock_t tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0, textra=0;
8408  clock_t tinput = clock();
8409#endif
8410  int nsteppert=0, i, nV = currRing->N, nwalk=0, npert_tmp=0;
8411  int *npert=(int*)omAlloc(2*nV*sizeof(int));
8412  ideal Gomega, M,F,  G1, Gomega1, Gomega2, M1, F1;
8413  //ring endRing;
8414  ring newRing, oldRing, lpRing;
8415  intvec* next_weight;
8416  intvec* ivNull = new intvec(nV); //define (0,...,0)
8417  intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
8418  intvec* iv_lp = Mivlp(nV); //define (1,0,...,0)
8419  ideal H0;
8420  //ideal  H1;
8421  ideal H2, Glp;
8422  int nGB, endwalks = 0,  nwalkpert=0;
8423  intvec* Mlp =  MivMatrixOrderlp(nV);
8424  intvec* vector_tmp = new intvec(nV);
8425#ifndef BUCHBERGER_ALG
8426  intvec* hilb_func;
8427#endif
8428  // to avoid (1,0,...,0) as the target vector
8429  intvec* last_omega = new intvec(nV);
8430  for(i=nV-1; i>0; i--)
8431    (*last_omega)[i] = 1;
8432  (*last_omega)[0] = 10000;
8433
8434  //  intvec* extra_curr_weight = new intvec(nV);
8435  intvec* target_weight = new intvec(nV);
8436  for(i=nV-1; i>=0; i--)
8437    (*target_weight)[i] = (*target_tmp)[i];
8438
8439  ring XXRing = currRing;
8440  newRing = currRing;
8441
8442#ifdef TIME_TEST
8443  to=clock();
8444#endif
8445  // compute a red. GB w.r.t. the help ring
8446  if(MivComp(curr_weight, iv_dp) == 1) //rOrdStr(currRing) = "dp"
8447    G = MstdCC(G);
8448  else
8449  {
8450    //rOrdStr(currRing) = (a(.c_w..),lp,C)
8451    if (rParameter(currRing) != NULL)
8452      DefRingPar(curr_weight);
8453    else
8454      rChangeCurrRing(VMrDefault(curr_weight));
8455    G = idrMoveR(G, XXRing,currRing);
8456    G = MstdCC(G);
8457  }
8458#ifdef TIME_TEST
8459  tostd=clock()-to;
8460#endif
8461
8462#ifdef REPRESENTATION_OF_SIGMA
8463  ideal Gw = MwalkInitialForm(G, curr_weight);
8464
8465  if(islengthpoly2(Gw)==1)
8466  {
8467    intvec* MDp;
8468    if(MivComp(curr_weight, iv_dp) == 1)
8469      MDp = MatrixOrderdp(nV); //MivWeightOrderlp(iv_dp);
8470    else
8471      MDp = MivWeightOrderlp(curr_weight);
8472
8473    curr_weight = RepresentationMatrix_Dp(G, MDp);
8474
8475    delete MDp;
8476
8477    ring exring = currRing;
8478
8479    if (rParameter(currRing) != NULL)
8480      DefRingPar(curr_weight);
8481    else
8482      rChangeCurrRing(VMrDefault(curr_weight));
8483#ifdef TIME_TEST
8484    to=clock();
8485#endif
8486    Gw = idrMoveR(G, exring,currRing);
8487    G = MstdCC(Gw);
8488    Gw = NULL;
8489#ifdef TIME_TEST
8490    tostd=tostd+clock()-to;
8491#endif
8492    //ivString(curr_weight,"rep. sigma");
8493    goto COMPUTE_NEW_VECTOR;
8494  }
8495
8496  idDelete(&Gw);
8497  delete iv_dp;
8498#endif
8499
8500
8501  while(1)
8502  {
8503#ifdef TIME_TEST
8504    to=clock();
8505#endif
8506    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
8507    Gomega = MwalkInitialForm(G, curr_weight);
8508#ifdef TIME_TEST
8509    tif=tif+clock()-to;
8510#endif
8511
8512#ifndef  BUCHBERGER_ALG
8513    if(isNolVector(curr_weight) == 0)
8514      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
8515    else
8516      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
8517#endif // BUCHBERGER_ALG
8518
8519    oldRing = currRing;
8520
8521    /* define a new ring that its ordering is "(a(curr_weight),lp) */
8522    if (rParameter(currRing) != NULL)
8523      DefRingPar(curr_weight);
8524    else
8525      rChangeCurrRing(VMrDefault(curr_weight));
8526
8527    newRing = currRing;
8528    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
8529
8530#ifdef TIME_TEST
8531    to=clock();
8532#endif
8533    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
8534#ifdef  BUCHBERGER_ALG
8535    M = MstdhomCC(Gomega1);
8536#else
8537    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
8538    delete hilb_func;
8539#endif // BUCHBERGER_ALG
8540#ifdef TIME_TEST
8541    tstd=tstd+clock()-to;
8542#endif
8543
8544    /* change the ring to oldRing */
8545    rChangeCurrRing(oldRing);
8546    M1 =  idrMoveR(M, newRing,currRing);
8547    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
8548
8549#ifdef TIME_TEST
8550    to=clock();
8551#endif
8552    /* compute a representation of the generators of submod (M)
8553       with respect to those of mod (Gomega).
8554       Gomega is a reduced Groebner basis w.r.t. the current ring */
8555    F = MLifttwoIdeal(Gomega2, M1, G);
8556#ifdef TIME_TEST
8557    tlift=tlift+clock()-to;
8558#endif
8559
8560    idDelete(&M1);
8561    idDelete(&Gomega2);
8562    idDelete(&G);
8563
8564    /* change the ring to newRing */
8565    rChangeCurrRing(newRing);
8566    F1 = idrMoveR(F, oldRing,currRing);
8567
8568#ifdef TIME_TEST
8569    to=clock();
8570#endif
8571    /* reduce the Groebner basis <G> w.r.t. new ring */
8572    G = kInterRedCC(F1, NULL);
8573#ifdef TIME_TEST
8574    tred=tred+clock()-to;
8575#endif
8576    idDelete(&F1);
8577
8578
8579  COMPUTE_NEW_VECTOR:
8580    newRing = currRing;
8581    nwalk++;
8582    nwalkpert++;
8583#ifdef TIME_TEST
8584    to=clock();
8585#endif
8586    // compute a next weight vector
8587    next_weight = MwalkNextWeightCC(curr_weight,target_weight, G);
8588#ifdef TIME_TEST
8589    tnw=tnw+clock()-to;
8590#endif
8591#ifdef PRINT_VECTORS
8592    MivString(curr_weight, target_weight, next_weight);
8593#endif
8594
8595    /* check whether the computed intermediate weight vector is in
8596       the correct cone; sometimes it is very big e.g. s7, cyc7.
8597       If it is NOT in the correct cone, then compute directly
8598       a reduced Groebner basis with respect to the lexicographic ordering
8599       for the known Groebner basis that it is computed in the last step.
8600    */
8601    //if(test_w_in_ConeCC(G, next_weight) != 1)
8602    if(Overflow_Error == TRUE)
8603    {
8604    OMEGA_OVERFLOW_TRAN_NEW:
8605      //Print("\n//  takes %d steps!", nwalk-1);
8606      //Print("\n//ring lastRing = %s;", rString(currRing));
8607#ifdef TEST_OVERFLOW
8608      goto  BE_FINISH;
8609#endif
8610/*
8611#ifdef CHECK_IDEAL_MWALK
8612      idElements(G, "G");
8613      //headidString(G, "G");
8614#endif
8615*/
8616      if(MivSame(target_tmp, iv_lp) == 1)
8617        if (rParameter(currRing) != NULL)
8618          DefRingParlp();
8619        else
8620          VMrDefaultlp();
8621      else
8622        if (rParameter(currRing) != NULL)
8623          DefRingPar(target_tmp);
8624        else
8625          rChangeCurrRing(VMrDefault(target_tmp));
8626
8627      lpRing = currRing;
8628      G1 = idrMoveR(G, newRing,currRing);
8629
8630#ifdef TIME_TEST
8631      to=clock();
8632#endif
8633      /*apply kStd or LastGB to compute  a lex. red. Groebner basis of <G>*/
8634      if(nP == 0 || MivSame(target_tmp, iv_lp) == 0){
8635        //Print("\n\n// calls \"std in ring r_%d = %s;", nwalk, rString(currRing));
8636        G = MstdCC(G1);//no result for qnt1
8637      }
8638      else {
8639        rChangeCurrRing(newRing);
8640        G1 = idrMoveR(G1, lpRing,currRing);
8641
8642        //Print("\n\n// calls \"LastGB\" (%d) to compute a GB", nV-1);
8643        G = LastGB(G1, curr_weight, nV-1); //no result for kats7
8644
8645        rChangeCurrRing(lpRing);
8646        G = idrMoveR(G, newRing,currRing);
8647      }
8648#ifdef TIME_TEST
8649      textra=clock()-to;
8650#endif
8651      npert[endwalks]=nwalk-npert_tmp;
8652      npert_tmp = nwalk;
8653      endwalks ++;
8654      break;
8655    }
8656
8657    /* check whether the computed Groebner basis is really a Groebner basis.
8658       If not, we perturb the target vector with the maximal "perturbation"
8659       degree.*/
8660    if(MivComp(next_weight, target_weight) == 1 ||
8661       MivComp(next_weight, curr_weight) == 1 )
8662    {
8663      //Print("\n//ring r_%d = %s;", nwalk, rString(currRing));
8664
8665
8666      //compute the number of perturbations and its step
8667      npert[endwalks]=nwalk-npert_tmp;
8668      npert_tmp = nwalk;
8669
8670      endwalks ++;
8671
8672      /*it is very important if the walk only uses one step, e.g. Fate, liu*/
8673      if(endwalks == 1 && MivComp(next_weight, curr_weight) == 1){
8674        rChangeCurrRing(XXRing);
8675        G = idrMoveR(G, newRing,currRing);
8676        goto FINISH;
8677      }
8678      H0 = id_Head(G,currRing);
8679
8680      if(MivSame(target_tmp, iv_lp) == 1)
8681        if (rParameter(currRing) != NULL)
8682          DefRingParlp();
8683        else
8684          VMrDefaultlp();
8685      else
8686        if (rParameter(currRing) != NULL)
8687          DefRingPar(target_tmp);
8688        else
8689          rChangeCurrRing(VMrDefault(target_tmp));
8690
8691      lpRing = currRing;
8692      Glp = idrMoveR(G, newRing,currRing);
8693      H2 = idrMoveR(H0, newRing,currRing);
8694
8695      /* Apply Lemma 2.2 in Collart et. al (1997) to check whether
8696         cone(k-1) is equal to cone(k) */
8697      nGB = 1;
8698      for(i=IDELEMS(Glp)-1; i>=0; i--)
8699      {
8700        poly t;
8701        if((t=pSub(pHead(Glp->m[i]), pCopy(H2->m[i]))) != NULL)
8702        {
8703          pDelete(&t);
8704          idDelete(&H2);//5.5.02
8705          nGB = 0; //i.e. Glp is no reduced Groebner basis
8706          break;
8707        }
8708        pDelete(&t);
8709      }
8710
8711      idDelete(&H2);//5.5.02
8712
8713      if(nGB == 1)
8714      {
8715        G = Glp;
8716        Glp = NULL;
8717        break;
8718      }
8719
8720       /* perturb the target weight vector, if the vector target_tmp
8721          stays in many cones */
8722      poly p;
8723      BOOLEAN plength3 = FALSE;
8724      for(i=IDELEMS(Glp)-1; i>=0; i--)
8725      {
8726        p = MpolyInitialForm(Glp->m[i], target_tmp);
8727        if(p->next != NULL &&
8728           p->next->next != NULL &&
8729           p->next->next->next != NULL)
8730        {
8731          Overflow_Error = FALSE;
8732
8733          for(i=0; i<nV; i++)
8734            (*vector_tmp)[i] = (*target_weight)[i];
8735
8736          delete target_weight;
8737          target_weight = MPertVectors(Glp, Mlp, nV);
8738
8739          if(MivComp(vector_tmp, target_weight)==1)
8740          {
8741            //PrintS("\n// The old and new representaion vector are the same!!");
8742            G = Glp;
8743            newRing = currRing;
8744            goto OMEGA_OVERFLOW_TRAN_NEW;
8745           }
8746
8747          if(Overflow_Error == TRUE)
8748          {
8749            rChangeCurrRing(newRing);
8750            G = idrMoveR(Glp, lpRing,currRing);
8751            goto OMEGA_OVERFLOW_TRAN_NEW;
8752          }
8753
8754          plength3 = TRUE;
8755          pDelete(&p);
8756          break;
8757        }
8758        pDelete(&p);
8759      }
8760
8761      if(plength3 == FALSE)
8762      {
8763        rChangeCurrRing(newRing);
8764        G = idrMoveR(Glp, lpRing,currRing);
8765        goto TRAN_LIFTING;
8766      }
8767
8768
8769      nwalkpert = 1;
8770      nsteppert ++;
8771
8772      /*
8773      Print("\n// Subroutine needs (%d) steps.", nwalk);
8774      idElements(Glp, "last G in walk:");
8775      PrintS("\n// ****************************************");
8776      Print("\n// Perturb the original target vector (%d): ", nsteppert);
8777      ivString(target_weight, "new target");
8778      PrintS("\n// ****************************************\n");
8779      */
8780      rChangeCurrRing(newRing);
8781      G = idrMoveR(Glp, lpRing,currRing);
8782
8783      delete next_weight;
8784
8785      //Print("\n// ring rNEW = %s;", rString(currRing));
8786      goto COMPUTE_NEW_VECTOR;
8787    }
8788
8789  TRAN_LIFTING:
8790    for(i=nV-1; i>=0; i--)
8791      (*curr_weight)[i] = (*next_weight)[i];
8792
8793    delete next_weight;
8794  }//while
8795#ifdef TEST_OVERFLOW
8796 BE_FINISH:
8797#endif
8798  rChangeCurrRing(XXRing);
8799  G = idrMoveR(G, lpRing,currRing);
8800
8801 FINISH:
8802  delete ivNull;
8803  delete next_weight;
8804  delete iv_lp;
8805  omFree(npert);
8806/*
8807#ifdef TIME_TEST
8808  Print("\n// Computation took %d steps and %.2f sec",
8809        nwalk, ((double) (clock()-mtim)/1000000));
8810
8811  TimeStringFractal(tinput, tostd, tif, tstd, textra, tlift, tred, tnw);
8812
8813 // Print("\n// pSetm_Error = (%d)", ErrorCheck());
8814  Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
8815#endif
8816*/
8817  return(G);
8818}
8819
8820#if 0
8821/*******************************************************
8822 * Tran's algorithm with random element                *
8823 *                                                     *
8824 * use kStd, if nP = 0, else call Ab_Rec_Pert (LastGB) *
8825 *******************************************************/
8826ideal TranMrImprovwalk(ideal G,intvec* curr_weight,intvec* target_tmp, int nP, int weight_rad, int pert_deg)
8827{
8828#ifdef TIME_TEST
8829  clock_t mtim = clock();
8830#endif
8831  Set_Error(FALSE  );
8832  Overflow_Error =  FALSE;
8833  //Print("// pSetm_Error = (%d)", ErrorCheck());
8834  //Print("\n// ring ro = %s;", rString(currRing));
8835
8836#ifdef TIME_TEST
8837  VAR clock_t tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0, textra=0;
8838  VAR clock_t tinput = clock();
8839#endif
8840  VAR int nsteppert=0, i, nV = currRing->N, nwalk=0, npert_tmp=0;
8841  VAR int *npert=(int*)omAlloc(2*nV*sizeof(int));
8842  INST_VAR ideal Gomega, M,F,  G1, Gomega1, Gomega2, M1, F1;
8843  //ring endRing;
8844  VAR ring newRing, oldRing, lpRing;
8845  VAR intvec* next_weight;
8846  VAR intvec* ivNull = new intvec(nV); //define (0,...,0)
8847  VAR intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
8848  VAR intvec* iv_lp = Mivlp(nV); //define (1,0,...,0)
8849  INST_VAR ideal H0;
8850  //ideal H1;
8851  INST_VAR ideal H2, Glp;
8852  VAR int weight_norm, nGB, endwalks = 0,  nwalkpert=0,  npertstep=0;
8853  VAR intvec* Mlp =  MivMatrixOrderlp(nV);
8854  VAR intvec* vector_tmp = new intvec(nV);
8855#ifndef BUCHBERGER_ALG
8856  VAR intvec* hilb_func;
8857#endif
8858  // to avoid (1,0,...,0) as the target vector
8859  VAR intvec* last_omega = new intvec(nV);
8860  for(i=nV-1; i>0; i--)
8861  {
8862    (*last_omega)[i] = 1;
8863  }
8864  (*last_omega)[0] = 10000;
8865
8866//intvec* extra_curr_weight = new intvec(nV);
8867  VAR intvec* target_weight = new intvec(nV);
8868  for(i=nV-1; i>=0; i--)
8869  {
8870    (*target_weight)[i] = (*target_tmp)[i];
8871  }
8872  VAR ring XXRing = currRing;
8873  newRing = currRing;
8874
8875#ifdef TIME_TEST
8876  to=clock();
8877#endif
8878  // compute a red. GB w.r.t. the help ring
8879  if(MivComp(curr_weight, iv_dp) == 1)
8880  {
8881    //rOrdStr(currRing) = "dp"
8882    G = MstdCC(G);
8883  }
8884  else
8885  {
8886    //rOrdStr(currRing) = (a(.c_w..),lp,C)
8887    if (rParameter(currRing) != NULL)
8888    {
8889      DefRingPar(curr_weight);
8890    }
8891    else
8892    {
8893      rChangeCurrRing(VMrDefault(curr_weight));
8894    }
8895    G = idrMoveR(G, XXRing,currRing);
8896    G = MstdCC(G);
8897  }
8898#ifdef TIME_TEST
8899  tostd=clock()-to;
8900#endif
8901
8902#ifdef REPRESENTATION_OF_SIGMA
8903  INST_VAR ideal Gw = MwalkInitialForm(G, curr_weight);
8904
8905  if(islengthpoly2(Gw)==1)
8906  {
8907    intvec* MDp;
8908    if(MivComp(curr_weight, iv_dp) == 1)
8909    {
8910      MDp = MatrixOrderdp(nV); //MivWeightOrderlp(iv_dp);
8911    }
8912    else
8913    {
8914      MDp = MivWeightOrderlp(curr_weight);
8915    }
8916    curr_weight = RepresentationMatrix_Dp(G, MDp);
8917
8918    delete MDp;
8919
8920    ring exring = currRing;
8921
8922    if (rParameter(currRing) != NULL)
8923    {
8924      DefRingPar(curr_weight);
8925    }
8926    else
8927    {
8928      rChangeCurrRing(VMrDefault(curr_weight));
8929    }
8930#ifdef TIME_TEST
8931    to=clock();
8932#endif
8933    Gw = idrMoveR(G, exring,currRing);
8934    G = MstdCC(Gw);
8935    Gw = NULL;
8936#ifdef TIME_TEST
8937    tostd=tostd+clock()-to;
8938#endif
8939    //ivString(curr_weight,"rep. sigma");
8940    goto COMPUTE_NEW_VECTOR;
8941  }
8942
8943  idDelete(&Gw);
8944  VAR delete iv_dp;
8945#endif
8946
8947
8948  while(1)
8949  {
8950#ifdef TIME_TEST
8951    to=clock();
8952#endif
8953    // compute an initial form ideal of <G> w.r.t. "curr_vector"
8954    Gomega = MwalkInitialForm(G, curr_weight);
8955#ifdef TIME_TEST
8956    tif=tif+clock()-to;
8957#endif
8958
8959#ifndef  BUCHBERGER_ALG
8960    if(isNolVector(curr_weight) == 0)
8961    {
8962      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
8963    }
8964    else
8965    {
8966      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
8967    }
8968#endif // BUCHBERGER_ALG
8969
8970    oldRing = currRing;
8971
8972    // define a new ring with ordering "(a(curr_weight),lp)
8973    if (rParameter(currRing) != NULL)
8974    {
8975      DefRingPar(curr_weight);
8976    }
8977    else
8978    {
8979      rChangeCurrRing(VMrDefault(curr_weight));
8980    }
8981    newRing = currRing;
8982    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
8983
8984#ifdef TIME_TEST
8985    to=clock();
8986#endif
8987    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
8988#ifdef  BUCHBERGER_ALG
8989    M = MstdhomCC(Gomega1);
8990#else
8991    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
8992    delete hilb_func;
8993#endif
8994#ifdef TIME_TEST
8995    tstd=tstd+clock()-to;
8996#endif
8997
8998    // change the ring to oldRing
8999    rChangeCurrRing(oldRing);
9000    M1 =  idrMoveR(M, newRing,currRing);
9001    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
9002
9003#ifdef TIME_TEST
9004    to=clock();
9005#endif
9006    // compute a representation of the generators of submod (M) with respect to those of mod (Gomega).
9007    // Gomega is a reduced Groebner basis w.r.t. the current ring
9008    F = MLifttwoIdeal(Gomega2, M1, G);
9009#ifdef TIME_TEST
9010    tlift=tlift+clock()-to;
9011#endif
9012
9013    idDelete(&M1);
9014    idDelete(&Gomega2);
9015    idDelete(&G);
9016
9017    // change the ring to newRing
9018    rChangeCurrRing(newRing);
9019    F1 = idrMoveR(F, oldRing,currRing);
9020
9021#ifdef TIME_TEST
9022    to=clock();
9023#endif
9024    // reduce the Groebner basis <G> w.r.t. new ring
9025    G = kInterRedCC(F1, NULL);
9026#ifdef TIME_TEST
9027    tred=tred+clock()-to;
9028#endif
9029    idDelete(&F1);
9030
9031  COMPUTE_NEW_VECTOR:
9032    newRing = currRing;
9033    nwalk++;
9034    nwalkpert++;
9035#ifdef TIME_TEST
9036    to=clock();
9037#endif
9038    // compute a next weight vector
9039    //next_weight = MwalkNextWeightCC(curr_weight,target_weight, G);
9040    next_weight = MWalkRandomNextWeight(G, curr_weight, target_weight, weight_rad, pert_deg);
9041/*
9042    next_weight = MkInterRedNextWeight(curr_weight,target_weight,G);
9043
9044    if(MivComp(next_weight, target_weight) != 1)
9045    {
9046      // compute a perturbed next weight vector "next_weight1"
9047      intvec* next_weight1 = MkInterRedNextWeight(MPertVectors(G, MivMatrixOrder(curr_weight), pert_deg), target_weight, G);
9048
9049      // compare next_weight and next_weight1
9050      ideal G_test = MwalkInitialForm(G, next_weight);
9051      ideal G_test1 = MwalkInitialForm(G, next_weight1);
9052      if(IDELEMS(G_test1) <= IDELEMS(G_test))
9053      {
9054        next_weight = ivCopy(next_weight1);
9055      }
9056      delete next_weight1;
9057      // compute a random next weight vector "next_weight2"
9058      intvec* next_weight22 = ivCopy(target_weight);
9059      // Print("\n//  size of target_weight  = %d", sizeof((*target_weight)));
9060      k = 0;
9061
9062      while(test_w_in_ConeCC(G, next_weight22) == 0 && k < 11)
9063      {
9064        k++;
9065        if(k>10)
9066        {
9067          break;
9068        }
9069        weight_norm = 0;
9070        while(weight_norm == 0)
9071        {
9072          for(i=nV-1; i>=0; i--)
9073          {
9074            // Print("\n//  next_weight[%d]  = %d", i, (*next_weight)[i]);
9075            (*next_weight22)[i] = rand() % 60000 - 30000;
9076            weight_norm = weight_norm + (*next_weight22)[i]*(*next_weight22)[i];
9077          }
9078          weight_norm = 1 + floor(sqrt(weight_norm));
9079        }
9080        for(i=nV-1; i>=0; i--)
9081        {
9082          if((*next_weight22)[i] < 0)
9083          {
9084            (*next_weight22)[i] = 1 + (*curr_weight)[i] + floor(weight_rad*(*next_weight22)[i]/weight_norm);
9085          }
9086          else
9087          {
9088            (*next_weight22)[i] = (*curr_weight)[i] + floor(weight_rad*(*next_weight22)[i]/weight_norm);
9089          }
9090          // Print("\n//  next_weight22[%d]  = %d", i, (*next_weight22)[i]);
9091        }
9092      }
9093
9094      if(test_w_in_ConeCC(G, next_weight22) == 1)
9095      {
9096        // compare next_weight and next_weight2
9097        // Print("\n// ZUFALL IM KEGEL");
9098        intvec* next_weight2 = MkInterRedNextWeight(next_weight22, target_weight, G);
9099
9100        ideal G_test2 = MwalkInitialForm(G, next_weight2);
9101        if(IDELEMS(G_test2) <= IDELEMS(G_test))
9102        {
9103          if(IDELEMS(G_test2) <= IDELEMS(G_test1))
9104          {
9105             // Print("\n// ZUFALL BENUTZT!\n");
9106            next_weight = ivCopy(next_weight2);
9107          }
9108        }
9109        idDelete(&G_test2);
9110        delete next_weight2;
9111      }
9112      delete next_weight22;
9113      idDelete(&G_test);
9114      idDelete(&G_test1);
9115    }*/
9116
9117#ifdef TIME_TEST
9118    tnw=tnw+clock()-to;
9119#endif
9120#ifdef PRINT_VECTORS
9121    MivString(curr_weight, target_weight, next_weight);
9122#endif
9123
9124/*   check whether the computed intermediate weight vector is in
9125     the correct cone; sometimes it is very big e.g. s7, cyc7.
9126     If it is NOT in the correct cone, then compute directly
9127     a reduced Groebner basis with respect to the lexicographic ordering
9128     for the known Groebner basis that it is computed in the last step.
9129*/
9130    //if(test_w_in_ConeCC(G, next_weight) != 1)
9131    if(Overflow_Error == TRUE)
9132    {
9133    OMEGA_OVERFLOW_TRAN_NEW:
9134      //Print("\n//  takes %d steps!", nwalk-1);
9135      //Print("\n//ring lastRing = %s;", rString(currRing));
9136#ifdef TEST_OVERFLOW
9137      goto  BE_FINISH;
9138#endif
9139
9140#ifdef CHECK_IDEAL_MWALK
9141      idElements(G, "G");
9142      //headidString(G, "G");
9143#endif
9144
9145      if(MivSame(target_tmp, iv_lp) == 1)
9146      {
9147        if (rParameter(currRing) != NULL)
9148        {
9149          DefRingParlp();
9150        }
9151        else
9152        {
9153          VMrDefaultlp();
9154        }
9155      }
9156      else
9157      {
9158        if (rParameter(currRing) != NULL)
9159        {
9160          DefRingPar(target_tmp);
9161        }
9162        else
9163        {
9164          rChangeCurrRing(VMrDefault(target_tmp));
9165        }
9166      }
9167      lpRing = currRing;
9168      G1 = idrMoveR(G, newRing,currRing);
9169
9170#ifdef TIME_TEST
9171      to=clock();
9172#endif
9173      // apply kStd or LastGB to compute  a lex. red. Groebner basis of <G>
9174      if(nP == 0 || MivSame(target_tmp, iv_lp) == 0)
9175      {
9176        //Print("\n\n// calls \"std in ring r_%d = %s;", nwalk, rString(currRing));
9177        G = MstdCC(G1);//no result for qnt1
9178      }
9179      else
9180      {
9181        rChangeCurrRing(newRing);
9182        G1 = idrMoveR(G1, lpRing,currRing);
9183
9184        //Print("\n\n// calls \"LastGB\" (%d) to compute a GB", nV-1);
9185        G = LastGB(G1, curr_weight, nV-1); //no result for kats7
9186
9187        rChangeCurrRing(lpRing);
9188        G = idrMoveR(G, newRing,currRing);
9189      }
9190#ifdef TIME_TEST
9191      textra=clock()-to;
9192#endif
9193      npert[endwalks]=nwalk-npert_tmp;
9194      npert_tmp = nwalk;
9195      endwalks ++;
9196      break;
9197    }
9198
9199    // check whether the computed Groebner basis is really a Groebner basis.
9200    // If not, we perturb the target vector with the maximal "perturbation" degree.
9201
9202    if(MivComp(next_weight, target_weight) == 1 || MivComp(next_weight, curr_weight) == 1 )
9203    {
9204      //Print("\n//ring r_%d = %s;", nwalk, rString(currRing));
9205
9206
9207      //compute the number of perturbations and its step
9208      npert[endwalks]=nwalk-npert_tmp;
9209      npert_tmp = nwalk;
9210
9211      endwalks ++;
9212
9213      // it is very important if the walk only uses one step, e.g. Fate, liu
9214      if(endwalks == 1 && MivComp(next_weight, curr_weight) == 1)
9215      {
9216        rChangeCurrRing(XXRing);
9217        G = idrMoveR(G, newRing,currRing);
9218        goto FINISH;
9219      }
9220      H0 = id_Head(G,currRing);
9221
9222      if(MivSame(target_tmp, iv_lp) == 1)
9223      {
9224        if (rParameter(currRing) != NULL)
9225        {
9226          DefRingParlp();
9227        }
9228        else
9229        {
9230          VMrDefaultlp();
9231        }
9232      }
9233      else
9234      {
9235        if (rParameter(currRing) != NULL)
9236        {
9237          DefRingPar(target_tmp);
9238        }
9239        else
9240        {
9241          rChangeCurrRing(VMrDefault(target_tmp));
9242        }
9243      }
9244      lpRing = currRing;
9245      Glp = idrMoveR(G, newRing,currRing);
9246      H2 = idrMoveR(H0, newRing,currRing);
9247
9248      // Apply Lemma 2.2 in Collart et. al (1997) to check whether cone(k-1) is equal to cone(k)
9249      nGB = 1;
9250      for(i=IDELEMS(Glp)-1; i>=0; i--)
9251      {
9252        poly t;
9253        if((t=pSub(pHead(Glp->m[i]), pCopy(H2->m[i]))) != NULL)
9254        {
9255          pDelete(&t);
9256          idDelete(&H2);//5.5.02
9257          nGB = 0; //i.e. Glp is no reduced Groebner basis
9258          break;
9259        }
9260        pDelete(&t);
9261      }
9262
9263      idDelete(&H2);//5.5.02
9264
9265      if(nGB == 1)
9266      {
9267        G = Glp;
9268        Glp = NULL;
9269        break;
9270      }
9271
9272       // perturb the target weight vector, if the vector target_tmp stays in many cones
9273      poly p;
9274      BOOLEAN plength3 = FALSE;
9275      for(i=IDELEMS(Glp)-1; i>=0; i--)
9276      {
9277        p = MpolyInitialForm(Glp->m[i], target_tmp);
9278        if(p->next != NULL &&
9279           p->next->next != NULL &&
9280           p->next->next->next != NULL)
9281        {
9282          Overflow_Error = FALSE;
9283
9284          for(i=0; i<nV; i++)
9285          {
9286            (*vector_tmp)[i] = (*target_weight)[i];
9287          }
9288          delete target_weight;
9289          target_weight = MPertVectors(Glp, Mlp, nV);
9290
9291          if(MivComp(vector_tmp, target_weight)==1)
9292          {
9293            //PrintS("\n// The old and new representaion vector are the same!!");
9294            G = Glp;
9295            newRing = currRing;
9296            goto OMEGA_OVERFLOW_TRAN_NEW;
9297           }
9298
9299          if(Overflow_Error == TRUE)
9300          {
9301            rChangeCurrRing(newRing);
9302            G = idrMoveR(Glp, lpRing,currRing);
9303            goto OMEGA_OVERFLOW_TRAN_NEW;
9304          }
9305
9306          plength3 = TRUE;
9307          pDelete(&p);
9308          break;
9309        }
9310        pDelete(&p);
9311      }
9312
9313      if(plength3 == FALSE)
9314      {
9315        rChangeCurrRing(newRing);
9316        G = idrMoveR(Glp, lpRing,currRing);
9317        goto TRAN_LIFTING;
9318      }
9319
9320
9321      npertstep = nwalk;
9322      nwalkpert = 1;
9323      nsteppert ++;
9324
9325      /*
9326      Print("\n// Subroutine needs (%d) steps.", nwalk);
9327      idElements(Glp, "last G in walk:");
9328      PrintS("\n// ****************************************");
9329      Print("\n// Perturb the original target vector (%d): ", nsteppert);
9330      ivString(target_weight, "new target");
9331      PrintS("\n// ****************************************\n");
9332      */
9333      rChangeCurrRing(newRing);
9334      G = idrMoveR(Glp, lpRing,currRing);
9335
9336      delete next_weight;
9337
9338      //Print("\n// ring rNEW = %s;", rString(currRing));
9339      goto COMPUTE_NEW_VECTOR;
9340    }
9341
9342  TRAN_LIFTING:
9343    for(i=nV-1; i>=0; i--)
9344    {
9345      (*curr_weight)[i] = (*next_weight)[i];
9346    }
9347    delete next_weight;
9348  } // end of while
9349#ifdef TEST_OVERFLOW
9350 BE_FINISH:
9351#endif
9352  rChangeCurrRing(XXRing);
9353  G = idrMoveR(G, lpRing,currRing);
9354
9355 FINISH:
9356  delete ivNull;
9357  VAR delete next_weight;
9358  VAR delete iv_lp;
9359  omFree(npert);
9360
9361#ifdef TIME_TEST
9362  Print("\n// Computation took %d steps and %.2f sec", nwalk, ((double) (clock()-mtim)/1000000));
9363
9364  TimeStringFractal(tinput, tostd, tif, tstd, textra, tlift, tred, tnw);
9365
9366  Print("\n// pSetm_Error = (%d)", ErrorCheck());
9367  Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
9368#endif
9369
9370  return(G);
9371}
9372#endif
9373
9374/*****************************************************************
9375 * compute the reduced Groebner basis of an ideal <Go> w.r.t. lp *
9376 *****************************************************************/
9377static ideal Mpwalk_MAltwalk1(ideal Go, intvec* curr_weight, int tp_deg)
9378{
9379  Overflow_Error = FALSE;
9380 // BOOLEAN nOverflow_Error = FALSE;
9381#ifdef TIME_TEST
9382  clock_t tproc=0;
9383  clock_t tinput=clock();
9384#endif
9385  int i, nV = currRing->N;
9386
9387  //check that perturbation degree is valid
9388  if(tp_deg < 1 || tp_deg > nV)
9389  {
9390    WerrorS("Invalid perturbation degree.\n");
9391    return NULL;
9392  }
9393
9394  int nwalk=0, endwalks=0, ntestwinC=1;
9395  int tp_deg_tmp = tp_deg;
9396  ideal Gomega, M, F, G, M1, F1, Gomega1, Gomega2, G1;
9397  ring newRing, oldRing, TargetRing;
9398  intvec* next_weight;
9399  intvec* ivNull = new intvec(nV);
9400
9401  ring YXXRing = currRing;
9402
9403  intvec* iv_M_dpp = MivMatrixOrderlp(nV);
9404  intvec* target_weight;// = Mivlp(nV);
9405  ideal ssG;
9406
9407  // perturb the target vector
9408  while(1)
9409  {
9410    if(Overflow_Error == FALSE)
9411    {
9412      if (rParameter(currRing) != NULL)
9413      {
9414        DefRingParlp();
9415      }
9416      else
9417      {
9418        VMrDefaultlp();
9419      }
9420      TargetRing = currRing;
9421      ssG = idrMoveR(Go,YXXRing,currRing);
9422    }
9423    Overflow_Error = FALSE;
9424    if(tp_deg != 1)
9425    {
9426      target_weight = MPertVectors(ssG, iv_M_dpp, tp_deg);
9427    }
9428    else
9429    {
9430      target_weight = Mivlp(nV);
9431      break;
9432    }
9433    if(Overflow_Error == FALSE)
9434    {
9435      break;
9436    }
9437    Overflow_Error = TRUE;
9438    tp_deg --;
9439  }
9440  if(tp_deg != tp_deg_tmp)
9441  {
9442    Overflow_Error = TRUE;
9443    //nOverflow_Error = TRUE;
9444  }
9445
9446  //  Print("\n// tp_deg = %d", tp_deg);
9447  // ivString(target_weight, "pert target");
9448
9449  delete iv_M_dpp;
9450#ifndef  BUCHBERGER_ALG
9451  intvec* hilb_func;
9452#endif
9453  // to avoid (1,0,...,0) as the target vector
9454  intvec* last_omega = new intvec(nV);
9455  for(i=nV-1; i>0; i--)
9456  {
9457    (*last_omega)[i] = 1;
9458  }
9459  (*last_omega)[0] = 10000;
9460
9461  rChangeCurrRing(YXXRing);
9462  G = idrMoveR(ssG, TargetRing,currRing);
9463
9464  while(1)
9465  {
9466    nwalk ++;
9467    nstep ++;
9468
9469    if(nwalk==1)
9470    {
9471      goto FIRST_STEP;
9472    }
9473#ifdef TIME_TEST
9474    to=clock();
9475#endif
9476    // compute an initial form ideal of <G> w.r.t. "curr_vector"
9477    Gomega = MwalkInitialForm(G, curr_weight);
9478#ifdef TIME_TEST
9479    xtif=xtif+clock()-to;
9480#endif
9481
9482#ifndef  BUCHBERGER_ALG
9483    if(isNolVector(curr_weight) == 0)
9484      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
9485    else
9486      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
9487#endif
9488
9489    oldRing = currRing;
9490
9491    // define a new ring that its ordering is "(a(curr_weight),lp)
9492    if (rParameter(currRing) != NULL)
9493    {
9494      DefRingPar(curr_weight);
9495    }
9496    else
9497    {
9498      rChangeCurrRing(VMrDefault(curr_weight));
9499    }
9500    newRing = currRing;
9501    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
9502/*
9503#ifdef ENDWALKS
9504    if(endwalks == 1)
9505    {
9506      Print("\n//  it is  %d-th step!!", nwalk);
9507      idString(Gomega1, "Gw");
9508      PrintS("\n//  compute a rGB of Gw:");
9509    }
9510#endif
9511*/
9512#ifdef TIME_TEST
9513    to=clock();
9514#endif
9515    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
9516#ifdef  BUCHBERGER_ALG
9517    M = MstdhomCC(Gomega1);
9518#else
9519    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
9520    delete hilb_func;
9521#endif // BUCHBERGER_ALG
9522#ifdef TIME_TEST
9523    xtstd=xtstd+clock()-to;
9524#endif
9525
9526    // change the ring to oldRing
9527    rChangeCurrRing(oldRing);
9528    M1 =  idrMoveR(M, newRing,currRing);
9529    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
9530#ifdef TIME_TEST
9531    to=clock();
9532#endif
9533
9534    // if(endwalks == 1){PrintS("\n//  Lifting is still working:");}
9535
9536    // compute a reduced Groebner basis of <G> w.r.t. "newRing" by the lifting process
9537    F = MLifttwoIdeal(Gomega2, M1, G);
9538#ifdef TIME_TEST
9539    xtlift=xtlift+clock()-to;
9540#endif
9541
9542    idDelete(&M1);
9543    idDelete(&Gomega2);
9544    idDelete(&G);
9545
9546    // change the ring to newRing
9547    rChangeCurrRing(newRing);
9548    F1 = idrMoveR(F, oldRing,currRing);
9549#ifdef TIME_TEST
9550    to=clock();
9551#endif
9552    //if(endwalks == 1){ PrintS("\n//  InterRed is still working:");}
9553    // reduce the Groebner basis <G> w.r.t. the new ring
9554    G = kInterRedCC(F1, NULL);
9555#ifdef TIME_TEST
9556    xtred=xtred+clock()-to;
9557#endif
9558    idDelete(&F1);
9559
9560    if(endwalks == 1)
9561      break;
9562
9563  FIRST_STEP:
9564    Overflow_Error=FALSE;
9565#ifdef TIME_TEST
9566    to=clock();
9567#endif
9568    // compute a next weight vector
9569    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
9570#ifdef TIME_TEST
9571    xtnw=xtnw+clock()-to;
9572#endif
9573#ifdef PRINT_VECTORS
9574    MivString(curr_weight, target_weight, next_weight);
9575#endif
9576
9577    if(Overflow_Error == TRUE)
9578    {
9579      delete next_weight;
9580      if(tp_deg > 1){
9581        //nOverflow_Error = Overflow_Error;
9582#ifdef TIME_TEST
9583        tproc = tproc+clock()-tinput;
9584#endif
9585        //Print("\n// A subroutine takes %d steps and calls \"Mpwalk\" (1,%d):", nwalk, tp_deg-1);
9586        G1 = Mpwalk_MAltwalk1(G, curr_weight, tp_deg-1);
9587        goto MPW_Finish;
9588      }
9589      else {
9590        newRing = currRing;
9591        ntestwinC = 0;
9592        break;
9593      }
9594    }
9595
9596    if(MivComp(next_weight, ivNull) == 1)
9597    {
9598      newRing = currRing;
9599      delete next_weight;
9600      break;
9601    }
9602    if(MivComp(next_weight, target_weight) == 1)
9603    {
9604      endwalks = 1;
9605    }
9606    for(i=nV-1; i>=0; i--)
9607    {
9608      //(*extra_curr_weight)[i] = (*curr_weight)[i];
9609      (*curr_weight)[i] = (*next_weight)[i];
9610    }
9611    delete next_weight;
9612  }//while
9613
9614  // check whether the pertubed target vector is correct
9615
9616  //define and execute ring with lex. order
9617  if (rParameter(currRing) != NULL)
9618  {
9619    DefRingParlp();
9620  }
9621  else
9622  {
9623    VMrDefaultlp();
9624  }
9625  G1 = idrMoveR(G, newRing,currRing);
9626
9627  if( test_w_in_ConeCC(G1, target_weight) != 1 || ntestwinC == 0)
9628  {
9629    //PrintS("\n// The perturbed target vector doesn't STAY in the correct cone!!");
9630    if(tp_deg == 1)
9631    {
9632      //Print("\n// subroutine takes %d steps and applys \"std\"", nwalk);
9633#ifdef TIME_TEST
9634      to=clock();
9635#endif
9636      ideal G2 = MstdCC(G1);
9637#ifdef TIME_TEST
9638      xtextra=xtextra+clock()-to;
9639#endif
9640      idDelete(&G1);
9641      G1 = G2;
9642      G2 = NULL;
9643    }
9644    else
9645    {
9646      //nOverflow_Error = Overflow_Error;
9647#ifdef TIME_TEST
9648      tproc = tproc+clock()-tinput;
9649#endif
9650      // Print("\n// B subroutine takes %d steps and calls \"Mpwalk\" (1,%d) :", nwalk,  tp_deg-1);
9651      G1 = Mpwalk_MAltwalk1(G1, curr_weight, tp_deg-1);
9652    }
9653  }
9654
9655 MPW_Finish:
9656  newRing = currRing;
9657  rChangeCurrRing(YXXRing);
9658  ideal result = idrMoveR(G1, newRing,currRing);
9659
9660  delete ivNull;
9661  delete target_weight;
9662
9663  //Print("\n// \"Mpwalk\" (1,%d) took %d steps and %.2f sec. Overflow_Error (%d)", tp_deg, nwalk, ((double) clock()-tinput)/1000000, nOverflow_Error);
9664  //Print("\n// Mprwalk took %d steps. Ring= %s;\n", nwalk, rString(currRing));
9665  return(result);
9666}
9667
9668/*******************************************************************
9669 * Implementation of the first alternative Groebner Walk Algorithm *
9670 *******************************************************************/
9671ideal MAltwalk1(ideal Go, int op_deg, int tp_deg, intvec* curr_weight,
9672                intvec* target_weight)
9673{
9674  Set_Error(FALSE  );
9675  Overflow_Error = FALSE;
9676#ifdef TIME_TEST
9677  BOOLEAN nOverflow_Error = FALSE;
9678#endif
9679  // Print("// pSetm_Error = (%d)", ErrorCheck());
9680
9681#ifdef TIME_TEST
9682  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0; xtextra=0;
9683  xftinput = clock();
9684  clock_t tostd, tproc;
9685#endif
9686
9687  nstep = 0;
9688  int i, nV = currRing->N;
9689  int nwalk=0, endwalks=0;
9690  int op_tmp = op_deg;
9691  ideal Gomega, M, F, G, Gomega1, Gomega2, M1, F1;
9692  ring newRing, oldRing;
9693  intvec* next_weight;
9694  intvec* iv_M_dp;
9695  intvec* ivNull = new intvec(nV);
9696  intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
9697  intvec* exivlp = Mivlp(nV);
9698  //intvec* extra_curr_weight = new intvec(nV);
9699#ifndef  BUCHBERGER_ALG
9700  intvec* hilb_func;
9701#endif
9702  intvec* cw_tmp = curr_weight;
9703
9704  // to avoid (1,0,...,0) as the target vector
9705  intvec* last_omega = new intvec(nV);
9706  for(i=nV-1; i>0; i--)
9707  {
9708    (*last_omega)[i] = 1;
9709  }
9710  (*last_omega)[0] = 10000;
9711
9712  ring XXRing = currRing;
9713
9714#ifdef TIME_TEST
9715  to=clock();
9716#endif
9717  /* compute a pertubed weight vector of the original weight vector.
9718     The perturbation degree is recursive decrease until that vector
9719     stays inn the correct cone. */
9720  while(1)
9721  {
9722    if(Overflow_Error == FALSE)
9723    {
9724      if(MivComp(curr_weight, iv_dp) == 1)
9725      {
9726      //rOrdStr(currRing) = "dp"
9727        if(op_tmp == op_deg)
9728        {
9729          G = MstdCC(Go);
9730          if(op_deg != 1)
9731          {
9732            iv_M_dp = MivMatrixOrderdp(nV);
9733          }
9734        }
9735      }
9736    }
9737    else
9738    {
9739      if(op_tmp == op_deg)
9740      {
9741        //rOrdStr(currRing) = (a(...),lp,C)
9742        if (rParameter(currRing) != NULL)
9743        {
9744          DefRingPar(cw_tmp);
9745        }
9746        else
9747        {
9748          rChangeCurrRing(VMrDefault(cw_tmp));
9749        }
9750        G = idrMoveR(Go, XXRing,currRing);
9751        G = MstdCC(G);
9752        if(op_deg != 1)
9753          iv_M_dp = MivMatrixOrder(cw_tmp);
9754      }
9755    }
9756    Overflow_Error = FALSE;
9757    if(op_deg != 1)
9758    {
9759      curr_weight = MPertVectors(G, iv_M_dp, op_deg);
9760    }
9761    else
9762    {
9763      curr_weight =  cw_tmp;
9764      break;
9765    }
9766    if(Overflow_Error == FALSE)
9767    {
9768      break;
9769    }
9770    Overflow_Error = TRUE;
9771    op_deg --;
9772  }
9773#ifdef TIME_TEST
9774  tostd=clock()-to;
9775#endif
9776
9777  if(op_tmp != 1 )
9778    delete iv_M_dp;
9779  delete iv_dp;
9780
9781  if(currRing->order[0] == ringorder_a)
9782    goto NEXT_VECTOR;
9783
9784  while(1)
9785  {
9786    nwalk ++;
9787    nstep ++;
9788
9789#ifdef TIME_TEST
9790    to = clock();
9791#endif
9792    // compute an initial form ideal of <G> w.r.t. "curr_vector"
9793    Gomega = MwalkInitialForm(G, curr_weight);
9794#ifdef TIME_TEST
9795    xtif=xtif+clock()-to;
9796#endif
9797#if 0
9798    if(Overflow_Error == TRUE)
9799    {
9800      for(i=nV-1; i>=0; i--)
9801        (*curr_weight)[i] = (*extra_curr_weight)[i];
9802      delete extra_curr_weight;
9803
9804      newRing = currRing;
9805      goto MSTD_ALT1;
9806    }
9807#endif
9808#ifndef  BUCHBERGER_ALG
9809    if(isNolVector(curr_weight) == 0)
9810    {
9811      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
9812    }
9813    else
9814    {
9815      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
9816    }
9817#endif // BUCHBERGER_ALG
9818
9819    oldRing = currRing;
9820
9821    // define a new ring which ordering is "(a(curr_weight),lp)
9822    if (rParameter(currRing) != NULL)
9823    {
9824      DefRingPar(curr_weight);
9825    }
9826    else
9827    {
9828      rChangeCurrRing(VMrDefault(curr_weight));
9829    }
9830    newRing = currRing;
9831    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
9832
9833#ifdef TIME_TEST
9834    to=clock();
9835#endif
9836    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
9837#ifdef  BUCHBERGER_ALG
9838    M = MstdhomCC(Gomega1);
9839#else
9840    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
9841    delete hilb_func;
9842#endif // BUCHBERGER_ALG
9843#ifdef TIME_TEST
9844    xtstd=xtstd+clock()-to;
9845#endif
9846
9847    // change the ring to oldRing
9848    rChangeCurrRing(oldRing);
9849    M1 =  idrMoveR(M, newRing,currRing);
9850    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
9851
9852#ifdef TIME_TEST
9853    to=clock();
9854#endif
9855    // compute a reduced Groebner basis of <G> w.r.t. "newRing" by the lifting process
9856    F = MLifttwoIdeal(Gomega2, M1, G);
9857#ifdef TIME_TEST
9858    xtlift=xtlift+clock()-to;
9859#endif
9860
9861    idDelete(&M1);
9862    idDelete(&Gomega2);
9863    idDelete(&G);
9864
9865    // change the ring to newRing
9866    rChangeCurrRing(newRing);
9867    F1 = idrMoveR(F, oldRing,currRing);
9868    if (oldRing!=IDRING(currRingHdl)) rDelete(oldRing); // do not delete the global currRing
9869    oldRing=NULL;
9870
9871#ifdef TIME_TEST
9872    to=clock();
9873#endif
9874    // reduce the Groebner basis <G> w.r.t. new ring
9875    G = kInterRedCC(F1, NULL);
9876#ifdef TIME_TEST
9877    xtred=xtred+clock()-to;
9878#endif
9879    idDelete(&F1);
9880
9881    if(endwalks == 1)
9882    {
9883      break;
9884    }
9885  NEXT_VECTOR:
9886#ifdef TIME_TEST
9887    to=clock();
9888#endif
9889    // compute a next weight vector
9890    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
9891#ifdef TIME_TEST
9892    xtnw=xtnw+clock()-to;
9893#endif
9894#ifdef PRINT_VECTORS
9895    MivString(curr_weight, target_weight, next_weight);
9896#endif
9897    if(Overflow_Error == TRUE)
9898    {
9899      newRing = currRing;
9900
9901      if (rParameter(currRing) != NULL)
9902      {
9903        DefRingPar(target_weight);
9904      }
9905      else
9906      {
9907        rChangeCurrRing(VMrDefault(target_weight));
9908      }
9909      F1 = idrMoveR(G, newRing,currRing);
9910      G = MstdCC(F1);
9911      idDelete(&F1);
9912      newRing = currRing;
9913      break; //for while
9914    }
9915
9916
9917    /* G is the wanted Groebner basis if next_weight == curr_weight */
9918    if(MivComp(next_weight, ivNull) == 1)
9919    {
9920      newRing = currRing;
9921      delete next_weight;
9922      break; //for while
9923    }
9924
9925    if(MivComp(next_weight, target_weight) == 1)
9926    {
9927      if(tp_deg == 1 || MivSame(target_weight, exivlp) == 0)
9928        endwalks = 1;
9929      else
9930      {
9931       // MSTD_ALT1:
9932#ifdef TIME_TEST
9933        nOverflow_Error = Overflow_Error;
9934        tproc = clock()-xftinput;
9935#endif
9936
9937        //Print("\n//  main routine takes %d steps and calls \"Mpwalk\" (1,%d):", nwalk,  tp_deg);
9938
9939        // compute the red. GB of <G> w.r.t. the lex order by the "recursive-modified" perturbation walk alg (1,tp_deg)
9940        G = Mpwalk_MAltwalk1(G, curr_weight, tp_deg);
9941        delete next_weight;
9942        break; // for while
9943      }
9944    }
9945
9946    //NOT Changed, to free memory
9947    for(i=nV-1; i>=0; i--)
9948    {
9949      //(*extra_curr_weight)[i] = (*curr_weight)[i];
9950      (*curr_weight)[i] = (*next_weight)[i];
9951    }
9952    delete next_weight;
9953  }//while
9954
9955  rChangeCurrRing(XXRing);
9956  ideal result = idrMoveR(G, newRing,currRing);
9957  id_Delete(&G, newRing);
9958
9959  delete ivNull;
9960  if(op_deg != 1 )
9961  {
9962    delete curr_weight;
9963  }
9964  delete exivlp;
9965#ifdef TIME_TEST
9966/*
9967  Print("\n// \"Main procedure\"  took %d steps, %.2f sec. and Overflow_Error(%d)",
9968        nwalk, ((double) tproc)/1000000, nOverflow_Error);
9969
9970  TimeStringFractal(xftinput, tostd, xtif, xtstd,xtextra, xtlift, xtred, xtnw);
9971*/
9972 // Print("\n// pSetm_Error = (%d)", ErrorCheck());
9973 // Print("\n// Overflow_Error? (%d)", Overflow_Error);
9974 // Print("\n// Awalk1 took %d steps.\n", nstep);
9975#endif
9976  return(result);
9977}
Note: See TracBrowser for help on using the repository browser.