source: git/Singular/LIB/standard.lib @ b3ce75

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