[0e1846] | 1 | /**************************************** |
---|
| 2 | * Computer Algebra System SINGULAR * |
---|
| 3 | ****************************************/ |
---|
[4508ce5] | 4 | /* $Id: algmap.cc,v 1.22 2000-12-15 18:49:27 Singular Exp $ */ |
---|
[0e1846] | 5 | /* |
---|
| 6 | * ABSTRACT - the mapping of polynomials from rings with |
---|
| 7 | * 'alg' numbers |
---|
| 8 | */ |
---|
| 9 | |
---|
| 10 | #include "mod2.h" |
---|
[512a2b] | 11 | #include "omalloc.h" |
---|
[ca7a56] | 12 | #include "tok.h" |
---|
[0e1846] | 13 | #include "polys.h" |
---|
| 14 | #include "numbers.h" |
---|
| 15 | #include "longalg.h" |
---|
| 16 | #include "ipid.h" |
---|
| 17 | #include "ring.h" |
---|
| 18 | #include "febase.h" |
---|
| 19 | #include "maps.h" |
---|
| 20 | #include "algmap.h" |
---|
| 21 | |
---|
| 22 | |
---|
[47faf56] | 23 | static poly maLongalg1Fetch(poly res, poly p0, ring r0, int n, |
---|
[0e1846] | 24 | int t, BOOLEAN *nom) |
---|
| 25 | { |
---|
| 26 | napoly a0, b0; |
---|
| 27 | poly q0, q1 = NULL; |
---|
[47faf56] | 28 | int i, j, m = r0->N; |
---|
[0e1846] | 29 | |
---|
[0f0974] | 30 | if (naGetDenom0(pGetCoeff(p0)) != NULL) |
---|
[0e1846] | 31 | { |
---|
| 32 | *nom = TRUE; |
---|
| 33 | return res; |
---|
| 34 | } |
---|
[0f0974] | 35 | a0 = naGetNom0(pGetCoeff(p0)); |
---|
[0e1846] | 36 | do |
---|
| 37 | { |
---|
| 38 | q0 = pInit(); |
---|
[a6a239] | 39 | pSetComp(q0,p_GetComp(p0, r0)); |
---|
[0e1846] | 40 | if (t!=0) |
---|
| 41 | { |
---|
[c232af] | 42 | pGetCoeff(q0) = (number)omAlloc0Bin(rnumber_bin); |
---|
[0f0974] | 43 | b0 = naGetNom0(pGetCoeff(q0)) = napNew(); |
---|
[0e1846] | 44 | napGetCoeff(b0) = nacCopy(napGetCoeff(a0)); |
---|
| 45 | for (i=1; i<=t; i++) |
---|
| 46 | { |
---|
[98621a5] | 47 | napSetExp(b0,i,napGetExpFrom(a0,i,r0)); |
---|
[0e1846] | 48 | } |
---|
| 49 | } |
---|
| 50 | else |
---|
| 51 | { |
---|
| 52 | pGetCoeff(q0) = nCopy(napGetCoeff(a0)); |
---|
| 53 | } |
---|
| 54 | for (i=m; i>0; i--) |
---|
| 55 | { |
---|
[a6a239] | 56 | pSetExp(q0,i, p_GetExp( p0,i,r0)); |
---|
[0e1846] | 57 | } |
---|
| 58 | j = t; |
---|
| 59 | for (i=m+1; i<=n; i++) |
---|
| 60 | { |
---|
| 61 | j++; |
---|
[1cf2dc6] | 62 | pSetExp(q0,i, napGetExpFrom(a0,j,r0)); |
---|
[0e1846] | 63 | } |
---|
| 64 | pSetm(q0); |
---|
| 65 | q1 = pAdd(q1, q0); |
---|
| 66 | a0 = napNext(a0); |
---|
| 67 | } |
---|
| 68 | while (a0 != NULL); |
---|
| 69 | return pAdd(res, q1); |
---|
| 70 | } |
---|
| 71 | |
---|
[47faf56] | 72 | static poly maLongalg2Fetch(poly res, poly p0, ring r0, int n, int s, |
---|
[0e1846] | 73 | int t, BOOLEAN *nom) |
---|
| 74 | { |
---|
| 75 | poly q0; |
---|
| 76 | int i, j; |
---|
| 77 | napoly b0; |
---|
| 78 | napoly a0 = NULL, b1 = NULL; |
---|
| 79 | |
---|
| 80 | if (s!=0) |
---|
| 81 | { |
---|
[0f0974] | 82 | if (naGetDenom0(pGetCoeff(p0)) != NULL) |
---|
[0e1846] | 83 | { |
---|
| 84 | *nom = TRUE; |
---|
| 85 | return res; |
---|
| 86 | } |
---|
[0f0974] | 87 | a0 = naGetNom0(pGetCoeff(p0)); |
---|
[0e1846] | 88 | } |
---|
| 89 | q0 = pInit(); |
---|
[a6a239] | 90 | pSetComp(q0,p_GetComp(p0, r0)); |
---|
[0e1846] | 91 | for (i=n; i>0; i--) |
---|
| 92 | { |
---|
[a6a239] | 93 | pSetExp(q0,i, p_GetExp(p0,i,r0)); |
---|
[0e1846] | 94 | } |
---|
| 95 | pSetm(q0); |
---|
| 96 | do |
---|
| 97 | { |
---|
| 98 | b0 = napNew(); |
---|
| 99 | if (s!=0) |
---|
| 100 | { |
---|
| 101 | napGetCoeff(b0) = nacCopy(napGetCoeff(a0)); |
---|
| 102 | for (i=1; i<=s; i++) |
---|
| 103 | { |
---|
[6aef97b] | 104 | napSetExp(b0,i, napGetExp(a0,i)); |
---|
[0e1846] | 105 | } |
---|
| 106 | } |
---|
| 107 | else |
---|
| 108 | { |
---|
| 109 | napGetCoeff(b0) = nacCopy(pGetCoeff(p0)); |
---|
| 110 | } |
---|
| 111 | j = n; |
---|
| 112 | for (i=s+1; i<=t; i++) |
---|
| 113 | { |
---|
| 114 | j++; |
---|
[6aef97b] | 115 | napSetExp(b0,i, p_GetExp(p0,j,r0)); |
---|
[0e1846] | 116 | } |
---|
| 117 | if (s==0) |
---|
| 118 | { |
---|
[c232af] | 119 | pGetCoeff(q0)=(number)omAlloc0Bin(rnumber_bin); |
---|
[0f0974] | 120 | naGetNom0(pGetCoeff(q0)) = b0; |
---|
[0e1846] | 121 | return pAdd(res, q0); |
---|
| 122 | } |
---|
| 123 | b1 = napAdd(b1, b0); |
---|
| 124 | a0 = napNext(a0); |
---|
| 125 | } |
---|
| 126 | while (a0 != NULL); |
---|
| 127 | if (pGetCoeff(q0)==NULL) |
---|
[c232af] | 128 | pGetCoeff(q0) = (number)omAlloc0Bin(rnumber_bin); |
---|
[0f0974] | 129 | naGetNom0(pGetCoeff(q0)) = b1; |
---|
[0e1846] | 130 | return pAdd(res, q0); |
---|
| 131 | } |
---|
| 132 | |
---|
| 133 | /*2 |
---|
| 134 | * return Fe(preimage) |
---|
| 135 | * Fe : k(y(1),..,y(s))[x(1),..,x(m)] -> k(y(1),..,y(t))[x(1),..,x(n)] |
---|
| 136 | * with: |
---|
| 137 | * s+m = t+n, |
---|
| 138 | * Fe(y(i)) = y(i), i = 1,..,min(s,t), |
---|
| 139 | * Fe(x(i)) = x(i), i = 1,..,min(m,n), |
---|
| 140 | * and |
---|
| 141 | * 1. for s>t: Fe(y(i)) = x(i+n-t), i = t+1,..,s |
---|
| 142 | * 2. for m>n: Fe(x(i)) = y(i+t-n), i = n+1,..,m |
---|
| 143 | */ |
---|
| 144 | poly maAlgpolyFetch(ring R, poly preimage) |
---|
| 145 | { |
---|
| 146 | BOOLEAN nom=FALSE; |
---|
| 147 | int m, n, s, t; |
---|
| 148 | poly p0, result=NULL; |
---|
| 149 | |
---|
| 150 | if (preimage == NULL) |
---|
| 151 | { |
---|
| 152 | return NULL; |
---|
| 153 | } |
---|
| 154 | m = R->N; |
---|
| 155 | n = currRing->N; |
---|
| 156 | s = rPar(R); |
---|
| 157 | t = rPar(currRing); |
---|
| 158 | if ((m+s) != (n+t)) |
---|
| 159 | { |
---|
[da97958] | 160 | WerrorS("no algfetch possible"); |
---|
[0e1846] | 161 | return NULL; |
---|
| 162 | } |
---|
| 163 | if (n == m) |
---|
| 164 | { |
---|
| 165 | return pCopy(preimage); |
---|
| 166 | } |
---|
| 167 | p0 = preimage; |
---|
| 168 | if (s > t) |
---|
| 169 | { |
---|
| 170 | while (p0!=NULL) |
---|
| 171 | { |
---|
[47faf56] | 172 | result = maLongalg1Fetch(result, p0, R, n, t, &nom); |
---|
[0e1846] | 173 | if (nom) |
---|
| 174 | { |
---|
| 175 | goto err_algfetch; |
---|
| 176 | } |
---|
| 177 | pIter(p0); |
---|
| 178 | } |
---|
| 179 | } |
---|
| 180 | else |
---|
| 181 | { |
---|
| 182 | while (p0!=NULL) |
---|
| 183 | { |
---|
[47faf56] | 184 | result = maLongalg2Fetch(result, p0, R, n, s, t, &nom); |
---|
[0e1846] | 185 | if (nom) |
---|
| 186 | { |
---|
| 187 | goto err_algfetch; |
---|
| 188 | } |
---|
| 189 | pIter(p0); |
---|
| 190 | } |
---|
| 191 | } |
---|
| 192 | return result; |
---|
| 193 | |
---|
| 194 | err_algfetch: |
---|
| 195 | pDelete(&result); |
---|
[da97958] | 196 | WerrorS("denominator in algnumber"); |
---|
[0e1846] | 197 | return NULL; |
---|
| 198 | } |
---|
| 199 | |
---|
[a38f5ea] | 200 | static poly maLongalgMap(poly res, ring r, poly p0, int s, int t, |
---|
[0e1846] | 201 | BOOLEAN *nom, poly monpart, ideal F) |
---|
| 202 | { |
---|
| 203 | number cc; |
---|
| 204 | napoly a0, b0; |
---|
| 205 | poly q, q0, q1 = NULL; |
---|
| 206 | int i; |
---|
[e0d91c] | 207 | |
---|
[0e1846] | 208 | if (s == 0) |
---|
| 209 | { |
---|
| 210 | if (t!=0) |
---|
| 211 | { |
---|
| 212 | nNew(&cc); |
---|
| 213 | b0 = napNew(); |
---|
| 214 | napGetCoeff(b0) = pGetCoeff(p0); |
---|
[0f0974] | 215 | naGetNom0(cc) = b0; |
---|
[a6a239] | 216 | pMult_nn(monpart,cc); |
---|
[0e1846] | 217 | napGetCoeff(b0) = NULL; |
---|
| 218 | nDelete(&cc); |
---|
| 219 | } |
---|
| 220 | else |
---|
| 221 | { |
---|
[a6a239] | 222 | pMult_nn(monpart,pGetCoeff(p0)); |
---|
[0e1846] | 223 | } |
---|
[a6a239] | 224 | pSetCompP(monpart, p_GetComp(p0,r)); |
---|
[0e1846] | 225 | return pAdd(res, monpart); |
---|
| 226 | } |
---|
[0f0974] | 227 | if (naGetDenom0(pGetCoeff(p0)) != NULL) |
---|
[0e1846] | 228 | { |
---|
| 229 | *nom = TRUE; |
---|
[da97958] | 230 | WerrorS("denominator in algnumber"); |
---|
[0e1846] | 231 | pDelete(&monpart); |
---|
| 232 | pDelete(&res); |
---|
| 233 | return NULL; |
---|
| 234 | } |
---|
[0f0974] | 235 | a0 = naGetNom0(pGetCoeff(p0)); |
---|
[0e1846] | 236 | do |
---|
| 237 | { |
---|
| 238 | q = pInit(); |
---|
| 239 | if (t!=0) |
---|
| 240 | { |
---|
[c232af] | 241 | pGetCoeff(q) = (number)omAlloc0Bin(rnumber_bin); |
---|
[0f0974] | 242 | b0 = naGetNom0(pGetCoeff(q)) = napNew(); |
---|
[0e1846] | 243 | napGetCoeff(b0) = nacCopy(napGetCoeff(a0)); |
---|
| 244 | } |
---|
| 245 | else |
---|
| 246 | { |
---|
| 247 | pGetCoeff(q) = nCopy(napGetCoeff(a0)); |
---|
| 248 | } |
---|
| 249 | for(i=0; i<s; i++) |
---|
| 250 | { |
---|
[98621a5] | 251 | if (napGetExpFrom(a0,i+1,r) != 0) |
---|
[0e1846] | 252 | { |
---|
| 253 | if (F->m[i]!=NULL) |
---|
| 254 | { |
---|
[98621a5] | 255 | q0 = pPower(pCopy(F->m[i]),napGetExpFrom(a0,i+1,r)); |
---|
[0e1846] | 256 | q = pMult(q, q0); |
---|
| 257 | } |
---|
| 258 | else |
---|
| 259 | { |
---|
| 260 | pDelete(&q); |
---|
| 261 | break; |
---|
| 262 | } |
---|
| 263 | } |
---|
| 264 | } |
---|
| 265 | q1 = pAdd(q1, q); |
---|
| 266 | a0 = napNext(a0); |
---|
| 267 | } |
---|
| 268 | while (a0 != NULL); |
---|
| 269 | q1 = pMult(q1,monpart); |
---|
[a6a239] | 270 | pSetCompP(q1,p_GetComp(p0,r)); |
---|
[0e1846] | 271 | return pAdd(res, q1); |
---|
| 272 | } |
---|
| 273 | |
---|
| 274 | number maNumberOne(number x) |
---|
| 275 | { |
---|
| 276 | return nInit(1); |
---|
| 277 | } |
---|
| 278 | |
---|
| 279 | /*2 |
---|
| 280 | * return Ma(preimage) |
---|
| 281 | * Ma : k(y(1),..,y(s))[x(1),..,x(m)] -> k(y(1),..,y(t))[z(1),..,z(n)] |
---|
| 282 | * the ideals F = f_1,..,f_s and G = g_1,..,g_m in k(y(1),..,y(t))[z(1),..,z(n)] |
---|
| 283 | * are as follows: |
---|
| 284 | * f_i = Ma(y(i)), g_i = Ma(x(i)) |
---|
| 285 | */ |
---|
| 286 | poly maAlgpolyMap(ring R, poly preimage, ideal F, ideal G) |
---|
| 287 | { |
---|
| 288 | BOOLEAN nom=FALSE; |
---|
| 289 | int m, s, t; |
---|
| 290 | poly p0, monpart, result = NULL; |
---|
| 291 | |
---|
| 292 | if (preimage == NULL) |
---|
| 293 | { |
---|
| 294 | return NULL; |
---|
| 295 | } |
---|
| 296 | m = R->N; |
---|
| 297 | if (m != IDELEMS(G)) |
---|
| 298 | { |
---|
[da97958] | 299 | WerrorS("error 1 in algmap"); |
---|
[0e1846] | 300 | return NULL; |
---|
| 301 | } |
---|
| 302 | s = rPar(R); |
---|
| 303 | if ((s!=0) && (s != IDELEMS(F))) |
---|
| 304 | { |
---|
[da97958] | 305 | WerrorS("error 2 in algmap"); |
---|
[0e1846] | 306 | return NULL; |
---|
| 307 | } |
---|
| 308 | t = rPar(currRing); |
---|
| 309 | p0 = preimage; |
---|
| 310 | poly pr=NULL; |
---|
| 311 | while (p0!=NULL) |
---|
| 312 | { |
---|
| 313 | poly pr=pNext(p0); |
---|
| 314 | p0->next=NULL; |
---|
[4508ce5] | 315 | monpart = maEval((map)G, p0, R, maNumberOne); |
---|
[a38f5ea] | 316 | result = maLongalgMap(result, R, p0, s, t, &nom, monpart, F); |
---|
[0498af] | 317 | pTest(result); |
---|
[0e1846] | 318 | if (nom) |
---|
| 319 | { |
---|
| 320 | return NULL; |
---|
| 321 | } |
---|
[0498af] | 322 | p0->next = pr; |
---|
[0e1846] | 323 | p0=pr; |
---|
| 324 | } |
---|
| 325 | return result; |
---|
| 326 | } |
---|