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