source: git/Singular/LIB/presolve.lib @ f34c37c

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