source: git/Singular/walk_ip.cc @ 80f8f6c

spielwiese
Last change on this file since 80f8f6c was 80f8f6c, checked in by jgmbenoit <quatermaster@…>, 8 years ago
correct spelling errors as detected by Lintian
  • Property mode set to 100644
File size: 9.6 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT: frwalk: interpreter link
6*/
7
8#include <kernel/mod2.h>
9#include <Singular/tok.h>
10#include <misc/options.h>
11#include <Singular/ipid.h>
12#include <misc/intvec.h>
13#include <omalloc/omalloc.h>
14#include <kernel/polys.h>
15#include <kernel/ideals.h>
16#include <polys/matpol.h>
17#include <kernel/GBEngine/kstd1.h>
18#include <polys/monomials/ring.h>
19#include <Singular/subexpr.h>
20#include <polys/monomials/maps.h>
21#include <kernel/GBEngine/syz.h>
22#include <coeffs/numbers.h>
23#include <Singular/lists.h>
24#include <Singular/attrib.h>
25#include <Singular/ipconv.h>
26#include <Singular/links/silink.h>
27#include <kernel/combinatorics/stairc.h>
28#include <polys/weight.h>
29#include <kernel/spectrum/semic.h>
30#include <kernel/spectrum/splist.h>
31#include <kernel/spectrum/spectrum.h>
32//#include <kernel/gnumpfl.h>
33//#include <kernel/mpr_base.h>
34//#include <kernel/ffields.h>
35#include <polys/clapsing.h>
36#include <kernel/combinatorics/hutil.h>
37#include <Singular/ipshell.h>
38#include <kernel/groebner_walk/walkMain.h>
39#include <kernel/groebner_walk/walkProc.h>
40#include <kernel/groebner_walk/walkSupport.h>
41#include <polys/prCopy.h>
42
43//#include <stdlib.h>
44#include <stdio.h>
45#include <string.h>
46#include <ctype.h>
47#include <math.h>
48
49///////////////////////////////////////////////////////////////////
50//walkProc
51///////////////////////////////////////////////////////////////////
52//Description: The main function for the Walk-Algorithm. Checks the
53//input-data, and calls walk64 (see walkMain.cc). Returns the new
54//groebner basis or something else if an error occoured.
55///////////////////////////////////////////////////////////////////
56//Uses: omAlloc0,walkConsistency,rGetGlobalOrderWeightVec,
57//omFreeSize,sizeof,IDIDEAL,walk64,rSetHdl,idrMoveR,Werror,idInit
58///////////////////////////////////////////////////////////////////
59
60ideal
61walkProc(leftv first, leftv second)
62{
63    WalkState state = WalkOk;
64    BITSET save1,save2;
65    SI_SAVE_OPT(save1,save2);
66    si_opt_1 &= (~Sy_bit(OPT_REDSB)); //make sure option noredSB is set
67
68    ring destRing = currRing;
69    ideal destIdeal = NULL;
70    idhdl sourceRingHdl = (idhdl)first->data;
71    ring sourceRing = IDRING(sourceRingHdl);
72    rChangeCurrRing( sourceRing );
73
74    if(state==WalkOk)
75    {
76      int * vperm = (int *)omAlloc0( (currRing->N+1)*sizeof( int ) );
77      state= walkConsistency( sourceRing, destRing, vperm );
78      omFreeSize( (ADDRESS)vperm, (currRing->N+1)*sizeof(int) );
79    }
80
81    int64vec* currw64=rGetGlobalOrderWeightVec(sourceRing);
82    int64vec* destVec64=rGetGlobalOrderWeightVec(destRing);
83
84    ideal sourceIdeal;
85    BOOLEAN sourcIdealIsSB=FALSE;
86    if ( state == WalkOk )
87    {
88      idhdl ih = currRing->idroot->get( second->Name(), myynest );
89      if ( (ih != NULL) && (IDTYP(ih)==IDEAL_CMD) )
90      {
91           sourceIdeal = idCopy(IDIDEAL( ih ));
92           if(hasFlag((leftv)ih,FLAG_STD)){
93              sourcIdealIsSB=TRUE;
94           }
95      }
96      else
97      {
98        state=WalkNoIdeal;
99      }
100    }
101
102    if ( state == WalkOk )
103    {
104      // Now the settings are compatible with Walk
105      state=walk64(sourceIdeal,currw64,destRing,destVec64,
106                   destIdeal,sourcIdealIsSB);
107    }
108
109    SI_RESTORE_OPT(save1,save2);//making sure options are as before function call
110
111    ring almostDestRing=currRing;
112    rChangeCurrRing(destRing);
113
114    switch (state) {
115        case WalkOk:
116          destIdeal=idrMoveR(destIdeal,currRing,almostDestRing);
117          break;
118
119        case WalkIncompatibleRings:
120          Werror("ring %s and current ring are incompatible\n",
121                 first->Name() );
122          destIdeal= NULL;
123          break;
124
125        case WalkIncompatibleDestRing:
126          Werror( "Order of basering not allowed,\n must be a combination of a,A,lp,dp,Dp,wp,Wp,M and C.\n");
127          destIdeal= NULL;
128          break;
129
130        case WalkIncompatibleSourceRing:
131          Werror( "Order of %s not allowed,\n must be a combination of a,A,lp,dp,Dp,wp,Wp,M and C.\n",first->Name());
132          rChangeCurrRing(destRing);
133          destIdeal= NULL;
134          break;
135
136        case WalkNoIdeal:
137          Werror( "Can't find ideal %s in ring %s.\n",
138                   second->Name(), first->Name() );
139          destIdeal= NULL;
140          break;
141
142        case WalkOverFlowError:
143          Werror( "Overflow occurred.\n");
144          destIdeal= NULL;
145          break;
146
147        default:
148           destIdeal= NULL;
149    }
150
151    return destIdeal;
152}
153
154///////////////////////////////////////////////////////////////////
155//fractalWalkProc
156///////////////////////////////////////////////////////////////////
157//Description: The main function for the Fractalwalk-Algorithm.
158//Responsible for contact between user and walk64. Checks the
159//input-data, and calls fractalWalk64. Returns the new groebner
160//basis or something else if an error occurred.
161///////////////////////////////////////////////////////////////////
162//Uses: omAlloc0,fractalWalkConsistency,omFreeSize,sizeof,IDIDEAL,
163//fractalWalk64,rSetHdl,idrMoveR,Werror,idInit
164///////////////////////////////////////////////////////////////////
165
166ideal
167fractalWalkProc(leftv first, leftv second)
168{
169
170  //unperturbedStartVectorStrategy SHOULD BE SET BY THE USER THROUGH
171  //A THIRD ARGUMENT. TRUE MEANS THAT THE UNPERTURBED START
172  //VECTOR STRATEGY IS USED AND FALSE THAT THE START VECTOR IS
173  //MAXIMALLY PERTURBED
174
175    BOOLEAN unperturbedStartVectorStrategy=TRUE;
176
177    WalkState state = WalkOk;
178    BITSET save1,save2;
179    SI_SAVE_OPT(save1,save2);
180    si_opt_1 &= (~Sy_bit(OPT_REDSB)); //make sure option noredSB is set
181
182    ring destRing = currRing;
183    ideal destIdeal = NULL;
184    idhdl sourceRingHdl = (idhdl)first->data;
185    rSetHdl( sourceRingHdl );
186    ring sourceRing = currRing;
187
188    int * vperm = (int *)omAlloc0( (currRing->N+1)*sizeof( int ) );
189    state= fractalWalkConsistency( sourceRing, destRing, vperm );
190    omFreeSize( (ADDRESS)vperm, (currRing->N+1)*sizeof(int) );
191
192    ideal sourceIdeal;
193    BOOLEAN sourcIdealIsSB=FALSE;
194    if ( state == WalkOk ) {
195      idhdl ih = currRing->idroot->get( second->Name(), myynest );
196      if ( (ih != NULL) && (IDTYP(ih)==IDEAL_CMD) ) {
197           sourceIdeal = IDIDEAL( ih );
198           if(hasFlag((leftv)ih,FLAG_STD)){
199              sourcIdealIsSB=TRUE;
200           }
201      }
202      else {
203        state=WalkNoIdeal;
204      }
205    }
206
207    if ( state == WalkOk ) {
208      // Now the settings are compatible with Walk
209      state=fractalWalk64(sourceIdeal,destRing,destIdeal,
210                          sourcIdealIsSB,
211                          unperturbedStartVectorStrategy);
212    }
213
214    SI_RESTORE_OPT(save1,save2);//making sure options are as before functiocall
215
216     if ( state == WalkOk )
217     {
218       ring almostDestRing=currRing;
219       rChangeCurrRing(destRing);
220       destIdeal=idrMoveR(destIdeal, almostDestRing, destRing);
221     }
222
223
224     switch (state) {
225
226        case WalkOk:
227            destIdeal=sortRedSB(destIdeal);
228            return(destIdeal);
229            break;
230
231        case WalkIncompatibleRings:
232            Werror( "ring %s and current ring are incompatible\n",
233                     first->Name() );
234            rChangeCurrRing(destRing);
235            destIdeal= NULL;
236            return destIdeal;
237            break;
238
239        case WalkIncompatibleDestRing:
240            Werror( "Order of basering not allowed,\n must be a combination of lp,dp,Dp,wp,Wp and C or just M.\n");
241            rChangeCurrRing(destRing);
242            destIdeal= NULL;
243            return destIdeal;
244            break;
245
246        case WalkIncompatibleSourceRing:
247            Werror( "Order of %s not allowed,\n must be a combination of lp,dp,Dp,wp,Wp and C or just M.\n",
248                     first->Name());
249            rChangeCurrRing(destRing);
250            destIdeal= NULL;
251            return destIdeal;
252            break;
253
254        case WalkNoIdeal:
255            Werror( "Can't find ideal %s in ring %s.\n",
256                     second->Name(), first->Name() );
257            rChangeCurrRing(destRing);
258            destIdeal= NULL;
259            return destIdeal;
260            break;
261
262        case WalkOverFlowError:
263            Werror( "Overflow occurred in ring %s.\n", first->Name() );
264            rChangeCurrRing(destRing);
265            destIdeal= NULL;
266            return destIdeal;
267            break;
268
269        default:
270            rChangeCurrRing(destRing);
271            destIdeal= idInit(1,1);
272            return destIdeal;
273    }
274
275
276  return NULL;
277}
278
279
280///////////////////////////////////////////////////////////////////
281//getiv64
282///////////////////////////////////////////////////////////////////
283//Description: retrieves the int64vec from input list l
284///////////////////////////////////////////////////////////////////
285//Assumes: that the first entry of l is an int64vec
286///////////////////////////////////////////////////////////////////
287//Uses: none
288///////////////////////////////////////////////////////////////////
289
290int64vec* getiv64(lists l)
291{
292  return (int64vec*)(l->m[0].data);
293}
294
295///////////////////////////////////////////////////////////////////
296
297
298///////////////////////////////////////////////////////////////////
299//getint64
300///////////////////////////////////////////////////////////////////
301//Description: retrieves the int64 from input list l
302///////////////////////////////////////////////////////////////////
303//Assumes: that the second entry of l is an int64
304///////////////////////////////////////////////////////////////////
305//Uses: none
306///////////////////////////////////////////////////////////////////
307
308// not used, bad impl.
309//int64 getint64(lists l)
310//{
311//  return (int64)(long)(l->m[1].data);
312//}
313
314///////////////////////////////////////////////////////////////////
Note: See TracBrowser for help on using the repository browser.