| 1 | // |
|---|
| 2 | version="$Id: fastsolv.lib,v 1.3 1998-05-05 11:55:24 krueger Exp $"; |
|---|
| 3 | info=""; |
|---|
| 4 | |
|---|
| 5 | // ==================================================================== |
|---|
| 6 | // library fast.lib |
|---|
| 7 | // |
|---|
| 8 | // ==================================================================== |
|---|
| 9 | |
|---|
| 10 | proc Tsimplify |
|---|
| 11 | "USAGE: simplify(id,n); id ideal, n integer |
|---|
| 12 | RETURNS: list of two ideals the first containing the simplified |
|---|
| 13 | elements, the second the variables which already have |
|---|
| 14 | been eliminated |
|---|
| 15 | ASSUME: basering has ordering dp, the elimination of the variables |
|---|
| 16 | n+1,... is not supported |
|---|
| 17 | EXAMPLE: example simplify; shows an example |
|---|
| 18 | " |
|---|
| 19 | { |
|---|
| 20 | def bsr=basering; |
|---|
| 21 | int @n, @m, @k; |
|---|
| 22 | option (redSB); |
|---|
| 23 | ideal @i = interred(#[1]); |
|---|
| 24 | ideal @j, @im, @va; |
|---|
| 25 | for (@n=1;@n<=size(@i);@n=@n+1) |
|---|
| 26 | { |
|---|
| 27 | if (deg(@i[@n])==1) |
|---|
| 28 | { |
|---|
| 29 | @k=0; |
|---|
| 30 | for (@m=#[2]+1;@m<=nvars(basering);@m=@m+1) |
|---|
| 31 | { |
|---|
| 32 | if (lead(@i[@n])/var(@m)!=0) |
|---|
| 33 | { |
|---|
| 34 | @k=1; |
|---|
| 35 | break; |
|---|
| 36 | } |
|---|
| 37 | } |
|---|
| 38 | if (@k==0) |
|---|
| 39 | { |
|---|
| 40 | @va=@va+lead(@i[@n]); |
|---|
| 41 | @i[@n]=0; |
|---|
| 42 | } |
|---|
| 43 | } |
|---|
| 44 | } |
|---|
| 45 | @i=@i+@j; |
|---|
| 46 | map @phi; |
|---|
| 47 | for (@m=1;@m<=#[2];@m=@m+1) |
|---|
| 48 | { |
|---|
| 49 | for (@n=size(@i);@n>=1;@n=@n-1) |
|---|
| 50 | { |
|---|
| 51 | if (deg(@i[@n]/var(@m))==0) |
|---|
| 52 | { |
|---|
| 53 | @im = maxideal(1); |
|---|
| 54 | @im[@m]=(-1/coeffs(@i[@n],var(@m))[2,1])*(@i[@n]-coeffs(@i[@n],var(@m))[2,1]*var(@m)); |
|---|
| 55 | @phi = basering,@im; |
|---|
| 56 | @i=@phi(@i); |
|---|
| 57 | @i=@i+@j; |
|---|
| 58 | @va=@va+var(@m); |
|---|
| 59 | break;// hier muesste evt. sorgfaeltiger ausgewaehlt werden |
|---|
| 60 | } |
|---|
| 61 | } |
|---|
| 62 | } |
|---|
| 63 | @i=interred(@i); |
|---|
| 64 | option(noredSB); |
|---|
| 65 | return(@i,@va); |
|---|
| 66 | } |
|---|
| 67 | example |
|---|
| 68 | { |
|---|
| 69 | ring s=181,(x,y,z,t,u,v,w,a,b,c,d,f,e),dp; |
|---|
| 70 | ideal j= |
|---|
| 71 | w2+f2-1, |
|---|
| 72 | x2+t2+a2-1, |
|---|
| 73 | y2+u2+b2-1, |
|---|
| 74 | z2+v2+c2-1, |
|---|
| 75 | d2+e2-1, |
|---|
| 76 | f4+2u, |
|---|
| 77 | wa+tf, |
|---|
| 78 | xy+tu+ab, |
|---|
| 79 | yz+uv+bc, |
|---|
| 80 | cd+ze, |
|---|
| 81 | x+y+z+e+1, |
|---|
| 82 | t+u+v+f-1, |
|---|
| 83 | w+a+b+c+d; |
|---|
| 84 | list l=Tsimplify(j,10); |
|---|
| 85 | l; |
|---|
| 86 | } |
|---|
| 87 | |
|---|
| 88 | |
|---|
| 89 | proc simplifyInBadRings |
|---|
| 90 | "USAGE: simplify(id,n); id ideal, n product of the variables |
|---|
| 91 | to be eliminated later |
|---|
| 92 | RETURNS: list of two ideals the first containing the simplified |
|---|
| 93 | elements, the second the variables which already have |
|---|
| 94 | been eliminated |
|---|
| 95 | EXAMPLE: example simplify; shows an example |
|---|
| 96 | " |
|---|
| 97 | { |
|---|
| 98 | int @i,@j; |
|---|
| 99 | string @es=",("; |
|---|
| 100 | string @ns="),dp;"; |
|---|
| 101 | for (@i=1;@i<=nvars(basering);@i=@i+1) |
|---|
| 102 | { |
|---|
| 103 | if (deg(#[2]/var(@i))>=0) |
|---|
| 104 | { |
|---|
| 105 | @es=@es+varstr(@i)+","; |
|---|
| 106 | @j=@j+1; |
|---|
| 107 | } |
|---|
| 108 | else |
|---|
| 109 | { |
|---|
| 110 | @ns=","+varstr(@i)+@ns; |
|---|
| 111 | } |
|---|
| 112 | } |
|---|
| 113 | string @s=@es[1,size(@es)-1]+@ns; |
|---|
| 114 | @ns=nameof(basering); |
|---|
| 115 | ideal i=#[1]; |
|---|
| 116 | execute "ring @gnir ="+charstr(basering)+@s; |
|---|
| 117 | ideal @laedi=imap(`@ns`,i); |
|---|
| 118 | list @l=Tsimplify(@laedi,@j); |
|---|
| 119 | ideal @l1, @l2=@l[1], @l[2]; |
|---|
| 120 | execute "setring "+@ns+";"; |
|---|
| 121 | return(imap(@gnir,@l1),imap(@gnir,@l2)); |
|---|
| 122 | } |
|---|
| 123 | example |
|---|
| 124 | { |
|---|
| 125 | ring s=0,(e,f,x,y,z,t,u,v,w,a,b,c,d),dp; |
|---|
| 126 | ideal j= |
|---|
| 127 | w2+f2-1, |
|---|
| 128 | x2+t2+a2-1, |
|---|
| 129 | y2+u2+b2-1, |
|---|
| 130 | z2+v2+c2-1, |
|---|
| 131 | d2+e2-1, |
|---|
| 132 | f4+2u, |
|---|
| 133 | wa+tf, |
|---|
| 134 | xy+tu+ab, |
|---|
| 135 | yz+uv+bc, |
|---|
| 136 | cd+ze, |
|---|
| 137 | x+y+z+e+1, |
|---|
| 138 | t+u+v+f-1, |
|---|
| 139 | w+a+b+c+d; |
|---|
| 140 | list l=simplifyInBadRings(j,xyztuvwabc); |
|---|
| 141 | l; |
|---|
| 142 | } |
|---|
| 143 | |
|---|
| 144 | |
|---|
| 145 | proc fastElim |
|---|
| 146 | "USAGE: fastelim(id,v); id ideal, v Product of variables to |
|---|
| 147 | be eliminated. |
|---|
| 148 | RETURNS: list of two ideals the first containing the simplified |
|---|
| 149 | elements, the second the variables which already have |
|---|
| 150 | been eliminated |
|---|
| 151 | EXAMPLE: example fastElim; shows an example. |
|---|
| 152 | "{ |
|---|
| 153 | string @oldgnir = nameof(basering); // Namen des alten Baserings merken |
|---|
| 154 | string @varnames; |
|---|
| 155 | int @i; |
|---|
| 156 | poly @testpoly=1; // Variablen, die schon eliminiert sind (nach Simplify) |
|---|
| 157 | poly @elimvarspoly=#[2]; // Variablen, die noch eliminiert werden sollen |
|---|
| 158 | |
|---|
| 159 | // das Ideal vereinfachen. Beachte: l[1] erzeugt nicht mehr id! |
|---|
| 160 | list @l=simplifyInBadRings(#[1],#[2]); |
|---|
| 161 | ideal @a, @b = @l[1], @l[2]; |
|---|
| 162 | |
|---|
| 163 | // ------------------------------------------------------------ |
|---|
| 164 | // in einen Ring abbilden, der die in (2) angegebenen Variablen |
|---|
| 165 | // nicht mehr enthaelt. |
|---|
| 166 | // ------------------------------------------------------------ |
|---|
| 167 | |
|---|
| 168 | |
|---|
| 169 | // Aus dem von simplifyInBadRings zurueckgegebenen Ideal(2), das die |
|---|
| 170 | // Variablen anthealt, die eliminiert sind, ein Polynom bauen: |
|---|
| 171 | for (@i=1; @i<=size(@b); @i=@i+1) |
|---|
| 172 | { |
|---|
| 173 | @testpoly=@testpoly*@b[@i]; |
|---|
| 174 | @elimvarspoly = subst(@elimvarspoly, @b[@i], 1); |
|---|
| 175 | } |
|---|
| 176 | |
|---|
| 177 | //Wenn keine Variablen mehr uebrig sind, sind wir fertig: |
|---|
| 178 | if (@elimvarspoly==1) |
|---|
| 179 | { |
|---|
| 180 | // Falls das 4. Argument 1 ist, eine minimale Basis berechnen |
|---|
| 181 | if (#[4]==1) |
|---|
| 182 | { |
|---|
| 183 | mres(@a,1,@a0); |
|---|
| 184 | @a=@a0(1); |
|---|
| 185 | } |
|---|
| 186 | return(@a); |
|---|
| 187 | } |
|---|
| 188 | |
|---|
| 189 | // Anhand dieses Polynoms ueberpruefen, welche Variablen unser |
|---|
| 190 | // neuer Ring braucht: @varnames |
|---|
| 191 | for (@i=1; @i<=nvars(basering); @i=@i+1) |
|---|
| 192 | { |
|---|
| 193 | if (@testpoly/var(@i)==0) |
|---|
| 194 | { |
|---|
| 195 | @varnames=@varnames + nameof(var(@i)) + ","; |
|---|
| 196 | } |
|---|
| 197 | } |
|---|
| 198 | @varnames=@varnames[1, size(@varnames)-1]; |
|---|
| 199 | |
|---|
| 200 | // Den neuen Ring erzeugen und das Ideal a darin abbilden: |
|---|
| 201 | execute("ring @r1=" + charstr(basering) + ",(" + @varnames + ")," + "dp;" ); |
|---|
| 202 | ideal @a=imap(`@oldgnir`, @a); |
|---|
| 203 | list #=imap(`@oldgnir`,#); |
|---|
| 204 | |
|---|
| 205 | // Nun die beste Reihenfolge fuer die Variablen berechnen: |
|---|
| 206 | string @orderedvars=string(maxideal(1)); |
|---|
| 207 | if (#[3]==1) |
|---|
| 208 | { |
|---|
| 209 | poly @elimvarspoly=imap(`@oldgnir`,@elimvarspoly); |
|---|
| 210 | intvec @v= valvars(@a,#[5], @elimvarspoly,#[6]); |
|---|
| 211 | @v; |
|---|
| 212 | @orderedvars=string(sort1(maxideal(1),@v)); |
|---|
| 213 | } |
|---|
| 214 | |
|---|
| 215 | // In einen Ring wechseln, der diese Reihenfolge beruecksichtig: |
|---|
| 216 | execute("ring @r2=" + charstr(basering) + ",(" + @orderedvars + ",@homo),dp;" ); |
|---|
| 217 | ideal @a= imap(@r1, @a); |
|---|
| 218 | kill @r1; |
|---|
| 219 | |
|---|
| 220 | //das ideal homogenisieren |
|---|
| 221 | @a=homog(@a,@homo); |
|---|
| 222 | |
|---|
| 223 | // Die Variablen holen, die wirklich noch zu eliminieren sind, und |
|---|
| 224 | // danach eliminate aufrufen. |
|---|
| 225 | poly @elimvarspoly= imap(`@oldgnir`, @elimvarspoly); |
|---|
| 226 | ideal @b=eliminate(@a, @elimvarspoly); |
|---|
| 227 | |
|---|
| 228 | // Falls das 4. Argument 1 ist, eine minimale Basis berechnen |
|---|
| 229 | if (#[4]==1) |
|---|
| 230 | { |
|---|
| 231 | mres(@b,1,@b0); |
|---|
| 232 | @b=@b0(1); |
|---|
| 233 | } |
|---|
| 234 | |
|---|
| 235 | // dehomogenisieren (@homo=1) und zurueck in den alten Ring |
|---|
| 236 | @b=subst(@b,@homo,1); |
|---|
| 237 | execute "setring "+@oldgnir+";"; |
|---|
| 238 | return(imap(@r2,@b)); |
|---|
| 239 | } |
|---|
| 240 | example |
|---|
| 241 | { |
|---|
| 242 | ring s=31991,(e,f,x,y,z,t,u,v,w,a,b,c,d),dp; |
|---|
| 243 | ideal j= |
|---|
| 244 | w2+f2-1, |
|---|
| 245 | x2+t2+a2-1, |
|---|
| 246 | y2+u2+b2-1, |
|---|
| 247 | z2+v2+c2-1, |
|---|
| 248 | d2+e2-1, |
|---|
| 249 | f4+2u, |
|---|
| 250 | wa+tf, |
|---|
| 251 | xy+tu+ab, |
|---|
| 252 | yz+uv+bc, |
|---|
| 253 | cd+ze, |
|---|
| 254 | x+y+z+e+1, |
|---|
| 255 | t+u+v+f-1, |
|---|
| 256 | w+a+b+c+d; |
|---|
| 257 | fastElim(j,xyztuvwabcd,1,0,0,0); |
|---|
| 258 | } |
|---|
| 259 | |
|---|
| 260 | |
|---|
| 261 | proc sort1 |
|---|
| 262 | { |
|---|
| 263 | intvec @i=#[2]; |
|---|
| 264 | int @ii=size(@i); |
|---|
| 265 | int @j; |
|---|
| 266 | string @s=string(typeof(#[1]))+" @m;"; |
|---|
| 267 | execute(@s); |
|---|
| 268 | for (@j=1;@j<=@ii;@j=@j+1) |
|---|
| 269 | { |
|---|
| 270 | @m[@j] = #[1][@i[@j]]; |
|---|
| 271 | } |
|---|
| 272 | return(@m); |
|---|
| 273 | } |
|---|
| 274 | |
|---|
| 275 | |
|---|
| 276 | proc valvars |
|---|
| 277 | " |
|---|
| 278 | USAGE: valvars(id, [n1, [m, [n2]]]); id (poly|ideal|vector|module); |
|---|
| 279 | m monom; n1,n2 int |
|---|
| 280 | RETURNS: an intvec describing the permutation such that the permuted |
|---|
| 281 | ringvariables are ordered with respect to inreasing complexity |
|---|
| 282 | [resp. decreasing complexity if n1 is present and non-zero]. |
|---|
| 283 | If m is present, the variables occuring in m are sorted in one |
|---|
| 284 | block before all variables not occuring in m. n2 controls the |
|---|
| 285 | order of this block as n1 does for the other one. |
|---|
| 286 | A variable x is more complex than y (with respect to id) if, in the |
|---|
| 287 | input, either the maximal occuring power of x is bigger than that |
|---|
| 288 | of y or both are equal and the coefficient of x to this power |
|---|
| 289 | contains more monomials than that of y. |
|---|
| 290 | EXAMPLE: example valvars; shows an example |
|---|
| 291 | " |
|---|
| 292 | { |
|---|
| 293 | int @order1, @order2, // order of vars not to elim resp. to elim |
|---|
| 294 | @i1, // runs through all variables |
|---|
| 295 | @i2, // # of vars to elim already found |
|---|
| 296 | @N, @M, // N = total # of vars, M = # of vars to elim |
|---|
| 297 | @i, @j, @k, @size, @degree; |
|---|
| 298 | intvec @varvec, @degvec, @sizevec; |
|---|
| 299 | poly @m; |
|---|
| 300 | ideal @id; |
|---|
| 301 | matrix @C; |
|---|
| 302 | |
|---|
| 303 | @id = matrix( #[1] ); @m = 0; |
|---|
| 304 | @N = nvars( basering ); @M = 0; |
|---|
| 305 | @order1 = 1; @order2 = 1; |
|---|
| 306 | if ( size(#) >= 4 ) |
|---|
| 307 | { @order2 = not( #[4] ) * 2 - 1; } |
|---|
| 308 | if ( size(#) >= 3 ) |
|---|
| 309 | { @m = #[3]; @M = deg( #[3] ); } |
|---|
| 310 | if ( size(#) >= 2 ) |
|---|
| 311 | { @order1 = not( #[2] ) * 2 - 1; } |
|---|
| 312 | |
|---|
| 313 | @i2 = 0; |
|---|
| 314 | for ( @i1 = 1; @i1 <= @N; @i1++ ) |
|---|
| 315 | { |
|---|
| 316 | // get valuation of current variable. |
|---|
| 317 | @C = coeffs( @id, var( @i1 )); |
|---|
| 318 | @degree = nrows( @C ); |
|---|
| 319 | @size = 0; |
|---|
| 320 | for ( @j = ncols( @C ); @j >= 1; @j-- ) |
|---|
| 321 | { @size = @size + size( @C[ @degree, @j ] ); } |
|---|
| 322 | |
|---|
| 323 | // mind order and calculate limits for search |
|---|
| 324 | if ( @M and size( @m / var( @i1 ))) |
|---|
| 325 | { |
|---|
| 326 | @degree = @degree * @order2; @size = @size * @order2; |
|---|
| 327 | @i2++; |
|---|
| 328 | @i = @i2; @j = 1; |
|---|
| 329 | } |
|---|
| 330 | else |
|---|
| 331 | { |
|---|
| 332 | @degree = @degree * @order1; @size = @size * @order1; |
|---|
| 333 | @i = @i1 - @i2 + @M; @j = @M+1; |
|---|
| 334 | } |
|---|
| 335 | |
|---|
| 336 | // look where we have to insert the variable |
|---|
| 337 | // "start = " + string( @j ) + ", end = " + string( @i ); |
|---|
| 338 | @degvec[ @i ] = @degree + 1; @sizevec[ @i ] = @size + 1; |
|---|
| 339 | while ( @degvec[ @j ] < @degree ) |
|---|
| 340 | { @j++; } |
|---|
| 341 | while ( @degvec[ @j ] == @degree and @sizevec[ @j ] < @size ) |
|---|
| 342 | { @j++; } |
|---|
| 343 | |
|---|
| 344 | // now shift the variables behind the current one back |
|---|
| 345 | // "inserting at " + string( @j ); |
|---|
| 346 | for ( @k = @i-1; @k >= @j; @k-- ) |
|---|
| 347 | { |
|---|
| 348 | @varvec[ @k+1 ] = @varvec[ @k ]; |
|---|
| 349 | @degvec[ @k+1 ] = @degvec[ @k ]; |
|---|
| 350 | @sizevec[ @k+1 ] = @sizevec[ @k ]; |
|---|
| 351 | } |
|---|
| 352 | @varvec[ @j ] = @i1; // print( @varvec ); |
|---|
| 353 | @degvec[ @j ] = @degree; // print( @degvec ); |
|---|
| 354 | @sizevec[ @j ] = @size; // print( @sizevec ); |
|---|
| 355 | } |
|---|
| 356 | |
|---|
| 357 | return( @varvec ); |
|---|
| 358 | } |
|---|
| 359 | example |
|---|
| 360 | { |
|---|
| 361 | echo = 1; ring @r=0,(a,b,c,x,y,z),lp; |
|---|
| 362 | poly @f=a3+b4+xyz2+xyz+yz+1; |
|---|
| 363 | valvars( @f ); |
|---|
| 364 | valvars( @f, 1 ); |
|---|
| 365 | valvars( @f, 0, abc ); |
|---|
| 366 | valvars( @f, 0, xyz ); |
|---|
| 367 | valvars( @f, 0, abc, 1 ); |
|---|
| 368 | valvars( @f, 1, abc, 1 ); |
|---|
| 369 | ideal @i=@f,z5,y5,-y5; |
|---|
| 370 | valvars( @i ); |
|---|
| 371 | valvars( @i, 0, abcxyz ); |
|---|
| 372 | kill @r; echo = 0; |
|---|
| 373 | } |
|---|
