source: git/Singular/walk.cc @ fc5095

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