source: git/Singular/LIB/standard.lib @ 36861ed

spielwiese
Last change on this file since 36861ed was 36861ed, checked in by Hans Schönemann <hannes@…>, 25 years ago
* hannes: res recognizes option(prot) git-svn-id: file:///usr/local/Singular/svn/trunk@3529 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 25.8 KB
Line 
1// $Id: standard.lib,v 1.42 1999-08-23 14:17:35 Singular Exp $
2//////////////////////////////////////////////////////////////////////////////
3
4version="$Id: standard.lib,v 1.42 1999-08-23 14:17:35 Singular Exp $";
5info="
6LIBRARY: standard.lib   PROCEDURES WHICH ARE ALWAYS LOADED AT START-UP
7
8PROCEDURES:
9 stdfglm(ideal[,ord])   standard basis of ideal via fglm [and ordering ord]
10 stdhilb(ideal[,h])     standard basis of ideal using the Hilbert function
11 groebner(ideal/module) standard basis using a heuristically chosen method
12 quot(any,any[,n])      quotient using heuristically chosen method
13 res(ideal/module,[i])  free resolution of ideal or module
14 sprintf(fmt,...)     returns fomatted string
15 fprintf(link,fmt,..) writes formatted string to link
16 printf(fmt,...)      displays formatted string
17";
18
19//////////////////////////////////////////////////////////////////////////////
20
21proc stdfglm (ideal i, list #)
22"USAGE:   stdfglm(i[,s]); i ideal, s string (any allowed ordstr of a ring)
23RETURN:  stdfglm(i): standard basis of i in the basering, calculated via fglm
24                     from ordering \"dp\" to the ordering of the basering.
25         stdfglm(i,s): standard basis of i in the basering, calculated via
26                     fglm from ordering s to the ordering of the basering.
27SEE ALSO: stdhilb, std, groebner
28KEYWORDS: fglm
29EXAMPLE: example stdfglm; shows an example"
30{
31   string os;
32   def dr= basering;
33   if( (size(#)==0) or (typeof(#[1]) != "string") )
34   {
35     os = "dp(" + string( nvars(dr) ) + ")";
36     if ( (find( ordstr(dr), os ) != 0) and (find( ordstr(dr), "a") == 0) )
37     {
38       os= "Dp";
39     }
40     else
41     {
42       os= "dp";
43     }
44   }
45   else { os = #[1]; }
46   execute "ring sr=("+charstr(dr)+"),("+varstr(dr)+"),"+os+";";
47   ideal i= fetch(dr,i);
48   intvec opt= option(get);
49   option(redSB);
50   i=std(i);
51   option(set,opt);
52   setring dr;
53   return (fglm(sr,i));
54}
55example
56{ "EXAMPLE:"; echo = 2;
57   ring r  = 0,(x,y,z),lp;
58   ideal i = y3+x2, x2y+x2, x3-x2, z4-x2-y;
59   ideal i1= stdfglm(i);         //uses fglm from "dp" to "lp"
60   i1;
61   ideal i2= stdfglm(i,"Dp");    //uses fglm from "Dp" to "lp"
62   i2;
63}
64/////////////////////////////////////////////////////////////////////////////
65
66proc stdhilb(ideal i,list #)
67"USAGE:  stdhilb(i);  i ideal
68         stdhilb(i,v); i homogeneous ideal, v intvec (the Hilbert function)
69RETURN:  stdhilb(i): a standard basis of i (computing v internally)
70         stdhilb(i,v): standard basis of i, using the given Hilbert function
71SEE ALSO: stdfglm, std, groebner
72KEYWORDS: Hilbert function
73EXAMPLE: example stdhilb; shows an example"
74{
75   def R=basering;
76
77   if((homog(i)==1)||(ordstr(basering)[1]=="d"))
78   {
79      if ((size(#)!=0)&&(homog(i)==1))
80      {
81         return(std(i,#[1]));
82      }
83      return(std(i));
84   }
85
86   execute "ring S = ("+charstr(R)+"),("+varstr(R)+",@t),dp;";
87   ideal i=homog(imap(R,i),@t);
88   intvec v=hilb(std(i),1);
89   execute "ring T = ("+charstr(R)+"),("+varstr(R)+",@t),("+ordstr(R)+");";
90   ideal i=fetch(S,i);
91   ideal a=std(i,v);
92   setring R;
93   map phi=T,maxideal(1),1;
94   ideal a=phi(a);
95
96   int k,j;
97   poly m;
98   int c=size(i);
99
100   for(j=1;j<c;j++)
101   {
102     if(deg(a[j])==0)
103     {
104       a=ideal(1);
105       attrib(a,"isSB",1);
106       return(a);
107     }
108     if(deg(a[j])>0)
109     {
110       m=lead(a[j]);
111       for(k=j+1;k<=c;k++)
112       {
113          if(size(lead(a[k])/m)>0)
114          {
115            a[k]=0;
116          }
117       }
118     }
119   }
120   a=simplify(a,2);
121   attrib(a,"isSB",1);
122   return(a);
123}
124example
125{ "EXAMPLE:"; echo = 2;
126   ring  r = 0,(x,y,z),lp;
127   ideal i = y3+x2, x2y+x2, x3-x2, z4-x2-y;
128   ideal i1= stdhilb(i); i1;
129   // is in this case equivalent to:
130   intvec v=1,0,0,-3,0,1,0,3,-1,-1;
131   ideal i2=stdhilb(i,v);
132}
133//////////////////////////////////////////////////////////////////////////
134
135proc groebner(def i, list #)
136"USAGE: groebner(i[, wait]) i -- ideal/module; wait -- int
137RETURNS: Standard basis of ideal or module which is computed using a
138         heuristically chosen method:
139         If the ordering of the current ring is a local ordering, or
140         if it is a non-block ordering and the current ring has no
141         parameters, then std(i) is returned.
142         Otherwise, i is mapped into a ring with no parameters and
143         ordering dp, where its Hilbert series is computed. This is
144         followed by a Hilbert-series based std computation in the
145         original ring.
146NOTE: If a 2nd argument 'wait' is given, then the computation proceeds
147      at most 'wait' seconds. That is, if no result could be computed in
148      'wait' seconds, then the computation is interrupted, 0 is returned,
149      a warning message is displayed, and the global variable
150      'groebner_error' is defined.
151SEE ALSO: stdhilb, stdfglm, std
152KEYWORDS: time limit on computations; MP, groebner basis computations
153EXAMPLE: example groebner; shows an example"
154{
155  def P=basering;
156
157  // we have two arguments -- try to use MPfork links
158  if (size(#) > 0)
159  {
160    if (system("with", "MP"))
161    {
162      if (typeof(#[1]) == "int")
163      {
164        int wait = #[1];
165        int j = 10;
166
167        string bs = nameof(basering);
168        link l_fork = "MPtcp:fork";
169        open(l_fork);
170        write(l_fork, quote(system("pid")));
171        int pid = read(l_fork);
172        write(l_fork, quote(groebner(eval(i))));
173
174        // sleep in small intervalls for appr. one second
175        if (wait > 0)
176        {
177          while(j < 1000000)
178          {
179            if (status(l_fork, "read", "ready", j)) {break;}
180            j = j + j;
181          }
182        }
183
184        // sleep in intervalls of one second from now on
185        j = 1;
186        while (j < wait)
187        {
188          if (status(l_fork, "read", "ready", 1000000)) {break;}
189          j = j + 1;
190        }
191
192        if (status(l_fork, "read", "ready"))
193        {
194          def result = read(l_fork);
195          if (bs != nameof(basering))
196          {
197            def PP = basering;
198            setring P;
199            def result = imap(PP, result);
200            kill PP;
201          }
202          if (defined(groebner_error))
203          {
204            kill(groebner_error);
205          }
206          kill (l_fork);
207        }
208        else
209        {
210          ideal result;
211          if (! defined(groebner_error))
212          {
213            int groebner_error = 1;
214            export groebner_error;
215          }
216          "// ** groebner did not finish";
217          j = system("sh", "kill " + string(pid));
218        }
219        return (result);
220      }
221      else
222      {
223        "// ** groebner needs int as 2nd arg";
224      }
225    }
226    else
227    {
228      "// ** groebner with two args is not supported in this configuration";
229    }
230  }
231
232  // we are still here -- do the actual computation
233  string ordstr_P = ordstr(P);
234  if (find(ordstr_P,"s") > 0)
235  {
236    //spaeter den lokalen fall ueber lp oder aehnlich behandeln
237    return(std(i));
238  }
239
240  int IsSimple_P;
241  if (system("nblocks") <= 2)
242  {
243    if (find(ordstr_P, "M") <= 0)
244    {
245      IsSimple_P = 1;
246    }
247  }
248  int npars_P = npars(P);
249
250  // return std if no parameters and (dp or wp)
251  if ((npars_P <= 1) && IsSimple_P)
252  {
253    if (find(ordstr_P, "d") > 0)
254    {
255      return (std(i));
256    }
257    if (find(ordstr_P,"w") > 0)
258    {
259      return (std(i));
260    }
261  }
262
263  // reset options
264  intvec opt=option(get);
265  int p_opt;
266  string s_opt = option();
267  option(none);
268  // turn on option(prot) and/or option(mem), if previously set
269  if (find(s_opt, "prot"))
270  {
271    option(prot);
272    p_opt = 1;
273  }
274  if (find(s_opt, "mem"))
275  {
276    option(mem);
277  }
278
279  // construct ring in which first std computation is done
280  string varstr_P = varstr(P);
281  string parstr_P = parstr(P);
282  int is_homog = (homog(i) && (npars_P <= 1));
283  int add_vars = 0;
284  string ri = "ring Phelp =";
285
286  // more than one parameters are converted to ring variables
287  if (npars_P > 1)
288  {
289    ri = ri + string(char(P)) + ",(" + varstr_P + "," + parstr_P;
290    add_vars = npars_P;
291  }
292  else
293  {
294    ri = ri + "(" + charstr(P) + "),(" + varstr_P;
295  }
296
297  // a homogenizing variable is added, if necessary
298  if (! is_homog)
299  {
300    ri = ri + ",@t";
301    add_vars = add_vars + 1;
302  }
303  // ordering is set to (dp, C)
304  ri = ri + "),(dp,C);";
305
306  // change the ring
307  execute(ri);
308
309  // get ideal from previous ring
310  if (is_homog)
311  {
312    ideal qh = imap(P, i);
313  }
314  else
315  {
316    // and homogenize
317    ideal qh=homog(imap(P,i),@t);
318  }
319
320  // compute std and hilbert series
321  if (p_opt)
322  {
323    "std in " + ri[13, size(ri) - 13];
324  }
325  ideal qh1=std(qh);
326  intvec hi=hilb(qh1,1);
327
328  if (add_vars == 0)
329  {
330    // no additional variables were introduced
331    setring P; // can immediately change to original ring
332    // simply compute std with hilbert series in original ring
333    if (p_opt)
334    {
335      "std with hilb in basering";
336    }
337    i = std(i, hi);
338  }
339  else
340  {
341    // additional variables were introduced
342    // need another intermediate ring
343    ri = "ring Phelp1 = (" + charstr(Phelp)
344      + "),(" + varstr(Phelp) + "),(" + ordstr_P;
345
346    // for lp wit at most one parameter, we do not need a block ordering
347    if ( ! (IsSimple_P && (add_vars <2) && find(ordstr_P, "l")))
348    {
349      // need block ordering
350      ri = ri + ", dp(" + string(add_vars) + ")";
351    }
352    ri = ri + ");";
353
354    // change to intermediate ring
355    execute(ri);
356    ideal qh = imap(Phelp, qh);
357    kill Phelp;
358    if (p_opt)
359    {
360      "std with hilb in " + ri[14,size(ri)-14];
361    }
362    // compute std with Hilbert series
363    qh = std(qh, hi);
364    // subst 1 for homogenizing var
365    if (!is_homog)
366    {
367      if (p_opt)
368      {
369        "dehomogenization";
370      }
371      qh = subst(qh, @t, 1);
372    }
373
374    // go back to original ring
375    setring P;
376    // get ideal, delete zeros and clean SB
377    if (p_opt)
378    {
379      "imap to original ring";
380    }
381    i = imap(Phelp1,qh);
382    if (p_opt)
383    {
384      "simplification";
385    }
386    i = simplify(i, 34);
387    kill Phelp1;
388  }
389
390  // clean-up time
391  option(set, opt);
392  if (find(s_opt, "redSB") > 0)
393  {
394    if (p_opt)
395    {
396      "interreduction";
397    }
398    i=interred(i);
399  }
400  attrib(i, "isSB", 1);
401  return (i);
402}
403example
404{ "EXAMPLE: "; echo = 2;
405  ring r = 0, (a,b,c,d), lp;
406  option(prot);
407  ideal i = a+b+c+d, ab+ad+bc+cd, abc+abd+acd+bcd, abcd-1; // cyclic 4
408  groebner(i);
409  ring rp = (0, a, b), (c,d), lp;
410  ideal i = imap(r, i);
411  ideal j = groebner(i);
412  option(noprot);
413  j; simplify(j, 1); std(i);
414  if (system("with", "MP")) {groebner(i, 0);}
415  defined(groebner_error);
416}
417
418
419//////////////////////////////////////////////////////////////////////////
420proc res(list #)
421"@c we do texinfo here:
422@cindex resolution, computation of
423@table @code
424@item @strong{Syntax:}
425@code{res (} ideal_expression@code{,} int_expression @code{[,} any_expression @code{])}
426@*@code{res (} module_expression@code{,} int_expression @code{[,} any_expression @code{])}
427@item @strong{Type:}
428resolution
429@item @strong{Purpose:}
430computes a (possibly minimal) free resolution of an ideal or module using
431a heuristically choosen method.
432@* The second (int) argument (say, @code{k}) specifies the length of
433the resolution. If @code{k <=0 } then k is assumed to be the number of
434variables of the basering.
435@* If a third argument is given, the returned resolution is minimized.
436
437Depending on the input, the returned resolution is computed using the
438following methods:
439@table @asis
440@item @strong{quotient rings:}
441@code{nres} (classical method using syzygies) , see @ref{nres}.
442
443@item @strong{homogenous ideals and k == 0:}
444@code{lres} (La'Scala's method), see @ref{lres}.
445
446@item @strong{not minimized resolution,  and, homogenous input with k != 0 or local rings:}
447@code{sres} (Schreyer's method), see @ref{sres}.
448
449@item @strong{all other inputs:}
450@code{mres} (classical method), see @ref{mres}.
451@end table
452@item @strong{Note:}
453Accessing single elements of a resolution may require that some partial computations have to be finished and may therefor take some time.
454@end table
455@c ref
456See also
457@ref{betti};
458@ref{ideal};
459@ref{minres};
460@ref{module};
461@ref{mres};
462@ref{nres};
463@ref{lres};
464@ref{sres}.
465@ref{resolution}
466@c ref
467"
468{
469   def P=basering;
470   if (size(#) < 2)
471   {
472     ERROR("res: need at least two arguments: ideal/module, int");
473   }
474
475   def m=#[1]; //the ideal or module
476   int i=#[2]; //the length of the resolution
477   if (i< 0) { i=0;}
478
479   string varstr_P = varstr(P);
480
481   int p_opt;
482   string s_opt = option();
483   // set p_opt, if option(prot) is set
484   if (find(s_opt, "prot"))
485   {
486     p_opt = 1;
487   }
488
489   if(size(ideal(basering)) > 0)
490   {
491     // the quick hack for qrings - seems to fit most needs
492     // (lres is not implemented for qrings, sres is not so efficient)
493     if (p_opt) { "using nres";}
494     return(nres(m,i));
495   }
496
497   if(homog(m)==1)
498   {
499      resolution re;
500      if (((i==0) or (i>=nvars(basering))) && typeof(m) != "module")
501      {
502        //LaScala for the homogeneous case and i == 0
503        if (p_opt) { "using lres";}
504        re=lres(m,i);
505        if(size(#)>2)
506        {
507           re=minres(re);
508        }
509      }
510      else
511      {
512        if(size(#)>2)
513        {
514          if (p_opt) { "using mres";}
515          re=mres(m,i);
516        }
517        else
518        {
519          if (p_opt) { "using sres";}
520          re=sres(std(m),i);
521        }
522      }
523      return(re);
524   }
525
526   //mres for the global non homogeneous case
527   if(find(ordstr(P),"s")==0)
528   {
529      string ri= "ring Phelp ="
530                  +string(char(P))+",("+varstr_P+"),(dp,C);";
531      execute(ri);
532      def m=imap(P,m);
533      if (p_opt) { "using mres in another ring";}
534      list re=mres(m,i);
535      setring P;
536      resolution result=imap(Phelp,re);
537      if (size(#) > 2) {result = minres(result);}
538      return(result);
539   }
540
541   //sres for the local case and not minimal resolution
542   if(size(#)<=2)
543   {
544      string ri= "ring Phelp ="
545                  +string(char(P))+",("+varstr_P+"),(ls,c);";
546      execute(ri);
547      def m=imap(P,m);
548      m=std(m);
549      if (p_opt) { "using sres in another ring";}
550      list re=sres(m,i);
551      setring P;
552      resolution result=imap(Phelp,re);
553      return(result);
554   }
555
556   //mres for the local case and minimal resolution
557   string ri= "ring Phelp ="
558                  +string(char(P))+",("+varstr_P+"),(ls,C);";
559   execute(ri);
560   def m=imap(P,m);
561    if (p_opt) { "using mres in another ring";}
562   list re=mres(m,i);
563   setring P;
564   resolution result=imap(Phelp,re);
565   result = minres(result);
566   return(result);
567}
568example
569{"EXAMPLE:"; echo = 2;
570  ring r=0,(x,y,z),dp;
571  ideal i=xz,yz,x^3-y^3;
572  def l=res(i,0); // homogenous ideal: uses lres
573  l;              // resolution is not yet minimized
574  print(betti(l), "betti"); // input to betti may be of type resolution
575  l[2];         // element access may take some time
576  i=i, x+1;
577  l=res(i,0);   // inhomogenous ideal: uses mres
578  l;            // resolution is not yet minimized
579  ring rs=0,(x,y,z),ds;
580  ideal i = imap(r, i);
581  def l=res(i,0); // local ring not minimized: uses sres
582  l;              // resolution is minimized
583  res(i,0,0);     // local ring and minimized: uses mres
584}
585
586
587proc quot (m1,m2,list #)
588"USAGE:   quot(m1, m2[, n]); m1, m2 two submodules of k^s,
589          n (optional) integer (1<= n <=5)
590RETURN:  the quotient of m1 and m2
591SEE ALSO: quotient
592EXAMPLE: example quot; shows an example"
593{
594  if (((typeof(m1)!="ideal") and (typeof(m1)!="module"))
595     or ((typeof(m2)!="ideal") and (typeof(m2)!="module")))
596  {
597    "USAGE:   quot(m1, m2[, n]); m1, m2 two submodules of k^s,";
598    "         n (optional) integer (1<= n <=5)";
599    "RETURN:  the quotient of m1 and m2";
600    "EXAMPLE: example quot; shows an example";
601    return();
602  }
603  if (typeof(m1)!=typeof(m2))
604  {
605    return(quotient(m1,m2));
606  }
607  if (size(#)>0)
608  {
609    if (typeof(#[1])=="int" )
610    {
611      return(quot1(m1,m2,#[1]));
612    }
613  }
614  else
615  {
616    return(quot1(m1,m2,2));
617  }
618}
619example
620{ "EXAMPLE:"; echo = 2;
621  ring r=181,(x,y,z),(c,ls);
622  ideal id1=maxideal(4);
623  ideal id2=x2+xyz,y2-z3y,z3+y5xz;
624  option(prot);
625  ideal id6=quotient(id1,id2);
626  id6;
627  ideal id7=quot(id1,id2,1);
628  id7;
629  ideal id8=quot(id1,id2,2);
630  id8;
631}
632
633static proc quot1 (module m1, module m2,int n)
634"USAGE:   quot1(m1, m2, n); m1, m2 two submodules of k^s,
635         n integer (1<= n <=5)
636RETURN:  the quotient of m1 and m2
637EXAMPLE: example quot1; shows an example"
638{
639  if (n==1)
640  {
641    return(quotient1(m1,m2));
642  }
643  else
644  {
645    if (n==2)
646    {
647      return(quotient2(m1,m2));
648    }
649    else
650    {
651      if (n==3)
652      {
653        return(quotient3(m1,m2));
654      }
655      else
656      {
657        if (n==4)
658        {
659          return(quotient4(m1,m2));
660        }
661        else
662        {
663          if (n==5)
664          {
665            return(quotient5(m1,m2));
666          }
667          else
668          {
669            return(quotient(m1,m2));
670          }
671        }
672      }
673    }
674  }
675}
676example
677{ "EXAMPLE:"; echo = 2;
678  ring r=181,(x,y,z),(c,ls);
679  ideal id1=maxideal(4);
680  ideal id2=x2+xyz,y2-z3y,z3+y5xz;
681  option(prot);
682  ideal id6=quotient(id1,id2);
683  id6;
684  ideal id7=quot1(id1,id2,1);
685  id7;
686  ideal id8=quot1(id1,id2,2);
687  id8;
688}
689
690static proc quotient0(module a,module b)
691{
692  module mm=b+a;
693  resolution rs=lres(mm,0);
694  list I=list(rs);
695  matrix M=I[2];
696  matrix A[1][nrows(M)]=M[1..nrows(M),1];
697  ideal i=A;
698  return (i);
699}
700proc quotient1(module a,module b)  //17sec
701"USAGE:   quotient1(m1, m2); m1, m2 two submodules of k^s,
702RETURN:  the quotient of m1 and m2"
703{
704  int i;
705  a=std(a);
706  module dummy;
707  module B=NF(b,a)+dummy;
708  ideal re=quotient(a,module(B[1]));
709  for(i=2;i<=size(B);i++)
710  {
711     re=intersect1(re,quotient(a,module(B[i])));
712  }
713  return(re);
714}
715proc quotient2(module a,module b)    //13sec
716"USAGE:   quotient2(m1, m2); m1, m2 two submodules of k^s,
717RETURN:  the quotient of m1 and m2"
718{
719  a=std(a);
720  module dummy;
721  module bb=NF(b,a)+dummy;
722  int i=size(bb);
723  ideal re=quotient(a,module(bb[i]));
724  bb[i]=0;
725  module temp;
726  module temp1;
727  module bbb;
728  int mx;
729  i=i-1;
730  while (1)
731  {
732    if (i==0) break;
733    temp = a+bb*re;
734    temp1 = lead(interred(temp));
735    mx=ncols(a);
736    if (ncols(temp1)>ncols(a))
737    {
738      mx=ncols(temp1);
739    }
740    temp1 = matrix(temp1,1,mx)-matrix(lead(a),1,mx);
741    temp1 = dummy+temp1;
742    if (deg(temp1[1])<0) break;
743    re=intersect1(re,quotient(a,module(bb[i])));
744    bb[i]=0;
745    i = i-1;
746  }
747  return(re);
748}
749proc quotient3(module a,module b)   //89sec
750"USAGE:   quotient3(m1, m2); m1, m2 two submodules of k^s,
751         only for global rings
752RETURN:  the quotient of m1 and m2"
753{
754  string s="ring @newr=("+charstr(basering)+
755           "),("+varstr(basering)+",@t,@w),dp;";
756  def @newP=basering;
757  execute s;
758  module b=imap(@newP,b);
759  module a=imap(@newP,a);
760  int i;
761  int j=size(b);
762  vector @b;
763  for(i=1;i<=j;i++)
764  {
765     @b=@b+@t^(i-1)*@w^(j-i+1)*b[i];
766  }
767  ideal re=quotient(a,module(@b));
768  setring @newP;
769  ideal re=imap(@newr,re);
770  return(re);
771}
772proc quotient5(module a,module b)   //89sec
773"USAGE:   quotient5(m1, m2); m1, m2 two submodules of k^s,
774         only for global rings
775RETURN:  the quotient of m1 and m2"
776{
777  string s="ring @newr=("+charstr(basering)+
778           "),("+varstr(basering)+",@t),dp;";
779  def @newP=basering;
780  execute s;
781  module b=imap(@newP,b);
782  module a=imap(@newP,a);
783  int i;
784  int j=size(b);
785  vector @b;
786  for(i=1;i<=j;i++)
787  {
788     @b=@b+@t^(i-1)*b[i];
789  }
790  @b=homog(@b,@w);
791  ideal re=quotient(a,module(@b));
792  setring @newP;
793  ideal re=imap(@newr,re);
794  return(re);
795}
796proc quotient4(module a,module b)   //95sec
797"USAGE:   quotient4(m1, m2); m1, m2 two submodules of k^s,
798         only for global rings
799RETURN:  the quotient of m1 and m2"
800{
801  string s="ring @newr=("+charstr(basering)+
802           "),("+varstr(basering)+",@t),dp;";
803  def @newP=basering;
804  execute s;
805  module b=imap(@newP,b);
806  module a=imap(@newP,a);
807  int i;
808  vector @b=b[1];
809  for(i=2;i<=size(b);i++)
810  {
811     @b=@b+@t^(i-1)*b[i];
812  }
813  matrix sy=modulo(@b,a);
814  ideal re=sy;
815  setring @newP;
816  ideal re=imap(@newr,re);
817  return(re);
818}
819static proc intersect1(ideal i,ideal j)
820{
821  def R=basering;
822  execute "ring gnir = ("+charstr(basering)+"),
823                       ("+varstr(basering)+",@t),(C,dp);";
824  ideal i=var(nvars(basering))*imap(R,i)+(var(nvars(basering))-1)*imap(R,j);
825  ideal j=eliminate(i,var(nvars(basering)));
826  setring R;
827  map phi=gnir,maxideal(1);
828  return(phi(j));
829}
830
831//////////////////////////////////////////////////////////////////
832///
833/// sprintf, fprintf printf
834///
835proc sprintf(string fmt, list #)
836"USAGE:    sprintf(fmt, ...) fmt string
837RETURN:   string
838PURPOSE:  sprintf performs output formatting. The first argument is a format
839          control string. Additional arguments may be required, depending on
840          the contents of the control string. A series of output characters is
841          generated as directed by the control string; these characters are
842          returned as a string. The control string is simply text to be copied,
843          except that the string may contain conversion specifications. Do
844          'help print:' for a listing of valid conversion specifications.
845          As an addition to the conversions of 'print', the '%n' and '%2'
846          conversion specification does not consume an additional argument,
847          but simply generates a newline character.
848NOTE:     If one of the additional arguments is a list, then it should be
849          enclosed once more into a list() command, since passing a list
850          as an argument flattens the list by one level.
851SEE ALSO: fprintf, printf, print, string
852EXAMPLE : example sprintf; shows an example
853"
854{
855  int sfmt = size(fmt);
856  if (sfmt  <= 1)
857  {
858    return (fmt);
859  }
860  int next, l, nnext;
861  string ret;
862  list formats = "%l", "%s", "%2l", "%2s", "%t", "%;", "%p", "%b", "%n", "%2";
863  while (1)
864  {
865    if (size(#) <= 0)
866    {
867      return (ret + fmt);
868    }
869    nnext = 0;
870    while (nnext < sfmt)
871    {
872      nnext = find(fmt, "%", nnext + 1);
873      if (nnext == 0)
874      {
875        next = 0;
876        break;
877      }
878      l = 1;
879      while (l <= size(formats))
880      {
881        next = find(fmt, formats[l], nnext);
882        if (next == nnext) break;
883        l++;
884      }
885      if (next == nnext) break;
886    }
887    if (next == 0)
888    {
889      return (ret + fmt);
890    }
891    if (formats[l] != "%2" && formats[l] != "%n")
892    {
893      ret = ret + fmt[1, next - 1] + print(#[1], formats[l]);
894      # = delete(#, 1);
895    }
896    else
897    {
898      ret = ret + fmt[1, next - 1] + print("", "%2s");
899    }
900    if (size(fmt) <= (next + size(formats[l]) - 1))
901    {
902      return (ret);
903    }
904    fmt = fmt[next + size(formats[l]), size(fmt)-next-size(formats[l]) + 1];
905  }
906}
907example
908{ "EXAMPLE:"; echo=2;
909  ring r=0,(x,y,z),dp;
910  module m=[1,y],[0,x+z];
911  intmat M=betti(mres(m,0));
912  list l = r, m, M;
913  string s = sprintf("s:%s,%n l:%l", 1, 2); s;
914  s = sprintf("s:%n%s", l); s;
915  s = sprintf("s:%2%s", list(l)); s;
916  s = sprintf("2l:%n%2l", list(l)); s;
917  s = sprintf("%p", list(l)); s;
918  s = sprintf("%;", list(l)); s;
919  s = sprintf("%b", M); s;
920}
921
922proc printf(string fmt, list #)
923"USAGE:    printf(fmt, ...) fmt string
924RETURN:   none
925PURPOSE:  printf performs output formatting. The first argument is a format
926          control string. Additional arguments may be required, depending on
927          the contents of the control string. A series of output characters is
928          generated as directed by the control string; these characters are
929          displayed (i.e. printed to standard out).
930          The control string is simply text to be copied, except that the
931          string may contain conversion specifications.
932          Do 'help print:' for a listing of valid conversion specifications.
933          As an addition to the conversions of 'print', the '%n' and '%2'
934          conversion specification does not consume an additional argument,
935          but simply generates a newline character.
936
937NOTE:     If one of the additional arguments is a list, then it should be
938          enclosed once more into a list() command, since passing a list
939          as an argument flattens the list by one level.
940SEE ALSO: sprintf, fprintf, print, string
941EXAMPLE : example printf; shows an example
942"
943{
944  write("", sprintf(fmt, #));
945}
946example
947{ "EXAMPLE:"; echo=2;
948  ring r=0,(x,y,z),dp;
949  module m=[1,y],[0,x+z];
950  intmat M=betti(mres(m,0));
951  list l = r, m, M;
952  printf("s:%s, l:%l", 1, 2);
953  printf("s:%s", l);
954  printf("s:%s", list(l));
955  printf("2l:%2l", list(l));
956  printf("%p", list(l));
957  printf("%;", list(l));
958  printf("%b", M);
959}
960
961
962proc fprintf(link l, string fmt, list #)
963"USAGE:    fprintf(l, fmt, ...) l link; fmt string
964RETURN:   none
965PURPOSE:  fprintf performs output formatting. The second argument is a format
966          control string. Additional arguments may be required, depending on
967          the contents of the control string. A series of output characters is
968          generated as directed by the control string; these characters are
969          written to the link l.
970          The control string is simply text to be copied, except that the
971          string may contain conversion specifications.
972          Do 'help print:' for a listing of valid conversion specifications.
973          As an addition to the conversions of 'print', the '%n' and '%2'
974          conversion specification does not consume an additional argument,
975          but simply generates a newline character.
976
977NOTE:     If one of the additional arguments is a list, then it should be
978          enclosed once more into a list() command, since passing a list
979          as an argument flattens the list by one level.
980SEE ALSO: sprintf, printf, print, string
981EXAMPLE : example fprintf; shows an example
982"
983{
984  write(l, sprintf(fmt, #));
985}
986example
987{ "EXAMPLE:"; echo=2;
988  ring r=0,(x,y,z),dp;
989  module m=[1,y],[0,x+z];
990  intmat M=betti(mres(m,0));
991  list l = r, m, M;
992  link li = ""; // link to stdout
993  fprintf(li, "s:%s, l:%l", 1, 2);
994  fprintf(li, "s:%s", l);
995  fprintf(li, "s:%s", list(l));
996  fprintf(li, "2l:%2l", list(l));
997  fprintf(li, "%p", list(l));
998  fprintf(li, "%;", list(l));
999  fprintf(li, "%b", M);
1000}
1001
1002/*
1003proc minres(list #)
1004{
1005  if (size(#) == 2)
1006  {
1007    if (typeof(#[1]) == "ideal" || typeof(#[1]) == "module")
1008    {
1009      if (typeof(#[2] == "int"))
1010      {
1011        return (res(#[1],#[2],1));
1012      }
1013    }
1014  }
1015
1016  if (typeof(#[1]) == "resolution")
1017  {
1018    return minimizeres(#[1]);
1019  }
1020  else
1021  {
1022    return minimizeres(#);
1023  }
1024
1025}
1026*/
Note: See TracBrowser for help on using the repository browser.