[28c487] | 1 | // last modified: 10.06.2010 |
---|
[fab82ab] | 2 | ////////////////////////////////////////////////////////////////////////////// |
---|
[ff283f7] | 3 | version = "$Id$"; |
---|
[fab82ab] | 4 | category = "Commutative algebra"; |
---|
| 5 | info = " |
---|
[28c487] | 6 | LIBRARY: monomialideal.lib Primary and irreducible decompositions of monomial |
---|
| 7 | ideals |
---|
| 8 | AUTHORS: I.Bermejo, ibermejo@ull.es |
---|
| 9 | @* E.Garcia-Llorente, evgarcia@ull.es |
---|
| 10 | @* Ph.Gimenez, pgimenez@agt.uva.es |
---|
[f9b430] | 11 | |
---|
[fab82ab] | 12 | OVERVIEW: |
---|
[28c487] | 13 | A library for computing a primary and the irreducible decompositions of a |
---|
| 14 | monomial ideal using several methods. |
---|
| 15 | In this library we also take advantage of the fact that the ideal is |
---|
| 16 | monomial to make some computations that are Grobner free in this case |
---|
| 17 | (radical, intersection, quotient...). |
---|
[a0b5e2] | 18 | |
---|
[fab82ab] | 19 | PROCEDURES: |
---|
[28c487] | 20 | isMonomial(id); checks whether an ideal id is monomial |
---|
| 21 | minbaseMon(id); computes the minimal monomial generating set of a |
---|
| 22 | monomial ideal id |
---|
| 23 | gcdMon(f,g); computes the gcd of two monomials f, g |
---|
| 24 | lcmMon(f,g); computes the lcm of two monomials f, g |
---|
| 25 | membershipMon(f,id); checks whether a polynomial f belongs to a monomial |
---|
| 26 | ideal id |
---|
| 27 | intersectMon(id1,id2);intersection of monomial ideals id1 and id2 |
---|
| 28 | quotientMon(id1,id2); quotient ideal id1:id2 |
---|
| 29 | radicalMon(id); computes the radical of a monomial ideal id |
---|
| 30 | isprimeMon(id); checks whether a monomial ideal id is prime |
---|
| 31 | isprimaryMon(id); checks whether a monomial ideal id is primary |
---|
| 32 | isirreducibleMon(id); checks whether a monomial ideal id is irreducible |
---|
| 33 | isartinianMon(id); checks whether a monomial ideal id is artininan |
---|
| 34 | isgenericMon(id); checks whether a monomial ideal id is generic |
---|
| 35 | dimMon(id); dimension of a monomial ideal id |
---|
| 36 | irreddecMon(id,..); computes the irreducible decomposition of a monomial |
---|
| 37 | ideal id |
---|
| 38 | primdecMon(id,..); computes a minimal primary decomposition of a monomial |
---|
| 39 | ideal id |
---|
[fab82ab] | 40 | "; |
---|
| 41 | LIB "poly.lib"; // Para "maxdeg1" en "isprimeMon" |
---|
[abbd22] | 42 | //--------------------------------------------------------------------------- |
---|
[fab82ab] | 43 | //----------------------- INTERNOS ------------------------------------- |
---|
[abbd22] | 44 | //--------------------------------------------------------------------------- |
---|
[fab82ab] | 45 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 46 | // |
---|
[fab82ab] | 47 | static proc checkIdeal (ideal I) |
---|
| 48 | " |
---|
| 49 | USAGE: checkIdeal (I); I ideal. |
---|
[28c487] | 50 | RETURN: 1, if ideal is generated by monomials; 0, otherwise. |
---|
[fab82ab] | 51 | " |
---|
| 52 | // Aqui NO estoy quitando el caso de que el ideal sea el trivial. |
---|
| 53 | { |
---|
| 54 | int i,n; |
---|
| 55 | n = ncols(I); |
---|
[abbd22] | 56 | for (i = n ; i >= 1 ; i --) |
---|
| 57 | { |
---|
| 58 | if ( size(I[i]) > 1 ) |
---|
[fab82ab] | 59 | { |
---|
[abbd22] | 60 | return (0); |
---|
[fab82ab] | 61 | } |
---|
[abbd22] | 62 | } |
---|
[fab82ab] | 63 | return (1); |
---|
| 64 | } |
---|
| 65 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 66 | // |
---|
| 67 | static proc quotientIdealMon (ideal I,poly f) |
---|
[fab82ab] | 68 | " |
---|
| 69 | USAGE: quotientIdealMon(I,f); I ideal, f polynomial. |
---|
| 70 | RETURN: an ideal, the quotient ideal I:(f). |
---|
[28c487] | 71 | ASSUME: I is an ideal generated by a list of monomials and f is a monomial |
---|
[fab82ab] | 72 | of the basering. |
---|
| 73 | " |
---|
| 74 | { |
---|
| 75 | // Variables |
---|
| 76 | int i,j; |
---|
| 77 | poly g,generator; |
---|
| 78 | intvec v; |
---|
| 79 | ideal J; |
---|
| 80 | J = 0; |
---|
| 81 | |
---|
[abbd22] | 82 | int sizI = ncols(I); |
---|
[fab82ab] | 83 | for (i = 1 ; i <= sizI ; i++) |
---|
[abbd22] | 84 | { |
---|
| 85 | g = gcd(I[i],f); |
---|
| 86 | // Cociente de dos monomios: restamos los exponentes, y en el |
---|
| 87 | // denominador va el mcd |
---|
| 88 | v = leadexp(I[i]) - leadexp(g); |
---|
| 89 | generator = monomial (v); |
---|
| 90 | if (membershipMon(generator,J) == 0) |
---|
[fab82ab] | 91 | { |
---|
[abbd22] | 92 | J=J,generator; |
---|
[fab82ab] | 93 | } |
---|
[abbd22] | 94 | } |
---|
[fab82ab] | 95 | // minimal monomial basis |
---|
| 96 | return ( minbase(J) ); |
---|
| 97 | } |
---|
| 98 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 99 | // |
---|
[fab82ab] | 100 | static proc soporte (poly f) |
---|
| 101 | " |
---|
| 102 | USAGE: soporte(f); f polynomial. |
---|
| 103 | RETURN: 0, if the monomial f is product of more than one variable; |
---|
| 104 | otherwise, an integer j, 1<=j<=n, if the monomial f is a power of |
---|
| 105 | x(j). |
---|
| 106 | ASSUME: f is a monomial of the basering K[x(1)..x(n)]. |
---|
| 107 | " |
---|
| 108 | { |
---|
| 109 | // Variables |
---|
[abbd22] | 110 | int i,cont,sop; |
---|
[fab82ab] | 111 | intvec expf; |
---|
[abbd22] | 112 | int nvar = nvars(basering); |
---|
[fab82ab] | 113 | expf = leadexp(f); |
---|
| 114 | cont = 0; |
---|
| 115 | // cont va a contar el numero de componentes del vector no nulas. |
---|
| 116 | // En sop guardamos el subindice de la componente no nula. |
---|
[abbd22] | 117 | for (i = nvar ; i >= 1 ; i--) |
---|
| 118 | { |
---|
| 119 | if (expf[i] > 0) |
---|
[fab82ab] | 120 | { |
---|
[abbd22] | 121 | cont ++; |
---|
| 122 | sop = i; |
---|
| 123 | // Si cont > 1 ==> aparece mas de una variable, devolvemos 0 |
---|
| 124 | if (cont > 1) |
---|
| 125 | { |
---|
| 126 | return (0); |
---|
| 127 | } |
---|
[fab82ab] | 128 | } |
---|
[abbd22] | 129 | } |
---|
[fab82ab] | 130 | return(sop); |
---|
| 131 | } |
---|
| 132 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 133 | // |
---|
[fab82ab] | 134 | static proc irredAux (ideal I) |
---|
| 135 | " |
---|
| 136 | USAGE: irredAux (I); I ideal. |
---|
[28c487] | 137 | RETURN: 1, if I is irreducible; otherwise, an intvec whose fist entry is |
---|
[fab82ab] | 138 | the position of a generator which is the product of more than one |
---|
[28c487] | 139 | variable, the next entries are the indexes of those variables. |
---|
[fab82ab] | 140 | ASSUME: I is a monomial ideal of the basering K[x(1)..x(n)] and it is |
---|
| 141 | generated by its minimal monomial generators. |
---|
| 142 | NOTE: This procedure is a modification of isirreducibleMon to give |
---|
[28c487] | 143 | more information when ideal is not irreducible. |
---|
[fab82ab] | 144 | " |
---|
| 145 | { |
---|
| 146 | // Variables |
---|
| 147 | int sizI,i,nvar,j,sum; |
---|
| 148 | intvec w,exp; |
---|
[abbd22] | 149 | sizI = ncols(I); |
---|
| 150 | nvar = nvars(basering); |
---|
[fab82ab] | 151 | for (i = 1 ; i <= sizI ; i++) |
---|
[abbd22] | 152 | { |
---|
| 153 | sum = 0; |
---|
| 154 | exp = leadexp(I[i]); |
---|
| 155 | for (j = 1 ; j <= nvar ; j++) |
---|
[fab82ab] | 156 | { |
---|
[abbd22] | 157 | // Al menos tenemos una variable en cada generador, luego |
---|
| 158 | // entramos minimo 1 vez, luego sum >= 1. |
---|
| 159 | if (exp[j] <> 0) |
---|
| 160 | { |
---|
| 161 | sum++; |
---|
| 162 | w[sum] = j; |
---|
| 163 | } |
---|
| 164 | } |
---|
| 165 | // Si hay mas de una variable la suma sera mayor que 1; y ya |
---|
| 166 | // sabemos que I no es irreducible. |
---|
| 167 | if (sum <> 1) |
---|
| 168 | { |
---|
| 169 | return(i,w); |
---|
[fab82ab] | 170 | } |
---|
[abbd22] | 171 | } |
---|
[fab82ab] | 172 | return(1); |
---|
| 173 | } |
---|
[28c487] | 174 | ////////////////////////////////////////////////////////////////////// |
---|
| 175 | // |
---|
| 176 | static proc contents (ideal I,ideal J) |
---|
[fab82ab] | 177 | " |
---|
| 178 | USAGE: contents (I,J); I,J ideals. |
---|
| 179 | RETURN: 1, if I is contained in J; 0, otherwise. |
---|
[28c487] | 180 | ASSUME: I,J are monomial ideals of the basering. |
---|
[fab82ab] | 181 | " |
---|
| 182 | { |
---|
| 183 | // Variables |
---|
| 184 | poly f; |
---|
| 185 | int i,resp; |
---|
[abbd22] | 186 | int n = ncols(I); |
---|
[fab82ab] | 187 | // Desde que haya un generador que no pertenzca al ideal, ya no se da |
---|
| 188 | // el contenido y terminamos. |
---|
| 189 | for (i = 1 ; i <= n ; i++) |
---|
[abbd22] | 190 | { |
---|
| 191 | resp = membershipMon(I[i],J); |
---|
| 192 | if (resp == 0) |
---|
[fab82ab] | 193 | { |
---|
[abbd22] | 194 | return(0); |
---|
[fab82ab] | 195 | } |
---|
[abbd22] | 196 | } |
---|
[fab82ab] | 197 | return(1); |
---|
| 198 | } |
---|
| 199 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 200 | // |
---|
| 201 | static proc equal (ideal I,ideal J) |
---|
[fab82ab] | 202 | " |
---|
| 203 | USAGE: equal (I,J); I,J ideals. |
---|
| 204 | RETURN: 1, if I and J are the same ideal; 0, otherwise. |
---|
[28c487] | 205 | ASSUME: I,J are monomial ideals of the basering and are defined by their |
---|
[fab82ab] | 206 | minimal monomial generators. |
---|
| 207 | " |
---|
| 208 | { |
---|
| 209 | // Variables |
---|
| 210 | int n,i,j; |
---|
| 211 | intvec resps; |
---|
| 212 | // Si no tienen el mismo numero de generadores, no pueden ser iguales; ya |
---|
| 213 | // que vienen dados por el sistema minimal de generadores. |
---|
[28c487] | 214 | if (size(I) <> size(J)) |
---|
[abbd22] | 215 | { |
---|
| 216 | return(0); |
---|
| 217 | } |
---|
[fab82ab] | 218 | // Como ambos ideales vienen dados por la base minimal, no vamos a |
---|
| 219 | // tener problemas con que comparemos uno de I con otro de J, pues |
---|
| 220 | // no puede haber generadores iguales en el mismo ideal. |
---|
| 221 | // Si los ordenamos, se puede comparar uno a uno |
---|
[abbd22] | 222 | return(matrix( sort(I)[1])==matrix(sort(J)[1])); |
---|
| 223 | //n = size(I); |
---|
| 224 | //I = sort(I)[1]; |
---|
| 225 | //J = sort(J)[1]; |
---|
| 226 | //for (i = 1 ; i <= n ; i++) |
---|
| 227 | //{ |
---|
| 228 | // if (I[i] <> J[i]) |
---|
| 229 | // { |
---|
| 230 | // return(0); |
---|
| 231 | // } |
---|
| 232 | //} |
---|
| 233 | //return(1); |
---|
[fab82ab] | 234 | } |
---|
| 235 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 236 | // |
---|
[fab82ab] | 237 | static proc radicalAux (ideal I) |
---|
| 238 | " |
---|
| 239 | USAGE: radicalAux (I); I ideal. |
---|
| 240 | RETURN: an ideal, the radical ideal of I |
---|
| 241 | ASSUME: I is an irreducible monomial ideal of the basering given by its |
---|
| 242 | minimal monomial generators. |
---|
| 243 | " |
---|
| 244 | { |
---|
| 245 | // Cambiamos de anillo |
---|
[abbd22] | 246 | int nvar = nvars(basering); |
---|
[fab82ab] | 247 | // Variables |
---|
| 248 | int i,cont; |
---|
| 249 | intvec exp; |
---|
| 250 | ideal rad; |
---|
| 251 | // Como en cada generador aparece solo una variable, y ademas la |
---|
| 252 | // la misma variable no va a aparecer dos veces, es suficiente |
---|
| 253 | // con sumar los exponentes de todos los generadores para saber que |
---|
| 254 | // variables aparecen. |
---|
[abbd22] | 255 | int n = ncols(I); |
---|
[fab82ab] | 256 | for (i = 1 ; i <= n ; i++) |
---|
[abbd22] | 257 | { |
---|
| 258 | exp = exp + leadexp (I[i]); |
---|
| 259 | } |
---|
[fab82ab] | 260 | cont = 1; |
---|
| 261 | for (i = 1 ; i <= nvar ; i++) |
---|
[abbd22] | 262 | { |
---|
| 263 | if (exp[i] <> 0) |
---|
[fab82ab] | 264 | { |
---|
[abbd22] | 265 | rad[cont] = var(i); |
---|
| 266 | cont ++; |
---|
[fab82ab] | 267 | } |
---|
[abbd22] | 268 | } |
---|
[fab82ab] | 269 | return (rad); |
---|
| 270 | } |
---|
| 271 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 272 | // |
---|
[fab82ab] | 273 | static proc primAux (ideal I) |
---|
| 274 | " |
---|
| 275 | USAGE: primAux (I); I ideal. |
---|
| 276 | RETURN: 1, if I is primary; otherwise, an intvec, whose first element is |
---|
| 277 | 0, the second is the index of one variable such that a power of it |
---|
| 278 | does not appear as a generator of I, the rest of the elements are |
---|
[28c487] | 279 | the situation in the ideal of that elements of I which |
---|
| 280 | are product of more than one variable. |
---|
[fab82ab] | 281 | ASSUME: I is a monomial ideal of the basering K[x(1)..x(n)]. |
---|
[28c487] | 282 | NOTE: This procedure detects if the ideal is primary, when the |
---|
[fab82ab] | 283 | ideal is not primary, it gives some additional information. |
---|
| 284 | " |
---|
| 285 | { |
---|
| 286 | // Variables |
---|
| 287 | int control,nvar,i,sub_in,l,j; |
---|
| 288 | intvec v,w,exp_gen; |
---|
| 289 | // El ideal ya entra generado por el sistema minimal |
---|
[abbd22] | 290 | nvar = nvars(basering); |
---|
| 291 | int sizI = ncols(I); |
---|
[fab82ab] | 292 | v[nvar] = 0; |
---|
| 293 | int cont = 1; |
---|
| 294 | // v = 1 en la posicion en el ideal de variables sueltas, que son |
---|
| 295 | // las que no hay que tocar, 0 en las demas. w = posiciones de los |
---|
| 296 | // generadores de I que hay que comprobar. |
---|
| 297 | for (i = 1 ; i <= sizI ; i++ ) |
---|
[abbd22] | 298 | { |
---|
| 299 | sub_in = soporte(I[i]); |
---|
| 300 | if ( sub_in <> 0) |
---|
[fab82ab] | 301 | { |
---|
[abbd22] | 302 | v[sub_in] = 1; |
---|
| 303 | } |
---|
| 304 | else |
---|
| 305 | { |
---|
| 306 | w[cont] = i; |
---|
| 307 | cont ++; |
---|
[fab82ab] | 308 | } |
---|
[abbd22] | 309 | } |
---|
[fab82ab] | 310 | l = size(w); |
---|
| 311 | // No hay ningun generador que tenga productos de variables, luego |
---|
| 312 | // este ideal ya es primario. |
---|
| 313 | if (l == 1 && w[1] == 0) |
---|
[abbd22] | 314 | { |
---|
| 315 | return (1); |
---|
| 316 | } |
---|
[fab82ab] | 317 | for (i = 1 ; i <= l ; i++) |
---|
[abbd22] | 318 | { |
---|
| 319 | exp_gen = leadexp(I[w[i]]); |
---|
| 320 | // Ahora hay que ver que valor tiene el exponente de los |
---|
| 321 | // generadores oportunos en la posicion que es cero dentro del |
---|
| 322 | // vector v. |
---|
| 323 | for (j = 1 ; j <= nvar ; j++) |
---|
[fab82ab] | 324 | { |
---|
[abbd22] | 325 | if (v[j] == 0) |
---|
| 326 | { |
---|
| 327 | if (exp_gen[j] <> 0) |
---|
[fab82ab] | 328 | { |
---|
[abbd22] | 329 | return (0,j,w); |
---|
[fab82ab] | 330 | } |
---|
[abbd22] | 331 | } |
---|
[fab82ab] | 332 | } |
---|
[abbd22] | 333 | } |
---|
[fab82ab] | 334 | // Si hemos llegado hasta aqui hemos recorrido todo el ideal y por tanto |
---|
| 335 | // es primario. |
---|
| 336 | return (1); |
---|
| 337 | } |
---|
| 338 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 339 | // |
---|
| 340 | static proc maxExp (ideal I,intvec v) |
---|
[fab82ab] | 341 | " |
---|
| 342 | USAGE: maxExp (I,v); I ideal, v integer vector. |
---|
| 343 | RETURN: an integer, the greatest power of a variable in the minimal |
---|
| 344 | monomial set of generators of I. |
---|
| 345 | ASSUME: I is a monomial ideal of the basering, v=primAux(I) and the |
---|
| 346 | variable considered is v[2]. |
---|
| 347 | If the ideal I is primary, it returns 0. |
---|
[28c487] | 348 | NOTE: The elements of the vector shows what variable and what |
---|
[fab82ab] | 349 | generators we must consider to look for the greatest power |
---|
| 350 | of this variable. |
---|
| 351 | " |
---|
| 352 | { |
---|
| 353 | // Variables |
---|
| 354 | int n,i,max; |
---|
| 355 | intvec exp; |
---|
| 356 | // Ponemos el tama?o de v menos 2 porque en el vector v a partir de |
---|
| 357 | // la tercera componente es donde tenemos la posicion de los |
---|
| 358 | // generadores que tenemos que estudiar. |
---|
| 359 | n = size(v)-2; |
---|
| 360 | // Buscamos el maximo de la variable que no aparece "sola" en los |
---|
| 361 | // generadores del ideal (donde nos indica v). |
---|
| 362 | max = 0; |
---|
| 363 | for (i = 1 ; i <= n ; i++) |
---|
[abbd22] | 364 | { |
---|
| 365 | exp = leadexp (I[v[i+2]]); |
---|
| 366 | if (exp[v[2]] > max) |
---|
[fab82ab] | 367 | { |
---|
[abbd22] | 368 | max = exp[v[2]]; |
---|
[fab82ab] | 369 | } |
---|
[abbd22] | 370 | } |
---|
[fab82ab] | 371 | return (max); |
---|
| 372 | } |
---|
| 373 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 374 | // |
---|
[fab82ab] | 375 | static proc irredundant (list l) |
---|
| 376 | " |
---|
| 377 | USAGE: irredundant (l); l, list. |
---|
| 378 | RETURN: a list such that the intersection of the elements in that list has |
---|
| 379 | no redundant component. |
---|
[28c487] | 380 | ASSUME: elements of l are monomial ideals of the basering. |
---|
[fab82ab] | 381 | " |
---|
| 382 | { |
---|
| 383 | // Variables |
---|
| 384 | int i,j,resp; |
---|
| 385 | ideal J; |
---|
| 386 | // Recalculamos el tamano de l cuando modificamos la lista (sizl) |
---|
| 387 | int sizl = size(l); |
---|
| 388 | for (i = 1 ; i <= sizl ; i++) |
---|
[abbd22] | 389 | { |
---|
| 390 | J = 1; |
---|
| 391 | for (j = 1 ; j <= sizl ; j++) |
---|
[fab82ab] | 392 | { |
---|
[abbd22] | 393 | // Hacemos la interseccion de todos los ideales menos uno y |
---|
| 394 | // luego se estudia el contenido. |
---|
| 395 | if (j <> i) |
---|
| 396 | { |
---|
| 397 | J = intersect (J,l[j]); |
---|
| 398 | } |
---|
| 399 | } |
---|
| 400 | J = minbase(J); |
---|
| 401 | resp = contents(J,l[i]); |
---|
| 402 | if (resp == 1) |
---|
| 403 | { |
---|
| 404 | l = delete (l,i); |
---|
| 405 | i--; |
---|
| 406 | sizl = size(l); |
---|
[fab82ab] | 407 | } |
---|
[abbd22] | 408 | } |
---|
[fab82ab] | 409 | return (l); |
---|
| 410 | } |
---|
| 411 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 412 | // |
---|
| 413 | static proc alexDif (intvec v,ideal I) |
---|
[fab82ab] | 414 | " |
---|
| 415 | USAGE: alexDif (v,I); v, intvec; I, ideal. |
---|
| 416 | RETURN: a list, irreducible monomial ideals whose intersection is the |
---|
| 417 | Alexander dual of I with respect to v. |
---|
| 418 | ASSUME: I is a monomial ideal of the basering K[x(1),...,x(n)] given by |
---|
| 419 | its minimal monomial generators and v is an integer vector with |
---|
[28c487] | 420 | n entries s.t.monomial(v) is a multiple of all minimal monomial |
---|
[fab82ab] | 421 | generators of I. |
---|
| 422 | " |
---|
| 423 | { |
---|
| 424 | // Cambiamos de anillo |
---|
[abbd22] | 425 | int nvar = nvars(basering); |
---|
[fab82ab] | 426 | // Variables |
---|
| 427 | int i,j; |
---|
| 428 | intvec exp_I,exp; |
---|
| 429 | list l; |
---|
| 430 | ideal J; |
---|
[abbd22] | 431 | int sizI = ncols(I); |
---|
[fab82ab] | 432 | // Vamos a tener tantas componentes como generadores minimales tiene el |
---|
| 433 | // ideal, por eso el bucle es de 1 a size(I). |
---|
[abbd22] | 434 | for (i = 1 ; i <= sizI ; i++) |
---|
| 435 | { |
---|
| 436 | J = 0; |
---|
| 437 | exp_I = leadexp (I[i]); |
---|
| 438 | for (j = 1 ; j <= nvar ; j++) |
---|
| 439 | { |
---|
| 440 | if (exp_I[j] <> 0) |
---|
| 441 | { |
---|
| 442 | exp[j] = v[j] + 1 - exp_I[j]; |
---|
| 443 | J = J, var(j)^exp[j]; |
---|
| 444 | } |
---|
| 445 | } |
---|
| 446 | // Tenemos siempre un cero por la inicializacion de J, entonces |
---|
| 447 | // lo quitamos. |
---|
| 448 | J = simplify (J,2); |
---|
| 449 | l = insert (l,J); |
---|
| 450 | } |
---|
| 451 | return (l); |
---|
[fab82ab] | 452 | } |
---|
| 453 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 454 | // |
---|
[fab82ab] | 455 | static proc irredPrimary (list l1) |
---|
| 456 | " |
---|
| 457 | USAGE: irredPrimary (l1); l1, list of ideals. |
---|
| 458 | RETURN: a list, primary monomial ideals whose intersection is an |
---|
| 459 | irredundant primary decomposition. |
---|
| 460 | ASSUME: list l1 is the list of the irredundant irreducible components of a |
---|
| 461 | monomial ideal I of the basering. |
---|
| 462 | " |
---|
| 463 | { |
---|
| 464 | // Variables |
---|
| 465 | int i,sizl1,sizl2,j; |
---|
| 466 | ideal J,K; |
---|
| 467 | list l2,l3; |
---|
| 468 | //----- irredundant primary decomposition |
---|
| 469 | sizl1 = size(l1); |
---|
| 470 | for (i = 1 ; i <= sizl1 ; i++) |
---|
[abbd22] | 471 | { |
---|
| 472 | l2[i] = radicalAux (l1[i]); |
---|
| 473 | } |
---|
[fab82ab] | 474 | sizl2 = size(l2); |
---|
| 475 | int sizl2i, sizl2j; |
---|
| 476 | // Looking for irreducible components whose radicals are equal. |
---|
| 477 | // l1 = irreducible components list |
---|
| 478 | // l2 = radical of irreducible components list |
---|
| 479 | // l3 = primary components list |
---|
| 480 | for (i = 1 ; i <= sizl1 ; i++) |
---|
[abbd22] | 481 | { |
---|
| 482 | J = l2[i]; |
---|
| 483 | sizl2i = size(l2[i]); |
---|
| 484 | K = l1[i]; |
---|
| 485 | for (j = i+1 ; j <= sizl2 ; j++) |
---|
[fab82ab] | 486 | { |
---|
[abbd22] | 487 | sizl2j = size(l2[j]); |
---|
| 488 | if (sizl2i == sizl2j) |
---|
| 489 | { |
---|
| 490 | if (equal (J,l2[j]) == 1) |
---|
[fab82ab] | 491 | { |
---|
[abbd22] | 492 | K = minbase(intersect (K,l1[j])); |
---|
| 493 | l1 = delete (l1,j); |
---|
| 494 | sizl1 = size(l1); |
---|
| 495 | l2 = delete (l2,j); |
---|
| 496 | sizl2 = size(l2); |
---|
| 497 | j--; |
---|
[fab82ab] | 498 | } |
---|
[abbd22] | 499 | } |
---|
[fab82ab] | 500 | } |
---|
[abbd22] | 501 | l3 = insert (l3,K); |
---|
| 502 | } |
---|
[fab82ab] | 503 | return (l3); |
---|
| 504 | } |
---|
| 505 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 506 | // |
---|
[abbd22] | 507 | static proc isMinimal (ideal I) |
---|
[fab82ab] | 508 | " |
---|
| 509 | USAGE: isMinimal (I); I ideal. |
---|
[28c487] | 510 | RETURN: 1, if the generators of I are the minimal ones; |
---|
[fab82ab] | 511 | 0 & minimal generators of I, otherwise. |
---|
[28c487] | 512 | ASSUME: I is an ideal of the basering generated by monomials. |
---|
[fab82ab] | 513 | " |
---|
| 514 | { |
---|
| 515 | // VARIABLES |
---|
| 516 | int i; |
---|
| 517 | ideal J; |
---|
| 518 | // Quitamos los ceros del sistema de generadores. |
---|
| 519 | I = simplify(I,2); |
---|
| 520 | int resp = 1; |
---|
[abbd22] | 521 | int sizI = ncols(I); |
---|
[fab82ab] | 522 | // Cambiamos el tamano de I cuando eliminamos generadores |
---|
| 523 | for (i = 1 ; i <= sizI ; i++) |
---|
[abbd22] | 524 | { |
---|
| 525 | if (sizI <> 1) |
---|
[fab82ab] | 526 | { |
---|
[abbd22] | 527 | if (i == 1) |
---|
| 528 | { |
---|
| 529 | J = I[2..sizI]; |
---|
| 530 | } |
---|
| 531 | else |
---|
| 532 | { |
---|
| 533 | if (i > 1 && i < sizI) |
---|
[fab82ab] | 534 | { |
---|
[abbd22] | 535 | J = I[1..i-1], I[i+1..sizI]; |
---|
| 536 | } |
---|
| 537 | else |
---|
| 538 | { |
---|
| 539 | J = I[1..sizI-1]; |
---|
[fab82ab] | 540 | } |
---|
[abbd22] | 541 | } |
---|
| 542 | // Si quitamos el generador del lugar "i", luego el que |
---|
| 543 | // ocupa ahora el lugar "i" es el "i+1", de ahi que restemos |
---|
| 544 | // 1 al i para volver al for de manera que recorramos los |
---|
| 545 | // generadores como debemos. |
---|
| 546 | if (membershipMon(I[i],J) == 1) |
---|
| 547 | { |
---|
| 548 | resp = 0; |
---|
| 549 | I = J; |
---|
| 550 | i--; |
---|
[28c487] | 551 | sizI = size(I); |
---|
[abbd22] | 552 | } |
---|
[fab82ab] | 553 | } |
---|
[abbd22] | 554 | } |
---|
[fab82ab] | 555 | if (resp == 1) |
---|
[abbd22] | 556 | { |
---|
| 557 | return (1); |
---|
| 558 | } |
---|
[fab82ab] | 559 | else |
---|
[abbd22] | 560 | { |
---|
| 561 | return (0,I); |
---|
| 562 | } |
---|
[fab82ab] | 563 | } |
---|
| 564 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 565 | // |
---|
[abbd22] | 566 | static proc isMonomialGB (ideal I) |
---|
[fab82ab] | 567 | " |
---|
| 568 | USAGE: isMonomialGB (I); I ideal. |
---|
| 569 | RETURN: a list, 1 & the minimal generators of I, if I is a monomial ideal; |
---|
| 570 | 0, otherwise. |
---|
[28c487] | 571 | ASSUME: I is an ideal of the basering which is not generated by |
---|
[fab82ab] | 572 | monomials. |
---|
[28c487] | 573 | NOTE: this procedure is NOT Grobner free and should be used only if the |
---|
| 574 | ideal has non-monomial generators (use first checkIdeal) |
---|
[fab82ab] | 575 | " |
---|
| 576 | { |
---|
| 577 | // Variables |
---|
[abbd22] | 578 | int resp; |
---|
[fab82ab] | 579 | // Si el ideal es cero, no es monomial. |
---|
| 580 | if ( size(I) == 0) |
---|
[abbd22] | 581 | { |
---|
| 582 | return(0); |
---|
| 583 | } |
---|
| 584 | // Queremos la base de Grobner reducida, para uncidad. |
---|
| 585 | intvec save_opt=option(get); |
---|
| 586 | option(redSB); |
---|
[fab82ab] | 587 | // Base de Grobner |
---|
| 588 | I = std(I); |
---|
[abbd22] | 589 | option(set,save_opt); |
---|
[fab82ab] | 590 | // Una vez que tenemos la GB, no es mas que comprobar que el ideal |
---|
| 591 | // esta generado por monomios. |
---|
| 592 | resp = checkIdeal(I); |
---|
| 593 | if (resp == 0) |
---|
[abbd22] | 594 | { |
---|
| 595 | return (0); |
---|
| 596 | } |
---|
[fab82ab] | 597 | else |
---|
[abbd22] | 598 | { |
---|
| 599 | return (1,I); |
---|
| 600 | } |
---|
[fab82ab] | 601 | } |
---|
| 602 | ///////////////////////////////////////////////////////////////////////////// |
---|
| 603 | // |
---|
| 604 | // Comparing irreducible decompsitions |
---|
| 605 | // WARNING: this is not a test, when the answer is 1 and the decompositions |
---|
| 606 | // may not coincide but it is fast and easy and when the answer is |
---|
[28c487] | 607 | // 0 the decomposition do not coincide. |
---|
[fab82ab] | 608 | // |
---|
[28c487] | 609 | proc areEqual(list l1,list l2) |
---|
[fab82ab] | 610 | { |
---|
| 611 | int i,j,sizIdeal; |
---|
| 612 | poly generator; |
---|
| 613 | ideal l1Ideal,l2Ideal; |
---|
| 614 | int sizl1 = size(l1); |
---|
| 615 | for (i = 1 ; i <= sizl1 ; i ++) |
---|
[abbd22] | 616 | { |
---|
| 617 | sizIdeal = size(l1[i]); |
---|
| 618 | generator = 1; |
---|
| 619 | for (j = 1 ; j <= sizIdeal ; j ++) |
---|
[fab82ab] | 620 | { |
---|
[abbd22] | 621 | generator = generator*l1[i][j]; |
---|
[fab82ab] | 622 | } |
---|
[abbd22] | 623 | l1Ideal[i] = generator; |
---|
| 624 | } |
---|
[fab82ab] | 625 | int sizl2 = size(l2); |
---|
| 626 | for (i = 1 ; i <= sizl2 ; i ++) |
---|
[abbd22] | 627 | { |
---|
| 628 | sizIdeal = size(l2[i]); |
---|
| 629 | generator = 1; |
---|
| 630 | for (j = 1 ; j <= sizIdeal ; j ++) |
---|
[fab82ab] | 631 | { |
---|
[abbd22] | 632 | generator = generator*l2[i][j]; |
---|
[fab82ab] | 633 | } |
---|
[abbd22] | 634 | l2Ideal[i] = generator; |
---|
| 635 | } |
---|
[fab82ab] | 636 | return (equal(l1Ideal,l2Ideal)); |
---|
| 637 | } |
---|
| 638 | ///////////////////////////////////////////////////////////////////////////// |
---|
| 639 | //-------------------------------------------------------------------------// |
---|
| 640 | //----------------------- EXTERNOS ------------------------------------// |
---|
| 641 | //-------------------------------------------------------------------------// |
---|
| 642 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 643 | // |
---|
[abbd22] | 644 | proc isMonomial (ideal I) |
---|
[28c487] | 645 | "USAGE: isMonomial (I); I ideal. |
---|
| 646 | RETURN: 1, if I is monomial ideal; 0, otherwise. |
---|
[fab82ab] | 647 | ASSUME: I is an ideal of the basering. |
---|
| 648 | EXAMPLE: example isMonomial; shows some examples. |
---|
| 649 | " |
---|
| 650 | { |
---|
| 651 | // Si el ideal es cero, no es monomial. |
---|
| 652 | if ( size(I) == 0) |
---|
[abbd22] | 653 | { |
---|
| 654 | return(0); |
---|
| 655 | } |
---|
[fab82ab] | 656 | // Si ya viene dado por sistema de generadores monomiales, devolvemos 1 |
---|
| 657 | if (checkIdeal (I) == 1) |
---|
[abbd22] | 658 | { |
---|
| 659 | return(1); |
---|
| 660 | } |
---|
| 661 | // Variables |
---|
| 662 | int resp,m,k; |
---|
| 663 | // Queremos la base de Grobner reducida, para uncidad. |
---|
| 664 | intvec save_opt=option(get); |
---|
| 665 | option(redSB); |
---|
[fab82ab] | 666 | // Hallamos GB |
---|
| 667 | I = std(I); |
---|
[abbd22] | 668 | option(set,save_opt); |
---|
[fab82ab] | 669 | // Una vez que tenemos la GB, no es mas que comprobar si el ideal |
---|
| 670 | // esta generado por monomios. |
---|
| 671 | resp = checkIdeal(I); |
---|
| 672 | // Volvemos a dejar el comando "std" devolviendo una GB estandar. |
---|
| 673 | return(resp); |
---|
| 674 | } |
---|
| 675 | example |
---|
| 676 | { "EXAMPLE:"; echo = 2; |
---|
| 677 | ring R = 0,(w,x,y,z,t),lp; |
---|
| 678 | ideal I = w^3*x*y, w^2*x^2*y^2*z^2 - y^3*z+x^4*z^4*t^4, w*x*y*z*t - w*x^6*y^5*z^4, x^2*z^4*t^3 , w^6*y^4*z^2 + x^2*y^2*z^2; |
---|
| 679 | isMonomial(I); |
---|
| 680 | ideal J = w^3*x*y + x^3*y^9*t^3, w^2*x^2*y^2*z^2 - y^3*z, w*x*y*z*t - w*x^6*y^5*z^4, x^2*z^4*t^3 + y^4*z^4*t^4, w^6*y^4*z^2 + x^2*y^2*z^2; |
---|
| 681 | isMonomial(J); |
---|
| 682 | } |
---|
| 683 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 684 | // |
---|
[fab82ab] | 685 | proc minbaseMon (ideal I) |
---|
[28c487] | 686 | "USAGE: minbaseMon (I); I ideal. |
---|
[fab82ab] | 687 | RETURN: an ideal, the minimal monomial generators of I. |
---|
[28c487] | 688 | (-1 if the generators of I are not monomials) |
---|
[fab82ab] | 689 | ASSUME: I is an ideal generated by a list of monomials of the basering. |
---|
| 690 | EXAMPLE: example minbaseMon; shows an example. |
---|
| 691 | " |
---|
| 692 | { |
---|
| 693 | // VARIABLES |
---|
| 694 | int i; |
---|
| 695 | ideal J; |
---|
| 696 | // Si no esta generado por monomios este metodo no vale |
---|
| 697 | int control = checkIdeal(I); |
---|
| 698 | if (control == 0) |
---|
[abbd22] | 699 | { |
---|
[28c487] | 700 | return (-1); |
---|
[abbd22] | 701 | } |
---|
[fab82ab] | 702 | // Quitamos los ceros del sistema de generadores. |
---|
| 703 | I = simplify(I,2); |
---|
[abbd22] | 704 | int sizI = ncols(I); |
---|
[fab82ab] | 705 | for (i = 1 ; i <= sizI ; i++) |
---|
[abbd22] | 706 | { |
---|
| 707 | if (sizI > 1) |
---|
[fab82ab] | 708 | { |
---|
[abbd22] | 709 | if (i == 1) |
---|
| 710 | { |
---|
| 711 | J = I[2..sizI]; |
---|
| 712 | } |
---|
| 713 | else |
---|
| 714 | { |
---|
| 715 | if (i > 1 && i < sizI) |
---|
[fab82ab] | 716 | { |
---|
[abbd22] | 717 | J = I[1..i-1], I[i+1..sizI]; |
---|
| 718 | } |
---|
| 719 | else |
---|
| 720 | { |
---|
| 721 | if (i == sizI) |
---|
| 722 | { |
---|
| 723 | J = I[1..sizI-1]; |
---|
| 724 | } |
---|
[fab82ab] | 725 | } |
---|
[abbd22] | 726 | } |
---|
| 727 | // Si quitamos el generador del lugar "i", luego el que |
---|
| 728 | // ocupa ahora el lugar "i" es el "i+1", de ahi que restemos |
---|
| 729 | // 1 al i para volver al for de manera que recorramos los |
---|
| 730 | // generadores como debemos. |
---|
| 731 | if (membershipMon(I[i],J) == 1) |
---|
| 732 | { |
---|
| 733 | I = J; |
---|
| 734 | i--; |
---|
| 735 | sizI = ncols(I); |
---|
| 736 | } |
---|
[fab82ab] | 737 | } |
---|
[abbd22] | 738 | } |
---|
[fab82ab] | 739 | return (I); |
---|
| 740 | } |
---|
| 741 | example |
---|
| 742 | {"EXAMPLE:"; echo = 2; |
---|
| 743 | ring R = 0,(w,x,y,z,t),lp; |
---|
| 744 | ideal I = w^3*x*y, w^2*x^2*y^2*z^2, y^3*z,x^4*z^4*t^4, w*x*y*z*t,w*x^6*y^5*z^4, x^2*z^4*t^3 , w^6*y^4*z^2,x^2*y^2*z^2; |
---|
| 745 | minbaseMon(I); |
---|
| 746 | } |
---|
| 747 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 748 | // |
---|
| 749 | proc gcdMon (poly f,poly g) |
---|
| 750 | "USAGE: gcdMon (f,g); f,g polynomials. |
---|
[fab82ab] | 751 | RETURN: a monomial, the greatest common divisor of f and g. |
---|
| 752 | ASSUME: f and g are monomials of the basering. |
---|
| 753 | EXAMPLE: example gcdMon; shows an example. |
---|
| 754 | " |
---|
| 755 | { |
---|
| 756 | if (size(f) <> 1 or size(g) <> 1) |
---|
| 757 | { |
---|
| 758 | ERROR ("the input must be 2 monomials."); |
---|
| 759 | } |
---|
| 760 | return(gcd(f,g)); |
---|
| 761 | |
---|
| 762 | // // Variables |
---|
| 763 | // int k; |
---|
| 764 | // intvec exp; |
---|
| 765 | // int nvar = nvars(basering); |
---|
| 766 | // // intput: monomials |
---|
| 767 | // |
---|
| 768 | // intvec expf = leadexp(f); |
---|
| 769 | // intvec expg = leadexp(g); |
---|
| 770 | // // Nos quedamos con el menor exponente de cada variable. |
---|
| 771 | // for (k = 1 ; k <= nvar ; k++) |
---|
| 772 | // { |
---|
| 773 | // if (expf[k] <= expg[k]) |
---|
| 774 | // { |
---|
| 775 | // exp[k] = expf[k]; |
---|
| 776 | // } |
---|
| 777 | // else |
---|
| 778 | // { |
---|
| 779 | // exp[k] = expg[k]; |
---|
| 780 | // } |
---|
| 781 | // } |
---|
| 782 | // // Devolvemos el monomio correspondiente al exponente que hemos |
---|
| 783 | // // calculado. |
---|
| 784 | // return(monomial(exp)); |
---|
| 785 | } |
---|
| 786 | example |
---|
| 787 | {"EXAMPLE:"; echo = 2; |
---|
| 788 | ring R = 0,(x,y,z,t),dp; |
---|
| 789 | poly f = x^3*z^5*t^2; |
---|
| 790 | poly g = y^6*z^3*t^3; |
---|
| 791 | gcdMon(f,g); |
---|
| 792 | } |
---|
| 793 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 794 | // |
---|
| 795 | proc lcmMon (poly f,poly g) |
---|
| 796 | "USAGE: lcmMon (f,g); f,g polynomials. |
---|
[fab82ab] | 797 | RETURN: a monomial,the least common multiple of f and g. |
---|
| 798 | ASSUME: f,g are monomials of the basering. |
---|
| 799 | EXAMPLE: example lcmMon; shows an example. |
---|
| 800 | " |
---|
| 801 | { |
---|
| 802 | // Hay que verificar que son monomios |
---|
| 803 | if (size(f) <> 1 or size(g) <> 1) |
---|
| 804 | { |
---|
| 805 | ERROR ("the input must be 2 monomials."); |
---|
| 806 | } |
---|
[abbd22] | 807 | return(f*g/gcd(f,g)); |
---|
| 808 | //// Variables. |
---|
| 809 | //int k; |
---|
| 810 | //intvec exp; |
---|
| 811 | //int nvar = nvars(basering); |
---|
[fab82ab] | 812 | |
---|
[abbd22] | 813 | //// No tenemos mas que tomar el mayor exponente. |
---|
| 814 | //intvec expf = leadexp (f); |
---|
| 815 | //intvec expg = leadexp (g); |
---|
| 816 | |
---|
| 817 | //for (k = 1 ; k <= nvar ; k ++) |
---|
| 818 | //{ |
---|
| 819 | // if (expf[k] <= expg[k]) |
---|
| 820 | // { |
---|
| 821 | // exp[k] = expg[k]; |
---|
| 822 | // } |
---|
| 823 | // else |
---|
| 824 | // { |
---|
| 825 | // exp[k] = expf[k]; |
---|
| 826 | // } |
---|
| 827 | //} |
---|
| 828 | //// Transformamos el vector de exponentes al monomio correspondiente. |
---|
| 829 | //return(monomial (exp)); |
---|
[fab82ab] | 830 | } |
---|
| 831 | example |
---|
| 832 | {"EXAMPLE:"; echo = 2; |
---|
| 833 | ring R = 0,(x,y,z,t),dp; |
---|
| 834 | poly f = x^3*z^5*t^2; |
---|
| 835 | poly g = y^6*z^3*t^3; |
---|
| 836 | lcmMon(f,g); |
---|
| 837 | } |
---|
[28c487] | 838 | ////////////////////////////////////////////////////////////////////// |
---|
| 839 | // |
---|
| 840 | proc membershipMon(poly f,ideal I) |
---|
| 841 | "USAGE: membershipMon(f,I); f polynomial, I ideal. |
---|
[fab82ab] | 842 | RETURN: 1, if f lies in I; 0 otherwise. |
---|
[28c487] | 843 | (-1 if I and f are nonzero and I is not a monomial ideal) |
---|
[fab82ab] | 844 | ASSUME: I is a monomial ideal of the basering. |
---|
| 845 | EXAMPLE: example membershipMon; shows some examples |
---|
| 846 | " |
---|
| 847 | { |
---|
| 848 | // Variables |
---|
| 849 | int i,j,resp,k,control; |
---|
| 850 | intvec restf; |
---|
| 851 | // Si el ideal es cero no es monomial, pero la pertenencia no se da si |
---|
| 852 | // el polinomio es no nulo |
---|
| 853 | if ( size(I) == 0 && size(f) > 0) |
---|
| 854 | { |
---|
| 855 | return (0); |
---|
| 856 | } |
---|
| 857 | // El cero esta en todos los ideales. |
---|
| 858 | if (f == 0) |
---|
| 859 | { |
---|
| 860 | return (1); |
---|
| 861 | } |
---|
| 862 | // COMPROBACIONES |
---|
| 863 | control = checkIdeal(I); |
---|
| 864 | if (control == 0) |
---|
| 865 | { |
---|
| 866 | list isMon = isMonomialGB (I); |
---|
| 867 | if (isMon[1] == 0) |
---|
| 868 | { |
---|
| 869 | ERROR ("the ideal is not monomial."); |
---|
| 870 | } |
---|
| 871 | else |
---|
| 872 | { |
---|
| 873 | // Sabemos que I ya viene dado por el sistema minimal de |
---|
| 874 | // generadores, aunque aqui no sea necesario. |
---|
| 875 | I = isMon[2]; |
---|
| 876 | } |
---|
| 877 | } |
---|
| 878 | // Quitamos ceros. |
---|
| 879 | I = simplify(I,2); |
---|
[abbd22] | 880 | int n = ncols(I); |
---|
[fab82ab] | 881 | int m = size(f); |
---|
[abbd22] | 882 | int nvar = nvars(basering); |
---|
[fab82ab] | 883 | for (i=1 ; i<=m ; i++) |
---|
| 884 | { |
---|
| 885 | resp = 0; |
---|
| 886 | for (j=1 ; j<=n ;j++) |
---|
| 887 | { |
---|
| 888 | // Vamos termino a termino viendo si son divididos por algun |
---|
| 889 | // generador. Trabajamos con los exponentes, pues es mas |
---|
| 890 | // simple. |
---|
| 891 | restf = leadexp(f) - leadexp(I[j]); |
---|
| 892 | for (k=1 ; k<=nvar; k++) |
---|
| 893 | { |
---|
| 894 | // Si hay una componente negativa es que este generador |
---|
| 895 | // no divide. Queremos entonces ir al siguiente |
---|
| 896 | // generador. |
---|
| 897 | if (restf[k] < 0) |
---|
| 898 | { |
---|
| 899 | break; |
---|
| 900 | } |
---|
| 901 | } |
---|
| 902 | // Si no ha habido componente nula, hemos encontrado un |
---|
| 903 | // divisor para el actual termino de f. En esta situacion |
---|
| 904 | // queremos pasar a otro termino de f, no seguir con los |
---|
| 905 | // otros generadores. |
---|
| 906 | if (k == nvar+1) |
---|
| 907 | { |
---|
| 908 | resp = 1; |
---|
| 909 | break; |
---|
| 910 | } |
---|
| 911 | } |
---|
| 912 | // Si hemos encontrado para el anterior termino, voy al |
---|
| 913 | // siguiente; en caso contrario salimos, pues desde que un |
---|
| 914 | // termino no sea dividido, f no esta en I. |
---|
| 915 | if (resp == 1) |
---|
| 916 | { |
---|
| 917 | f = f - lead(f); |
---|
| 918 | } |
---|
| 919 | else |
---|
| 920 | { |
---|
| 921 | break; |
---|
| 922 | } |
---|
| 923 | } |
---|
| 924 | // Si hemos recorrido todo el bucle, f esta en I. |
---|
| 925 | if (i == m+1) |
---|
| 926 | { |
---|
| 927 | return (1); |
---|
| 928 | } |
---|
| 929 | return (0); |
---|
| 930 | } |
---|
| 931 | example |
---|
| 932 | {"EXAMPLE:"; echo = 2; |
---|
| 933 | ring R = 0,(w,x,y,z,t),lp; |
---|
| 934 | ideal I = w*x, x^2, y*z*t, y^5*t; |
---|
| 935 | poly f = 3*x^2*y + 6*t^5*z*y^6 - 4*x^2 + 8*w*x^5*y^6 - 10*y^10*t^10; |
---|
| 936 | membershipMon(f,I); |
---|
| 937 | poly g = 3*w^2*t^3 - 4*y^3*z*t^3 - 2*x^2*y^5*t + 4*x*y^3; |
---|
| 938 | membershipMon(g,I); |
---|
| 939 | } |
---|
[28c487] | 940 | ////////////////////////////////////////////////////////////////////// |
---|
| 941 | // |
---|
| 942 | proc intersectMon (ideal I,ideal J) |
---|
| 943 | "USAGE: intersectMon (I,J); I,J ideals. |
---|
[fab82ab] | 944 | RETURN: an ideal, the intersection of I and J. |
---|
| 945 | (it returns -1 if I or J are not monomial ideals) |
---|
| 946 | ASSUME: I,J are monomial ideals of the basering. |
---|
| 947 | NOTE: the minimal monomial generating set is returned. |
---|
| 948 | EXAMPLE: example intersectMon; shows some examples |
---|
| 949 | " |
---|
| 950 | { |
---|
| 951 | // Variables |
---|
| 952 | ideal K; |
---|
| 953 | int i,j,control; |
---|
| 954 | list isMon; |
---|
| 955 | // El ideal trivial no es monomial. |
---|
| 956 | if ( size(I) == 0 || size(J) == 0) |
---|
[abbd22] | 957 | { |
---|
| 958 | ERROR("one of the ideals is zero, hence not monomial."); |
---|
| 959 | } |
---|
[fab82ab] | 960 | // COMPROBACIONES |
---|
| 961 | control = checkIdeal(I); |
---|
| 962 | if (control == 0) |
---|
[abbd22] | 963 | { |
---|
| 964 | isMon = isMonomialGB(I); |
---|
| 965 | if (isMon[1] == 0) |
---|
[fab82ab] | 966 | { |
---|
[abbd22] | 967 | ERROR ("the first ideal is not monomial."); |
---|
[fab82ab] | 968 | } |
---|
[abbd22] | 969 | else |
---|
[fab82ab] | 970 | { |
---|
[abbd22] | 971 | // Sabemos que I ya viene dado por el sistema minimal de |
---|
| 972 | // generadores, aunque aqui no sea necesario. |
---|
| 973 | I = isMon[2]; |
---|
[fab82ab] | 974 | } |
---|
[abbd22] | 975 | } |
---|
| 976 | else |
---|
| 977 | { |
---|
| 978 | // Los generadores son monomiales, hallamos el sistema minimal |
---|
| 979 | I = minbase(I); |
---|
| 980 | } |
---|
[fab82ab] | 981 | control = checkIdeal(J); |
---|
| 982 | if (control == 0) |
---|
[abbd22] | 983 | { |
---|
| 984 | isMon = isMonomialGB (J); |
---|
| 985 | if (isMon[1] == 0) |
---|
[fab82ab] | 986 | { |
---|
[abbd22] | 987 | ERROR ("the second ideal is not monomial."); |
---|
[fab82ab] | 988 | } |
---|
[abbd22] | 989 | else |
---|
[fab82ab] | 990 | { |
---|
[abbd22] | 991 | // Sabemos que J ya viene dado por el sistema minimal de |
---|
| 992 | // generadores, aunque aqui no sea necesario. |
---|
| 993 | J = isMon[2]; |
---|
[fab82ab] | 994 | } |
---|
[abbd22] | 995 | } |
---|
| 996 | else |
---|
| 997 | { |
---|
| 998 | // Los generadores son monomiales,hallamos la base minimal |
---|
| 999 | J = minbase(J); |
---|
| 1000 | } |
---|
[fab82ab] | 1001 | // Hemos asegurado que los ideales sean monomiales. |
---|
| 1002 | // Quitamos ceros de la base para no alargar calculos. |
---|
[abbd22] | 1003 | int n = ncols(I); |
---|
| 1004 | int m = ncols(J); |
---|
[fab82ab] | 1005 | // Hallamos el m.c.m.de cada par de generadores de uno y otro ideal |
---|
| 1006 | // y los a?adimos al ideal interseccion. |
---|
| 1007 | for (i=1 ; i<=n ; i++) |
---|
[abbd22] | 1008 | { |
---|
| 1009 | for (j=1 ; j<=m ; j++) |
---|
[fab82ab] | 1010 | { |
---|
[abbd22] | 1011 | K = K , lcmMon (I[i],J[j]); |
---|
[fab82ab] | 1012 | } |
---|
[abbd22] | 1013 | } |
---|
[fab82ab] | 1014 | // Devolvemos el ideal ya dado por la base minimal porque sabemos |
---|
| 1015 | // que este procedimiento genera muchos generadores redundantes. |
---|
| 1016 | return(minbase(K)); |
---|
| 1017 | } |
---|
| 1018 | example |
---|
| 1019 | {"EXAMPLE:"; echo = 2; |
---|
| 1020 | ring R = 0,(w,x,y,z,t),lp; |
---|
| 1021 | ideal I = w^3*x*y,w*x*y*z*t,x^2*y^2*z^2,x^2*z^4*t^3,y^3*z; |
---|
| 1022 | ideal J = w*x, x^2, y*z*t, y^5*t; |
---|
| 1023 | intersectMon (I,J); |
---|
| 1024 | } |
---|
[28c487] | 1025 | ////////////////////////////////////////////////////////////////////// |
---|
| 1026 | // |
---|
| 1027 | proc quotientMon (ideal I,ideal J) |
---|
| 1028 | "USAGE: quotientMon (I,J); I,J ideals. |
---|
[fab82ab] | 1029 | RETURN: an ideal, the quotient I:J. |
---|
| 1030 | (returns -1 if I or J is not monomial) |
---|
[28c487] | 1031 | ASSUME: I,J are monomial ideals of the basering. |
---|
[fab82ab] | 1032 | NOTE: the minimal monomial generating set is returned. |
---|
| 1033 | EXAMPLE: example quotientMon; shows an example. |
---|
| 1034 | " |
---|
| 1035 | { |
---|
| 1036 | // Variables |
---|
| 1037 | int i,control,n; |
---|
| 1038 | poly f; |
---|
| 1039 | list isMon; |
---|
| 1040 | //COMPROBACIONES |
---|
| 1041 | if (size(I) == 0 || size(J) == 0) |
---|
[abbd22] | 1042 | { |
---|
| 1043 | ERROR("one of the ideals is zero, hence not monomial."); |
---|
| 1044 | } |
---|
[fab82ab] | 1045 | control = checkIdeal(I); |
---|
| 1046 | if (control == 0) |
---|
[abbd22] | 1047 | { |
---|
| 1048 | isMon = isMonomialGB (I); |
---|
| 1049 | if (isMon[1] == 0) |
---|
[fab82ab] | 1050 | { |
---|
[abbd22] | 1051 | ERROR ("the first ideal is not monomial."); |
---|
[fab82ab] | 1052 | } |
---|
[abbd22] | 1053 | else |
---|
[fab82ab] | 1054 | { |
---|
[abbd22] | 1055 | // Sabemos que I ya viene dado por el sistema minimal de |
---|
| 1056 | // generadores, aunque aqui no sea necesario. |
---|
| 1057 | I = isMon[2]; |
---|
[fab82ab] | 1058 | } |
---|
[abbd22] | 1059 | } |
---|
| 1060 | else |
---|
| 1061 | { |
---|
| 1062 | // Los generadores son monomiales,hallamos sistema minimal |
---|
| 1063 | I = minbase(I); |
---|
| 1064 | } |
---|
[fab82ab] | 1065 | control = checkIdeal(J); |
---|
| 1066 | if (control == 0) |
---|
[abbd22] | 1067 | { |
---|
| 1068 | isMon = isMonomialGB (J); |
---|
| 1069 | if (isMon[1] == 0) |
---|
[fab82ab] | 1070 | { |
---|
[abbd22] | 1071 | ERROR ("the second ideal is not monomial."); |
---|
[28c487] | 1072 | return (-1); |
---|
[fab82ab] | 1073 | } |
---|
[abbd22] | 1074 | else |
---|
[fab82ab] | 1075 | { |
---|
[abbd22] | 1076 | // Sabemos que J ya viene dado por el sistema minimal de |
---|
| 1077 | // generadores, aunque aqui no sea necesario. |
---|
| 1078 | J = isMon[2]; |
---|
[fab82ab] | 1079 | } |
---|
[abbd22] | 1080 | } |
---|
| 1081 | else |
---|
| 1082 | { |
---|
| 1083 | // Los generadores son monomiales, hallamos el sistema minimal |
---|
| 1084 | J = minbase(J); |
---|
| 1085 | } |
---|
[fab82ab] | 1086 | // Tenemos los ideales dados por su sistema minimal (aunque no es necesario, ahorra |
---|
| 1087 | // calculos. En K vamos a tener la interseccion de los ideales. |
---|
| 1088 | ideal K = 1; |
---|
| 1089 | // ------ Empezamos a hacer el cociente. |
---|
| 1090 | // Los ideales estan dados por su sistema minimal, con lo que no aparecen ceros. |
---|
| 1091 | // Luego podemos usar size(J). |
---|
[abbd22] | 1092 | n = ncols(J); |
---|
[fab82ab] | 1093 | for (i = 1 ; i <= n ; i++) |
---|
[abbd22] | 1094 | { |
---|
| 1095 | K = intersect (K ,quotientIdealMon(I,J[i])); |
---|
| 1096 | } |
---|
[fab82ab] | 1097 | // Aqui tambien surgen muchos generadores que no forman parte de la |
---|
| 1098 | // base minimal del ideal obtenido. |
---|
| 1099 | return(minbase(K)); |
---|
| 1100 | } |
---|
| 1101 | example |
---|
| 1102 | {"EXAMPLE:"; echo = 2; |
---|
| 1103 | ring R = 0,(w,x,y,z,t),lp; |
---|
| 1104 | ideal I = w^3*x*y,w*x*y*z*t,x^2*y^2*z^2,x^2*z^4*t^3,y^3*z; |
---|
| 1105 | ideal J = w*x, x^2, y*z*t, y^5*t; |
---|
| 1106 | quotientMon (I,J); |
---|
| 1107 | } |
---|
[28c487] | 1108 | ////////////////////////////////////////////////////////////////////// |
---|
| 1109 | // |
---|
[fab82ab] | 1110 | proc radicalMon(ideal I) |
---|
[28c487] | 1111 | "USAGE: radicalMon(I); I ideal |
---|
[fab82ab] | 1112 | RETURN: an ideal, the radical ideal of the ideal I. |
---|
| 1113 | (returns -1 if I is not a monomial ideal) |
---|
| 1114 | ASSUME: I is a monomial ideal of the basering. |
---|
[28c487] | 1115 | NOTE: the minimal monomial generating set is returned. |
---|
[fab82ab] | 1116 | EXAMPLE: example radicalMon; shows an example. |
---|
| 1117 | " |
---|
| 1118 | { |
---|
| 1119 | // Cambiamos de anillo |
---|
[abbd22] | 1120 | int nvar = nvars(basering); |
---|
[fab82ab] | 1121 | // Variables |
---|
| 1122 | int i,m,j,control; |
---|
| 1123 | poly f; |
---|
| 1124 | intvec v; |
---|
| 1125 | ideal rad_I; |
---|
| 1126 | // COMPROBACIONES |
---|
| 1127 | control = checkIdeal(I); |
---|
| 1128 | // Si el sistema de generadores no esta formado por monomios, hay |
---|
| 1129 | // que comprobar si el ideal es monomial. |
---|
| 1130 | if (control == 0) |
---|
[abbd22] | 1131 | { |
---|
| 1132 | list isMon = isMonomialGB (I); |
---|
| 1133 | if (isMon[1] == 0) |
---|
[fab82ab] | 1134 | { |
---|
[abbd22] | 1135 | ERROR ("the ideal is not monomial."); |
---|
[fab82ab] | 1136 | } |
---|
[abbd22] | 1137 | else |
---|
[fab82ab] | 1138 | { |
---|
[abbd22] | 1139 | I = isMon[2]; |
---|
| 1140 | // Ya lo tenemos con los generadores monomiales minimales |
---|
[fab82ab] | 1141 | } |
---|
[abbd22] | 1142 | } |
---|
| 1143 | else |
---|
| 1144 | { |
---|
| 1145 | // Generadores monomiales, hallamos sistema minimal |
---|
| 1146 | I = minbase(I); |
---|
| 1147 | } |
---|
[fab82ab] | 1148 | // Ya tenemos el ideal generado por la BASE MINIMAL MONOMIAL |
---|
[abbd22] | 1149 | m = ncols(I); |
---|
[fab82ab] | 1150 | // Solo hay que poner exponente 1 a todas las variables que tengan |
---|
| 1151 | // exponente >1. |
---|
| 1152 | for (i = 1 ; i <= m ; i++) |
---|
[abbd22] | 1153 | { |
---|
| 1154 | v = leadexp(I[i]); |
---|
| 1155 | f = 1; |
---|
| 1156 | for (j = 1 ; j <= nvar ; j++) |
---|
[fab82ab] | 1157 | { |
---|
[abbd22] | 1158 | if (v[j] <> 0) |
---|
| 1159 | { |
---|
| 1160 | f = f*var(j); |
---|
| 1161 | } |
---|
[fab82ab] | 1162 | } |
---|
[abbd22] | 1163 | rad_I = rad_I,f; |
---|
| 1164 | } |
---|
[fab82ab] | 1165 | // Hay que devolver el ideal dado por la base minimal, pues se |
---|
| 1166 | // producen muchos generadores redundantes. |
---|
| 1167 | return( minbase (rad_I)); |
---|
| 1168 | } |
---|
| 1169 | example |
---|
| 1170 | {"EXAMPLE:"; echo = 2; |
---|
| 1171 | ring R = 0,(w,x,y,z,t),lp; |
---|
| 1172 | ideal I = w^3*x*y,w*x*y*z*t,x^2*y^2*z^2,x^2*z^4*t^3,y^3*z; |
---|
| 1173 | radicalMon(I); |
---|
| 1174 | } |
---|
[28c487] | 1175 | ////////////////////////////////////////////////////////////////////// |
---|
| 1176 | // |
---|
[abbd22] | 1177 | proc isprimeMon (ideal I) |
---|
[28c487] | 1178 | "USAGE: isprimeMon (I); I ideal |
---|
[fab82ab] | 1179 | RETURN: 1, if I is prime; 0, otherwise. |
---|
| 1180 | (returns -1 if I is not a monomial ideal) |
---|
| 1181 | ASSUME: I is a monomial ideal of the basering. |
---|
| 1182 | EXAMPLE: example isprimeMon; shows some example. |
---|
| 1183 | " |
---|
| 1184 | { |
---|
| 1185 | // Variables |
---|
| 1186 | int control,i,j,suma; |
---|
| 1187 | intvec expin; |
---|
| 1188 | // COMPROBACIONES |
---|
| 1189 | control = checkIdeal(I); |
---|
| 1190 | // Si el sistema de generadores no esta formado por monomios, hay |
---|
| 1191 | // que comprobar si el ideal es monomial. |
---|
| 1192 | if (control == 0) |
---|
[abbd22] | 1193 | { |
---|
| 1194 | list isMon = isMonomialGB (I); |
---|
| 1195 | if (isMon[1] == 0) |
---|
[fab82ab] | 1196 | { |
---|
[abbd22] | 1197 | ERROR ("the ideal is not monomial."); |
---|
[fab82ab] | 1198 | } |
---|
[abbd22] | 1199 | else |
---|
[fab82ab] | 1200 | { |
---|
[abbd22] | 1201 | I = isMon[2]; |
---|
| 1202 | // Ya lo tenemos con los generadores minimales |
---|
[fab82ab] | 1203 | } |
---|
[abbd22] | 1204 | } |
---|
| 1205 | else |
---|
| 1206 | { |
---|
| 1207 | // Generadores monomiales, hallamos el sistema minimal |
---|
| 1208 | I = minbase(I); |
---|
| 1209 | } |
---|
[fab82ab] | 1210 | // Ya tenemos el ideal generado por la BASE MINIMAL |
---|
| 1211 | if (maxdeg1(I) == 1) |
---|
[abbd22] | 1212 | { |
---|
| 1213 | return (1); |
---|
| 1214 | } |
---|
| 1215 | return (0); |
---|
[fab82ab] | 1216 | } |
---|
| 1217 | example |
---|
| 1218 | {"EXAMPLE:"; echo = 2; |
---|
| 1219 | ring R = 0,(w,x,y,z,t),lp; |
---|
| 1220 | ideal I = w,y,t; |
---|
| 1221 | isprimeMon (I); |
---|
| 1222 | ideal J = w,y,t,x*z; |
---|
| 1223 | isprimeMon (J); |
---|
| 1224 | } |
---|
[28c487] | 1225 | ////////////////////////////////////////////////////////////////////// |
---|
| 1226 | // |
---|
[abbd22] | 1227 | proc isprimaryMon (ideal I) |
---|
[28c487] | 1228 | "USAGE: isprimaryMon (I); I ideal |
---|
[fab82ab] | 1229 | RETURN: 1, if I is primary; 0, otherwise. |
---|
| 1230 | (returns -1 if I is not a monomial ideal) |
---|
| 1231 | ASSUME: I is a monomial ideal of the basering. |
---|
| 1232 | EXAMPLE: example isprimaryMon; shows some examples |
---|
| 1233 | " |
---|
| 1234 | { |
---|
| 1235 | // Variables |
---|
| 1236 | int nvar,control,m,l,sub_in,i,j,k; |
---|
| 1237 | intvec v,w,exp_gen; |
---|
| 1238 | // COMPROBACIONES |
---|
| 1239 | control = checkIdeal(I); |
---|
| 1240 | // Si el sistema de generadores no esta formado por monomios, hay |
---|
| 1241 | // que comprobar si el ideal es monomial. |
---|
| 1242 | if (control == 0) |
---|
[abbd22] | 1243 | { |
---|
| 1244 | list isMon = isMonomialGB (I); |
---|
| 1245 | if (isMon[1] == 0) |
---|
[fab82ab] | 1246 | { |
---|
[abbd22] | 1247 | ERROR ("the ideal is not monomial."); |
---|
[fab82ab] | 1248 | } |
---|
[abbd22] | 1249 | else |
---|
[fab82ab] | 1250 | { |
---|
[abbd22] | 1251 | I = isMon[2]; |
---|
| 1252 | // Ya lo tenemos con los generadores minimales |
---|
[fab82ab] | 1253 | } |
---|
[abbd22] | 1254 | } |
---|
| 1255 | else |
---|
| 1256 | { |
---|
| 1257 | // Generadores monomiales, hallamos el sistema minimal |
---|
| 1258 | I = minbase(I); |
---|
| 1259 | } |
---|
[fab82ab] | 1260 | // Ya tenemos el ideal generado por la BASE MINIMAL |
---|
| 1261 | // Usamos la funcion "soporte" que hemos creado, para saber que |
---|
| 1262 | // variables aparecen en la base de generadores como producto de si |
---|
| 1263 | // mismas y tambien cuales son los generadores del ideal donde |
---|
| 1264 | // tenemos que comprobar si aparecen tales variables. |
---|
[abbd22] | 1265 | nvar = nvars(basering); |
---|
| 1266 | m = ncols(I); |
---|
[fab82ab] | 1267 | // Inicializo la ultima componente del vector para que contenga a |
---|
| 1268 | // todas las variables (el subindice de la variable es el lugar |
---|
| 1269 | // que ocupa como componente de v). |
---|
| 1270 | v[nvar] = 0; |
---|
| 1271 | k = 1; |
---|
| 1272 | // v = 1 en variables solas y 0 en el resto. |
---|
| 1273 | // w = lugar de los generadores de I que son producto de mas de una variable. |
---|
| 1274 | for (i = 1 ; i <= m ; i++) |
---|
[abbd22] | 1275 | { |
---|
| 1276 | sub_in = soporte(I[i]); |
---|
| 1277 | // Si soporte <> 0 la variable aparece sola, en caso contrario |
---|
| 1278 | // el generador es producto de mas de una variable |
---|
| 1279 | if (sub_in <> 0) |
---|
[fab82ab] | 1280 | { |
---|
[abbd22] | 1281 | v[sub_in] = 1; |
---|
| 1282 | } |
---|
| 1283 | else |
---|
| 1284 | { |
---|
| 1285 | w[k] = i; |
---|
| 1286 | k++; |
---|
[fab82ab] | 1287 | } |
---|
[abbd22] | 1288 | } |
---|
[fab82ab] | 1289 | // Ahora solo hay que ver que no aparecen variables distintas de |
---|
| 1290 | // las que tenemos marcadas con 1 en v. |
---|
| 1291 | l = size(w); |
---|
| 1292 | // Si w es cero, quiere decir que todos los generadores del ideal |
---|
| 1293 | // son producto de una sola variable, luego es primario. |
---|
| 1294 | if (l == 1 && w[1] == 0) |
---|
[abbd22] | 1295 | { |
---|
| 1296 | return(1); |
---|
| 1297 | } |
---|
[fab82ab] | 1298 | // Estudiamos el exponente de los generadores de I oportunos (los |
---|
| 1299 | // que nos indica w). |
---|
| 1300 | for (i = 1 ; i <= l ; i++) |
---|
[abbd22] | 1301 | { |
---|
| 1302 | exp_gen = leadexp(I[w[i]]); |
---|
| 1303 | for (j = 1 ; j <= nvar ; j++) |
---|
[fab82ab] | 1304 | { |
---|
[abbd22] | 1305 | if (v[j] == 0) |
---|
| 1306 | { |
---|
| 1307 | if (exp_gen[j] <> 0) |
---|
[fab82ab] | 1308 | { |
---|
[abbd22] | 1309 | return (0); |
---|
[fab82ab] | 1310 | } |
---|
[abbd22] | 1311 | } |
---|
[fab82ab] | 1312 | } |
---|
[abbd22] | 1313 | } |
---|
[fab82ab] | 1314 | // Si hemos recorrido todo el ideal sin que salte el "for" |
---|
| 1315 | // quiere decir que no se ha contradicho la caracterizacion, |
---|
| 1316 | // luego el ideal es primario. |
---|
| 1317 | return(1); |
---|
| 1318 | } |
---|
| 1319 | example |
---|
| 1320 | {"EXAMPLE:"; echo = 2; |
---|
| 1321 | ring R = 0,(w,x,y,z,t),lp; |
---|
| 1322 | ideal I = w^4,x^3,z^2,t^5,x*t,w*x^2*z; |
---|
| 1323 | isprimaryMon (I); |
---|
| 1324 | ideal J = w^4,x^3,z^2,t^5,x*t,w*x^2*z,y^3*t^3; |
---|
| 1325 | isprimaryMon (J); |
---|
| 1326 | } |
---|
[28c487] | 1327 | ////////////////////////////////////////////////////////////////////// |
---|
| 1328 | // |
---|
[fab82ab] | 1329 | proc isirreducibleMon (ideal I) |
---|
[28c487] | 1330 | "USAGE: isirreducibleMon(I); I ideal |
---|
[fab82ab] | 1331 | RETURN: 1, if I is irreducible; 0, otherwise. |
---|
[28c487] | 1332 | (return -1 if I is not a monomial ideal) |
---|
[fab82ab] | 1333 | ASSUME: I is a monomial ideal of the basering. |
---|
| 1334 | EXAMPLE: example isirreducibleMon; shows some examples |
---|
| 1335 | " |
---|
| 1336 | { |
---|
| 1337 | // Variables |
---|
| 1338 | intvec v; |
---|
| 1339 | int n,i,j,sum,control; |
---|
| 1340 | control = checkIdeal(I); |
---|
| 1341 | // Si el sistema de generadores no esta formado por monomios, hay |
---|
| 1342 | // que comprobar si el ideal es monomial. |
---|
| 1343 | if (control == 0) |
---|
[abbd22] | 1344 | { |
---|
| 1345 | list isMon = isMonomialGB (I); |
---|
| 1346 | if (isMon[1] == 0) |
---|
[fab82ab] | 1347 | { |
---|
[abbd22] | 1348 | ERROR ("the ideal is not monomial."); |
---|
[fab82ab] | 1349 | } |
---|
[abbd22] | 1350 | else |
---|
[fab82ab] | 1351 | { |
---|
[abbd22] | 1352 | I = isMon[2]; |
---|
| 1353 | // Ya lo tenemos con los generadores minimales |
---|
[fab82ab] | 1354 | } |
---|
[abbd22] | 1355 | } |
---|
| 1356 | else |
---|
| 1357 | { |
---|
| 1358 | // Generadores monomiales, hallamos sistema minimal |
---|
| 1359 | I = minbase(I); |
---|
| 1360 | } |
---|
[fab82ab] | 1361 | // Ya tenemos el ideal generado por la BASE MINIMAL |
---|
[abbd22] | 1362 | n = ncols(I); |
---|
[fab82ab] | 1363 | // La funcion soporte devuelve 0 si el monomio es producto de mas |
---|
| 1364 | // de una variable. Chequeamos generador a generador si el ideal |
---|
| 1365 | // esta generado por potencias de variables. |
---|
| 1366 | for (i = 1 ; i <= n ; i ++) |
---|
[abbd22] | 1367 | { |
---|
| 1368 | if (soporte(I[i]) == 0) |
---|
[fab82ab] | 1369 | { |
---|
[abbd22] | 1370 | return(0); |
---|
[fab82ab] | 1371 | } |
---|
[abbd22] | 1372 | } |
---|
[fab82ab] | 1373 | return (1); |
---|
| 1374 | } |
---|
| 1375 | example |
---|
| 1376 | {"EXAMPLE:"; echo = 2; |
---|
| 1377 | ring R = 0,(w,x,y,z,t),lp; |
---|
| 1378 | ideal I = w^4,x^3,z^2,t^5; |
---|
| 1379 | isirreducibleMon (I); |
---|
| 1380 | ideal J = w^4*x,x^3,z^2,t^5; |
---|
| 1381 | isirreducibleMon (J); |
---|
| 1382 | } |
---|
[28c487] | 1383 | ////////////////////////////////////////////////////////////////////// |
---|
| 1384 | // |
---|
[fab82ab] | 1385 | proc isartinianMon (ideal I) |
---|
[28c487] | 1386 | "USAGE: isartinianMon(I); I ideal. |
---|
[fab82ab] | 1387 | RETURN: 1, if ideal is artinian; 0, otherwise. |
---|
[28c487] | 1388 | (return -1 if ideal I is not a monmomial ideal). |
---|
[fab82ab] | 1389 | ASSUME: I is a monomial ideal of the basering. |
---|
| 1390 | EXAMPLE: example isartinianMon; shows some examples |
---|
| 1391 | " |
---|
| 1392 | { |
---|
[abbd22] | 1393 | int nvar = nvars(basering); |
---|
[fab82ab] | 1394 | // Declaracion de variables |
---|
| 1395 | int i,j,k,cont,sizI; |
---|
| 1396 | intvec v; |
---|
| 1397 | // COMPROBACIONES |
---|
| 1398 | int control = checkIdeal(I); |
---|
| 1399 | // Si el sistema de generadores no esta formado por monomios, hay |
---|
| 1400 | // que comprobar si el ideal es monomial. |
---|
| 1401 | if (control == 0) |
---|
[abbd22] | 1402 | { |
---|
| 1403 | list isMon = isMonomialGB (I); |
---|
| 1404 | if (isMon[1] == 0) |
---|
[fab82ab] | 1405 | { |
---|
[abbd22] | 1406 | ERROR ("the ideal is not monomial."); |
---|
[fab82ab] | 1407 | } |
---|
[abbd22] | 1408 | else |
---|
[fab82ab] | 1409 | { |
---|
[abbd22] | 1410 | I = isMon[2]; |
---|
| 1411 | // Ya lo tenemos con los generadores minimales |
---|
[fab82ab] | 1412 | } |
---|
[abbd22] | 1413 | } |
---|
| 1414 | else |
---|
| 1415 | { |
---|
| 1416 | // Generadores monomiales, hallamos sistema minimal |
---|
| 1417 | I = minbase(I); |
---|
| 1418 | } |
---|
[fab82ab] | 1419 | // Ya tenemos el ideal generado por la BASE MINIMAL |
---|
[abbd22] | 1420 | sizI = ncols(I); |
---|
[fab82ab] | 1421 | // Comprobamos que entre los generadores minimales aparece una |
---|
| 1422 | // potencia de cada. Cuando encontramos un generador que es potencia |
---|
| 1423 | // de una sola variable aumento contador |
---|
| 1424 | cont = 0; |
---|
| 1425 | for (i = 1 ; i <= sizI ; i++) |
---|
[abbd22] | 1426 | { |
---|
| 1427 | if (soporte(I[i]) <> 0) |
---|
[fab82ab] | 1428 | { |
---|
[abbd22] | 1429 | cont ++; |
---|
| 1430 | // Solo volvemos a evaluar en caso de que hayamos aumentado |
---|
| 1431 | if (cont == nvar) |
---|
| 1432 | { |
---|
| 1433 | // Ya hemos encontrado que todas las variables aparrecen en |
---|
| 1434 | // el sistema minimal como potencia pura. No queremos seguir |
---|
| 1435 | // buscando |
---|
| 1436 | return (1); |
---|
| 1437 | } |
---|
[fab82ab] | 1438 | } |
---|
[abbd22] | 1439 | } |
---|
[fab82ab] | 1440 | // Si ha salido, es que faltan variables |
---|
| 1441 | return(0); |
---|
| 1442 | } |
---|
| 1443 | example |
---|
| 1444 | {"EXAMPLE:"; echo = 2; |
---|
| 1445 | ring R = 0,(w,x,y,z,t),lp; |
---|
| 1446 | ideal I = w^4,x^3,y^4,z^2,t^6,w^2*x^2*y,w*z*t^4,x^2*y^3,z^2*t^5; |
---|
| 1447 | isartinianMon (I); |
---|
| 1448 | ideal J = w^4,x^3,y^4,z^2,w^2*x^2*y,w*z*t^4,x^2*y^3,z^2*t^5; |
---|
| 1449 | isartinianMon (J); |
---|
| 1450 | } |
---|
[28c487] | 1451 | ////////////////////////////////////////////////////////////////////// |
---|
| 1452 | // |
---|
[fab82ab] | 1453 | proc isgenericMon (ideal I) |
---|
[28c487] | 1454 | "USAGE: isgenericMon(I); I ideal. |
---|
[fab82ab] | 1455 | RETURN: 1, if ideal is generic; 0, otherwise. |
---|
[28c487] | 1456 | (return -1 if ideal I is not a monomial ideal) |
---|
[fab82ab] | 1457 | ASSUME: I is a monomial ideal of the basering. |
---|
| 1458 | EXAMPLE: example isgenericMon; shows some examples. |
---|
| 1459 | " |
---|
| 1460 | { |
---|
[abbd22] | 1461 | int nvar = nvars(basering); |
---|
[fab82ab] | 1462 | // Declaracion de variables |
---|
| 1463 | int sizI,i,j,k; |
---|
| 1464 | list exp; |
---|
| 1465 | // COMPROBACIONES |
---|
| 1466 | int control = checkIdeal(I); |
---|
| 1467 | // Si el sistema de generadores no esta formado por monomios, hay |
---|
| 1468 | // que comprobar si el ideal es monomial. |
---|
| 1469 | if (control == 0) |
---|
[abbd22] | 1470 | { |
---|
| 1471 | list isMon = isMonomialGB (I); |
---|
| 1472 | if (isMon[1] == 0) |
---|
[fab82ab] | 1473 | { |
---|
[abbd22] | 1474 | ERROR ("the ideal is not monomial."); |
---|
[fab82ab] | 1475 | } |
---|
[abbd22] | 1476 | else |
---|
[fab82ab] | 1477 | { |
---|
[abbd22] | 1478 | I = isMon[2]; |
---|
| 1479 | // Ya lo tenemos con los generadores minimales |
---|
[fab82ab] | 1480 | } |
---|
[abbd22] | 1481 | } |
---|
| 1482 | else |
---|
| 1483 | { |
---|
| 1484 | // Generadores monomiales, hallamos sistema minimal |
---|
| 1485 | I = minbase(I); |
---|
| 1486 | } |
---|
[fab82ab] | 1487 | // Ya tenemos el ideal generado por la BASE MINIMAL |
---|
[abbd22] | 1488 | sizI = ncols(I); |
---|
[fab82ab] | 1489 | // Creamos una lista que tenga los exponentes de todos los |
---|
| 1490 | // generadores. |
---|
| 1491 | for (i = 1 ; i <= sizI ; i++) |
---|
[abbd22] | 1492 | { |
---|
| 1493 | exp[i] = leadexp(I[i]); |
---|
| 1494 | } |
---|
[fab82ab] | 1495 | // Ahora hay que ver si alguno se repite, y si uno de ellos |
---|
| 1496 | // lo hace, ya no es gen?rico. |
---|
| 1497 | for (i = 1 ; i <= nvar ; i++) |
---|
[abbd22] | 1498 | { |
---|
| 1499 | for (j = 1 ; j <= sizI-1 ; j++) |
---|
[fab82ab] | 1500 | { |
---|
[abbd22] | 1501 | for (k = j+1 ; k <= sizI ; k++) |
---|
| 1502 | { |
---|
| 1503 | // Notar que no se pueden repetir si la variable realmente |
---|
| 1504 | // aparece en el generador, es decir, exponente >1. |
---|
| 1505 | if (exp[j][i] == exp[k][i] & exp[j][i] <> 0) |
---|
[fab82ab] | 1506 | { |
---|
[abbd22] | 1507 | return (0); |
---|
[fab82ab] | 1508 | } |
---|
[abbd22] | 1509 | } |
---|
[fab82ab] | 1510 | } |
---|
[abbd22] | 1511 | } |
---|
[fab82ab] | 1512 | return (1); |
---|
| 1513 | } |
---|
| 1514 | example |
---|
| 1515 | {"EXAMPLE:"; echo = 2; |
---|
| 1516 | ring R = 0,(w,x,y,z,t),lp; |
---|
| 1517 | ideal I = w^4,x^3,y^4,z^2,w^2*x^2*y,w*z*t^4,x*y^3,z*t^5; |
---|
| 1518 | isgenericMon (I); |
---|
| 1519 | ideal J = w^4,x^3,y^4,z^3,w^2*x^2*y,w*z*t^4,x*y^3,z^2*t^5; |
---|
| 1520 | isgenericMon (J); |
---|
| 1521 | } |
---|
[28c487] | 1522 | ////////////////////////////////////////////////////////////////////// |
---|
| 1523 | // |
---|
[fab82ab] | 1524 | proc dimMon (ideal I) |
---|
[28c487] | 1525 | "USAGE: dimMon (I); I ideal |
---|
[fab82ab] | 1526 | RETURN: an integer, the dimension of the affine variety defined by |
---|
| 1527 | the ideal I. |
---|
[28c487] | 1528 | (returns -1 if I is not a monomial ideal) |
---|
[fab82ab] | 1529 | ASSUME: I is a monomial ideal of the basering. |
---|
| 1530 | EXAMPLE: example dimMon; shows some examples. |
---|
| 1531 | " |
---|
| 1532 | { |
---|
| 1533 | // El ideal trivial no es monomial. |
---|
| 1534 | if ( size(I) == 0 ) |
---|
[abbd22] | 1535 | { |
---|
| 1536 | ERROR("the ideal is zero, hence not monomial."); |
---|
| 1537 | } |
---|
| 1538 | // VARIABLES |
---|
| 1539 | int control,sizSum,sumandos,i,j,k,cont; |
---|
[fab82ab] | 1540 | // COMPROBACIONES |
---|
| 1541 | control = checkIdeal(I); |
---|
| 1542 | if (control == 0) |
---|
[abbd22] | 1543 | { |
---|
| 1544 | list isMon = isMonomialGB (I); |
---|
| 1545 | if (isMon[1] == 0) |
---|
[fab82ab] | 1546 | { |
---|
[abbd22] | 1547 | ERROR ("the ideal is not monomial."); |
---|
[fab82ab] | 1548 | } |
---|
[abbd22] | 1549 | else |
---|
[fab82ab] | 1550 | { |
---|
[abbd22] | 1551 | // Sabemos que I ya viene dado por el sistema minimal de |
---|
| 1552 | // generadores, aunque aqui no sea necesario. |
---|
| 1553 | I = isMon[2]; |
---|
[fab82ab] | 1554 | } |
---|
[abbd22] | 1555 | } |
---|
| 1556 | attrib(I,"isSB",1); |
---|
| 1557 | return (dim(I)); |
---|
| 1558 | // int nvar = nvars(basering); |
---|
| 1559 | // intvec index,indexAux,vaux,w; |
---|
| 1560 | // list sum, sumAux; |
---|
| 1561 | // // La base del ideal tiene que ser la monomial |
---|
| 1562 | // // Si el ideal es artiniano, es 0-dimensional |
---|
| 1563 | // if (isartinianMon(I) == 1) |
---|
| 1564 | // { |
---|
| 1565 | // return (0); |
---|
| 1566 | // } |
---|
| 1567 | // int sizI = ncols(I); |
---|
| 1568 | // // v(i) = vector con sizI entradas y donde cada entrada "j" se corresponde |
---|
| 1569 | // // con el exponente del generador "i" en la variable "j" |
---|
| 1570 | // for (i = 1 ; i <= nvar ; i++) |
---|
| 1571 | // { |
---|
| 1572 | // intvec v(i); |
---|
| 1573 | // for (j = 1 ; j <= sizI ;j++ ) |
---|
| 1574 | // { |
---|
| 1575 | // v(i)[j] = leadexp(I[j])[i]; |
---|
| 1576 | // } |
---|
| 1577 | // } |
---|
| 1578 | // // Vamos a guardar en el vector "index" la ultima variable que se ha |
---|
| 1579 | // // sumado y en cada "sum(i)" el vector suma que se corresponde con la |
---|
| 1580 | // // entrada "i" del vector index. |
---|
| 1581 | // // Inicializo los valores de index y de cada sum |
---|
| 1582 | // w[sizI] = 0; |
---|
| 1583 | // sum[1] = w; |
---|
| 1584 | // index[1] = 0; |
---|
| 1585 | // sizSum = 1; |
---|
| 1586 | // while ( 1 ) |
---|
| 1587 | // { |
---|
| 1588 | // cont = 1; |
---|
| 1589 | // sumandos ++; |
---|
| 1590 | // for (i = 1 ; i <= sizSum ; i ++) |
---|
| 1591 | // { |
---|
| 1592 | // for (j = index[i] + 1 ; j <= nvar ; j ++) |
---|
| 1593 | // { |
---|
| 1594 | // w = sum[i]; |
---|
| 1595 | // vaux = w + v(j); |
---|
| 1596 | // // Comprobamos |
---|
| 1597 | // for (k = 1 ; k <= sizI ; k ++) |
---|
| 1598 | // { |
---|
| 1599 | // if (vaux[k] == 0) |
---|
| 1600 | // { |
---|
| 1601 | // break; |
---|
| 1602 | // } |
---|
| 1603 | // } |
---|
| 1604 | // if (k == sizI +1) |
---|
| 1605 | // { |
---|
| 1606 | // return (nvar - sumandos); |
---|
| 1607 | // } |
---|
| 1608 | // if (j <> nvar) |
---|
| 1609 | // { |
---|
| 1610 | // sumAux[cont] = vaux; |
---|
| 1611 | // indexAux[cont] = j; |
---|
| 1612 | // cont ++; |
---|
| 1613 | // } |
---|
| 1614 | // } |
---|
| 1615 | // } |
---|
| 1616 | // index = indexAux; |
---|
| 1617 | // sum = sumAux; |
---|
| 1618 | // sizSum = size(sumAux); |
---|
| 1619 | // } |
---|
[fab82ab] | 1620 | } |
---|
| 1621 | example |
---|
| 1622 | {"EXAMPLE:"; echo = 2; |
---|
| 1623 | ring R = 0,(w,x,y,z,t),lp; |
---|
| 1624 | ideal I = w^3*x*y,w*x*y*z*t,x^2*y^2*z^2,x^2*z^4*t^3,y^3*z; |
---|
| 1625 | dimMon (I); |
---|
| 1626 | ideal J = w^4,x^3,y^4,z^2,t^6,w^2*x^2*y,w*z*t^4,x^2*y^3,z*t^5; |
---|
| 1627 | dimMon (J); |
---|
| 1628 | } |
---|
| 1629 | ///////////////////////////////////////////////////////////////////////////// |
---|
| 1630 | //-------------------------------------------------------------------------// |
---|
| 1631 | //----------------------- DESCOMPOSICIONES -----------------------------_// |
---|
| 1632 | //-------------------------------------------------------------------------// |
---|
| 1633 | ///////////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 1634 | // |
---|
[fab82ab] | 1635 | // METODO 1: Metodo directo para descomp. irreducible (ver Vasconcelos) |
---|
| 1636 | // |
---|
| 1637 | ////////////////////////////////////////////////////////////////////// |
---|
| 1638 | // Este procedimiento calcula la descomposicion en irreducibles de // |
---|
| 1639 | // un ideal monomial dado por su base minimal de generadores // |
---|
| 1640 | // haciendo uso de la caracterizacion de ideal monomial irreducible // |
---|
| 1641 | // (Vasconcelos) // |
---|
| 1642 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 1643 | // |
---|
[fab82ab] | 1644 | static proc irredDec1 (ideal I) |
---|
| 1645 | { |
---|
| 1646 | // Variables |
---|
| 1647 | int i,j,n,resp; |
---|
| 1648 | list l1,l2; |
---|
| 1649 | intvec exp,v; |
---|
| 1650 | ideal J,K; |
---|
| 1651 | // ----- DESCOMPOSICION IRREDUCIBLE |
---|
| 1652 | // Inicializamos la lista que va a estar formada por los ideales |
---|
| 1653 | // que tenemos que comprobar son irreducibles. |
---|
| 1654 | I = simplify(I,1); |
---|
| 1655 | l1 = I; |
---|
| 1656 | while (size(l1) > 0) |
---|
[abbd22] | 1657 | { |
---|
| 1658 | for (i = 1 ; i <= size(l1) ; i++) |
---|
| 1659 | { |
---|
| 1660 | J = l1[i]; |
---|
| 1661 | n = ncols(J); |
---|
| 1662 | l1 = delete(l1,i); |
---|
| 1663 | // Llamamos a la funcion que va a detectar si el ideal es o |
---|
| 1664 | // no irreducible, y en caso de no serlo sabemos sobre que |
---|
| 1665 | // generador y con que variables hay que aplicar el |
---|
| 1666 | // el resultado teorico. |
---|
| 1667 | v = irredAux (J); |
---|
| 1668 | // No irreducible |
---|
| 1669 | if (size(v) > 1) |
---|
| 1670 | { |
---|
| 1671 | // En este caso, v[1] nos indica el generador del ideal |
---|
| 1672 | // que debemos eliminar. |
---|
| 1673 | exp = leadexp(J[v[1]]); |
---|
| 1674 | if (v[1] == 1) |
---|
[fab82ab] | 1675 | { |
---|
[abbd22] | 1676 | J = J[2..n]; |
---|
| 1677 | } |
---|
| 1678 | if (v[1] > 1 && v[1] < n) |
---|
| 1679 | { |
---|
| 1680 | J = J[1..v[1]-1],J[v[1]+1..n]; |
---|
| 1681 | } |
---|
| 1682 | if (v[1] == n) |
---|
| 1683 | { |
---|
| 1684 | J = J[1..n-1]; |
---|
| 1685 | } |
---|
| 1686 | // Ahora vamos a introducir los nuevos generadores en |
---|
| 1687 | // cada uno de los nuevos ideales que generamos. Los |
---|
| 1688 | // ponemos en la lista en la que comprobamos. |
---|
| 1689 | for (j = 1 ; j <= size(v)-1 ; j++) |
---|
| 1690 | { |
---|
| 1691 | K = J,var(v[j+1])^exp[v[j+1]]; |
---|
| 1692 | l1 = insert(l1,minbase(K)); |
---|
[fab82ab] | 1693 | } |
---|
[abbd22] | 1694 | } |
---|
| 1695 | // Si v[1]=0, el ideal es irreducible y lo introducimos en |
---|
| 1696 | // la lista l2, que es la que finalmente devolvera las |
---|
| 1697 | // componentes de la descomposicion. |
---|
| 1698 | else |
---|
| 1699 | { |
---|
| 1700 | l2 = insert(l2,J); |
---|
| 1701 | } |
---|
[fab82ab] | 1702 | } |
---|
[abbd22] | 1703 | } |
---|
[fab82ab] | 1704 | // ---- IRREDUNDANTE |
---|
| 1705 | l2 = irredundant (l2); |
---|
| 1706 | // La salida es la lista de los ideales irreducibles. |
---|
| 1707 | return (l2); |
---|
| 1708 | } |
---|
| 1709 | ////////////////////////////////////////////////////////////////////// |
---|
| 1710 | // La siguiente funcion va a obtener una descomposicion primaria // |
---|
| 1711 | // minimal a partir de la irreducible anterior. // |
---|
| 1712 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 1713 | // |
---|
[abbd22] | 1714 | static proc primDec1 (ideal I) |
---|
| 1715 | { |
---|
[fab82ab] | 1716 | // Variables |
---|
| 1717 | list l1,l2; |
---|
| 1718 | // ----- DESCOMPOSICION IRREDUCIBLE |
---|
| 1719 | l1 = irredDec1 (I); |
---|
| 1720 | // ----- DESCOMPOSICION PRIMARIA |
---|
| 1721 | l2 = irredPrimary (l1); |
---|
| 1722 | return (l2); |
---|
| 1723 | } |
---|
[28c487] | 1724 | // |
---|
[fab82ab] | 1725 | // METODO 2: Metodo directo para descomp. primaria (ver Vasconcelos) |
---|
| 1726 | // |
---|
[abbd22] | 1727 | ////////////////////////////////////////////////////////////////////// |
---|
[fab82ab] | 1728 | // La siguiente funcion va a calcular una descomposicion primaria // |
---|
| 1729 | // minimal de un ideal monomial, pero esta vez usando la // |
---|
| 1730 | // caracterizacion de ideal monomial primario y un resultado que // |
---|
| 1731 | // hace uso de esta (Vasconcelos). // |
---|
| 1732 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 1733 | // |
---|
[abbd22] | 1734 | static proc primDec2 (ideal I) |
---|
| 1735 | { |
---|
[fab82ab] | 1736 | // Variables en el nuevo anillo |
---|
| 1737 | int i,n,max; |
---|
| 1738 | list l1,l2; |
---|
| 1739 | intvec v; |
---|
| 1740 | ideal J,K; |
---|
| 1741 | // Vamos a tener dos listas: l1 que va a guardar todos los ideales |
---|
| 1742 | // que vayamos generando con el resultado citado antes, que seran |
---|
| 1743 | // los que vamos a comprobar si son primarios; y l2, donde guardamos |
---|
| 1744 | // aquellos de l1 que verifiquemos son primarios. |
---|
| 1745 | I = simplify(I,1); |
---|
| 1746 | l1 = I; |
---|
| 1747 | while (size(l1) > 0) |
---|
[abbd22] | 1748 | { |
---|
| 1749 | for (i = 1 ; i <= size(l1) ; i++) |
---|
| 1750 | { |
---|
| 1751 | J = l1[i]; |
---|
| 1752 | n = ncols(J); |
---|
| 1753 | l1 = delete (l1,i); |
---|
| 1754 | // Usamos la funcion que hemos creado para saber si el ideal |
---|
| 1755 | // es primario. Si no lo es devuelve la variable que crea |
---|
| 1756 | // conflicto y los generadores del ideal que luego hay que |
---|
| 1757 | // usar (los que tienen productos de mas de una vble). |
---|
| 1758 | // Se le llama con el sistema minimal de generadores |
---|
| 1759 | v = primAux (J); |
---|
| 1760 | // En caso de no ser primario, hay que buscar el maximo |
---|
| 1761 | // exponente de la variable que aparece en los generadores |
---|
| 1762 | // del ideal multiplicada siempre por otras variables, |
---|
| 1763 | // nunca por si misma. |
---|
| 1764 | if (v[1] == 0) |
---|
| 1765 | { |
---|
| 1766 | max = maxExp(J,v); |
---|
| 1767 | K = J,var(v[2])^max; |
---|
| 1768 | l1 = insert (l1,minbase(K)); |
---|
| 1769 | K = quotientIdealMon(J,var(v[2])^max); |
---|
| 1770 | // quotientidealMon devuelve sistema minimal de generadores |
---|
| 1771 | l1 = insert (l1,minbase(K)); |
---|
| 1772 | } |
---|
| 1773 | // En caso de ser primario, lo introducimos en la lista |
---|
| 1774 | // conveniente. |
---|
| 1775 | else |
---|
| 1776 | { |
---|
| 1777 | l2 = insert (l2,J); |
---|
| 1778 | } |
---|
[fab82ab] | 1779 | } |
---|
[abbd22] | 1780 | } |
---|
[fab82ab] | 1781 | // ------ IRREDUNDANTE |
---|
| 1782 | l2 = irredundant (l2); |
---|
| 1783 | return (l2); |
---|
| 1784 | } |
---|
[28c487] | 1785 | // |
---|
[fab82ab] | 1786 | // METODO 3: via dual de Alexander y doble dual (Miller) |
---|
| 1787 | // |
---|
| 1788 | ////////////////////////////////////////////////////////////////////// |
---|
| 1789 | // Esta funcion calcula la descomposicion irreducible usando el // |
---|
| 1790 | // dual de Alexander teniendo en cuenta que el dual del dual es el // |
---|
| 1791 | // ideal de partida (Miller) // |
---|
| 1792 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 1793 | // |
---|
[abbd22] | 1794 | static proc irredDec3 (ideal I) |
---|
| 1795 | { |
---|
[fab82ab] | 1796 | int i,n,j; |
---|
| 1797 | poly lcm; |
---|
| 1798 | intvec v,exp_I,exp; |
---|
| 1799 | ideal J; |
---|
| 1800 | list l; |
---|
| 1801 | // Hallamos el m.c.m. de los generadores minimales del ideal. |
---|
[abbd22] | 1802 | n = ncols (I); |
---|
[fab82ab] | 1803 | lcm = I[1]; |
---|
| 1804 | for ( i = 2 ; i <= n ; i++ ) |
---|
[abbd22] | 1805 | { |
---|
| 1806 | lcm = lcmMon (lcm,I[i]); |
---|
| 1807 | } |
---|
[fab82ab] | 1808 | v = leadexp (lcm); |
---|
| 1809 | // Calculamos el dual de Alexander. |
---|
| 1810 | // Hacemos una funcion para este paso porque luego lo volveremos a |
---|
| 1811 | // utilizar. |
---|
| 1812 | l = alexDif (v,I); |
---|
| 1813 | // Tenemos los ideales irreducibles cuya interseccion nos da el dual |
---|
| 1814 | // de Alexander. Notar que tenemos tantos ideales como generadores |
---|
| 1815 | // minimales tiene I. |
---|
| 1816 | // Hallamos la base minimal. |
---|
| 1817 | J = minbase(intersect(l[1..size(l)])); |
---|
| 1818 | // Ya solo queda el ultimo paso: hallar de nuevo el dual de |
---|
| 1819 | // Alexander. Sabemos que este proceso ya devuelve la descomposicion |
---|
| 1820 | // irreducible irredundante. |
---|
| 1821 | l = alexDif (v,J); |
---|
| 1822 | return (l); |
---|
| 1823 | } |
---|
| 1824 | ////////////////////////////////////////////////////////////////////// |
---|
| 1825 | // En este caso hallamos una descomposicion primaria minimal usando // |
---|
| 1826 | // la irreducible irredundante del procedimiento anterior. // |
---|
| 1827 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 1828 | // |
---|
[abbd22] | 1829 | static proc primDec3 (ideal I) |
---|
| 1830 | { |
---|
[fab82ab] | 1831 | // Variables |
---|
| 1832 | list l1,l2; |
---|
| 1833 | // ----- DESCOMPOSICION IREDUCIBLE |
---|
| 1834 | l1 = irredDec3 (I); |
---|
| 1835 | // ----- DESCOMPOSICION PRIMARIA |
---|
| 1836 | l2 = irredPrimary (l1); |
---|
| 1837 | return (l2); |
---|
| 1838 | } |
---|
[28c487] | 1839 | // |
---|
[fab82ab] | 1840 | // METODO 4: via dual de Alexander y cociente (Miller) |
---|
| 1841 | // |
---|
| 1842 | ////////////////////////////////////////////////////////////////////// |
---|
| 1843 | // Vamos a hallar las componentes irreducibles de un ideal monomial // |
---|
| 1844 | // dado por sus generadores minimales haciendo uso del dual de // |
---|
| 1845 | // Alexander (con el cociente) (Miller) // |
---|
| 1846 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 1847 | // |
---|
[abbd22] | 1848 | static proc irredDec4 (ideal I) |
---|
| 1849 | { |
---|
[fab82ab] | 1850 | // Cambiamos de anillo. |
---|
[abbd22] | 1851 | int nvar = nvars(basering); |
---|
[fab82ab] | 1852 | // Variables |
---|
| 1853 | int n,i,j,m,resp; |
---|
| 1854 | poly lcm; |
---|
| 1855 | intvec v; |
---|
| 1856 | ideal J,K; |
---|
| 1857 | list L; |
---|
| 1858 | // Calculamos el l.c.m. de los generadores minimales del ideal. |
---|
[abbd22] | 1859 | n = ncols (I); |
---|
[fab82ab] | 1860 | lcm = I[1]; |
---|
| 1861 | for ( i = 2 ; i <= n ; i++ ) |
---|
[abbd22] | 1862 | { |
---|
| 1863 | lcm = lcmMon (lcm,I[i]); |
---|
| 1864 | } |
---|
[fab82ab] | 1865 | v = leadexp (lcm); |
---|
| 1866 | // Hallamos el ideal J = (x(1)^(l(1)+1),...,x(n)^(l(n)+1)). Como |
---|
| 1867 | // luego, en el procedimiento quotientMon, vamos a hallar la base |
---|
| 1868 | // minimal de cada ideal, no nos preocupa que tengamos un cero en |
---|
| 1869 | // el ideal J. |
---|
| 1870 | for ( i = 1 ; i <= nvar ; i++ ) |
---|
[abbd22] | 1871 | { |
---|
| 1872 | J[i] = (var(i))^(v[i]+1); |
---|
| 1873 | } |
---|
[fab82ab] | 1874 | // Ahora hacemos el cociente oportuno. |
---|
| 1875 | K = minbase(quotient (J,I)); |
---|
| 1876 | // Buscamos aquellos generadores de K que no son divisibles por los |
---|
| 1877 | // generadores de J. Los generadores que son divisibles los hacemos |
---|
| 1878 | // cero y luego los eliminamos. |
---|
[abbd22] | 1879 | m = ncols (K); |
---|
[fab82ab] | 1880 | for ( i = 1 ; i <= m ; i++ ) |
---|
[abbd22] | 1881 | { |
---|
| 1882 | resp = membershipMon(K[i],J); |
---|
| 1883 | if ( resp == 1) |
---|
[fab82ab] | 1884 | { |
---|
[abbd22] | 1885 | K[i] = 0; |
---|
[fab82ab] | 1886 | } |
---|
[abbd22] | 1887 | } |
---|
[fab82ab] | 1888 | K = simplify (K,2); |
---|
| 1889 | // Ahora obtenemos las componentes de la descomposicion irreducible, |
---|
| 1890 | // que estan en correspondencia con los generadores minimales de K. |
---|
| 1891 | L = alexDif (v,K); |
---|
| 1892 | // Volvemos al anillo de partida y devolvemos la lista de las |
---|
| 1893 | // componentes irreducibles irredundantes. |
---|
| 1894 | return (L); |
---|
| 1895 | } |
---|
| 1896 | ////////////////////////////////////////////////////////////////////// |
---|
| 1897 | // Ahora hallamos una descomposicion primaria irredundante usando // |
---|
| 1898 | // la ultima funcion para hallar las componentes irreducibles de un // |
---|
| 1899 | // ideal monomial dado por sus generadores minimales. // |
---|
| 1900 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 1901 | // |
---|
[abbd22] | 1902 | static proc primDec4 (ideal I) |
---|
| 1903 | { |
---|
[fab82ab] | 1904 | // Variables |
---|
| 1905 | list l1,l2; |
---|
| 1906 | // ----- DESCOMPOSICION IREDUCIBLE |
---|
| 1907 | l1 = irredDec4 (I); |
---|
| 1908 | // ----- DESCOMPOSICION PRIMARIA |
---|
| 1909 | l2 = irredPrimary (l1); |
---|
| 1910 | return (l2); |
---|
| 1911 | } |
---|
[28c487] | 1912 | // |
---|
[fab82ab] | 1913 | // METODO 5: un misterio!! |
---|
| 1914 | // |
---|
| 1915 | ////////////////////////////////////////////////////////////////////// |
---|
| 1916 | // Este procedimiento halla los elementos maximales de la base // |
---|
| 1917 | // estandar del ideal, que se correspoenden con las componentes // |
---|
| 1918 | // irreducibles del ideal 1-1. // |
---|
| 1919 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 1920 | // |
---|
[fab82ab] | 1921 | static proc irredDec5 (ideal I) |
---|
| 1922 | { |
---|
[abbd22] | 1923 | int nvar = nvars(basering); |
---|
[fab82ab] | 1924 | //Variables |
---|
| 1925 | int i,j; |
---|
| 1926 | ideal K; |
---|
| 1927 | // Artinianization |
---|
| 1928 | list artiniano = artinian (I); |
---|
| 1929 | if (artiniano[1] == 0) |
---|
[abbd22] | 1930 | { |
---|
| 1931 | I = artiniano[2]; |
---|
| 1932 | intvec elimina = artiniano[3]; |
---|
| 1933 | } |
---|
[fab82ab] | 1934 | // Quotient |
---|
[abbd22] | 1935 | ideal M = maxideal(1); |
---|
[fab82ab] | 1936 | ideal J = quotient (I,M); |
---|
| 1937 | // Deleting generators lying in I |
---|
[abbd22] | 1938 | for (i = 1 ; i <= ncols(J) ; i ++) |
---|
| 1939 | { |
---|
| 1940 | if (membershipMon(J[i],I) == 1) |
---|
[fab82ab] | 1941 | { |
---|
[abbd22] | 1942 | if (i == 1) |
---|
| 1943 | { |
---|
| 1944 | J = J[2..ncols(J)]; |
---|
| 1945 | i --; |
---|
| 1946 | } |
---|
| 1947 | else |
---|
| 1948 | { |
---|
| 1949 | if (i == ncols(J)) |
---|
[fab82ab] | 1950 | { |
---|
[abbd22] | 1951 | J = J[1..i-1]; |
---|
| 1952 | i --; |
---|
| 1953 | } |
---|
| 1954 | else |
---|
| 1955 | { |
---|
| 1956 | J = J[1..i-1],J[i+1..ncols(J)]; |
---|
| 1957 | i --; |
---|
[fab82ab] | 1958 | } |
---|
[abbd22] | 1959 | } |
---|
[fab82ab] | 1960 | } |
---|
[abbd22] | 1961 | } |
---|
[fab82ab] | 1962 | // Exponents of the ideals are going to form the decomposition |
---|
[abbd22] | 1963 | int sizJ = ncols(J); |
---|
[fab82ab] | 1964 | for (i = 1 ; i <= sizJ ; i ++ ) |
---|
[abbd22] | 1965 | { |
---|
| 1966 | intvec exp(i) = leadexp(J[i]) + 1; |
---|
| 1967 | } |
---|
[fab82ab] | 1968 | // Deleting artinianization process |
---|
| 1969 | if (artiniano[1] == 0) |
---|
[abbd22] | 1970 | { |
---|
| 1971 | // En elimina estan guardadas las variables que hay que eliminar |
---|
| 1972 | for (i = 1 ; i <= nvar ; i ++) |
---|
| 1973 | { |
---|
| 1974 | if (elimina[i] <> 0) |
---|
| 1975 | { |
---|
| 1976 | for (j = 1 ; j <= sizJ ; j ++) |
---|
| 1977 | { |
---|
| 1978 | if (exp(j)[i] == elimina[i]) |
---|
| 1979 | { |
---|
| 1980 | exp(j)[i] = 0; |
---|
| 1981 | } |
---|
| 1982 | } |
---|
| 1983 | } |
---|
| 1984 | } |
---|
| 1985 | } |
---|
[fab82ab] | 1986 | // En exp(i) tengo los exponentes de cada variable de las que aparecen |
---|
| 1987 | // en cada ideal. |
---|
| 1988 | list facets; |
---|
| 1989 | for (i = 1 ; i <= sizJ ; i ++) |
---|
[abbd22] | 1990 | { |
---|
| 1991 | J = 0; |
---|
| 1992 | for (j = 1 ; j <= nvar ; j ++) |
---|
[fab82ab] | 1993 | { |
---|
[abbd22] | 1994 | if (exp(i)[j] <> 0) |
---|
| 1995 | { |
---|
| 1996 | J = J,var(j)^exp(i)[j]; |
---|
| 1997 | } |
---|
[fab82ab] | 1998 | } |
---|
[abbd22] | 1999 | J = simplify(J,2); |
---|
| 2000 | facets[i] = J; |
---|
| 2001 | } |
---|
[fab82ab] | 2002 | return (facets); |
---|
| 2003 | } |
---|
| 2004 | ////////////////////////////////////////////////////////////////////// |
---|
| 2005 | // Ahora hallamos una descomposicion primaria irredundante usando // |
---|
| 2006 | // la ultima funcion para hallar las componentes irreducibles de un // |
---|
| 2007 | // ideal monomial dado por sus generadores minimales. // |
---|
| 2008 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 2009 | // |
---|
[abbd22] | 2010 | static proc primDec5 (ideal I) |
---|
| 2011 | { |
---|
[fab82ab] | 2012 | // Variables |
---|
| 2013 | list l1,l2; |
---|
| 2014 | // ----- IRREDUCIBLE DECOMPOSITION |
---|
| 2015 | l1 = irredDec5 (I); |
---|
| 2016 | // ----- PRIMARY DECOMPOSITION |
---|
| 2017 | l2 = irredPrimary (l1); |
---|
| 2018 | return (l2); |
---|
| 2019 | } |
---|
[28c487] | 2020 | // |
---|
[fab82ab] | 2021 | // METODO 6: via complejo de Scarf (Milovsky) |
---|
| 2022 | // |
---|
| 2023 | ////////////////////////////////////////////////////////////////////// |
---|
| 2024 | // Metodo que usa el complejo de Scarf asociado a un ideal monomial // |
---|
| 2025 | // de k[x(1)..x(n)] (Milowski) // |
---|
| 2026 | ////////////////////////////////////////////////////////////////////// |
---|
| 2027 | ////////////////////////////////////////////////////////////////////// |
---|
| 2028 | // Calcula el maximo exponente de la variable x(i) entre los // |
---|
| 2029 | // generadores del ideal. // |
---|
| 2030 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 2031 | // |
---|
[fab82ab] | 2032 | static proc maximoExp(ideal I,int i) |
---|
| 2033 | { |
---|
| 2034 | // VARIABLES |
---|
| 2035 | int max,j,k,sizI; |
---|
| 2036 | intvec exp; |
---|
[abbd22] | 2037 | sizI = ncols(I); |
---|
[fab82ab] | 2038 | max = 0; |
---|
| 2039 | for (j = 1 ; j <= sizI ; j ++) |
---|
[abbd22] | 2040 | { |
---|
| 2041 | exp = leadexp(I[j]); |
---|
| 2042 | if ( exp[i] > max) |
---|
[fab82ab] | 2043 | { |
---|
[abbd22] | 2044 | max = exp[i]; |
---|
[fab82ab] | 2045 | } |
---|
[abbd22] | 2046 | } |
---|
[fab82ab] | 2047 | return(max); |
---|
| 2048 | } |
---|
| 2049 | ////////////////////////////////////////////////////////////////////// |
---|
| 2050 | // Esta funcion estudia si un ideal monomial dado por su sistema // |
---|
| 2051 | // minimal de generadores es o no artiniano. En caso de no serlo, // |
---|
| 2052 | // halla el artiniano mas proximo y ademas devuelve los generadores // |
---|
| 2053 | // que han sido introducidos. // |
---|
| 2054 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 2055 | // |
---|
[fab82ab] | 2056 | static proc artinian (ideal I) |
---|
| 2057 | { |
---|
| 2058 | // Cambiamos de anillo |
---|
[abbd22] | 2059 | int nvar = nvars(basering); |
---|
[fab82ab] | 2060 | // Declaracion de variables |
---|
| 2061 | int i,j,k,cont1,cont2,sizI,marcavar,max; |
---|
| 2062 | intvec v,variablesin,cambio; |
---|
| 2063 | list nuevo; |
---|
| 2064 | ideal J; |
---|
[abbd22] | 2065 | sizI = ncols(I); |
---|
[fab82ab] | 2066 | // Comprobamos que entre los generadores minimales aparece una |
---|
| 2067 | // potencia de cada |
---|
| 2068 | cont2 = 0; |
---|
| 2069 | for (i = 1 ; i <= sizI ; i++) |
---|
[abbd22] | 2070 | { |
---|
| 2071 | v = leadexp(I[i]); |
---|
| 2072 | marcavar = 0; |
---|
| 2073 | cont1 = 0; |
---|
| 2074 | for (j = 1 ; j <= nvar ; j++) |
---|
[fab82ab] | 2075 | { |
---|
[abbd22] | 2076 | if (v[j] <> 0) |
---|
| 2077 | { |
---|
| 2078 | cont1 ++; |
---|
| 2079 | marcavar = j; |
---|
| 2080 | } |
---|
| 2081 | } |
---|
| 2082 | // Si cont1=1 hemos encontrado un generador de los que nos |
---|
| 2083 | // interesa."variablesin" guarda el indice de las que estan. |
---|
| 2084 | if (cont1 == 1) |
---|
| 2085 | { |
---|
| 2086 | cont2 ++; |
---|
| 2087 | variablesin[cont2] = marcavar; |
---|
[fab82ab] | 2088 | } |
---|
[abbd22] | 2089 | } |
---|
[fab82ab] | 2090 | // Notar que como el sistema de generadores es minimal no se |
---|
| 2091 | // va a repetir la potencia de la misma variable. Por tanto basta |
---|
| 2092 | // comprobar si cont2 es o no nvar. |
---|
| 2093 | if (cont2 == nvar) |
---|
[abbd22] | 2094 | { |
---|
| 2095 | list output; |
---|
| 2096 | output[1] = 1; |
---|
| 2097 | return(output); |
---|
| 2098 | } |
---|
| 2099 | else |
---|
| 2100 | { |
---|
| 2101 | J = I; |
---|
| 2102 | // Buscamos las que no estan |
---|
| 2103 | if (cont2 == 0) |
---|
[fab82ab] | 2104 | { |
---|
[abbd22] | 2105 | for (i = 1 ; i <= nvar ; i ++) |
---|
| 2106 | { |
---|
| 2107 | max = maximoExp(I,i); |
---|
| 2108 | cambio[i] = max + 1; |
---|
| 2109 | J = J,var(i)^(max + 1); |
---|
| 2110 | } |
---|
[fab82ab] | 2111 | } |
---|
[abbd22] | 2112 | else |
---|
[fab82ab] | 2113 | { |
---|
[abbd22] | 2114 | for (i = 1 ; i <= nvar ; i++) |
---|
| 2115 | { |
---|
| 2116 | for (j = 1 ; j <= cont2 ; j ++) |
---|
[fab82ab] | 2117 | { |
---|
[abbd22] | 2118 | if (i == variablesin[j]) |
---|
| 2119 | { |
---|
| 2120 | cambio[i] = 0; |
---|
| 2121 | break; |
---|
| 2122 | } |
---|
[fab82ab] | 2123 | } |
---|
[abbd22] | 2124 | if (j == cont2 + 1) |
---|
[fab82ab] | 2125 | { |
---|
[abbd22] | 2126 | max = maximoExp(I,i); |
---|
| 2127 | cambio[i] = max + 1; |
---|
| 2128 | J = J,var(i)^(max + 1); |
---|
[fab82ab] | 2129 | } |
---|
[abbd22] | 2130 | } |
---|
[fab82ab] | 2131 | } |
---|
[abbd22] | 2132 | list output; |
---|
| 2133 | output[1] = 0; |
---|
| 2134 | output[2] = J; |
---|
| 2135 | output[3] = cambio; |
---|
| 2136 | return(output); |
---|
| 2137 | } |
---|
[fab82ab] | 2138 | } |
---|
| 2139 | ////////////////////////////////////////////////////////////////////// |
---|
| 2140 | // En este caso vamos primero a chequear si el ideal es o no // |
---|
| 2141 | // generico y en caso de no serlo vamos a devolver los cambios, // |
---|
| 2142 | // pues estos son una aplicacion biyectiva. // |
---|
| 2143 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 2144 | // |
---|
[fab82ab] | 2145 | static proc generic (ideal I) |
---|
| 2146 | { |
---|
| 2147 | // New ring |
---|
[abbd22] | 2148 | int nvar = nvars(basering); |
---|
[fab82ab] | 2149 | // VARIABLES |
---|
| 2150 | int i,j,k; |
---|
| 2151 | // Cargamos la matriz con los exponentes |
---|
[abbd22] | 2152 | int sizI = ncols(I); |
---|
[fab82ab] | 2153 | intmat EXP[sizI][nvar]; |
---|
| 2154 | for (i = 1 ; i <= sizI ; i ++) |
---|
[abbd22] | 2155 | { |
---|
| 2156 | // Ordenamos el vector de exponentes oportuno |
---|
| 2157 | EXP[i,1..nvar] = leadexp(I[i]); |
---|
| 2158 | } |
---|
[fab82ab] | 2159 | |
---|
| 2160 | // Ahora tenemos que ordenarla segun la variable que este en conficto. |
---|
| 2161 | intvec vari,change; |
---|
| 2162 | intmat NEWEXP = EXP; |
---|
| 2163 | list aux; |
---|
| 2164 | int count = 0; |
---|
| 2165 | for (i = 1 ; i <= nvar ; i ++) |
---|
[abbd22] | 2166 | { |
---|
| 2167 | // Buscamos conflicto en la variable x(i), para ello tengo que ordenar |
---|
| 2168 | // la columna i de EXP |
---|
| 2169 | vari = EXP[1..sizI,i]; |
---|
| 2170 | aux = sort(vari); |
---|
| 2171 | vari = aux[1]; |
---|
| 2172 | change = aux[2]; |
---|
| 2173 | for (j = 1 ; j <= sizI - 1 ; j ++) |
---|
| 2174 | { |
---|
| 2175 | if (vari[j] > 0) |
---|
| 2176 | { |
---|
| 2177 | while (NEWEXP[change[j + count] , i] >= vari[j + 1 + count]) |
---|
[fab82ab] | 2178 | { |
---|
[abbd22] | 2179 | NEWEXP[change[j + 1 + count] , i] = NEWEXP[change[j + count] , i] + 1; |
---|
| 2180 | count ++; |
---|
| 2181 | if (j + 1 + count > sizI) |
---|
| 2182 | { |
---|
| 2183 | break; |
---|
| 2184 | } |
---|
[fab82ab] | 2185 | } |
---|
[abbd22] | 2186 | } |
---|
| 2187 | j = j + count; |
---|
| 2188 | count = 0; |
---|
[fab82ab] | 2189 | } |
---|
[abbd22] | 2190 | } |
---|
[fab82ab] | 2191 | // Devolvemos tambien la matriz, pues aqui tengo la biyeccion entre los exponentes |
---|
| 2192 | if (EXP == NEWEXP) |
---|
[abbd22] | 2193 | { |
---|
| 2194 | return (1,I); |
---|
| 2195 | } |
---|
[fab82ab] | 2196 | else |
---|
[abbd22] | 2197 | { |
---|
| 2198 | // Hallamos el ideal con los nuevos exponentes |
---|
| 2199 | intvec expI; |
---|
| 2200 | for (i = 1 ; i <= sizI ; i ++) |
---|
[fab82ab] | 2201 | { |
---|
[abbd22] | 2202 | expI = NEWEXP[i,1..nvar]; |
---|
| 2203 | I[i] = monomial(expI); |
---|
[fab82ab] | 2204 | } |
---|
[abbd22] | 2205 | return(0,I,EXP,NEWEXP); |
---|
| 2206 | } |
---|
[fab82ab] | 2207 | } |
---|
| 2208 | ////////////////////////////////////////////////////////////////////// |
---|
| 2209 | // Esta funci?n obtiene una descomposicion irreducible del ideal // |
---|
| 2210 | // monomial a partir de la descomposicion irreducible del idal // |
---|
| 2211 | // generico que le asociamos. // |
---|
| 2212 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 2213 | // |
---|
[fab82ab] | 2214 | static proc nonGeneric (EXP,NEWEXP,Faces,sizI) |
---|
| 2215 | { |
---|
[abbd22] | 2216 | int nvar = nvars(basering); |
---|
[fab82ab] | 2217 | int sizFaces = size(Faces); |
---|
| 2218 | // Variables |
---|
| 2219 | int i,j,k; |
---|
| 2220 | // Vamos variable a variable |
---|
| 2221 | intvec exp, newexp; |
---|
| 2222 | list newFaces; |
---|
| 2223 | newFaces = Faces; |
---|
| 2224 | for (i = 1 ; i <= nvar ; i ++) |
---|
[abbd22] | 2225 | { |
---|
| 2226 | // comparamos las matrices de exponentes por columnas |
---|
| 2227 | exp = EXP[1..sizI,i]; |
---|
| 2228 | newexp = NEWEXP[1..sizI,i]; |
---|
| 2229 | if (exp <> newexp) |
---|
[fab82ab] | 2230 | { |
---|
[abbd22] | 2231 | for (j = 1 ; j <= sizI ; j ++) |
---|
| 2232 | { |
---|
| 2233 | if (exp[j] <> newexp[j]) |
---|
[fab82ab] | 2234 | { |
---|
[abbd22] | 2235 | for (k = 1 ; k <= sizFaces ; k ++) |
---|
| 2236 | { |
---|
| 2237 | if (Faces[k][i] == newexp[j]) |
---|
[fab82ab] | 2238 | { |
---|
[abbd22] | 2239 | newFaces[k][i] = exp[j]; |
---|
[fab82ab] | 2240 | } |
---|
[abbd22] | 2241 | } |
---|
[fab82ab] | 2242 | } |
---|
[abbd22] | 2243 | } |
---|
[fab82ab] | 2244 | } |
---|
[abbd22] | 2245 | } |
---|
[fab82ab] | 2246 | return (newFaces); |
---|
| 2247 | } |
---|
| 2248 | ////////////////////////////////////////////////////////////////////// |
---|
| 2249 | // Este procedimiento va a dar una faceta inicial para el complejo // |
---|
| 2250 | // de Scarf asociado a I, donde I es un ideal monomial artiniano // |
---|
| 2251 | // y generico (evidentemente I dado por la bse minimal) // |
---|
| 2252 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 2253 | // |
---|
[fab82ab] | 2254 | static proc initialFacet (ideal I) |
---|
| 2255 | { |
---|
| 2256 | // Cambiamos de anillo |
---|
| 2257 | // Queremos usar x(1)..x(n) como variables. |
---|
[abbd22] | 2258 | int nvar = nvars(basering); |
---|
[fab82ab] | 2259 | // Declaracion de variables. |
---|
| 2260 | int i,sizJ,j,max,aux,sizK,l, elim; |
---|
| 2261 | intvec v; |
---|
| 2262 | list face; |
---|
| 2263 | // Hacemos una copia de I pues ahora modificaremos el sistema |
---|
| 2264 | // de generadores. |
---|
| 2265 | ideal J = I; |
---|
[abbd22] | 2266 | sizJ = ncols(J); |
---|
[fab82ab] | 2267 | // Para cada variable buscamos el maximo exponente, teniendo en |
---|
| 2268 | // cuenta que un mismo generador no puede dar dos exponentes. |
---|
| 2269 | // Vamos a guardar los exponentes en "expIni" |
---|
| 2270 | intvec expIni; |
---|
| 2271 | for (i = 1 ; i <= nvar ; i++) |
---|
[abbd22] | 2272 | { |
---|
| 2273 | max = 0; |
---|
| 2274 | for (j = 1 ; j <= sizJ ; j++) |
---|
[fab82ab] | 2275 | { |
---|
[abbd22] | 2276 | aux = leadexp(J[j])[i]; |
---|
| 2277 | if (aux > max) |
---|
| 2278 | { |
---|
| 2279 | max = aux; |
---|
| 2280 | elim = j; |
---|
| 2281 | } |
---|
| 2282 | } |
---|
| 2283 | // Guardamos el exponente |
---|
| 2284 | expIni[i] = max; |
---|
| 2285 | // Ahora tenemos el maximo de la variable x(i), por lo que |
---|
| 2286 | // eliminamos el generador en el que la encontramos. |
---|
| 2287 | // Si queda un generador no hay nada que hacer |
---|
| 2288 | if (sizJ <> 1) |
---|
| 2289 | { |
---|
| 2290 | if (elim <> 1 & elim <> sizJ) |
---|
| 2291 | { |
---|
| 2292 | J = J[1..elim-1],J[elim+1..sizJ]; |
---|
| 2293 | } |
---|
| 2294 | else |
---|
| 2295 | { |
---|
| 2296 | if (elim == 1) |
---|
[fab82ab] | 2297 | { |
---|
[abbd22] | 2298 | J = J[2..sizJ]; |
---|
[fab82ab] | 2299 | } |
---|
[abbd22] | 2300 | else |
---|
[fab82ab] | 2301 | { |
---|
[abbd22] | 2302 | J = J[1..sizJ-1]; |
---|
[fab82ab] | 2303 | } |
---|
[abbd22] | 2304 | } |
---|
| 2305 | sizJ = ncols(J); |
---|
| 2306 | // Eliminamos la variable x(i) en todos los generadores. |
---|
| 2307 | for (j = 1 ; j <= sizJ ; j++) |
---|
| 2308 | { |
---|
| 2309 | v = leadexp(J[j]); |
---|
| 2310 | if (v [i] <> 0) |
---|
| 2311 | { |
---|
| 2312 | v[i] = 0; |
---|
| 2313 | J[j] = monomial(v); |
---|
| 2314 | } |
---|
| 2315 | } |
---|
| 2316 | // Hallamos el sistema minimal de generadores que |
---|
| 2317 | // corresponde al ideal que nos ha quedado. |
---|
| 2318 | J = minbase(J); |
---|
| 2319 | sizJ = ncols(J); |
---|
| 2320 | } |
---|
| 2321 | } |
---|
| 2322 | // En expIni tenemos los exponentes de los monomios que dan la cara |
---|
| 2323 | // inicial, ahora hay que buscar en el ideal original a que |
---|
[fab82ab] | 2324 | // generador se corresponde (el ideal es generico) |
---|
[abbd22] | 2325 | int sizI = ncols(I); |
---|
[fab82ab] | 2326 | for (i = 1 ; i <= nvar ; i ++) |
---|
[abbd22] | 2327 | { |
---|
| 2328 | for (j = 1 ; j <= sizI ; j ++) |
---|
[fab82ab] | 2329 | { |
---|
[abbd22] | 2330 | if (expIni[i] == leadexp(I[j])[i]) |
---|
| 2331 | { |
---|
| 2332 | face = insert(face, I[j]); |
---|
| 2333 | // Si lo encontramos buscamos el siguiente |
---|
| 2334 | break; |
---|
| 2335 | } |
---|
[fab82ab] | 2336 | } |
---|
[abbd22] | 2337 | } |
---|
[fab82ab] | 2338 | return (face); |
---|
| 2339 | } |
---|
| 2340 | ////////////////////////////////////////////////////////////////////// |
---|
| 2341 | // La funcion que sigue devuelve las facetas adyacentes a una dada // |
---|
| 2342 | // en el complejo de Scarf asociado a I. // |
---|
| 2343 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 2344 | // |
---|
[fab82ab] | 2345 | static proc adyacency (list l1, ideal I) |
---|
| 2346 | { |
---|
| 2347 | // Cambiamos de anillo |
---|
| 2348 | // Queremos usar x(1)..x(n) como variables. |
---|
[abbd22] | 2349 | int nvar = nvars(basering); |
---|
[fab82ab] | 2350 | // Declaracion de variables. |
---|
| 2351 | int i,j,cambio,sizI,k,min,m,generador,max; |
---|
| 2352 | list l2,newl1,w,expI; |
---|
| 2353 | poly LCM,newLCM; |
---|
| 2354 | intvec v,newv,expgen; |
---|
[abbd22] | 2355 | sizI = ncols(I); |
---|
[fab82ab] | 2356 | // Hallamos el lcm de los elementos, e. d., la faceta del |
---|
| 2357 | // complejo para luego comparar con los nuevos |
---|
| 2358 | LCM = 1; |
---|
| 2359 | for (i = 1 ; i <= nvar ; i++) |
---|
[abbd22] | 2360 | { |
---|
| 2361 | LCM = lcmMon(LCM,l1[i]); |
---|
| 2362 | } |
---|
[fab82ab] | 2363 | v = leadexp(LCM); |
---|
| 2364 | // Calculo los exponentes de los monomios de I |
---|
| 2365 | for (i = 1 ; i <= sizI ; i++) |
---|
[abbd22] | 2366 | { |
---|
| 2367 | expI[i] = leadexp(I[i]); |
---|
| 2368 | } |
---|
[fab82ab] | 2369 | // Hay que quitar cada elemento de la lista y comprobar si hay o no |
---|
| 2370 | // cara adyacente al simplice que queda, y en caso de haberla, la |
---|
| 2371 | // calculamos. |
---|
| 2372 | for (i = 1 ; i <= nvar ; i++) |
---|
[abbd22] | 2373 | { |
---|
| 2374 | newl1 = delete(l1,i); |
---|
| 2375 | // Hallamos el lcm de los elementos que hay en la nueva lista. |
---|
| 2376 | newLCM = 1; |
---|
| 2377 | for (j = 1 ; j <= nvar - 1 ; j++) |
---|
[fab82ab] | 2378 | { |
---|
[abbd22] | 2379 | newLCM = lcmMon(newLCM,newl1[j]); |
---|
| 2380 | } |
---|
| 2381 | // Ahora hay que detectar si alguna variable ha desaparecido |
---|
| 2382 | // en este LCM. |
---|
| 2383 | newv = leadexp(newLCM); |
---|
| 2384 | for (j = 1 ; j <= nvar ; j++) |
---|
| 2385 | { |
---|
| 2386 | if (newv[j] == 0) |
---|
| 2387 | { |
---|
| 2388 | l2[i] = 0; |
---|
| 2389 | break; |
---|
| 2390 | } |
---|
| 2391 | } |
---|
| 2392 | if (j == nvar+1) |
---|
| 2393 | { |
---|
| 2394 | // Si no ha habido ceros, queremos hallar la cara adyacente, |
---|
| 2395 | // es decir, buscar un generador que introducido en l1 de una |
---|
| 2396 | // faceta del complejo. |
---|
| 2397 | // Comparamos los lcm entre s?, para comprobar en que variable |
---|
| 2398 | // contribu?a el monomio que hemos eliminado. |
---|
| 2399 | for (j = 1 ; j <= nvar ; j++) |
---|
| 2400 | { |
---|
| 2401 | if (v[j] <> newv[j]) |
---|
| 2402 | { |
---|
| 2403 | cambio = j; |
---|
| 2404 | // Una vez encontrado no hay mas |
---|
| 2405 | break; |
---|
| 2406 | } |
---|
| 2407 | } |
---|
| 2408 | // Hallamos los exponentes de los monomios que quedan |
---|
| 2409 | // para ver cual da el exponente en "newv" |
---|
[fab82ab] | 2410 | for (j = 1 ; j <= nvar - 1 ; j++) |
---|
[abbd22] | 2411 | { |
---|
| 2412 | w[j] = leadexp(newl1[j]); |
---|
| 2413 | } |
---|
| 2414 | for (j = 1 ; j <= nvar ; j++) |
---|
| 2415 | { |
---|
| 2416 | for (k = 1 ; k <= nvar - 1 ; k++) |
---|
| 2417 | { |
---|
| 2418 | if (newv[cambio] == w[k][cambio]) |
---|
| 2419 | { |
---|
| 2420 | cambio = k; |
---|
| 2421 | break; |
---|
| 2422 | } |
---|
| 2423 | } |
---|
| 2424 | // Si no termino el for con k es que hemos encontrado ya |
---|
| 2425 | // los que son iguales. |
---|
| 2426 | if (k <> nvar) |
---|
[fab82ab] | 2427 | { |
---|
[abbd22] | 2428 | break; |
---|
[fab82ab] | 2429 | } |
---|
[abbd22] | 2430 | } |
---|
| 2431 | |
---|
| 2432 | // Donde contribuye antes, e.d., en "v" |
---|
[fab82ab] | 2433 | for (j = 1 ; j <= nvar ; j++) |
---|
[abbd22] | 2434 | { |
---|
| 2435 | if (w[cambio][j] == v[j]) |
---|
[fab82ab] | 2436 | { |
---|
[abbd22] | 2437 | cambio = j; |
---|
| 2438 | break; |
---|
[fab82ab] | 2439 | } |
---|
[abbd22] | 2440 | } |
---|
| 2441 | // Ahora ya buscamos entre los generadores el nuevo monomio. |
---|
| 2442 | // Ponemos de tope para encontrar el minimo el maximo de |
---|
| 2443 | // las variables en el ideal |
---|
| 2444 | max = 0; |
---|
| 2445 | for (m = 1 ; m <= sizI ; m ++) |
---|
| 2446 | { |
---|
| 2447 | if (expI[m][cambio] > max) |
---|
[fab82ab] | 2448 | { |
---|
[abbd22] | 2449 | max = expI[m][cambio]; |
---|
| 2450 | } |
---|
| 2451 | } |
---|
| 2452 | min = max; |
---|
| 2453 | for (j = 1 ; j <= sizI ; j++) |
---|
| 2454 | { |
---|
| 2455 | for (k = 1 ; k <= nvar ; k ++) |
---|
| 2456 | { |
---|
| 2457 | if (I[j] == l1[k]) |
---|
| 2458 | { |
---|
| 2459 | break; |
---|
| 2460 | } |
---|
| 2461 | } |
---|
| 2462 | // El generador no esta en la lista, es de los que hay que |
---|
| 2463 | // comprobar |
---|
| 2464 | if (k == nvar +1) |
---|
| 2465 | { |
---|
| 2466 | for (m = 1 ; m <= nvar ; m++) |
---|
| 2467 | { |
---|
| 2468 | if (m <> cambio) |
---|
[fab82ab] | 2469 | { |
---|
[abbd22] | 2470 | if (expI[j][m] > newv[m]) |
---|
| 2471 | { |
---|
| 2472 | break; |
---|
| 2473 | } |
---|
[fab82ab] | 2474 | } |
---|
[abbd22] | 2475 | else |
---|
[fab82ab] | 2476 | { |
---|
[abbd22] | 2477 | if (expI[j][m] <= newv[m]) |
---|
| 2478 | { |
---|
| 2479 | break; |
---|
| 2480 | } |
---|
[fab82ab] | 2481 | } |
---|
[abbd22] | 2482 | } |
---|
| 2483 | // Si termina el bucle cumple las condiciones |
---|
| 2484 | // oportunas, solo hay que comparar con el |
---|
| 2485 | // otro que tengamos. |
---|
| 2486 | if (m == nvar + 1) |
---|
| 2487 | { |
---|
| 2488 | if (expI[j][cambio] <= min) |
---|
[fab82ab] | 2489 | { |
---|
[abbd22] | 2490 | min = expI[j][cambio]; |
---|
| 2491 | generador = j; |
---|
[fab82ab] | 2492 | } |
---|
[abbd22] | 2493 | } |
---|
[fab82ab] | 2494 | } |
---|
[abbd22] | 2495 | } |
---|
| 2496 | // En la lista ponemos en el lugar "i" el generador que |
---|
| 2497 | // hay que introducir cuando eliminamos el generador |
---|
| 2498 | // "i" de la lista de entrada. |
---|
| 2499 | l2[i] = I[generador]; |
---|
[fab82ab] | 2500 | } |
---|
[abbd22] | 2501 | } |
---|
[fab82ab] | 2502 | return(l2); |
---|
| 2503 | } |
---|
| 2504 | ////////////////////////////////////////////////////////////////////// |
---|
| 2505 | // Metodo que calcula la descomposicion irreducible de un ideal // |
---|
| 2506 | // monomial usando el complejo de Scarf (Milowski) // |
---|
| 2507 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 2508 | // |
---|
[fab82ab] | 2509 | static proc ScarfMethod (ideal I) |
---|
| 2510 | { |
---|
| 2511 | // Cambiamos de anillo |
---|
| 2512 | // Queremos usar x(1)..x(n) como variables. |
---|
[abbd22] | 2513 | int nvar = nvars(basering); |
---|
[fab82ab] | 2514 | // Sabemos que dp siempre es mejor para trabajar, auqque luego para |
---|
| 2515 | // comparar I y genI vamos a cambiarlo al lexicografico. |
---|
| 2516 | // Variables |
---|
| 2517 | int i,j,k,sizl1,sizl,cont1,cont2; |
---|
| 2518 | int sizI; |
---|
| 2519 | list auxl,expl1,l1,l,l2,newLCM,expI,expgenI,Faces; |
---|
| 2520 | poly LCM,mon; |
---|
| 2521 | intvec v,w,betas; |
---|
| 2522 | ideal J,genI,artgenI; |
---|
| 2523 | // Comprobamos si el ideal es generico y artiniano, y, en caso de |
---|
| 2524 | // no serlo, obtenemos una modificacion de este ideal que si |
---|
| 2525 | // verifique estas propiedades |
---|
| 2526 | list genericlist = generic(I); |
---|
| 2527 | if (genericlist[1] == 0) |
---|
[abbd22] | 2528 | { |
---|
| 2529 | genI = genericlist[2]; |
---|
| 2530 | } |
---|
[fab82ab] | 2531 | else |
---|
[abbd22] | 2532 | { |
---|
| 2533 | genI = I; |
---|
| 2534 | } |
---|
[fab82ab] | 2535 | list artinianization = artinian (genI); |
---|
| 2536 | if (artinianization[1] == 0) |
---|
[abbd22] | 2537 | { |
---|
| 2538 | artgenI = artinianization[2]; |
---|
| 2539 | } |
---|
[fab82ab] | 2540 | else |
---|
[abbd22] | 2541 | { |
---|
| 2542 | artgenI = genI; |
---|
| 2543 | } |
---|
[fab82ab] | 2544 | // Una vez tenemos el ideal artiniano y generico, podemos hallar |
---|
| 2545 | // el complejo de Scarf asociado al ideal modificado |
---|
| 2546 | |
---|
| 2547 | // Hay que obtener una cara inicial del ideal. |
---|
| 2548 | list initial = initialFacet(artgenI); |
---|
| 2549 | // Ahora de cada cara que tengamos en una lista obtenemos sus |
---|
| 2550 | // caras adyacentes. Hay que tener en cuenta que si una cara la |
---|
| 2551 | // obtengo como adyacente de otra, cuando calculemos sus adyacentes |
---|
| 2552 | // sale la anterior, luego hay que evitar repetir. |
---|
| 2553 | // Guardamos la primera faceta, su LCM |
---|
| 2554 | LCM = 1; |
---|
| 2555 | for (i = 1 ; i <= nvar ; i++) |
---|
[abbd22] | 2556 | { |
---|
| 2557 | mon = initial[i]; |
---|
| 2558 | LCM = lcmMon(LCM,mon); |
---|
| 2559 | } |
---|
[fab82ab] | 2560 | v = leadexp(LCM); |
---|
| 2561 | // Guardamos la primera faceta |
---|
| 2562 | Faces[1] = v; |
---|
| 2563 | int sizfaces = 1; |
---|
| 2564 | // Lista de monomios que dan las facetas para hallar sus caras |
---|
| 2565 | // adyacentes |
---|
| 2566 | l[1] = initial; |
---|
| 2567 | sizl = 1; |
---|
| 2568 | // Ahora hayamos las posibles caras maximales adyacentes |
---|
| 2569 | while (sizl <> 0) |
---|
[abbd22] | 2570 | { |
---|
| 2571 | // Hallamos la lista de monomios que hay que introducir |
---|
| 2572 | // cuando eliminamos cada monomio. |
---|
| 2573 | auxl = adyacency(l[1],artgenI); |
---|
| 2574 | cont1 = 1; |
---|
| 2575 | cont2 = 0; |
---|
| 2576 | l1 = 0; |
---|
| 2577 | for (j = 1 ; j <= nvar ; j++) |
---|
| 2578 | { |
---|
| 2579 | if (auxl[j] <> 0) |
---|
| 2580 | { |
---|
| 2581 | l2 = delete(l[1],j); |
---|
| 2582 | l1[cont1] = insert(l2,auxl[j],cont1 + cont2 - 1); |
---|
| 2583 | cont1 ++; |
---|
| 2584 | } |
---|
| 2585 | else |
---|
| 2586 | { |
---|
| 2587 | cont2 ++; |
---|
| 2588 | } |
---|
| 2589 | } |
---|
| 2590 | // Hallamos los nuevos LCM |
---|
| 2591 | sizl1 = size(l1); |
---|
| 2592 | for (i = 1 ; i <= sizl1 ; i++) |
---|
[fab82ab] | 2593 | { |
---|
[abbd22] | 2594 | newLCM[i] = 1; |
---|
[fab82ab] | 2595 | for (j = 1 ; j <= nvar ; j++) |
---|
| 2596 | { |
---|
[abbd22] | 2597 | newLCM[i] = lcmMon(newLCM[i],l1[i][j]); |
---|
[fab82ab] | 2598 | } |
---|
[abbd22] | 2599 | expl1[i] = leadexp(newLCM[i]); |
---|
| 2600 | } |
---|
| 2601 | // Hallamos los LCM de las nuevas caras y eliminamos las que |
---|
| 2602 | // ya esten en la lista Faces |
---|
| 2603 | cont1 = 0; |
---|
| 2604 | cont2 = 0; |
---|
| 2605 | for (i = 1 ; i <= sizl1 ; i++) |
---|
| 2606 | { |
---|
| 2607 | for (j = 1 ; j <= sizfaces ; j++) |
---|
| 2608 | { |
---|
| 2609 | v = expl1[i]; |
---|
| 2610 | w = Faces[j]; |
---|
| 2611 | if (v == w) |
---|
[fab82ab] | 2612 | { |
---|
[abbd22] | 2613 | // Si ya esta el LCM en la lista, no queremos |
---|
| 2614 | // seguir buscando |
---|
| 2615 | break; |
---|
[fab82ab] | 2616 | } |
---|
[abbd22] | 2617 | } |
---|
| 2618 | // Si no ha salido del bucle en "j" es que este LCM |
---|
| 2619 | // no esta en la lista de las caras, la introducimos |
---|
| 2620 | if (j == sizfaces + 1) |
---|
| 2621 | { |
---|
| 2622 | Faces = insert(Faces,expl1[i],sizfaces + cont1); |
---|
| 2623 | l = insert(l,l1[i]); |
---|
| 2624 | cont1 ++; |
---|
| 2625 | } |
---|
[fab82ab] | 2626 | } |
---|
[abbd22] | 2627 | l = delete(l,cont1 + 1); |
---|
| 2628 | sizl = size(l); |
---|
| 2629 | sizfaces = size(Faces); |
---|
| 2630 | } |
---|
[fab82ab] | 2631 | // En "Faces" ya tengo los exponentes que luego seran los exponentes |
---|
| 2632 | // de los ideales que forman la descomposicion. |
---|
| 2633 | // Deshacemos la artinianizacion |
---|
| 2634 | intvec elimin = artinianization[3]; |
---|
| 2635 | if (artinianization[1] == 0) |
---|
[abbd22] | 2636 | { |
---|
| 2637 | // En elimina tenemos las variables que hemos introducido |
---|
| 2638 | // y cual es la potencia |
---|
| 2639 | // Solo miro las que tengan cambio |
---|
| 2640 | for (i = 1 ; i <= nvar ; i ++) |
---|
| 2641 | { |
---|
| 2642 | if (elimin[i] <> 0) |
---|
| 2643 | { |
---|
| 2644 | for (j = 1 ; j <= sizfaces ; j ++) |
---|
| 2645 | { |
---|
| 2646 | if (Faces[j][i] == elimin[i]) |
---|
| 2647 | { |
---|
| 2648 | Faces[j][i] = 0; |
---|
| 2649 | } |
---|
| 2650 | } |
---|
| 2651 | } |
---|
| 2652 | } |
---|
| 2653 | } |
---|
[fab82ab] | 2654 | // Generico |
---|
[28c487] | 2655 | sizI = size(I); |
---|
[fab82ab] | 2656 | if (genericlist[1] == 0) |
---|
[abbd22] | 2657 | { |
---|
| 2658 | Faces = nonGeneric(genericlist[3],genericlist[4],Faces,sizI); |
---|
| 2659 | } |
---|
[fab82ab] | 2660 | // Ya tenemos en Faces los exponentes de las componentes |
---|
| 2661 | // ahora solo hay que obtener los ideales. |
---|
[abbd22] | 2662 | for (i = 1 ; i <= sizfaces ; i ++) |
---|
| 2663 | { |
---|
| 2664 | J = 0; |
---|
| 2665 | for (j = 1 ; j <= nvar ; j ++) |
---|
[fab82ab] | 2666 | { |
---|
[abbd22] | 2667 | if (Faces[i][j] <> 0) |
---|
| 2668 | { |
---|
| 2669 | J = J,var(j)^(Faces[i][j]); |
---|
| 2670 | } |
---|
[fab82ab] | 2671 | } |
---|
[abbd22] | 2672 | J = simplify(J,2); |
---|
| 2673 | Faces[i] = J; |
---|
| 2674 | } |
---|
| 2675 | // Esta es la parte LENTA computacionalmente si el ideal de partida |
---|
| 2676 | // no es generico |
---|
| 2677 | if (genericlist[1] == 0) |
---|
| 2678 | { |
---|
| 2679 | Faces = irredundant(Faces); |
---|
| 2680 | } |
---|
| 2681 | return(Faces); |
---|
[fab82ab] | 2682 | } |
---|
| 2683 | ////////////////////////////////////////////////////////////////////// |
---|
| 2684 | // Devuelve una descomposicion primaria minimal de un ideal // |
---|
| 2685 | // monomial via el complejo de Scarf. // |
---|
| 2686 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 2687 | // |
---|
[fab82ab] | 2688 | static proc scarfMethodPrim (ideal I) |
---|
| 2689 | { |
---|
| 2690 | // VARIABLES |
---|
| 2691 | list l1,l2; |
---|
| 2692 | // Hallamos la despomposicion irreducible del ideal dado usando |
---|
| 2693 | // el complejo de Scarf |
---|
| 2694 | l1 = ScarfMethod (I); |
---|
| 2695 | // ----- DESCOMPOSICION PRIMARIA |
---|
| 2696 | l2 = irredPrimary (l1); |
---|
| 2697 | return (l2); |
---|
| 2698 | } |
---|
[28c487] | 2699 | // |
---|
[fab82ab] | 2700 | // METODO 7: algoritmo de etiquetas (Roune) |
---|
| 2701 | // |
---|
| 2702 | ////////////////////////////////////////////////////////////////////// |
---|
| 2703 | // Las siguientes funciones calculan la descomposicion en // |
---|
| 2704 | // irreducibles de un ideal monomial. En este caso utilizamos el // |
---|
| 2705 | // algoritmo de etiquetas de B. Roune. // |
---|
| 2706 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 2707 | // |
---|
[fab82ab] | 2708 | static proc phi (list F) |
---|
| 2709 | { |
---|
| 2710 | // Cambiamos de anillo |
---|
[abbd22] | 2711 | int nvar = nvars(basering); |
---|
[fab82ab] | 2712 | // Variables |
---|
| 2713 | int sizF,i,j; |
---|
| 2714 | poly f; |
---|
| 2715 | list listphi; |
---|
| 2716 | intvec exp,newexp; |
---|
| 2717 | // F es una lista de pares, que indica una x(i) etiqueta de una |
---|
| 2718 | // cara del ideal. Suponemos que F tiene ordenados sus elementos |
---|
| 2719 | // segun las x(i) |
---|
| 2720 | sizF = size(F); |
---|
| 2721 | for (i = 1 ; i <= sizF ; i ++) |
---|
[abbd22] | 2722 | { |
---|
| 2723 | f = F[i]; |
---|
| 2724 | exp = leadexp(f); |
---|
| 2725 | for (j = 1 ; j <= nvar ; j ++) |
---|
[fab82ab] | 2726 | { |
---|
[abbd22] | 2727 | if (j <> i) |
---|
| 2728 | { |
---|
| 2729 | exp[j] = exp[j] + 1; |
---|
| 2730 | } |
---|
[fab82ab] | 2731 | } |
---|
[abbd22] | 2732 | listphi[i] = monomial(exp); |
---|
| 2733 | } |
---|
[fab82ab] | 2734 | // Ya tenemos la lista de los monomios a los que |
---|
| 2735 | // luego haremos el "lcm" |
---|
| 2736 | return (listphi); |
---|
| 2737 | } |
---|
[28c487] | 2738 | ////////////////////////////////////////////////////////////////////// |
---|
| 2739 | // |
---|
[fab82ab] | 2740 | static proc pi(poly f) |
---|
| 2741 | { |
---|
| 2742 | // Cambiamos de anillo |
---|
[abbd22] | 2743 | int nvar = nvars(basering); |
---|
[fab82ab] | 2744 | int i,sizI; |
---|
| 2745 | intvec exp; |
---|
| 2746 | exp = leadexp(f); |
---|
[abbd22] | 2747 | for (i = nvar ; i > 0 ; i --) |
---|
| 2748 | { |
---|
| 2749 | if (exp[i] <> 0) |
---|
[fab82ab] | 2750 | { |
---|
[abbd22] | 2751 | exp[i] = exp[i] - 1; |
---|
[fab82ab] | 2752 | } |
---|
[abbd22] | 2753 | } |
---|
[fab82ab] | 2754 | f = monomial(exp); |
---|
| 2755 | return (f); |
---|
| 2756 | } |
---|
[28c487] | 2757 | ////////////////////////////////////////////////////////////////////// |
---|
| 2758 | // |
---|
[fab82ab] | 2759 | static proc conditionComplex (intvec posActual,ideal I,ideal S) |
---|
| 2760 | { |
---|
[abbd22] | 2761 | int nvar = nvars(basering); |
---|
[fab82ab] | 2762 | // VARIABLES |
---|
| 2763 | int i,nuevo; |
---|
| 2764 | list F; |
---|
| 2765 | // Vemos cual ha sido la ultima incorporacion al ideal, que es el |
---|
| 2766 | // ultimo dentro de posActual que es distinto de 0. |
---|
| 2767 | for (i = 1 ; i <= nvar ; i ++) |
---|
[abbd22] | 2768 | { |
---|
| 2769 | if (posActual[i] == 0) |
---|
[fab82ab] | 2770 | { |
---|
[abbd22] | 2771 | break; |
---|
[fab82ab] | 2772 | } |
---|
[abbd22] | 2773 | } |
---|
[fab82ab] | 2774 | nuevo = i - 1; |
---|
| 2775 | // No se pueden repetir generadores, se mira que el ultimo que se ha |
---|
[abbd22] | 2776 | // ha introducido no sea de los que ya tenemos |
---|
[fab82ab] | 2777 | for (i = 1 ; i <= nuevo - 1 ; i ++) |
---|
[abbd22] | 2778 | { |
---|
| 2779 | if (posActual[i] == posActual[nuevo]) |
---|
[fab82ab] | 2780 | { |
---|
[abbd22] | 2781 | return (0); |
---|
[fab82ab] | 2782 | } |
---|
[abbd22] | 2783 | } |
---|
[fab82ab] | 2784 | // Vemos si la variable oportuna divide al generador |
---|
| 2785 | if (leadexp(I[i]) == 0) |
---|
[abbd22] | 2786 | { |
---|
| 2787 | return (0); |
---|
| 2788 | } |
---|
[fab82ab] | 2789 | // Caso de que el LCM sea multiplo de los que ya tenemos |
---|
| 2790 | poly LCM = 1; |
---|
| 2791 | for (i = 1 ; i <= nuevo ; i ++) |
---|
[abbd22] | 2792 | { |
---|
| 2793 | F = insert (F,I[posActual[i]],size(F)); |
---|
| 2794 | } |
---|
[fab82ab] | 2795 | list phiF = phi(F); |
---|
| 2796 | for (i = 1 ; i <= nuevo ; i ++) |
---|
[abbd22] | 2797 | { |
---|
| 2798 | LCM = lcmMon(phiF[i],LCM); |
---|
| 2799 | } |
---|
[fab82ab] | 2800 | // Comprobamos si ya tenemos algun divisor del actual |
---|
| 2801 | if (membershipMon(LCM,S) == 1) |
---|
[abbd22] | 2802 | { |
---|
| 2803 | return (0); |
---|
| 2804 | } |
---|
[fab82ab] | 2805 | // Ahora vemos si la lista esta en el complejo simplicial |
---|
| 2806 | if (membershipMon(LCM,I) == 1) |
---|
[abbd22] | 2807 | { |
---|
| 2808 | if (membershipMon(pi(LCM),I) == 0) |
---|
[fab82ab] | 2809 | { |
---|
[abbd22] | 2810 | return (1,LCM); |
---|
[fab82ab] | 2811 | } |
---|
[abbd22] | 2812 | } |
---|
[fab82ab] | 2813 | return (0); |
---|
| 2814 | } |
---|
[28c487] | 2815 | ////////////////////////////////////////////////////////////////////// |
---|
| 2816 | // |
---|
[fab82ab] | 2817 | static proc findFaces (ideal I) |
---|
| 2818 | { |
---|
[abbd22] | 2819 | int nvar = nvars(basering); |
---|
[fab82ab] | 2820 | // Variables |
---|
| 2821 | int i; |
---|
| 2822 | ideal S; |
---|
| 2823 | list condiciones; |
---|
| 2824 | // Inicializamos valores |
---|
| 2825 | list F; |
---|
| 2826 | intvec posActual; |
---|
| 2827 | posActual[nvar] = 0; |
---|
| 2828 | |
---|
| 2829 | int variable = 1; |
---|
[abbd22] | 2830 | int sizI = ncols(I); |
---|
[fab82ab] | 2831 | while (1) |
---|
[abbd22] | 2832 | { |
---|
| 2833 | while (posActual[variable] == sizI) |
---|
[fab82ab] | 2834 | { |
---|
[abbd22] | 2835 | posActual[variable] = 0; |
---|
| 2836 | variable --; |
---|
[fab82ab] | 2837 | if (variable == 0) |
---|
[abbd22] | 2838 | { |
---|
| 2839 | break; |
---|
| 2840 | } |
---|
[fab82ab] | 2841 | } |
---|
[abbd22] | 2842 | // Comprobamos si hemos recorrido todas las posibilidades. Si |
---|
| 2843 | // es as?, terminamos el while |
---|
| 2844 | if (variable == 0) |
---|
| 2845 | { |
---|
| 2846 | break; |
---|
| 2847 | } |
---|
| 2848 | posActual[variable] = posActual[variable] + 1; |
---|
| 2849 | // Comprobamos las condiciones para saber si los generadores que |
---|
| 2850 | // tenemos est?n o no en el complejo. |
---|
| 2851 | condiciones = conditionComplex (posActual,I,S); |
---|
| 2852 | |
---|
| 2853 | if (condiciones[1] == 1 ) |
---|
| 2854 | { |
---|
| 2855 | if (posActual[nvar] <> 0) |
---|
| 2856 | { |
---|
| 2857 | S = S,condiciones[2]; |
---|
| 2858 | F = insert (F,condiciones[2]); |
---|
| 2859 | } |
---|
| 2860 | if (variable < nvar) |
---|
| 2861 | { |
---|
| 2862 | variable ++; |
---|
| 2863 | } |
---|
| 2864 | } |
---|
| 2865 | } |
---|
| 2866 | return (F); |
---|
[fab82ab] | 2867 | } |
---|
| 2868 | ////////////////////////////////////////////////////////////////////// |
---|
| 2869 | // La siguiente funcion calcula la descomposicion en irreducibles de// |
---|
| 2870 | // un ideal monomial artininano usando el algoritmo de etiquetas del// |
---|
| 2871 | // metodo de Bjarke Roune. // |
---|
| 2872 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 2873 | // |
---|
[fab82ab] | 2874 | static proc labelAlgorithm(ideal I) |
---|
| 2875 | { |
---|
[abbd22] | 2876 | int nvar = nvars(basering); |
---|
[fab82ab] | 2877 | |
---|
| 2878 | // Variables |
---|
| 2879 | int i,j,sizComponents; |
---|
| 2880 | list components; |
---|
| 2881 | // El ideal tiene que ser artininano, si no lo es hacemos el cambio |
---|
| 2882 | // oportuno para que lo sea (luego se deshace). |
---|
| 2883 | ideal artI; |
---|
| 2884 | list artiniano = artinian (I); |
---|
| 2885 | if (artiniano[1] == 0) |
---|
[abbd22] | 2886 | { |
---|
| 2887 | artI = artiniano[2]; |
---|
| 2888 | intvec elimina = artiniano[3]; |
---|
| 2889 | } |
---|
[fab82ab] | 2890 | else |
---|
[abbd22] | 2891 | { |
---|
| 2892 | artI = I; |
---|
| 2893 | } |
---|
[fab82ab] | 2894 | // Llamamos a findFaces para que encuentre las caras maximales del |
---|
| 2895 | // complejo asociado al ideal |
---|
| 2896 | components = findFaces(artI); |
---|
| 2897 | sizComponents = size(components); |
---|
| 2898 | list expComponents; |
---|
| 2899 | poly f; |
---|
| 2900 | for (i = 1 ; i <= sizComponents ; i ++) |
---|
[abbd22] | 2901 | { |
---|
| 2902 | f = components[i]; |
---|
| 2903 | expComponents[i] = leadexp(f); |
---|
| 2904 | } |
---|
[fab82ab] | 2905 | // Deshacemos la artinianizacion |
---|
| 2906 | if (artiniano[1] == 0) |
---|
[abbd22] | 2907 | { |
---|
| 2908 | // En elimina tenemos las variables que hemos introducido |
---|
| 2909 | // y cual es la potencia |
---|
| 2910 | // Solo miro las que tengan cambio |
---|
| 2911 | for (i = 1 ; i <= nvar ; i ++) |
---|
| 2912 | { |
---|
| 2913 | if (elimina[i] <> 0) |
---|
| 2914 | { |
---|
| 2915 | for (j = 1 ; j <= sizComponents ; j ++) |
---|
| 2916 | { |
---|
| 2917 | if (expComponents[j][i] == elimina[i]) |
---|
| 2918 | { |
---|
| 2919 | expComponents[j][i] = 0; |
---|
| 2920 | } |
---|
| 2921 | } |
---|
| 2922 | } |
---|
| 2923 | } |
---|
| 2924 | } |
---|
[fab82ab] | 2925 | // En exp(i) tengo los exponentes de cada variable de las que aparecen |
---|
| 2926 | // en cada ideal. |
---|
| 2927 | ideal J; |
---|
| 2928 | list facets; |
---|
| 2929 | for (i = 1 ; i <= sizComponents ; i ++) |
---|
[abbd22] | 2930 | { |
---|
| 2931 | J = 0; |
---|
| 2932 | for (j = 1 ; j <= nvar ; j ++) |
---|
[fab82ab] | 2933 | { |
---|
[abbd22] | 2934 | if (expComponents[i][j] <> 0) |
---|
| 2935 | { |
---|
| 2936 | J = J,var(j)^expComponents[i][j]; |
---|
| 2937 | } |
---|
[fab82ab] | 2938 | } |
---|
[abbd22] | 2939 | J = simplify(J,2); |
---|
| 2940 | facets[i] = J; |
---|
| 2941 | } |
---|
[fab82ab] | 2942 | return (facets); |
---|
| 2943 | } |
---|
| 2944 | ////////////////////////////////////////////////////////////////////// |
---|
| 2945 | // Devuelve una descomposicion primaria minimal de un ideal monomial// |
---|
| 2946 | // dado. // |
---|
| 2947 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 2948 | // |
---|
| 2949 | static proc labelAlgPrim (ideal I) |
---|
[fab82ab] | 2950 | { |
---|
| 2951 | // VARIABLES |
---|
| 2952 | list l1,l2; |
---|
| 2953 | // Hallamos la despomposicion irreducible del ideal dado usando |
---|
| 2954 | // el complejo de Scarf |
---|
| 2955 | l1 = labelAlgorithm (I); |
---|
| 2956 | // ----- DESCOMPOSICION PRIMARIA |
---|
| 2957 | l2 = irredPrimary (l1); |
---|
| 2958 | return (l2); |
---|
| 2959 | } |
---|
[28c487] | 2960 | // |
---|
[fab82ab] | 2961 | // METODO 8: Gao-Zhu |
---|
| 2962 | // |
---|
| 2963 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 2964 | // |
---|
[fab82ab] | 2965 | static proc divide (intvec v, intvec w, int k) |
---|
| 2966 | { |
---|
[abbd22] | 2967 | int nvar = nvars(basering); |
---|
[fab82ab] | 2968 | // Variables |
---|
| 2969 | int i; |
---|
[abbd22] | 2970 | for (i = nvar ; i > 0 ; i --) |
---|
| 2971 | { |
---|
| 2972 | if (i == k) |
---|
[fab82ab] | 2973 | { |
---|
[abbd22] | 2974 | if (v[i] <> w[i]) |
---|
| 2975 | { |
---|
| 2976 | return (0); |
---|
| 2977 | } |
---|
| 2978 | } |
---|
| 2979 | else |
---|
| 2980 | { |
---|
| 2981 | if (v[i] >= w[i]) |
---|
| 2982 | { |
---|
| 2983 | return (0); |
---|
| 2984 | } |
---|
[fab82ab] | 2985 | } |
---|
[abbd22] | 2986 | } |
---|
[fab82ab] | 2987 | return (1); |
---|
| 2988 | } |
---|
[28c487] | 2989 | ////////////////////////////////////////////////////////////////////// |
---|
| 2990 | // // |
---|
| 2991 | ////////////////////////////////////////////////////////////////////// |
---|
| 2992 | // |
---|
[fab82ab] | 2993 | static proc incrementalAlg (ideal I) |
---|
| 2994 | { |
---|
[abbd22] | 2995 | int nvar = nvars(basering); |
---|
[fab82ab] | 2996 | // COMPROBACIONES |
---|
| 2997 | // Variables |
---|
| 2998 | int i,sop,j,k,l,m,cont,cont2; |
---|
| 2999 | intvec beta,dbeta,betaaux,elimina; |
---|
| 3000 | // El ideal tiene que ser artininano, si no lo es hacemos el cambio |
---|
| 3001 | // oportuno para que lo sea (luego se deshace). |
---|
| 3002 | list artiniano = artinian (I); |
---|
| 3003 | ideal artI; |
---|
| 3004 | if (artiniano[1] == 0) |
---|
[abbd22] | 3005 | { |
---|
| 3006 | artI = artiniano[2]; |
---|
| 3007 | elimina = artiniano[3]; |
---|
| 3008 | } |
---|
[fab82ab] | 3009 | else |
---|
[abbd22] | 3010 | { |
---|
| 3011 | artI = I; |
---|
| 3012 | elimina[nvar] = 0; |
---|
| 3013 | } |
---|
[fab82ab] | 3014 | // Buscamos la primera componente irreducible o, lo que es lo |
---|
| 3015 | // mismo, aquellos generadores que son potencia de una variable. |
---|
| 3016 | // Si el tama?o de elimina es nvar es que hemos a?adido todos los |
---|
| 3017 | // generadores que son potencia luego estar?n todos al final del |
---|
| 3018 | // ideal. |
---|
| 3019 | list MinI,componentes; |
---|
[abbd22] | 3020 | int sizartI = ncols(artI); |
---|
[fab82ab] | 3021 | int sizelimina = size(elimina); |
---|
| 3022 | for (i = 1 ; i <= nvar ; i ++) |
---|
[abbd22] | 3023 | { |
---|
| 3024 | if (elimina[i] == 0) |
---|
[fab82ab] | 3025 | { |
---|
[abbd22] | 3026 | // Buscamos en el ideal los generadores que nos interesan |
---|
| 3027 | for (j = 1 ; j <= sizartI ; j ++) |
---|
| 3028 | { |
---|
| 3029 | sop = soporte(artI[j]); |
---|
| 3030 | if (sop <> 0) |
---|
[fab82ab] | 3031 | { |
---|
[abbd22] | 3032 | beta[sop] = leadexp(artI[j])[sop]; |
---|
| 3033 | MinI = insert(MinI,leadexp(artI[j])); |
---|
| 3034 | if (j <> 1 and j <> sizartI) |
---|
| 3035 | { |
---|
| 3036 | artI = artI[1..j - 1],artI[j + 1..sizartI]; |
---|
| 3037 | } |
---|
| 3038 | else |
---|
| 3039 | { |
---|
| 3040 | if (j == 1) |
---|
[fab82ab] | 3041 | { |
---|
[abbd22] | 3042 | artI = artI[2..sizartI]; |
---|
[fab82ab] | 3043 | } |
---|
[abbd22] | 3044 | else |
---|
[fab82ab] | 3045 | { |
---|
| 3046 | artI = artI[1..sizartI - 1]; |
---|
| 3047 | } |
---|
[abbd22] | 3048 | } |
---|
| 3049 | sizartI = ncols(artI); |
---|
| 3050 | break; |
---|
[fab82ab] | 3051 | } |
---|
[abbd22] | 3052 | } |
---|
| 3053 | } |
---|
| 3054 | else |
---|
| 3055 | { |
---|
| 3056 | // Buscamos la que esta al final |
---|
| 3057 | sop = soporte(artI[sizartI]); |
---|
| 3058 | beta[sop] = leadexp(artI[sizartI])[sop]; |
---|
| 3059 | MinI = insert(MinI,leadexp(artI[sizartI])); |
---|
| 3060 | if (sizartI <> 1) |
---|
| 3061 | { |
---|
| 3062 | artI = artI[1..sizartI - 1]; |
---|
| 3063 | } |
---|
| 3064 | else |
---|
| 3065 | { |
---|
| 3066 | artI = artI[1]; |
---|
| 3067 | } |
---|
| 3068 | sizartI = ncols(artI); |
---|
[fab82ab] | 3069 | } |
---|
[abbd22] | 3070 | } |
---|
[fab82ab] | 3071 | // En beta tenemos la primera componente |
---|
| 3072 | componentes = insert(componentes,beta); |
---|
| 3073 | int sizcomponents = size(componentes); |
---|
| 3074 | int sizMin = size(MinI); |
---|
| 3075 | // Es mas facil trabajar con los exponentes para nuestro objetivo |
---|
| 3076 | // Se elige un nuevo generador, que en nuestro caso es un nuevo |
---|
| 3077 | // exponente. |
---|
| 3078 | int min,max; |
---|
| 3079 | intvec expartI; |
---|
| 3080 | for(i = 1 ; i <= sizartI ; i ++) |
---|
[abbd22] | 3081 | { |
---|
| 3082 | expartI = leadexp(artI[1]); |
---|
[28c487] | 3083 | if (size(artI) <> 1) |
---|
[abbd22] | 3084 | { |
---|
[28c487] | 3085 | artI = artI[2..size(artI)]; |
---|
[abbd22] | 3086 | } |
---|
| 3087 | // Hay que distinguir T_1 y T_2. Para ello se comparar vectores |
---|
| 3088 | // de la lista actual de generadores con el que se acaba de |
---|
| 3089 | // introducir. |
---|
| 3090 | cont2 = 0; |
---|
| 3091 | for (j = 1 ; j <= sizcomponents ; j ++) |
---|
[fab82ab] | 3092 | { |
---|
[abbd22] | 3093 | beta = componentes[1 + cont2]; |
---|
| 3094 | // Si el nuevo generador divide a la componente beta, hay |
---|
| 3095 | // que buscar las nuevas componentes |
---|
| 3096 | for (k = 1 ; k <= nvar ; k ++) |
---|
| 3097 | { |
---|
| 3098 | if (expartI[k] >= beta[k]) |
---|
[fab82ab] | 3099 | { |
---|
[abbd22] | 3100 | break; |
---|
[fab82ab] | 3101 | } |
---|
[abbd22] | 3102 | } |
---|
| 3103 | // Si el bucle anterior termino, divide y hay que hacer |
---|
| 3104 | // los cambios. |
---|
| 3105 | if (k == nvar + 1) |
---|
| 3106 | { |
---|
| 3107 | componentes = delete (componentes,1 + cont2); |
---|
| 3108 | // Buscamos las nuevas componentes calculando las |
---|
| 3109 | // distancias. Para cada variable busco d(beta,k,l) |
---|
| 3110 | for (k = 1 ; k <= nvar ; k ++) |
---|
[fab82ab] | 3111 | { |
---|
[abbd22] | 3112 | betaaux = beta; |
---|
| 3113 | max = -1; |
---|
| 3114 | cont = 0; |
---|
| 3115 | dbeta = 0; |
---|
| 3116 | for (l = 1 ; l <= nvar ; l ++) |
---|
| 3117 | { |
---|
| 3118 | if (l <> k) |
---|
| 3119 | { |
---|
| 3120 | min = 32767; |
---|
| 3121 | cont ++; |
---|
| 3122 | for (m = 1 ; m <= sizMin ; m ++) |
---|
| 3123 | { |
---|
| 3124 | // Estos son de los buenos |
---|
| 3125 | if (divide(MinI[m],beta,l) == 1) |
---|
[fab82ab] | 3126 | { |
---|
[abbd22] | 3127 | if (MinI[m][k] < min) |
---|
| 3128 | { |
---|
| 3129 | min = MinI[m][k]; |
---|
| 3130 | } |
---|
[fab82ab] | 3131 | } |
---|
[abbd22] | 3132 | } |
---|
| 3133 | dbeta[cont] = min; |
---|
[fab82ab] | 3134 | } |
---|
[abbd22] | 3135 | } |
---|
| 3136 | // Aqui ya tenemos d(beta,k,l) para cada k |
---|
| 3137 | // Hallamos el maximo cuando terminemos |
---|
| 3138 | for (l = 1 ; l <= cont ; l ++) |
---|
| 3139 | { |
---|
| 3140 | if (dbeta[l] > max) |
---|
[fab82ab] | 3141 | { |
---|
[abbd22] | 3142 | max = dbeta[l]; |
---|
[fab82ab] | 3143 | } |
---|
[abbd22] | 3144 | } |
---|
| 3145 | // Condicion para introducir nueva componente |
---|
| 3146 | if (max < expartI[k]) |
---|
| 3147 | { |
---|
| 3148 | betaaux[k] = expartI[k]; |
---|
| 3149 | componentes = insert(componentes,betaaux,size(componentes)); |
---|
| 3150 | } |
---|
[fab82ab] | 3151 | } |
---|
[abbd22] | 3152 | } |
---|
| 3153 | else |
---|
| 3154 | { |
---|
| 3155 | cont2 ++; |
---|
| 3156 | } |
---|
[fab82ab] | 3157 | } |
---|
[abbd22] | 3158 | MinI = insert(MinI,expartI); |
---|
| 3159 | sizMin = size(MinI); |
---|
| 3160 | sizcomponents = size(componentes); |
---|
| 3161 | } |
---|
[fab82ab] | 3162 | // Deahacer los cambios de artiniano si se han hecho |
---|
| 3163 | if (artiniano[1] == 0) |
---|
[abbd22] | 3164 | { |
---|
| 3165 | // En elimina tenemos las variables que hemos introducido |
---|
| 3166 | // y cual es la potencia |
---|
| 3167 | // Solo miro las que tengan cambio |
---|
| 3168 | for (i = 1 ; i <= nvar ; i ++) |
---|
| 3169 | { |
---|
| 3170 | if (elimina[i] <> 0) |
---|
| 3171 | { |
---|
| 3172 | for (j = 1 ; j <= sizcomponents ; j ++) |
---|
| 3173 | { |
---|
| 3174 | if (componentes[j][i] == elimina[i]) |
---|
| 3175 | { |
---|
| 3176 | componentes[j][i] = 0; |
---|
| 3177 | } |
---|
| 3178 | } |
---|
| 3179 | } |
---|
| 3180 | } |
---|
| 3181 | } |
---|
[fab82ab] | 3182 | // En exp(i) tengo los exponentes de cada variable de las que aparecen |
---|
| 3183 | // en cada ideal. |
---|
| 3184 | ideal J; |
---|
| 3185 | list facets; |
---|
| 3186 | for (i = 1 ; i <= sizcomponents ; i ++) |
---|
[abbd22] | 3187 | { |
---|
| 3188 | J = 0; |
---|
| 3189 | for (j = 1 ; j <= nvar ; j ++) |
---|
[fab82ab] | 3190 | { |
---|
[abbd22] | 3191 | if (componentes[i][j] <> 0) |
---|
| 3192 | { |
---|
| 3193 | J = J,var(j)^componentes[i][j]; |
---|
| 3194 | } |
---|
[fab82ab] | 3195 | } |
---|
[abbd22] | 3196 | J = simplify(J,2); |
---|
| 3197 | facets[i] = J; |
---|
| 3198 | } |
---|
[fab82ab] | 3199 | return (facets); |
---|
| 3200 | } |
---|
[28c487] | 3201 | ////////////////////////////////////////////////////////////////////// |
---|
| 3202 | // |
---|
[fab82ab] | 3203 | static proc incrementalAlgPrim (ideal I) |
---|
| 3204 | { |
---|
| 3205 | // VARIABLES |
---|
| 3206 | list l1,l2; |
---|
| 3207 | // Hallamos la despomposicion irreducible del ideal dado usando |
---|
| 3208 | // el algoritmo de Gao-Zhu |
---|
| 3209 | l1 = incrementalAlg (I); |
---|
| 3210 | // ----- DESCOMPOSICION PRIMARIA |
---|
| 3211 | l2 = irredPrimary (l1); |
---|
| 3212 | return (l2); |
---|
| 3213 | } |
---|
[28c487] | 3214 | // |
---|
[fab82ab] | 3215 | // METODO 9: slice algorithm (Roune) |
---|
| 3216 | // |
---|
| 3217 | ////////////////////////////////////////////////////////////////////// |
---|
| 3218 | // SLICE ALGORITHM (B.Roune) // |
---|
| 3219 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 3220 | // |
---|
[fab82ab] | 3221 | static proc divideMon (poly f , poly g) |
---|
| 3222 | { |
---|
[abbd22] | 3223 | return (lead(g)/lead(f)!=0); |
---|
| 3224 | //int nvar = nvars(basering); |
---|
| 3225 | //intvec expf = leadexp(f); |
---|
| 3226 | //intvec expg = leadexp(g); |
---|
| 3227 | //for (int i = 1 ; i <= nvar ; i ++) |
---|
| 3228 | //{ |
---|
| 3229 | // if (expf[i] > expg[i]) |
---|
| 3230 | // { |
---|
| 3231 | // return (0); |
---|
| 3232 | // } |
---|
| 3233 | //} |
---|
| 3234 | //return (1); |
---|
[fab82ab] | 3235 | } |
---|
[28c487] | 3236 | ////////////////////////////////////////////////////////////////////// |
---|
| 3237 | // |
---|
[fab82ab] | 3238 | static proc pivot (ideal I , poly lcmMin, ideal S) |
---|
| 3239 | { |
---|
| 3240 | // I is monomial ideal |
---|
[abbd22] | 3241 | int sizI = ncols(I); |
---|
| 3242 | int nvar = nvars(basering); |
---|
[fab82ab] | 3243 | intvec explcmMin = leadexp(lcmMin); |
---|
| 3244 | // Variables |
---|
| 3245 | int i,j; |
---|
| 3246 | // The median estrategy |
---|
| 3247 | poly p; |
---|
| 3248 | int cont, exp, median, sizxi, max; |
---|
| 3249 | intvec xiexp; |
---|
| 3250 | for (i = 1 ; i <= nvar ; i ++) |
---|
[abbd22] | 3251 | { |
---|
| 3252 | if (explcmMin[i] >= 2 ) |
---|
[fab82ab] | 3253 | { |
---|
[abbd22] | 3254 | // Median exponent of x(i) from intersection(minI,x(i)) |
---|
| 3255 | cont = 0; |
---|
| 3256 | for (j = 1 ; j <= sizI ; j ++) |
---|
| 3257 | { |
---|
| 3258 | exp = leadexp(I[j])[i]; |
---|
| 3259 | if (exp > 0) |
---|
[fab82ab] | 3260 | { |
---|
[abbd22] | 3261 | cont ++; |
---|
| 3262 | xiexp[cont] = exp; |
---|
[fab82ab] | 3263 | } |
---|
[abbd22] | 3264 | } |
---|
| 3265 | xiexp = sort(xiexp)[1]; |
---|
| 3266 | sizxi = size(xiexp); |
---|
| 3267 | if (size(xiexp) == 1) |
---|
| 3268 | { |
---|
| 3269 | median = xiexp[1] - 1; |
---|
| 3270 | } |
---|
| 3271 | else |
---|
| 3272 | { |
---|
| 3273 | if (size(xiexp) == 2) |
---|
| 3274 | { |
---|
| 3275 | median = xiexp[2] - 1; |
---|
| 3276 | } |
---|
| 3277 | else |
---|
| 3278 | { |
---|
| 3279 | median = xiexp[(size(xiexp) + 1) / 2]; |
---|
| 3280 | } |
---|
| 3281 | } |
---|
| 3282 | p = var(i)^median; |
---|
| 3283 | // valid pivot?? |
---|
| 3284 | if ( membershipMon(p,S) == 0) |
---|
| 3285 | { |
---|
| 3286 | return(p); |
---|
| 3287 | } |
---|
| 3288 | else |
---|
| 3289 | { |
---|
| 3290 | max = maximoExp(S,i); |
---|
| 3291 | if ( xiexp[sizxi] == max ) |
---|
| 3292 | { |
---|
| 3293 | return(var(i)^(max-1)); |
---|
| 3294 | } |
---|
| 3295 | } |
---|
| 3296 | xiexp = 0; |
---|
[fab82ab] | 3297 | } |
---|
[abbd22] | 3298 | } |
---|
[fab82ab] | 3299 | } |
---|
[28c487] | 3300 | ////////////////////////////////////////////////////////////////////// |
---|
| 3301 | // |
---|
[fab82ab] | 3302 | static proc simplification (I) |
---|
| 3303 | { |
---|
| 3304 | // VARIABLES |
---|
| 3305 | int i, j, k, cont, numdeleted; |
---|
| 3306 | intvec isMaximal; |
---|
[abbd22] | 3307 | int sizI = ncols(I); |
---|
| 3308 | int nvar = nvars(basering); |
---|
[fab82ab] | 3309 | poly lcmMinI = 1; |
---|
| 3310 | for (i = 1 ; i <= sizI ; i ++) |
---|
[abbd22] | 3311 | { |
---|
| 3312 | lcmMinI = lcmMon(I[i],lcmMinI); |
---|
| 3313 | } |
---|
[fab82ab] | 3314 | intvec explcmMinI = leadexp(lcmMinI); |
---|
| 3315 | // Buscamos los elementos que son x(i) maximales. En caso de que |
---|
| 3316 | // un generador del ideal sea maximal para 2 variables distintas, |
---|
| 3317 | // ese generador se elimina. |
---|
| 3318 | isMaximal[sizI] = 0; |
---|
| 3319 | intvec genexp; |
---|
[abbd22] | 3320 | for (i = 1 ; i <= sizI ; i ++) |
---|
| 3321 | { |
---|
| 3322 | genexp = leadexp(I[i]); |
---|
| 3323 | cont = 0; |
---|
| 3324 | for ( j = 1 ; j <= nvar ; j ++) |
---|
[fab82ab] | 3325 | { |
---|
[abbd22] | 3326 | if (genexp[j] <> 0 && genexp[j] == explcmMinI[j]) |
---|
| 3327 | { |
---|
| 3328 | if (cont == 0) |
---|
[fab82ab] | 3329 | { |
---|
[abbd22] | 3330 | cont ++; |
---|
| 3331 | isMaximal[i] = j; |
---|
| 3332 | } |
---|
| 3333 | else |
---|
| 3334 | { |
---|
| 3335 | // Porque cuando encontramos que era maximal para |
---|
| 3336 | // la primera variable, lo guardamos |
---|
| 3337 | isMaximal[i] = 0; |
---|
| 3338 | // Eliminamos del ideal |
---|
| 3339 | if (i <> 1 && i <> sizI) |
---|
| 3340 | { |
---|
| 3341 | I = I[1..i - 1],I[i + 1..sizI]; |
---|
| 3342 | } |
---|
| 3343 | else |
---|
| 3344 | { |
---|
| 3345 | if (i == 1) |
---|
[fab82ab] | 3346 | { |
---|
[abbd22] | 3347 | I = I[2..sizI]; |
---|
[fab82ab] | 3348 | } |
---|
[abbd22] | 3349 | else |
---|
| 3350 | { |
---|
| 3351 | I = I[1..sizI - 1]; |
---|
| 3352 | } |
---|
| 3353 | } |
---|
| 3354 | i --; |
---|
| 3355 | sizI = ncols(I); |
---|
| 3356 | // Generador i eliminado, miramos el siguiente |
---|
| 3357 | break; |
---|
[fab82ab] | 3358 | } |
---|
[abbd22] | 3359 | } |
---|
[fab82ab] | 3360 | } |
---|
[abbd22] | 3361 | } |
---|
[fab82ab] | 3362 | // En isMaximal[i] tenemos 0 si I[i] no es maximal, |
---|
[abbd22] | 3363 | // y j si I[i] es maximal en x(j). |
---|
[fab82ab] | 3364 | // Matriz de exponentes de los generadores del ideal |
---|
| 3365 | intmat expI[sizI][nvar]; |
---|
| 3366 | for (i = 1 ; i <= sizI ; i++) |
---|
[abbd22] | 3367 | { |
---|
| 3368 | expI[i,1..nvar] = leadexp(I[i]); |
---|
| 3369 | } |
---|
[fab82ab] | 3370 | // Buscamos ahora cota inferior |
---|
| 3371 | poly lcmMi = 1; |
---|
| 3372 | poly l,gcdMi; |
---|
| 3373 | intvec Mi, mincol,expgcd; |
---|
| 3374 | for (i = 1 ; i <= nvar ; i ++) |
---|
[abbd22] | 3375 | { |
---|
| 3376 | Mi = 0; |
---|
| 3377 | cont = 0; |
---|
| 3378 | for (j = 1 ; j <= sizI ; j ++) |
---|
[fab82ab] | 3379 | { |
---|
[abbd22] | 3380 | // De isMaximal solo se usan las entradas que se corresponden con elementos del ideal |
---|
| 3381 | if (expI[j,i] <> 0) |
---|
| 3382 | { |
---|
| 3383 | if (isMaximal[j] == 0 or isMaximal[j] == i) |
---|
[fab82ab] | 3384 | { |
---|
[abbd22] | 3385 | // Elementos del sistema minimal que estan |
---|
| 3386 | // en Mi |
---|
| 3387 | cont ++; |
---|
| 3388 | Mi[cont] = j; |
---|
[fab82ab] | 3389 | } |
---|
[abbd22] | 3390 | } |
---|
| 3391 | } |
---|
| 3392 | // Si solo hay un elemento en Mi, no hay nada que hacer |
---|
| 3393 | if (cont > 1) |
---|
| 3394 | { |
---|
| 3395 | gcdMi = I[Mi[1]]; |
---|
| 3396 | // Tenemos los generadores a los que hay que hallar el gcd |
---|
| 3397 | for (j = 2; j <= cont ; j ++) |
---|
| 3398 | { |
---|
| 3399 | gcdMi = gcd(gcdMi,I[Mi[j]]); |
---|
| 3400 | } |
---|
| 3401 | } |
---|
| 3402 | else |
---|
| 3403 | { |
---|
| 3404 | if (Mi <> 0) |
---|
| 3405 | { |
---|
| 3406 | gcdMi = I[Mi[1]]; |
---|
| 3407 | } |
---|
[fab82ab] | 3408 | else |
---|
[abbd22] | 3409 | { |
---|
| 3410 | // Falta alguna variable |
---|
| 3411 | return (0,I); |
---|
| 3412 | } |
---|
[fab82ab] | 3413 | } |
---|
[abbd22] | 3414 | l = gcdMi/var(i); |
---|
| 3415 | lcmMi = lcmMon(lcmMi,l); |
---|
| 3416 | } |
---|
[fab82ab] | 3417 | // Ahora devolvemos la cota inferior, que luego hay que multiplicar |
---|
| 3418 | // por el monomio que define el corte. |
---|
| 3419 | // Devolvemos tambien el ideal (por si se ha modificado). |
---|
| 3420 | return (lcmMi,I); |
---|
| 3421 | } |
---|
[28c487] | 3422 | ////////////////////////////////////////////////////////////////////// |
---|
| 3423 | // |
---|
[fab82ab] | 3424 | static proc con (ideal I , ideal S , poly q) |
---|
| 3425 | { |
---|
[abbd22] | 3426 | int nvar = nvars(basering); |
---|
[fab82ab] | 3427 | // Variables |
---|
| 3428 | int i; |
---|
| 3429 | poly piI; |
---|
[abbd22] | 3430 | int sizI = ncols(I); |
---|
[fab82ab] | 3431 | // Simplification process |
---|
| 3432 | poly p; |
---|
| 3433 | list sol; |
---|
| 3434 | while (1) |
---|
[abbd22] | 3435 | { |
---|
| 3436 | // (I,S,q) normal slice? |
---|
| 3437 | // Como cada vez que introducimos una cota inferior sabemos |
---|
| 3438 | // que la slice actual es la inner slice (la otra es vacio), |
---|
| 3439 | // hay que volver a verificar si es normal |
---|
| 3440 | if ( S <> 0 ) |
---|
[fab82ab] | 3441 | { |
---|
[abbd22] | 3442 | // m/rad(m) esta en S, para m generador minimal de I?? |
---|
| 3443 | for (i = 1 ; i <= sizI ; i ++) |
---|
| 3444 | { |
---|
| 3445 | piI = pi(I[i]); |
---|
| 3446 | if (membershipMon(piI,S) == 1) |
---|
[fab82ab] | 3447 | { |
---|
[abbd22] | 3448 | if (i == 1) |
---|
| 3449 | { |
---|
| 3450 | I = I[2..sizI]; |
---|
| 3451 | } |
---|
| 3452 | else |
---|
| 3453 | { |
---|
| 3454 | if (i == sizI) |
---|
[fab82ab] | 3455 | { |
---|
[abbd22] | 3456 | I = I[1..sizI - 1]; |
---|
[fab82ab] | 3457 | } |
---|
[abbd22] | 3458 | else |
---|
[fab82ab] | 3459 | { |
---|
[abbd22] | 3460 | I = I[1..i - 1],I[i + 1..sizI]; |
---|
[fab82ab] | 3461 | } |
---|
[abbd22] | 3462 | } |
---|
| 3463 | sizI = ncols(I); |
---|
| 3464 | i --; |
---|
[fab82ab] | 3465 | } |
---|
[abbd22] | 3466 | } |
---|
[fab82ab] | 3467 | } |
---|
[abbd22] | 3468 | // Buscamos cota inferior, y si es distinta de 1, simplificamos |
---|
| 3469 | sol = simplification(I); |
---|
| 3470 | p = sol[1]; |
---|
| 3471 | if (p == 1) |
---|
| 3472 | { |
---|
| 3473 | break; |
---|
| 3474 | } |
---|
| 3475 | else |
---|
| 3476 | { |
---|
| 3477 | if (p == 0) |
---|
| 3478 | { |
---|
| 3479 | break; |
---|
| 3480 | } |
---|
| 3481 | else |
---|
| 3482 | { |
---|
| 3483 | if (membershipMon(p,I) == 1 ) |
---|
| 3484 | { |
---|
| 3485 | break; |
---|
| 3486 | } |
---|
| 3487 | } |
---|
| 3488 | } |
---|
| 3489 | // Changing slice by simplification |
---|
| 3490 | I = sol[2]; |
---|
| 3491 | I = minbase(quotient(I,p)); |
---|
| 3492 | q = p*q; |
---|
| 3493 | S = minbase(quotient(S,p)); |
---|
| 3494 | sizI = ncols(I); |
---|
| 3495 | } |
---|
| 3496 | sizI = ncols(I); |
---|
[fab82ab] | 3497 | // (I,S,q) base case? |
---|
| 3498 | poly lcmMinI; |
---|
| 3499 | lcmMinI = 1; |
---|
| 3500 | for (i = 1 ; i <= sizI ; i ++) |
---|
[abbd22] | 3501 | { |
---|
| 3502 | lcmMinI = lcmMon(lcmMinI,I[i]); |
---|
| 3503 | } |
---|
[fab82ab] | 3504 | // a:b generates an intvec of length b with constant entries a |
---|
| 3505 | intvec one = 1:nvar; |
---|
| 3506 | if (divideMon(monomial(one),lcmMinI) == 0) |
---|
[abbd22] | 3507 | { |
---|
| 3508 | return (0); |
---|
| 3509 | } |
---|
[fab82ab] | 3510 | if (equal(radicalMon(I),I) == 1) |
---|
[abbd22] | 3511 | { |
---|
| 3512 | if (equal(I, maxideal(1)) == 0) |
---|
[fab82ab] | 3513 | { |
---|
[abbd22] | 3514 | return (0); |
---|
| 3515 | } |
---|
| 3516 | else |
---|
| 3517 | { |
---|
| 3518 | for (i = 1 ; i <= nvar ; i ++) |
---|
| 3519 | { |
---|
| 3520 | q = q * var(i); |
---|
| 3521 | } |
---|
| 3522 | return (q); |
---|
[fab82ab] | 3523 | } |
---|
[abbd22] | 3524 | } |
---|
[fab82ab] | 3525 | // Selecting pivot |
---|
| 3526 | p = pivot(I,lcmMinI,S); |
---|
| 3527 | // New slices |
---|
| 3528 | ideal S1 = minbase(quotient(S,p)); |
---|
| 3529 | ideal I1 = minbase(quotient(I,p)); |
---|
| 3530 | ideal S2 = S,p; |
---|
| 3531 | S2 = minbase(S2); |
---|
| 3532 | return (con(I1,S1,p*q),con(I,S2,q)); |
---|
| 3533 | } |
---|
[28c487] | 3534 | ////////////////////////////////////////////////////////////////////// |
---|
| 3535 | // |
---|
[fab82ab] | 3536 | static proc irredDecMonSlice (ideal I) |
---|
| 3537 | { |
---|
[abbd22] | 3538 | int nvar = nvars(basering); |
---|
| 3539 | int sizI = ncols(I); |
---|
[fab82ab] | 3540 | int i,j; |
---|
| 3541 | // Artinian ideal |
---|
| 3542 | ideal artI; |
---|
| 3543 | list artinianization = artinian(I); |
---|
| 3544 | if (artinianization[1] == 0) |
---|
[abbd22] | 3545 | { |
---|
| 3546 | artI = artinianization[2]; |
---|
| 3547 | } |
---|
[fab82ab] | 3548 | else |
---|
[abbd22] | 3549 | { |
---|
| 3550 | artI = I; |
---|
| 3551 | } |
---|
[fab82ab] | 3552 | // Easy case: 2 variables |
---|
| 3553 | if (nvar == 2) |
---|
[abbd22] | 3554 | { |
---|
| 3555 | artI = sort(artI)[1]; |
---|
[28c487] | 3556 | int sizartI = size(artI); |
---|
[abbd22] | 3557 | for (i = 1 ; i <= sizartI - 1 ; i ++) |
---|
[fab82ab] | 3558 | { |
---|
[abbd22] | 3559 | components[i] = var(1)^(leadexp[artI[i]][1])*var(2)^(leadexp[artI[i + 1]][2]); |
---|
[fab82ab] | 3560 | } |
---|
[abbd22] | 3561 | return (components); |
---|
| 3562 | } |
---|
[fab82ab] | 3563 | ideal irredDec = con (artI,0,1); |
---|
| 3564 | // Delelting zeros |
---|
| 3565 | irredDec = simplify(irredDec,2); |
---|
| 3566 | // Delting, in case, generators |
---|
| 3567 | intvec elimina; |
---|
| 3568 | if (artinianization[1] == 0) |
---|
[abbd22] | 3569 | { |
---|
| 3570 | elimina = artinianization[3]; |
---|
| 3571 | } |
---|
[fab82ab] | 3572 | else |
---|
[abbd22] | 3573 | { |
---|
| 3574 | elimina = 0; |
---|
| 3575 | } |
---|
[fab82ab] | 3576 | // Each generator (monomial) corresponds to an ideal |
---|
| 3577 | list components; |
---|
| 3578 | poly comp; |
---|
| 3579 | intvec exp; |
---|
[28c487] | 3580 | int sizIrred = size(irredDec); |
---|
[fab82ab] | 3581 | ideal auxIdeal; |
---|
| 3582 | for (i = 1 ; i <= sizIrred ; i ++) |
---|
[abbd22] | 3583 | { |
---|
| 3584 | comp = irredDec[i]; |
---|
| 3585 | exp = leadexp(comp); |
---|
| 3586 | for (j = 1 ; j <= nvar ; j ++) |
---|
[fab82ab] | 3587 | { |
---|
[abbd22] | 3588 | if (exp[j] <> 0) |
---|
| 3589 | { |
---|
| 3590 | if (elimina <> 0) |
---|
[fab82ab] | 3591 | { |
---|
[abbd22] | 3592 | if (exp[j] == elimina[j]) |
---|
| 3593 | { |
---|
| 3594 | auxIdeal[j] = 0; |
---|
| 3595 | } |
---|
| 3596 | else |
---|
| 3597 | { |
---|
| 3598 | auxIdeal[j] = var(j)^exp[j]; |
---|
| 3599 | } |
---|
| 3600 | } |
---|
| 3601 | else |
---|
| 3602 | { |
---|
| 3603 | auxIdeal[j] = var(j)^exp[j]; |
---|
[fab82ab] | 3604 | } |
---|
[abbd22] | 3605 | } |
---|
[fab82ab] | 3606 | } |
---|
[abbd22] | 3607 | components[i] = simplify(auxIdeal,2); |
---|
| 3608 | auxIdeal = 0; |
---|
| 3609 | } |
---|
[fab82ab] | 3610 | return (components); |
---|
| 3611 | } |
---|
[28c487] | 3612 | ////////////////////////////////////////////////////////////////////// |
---|
| 3613 | // |
---|
[fab82ab] | 3614 | static proc primDecMonSlice (ideal I) |
---|
| 3615 | { |
---|
| 3616 | // VARIABLES |
---|
| 3617 | list l1,l2; |
---|
| 3618 | // ---- Irreducible decomposition |
---|
| 3619 | // Slice Method |
---|
| 3620 | l1 = irredDecMonSlice (I); |
---|
| 3621 | // ----- Primary decomposition |
---|
| 3622 | l2 = irredPrimary (l1); |
---|
| 3623 | return (l2); |
---|
| 3624 | } |
---|
| 3625 | ////////////////////////////////////////////////////////////////////// |
---|
| 3626 | // // |
---|
| 3627 | // DECOMPOSITIONS // |
---|
| 3628 | // // |
---|
| 3629 | ////////////////////////////////////////////////////////////////////// |
---|
| 3630 | ////////////////////////////////////////////////////////////////////// |
---|
[28c487] | 3631 | // |
---|
[fab82ab] | 3632 | proc irreddecMon |
---|
[28c487] | 3633 | "USAGE: irreddecMon (I[,alg]); I ideal, alg string. |
---|
[fab82ab] | 3634 | RETURN: list, the irreducible components of the monomial ideal I. |
---|
| 3635 | (returns -1 if I is not a monomial ideal). |
---|
| 3636 | ASSUME: I is a monomial ideal of the basering k[x(1)..x(n)]. |
---|
[28c487] | 3637 | NOTE: This procesure returns the irreducible decomposition of I. |
---|
[fab82ab] | 3638 | One may call the procedure with different algorithms using |
---|
| 3639 | the optional argument 'alg': |
---|
| 3640 | - the direct method following Vasconcelos' book (alg=vas) |
---|
| 3641 | - via the Alexander dual and using doble dual (alg=add), |
---|
| 3642 | - via the Alexander dual and quotients following E. Miller |
---|
| 3643 | (alg=ad), |
---|
| 3644 | - the formula of irreducible components (alg=for), |
---|
| 3645 | - via the Scarf complex following Milowski (alg=mil), |
---|
| 3646 | - using the label algorihtm of Roune (alg=lr), |
---|
| 3647 | - using the algorithm of Gao-Zhu (alg=gz). |
---|
| 3648 | - using the slice algorithm of Roune (alg=sr). |
---|
| 3649 | EXAMPLE: example irreddecMon; shows some examples. |
---|
| 3650 | " |
---|
| 3651 | { |
---|
| 3652 | // COMPROBACIONES |
---|
| 3653 | ideal I = #[1]; |
---|
| 3654 | int control = checkIdeal(I); |
---|
| 3655 | // Si el sistema de generadores no esta formado por monomios, hay |
---|
| 3656 | // que comprobar si el ideal es monomial. |
---|
| 3657 | if (control == 0) |
---|
[abbd22] | 3658 | { |
---|
| 3659 | list isMon = isMonomialGB (I); |
---|
| 3660 | if (isMon[1] == 0) |
---|
[fab82ab] | 3661 | { |
---|
[abbd22] | 3662 | ERROR ("the ideal is not monomial."); |
---|
[fab82ab] | 3663 | } |
---|
[abbd22] | 3664 | else |
---|
[fab82ab] | 3665 | { |
---|
[abbd22] | 3666 | I = isMon[2]; |
---|
| 3667 | // Ya lo tenemos con los generadores minimales |
---|
[fab82ab] | 3668 | } |
---|
[abbd22] | 3669 | } |
---|
| 3670 | else |
---|
| 3671 | { |
---|
| 3672 | // Generadores monomiales, hallamos sistema minimal |
---|
| 3673 | I = minbase(I); |
---|
| 3674 | } |
---|
[fab82ab] | 3675 | // Si el ideal es irreducible, devolvemos el mismo |
---|
| 3676 | if (isirreducibleMon(I) == 1) |
---|
[abbd22] | 3677 | { |
---|
| 3678 | return (I); |
---|
| 3679 | } |
---|
| 3680 | // Si no me han dado opcion, elijo una yo. |
---|
| 3681 | if (size(#) == 1) |
---|
| 3682 | { |
---|
| 3683 | return (irredDec3(I)); |
---|
| 3684 | } |
---|
[fab82ab] | 3685 | // Leo la opcion y llamo al procedimiento oportuno |
---|
| 3686 | else |
---|
[abbd22] | 3687 | { |
---|
| 3688 | if (#[2] == "vas") |
---|
[fab82ab] | 3689 | { |
---|
[abbd22] | 3690 | return (irredDec1(I)); |
---|
| 3691 | } |
---|
| 3692 | if (#[2] == "add") |
---|
| 3693 | { |
---|
| 3694 | return (irredDec3(I)); |
---|
| 3695 | } |
---|
| 3696 | if (#[2] == "ad") |
---|
| 3697 | { |
---|
| 3698 | return (irredDec4(I)); |
---|
| 3699 | } |
---|
| 3700 | if (#[2] == "for") |
---|
| 3701 | { |
---|
| 3702 | return (irredDec5(I)); |
---|
| 3703 | } |
---|
| 3704 | if (#[2] == "mil") |
---|
| 3705 | { |
---|
| 3706 | return (ScarfMethod(I)); |
---|
[fab82ab] | 3707 | } |
---|
[abbd22] | 3708 | if (#[2] == "lr") |
---|
| 3709 | { |
---|
| 3710 | return (labelAlgorithm(I)); |
---|
| 3711 | } |
---|
| 3712 | if (#[2] == "gz") |
---|
| 3713 | { |
---|
| 3714 | return (incrementalAlg(I)); |
---|
| 3715 | } |
---|
| 3716 | if (#[2] == "sr") |
---|
| 3717 | { |
---|
| 3718 | return (irredDecMonSlice(I)); |
---|
| 3719 | } |
---|
| 3720 | } |
---|
[fab82ab] | 3721 | } |
---|
| 3722 | example |
---|
| 3723 | {"EXAMPLE:"; echo = 2; |
---|
| 3724 | ring R = 0,(w,x,y,z),Dp; |
---|
| 3725 | ideal I = w^3*x*y,w*x*y*z,x^2*y^2*z^2,x^2*z^4,y^3*z; |
---|
| 3726 | // Vasconcelos |
---|
| 3727 | irreddecMon (I,"vas"); |
---|
| 3728 | // Alexander Dual |
---|
| 3729 | irreddecMon (I,"ad"); |
---|
| 3730 | // Scarf Complex |
---|
| 3731 | irreddecMon (I,"mil"); |
---|
| 3732 | // slice algorithm |
---|
| 3733 | irreddecMon(I,"sr"); |
---|
| 3734 | } |
---|
[28c487] | 3735 | ////////////////////////////////////////////////////////////////////// |
---|
| 3736 | // |
---|
[fab82ab] | 3737 | proc primdecMon |
---|
[28c487] | 3738 | "USAGE: primdecMon (I[,alg]); I ideal, alg string |
---|
[fab82ab] | 3739 | RETURN: list, the components in a minimal primary decomposition of I. |
---|
| 3740 | (returns -1 if I is not a monomial ideal). |
---|
| 3741 | ASSUME: I is a monomial ideal of the basering k[x(1)..x(n)]. |
---|
[28c487] | 3742 | NOTE: This procesure returns a minimal primary decomposition of I. |
---|
[fab82ab] | 3743 | One may call the procedure with different algorithms using |
---|
| 3744 | the optional argument 'alg': |
---|
| 3745 | - the direct method for a primary decomposition following |
---|
| 3746 | Vasconcelos' book (alg=vp), |
---|
| 3747 | - from the irreducible decomposition obtained via the direct |
---|
| 3748 | method following Vasconcelos' book (alg=vi), |
---|
| 3749 | - from the irreducible decomposition obtained via the |
---|
| 3750 | Alexander dual and using doble dual (alg=add), |
---|
| 3751 | - from the irreducible decomposition obtained via the |
---|
| 3752 | Alexander dual and quotients following E. Miller (alg=ad), |
---|
| 3753 | - from the irreducible decomposition obtained |
---|
| 3754 | via ........ (alg=for), |
---|
| 3755 | - from the irreducible decomposition obtained via the Scarf |
---|
| 3756 | complex following Milowski (alg=mil), |
---|
| 3757 | - from the irreducible decomposition obtained using the label |
---|
| 3758 | algorihtm of Roune (alg=lr), |
---|
| 3759 | - from the irreducible decomposition obtained using the |
---|
| 3760 | algorithm of Gao-Zhu (alg=gz), |
---|
| 3761 | - from the irreducible decomposition obtained using the slice |
---|
| 3762 | algorithm of Roune (alg=sr). |
---|
| 3763 | EXAMPLE: example primdecMon; shows some examples. |
---|
| 3764 | " |
---|
| 3765 | { |
---|
| 3766 | // COMPROBACIONES |
---|
| 3767 | ideal I = #[1]; |
---|
| 3768 | int control = checkIdeal(I); |
---|
| 3769 | // Si el sistema de generadores no esta formado por monomios, hay |
---|
| 3770 | // que comprobar si el ideal es monomial. |
---|
| 3771 | if (control == 0) |
---|
[abbd22] | 3772 | { |
---|
| 3773 | list isMon = isMonomialGB (I); |
---|
| 3774 | if (isMon[1] == 0) |
---|
[fab82ab] | 3775 | { |
---|
[abbd22] | 3776 | ERROR ("the ideal is not monomial."); |
---|
[fab82ab] | 3777 | } |
---|
[abbd22] | 3778 | else |
---|
[fab82ab] | 3779 | { |
---|
[abbd22] | 3780 | I = isMon[2]; |
---|
| 3781 | // Ya lo tenemos con los generadores minimales |
---|
[fab82ab] | 3782 | } |
---|
[abbd22] | 3783 | } |
---|
| 3784 | else |
---|
| 3785 | { |
---|
| 3786 | // Generadores monomiales, hallamos sistema minimal |
---|
| 3787 | I = minbase(I); |
---|
| 3788 | } |
---|
[fab82ab] | 3789 | // Estudiamos si el ideal es o no primario |
---|
| 3790 | if (isprimaryMon(I) == 1) |
---|
[abbd22] | 3791 | { |
---|
| 3792 | return (I); |
---|
| 3793 | } |
---|
[fab82ab] | 3794 | // Si no me han dado opcion, elijo una yo. |
---|
| 3795 | if (size(#) == 1) |
---|
[abbd22] | 3796 | { |
---|
| 3797 | return(primDec3(I)); |
---|
| 3798 | } |
---|
[fab82ab] | 3799 | // Leo la opcion y llamo al procedimiento oportuno |
---|
| 3800 | else |
---|
[abbd22] | 3801 | { |
---|
| 3802 | if (#[2] == "vi") |
---|
[fab82ab] | 3803 | { |
---|
[abbd22] | 3804 | return (primDec1(I)); |
---|
[fab82ab] | 3805 | } |
---|
[abbd22] | 3806 | if (#[2] == "vp") |
---|
| 3807 | { |
---|
| 3808 | return (primDec2(I)); |
---|
| 3809 | } |
---|
| 3810 | if (#[2] == "add") |
---|
| 3811 | { |
---|
| 3812 | return (primDec3(I)); |
---|
| 3813 | } |
---|
| 3814 | if (#[2] == "ad") |
---|
| 3815 | { |
---|
| 3816 | return (primDec4(I)); |
---|
| 3817 | } |
---|
| 3818 | if (#[2] == "for") |
---|
| 3819 | { |
---|
| 3820 | return (primDec5(I)); |
---|
| 3821 | } |
---|
| 3822 | if (#[2] == "mil") |
---|
| 3823 | { |
---|
| 3824 | return (scarfMethodPrim(I)); |
---|
| 3825 | } |
---|
| 3826 | if (#[2] == "lr") |
---|
| 3827 | { |
---|
| 3828 | return (labelAlgPrim(I)); |
---|
| 3829 | } |
---|
| 3830 | if (#[2] == "gz") |
---|
| 3831 | { |
---|
| 3832 | return (incrementalAlgPrim(I)); |
---|
| 3833 | } |
---|
| 3834 | if (#[2] == "sr") |
---|
| 3835 | { |
---|
| 3836 | return (primDecMonSlice(I)); |
---|
| 3837 | } |
---|
| 3838 | } |
---|
[fab82ab] | 3839 | } |
---|
| 3840 | example |
---|
| 3841 | {"EXAMPLE:"; echo = 2; |
---|
| 3842 | ring R = 0,(w,x,y,z),Dp; |
---|
| 3843 | ideal I = w^3*x*y,w*x*y*z,x^2*y^2*z^2,x^2*z^4,y^3*z; |
---|
| 3844 | // Vasconcelos para primaria |
---|
| 3845 | primdecMon(I,"vp"); |
---|
| 3846 | // Alexander dual |
---|
| 3847 | primdecMon(I,"add"); |
---|
| 3848 | // label algorithm |
---|
| 3849 | primdecMon(I,"lr"); |
---|
| 3850 | //slice algorithm |
---|
| 3851 | primdecMon(I,"sr"); |
---|
| 3852 | } |
---|