source: git/Singular/LIB/standard.lib @ 7c5f9d2

spielwiese
Last change on this file since 7c5f9d2 was 7c5f9d2, checked in by Olaf Bachmann <obachman@…>, 25 years ago
* syntax git-svn-id: file:///usr/local/Singular/svn/trunk@1967 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 10.6 KB
Line 
1// $Id: standard.lib,v 1.15 1998-05-25 08:44:14 obachman Exp $
2//////////////////////////////////////////////////////////////////////////////
3
4version="$Id: standard.lib,v 1.15 1998-05-25 08:44:14 obachman Exp $";
5info="
6LIBRARY: standard.lib   PROCEDURES WHICH ARE ALWAYS LOADED AT START-UP
7
8 stdfglm(ideal[,ord])   standard basis of the ideal via fglm [and ordering ord]
9 stdhilb(ideal)         standard basis of the ideal using the Hilbert function
10 groebner(ideal/module) standard basis of ideal or module using a
11                        heuristically choosen method
12";
13
14//////////////////////////////////////////////////////////////////////////////
15
16proc stdfglm (ideal i, list #)
17"USAGE:   stdfglm(i[,s]); i ideal, s string (any allowed ordstr of a ring)
18RETURN:  stdfglm(i): standard basis of i in the basering, calculated via fglm
19                     from ordering \"dp\" to the ordering of the basering.
20         stdfglm(i,s): standard basis of i in the basering, calculated via
21                     fglm from ordering s to the ordering of the basering.
22EXAMPLE: example stdfglm; shows an example"
23{
24   string os;
25   def dr= basering;
26   if( (size(#)==0) or (typeof(#[1]) != "string") )
27   {
28     os = "dp(" + string( nvars(dr) ) + ")";
29     if ( (find( ordstr(dr), os ) != 0) and (find( ordstr(dr), "a") == 0) )
30     {
31       os= "Dp";
32     }
33     else
34     {
35       os= "dp";
36     }
37   }
38   else { os = #[1]; }
39   execute "ring sr=("+charstr(dr)+"),("+varstr(dr)+"),"+os+";";
40   ideal i= fetch(dr,i);
41   intvec opt= option(get);
42   option(redSB);
43   i=std(i);
44   option(set,opt);
45   setring dr;
46   return (fglm(sr,i));
47}
48example
49{ "EXAMPLE:"; echo = 2;
50   ring r  = 0,(x,y,z),lp;
51   ideal i = y3+x2, x2y+x2, x3-x2, z4-x2-y;
52   ideal i1= stdfglm(i);         //uses fglm from "dp" to "lp"
53   i1;
54   ideal i2= stdfglm(i,"Dp");    //uses fglm from "Dp" to "lp"
55   i2;
56}
57/////////////////////////////////////////////////////////////////////////////
58
59proc stdhilb(ideal i,list #)
60"USAGE:   stdhilb(i);  i ideal
61         stdhilb(i,v); i homogeneous ideal, v intvec (the Hilbert function)
62RETURN:  stdhilb(i): a standard basis of i (computing v internally)
63         stdhilb(i,v): standard basis of i, using the given Hilbert function
64EXAMPLE: example stdhilb; shows an example"
65{
66   def R=basering;
67
68   if((homog(i)==1)||(ordstr(basering)[1]=="d"))
69   {
70      if ((size(#)!=0)&&(homog(i)==1))
71      {
72         return(std(i,#[1]));
73      }
74      return(std(i));
75   }
76
77   execute "ring S = ("+charstr(R)+"),("+varstr(R)+",@t),dp;";
78   ideal i=homog(imap(R,i),@t);
79   intvec v=hilb(std(i),1);
80   execute "ring T = ("+charstr(R)+"),("+varstr(R)+",@t),("+ordstr(R)+");";
81   ideal i=fetch(S,i);
82   ideal a=std(i,v);
83   setring R;
84   map phi=T,maxideal(1),1;
85   ideal a=phi(a);
86
87   int k,j;
88   poly m;
89   int c=size(i);
90
91   for(j=1;j<c;j++)
92   {
93     if(deg(a[j])==0)
94     {
95       a=ideal(1);
96       attrib(a,"isSB",1);
97       return(a);
98     }
99     if(deg(a[j])>0)
100     {
101       m=lead(a[j]);
102       for(k=j+1;k<=c;k++)
103       {
104          if(size(lead(a[k])/m)>0)
105          {
106            a[k]=0;
107          }
108       }
109     }
110   }
111   a=simplify(a,2);
112   attrib(a,"isSB",1);
113   return(a);
114}
115example
116{ "EXAMPLE:"; echo = 2;
117   ring  r = 0,(x,y,z),lp;
118   ideal i = y3+x2, x2y+x2, x3-x2, z4-x2-y;
119   ideal i1= stdhilb(i); i1;
120   // is in this case equivalent to:
121   intvec v=1,0,0,-3,0,1,0,3,-1,-1;
122   ideal i2=stdhilb(i,v);
123}
124//////////////////////////////////////////////////////////////////////////
125
126proc groebner(def i, list #)
127"USAGE: groebner(i[, wait]) i -- ideal/module; wait -- int
128RETURNS: Standard basis of ideal or module which is computed using a
129         heuristically choosen method:
130         If the ordering of the current ring is a local ordering, or
131         if it is a non-block ordering and the current ring has no
132         parameters, then std(i) is returned. 
133         Otherwise, i is mapped into a ring with no parameters and
134         ordering dp, where its Hilbert series is computed. This is
135         followed by a Hilbert-series based std computation in the
136         original ring.
137NOTE: If a 2nd argument 'wait' is given, then the computation proceeds
138      at most 'wait' seconds. That is, if no result could be computed in
139      'wait' seconds, then the computation is interrupted, 0 is returned,
140      a warning message is displayed, and the global variable
141      'groebner_error' is defined.
142EXAMPLE: example groebner; shows an example"
143{
144  def P=basering;
145
146  // we have two arguments -- try to use MPfork links
147  if (size(#) > 0)
148  {
149    if (system("with", "MP"))
150    {
151      if (typeof(#[1]) == "int")
152      {
153        int wait = #[1] * 1000000;
154        int j,k = 10, 0;
155        string bs = nameof(basering);
156        link l_fork = "MPtcp:fork";
157        open(l_fork);
158        write(l_fork, quote(system("pid")));
159        int pid = read(l_fork);
160        write(l_fork, quote(groebner(eval(i))));
161       
162        while(k < wait)
163        {
164          if (status(l_fork, "read", "ready", j)) {break;}
165          k = k + j;
166          j = j + j;
167        }
168
169        if (status(l_fork, "read", "ready"))
170        {
171          def result = read(l_fork);
172          if (bs != nameof(basering))
173          {
174            def PP = basering;
175            setring P;
176            def result = imap(PP, result);
177            kill PP;
178          }
179          if (defined(groebner_error))
180          {
181            kill(groebner_error);
182          }
183          kill (l_fork);
184        }
185        else
186        {
187          ideal result;
188          if (! defined(groebner_error))
189          {
190            int groebner_error = 1;
191            export groebner_error;
192          }
193          "// ** groebner did not finish";
194          j = system("sh", "kill " + string(pid));
195        }
196        return (result);
197      }
198      else
199      {
200        "// ** groebner needs int as 2nd arg";
201      }
202    }
203    else
204    {
205      "// ** groebner with two args not supported in this configuration";
206    }
207  }
208
209  // we are still here -- do the actual computation
210  string ordstr_P = ordstr(P);
211  if (find(ordstr_P,"s") > 0)
212  {
213    //spaeter den lokalen fall ueber lp oder aehnlich behandeln
214    return(std(i));
215  }
216   
217  int IsSimple_P;
218  if (system("nblocks") <= 2)
219  {
220    if (find(ordstr_P, "M") <= 0)
221    {
222      IsSimple_P = 1;
223    }
224  }
225  int npars_P = npars(P);
226
227  // return std if no parameters and (dp or wp)
228  if ((npars_P == 0) && IsSimple_P)
229  {
230    if (find(ordstr_P, "d") > 0)
231    {
232      return (std(i));
233    }
234    if (find(ordstr_P,"w") > 0)
235    {
236      return (std(i));
237    }
238  }
239
240  // reset options
241  intvec opt=option(get);
242  int p_opt;
243  string s_opt = option();
244  option(none);
245  // turn on option(prot) and/or option(mem), if previously set
246  if (find(s_opt, "prot"))
247  {
248    option(prot);
249    p_opt = 1;
250  }
251  if (find(s_opt, "mem"))
252  {
253    option(mem);
254  }
255   
256  // construct ring in which first std computation is done
257  string varstr_P = varstr(P);
258  string parstr_P = parstr(P);
259  int is_homog = (homog(i) && (npars_P == 0));
260   
261  string ri = "ring Phelp =" + string(char(P)) + ",(" + varstr_P;
262  // parameters are converted to ring variables
263  if (npars_P > 0)
264  {
265    ri = ri + "," + parstr_P;
266  }
267  // a homogenizing variable is added, if necessary
268  if (! is_homog)
269  {
270    ri = ri + ",@t";
271  }
272  // ordering is set to (dp, C)
273  ri = ri + "),(dp,C);";
274
275  // change the ring
276  execute(ri);
277   
278  // get ideal from previous ring
279  if (is_homog)
280  {
281    ideal qh = imap(P, i);
282  }
283  else
284  {
285    // and homogenize
286    ideal qh=homog(imap(P,i),@t);
287  }
288   
289  // compute std and hilbert series
290  if (p_opt)
291  {
292    "std in " + ri[13, size(ri) - 13];
293  }
294  ideal qh1=std(qh);
295  intvec hi=hilb(qh1,1);
296
297  if (is_homog && (npars_P == 0))
298  {
299    // no additional variables were introduced
300    setring P; // can immediately change to original ring
301    // simply compute std with hilbert series in original ring
302    if (p_opt)
303    {
304      "std with hilb in basering";
305      i = std(i, hi);
306    }
307  }
308  else
309  {
310    // additional variables were introduced
311    // need another intermediate ring
312    ri = "ring Phelp1 =" + string(char(P))
313      + ",(" + varstr(Phelp) + "),(" + ordstr_P;
314     
315    // for lp without parameters, we do not need a block ordering
316    if ( ! (IsSimple_P && (npars_P + is_homog < 2) && find(ordstr_P, "l")))
317    {
318      // need block ordering
319      ri = ri + ", dp(" + string(npars_P + is_homog) + ")";
320    }
321    ri = ri + ");";
322     
323    // change to intermediate ring
324    execute(ri);
325    ideal qh = imap(Phelp, qh);
326    kill Phelp;
327    if (p_opt)
328    {
329      "std with hilb in " + ri[14,size(ri)-14];
330    }
331    // compute std with Hilbert series
332    qh = std(qh, hi);
333    // subst 1 for homogenizing var
334    if (!is_homog)
335    {
336      qh = subst(qh, @t, 1);
337    }
338     
339    // go back to original ring
340    setring P;
341    // get ideal, delete zeros and clean SB
342    i = imap(Phelp1,qh);
343    i = simplify(i, 34);
344    kill Phelp1;
345  }
346
347  // clean-up time
348  option(set, opt);
349  if (find(s_opt, "redSB") > 0)
350  {
351    i=interred(i);
352  }
353  attrib(i, "isSB", 1);
354  return (i);
355}
356example
357{
358  "EXAMPLE: "; echo = 2;
359  ring r = 0, (a,b,c,d), lp;
360  option(prot);
361  ideal i = a+b+c+d, ab+ad+bc+cd, abc+abd+acd+bcd, abcd-1; // cyclic 4
362  groebner(i);
363  ring rp = (0, a, b), (c,d), lp;
364  ideal i = imap(r, i);
365  ideal j = groebner(i);
366  option(noprot);
367  j; simplify(j, 1); std(i);
368  if (system("with", "MP")) {groebner(i, 0);}
369  defined(groebner_error);
370}
371
372
373//////////////////////////////////////////////////////////////////////////
374proc resu(list #)
375{
376   def P=basering;
377   list result;
378   def m=#[1]; //the ideal or module
379   
380   int i=#[2]; //the length of the resolution
381               //if size(#)>2 a minimal resolution is computed
382
383   //LaScala for the homogeneous case
384   if(homog(m)==1)
385   {
386      resolution re=lres(m,i);
387      if(size(#)>2)
388      {
389         re=minres(re);
390      }
391      return(re);
392   }
393
394   //mres for the global non homogeneous case
395   if(find(ordstr(P),"s")==0)
396   {
397      string ri= "ring Phelp ="
398                  +string(char(P))+",("+varstr_P+"),(dp,C);";
399      execute(ri);
400      def m=imap(P,m);
401      list re=mres(m,i);
402      setring P;
403      result=imap(Phelp,re);
404      return(result);   
405   }
406
407   //sres for the local case and not minimal resolution
408   if(size(#)<=2)
409   {
410      string ri= "ring Phelp ="
411                  +string(char(P))+",("+varstr_P+"),(ls,c);";
412      execute(ri);
413      def m=imap(P,m);
414      m=std(m);
415      list re=sres(m,i);
416      setring P;
417      result=imap(Phelp,re);
418      return(result);
419   }
420
421   //mres for the local case and minimal resolution
422   string ri= "ring Phelp ="
423                  +string(char(P))+",("+varstr_P+"),(ls,C);";
424   execute(ri);
425   def m=imap(P,m);
426   list re=mres(m,i);
427   setring P;
428   result=imap(Phelp,re);
429   return(result);     
430}
431
432proc minresu(list #)
433{
434   return(resu(#[1],#[2],1));
435}
Note: See TracBrowser for help on using the repository browser.