source: git/Singular/walk_ip.cc @ f5d2647

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