source: git/Singular/LIB/presolve.lib @ 6d37e8

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