source: git/Singular/walk.cc @ 0001f9

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