source: git/Singular/LIB/presolve.lib @ 63be42

spielwiese
Last change on this file since 63be42 was 82716e, checked in by Hans Schönemann <hannes@…>, 26 years ago
*hannes: typos in the info-help-string git-svn-id: file:///usr/local/Singular/svn/trunk@1773 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 43.1 KB
Line 
1// $Id: presolve.lib,v 1.5 1998-05-14 18:45:12 Singular Exp $
2//system("random",787422842);
3//(GMG), last modified 97/10/07 by GMG
4///////////////////////////////////////////////////////////////////////////////
5
6version="$Id: presolve.lib,v 1.5 1998-05-14 18:45:12 Singular Exp $";
7info="
8LIBRARY:  presolve.lib     PROCEDURES FOR PRE-SOLVING POLYNOMIAL EQUATIONS
9
10 degreepart(id,d1,d2);  elements of id of total degree >= d1 and <= d2
11 elimlinearpart(id);    linear part eliminated from id
12 elimpart(id[,n]);      partial elimination of vars [among 1-st n vars]
13 elimpartanyr(i,p);     factors of p partially eliminated from i in any ring
14 fastelim(i,p[..]);     fast elimination of factors of p from i [options]
15 findvars(id[..]);      ideal of variables occuring in id [more information]
16 hilbvec(id[,c,o]);     intvec of Hilberseries of id [in char c and ord o]
17 linearpart(id);        elements of id of total degree <=1
18 tolessvars(id[,]);     maps id to new basering having only vars occuring in id
19 solvelinearpart(id);   reduced std-basis of linear part of id
20 sortandmap(id,s1,s2);  map to new basering with vars sorted w.r.t. complexity
21 sortvars(id[n1,p1..]); sort vars w.r.t. complexity in id [different blocks]
22 valvars(id[..]);       valuation of vars w.r.t. to their complexity in id
23           (parameters in square brackets [] are optional)
24";
25
26LIB "inout.lib";
27LIB "general.lib";
28LIB "matrix.lib";
29LIB "ring.lib";
30LIB "elim.lib";
31///////////////////////////////////////////////////////////////////////////////
32
33proc degreepart (id,int d1,int d2,list #)
34"USAGE:   degreepart(id,d1,d2[,v]);  id=ideal/module, d1,d1=integers, v=intvec
35RETURN:  generators of id of [v-weighted] total degree >= d1 and <= d2
36         (default: v = 1,...,1)
37EXAMPLE: example degreepart; shows an example
38"
39{
40   def dpart = id;
41   int s,ii = size(id),0;
42   if ( size(#)==0 )
43   {
44      for ( ii=1; ii<=s; ii=ii+1 )
45      {
46         dpart[ii] = (jet(id[ii],d1-1)==0)*(id[ii]==jet(id[ii],d2))*id[ii];
47      }
48   }
49   else
50   {
51      for ( ii=1; ii<=s; ii=ii+1 )
52      {
53         dpart[ii]=(jet(id[ii],d1-1,#[1])==0)*(id[ii]==jet(id[ii],d2,#[1]))*id[ii];
54      }
55   }
56   return(simplify(dpart,2));
57}
58example
59{ "EXAMPLE:"; echo = 2;
60   ring r=0,(x,y,z),dp;
61   ideal i=1+x+x2+x3+x4,3,xz+y3+z4z4;
62   degreepart(i,0,4);
63   module m=[x,y,z],x*[x3,y2,z],[1,x2,z3,0,1];
64   intvec v=2,3,6;
65   show(degreepart(m,8,8,v));
66}
67///////////////////////////////////////////////////////////////////////////////
68
69proc elimlinearpart (ideal i,list #)
70"USAGE:   elimlinearpart(i[,n]);  i=ideal, n=integer
71RETURN:  list of of 5 objects:
72         [1]: (interreduced) ideal obtained from i by eliminating (sbstituting)
73              from the first n variables those which appear in a linear part
74              of i, by putting this part into triangular form
75              (default: n = nvars(basering))
76         [2]: ideal of variables which have been eliminated (= substituted)
77         [3]: ideal, j-th element defines substitution of j-th var in [2]
78         [4]: ideal of variables of basering, eliminated ones are set to 0
79         [5]: ideal, describing the map from the basering to itself such that
80              [1] is the image of i
81NOTE:    the procedure does always interreduces the ideal i internally w.r.t.
82         ordering dp
83         // bei ** spaeter eventuell verbessern
84EXAMPLE: example elimlinearpart; shows an example
85"
86{
87   int ii,n,fi,k;
88   string o, newo;
89   intvec getoption = option(get);
90   option(redSB);
91   def P = basering;
92   n = nvars(P);
93//--------------- replace ordering by dp-ordering if necessary ----------------
94   o = "dp("+string(n)+")";
95   fi = find(ordstr(P),o);
96   if( fi == 0 or find(ordstr(P),"a") != 0 )
97   {
98  execute "ring newP = ("+charstr(P)+"),("+varstr(P)+"),dp;";
99      ideal i = imap(P,i);
100   }
101   if ( size(#)!=0 ) {  n=#[1]; }
102   ideal max,rest = maxideal(1),0;
103   if ( n < nvars(P) ) { rest = max[n+1..nvars(P)]; }
104   attrib(rest,"isSB",1);
105//-------------------- interreduce and find linear part  ----------------------
106// interred does the only real work. Because of ordering dp the linear part is
107// within the first elements after interreduction
108// **: perhaps Bareiss to constant matrix of linear part instead of interred,
109// and/or for big systems, interred only those generators of id
110// which do not contain elements not to be eliminated
111
112   ideal id = interred(i);
113   for ( ii=1; ii<=size(id); ii++ )
114   {
115      if( deg(id[ii]) > 1) { break; }
116      k=ii;
117   }
118   if( k == 0 )       { ideal lin; }
119   else               { ideal lin = id[1..k];}
120   if( k < size(id) ) { id = id[k+1..size(id)]; }
121   else               { id = 0; }
122//----- remove generators from lin containing vars not to be eliminated  ------
123   if ( n < nvars(P) )
124   {
125      for ( ii=1; ii<=size(lin); ii++ )
126      {
127         if ( reduce(lead(lin[ii]),rest) == 0 )
128         {
129            id=lin[ii],id;
130            lin[ii] = 0;
131         }
132      }
133   }
134   lin = simplify(lin,2);
135   attrib(lin,"isSB",1);
136   ideal eva = lead(lin);
137   attrib(eva,"isSB",1);
138   ideal neva = reduce(maxideal(1),eva);
139//------------------ go back to original ring end return  ----------------------
140   if( fi == 0 or find(ordstr(P),"a") != 0 )
141   {
142      setring P;
143      ideal id = imap(newP,id);
144      ideal eva = imap(newP,eva);
145      ideal lin = imap(newP,lin);
146      ideal neva = imap(newP,neva);
147   }
148   eva = eva[ncols(eva)..1];  // sorting according to variables in basering
149   lin = lin[ncols(lin)..1];
150   ideal phi= neva;
151   k = 1;
152   for( ii=1; ii<=n; ii++ )
153   {
154      if( neva[ii] == 0 )
155      {
156         phi[ii] = eva[k]-lin[k];
157         k=k+1;
158      }
159   }
160   list L = id, eva, lin, neva, phi;
161   option(set,getoption);
162   return(L);
163}
164example
165{ "EXAMPLE:"; echo = 2;
166   ring s=0,(x,y,z,t,u,v,w,a,b,c,d,f,e),ds;
167   ideal i = w2+f2-1, x2+t2+a2-1,  y2+u2+b2-1, z2+v2+c2-1,
168             d2+e2-1, f4+2u, wa+tf, xy+tu+ab, yz+uv+bc,
169             cd+ze, x+y+z+e+1, t+u+v+f-1, w+a+b+c+d;
170  list L= elimlinearpart(i);
171}
172///////////////////////////////////////////////////////////////////////////////
173
174proc elimpart (ideal i,list #)
175"USAGE:   elimpart(i[,n,e]);  i=ideal, n,e=integers
176         consider 1-st n vars for elimination (better: substitution),
177         e =0: substitute from linear part of i (same as elimlinearpart)
178         e!=0: eliminate also by direct substitution
179         (default: n = nvars(basering), e = 1)
180RETURN:  list of of 5 objects:
181         [1]: ideal obtained by substituting from the first n variables those
182              from i which appear in the linear part of i [or, if e!=0, which
183              can be expressed directly in the remaining vars]
184         [2]: ideal, variables which have been substituted
185         [3]: ideal, i-th element defines substitution of i-th var in [2]
186         [4]: ideal of variables of basering, substituted ones are set to 0
187         [5]: ideal, describing the map from the basering, say k[x(1..m)], to
188              itself onto k[..variables fom [4]..] and [1] is the image of i
189         The ideal i is generated by [1] and [3] in k[x(1..m)], the map [5]
190         maps [3] to 0, hence induceds an isomorhism
191                   k[x(1..m)]/i -> k[..variables fom [4]..]/[1]
192NOTE:    If the basering has ordering (c,dp), this is faster for big ideals,
193         since it avoids internal ring change and mapping
194EXAMPLE: example elimpart; shows an example
195"
196{
197   def P = basering;
198   int n,e = nvars(P),1;
199   if ( size(#)==1 ) {  n=#[1]; }
200   if ( size(#)==2 ) {  n=#[1]; e=#[2];}
201//----------- interreduce linear part with proc elimlinearpart -----------------
202// lin = ideal after interreduction of linear part
203// eva = eliminated (substituted) variables
204// sub = polynomials defining substitution
205// neva= not eliminated variables
206// phi = map describing substitution
207   list L = elimlinearpart(i,n);
208   ideal lin, eva, sub, neva, phi = L[1], L[2], L[3], L[4], L[5];
209//-------- direct substitution of variables if possible and if e!=0 ------------
210// first find terms lin1 of pure degree 1 in each poly of lin
211// k1 = pure degree 1 part, k1+k2 = those polys of lin which contained a pure
212// degree 1 part.
213// Then go to ring newP with ordering c,dp(n) and create a matrix with size(k1)
214// colums and 2 rows, such that if [f1,f2] is a column of M then f1+f2 is one of
215// the polys of lin containing a pure degree 1 part and f1 is this part
216// interreduce this matrix (i.e. Gauss elimination on linear part, with rest
217// transformed accordingly).
218
219   if ( e!=0 )
220   {
221      int ii,kk;
222      ideal k1,k2;
223      int l = size(lin);
224      ideal lin1 = jet(lin,1) - jet(lin,0);  // part of pure degree 1
225      lin = lin - lin1;                      // rest, part of degree 1 substracted
226
227      for( ii=1; ii<=l; ii++ )
228      {
229         if( lin1[ii] != 0 )
230         {
231            kk = kk+1;
232            k1[kk] = lin1[ii];    // part of pure degree 1, renumbered
233            k2[kk] = lin[ii];     // rest of those polys which had a degree 1 part
234            lin[ii] = 0;
235         }
236      }
237
238      if( kk != 0 )
239      {
240         if( ordstr(P) != "c,dp(n)" )
241         {
242            execute "ring newP = ("+charstr(P)+"),("+varstr(P)+"),(c,dp);";
243            ideal k1 = imap(P,k1);
244            ideal k2 = imap(P,k2);
245            ideal lin = imap(P,lin);
246            ideal eva = imap(P,eva);
247            ideal sub = imap(P,sub);
248            ideal neva = imap(P,neva);
249         }
250         ideal k12 = k1,k2;
251         matrix M = matrix(k12,2,kk);
252        // M = interred(M);
253         l = ncols(M);
254         k1 = M[1,1..l];
255         k2 = M[2,1..l];
256         ideal kin = matrix(k1)+matrix(k2);
257         lin = simplify(lin,2);
258
259         l = size(kin);
260         poly p; map phi; ideal max;
261         for ( ii=1; ii<=n; ii++  )
262         {
263            for (kk=1; kk<=l; kk++ )
264            {
265               p = kin[kk]/var(ii);
266               if ( deg(p) == 0 )
267               {
268                  eva = eva+var(ii);
269                  neva[ii] = 0;
270                  sub = sub+kin[kk]/p;
271                  max = maxideal(1);
272                  max[ii] = var(ii) - (kin[kk]/p);
273                  phi = basering,max;
274                  lin = phi(lin);
275                  kin = simplify(phi(kin),2);
276                  l = size(kin);
277                  ii=ii+1;
278                  break;
279               }
280            }
281         }
282         lin = kin+lin;
283      }
284   }
285   for( ii=1; ii<=size(lin); ii++ )
286   {
287      lin[ii] = cleardenom(lin[ii]);
288   }
289   if( defined(newP) )
290   {
291      setring P;
292      lin = imap(newP,lin);
293      eva = imap(newP,eva);
294      sub = imap(newP,sub);
295      neva = imap(newP,neva);
296   }
297   for( ii=1; ii<=n; ii++ )
298   {
299      for( kk=1; kk<=size(eva); kk++ )
300      {
301         if (phi[ii] == eva[kk] )
302         {  phi[ii] = eva[kk]-sub[kk]; break; }
303      }
304   }
305   L = lin, eva, sub, neva, phi;
306  return(L);
307}
308example
309{ "EXAMPLE:"; echo = 2;
310   ring s=0,(x,y,z,t,u,v,w,a,b,c,d,f,e),(c,ds);
311   ideal i = w2+f2-1, x2+t2+a2-1,  y2+u2+b2-1, z2+v2+c2-1,
312             d2+e2-1, f4+2u, wa+tf, xy+tu+ab, yz+uv+bc,
313             cd+ze, x+y+z+e+1, t+u+v+f-1, w+a+b+c+d;
314   elimpart(i,4);
315}
316
317///////////////////////////////////////////////////////////////////////////////
318
319proc elimpartanyr (ideal i, list #)
320"USAGE:   elimpartanyr(i[,p,e]);  i=ideal, p=product of vars to be eliminated,
321         e=int (default: p=product of all vars, e=1)
322RETURN:  list of of 6 objects:
323         [1]: (interreduced) ideal obtained by substituting from i those vars
324              appearing in p which occur in the linear part of i [or which can
325              be expressed directly in the remaining variables, if e!=0]
326         [2]: ideal, variables which have been substituted
327         [3]: ideal, i-th element defines substitution of i-th var in [2]
328         [4]: ideal of variables of basering, substituted ones are set to 0
329         [5]: ideal, describing the map from the basering, say k[x(1..m)], to
330              itself onto k[..variables fom [4]..] and [1] is the image of i
331         [6]: int, # of vars considered for substitution (= # of factors of p)
332
333         The ideal i is generated by [1] and [3] in k[x(1..m)], the map [5]
334         maps [3] to 0, hence induceds an isomorhism
335                   k[x(1..m)]/i -> k[..variables fom [4]..]/[1]
336NOTE:    the proc uses 'execute' to create a ring with ordering dp and vars
337         placed correctly and then applies 'elimpart';
338EXAMPLE: example elimpartanyr; shows an example
339"
340{
341   def P = basering;
342   int j,n,e = 0,0,1;
343   poly p = product(maxideal(1));
344   if ( size(#)==1 ) { p=#[1]; }
345   if ( size(#)==2 ) { p=#[1]; e=#[2]; }
346   string a,b;
347   for ( j=1; j<=nvars(P); j++ )
348   {
349      if (deg(p/var(j))>=0) { a = a+varstr(j)+","; n = n+1; }
350      else { b = b+varstr(j)+","; }
351   }
352   if ( size(b) != 0 ) { b = b[1,size(b)-1]; }
353   else { a = a[1,size(a)-1]; }
354   execute "ring gnir ="+charstr(P)+",("+a+b+"),dp;";
355   ideal i = imap(P,i);
356   list L = elimpart(i,n,e)+list(n);
357   setring P;
358   list L = imap(gnir,L);
359   return(L);
360}
361example
362{ "EXAMPLE:"; echo = 2;
363   ring s=0,(e,f,x,y,z,t,u,v,w,a,b,c,d),dp;
364   ideal i = w2+f2-1, x2+t2+a2-1,  y2+u2+b2-1, z2+v2+c2-1,
365             d2+e2-1, f4+2u, wa+tf, xy+tu+ab, yz+uv+bc,
366             cd+ze, x+y+z+e+1, t+u+v+f-1, w+a+b+c+d;
367   show(elimpartanyr(i,xyztuvwabc));"";
368   elimpartanyr(i,xyztuvwabc);
369}
370///////////////////////////////////////////////////////////////////////////////
371
372proc fastelim (ideal i, poly p, list #)
373"USAGE:   fastelim(i,p[h,o,a,b,e,m]); i=ideal, p=product of variables to be
374         eliminated; h,o,a,b,e integers
375         (options for Hilbert-std, 'valvars', elimpart, minimizing)
376         - h !=0: use Hilbert-series driven std-basis computation
377         - o !=0: use proc 'valvars' for a - hopefully - best ordering of vars
378         - a !=0: order vars to be eliminated w.r.t. increasing complexity
379         - b !=0: order vars not to be eliminated w.r.t. increasing complexity
380         - e !=0: use elimpart first to eliminate easy part
381         - m !=0: compute a minimal system of generators
382         replacing '!=' by '=' has the opposite meaning
383         default: h,o,a,b,e,m = 0,1,0,0,0,0
384RETURN:  ideal obtained from i by eliminating those variables which occur in p
385EXAMPLE: example fastelim; shows an example.
386"
387{
388   def P = basering;
389   int h,o,a,b,e,m = 0,1,0,0,0,0;
390   if ( size(#) == 1 ) { h=#[1]; }
391   if ( size(#) == 2 ) { h=#[1]; o=#[2]; }
392   if ( size(#) == 3 ) { h=#[1]; o=#[2]; a=#[3]; }
393   if ( size(#) == 4 ) { h=#[1]; o=#[2]; a=#[3]; b=#[4];}
394   if ( size(#) == 5 ) { h=#[1]; o=#[2]; a=#[3]; b=#[4]; e=#[5]; }
395   if ( size(#) == 6 ) { h=#[1]; o=#[2]; a=#[3]; b=#[4]; e=#[5]; m=#[6]; }
396   list L = elimpartanyr(i,p,e);
397   poly q = product(L[2]);     //product of vars which are already eliminated
398   if ( q==0 ) { q=1; }
399   p = p/q;                    //product of vars which must still be eliminated
400   int nu = L[5]-size(L[2]);   //number of vars which must still be eliminated
401   if ( p==1 )                 //ready if no vars are left
402   {                           //compute minbase if 3-rd argument !=0
403      if ( m != 0 ) { L[1]=minbase(L[1]); }
404      return(L);
405   }
406//---------------- create new ring with remaining variables -------------------
407   string newvar = string(L[4]);
408   L = L[1],p;
409   execute "ring r1=("+charstr(P)+"),("+newvar+"),"+"dp;";
410   list L = imap(P,L);
411//------------------- find "best" ordering of variables  ----------------------
412   newvar = string(maxideal(1));
413   if ( o != 0 )
414   {
415      list ordevar = valvars(L[1],a,L[2],b);
416      intvec v = ordevar[1];
417      newvar=string(sort(maxideal(1),v)[1]);
418//------------ create new ring with "best" ordering of variables --------------
419      changevar("r0",newvar);
420      list L = imap(r1,L);
421      kill r1;
422      def r1 = r0;
423      kill r0;
424   }
425//----------------- h==0: eliminate remaining vars directly -------------------
426   if ( h == 0 )
427   {
428      L[1] = eliminate(L[1],L[2]);
429      def r2 = r1;
430   }
431   else
432//------- h!=0: homogenize and compute Hilbert-series using hilbvec ----------
433   {
434      intvec hi = hilbvec(L[1]);         // Hilbert-series of i
435      execute "ring r2=("+charstr(P)+"),("+varstr(basering)+",@homo),dp;";
436      list L = imap(r1,L);
437      L[1] = homog(L[1],@homo);          // @homo = homogenizing var
438//---- use Hilbert-series to eliminate variables with Hilbert-driven std -----
439      L[1] = eliminate(L[1],L[2],hi);
440      L[1]=subst(L[1],@homo,1);          // dehomogenize by setting @homo=1
441   }
442   if ( m != 0 )                         // compute minbase
443   {
444      if ( #[1] != 0 ) { L[1] = minbase(L[1]); }
445   }
446   def id = L[1];
447   setring P;
448   return(imap(r2,id));
449}
450example
451{ "EXAMPLE:"; echo = 2;
452   ring s=31991,(e,f,x,y,z,t,u,v,w,a,b,c,d),dp;
453   ideal i = w2+f2-1, x2+t2+a2-1,  y2+u2+b2-1, z2+v2+c2-1,
454            d2+e2-1, f4+2u, wa+tf, xy+tu+ab;
455   fastelim(i,xytua);           //with valvars only
456   fastelim(i,xytua,1,1);       //with hilb,valvars,minbase
457   fastelim(i,xytua,1,0);       //with hilb,minbase
458}
459///////////////////////////////////////////////////////////////////////////////
460
461proc faststd (@id,string @s1,string @s2, list #)
462"USAGE:   faststd(id,s1,s2[,\"hilb\",\"sort\",\"dec\",o,\"blocks\"]);
463         id=ideal/module, s1,s2=strings (names for new ring and maped id)
464         o = string (allowed ordstring:\"lp\",\"dp\",\"Dp\",\"ls\",\"ds\",\"Ds\")
465         \"hilb\",\"sort\",\"dec\",\"block\" options for Hilbert-std, sortandmap
466COMPUTE: create a new ring (with \"best\" ordering of vars) and compute a
467         std-basis of id (hopefully faster)
468         - If say, s1=\"R\" and s2=\"j\", the new basering has name R and the
469           std-basis of the image of id in R has name j
470         - \"hilb\"  : use Hilbert-series driven std-basis computation
471         - \"sort\"  : use 'sortandmap' for a best ordering of vars
472         - \"dec\"   : order vars w.r.t. decreasing complexity (with \"sort\")
473         - \"block\" : create blockordering, each block having ordstr=o, s.t.
474                     vars of same complexity are in one block (with \"sort\")
475         - o       : defines the basic ordering of the resulting ring
476         default: o = ordering of 1-st block of basering - if it is allowed,
477                      else o=\"dp\",
478                  \"sort\", if none of the optional parameters is given
479RETURN:  nothing
480NOTE:    This proc is only useful for hard problems where other methods fail.
481         \"hilb\" is useful for hard orderings (as \"lp\") or for characteristic 0,
482         it is correct for \"lp\",\"dp\",\"Dp\" (and for blockorderings combining
483         these) but not for s-orderings or if the vars have different weights.
484         There seem to be only few cases in which \"dec\" is fast
485EXAMPLE: example faststd; shows an example.
486"
487{
488   def @P = basering;
489   int @h,@s,@n,@m,@ii = 0,0,0,0,0;
490   string @o,@va,@c = ordstr(basering),"","";
491//-------------------- prepare ordering and set options -----------------------
492   if ( @o[1]=="c" or @o[1]=="C")
493      {  @o = @o[3,2]; }
494   else
495      { @o = @o[1,2]; }
496   if( @o[1]!="d" and @o[1]!="D" and @o[1]!="l")
497      { @o="dp"; }
498
499   if (size(#) == 0 )
500      { @s = 1; }
501   for ( @ii=1; @ii<=size(#); @ii++ )
502   {
503      if ( typeof(#[@ii]) != "string" )
504      {
505         "// wrong syntax! type: help faststd";
506         return();
507      }
508      else
509      {
510         if ( #[@ii] == "hilb"  ) { @h = 1; }
511         if ( #[@ii] == "dec"   ) { @n = 1; }
512         if ( #[@ii] == "block" ) { @m = 1; }
513         if ( #[@ii] == "sort"  ) { @s = 1; }
514         if ( #[@ii]=="lp" or #[@ii]=="dp" or #[@ii]=="Dp" or #[@ii]=="ls"
515              or #[@ii]=="ds" or #[@ii]=="Ds" ) { @o = #[@ii]; }
516      }
517   }
518   if( voice==2 ) { "// choosen options, hilb sort dec block:",@h,@s,@n,@m; }
519
520//-------------------- nosort: create ring with new name ----------------------
521   if ( @s==0 )
522   {
523      execute "ring "+@s1+"=("+charstr(@P)+"),("+varstr(@P)+"),("+@o+");";
524      def @id = imap(@P,@id);
525      verbose(noredefine);
526      def @P = basering;
527      verbose(redefine);
528      kill `@s1`;
529      if ( @h==0 ) { @id = std(@id); }
530   }
531//--------- sort: create new ring with "best" ordering of variables -----------
532 proc bestorder(@id,string @s1,string @s2,int @n,string @o,int @m,int @l)
533  {
534     intvec getoption = option(get);
535     option(redSB);
536     @id = interred(sort(@id)[1]);
537     poly @p = product(maxideal(1),1..@l);
538     def i,s1,s2,n,p,o,m = @id,@s1,@s2,@n,@p,@o,@m;
539     sortandmap(i,s1,s2,n,p,0,o,m);
540     option(set,getoption);
541     keepring(basering);
542  }
543//---------------------- no hilb: compute SB directly -------------------------
544   if ( @s != 0 and @h == 0 )
545   {
546      bestorder(@id,@s1,@s2,@n,@o,@m,nvars(@P));
547      verbose(noredefine);
548      def @P = basering;
549      verbose(redefine);
550      kill `@s1`;
551      def @id = `@s2`;
552      @id = std(@id);
553   }
554//------- hilb: homogenize and compute Hilbert-series using hilbvec -----------
555// this uses another standardbasis computation
556   if ( @h != 0 )
557   {
558      execute "ring @Q=("+charstr(@P)+"),("+varstr(@P)+",@homo),("+@o+");";
559      def @id = imap(@P,@id);
560      kill @P;
561      @id = homog(@id,@homo);               // @homo = homogenizing var
562      if ( @s != 0 )
563      {
564         bestorder(@id,@s1,@s2,@n,@o,@m,nvars(@Q)-1);
565         verbose(noredefine);
566         def @Q= basering;
567         kill `@s1`;
568         def @id = `@s2`;
569         verbose(redefine);
570      }
571      intvec @hi;                     // encoding of Hilbert-series of i
572      @hi = hilbvec(@id);
573      //if ( @s!=0 ) { @hi = hilbvec(@id,"32003",ordstr(@Q)); }
574      //else { @hi = hilbvec(@id); }
575//-------------------------- use Hilbert-driven std --------------------------
576      @id = std(@id,@hi);
577      @id = subst(@id,@homo,1);             // dehomogenize by setting @homo=1
578      @va = varstr(@Q)[1,size(varstr(@Q))-6];
579      if ( @s!=0 )
580      {
581         @o = ordstr(@Q);
582         if ( @o[1]=="c" or @o[1]=="C") { @o = @o[1,size(@o)-6]; }
583         else { @o = @o[1,size(@o)-8] + @o[size(@o)-1,2]; }
584      }
585      execute "ring @P=("+charstr(@Q)+"),("+@va+"),("+@o+");";
586      def @id = imap(@Q,@id);
587   }
588   def `@s1` = @P;
589   def `@s2` = @id;
590   attrib(`@s2`,"isSB",1);
591   export(`@s2`);
592   kill @P;
593   keepring(basering);
594   if( voice==2 ) { "// basering is now "+@s1+", std-basis has name "+@s2; }
595   return();
596}
597example
598{ "EXAMPLE:"; echo = 2;
599   ring s = 0,(e,f,x,y,z,t,u,v,w,a,b,c,d),(c,lp);
600   ideal i = w2+f2-1, x2+t2+a2-1,  y2+u2+b2-1, z2+v2+c2-1,
601            d2+e2-1, f4+2u, wa+tf, xy+tu+ab;
602  option(prot); timer=1;
603   int time = timer;
604   ideal j=std(i);
605   timer-time;
606   show(R);dim(j),mult(j);
607   int time = timer;
608   faststd(i,"R","i");                      // use "best" ordering of vars
609   timer-time;
610   show(R);dim(i),mult(i);
611   setring s;time = timer;
612   faststd(i,"R","i","hilb");                // hilb-std only
613   timer-time;
614   show(R);dim(i),mult(i);
615   setring s;time = timer;
616   faststd(i,"R","i","hilb","sort");         // hilb-std,"best" ordering
617   timer-time;
618   show(R);dim(i),mult(i);
619    setring s;time = timer;
620   faststd(i,"R","i","hilb","sort","block","dec"); // hilb-std,"best",blocks
621   timer-time;
622   show(R);dim(i),mult(i);
623  setring s;time = timer;
624   timer-time;time = timer;
625   faststd(i,"R","i","sort","block","Dp"); //"best",decreasing,Dp-blocks
626   timer-time;
627   show(R);dim(i),mult(i);
628}
629///////////////////////////////////////////////////////////////////////////////
630
631proc findvars(id, list #)
632"USAGE:   findvars(id[,any]); id poly/ideal/vector/module/matrix, any=any type
633RETURN:  ideal of variables occuring in id, if no second argument is present
634         list of 4 objects, if a second argument is given (of any type)
635         -[1]: ideal of variables occuring in id
636         -[2]: intvec of variables occuring in id
637         -[3]: ideal of variables not occuring in id
638         -[4]: intvec of variables not occuring in id
639EXAMPLE: example findvars; shows an example
640"
641{
642   int ii,n;
643   ideal found, notfound;
644   intvec f,nf;
645   n = nvars(basering);
646   ideal i = simplify(ideal(matrix(id)),10);
647   matrix M[ncols(i)][1] = i;
648   vector v = module(M)[1];
649   ideal max = maxideal(1);
650
651   for (ii=1; ii<=n; ii++)
652   {
653      if ( v != subst(v,var(ii),0) )
654      {
655         found = found+var(ii);
656         f = f,ii;
657      }
658      else
659      {
660         notfound = notfound+var(ii);
661         nf = nf,ii;
662      }
663   }
664   if ( size(f)>1 ) { f = f[2..size(f)]; }      //intvec of found vars
665   if ( size(nf)>1 ) { nf = nf[2..size(nf)]; }  //intvec of vars not found
666   if( size(#)==0 )  { return(found); }
667   if( size(#)!=0 )  { list L = found,f,notfound,nf; return(L); }
668}
669example
670{ "EXAMPLE:"; echo = 2;
671   ring s  = 0,(e,f,x,y,t,u,v,w,a,d),dp;
672   ideal i = w2+f2-1, x2+t2+a2-1;
673   findvars(i);
674   findvars(i,1);
675}
676///////////////////////////////////////////////////////////////////////////////
677
678proc hilbvec (@id, list #)
679"USAGE:   hilbvec(id[,c,o]); id poly/ideal/vector/module/matrix, c,o=strings
680         c=char, o=ord in which hilb is computed (default: c=\"32003\", o=\"dp\")
681RETURN:  intvec of 1-st Hilbert-series of id, computed in char c and ordering o
682         bei ** aendern falls ringmaps vollstaendig ?
683NOTE:    id must be homogeneous (all vars having weight 1)
684EXAMPLE: example hilbvec; shows an example
685"
686{
687   def @P = basering;
688   string @c,@o = "32003", "dp";
689   if ( size(#) == 1 ) {  @c = #[1]; }
690   if ( size(#) == 2 ) {  @c = #[1]; @o = #[2]; }
691   string @si = typeof(@id)+" @i = "+string(@id)+";";  //** weg
692   execute "ring @r=("+@c+"),("+varstr(basering)+"),("+@o+");";
693   //**def i = imap(P,@id);
694   execute @si;                   //** weg
695   //show(basering);
696   @i = std(@i);
697   intvec @hi = hilb(@i,1);         // intvec of 1-st Hilbert-series of id
698   return(@hi);
699}
700example
701{ "EXAMPLE:"; echo = 2;
702   ring s   = 0,(e,f,x,y,z,t,u,v,w,a,b,c,d,H),dp;
703   ideal id = w2+f2-1, x2+t2+a2-1,  y2+u2+b2-1, z2+v2+c2-1,
704              d2+e2-1, f4+2u, wa+tf, xy+tu+ab;
705   id = homog(id,H);
706   hilbvec(id);
707}
708///////////////////////////////////////////////////////////////////////////////
709
710proc linearpart (id)
711"USAGE:   linearpart(id);  id=ideal/module
712RETURN:  generators of id of total degree <= 1
713EXAMPLE: example linearpart; shows an example
714"
715{
716   return(degreepart(id,0,1));
717}
718example
719{ "EXAMPLE:"; echo = 2;
720   ring r=0,(x,y,z),dp;
721   ideal i=1+x+x2+x3,3,x+3y+5z;
722   linearpart(i);
723   module m=[x,y,z],x*[x3,y2,z],[1,x2,z3,0,1];
724   show(linearpart(m));
725}
726///////////////////////////////////////////////////////////////////////////////
727
728proc tolessvars (id ,list #)
729"USAGE:   tolessvars(id,[s1,s2]); id poly/ideal/vector/module/matrix,
730         s1,s2=strings (names of: new ring, new ordering)
731CREATE:  nothing, if id contains all vars of the basering. Else, create
732         a ring with same char as the basering, but with less variables
733         (only those variables which actually occur in id) and map id to the
734         new ring, which will be the basering after the proc has finished.
735         The name of the new ring is by default R(n), where n is the number of
736         variables in the new ring. If, say, s1 = \"newR\" then the new ring has
737         name newR. In s2 a different ordering for the new ring may be given
738         as an allowed ordstring (default is \"dp\" resp. \"ds\", depending whether
739         the first block of the old ordering is a p- resp. an s-ordering).
740DISPLAY: If printlevel >=0, display ideal of vars which have been ommitted from
741         the old ring (default)
742RETURN:  the original ideal id
743NOTE:    You must not type, say, 'ideal id=tolessvars(id);' since the ring
744         to which 'id' would belong will only be defined by the r.h.s.. But you
745         may type 'def id=tolessvars(id);' or 'list id=tolessvars(id);'
746         since then 'id' does not a priory belong to a ring, its type will
747         be defined by the right hand side. Moreover, do not use a name which
748         occurs in the old ring, for the same reason.
749EXAMPLE: example tolessvars; shows an example
750"
751{
752//---------------- initialisation and check occurence of vars -----------------
753   int s,ii,n,fp,fs;
754   string s1,s2,newvar;
755   int pr = printlevel-voice+3;  // p = printlevel+1 (default: p=1)
756   def P = basering;
757   s2 = ordstr(P);
758
759   list L = findvars(id,1);
760   newvar = string(L[1]);    // string of new variables
761   n = size(L[1]);           // number of new variables
762   if( n == 0 )
763   {
764      dbprint( pr,"","// no variable occured in "+typeof(id)+", no change of ring!");
765      return(id);
766   }
767   if( n == nvars(P) )
768   {
769      dbprint( pr,"","// all variables occured in "+typeof(id)+", no change of ring!");
770      return(id);
771   }
772//----------------- prepare new ring, map to it and return --------------------
773   s1 = "R("+string(n)+")";
774   if ( size(#) == 0 )
775   {
776       fp = find(s2,"p");
777       fs = find(s2,"s");
778       if( fs==0 or (fs>=fp && fp!=0) ) { s2="dp"; }
779       else {  s2="ds"; }
780   }
781   if ( size(#) ==1 ) { s1=#[1]; }
782   if ( size(#) ==2 ) { s1=#[1]; s2=#[2]; }
783   //dbprint( pr,"","// variables which did not occur:",simplify(max,2) );
784   dbprint( pr,"","// variables which did not occur:",L[3] );
785
786   execute "ring "+s1+"=("+charstr(P)+"),("+newvar+"),("+s2+");";
787   def id = imap(P,id);
788   export(basering);
789   keepring (basering);
790   dbprint( pr,"// basering is now "+s1 );
791   return(id);
792}
793example
794{ "EXAMPLE:"; echo = 2;
795   ring r  = 0,(x,y,z),dp;
796   ideal i = y2-x3,x-3,y-2x;
797   def j   = tolessvars(i);
798   show(basering);
799   j;
800   setring r;
801   list j = tolessvars(i,"R_r","lp");
802   R_r;
803   kill R_r, R(2);
804}
805///////////////////////////////////////////////////////////////////////////////
806
807proc solvelinearpart (id,list #)
808"USAGE:   solvelinearpart(id[,n]);  id=ideal/module, n=integer
809RETURN:  (interreduced) generators of id of degree <=1 in reduced triangular
810         form  (default) or if n=0 [non-reduced triangular form if n!=0]
811ASSUME:  monomial ordering is a global ordering (p-ordering)
812NOTE:    may be used to solve a system of linear equations
813         see proc 'gauss_row' from 'matrix.lib' for a different method
814WARNING: the result is very likely to be false for 'real' coefficients, use
815         char 0 instead!
816EXAMPLE: example solvelinearpart; shows an example
817"
818{
819   intvec getoption = option(get);
820   option(redSB);
821   if ( size(#)!=0 )
822   {
823      if(#[1]!=0) { option(noredSB); }
824   }
825   def lin = interred(degreepart(id,0,1));
826   if ( size(#)!=0 )
827   {
828      if(#[1]!=0)
829      {
830         return(lin);
831      }
832   }
833   option(set,getoption);
834   return(simplify(lin,1));
835}
836example
837{ "EXAMPLE:"; echo = 2;
838   // Solve the system of linear equations:
839   //         3x +   y +  z -  u = 2
840   //         3x +  8y + 6z - 7u = 1
841   //        14x + 10y + 6z - 7u = 0
842   //         7x +  4y + 3z - 3u = 3
843   ring r = 0,(x,y,z,u),lp;
844   ideal i= 3x +   y +  z -  u,
845           13x +  8y + 6z - 7u,
846           14x + 10y + 6z - 7u,
847            7x +  4y + 3z - 3u;
848   ideal j= 2,1,0,3;
849   j = i-j;                        // difference of 1x4 matrices
850                                   // compute reduced triangular form, setting
851   solvelinearpart(j);             // the RHS equal 0 gives the solutions!
852   solvelinearpart(j,1); "";       // triangular form, not reduced
853   // Solve the same system simultaneously for two RHS's: 2,1,0,3 and 1,2,3,4
854   matrix b[2][size(i)]=2,1,0,3,1,2,3,4;
855   module m = i*[1,1]-b;
856   show(solvelinearpart(m));"";
857   // Solve the same system but with parametric values for the RHS:
858   ring r1 = (0,a,b,c,d),(x,y,z,u),dp;
859   ideal i = 3x +   y +  z -  u - a,
860            13x +  8y + 6z - 7u - b,
861            14x + 10y + 6z - 7u - c,
862             7x +  4y + 3z - 3u - d;
863   solvelinearpart(i);
864}
865///////////////////////////////////////////////////////////////////////////////
866
867proc sortandmap (@id,string @s1,string @s2, list #)
868"USAGE:   sortandmap(id,s1,s2[,n1,p1,n2,p2...,o1,m1,o2,m2...]);
869         id=poly/ideal/vector/module
870         s1,s2=strings (names for new ring and maped id)
871         p1,p2,...= product of vars, n1,n2,...=integers
872         o1,o2,...= allowed ordstrings, m1,m2,...=integers
873         (default: p1=product of all vars, n1=0, o1=\"dp\",m1=0)
874         the last pi (containing the remaining vars) may be omitted
875CREATE:  a new ring and map id into it, the new ring has same char as basering
876         but with new ordering and vars sorted in the following manner:
877         - each block of vars occuring in pi is sorted w.r.t its complexity in
878           id, ni controls the sorting in i-th block (= vars occuring in pi):
879           ni=0 (resp.!=0) means that less (resp. more) complex vars come first
880         - If say, s1=\"R\" and s2=\"j\", the new basering has name R and the image
881           of id in R has name j
882         - oi and mi define the monomial ordering of the i-th block:
883           if mi =0, oi=ordstr(i-th block)
884           if mi!=0, the ordering of the i-th block itself is a blockordering,
885           each subblock having ordstr=oi, such that vars of same complexity
886           are in one block
887           default: oi=\"dp\", mi=0
888         - only simple ordstrings oi are allowed:\"lp\",\"dp\",\"Dp\",\"ls\",\"ds\",\"Ds\"
889RETURN:  nothing
890NOTE:    We define a variable x to be more complex than y (with respect to id)
891         if val(x) > val(y) lexicographically, where val(x) denotes the
892         valuation vector of x: consider id as list of polynomials in x with
893         coefficients in the remaining variables. Then val(x) =
894         (maximal occuring power of x, # of monomials in leading coefficient,
895          # of monomials in coefficient of next smaller power of x,...)
896EXAMPLE: example sortandmap; shows an example
897"
898{
899   def @P = basering;
900   int @ii,@jj;
901   intvec @v;
902   string @o;
903//----------------- find o in # and split # into 2 lists ---------------------
904   # = # +list("dp",0);
905   for ( @ii=1; @ii<=size(#); @ii++)
906   {
907      if ( typeof(#[@ii])=="string" )  break;
908   }
909   if ( @ii==1 ) { list @L1 = list(); }
910   else { list @L1 = #[1..@ii-1]; }
911   list @L2 = #[@ii..size(#)];
912   list @L = sortvars(@id,@L1);
913   string @va = string(@L[1]);
914   list @l = @L[2];   //e.g. @l[4]=intvec describing permutation of 1-st block
915//----------------- construct correct ordering with oi and mi ----------------
916   for ( @ii=4; @ii<=size(@l); @ii=@ii+4 )
917   {
918      @L2=@L2+list("dp",0);
919      if ( @L2[@ii/2] != 0)
920      {
921         @v = @l[@ii];
922         for ( @jj=1; @jj<=size(@v); @jj++ )
923         {
924           @o = @o+@L2[@ii/2 -1]+"("+string(@v[@jj])+"),";
925         }
926      }
927      else
928      {
929         @o = @o+@L2[@ii/2 -1]+"("+string(size(@l[@ii/2]))+"),";
930      }
931   }
932   @o=@o[1..size(@o)-1];
933//------------------ create new ring and make objects global -----------------
934   execute "ring "+@s1+"=("+charstr(@P)+"),("+@va+"),("+@o+");";
935   def @id = imap(@P,@id);
936   execute "def "+ @s2+"=@id;";
937   execute("export("+@s1+");");
938   execute("export("+@s2+");");
939   keepring(basering);
940   return();
941}
942example
943{ "EXAMPLE:"; echo = 2;
944   ring s = 32003,(e,f,x,y,z,t,u,v,w,a,b,c,d),dp;
945   ideal i = w2+f2-1, x2+t2+a2-1,  y2+u2+b2-1, z2+v2+c2-1,
946             d2+e2-1, f4+2u, wa+tf, xy+tu+ab, yz+uv+bc,
947             cd+ze, x+y+z+e+1, t+u+v+f-1, w+a+b+c+d;
948   sortandmap(i,"R_r","i");
949   // i is now an ideal in the new basering R_r
950   show(R_r);
951   kill R_r; setring s;
952   sortandmap(i,"R_r","i",1,"lp",0);
953   show(R_r);
954   kill R_r; setring s;
955   sortandmap(i,"R_r","i",1,abc,0,xyztuvw,0,"lp",0,"Dp",1);
956   show(R_r);
957   kill R_r;
958}
959///////////////////////////////////////////////////////////////////////////////
960
961proc sortvars (id, list #)
962"USAGE:   sortvars(id[,n1,p1,n2,p2,...]); id=poly/ideal/vector/module,
963         p1,p2,...= product of vars, n1,n2,...=integers
964         (default: p1=product of all vars, n1=0)
965         the last pi (containing the remaining vars) may be omitted
966COMPUTE: sort variables with respect to their complexity in id
967RETURN:  list of two elements, an ideal and a list:
968         [1]: ideal, variables of basering sorted w.r.t their complexity in id
969            ni controls the ordering in i-th block (= vars occuring in pi):
970            ni=0 (resp.!=0) means that less (resp. more) complex vars come
971            first
972         [2]: a list with 4 elements for each pi:
973            ideal ai : vars of pi in correct order,
974            intvec vi: permutation vector describing the ordering in ai,
975            intmat Mi: valuation matrix of ai, the columns of Mi being the
976                       valuation vectors of the vars in ai
977            intvec wi: 1-st,2-nd,...entry = size of 1-st,2-nd,... block of
978                       identically columns of Mi (vars with same valuation)
979NOTE:    We define a variable x to be more complex than y (w.r.t. id)
980         if val(x) > val(y) lexicographically, where val(x) denotes the
981         valuation vector of x: consider id as list of polynomials in x with
982         coefficients in the remaining variables. Then val(x) =
983         (maximal occuring power of x, # of monomials in leading coefficient,
984          # of monomials in coefficient of next smaller power of x,...)
985EXAMPLE: example sortvars; shows an example
986"
987{
988   int ii,jj,n,s;
989   list L = valvars(id,#);
990   list L2, L3 = L[2], L[3];
991   list K; intmat M; intvec v1,v2,w;
992   ideal i = sort(maxideal(1),L[1])[1];
993   for ( ii=1; ii<=size(L2); ii++ )
994   {
995      M = transpose(L3[2*ii]);
996      M = M[L2[ii],1..nrows(L3[2*ii])];
997      w = 0; s = 0;
998      for ( jj=1; jj<=nrows(M)-1; jj++ )
999      {
1000         v1 = M[jj,1..ncols(M)];
1001         v2 = M[jj+1,1..ncols(M)];
1002         if ( v1 != v2 ) { n=jj-s; s=s+n; w = w,n; }
1003      }
1004      w=w,nrows(M)-s; w=w[2..size(w)];
1005      K = K+sort(L3[2*ii-1],L2[ii])+list(transpose(M))+list(w);
1006   }
1007   L = i,K;
1008   return(L);
1009}
1010example
1011{ "EXAMPLE:"; echo = 2;
1012   ring r=0,(a,b,c,x,y,z),lp;
1013   poly f=a3+b4+xyz2+xyz+yz+1;
1014   show(sortvars( f,1,abc,1)[1]);"";
1015   ring s=31991,(e,f,x,y,z,t,u,v,w,a,b,c,d),dp;
1016   ideal i = w2+f2-1, x2+t2+a2-1,  y2+u2+b2-1, z2+v2+c2-1,
1017             d2+e2-1, f4+2u, wa+tf, xy+tu+ab, yz+uv+bc,
1018             cd+ze, x+y+z+e+1, t+u+v+f-1, w+a+b+c+d;
1019   show(sortvars(i,1,uybcazt,0,fewdvx));
1020}
1021///////////////////////////////////////////////////////////////////////////////
1022
1023proc valvars (id, list #)
1024"USAGE:   valvars(id[,n1,p1,n2,p2,...]); id=poly/ideal/vector/module,
1025         p1,p2,...= product of vars, n1,n2,...=integers
1026         ni controls the ordering of vars occuring in pi:
1027         ni=0 (resp.!=0) means that less (resp. more) complex vars come first
1028         (default: p1=product of all vars, n1=0)
1029         the last pi (containing the remaining vars) may be omitted
1030COMPUTE: valuation (complexity) of variables with respect to id
1031RETURN:  list consisting of 3 objects:
1032         [1]: intvec, say v, describing the permutation such that the permuted
1033            ringvariables are ordered with respect to their complexity in id
1034         [2]: list of intvecs, i-th intvec, say v(i) describing prmutation
1035              of vars in a(i) such that v=v(1),v(2),...
1036         [3]: list of ideals and intmat's, say a(i) and M(i), where ideal a(i)
1037            = factors of pi, M(i) = valuation matrix of a(i), such that the
1038            j-th column of M(i) is the valuation vector of j-th generator of a(i)
1039NOTE:    Use proc 'sortvars' for the actual sorting of vars!
1040         We define a variable x to be more complex than y (with respect to id)
1041         if val(x) > val(y) lexicographically, where val(x) denotes the
1042         valuation vector of x: consider id as list of polynomials in x with
1043         coefficients in the remaining variables. Then val(x) =
1044         (maximal occuring power of x, # of monomials in leading coefficient,
1045          # of monomials in coefficient of next smaller power of x,...)
1046EXAMPLE: example valvars; shows an example
1047"
1048{
1049//---------------------------- initialization ---------------------------------
1050   int ii,jj,kk,n;
1051   list L;                    // list of valuation vectors in one block
1052   intvec vec;                // describes permutation of vars (in one block)
1053   list blockvec;             // i-th element = vec of i-th block
1054   intvec varvec;             // result intvector
1055   list Li;                   // result list of ideals
1056   list LM;                   // result list of intmat's
1057   intvec v,w,s;              // w valuation vector for one variable
1058   matrix C;                  // coefficient matrix for different variables
1059   ideal i = simplify(ideal(matrix(id)),10);
1060
1061//---- for each pii in # create ideal a(ii) intvec v(ii) and list L(ii) -------
1062// a(ii) = ideal of vars in product, v(ii)[j]=k <=> a(ii)[j]=var(k)
1063
1064   v = 1..nvars(basering);
1065   int l = size(#);
1066   if ( l >= 2 )
1067   {
1068      ideal m=maxideal(1);
1069      for ( ii=2; ii<=l; ii=ii+2 )
1070      {
1071         int n(ii) = #[ii-1];
1072         ideal a(ii);
1073         intvec v(ii);
1074         for ( jj=1; jj<=nvars(basering); jj++ )
1075         {
1076            if ( #[ii]/var(jj) != 0)
1077            {
1078               a(ii) = a(ii) + var(jj);
1079               v(ii)=v(ii),jj;
1080               m[jj]=0;
1081               v[jj]=0;
1082            }
1083         }
1084         v(ii)=v(ii)[2..size(v(ii))];
1085      }
1086      if ( size(m)!=0 )
1087      {
1088         l = 2*(l/2)+2;
1089         ideal a(l) = simplify(m,2);
1090         intvec v(l) = compress(v);
1091         int n(l);
1092         if ( size(#)==l-1 ) { n(l) = #[l-1]; }
1093      }
1094   }
1095   else
1096   {
1097      l = 2;
1098      ideal a(2) = maxideal(1);
1099      intvec v(2) = v;
1100      int n(2);
1101      if ( size(#)==1 ) { n(2) = #[1]; }
1102   }
1103//------------- start loop to order variables in each a(ii) -------------------
1104
1105   for ( kk=2; kk<=l; kk=kk+2 )
1106   {
1107      L = list();
1108      n = 0;
1109//---------------- get valuation of all variables in a(kk) --------------------
1110      for ( ii=1; ii<=size(a(kk)); ii++ )
1111      {
1112         C = coeffs(i,a(kk)[ii]);
1113         w = nrows(C);
1114         for ( jj=w[1]; jj>1; jj-- )
1115         {
1116            s = size(C[jj,1..ncols(C)]);
1117            w[w[1]-jj+2] = sum(s);
1118         }
1119         L[ii]=w;
1120         n = size(w)*(size(w) > n) + n*(size(w) <= n);
1121      }
1122      intmat M(kk)[size(a(kk))][n];
1123      for ( ii=1; ii<=size(a(kk)); ii++ )
1124      {
1125         if ( n==1 ) { w = L[ii]; M(kk)[ii,1] = w[1]; }
1126         else  { M(kk)[ii,1..n] = L[ii]; }
1127      }
1128      LM[kk-1] = a(kk);
1129      LM[kk] = transpose(compress(M(kk)));
1130//------------------- compare valuation and insert in vec ---------------------
1131      vec = sort(L)[2];
1132      if ( n(kk) != 0 ) { vec = vec[size(vec)..1]; }
1133      blockvec[kk/2] = vec;
1134      vec = sort(v(kk),vec)[1];
1135      varvec = varvec,vec;
1136   }
1137   varvec = varvec[2..size(varvec)];
1138   list result = varvec,blockvec,LM;
1139   return(result);
1140}
1141example
1142{ "EXAMPLE:"; echo = 2;
1143   ring r=0,(a,b,c,x,y,z),lp;
1144   poly f=a3+b4+xyz2+xyz+yz+1;
1145   show(valvars(f,1,abc)[1]);"";
1146   ring s=31991,(e,f,x,y,z,t,u,v,w,a,b,c,d),dp;
1147   ideal i = w2+f2-1, x2+t2+a2-1,  y2+u2+b2-1, z2+v2+c2-1,
1148             d2+e2-1, f4+2u, wa+tf, xy+tu+ab, yz+uv+bc,
1149             cd+ze, x+y+z+e+1, t+u+v+f-1, w+a+b+c+d;
1150   list v6=valvars(i,1,uybcazt,0,efwdvx);
1151   show(v6);
1152}
1153///////////////////////////////////////////////////////////////////////////////
1154/*
1155
1156 ring s=31991,(e,f,x,y,z,t,u,v,w,a,b,c,d),dp;
1157 ring s=31991,(x,y,z,t,u,v,w,a,b,c,d,f,e,h),dp; //standard
1158 ring s1=31991,(y,u,b,c,a,z,t,x,v,d,w,e,f,h),dp; //gut
1159v;
116013,12,11,10,8,7,6,5,4,3,2,1,9,14
1161print(matrix(sort(maxideal(1),v)));
1162f,e,w,d,x,t,z,a,c,b,u,y,v,h
1163print(matrix(maxideal(1)));
1164y,u,b,c,a,z,t,x,v,d,w,e,f,h
1165v0;
116614,9,12,11,10,8,7,6,5,4,3,2,1,13
1167print(matrix(sort(maxideal(1),v0)));
1168h,v,e,w,d,x,t,z,a,c,b,u,y,f
1169v1;v2;
11709,12,11,10,8,7,6,5,4,3,2,1,13,14
117113,12,11,10,8,7,6,5,4,3,2,1,9,14
1172
1173Ev. Gute Ordnung fuer i:
1174========================
1175i=ad*x^d+ad-1*x^(d-1)+...+a1*x+a0, ad!=0
1176mit ar=(ar1,...,ark), k=size(i)
1177    arj in K[..x^..]
1178d=deg_x(i) := max{deg_x(i[k]) | k=1..size(i)}
1179size_x(i,deg_x(i)..0) := size(ad),...,size(a0)
1180x>y  <==
1181  1. deg_x(i)>deg_y(i)
1182  2. "=" in 1. und size_x lexikographisch
1183
1184hier im Beispiel:
1185f: 5,1,0,1,2
1186
1187u: 3,1,4
1188
1189y: 3,1,3
1190b: 3,1,3
1191c: 3,1,3
1192a: 3,1,3
1193z: 3,1,3
1194t: 3,1,3
1195
1196x: 3,1,2
1197v: 3,1,2
1198d: 3,1,2
1199w: 3,1,2
1200e: 3,1,2
1201probier mal:
1202 ring s=31991,(f,u,y,z,t,a,b,c,v,w,d,e,h),dp; //standard
1203
1204*/
Note: See TracBrowser for help on using the repository browser.