source: git/Singular/walk.cc @ 44b790a

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