Changeset 3dbee61 in git
- Timestamp:
- Sep 29, 2011, 5:34:55 PM (12 years ago)
- Branches:
- (u'spielwiese', '91fdef05f09f54b8d58d92a472e9c4a43aa4656f')
- Children:
- 61eb53a68205301a8f2e44993354fbe213d648eb
- Parents:
- 229530c0e416b111939f7e2475c01b2a091b0e55
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
Singular/iparith.cc
r229530 r3dbee61 2052 2052 if ((r->minpoly != NULL) || (r->minideal != NULL)) 2053 2053 naSetChar(rInternalChar(r),r); 2054 else n tSetChar(rInternalChar(r),r);2054 else naSetChar(rInternalChar(r),r); 2055 2055 nSetChar(currRing); 2056 2056 test=save_test; -
Singular/ipassign.cc
r229530 r3dbee61 191 191 /* redefine function pointers due to switch from 192 192 transcendental to algebraic field extension */ 193 redefineFunctionPointers();193 //redefineFunctionPointers(); 194 194 // and now, normalize all already defined objects in this ring 195 195 idhdl h=currRing->idroot; -
Singular/ipshell.cc
r229530 r3dbee61 2336 2336 R->algring->qideal->m[0]=NULL; 2337 2337 idDelete(&(R->algring->qideal)); 2338 redefineFunctionPointers();2338 //redefineFunctionPointers(); 2339 2339 } 2340 2340 else … … 2409 2409 if ((orig_ring->minpoly != NULL) || (orig_ring->minideal != NULL)) 2410 2410 naSetChar(rInternalChar(orig_ring),orig_ring); 2411 else n tSetChar(rInternalChar(orig_ring),orig_ring);2411 else naSetChar(rInternalChar(orig_ring),orig_ring); 2412 2412 nSetChar(currRing); 2413 2413 test=save_test; -
kernel/longalg.cc
r229530 r3dbee61 26 26 #endif 27 27 #include <kernel/longalg.h> 28 #include <kernel/longtrans.h> 28 29 struct snaIdeal 30 { 31 int anz; 32 napoly *liste; 33 }; 34 typedef struct snaIdeal * naIdeal; 35 36 naIdeal naI=NULL; 37 38 omBin snaIdeal_bin = omGetSpecBin(sizeof(snaIdeal)); 39 40 int naNumbOfPar; 41 napoly naMinimalPoly; 42 #define naParNames (currRing->parameter) 43 static int naIsChar0; 44 static ring naMapRing; 29 45 30 46 #ifdef LDEBUG … … 35 51 #endif 36 52 37 naIdeal naI = NULL; 38 napoly naMinimalPoly; 39 omBin snaIdeal_bin = omGetSpecBin(sizeof(snaIdeal)); 40 number (*naMap)(number from); 41 //omBin lnumber_bin = omGetSpecBin(sizeof(slnumber)); 42 //omBin rnumber_bin = omGetSpecBin(sizeof(snumber)); 43 44 void redefineFunctionPointers() 45 { 46 n_Procs_s* n = currRing->cf; 47 /* re-defining function pointers */ 48 n->cfDelete = naDelete; 49 n->nNormalize = naNormalize; 50 n->cfInit = naInit; 51 n->nPar = naPar; 52 n->nParDeg = naParDeg; 53 n->n_Int = naInt; 54 n->nAdd = naAdd; 55 n->nSub = naSub; 56 n->nMult = naMult; 57 n->nDiv = naDiv; 58 n->nExactDiv = naDiv; 59 n->nIntDiv = naIntDiv; 60 n->nNeg = naNeg; 61 n->nInvers = naInvers; 62 n->nCopy = naCopy; 63 n->cfCopy = na_Copy; 64 n->nGreater = naGreater; 65 n->nEqual = naEqual; 66 n->nIsZero = naIsZero; 67 n->nIsOne = naIsOne; 68 n->nIsMOne = naIsMOne; 69 n->nGreaterZero = naGreaterZero; 70 n->nGreater = naGreater; 71 n->cfWrite = naWrite; 72 n->nRead = naRead; 73 n->nPower = naPower; 74 n->nGcd = naGcd; 75 n->nLcm = naLcm; 76 n->cfSetMap = naSetMap; 77 n->nName = naName; 78 n->nSize = naSize; 79 n->cfGetDenom = napGetDenom; 80 n->cfGetNumerator = napGetNumerator; 81 #ifdef LDEBUG 82 n->nDBTest = naDBTest; 83 #endif 84 /* re-defining global function pointers */ 85 nNormalize=naNormalize; 86 nPar = naPar; 87 nParDeg= nParDeg; 88 n_Int = naInt; 89 nAdd = naAdd; 90 nSub = naSub; 91 nMult = naMult; 92 nDiv = naDiv; 93 nExactDiv= naDiv; 94 nIntDiv= naIntDiv; 95 nNeg = naNeg; 96 nInvers= naInvers; 97 nCopy = naCopy; 98 nGreater = naGreater; 99 nEqual = naEqual; 100 nIsZero = naIsZero; 101 nIsOne = naIsOne; 102 nIsMOne = naIsMOne; 103 nGreaterZero = naGreaterZero; 104 nGreater = naGreater; 105 nRead = naRead; 106 nPower = naPower; 107 nGcd = naGcd; 108 nLcm = naLcm; 109 nName= naName; 110 nSize = naSize; 111 } 53 number (*naMap)(number from); 54 /* procedure variables */ 55 static numberfunc 56 nacMult, nacSub, nacAdd, nacDiv, nacIntDiv; 57 static number (*nacGcd)(number a, number b, const ring r); 58 static number (*nacLcm)(number a, number b, const ring r); 59 static number (*nacInit)(int i, const ring r); 60 static int (*nacInt)(number &n, const ring r); 61 static void (*nacDelete)(number *a, const ring r); 62 #undef n_Delete 63 #define n_Delete(A,R) nacDelete(A,R) 64 void (*nacNormalize)(number &a); 65 static number (*nacNeg)(number a); 66 number (*nacCopy)(number a); 67 static number (*nacInvers)(number a); 68 BOOLEAN (*nacIsZero)(number a); 69 static BOOLEAN (*nacIsOne)(number a); 70 static BOOLEAN (*nacIsMOne)(number a); 71 static BOOLEAN (*nacGreaterZero)(number a); 72 static const char * (*nacRead) (const char *s, number *a); 73 static napoly napRedp(napoly q); 74 static napoly napTailred(napoly q); 75 static BOOLEAN napDivPoly(napoly p, napoly q); 76 static int napExpi(int i, napoly a, napoly b); 77 ring nacRing; 78 79 void naCoefNormalize(number pp); 80 81 #define napCopy(p) p_Copy(p,nacRing) 112 82 113 83 static number nadGcd( number a, number b, const ring r) { return nacInit(1,r); } … … 117 87 void naSetChar(int i, ring r) 118 88 { 119 assume((r->minpoly != NULL) ||120 (r->minideal != NULL) );121 122 89 if (naI!=NULL) 123 90 { … … 140 107 else 141 108 naMinimalPoly = NULL; 142 143 109 if (r->minideal!=NULL) 144 110 { … … 154 120 } 155 121 156 n tNumbOfPar=rPar(r);122 naNumbOfPar=rPar(r); 157 123 if (i == 1) 158 ntIsChar0 = 1; 124 { 125 naIsChar0 = 1; 126 } 159 127 else if (i < 0) 160 128 { 161 n tIsChar0 = 0;129 naIsChar0 = 0; 162 130 npSetChar(-i, r->algring); // to be changed HS 163 131 } … … 177 145 nacNeg = nacRing->cf->nNeg; 178 146 nacIsZero = nacRing->cf->nIsZero; 147 nacRead = nacRing->cf->nRead; 179 148 nacGreaterZero = nacRing->cf->nGreaterZero; 180 nacGreater = nacRing->cf->nGreater;181 149 nacIsOne = nacRing->cf->nIsOne; 150 nacIsMOne = nacRing->cf->nIsMOne; 182 151 nacGcd = nacRing->cf->nGcd; 183 152 nacLcm = nacRing->cf->nLcm; … … 186 155 nacIntDiv = nacRing->cf->nIntDiv; 187 156 nacInvers = nacRing->cf->nInvers; 188 } 157 nacDelete = nacRing->cf->cfDelete; 158 } 159 160 /*============= procedure for polynomials: napXXXX =======================*/ 161 162 163 164 #ifdef LDEBUG 165 static void napTest(napoly p) 166 { 167 while (p != NULL) 168 { 169 if (naIsChar0) 170 nlDBTest(pGetCoeff(p), "", 0); 171 pIter(p); 172 } 173 } 174 #else 175 #define napTest(p) ((void) 0) 176 #endif 177 178 #define napSetCoeff(p,n) {n_Delete(&pGetCoeff(p),nacRing);pGetCoeff(p)=n;} 179 #define napComp(p,q) p_LmCmp((poly)p,(poly)q, nacRing) 180 #define napMultT(A,E) A=(napoly)p_Mult_mm((poly)A,(poly)E,nacRing) 181 #define napDeg(p) (int)p_Totaldegree(p, nacRing) 182 183 /*3 184 * creates an napoly 185 */ 186 napoly napInitz(number z) 187 { 188 napoly a = (napoly)p_Init(nacRing); 189 pGetCoeff(a) = z; 190 return a; 191 } 192 193 /*3 194 * copy a napoly. poly 195 */ 196 static napoly napCopyNeg(napoly p) 197 { 198 napoly r=napCopy(p); 199 r=(napoly)p_Neg((poly)r, nacRing); 200 return r; 201 } 202 203 /*3 204 * returns ph * z 205 */ 206 static void napMultN(napoly p, number z) 207 { 208 number t; 209 210 while (p!=NULL) 211 { 212 t = nacMult(pGetCoeff(p), z); 213 nacNormalize(t); 214 n_Delete(&pGetCoeff(p),nacRing); 215 pGetCoeff(p) = t; 216 pIter(p); 217 } 218 } 219 220 /*3 221 * division with rest; f = g*q + r, returns r and destroy f 222 */ 223 napoly napRemainder(napoly f, const napoly g) 224 { 225 napoly a, h, qq; 226 227 qq = (napoly)p_Init(nacRing); 228 pNext(qq) = NULL; 229 p_Normalize(g, nacRing); 230 p_Normalize(f, nacRing); 231 a = f; 232 do 233 { 234 napSetExp(qq,1, p_GetExp(a,1,nacRing) - p_GetExp(g,1,nacRing)); 235 napSetm(qq); 236 pGetCoeff(qq) = nacDiv(pGetCoeff(a), pGetCoeff(g)); 237 pGetCoeff(qq) = nacNeg(pGetCoeff(qq)); 238 nacNormalize(pGetCoeff(qq)); 239 h = napCopy(g); 240 napMultT(h, qq); 241 p_Normalize(h,nacRing); 242 n_Delete(&pGetCoeff(qq),nacRing); 243 a = napAdd(a, h); 244 } 245 while ((a!=NULL) && (p_GetExp(a,1,nacRing) >= p_GetExp(g,1,nacRing))); 246 omFreeBinAddr(qq); 247 return a; 248 } 249 250 /*3 251 * division with rest; f = g*q + r, destroy f 252 */ 253 static void napDivMod(napoly f, napoly g, napoly *q, napoly *r) 254 { 255 napoly a, h, b, qq; 256 257 qq = (napoly)p_Init(nacRing); 258 pNext(qq) = b = NULL; 259 p_Normalize(g,nacRing); 260 p_Normalize(f,nacRing); 261 a = f; 262 do 263 { 264 napSetExp(qq,1, p_GetExp(a,1,nacRing) - p_GetExp(g,1,nacRing)); 265 p_Setm(qq,nacRing); 266 pGetCoeff(qq) = nacDiv(pGetCoeff(a), pGetCoeff(g)); 267 nacNormalize(pGetCoeff(qq)); 268 b = napAdd(b, napCopy(qq)); 269 pGetCoeff(qq) = nacNeg(pGetCoeff(qq)); 270 h = napCopy(g); 271 napMultT(h, qq); 272 p_Normalize(h,nacRing); 273 n_Delete(&pGetCoeff(qq),nacRing); 274 a = napAdd(a, h); 275 } 276 while ((a!=NULL) && (p_GetExp(a,1,nacRing) >= p_GetExp(g,1,nacRing))); 277 omFreeBinAddr(qq); 278 *q = b; 279 *r = a; 280 } 281 282 /*3 283 * returns z with z*x mod c = 1 284 */ 285 static napoly napInvers(napoly x, const napoly c) 286 { 287 napoly y, r, qa, qn, q; 288 number t, h; 289 290 if (p_GetExp(x,1,nacRing) >= p_GetExp(c,1,nacRing)) 291 x = napRemainder(x, c); 292 if (x==NULL) 293 { 294 goto zero_divisor; 295 } 296 if (p_GetExp(x,1,nacRing)==0) 297 { 298 if (!nacIsOne(pGetCoeff(x))) 299 { 300 nacNormalize(pGetCoeff(x)); 301 t = nacInvers(pGetCoeff(x)); 302 nacNormalize(t); 303 n_Delete(&pGetCoeff(x),nacRing); 304 pGetCoeff(x) = t; 305 } 306 return x; 307 } 308 y = napCopy(c); 309 napDivMod(y, x, &qa, &r); 310 if (r==NULL) 311 { 312 goto zero_divisor; 313 } 314 if (p_GetExp(r,1,nacRing)==0) 315 { 316 nacNormalize(pGetCoeff(r)); 317 t = nacInvers(pGetCoeff(r)); 318 nacNormalize(t); 319 t = nacNeg(t); 320 napMultN(qa, t); 321 n_Delete(&t,nacRing); 322 p_Normalize(qa,nacRing); 323 p_Delete(&x,nacRing); 324 p_Delete(&r,nacRing); 325 return qa; 326 } 327 y = x; 328 x = r; 329 napDivMod(y, x, &q, &r); 330 if (r==NULL) 331 { 332 goto zero_divisor; 333 } 334 if (p_GetExp(r,1,nacRing)==0) 335 { 336 q = p_Mult_q(q, qa,nacRing); 337 q = napAdd(q, p_ISet(1,nacRing)); 338 nacNormalize(pGetCoeff(r)); 339 t = nacInvers(pGetCoeff(r)); 340 napMultN(q, t); 341 p_Normalize(q,nacRing); 342 n_Delete(&t,nacRing); 343 p_Delete(&x,nacRing); 344 p_Delete(&r,nacRing); 345 if (p_GetExp(q,1,nacRing) >= p_GetExp(c,1,nacRing)) 346 q = napRemainder(q, c); 347 return q; 348 } 349 q = p_Mult_q(q, napCopy(qa),nacRing); 350 q = napAdd(q, p_ISet(1,nacRing)); 351 qa = napNeg(qa); 352 loop 353 { 354 y = x; 355 x = r; 356 napDivMod(y, x, &qn, &r); 357 if (r==NULL) 358 { 359 break; 360 } 361 if (p_GetExp(r,1,nacRing)==0) 362 { 363 q = p_Mult_q(q, qn,nacRing); 364 q = napNeg(q); 365 q = napAdd(q, qa); 366 nacNormalize(pGetCoeff(r)); 367 t = nacInvers(pGetCoeff(r)); 368 //nacNormalize(t); 369 napMultN(q, t); 370 p_Normalize(q,nacRing); 371 n_Delete(&t,nacRing); 372 p_Delete(&x,nacRing); 373 p_Delete(&r,nacRing); 374 if (p_GetExp(q,1,nacRing) >= p_GetExp(c,1,nacRing)) 375 q = napRemainder(q, c); 376 return q; 377 } 378 y = q; 379 q = p_Mult_q(napCopy(q), qn, nacRing); 380 q = napNeg(q); 381 q = napAdd(q, qa); 382 qa = y; 383 } 384 // zero divisor found: 385 zero_divisor: 386 Werror("zero divisor found - your minpoly is not irreducible"); 387 return x; 388 } 389 390 /*3 391 * the max degree of an napoly poly (used for test of "simple" et al.) 392 */ 393 static int napMaxDeg(napoly p) 394 { 395 int d = 0; 396 while(p!=NULL) 397 { 398 d=si_max(d,napDeg(p)); 399 pIter(p); 400 } 401 return d; 402 } 403 404 /*3 405 * the max degree of an napoly poly (used for test of "simple" et al.) 406 */ 407 static int napMaxDegLen(napoly p, int &l) 408 { 409 int d = 0; 410 int ll=0; 411 while(p!=NULL) 412 { 413 d=si_max(d,napDeg(p)); 414 pIter(p); 415 ll++; 416 } 417 l=ll; 418 return d; 419 } 420 421 422 /*3 423 *writes a polynomial number 424 */ 425 void napWrite(napoly p,const BOOLEAN has_denom, const ring r) 426 { 427 ring nacring=r->algring; 428 if (p==NULL) 429 StringAppendS("0"); 430 else if (p_LmIsConstant(p,nacring)) 431 { 432 BOOLEAN kl=FALSE; 433 if (has_denom) 434 { 435 number den=nacring->cf->cfGetDenom(pGetCoeff(p),nacring ); 436 kl=!n_IsOne(den,nacring); 437 n_Delete(&den, nacring); 438 } 439 if (kl) StringAppendS("("); 440 //StringAppendS("-1"); 441 n_Write(pGetCoeff(p),nacring); 442 if (kl) StringAppendS(")"); 443 } 444 else 445 { 446 StringAppendS("("); 447 loop 448 { 449 BOOLEAN wroteCoeff=FALSE; 450 if ((p_LmIsConstant(p,nacring)) 451 || ((!n_IsOne(pGetCoeff(p),nacring)) 452 && (!n_IsMOne(pGetCoeff(p),nacring)))) 453 { 454 n_Write(pGetCoeff(p),nacring); 455 wroteCoeff=(r->ShortOut==0); 456 } 457 else if (n_IsMOne(pGetCoeff(p),nacring)) 458 { 459 StringAppendS("-"); 460 } 461 int i; 462 for (i = 0; i < r->P; i++) 463 { 464 int e=p_GetExp(p,i+1,nacring); 465 if (e > 0) 466 { 467 if (wroteCoeff) 468 StringAppendS("*"); 469 else 470 wroteCoeff=(r->ShortOut==0); 471 StringAppendS(r->parameter[i]); 472 if (e > 1) 473 { 474 if (r->ShortOut == 0) 475 StringAppendS("^"); 476 StringAppend("%d", e); 477 } 478 } 479 } /*for*/ 480 pIter(p); 481 if (p==NULL) 482 break; 483 if (n_GreaterZero(pGetCoeff(p),nacring)) 484 StringAppendS("+"); 485 } 486 StringAppendS(")"); 487 } 488 } 489 490 491 static const char *napHandleMons(const char *s, int i, napoly ex) 492 { 493 int j; 494 if (strncmp(s,naParNames[i],strlen(naParNames[i]))==0) 495 { 496 s+=strlen(naParNames[i]); 497 if ((*s >= '0') && (*s <= '9')) 498 { 499 s = eati(s, &j); 500 napAddExp(ex,i+1,j); 501 } 502 else 503 napAddExp(ex,i+1,1); 504 } 505 return s; 506 } 507 static const char *napHandlePars(const char *s, int i, napoly ex) 508 { 509 int j; 510 if (strcmp(s,naParNames[i])==0) 511 { 512 s+=strlen(naParNames[i]); 513 napSetExp(ex,i+1,1); 514 } 515 return s; 516 } 517 518 /*3 reads a monomial */ 519 static const char *napRead(const char *s, napoly *b) 520 { 521 napoly a; 522 int i; 523 a = (napoly)p_Init(nacRing); 524 if ((*s >= '0') && (*s <= '9')) 525 { 526 s = nacRead(s, &pGetCoeff(a)); 527 if (nacIsZero(pGetCoeff(a))) 528 { 529 p_LmDelete(&a,nacRing); 530 *b = NULL; 531 return s; 532 } 533 } 534 else 535 pGetCoeff(a) = nacInit(1,nacRing); 536 i = 0; 537 const char *olds=s; 538 loop 539 { 540 s = napHandlePars(s, i, a); 541 if (olds == s) 542 i++; 543 else if (*s == '\0') 544 { 545 *b = a; 546 return s; 547 } 548 if (i >= naNumbOfPar) 549 break; 550 } 551 i=0; 552 loop 553 { 554 olds = s; 555 s = napHandleMons(s, i, a); 556 if (olds == s) 557 i++; 558 else 559 i = 0; 560 if ((*s == '\0') || (i >= naNumbOfPar)) 561 break; 562 } 563 *b = a; 564 return s; 565 } 566 567 static int napExp(napoly a, napoly b) 568 { 569 while (pNext(a)!=NULL) pIter(a); 570 int m = p_GetExp(a,1,nacRing); 571 if (m==0) return 0; 572 while (pNext(b)!=NULL) pIter(b); 573 int mm=p_GetExp(b,1,nacRing); 574 if (m > mm) m = mm; 575 return m; 576 } 577 578 /* 579 * finds the smallest i-th exponent in a and b 580 * used to find it in a fraction 581 */ 582 static int napExpi(int i, napoly a, napoly b) 583 { 584 if (a==NULL || b==NULL) return 0; 585 int m = p_GetExp(a,i+1,nacRing); 586 if (m==0) return 0; 587 while (pNext(a) != NULL) 588 { 589 pIter(a); 590 if (m > p_GetExp(a,i+1,nacRing)) 591 { 592 m = p_GetExp(a,i+1,nacRing); 593 if (m==0) return 0; 594 } 595 } 596 do 597 { 598 if (m > p_GetExp(b,i+1,nacRing)) 599 { 600 m = p_GetExp(b,i+1,nacRing); 601 if (m==0) return 0; 602 } 603 pIter(b); 604 } 605 while (b != NULL); 606 return m; 607 } 608 609 static void napContent(napoly ph) 610 { 611 number h,d; 612 napoly p; 613 614 p = ph; 615 if (nacIsOne(pGetCoeff(p))) 616 return; 617 h = nacCopy(pGetCoeff(p)); 618 pIter(p); 619 do 620 { 621 d=nacGcd(pGetCoeff(p), h, nacRing); 622 if(nacIsOne(d)) 623 { 624 n_Delete(&h,nacRing); 625 n_Delete(&d,nacRing); 626 return; 627 } 628 n_Delete(&h,nacRing); 629 h = d; 630 pIter(p); 631 } 632 while (p!=NULL); 633 h = nacInvers(d); 634 n_Delete(&d,nacRing); 635 p = ph; 636 while (p!=NULL) 637 { 638 d = nacMult(pGetCoeff(p), h); 639 n_Delete(&pGetCoeff(p),nacRing); 640 pGetCoeff(p) = d; 641 pIter(p); 642 } 643 n_Delete(&h,nacRing); 644 } 645 646 static void napCleardenom(napoly ph) 647 { 648 number d, h; 649 napoly p; 650 651 if (!naIsChar0) 652 return; 653 p = ph; 654 h = nacInit(1,nacRing); 655 while (p!=NULL) 656 { 657 d = nacLcm(h, pGetCoeff(p), nacRing); 658 n_Delete(&h,nacRing); 659 h = d; 660 pIter(p); 661 } 662 if(!nacIsOne(h)) 663 { 664 p = ph; 665 while (p!=NULL) 666 { 667 d=nacMult(h, pGetCoeff(p)); 668 n_Delete(&pGetCoeff(p),nacRing); 669 nacNormalize(d); 670 pGetCoeff(p) = d; 671 pIter(p); 672 } 673 n_Delete(&h,nacRing); 674 } 675 napContent(ph); 676 } 677 678 static napoly napGcd0(napoly a, napoly b) 679 { 680 number x, y; 681 if (!naIsChar0) 682 return p_ISet(1,nacRing); 683 x = nacCopy(pGetCoeff(a)); 684 if (nacIsOne(x)) 685 return napInitz(x); 686 while (pNext(a)!=NULL) 687 { 688 pIter(a); 689 y = nacGcd(x, pGetCoeff(a), nacRing); 690 n_Delete(&x,nacRing); 691 x = y; 692 if (nacIsOne(x)) 693 return napInitz(x); 694 } 695 do 696 { 697 y = nacGcd(x, pGetCoeff(b), nacRing); 698 n_Delete(&x,nacRing); 699 x = y; 700 if (nacIsOne(x)) 701 return napInitz(x); 702 pIter(b); 703 } 704 while (b!=NULL); 705 return napInitz(x); 706 } 707 708 /*3 709 * result =gcd(a,b) 710 */ 711 static napoly napGcd(napoly a, napoly b) 712 { 713 int i; 714 napoly g, x, y, h; 715 if ((a==NULL) 716 || ((pNext(a)==NULL)&&(nacIsZero(pGetCoeff(a))))) 717 { 718 if ((b==NULL) 719 || ((pNext(b)==NULL)&&(nacIsZero(pGetCoeff(b))))) 720 { 721 return p_ISet(1,nacRing); 722 } 723 return napCopy(b); 724 } 725 else 726 if ((b==NULL) 727 || ((pNext(b)==NULL)&&(nacIsZero(pGetCoeff(b))))) 728 { 729 return napCopy(a); 730 } 731 if (naMinimalPoly != NULL) 732 { 733 if (p_GetExp(a,1,nacRing) >= p_GetExp(b,1,nacRing)) 734 { 735 x = a; 736 y = b; 737 } 738 else 739 { 740 x = b; 741 y = a; 742 } 743 if (!naIsChar0) g = p_ISet(1,nacRing); 744 else g = napGcd0(x, y); 745 if (pNext(y)==NULL) 746 { 747 napSetExp(g,1, napExp(x, y)); 748 p_Setm(g,nacRing); 749 return g; 750 } 751 x = napCopy(x); 752 y = napCopy(y); 753 loop 754 { 755 h = napRemainder(x, y); 756 if (h==NULL) 757 { 758 napCleardenom(y); 759 if (!nacIsOne(pGetCoeff(g))) 760 napMultN(y, pGetCoeff(g)); 761 p_LmDelete(&g,nacRing); 762 return y; 763 } 764 else if (pNext(h)==NULL) 765 break; 766 x = y; 767 y = h; 768 } 769 p_Delete(&y,nacRing); 770 p_LmDelete(&h,nacRing); 771 napSetExp(g,1, napExp(a, b)); 772 p_Setm(g,nacRing); 773 return g; 774 } 775 // Hmm ... this is a memory leak 776 // x = (napoly)p_Init(nacRing); 777 g=a; 778 h=b; 779 if (!naIsChar0) x = p_ISet(1,nacRing); 780 else x = napGcd0(g,h); 781 for (i=(naNumbOfPar-1); i>=0; i--) 782 { 783 napSetExp(x,i+1, napExpi(i,a,b)); 784 p_Setm(x,nacRing); 785 } 786 return x; 787 } 788 789 790 number napLcm(napoly a) 791 { 792 number h = nacInit(1,nacRing); 793 794 if (naIsChar0) 795 { 796 number d; 797 napoly b = a; 798 799 while (b!=NULL) 800 { 801 d = nacLcm(h, pGetCoeff(b), nacRing); 802 n_Delete(&h,nacRing); 803 h = d; 804 pIter(b); 805 } 806 } 807 return h; 808 } 809 810 811 /*2 812 * meins (for reduction in algebraic extension) 813 * checks if head of p divides head of q 814 * doesn't delete p and q 815 */ 816 static BOOLEAN napDivPoly (napoly p, napoly q) 817 { 818 int j=1; /* evtl. von naNumber.. -1 abwaerts zaehlen */ 819 820 while (p_GetExp(p,j,nacRing) <= p_GetExp(q,j,nacRing)) 821 { 822 j++; 823 if (j > naNumbOfPar) 824 return 1; 825 } 826 return 0; 827 } 828 829 830 /*2 831 * meins (for reduction in algebraic extension) 832 * Normalform of poly with naI 833 * changes q and returns it 834 */ 835 napoly napRedp (napoly q) 836 { 837 napoly h = (napoly)p_Init(nacRing); 838 int i=0,j; 839 840 loop 841 { 842 if (napDivPoly (naI->liste[i], q)) 843 { 844 /* h = lt(q)/lt(naI->liste[i])*/ 845 pGetCoeff(h) = nacCopy(pGetCoeff(q)); 846 for (j=naNumbOfPar; j>0; j--) 847 napSetExp(h,j, p_GetExp(q,j,nacRing) - p_GetExp(naI->liste[i],j,nacRing)); 848 p_Setm(h,nacRing); 849 h = p_Mult_q(h, napCopy(naI->liste[i]),nacRing); 850 h = napNeg (h); 851 q = napAdd (q, napCopy(h)); 852 p_Delete (&pNext(h),nacRing); 853 if (q == NULL) 854 { 855 p_Delete(&h,nacRing); 856 return q; 857 } 858 /* try to reduce further */ 859 i = 0; 860 } 861 else 862 { 863 i++; 864 if (i >= naI->anz) 865 { 866 p_Delete(&h,nacRing); 867 return q; 868 } 869 } 870 } 871 } 872 873 874 /*2 875 * meins (for reduction in algebraic extension) 876 * reduces the tail of Poly q 877 * needs q != NULL 878 * changes q and returns it 879 */ 880 napoly napTailred (napoly q) 881 { 882 napoly h; 883 884 h = pNext(q); 885 while (h != NULL) 886 { 887 h = napRedp (h); 888 if (h == NULL) 889 return q; 890 pIter(h); 891 } 892 return q; 893 } 894 189 895 190 896 /*================ procedure for rational functions: naXXXX =================*/ … … 202 908 poly z=p_Init(r->algring); 203 909 pSetCoeff0(z,c); 204 lnumber l = ALLOC_LNUMBER();910 lnumber l = (lnumber)omAllocBin(rnumber_bin); 205 911 l->z = z; 206 912 l->s = 2; … … 215 921 number naPar(int i) 216 922 { 217 lnumber l = ALLOC_LNUMBER();923 lnumber l = (lnumber)omAllocBin(rnumber_bin); 218 924 l->s = 2; 219 925 l->z = p_ISet(1,nacRing); … … 272 978 p_Delete(&(l->z),r->algring); 273 979 p_Delete(&(l->n),r->algring); 274 FREE_LNUMBER(l);980 omFreeBin((ADDRESS)l, rnumber_bin); 275 981 } 276 982 *p = NULL; … … 286 992 lnumber erg; 287 993 lnumber src = (lnumber)p; 288 erg = ALLOC_LNUMBER();994 erg = (lnumber)omAlloc0Bin(rnumber_bin); 289 995 erg->z = p_Copy(src->z, nacRing); 290 996 erg->n = p_Copy(src->n, nacRing); … … 297 1003 lnumber erg; 298 1004 lnumber src = (lnumber)p; 299 erg = (lnumber) ALLOC_LNUMBER();1005 erg = (lnumber)omAlloc0Bin(rnumber_bin); 300 1006 erg->z = p_Copy(src->z,r->algring); 301 1007 erg->n = p_Copy(src->n,r->algring); … … 317 1023 lnumber b = (lnumber)lb; 318 1024 #ifdef LDEBUG 319 omCheckAddrSize(a,sizeof(s lnumber));320 omCheckAddrSize(b,sizeof(s lnumber));1025 omCheckAddrSize(a,sizeof(snumber)); 1026 omCheckAddrSize(b,sizeof(snumber)); 321 1027 #endif 322 1028 if (b->n!=NULL) x = pp_Mult_qq(a->z, b->n,nacRing); … … 329 1035 return (number)NULL; 330 1036 } 331 lu = ALLOC_LNUMBER();1037 lu = (lnumber)omAllocBin(rnumber_bin); 332 1038 lu->z=res; 333 1039 if (a->n!=NULL) … … 385 1091 386 1092 #ifdef LDEBUG 387 omCheckAddrSize(a,sizeof(s lnumber));388 omCheckAddrSize(b,sizeof(s lnumber));1093 omCheckAddrSize(a,sizeof(snumber)); 1094 omCheckAddrSize(b,sizeof(snumber)); 389 1095 #endif 390 1096 … … 399 1105 return (number)NULL; 400 1106 } 401 lu = ALLOC_LNUMBER();1107 lu = (lnumber)omAllocBin(rnumber_bin); 402 1108 lu->z=res; 403 1109 if (a->n!=NULL) … … 431 1137 number naMult(number la, number lb) 432 1138 { 433 if ((la==NULL) || (lb==NULL)) /* never occurs even when la or lb 434 represents zero??? */ 1139 if ((la==NULL) || (lb==NULL)) 435 1140 return NULL; 436 1141 … … 441 1146 442 1147 #ifdef LDEBUG 443 omCheckAddrSize(a,sizeof(s lnumber));444 omCheckAddrSize(b,sizeof(s lnumber));1148 omCheckAddrSize(a,sizeof(snumber)); 1149 omCheckAddrSize(b,sizeof(snumber)); 445 1150 #endif 446 1151 naTest(la); 447 1152 naTest(lb); 448 1153 449 lo = ALLOC_LNUMBER();1154 lo = (lnumber)omAllocBin(rnumber_bin); 450 1155 lo->z = pp_Mult_qq(a->z, b->z,nacRing); 451 1156 … … 470 1175 if (naMinimalPoly!=NULL) 471 1176 { 472 if ((lo->z != NULL) && 473 (p_GetExp(lo->z,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing))) 1177 if (p_GetExp(lo->z,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing)) 474 1178 lo->z = napRemainder(lo->z, naMinimalPoly); 475 if ((x!=NULL) && 476 (p_GetExp(x,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing))) 1179 if ((x!=NULL) && (p_GetExp(x,1,nacRing) >= p_GetExp(naMinimalPoly,1,nacRing))) 477 1180 x = napRemainder(x, naMinimalPoly); 478 1181 } … … 495 1198 if(lo->z==NULL) 496 1199 { 497 FREE_LNUMBER(lo);1200 omFreeBin((ADDRESS)lo, rnumber_bin); 498 1201 lo=NULL; 499 1202 } … … 527 1230 assume(a->z!=NULL && b->z!=NULL); 528 1231 assume(a->n==NULL && b->n==NULL); 529 res = ALLOC_LNUMBER();1232 res = (lnumber)omAllocBin(rnumber_bin); 530 1233 res->z = napCopy(a->z); 531 1234 res->n = napCopy(b->z); … … 558 1261 } 559 1262 #ifdef LDEBUG 560 omCheckAddrSize(a,sizeof(s lnumber));561 omCheckAddrSize(b,sizeof(s lnumber));1263 omCheckAddrSize(a,sizeof(snumber)); 1264 omCheckAddrSize(b,sizeof(snumber)); 562 1265 #endif 563 lo = ALLOC_LNUMBER();1266 lo = (lnumber)omAllocBin(rnumber_bin); 564 1267 if (b->n!=NULL) 565 1268 lo->z = pp_Mult_qq(a->z, b->n,nacRing); … … 635 1338 } 636 1339 #ifdef LDEBUG 637 omCheckAddrSize(b,sizeof(s lnumber));1340 omCheckAddrSize(b,sizeof(snumber)); 638 1341 #endif 639 lo = ALLOC0_LNUMBER();1342 lo = (lnumber)omAlloc0Bin(rnumber_bin); 640 1343 lo->s = b->s; 641 1344 if (b->n!=NULL) … … 744 1447 745 1448 746 /* This method will only consider the numerators of a and b.747 Moreover it may return TRUE only if one or both numerators748 are zero or if their degrees are equal. Then TRUE is returned iff749 coeff(numerator(a)) > coeff(numerator(b));750 In all other cases, FALSE will be returned. */751 1449 BOOLEAN naGreater (number a, number b) 752 1450 { 753 int az = 0; int ad = 0; 754 if (naIsZero(a)) az = 1; 755 else ad = napDeg(((lnumber)a)->z); 756 int bz = 0; int bd = 0; 757 if (naIsZero(b)) bz = 1; 758 else bd = napDeg(((lnumber)b)->z); 759 760 if ((az == 1) && (bz == 1)) /* a = b = 0 */ return FALSE; 761 if (az == 1) /* a = 0, b != 0 */ 762 { 763 return (!nacGreaterZero(pGetCoeff(((lnumber)b)->z))); 764 } 765 if (bz == 1) /* a != 0, b = 0 */ 766 { 767 return (nacGreaterZero(pGetCoeff(((lnumber)a)->z))); 768 } 769 if (ad == bd) 770 return nacGreater(pGetCoeff(((lnumber)a)->z), 771 pGetCoeff(((lnumber)b)->z)); 772 return FALSE; 1451 if (naIsZero(a)) 1452 return FALSE; 1453 if (naIsZero(b)) 1454 return TRUE; /* a!= 0)*/ 1455 return napDeg(((lnumber)a)->z)>napDeg(((lnumber)b)->z); 773 1456 } 774 1457 … … 786 1469 return s; 787 1470 } 788 *p = (number) ALLOC0_LNUMBER();1471 *p = (number)omAlloc0Bin(rnumber_bin); 789 1472 a = (lnumber)*p; 790 1473 if ((naMinimalPoly!=NULL) … … 801 1484 if(a->z==NULL) 802 1485 { 803 FREE_LNUMBER(a);1486 omFreeBin((ADDRESS)*p, rnumber_bin); 804 1487 *p=NULL; 805 1488 } … … 822 1505 return NULL; 823 1506 int i; 824 char *s=(char *)omAlloc(4* n tNumbOfPar);1507 char *s=(char *)omAlloc(4* naNumbOfPar); 825 1508 char *t=(char *)omAlloc(8); 826 1509 s[0]='\0'; 827 for (i = 0; i <= n tNumbOfPar - 1; i++)1510 for (i = 0; i <= naNumbOfPar - 1; i++) 828 1511 { 829 1512 int e=p_GetExp(ph->z,i+1,nacRing); … … 832 1515 if (e >1) 833 1516 { 834 sprintf(t,"%s%d",n tParNames[i],e);1517 sprintf(t,"%s%d",naParNames[i],e); 835 1518 strcat(s,t); 836 1519 } 837 1520 else 838 1521 { 839 strcat(s,n tParNames[i]);1522 strcat(s,naParNames[i]); 840 1523 } 841 1524 } … … 881 1564 if (a==NULL) return FALSE; 882 1565 #ifdef LDEBUG 883 omCheckAddrSize(a,sizeof(s lnumber));1566 omCheckAddrSize(a,sizeof(snumber)); 884 1567 if (a->z==NULL) 885 1568 { … … 939 1622 if (a==NULL) return FALSE; 940 1623 #ifdef LDEBUG 941 omCheckAddrSize(a,sizeof(s lnumber));1624 omCheckAddrSize(a,sizeof(snumber)); 942 1625 if (a->z==NULL) 943 1626 { … … 948 1631 if (a->n==NULL) 949 1632 { 950 if (p_LmIsConstant(a->z,nacRing)) return n _IsMOne(pGetCoeff(a->z),nacRing);1633 if (p_LmIsConstant(a->z,nacRing)) return nacIsMOne(pGetCoeff(a->z)); 951 1634 /*else return FALSE;*/ 952 1635 } … … 978 1661 979 1662 lnumber x, y; 980 lnumber result = ALLOC0_LNUMBER();1663 lnumber result = (lnumber)omAlloc0Bin(rnumber_bin); 981 1664 982 1665 x = (lnumber)a; 983 1666 y = (lnumber)b; 984 if ((n tNumbOfPar == 1) && (naMinimalPoly!=NULL))1667 if ((naNumbOfPar == 1) && (naMinimalPoly!=NULL)) 985 1668 { 986 1669 if (pNext(x->z)!=NULL) … … 1022 1705 1023 1706 /*2 1024 * n tNumbOfPar = 1:1707 * naNumbOfPar = 1: 1025 1708 * clears denominator algebraic case; 1026 1709 * tries to simplify ratio transcendental case; … … 1028 1711 * cancels monomials 1029 1712 * occuring in denominator 1030 * and enumerator ? n tNumbOfPar != 1;1713 * and enumerator ? naNumbOfPar != 1; 1031 1714 * 1032 1715 * #defines for Factory: … … 1165 1848 p->z = x; 1166 1849 p->n = y = NULL; 1167 norm=n tIsChar0;1850 norm=naIsChar0; 1168 1851 } 1169 1852 … … 1175 1858 x = napRemainder(x, naMinimalPoly); 1176 1859 p->z = x; 1177 norm=n tIsChar0;1860 norm=naIsChar0; 1178 1861 } 1179 1862 /* normalize all coefficients in n and z (if in Q) */ … … 1189 1872 { 1190 1873 int i; 1191 for (i=n tNumbOfPar-1; i>=0; i--)1874 for (i=naNumbOfPar-1; i>=0; i--) 1192 1875 { 1193 1876 napoly xx=x; … … 1228 1911 } 1229 1912 #ifndef FACTORY_GCD_TEST 1230 if (n tNumbOfPar == 1) /* apply built-in gcd */1913 if (naNumbOfPar == 1) /* apply built-in gcd */ 1231 1914 { 1232 1915 napoly x1,y1; … … 1263 1946 y = p->n; 1264 1947 /* collect all denoms from y and multiply x and y by it */ 1265 if (n tIsChar0)1948 if (naIsChar0) 1266 1949 { 1267 1950 number n=napLcm(y); … … 1378 2061 lnumber a = (lnumber)la; 1379 2062 lnumber b = (lnumber)lb; 1380 result = ALLOC0_LNUMBER(); 2063 result = (lnumber)omAlloc0Bin(rnumber_bin); 2064 //if (((naMinimalPoly==NULL) && (naI==NULL)) || !naIsChar0) 2065 //{ 2066 // result->z = p_ISet(1,nacRing); 2067 // return (number)result; 2068 //} 2069 //naNormalize(lb); 1381 2070 naTest(la); 1382 2071 naTest(lb); … … 1464 2153 { 1465 2154 if (npIsZero(c)) return NULL; 1466 lnumber l= ALLOC_LNUMBER();2155 lnumber l=(lnumber)omAllocBin(rnumber_bin); 1467 2156 l->s=2; 1468 2157 l->z=(napoly)p_Init(nacRing); 1469 2158 int i=(int)((long)c); 1470 if (i>((long)n tMapRing->ch>>2)) i-=(long)ntMapRing->ch;2159 if (i>((long)naMapRing->ch>>2)) i-=(long)naMapRing->ch; 1471 2160 pGetCoeff(l->z)=nlInit(i, nacRing); 1472 2161 l->n=NULL; … … 1480 2169 { 1481 2170 if (nlIsZero(c)) return NULL; 1482 lnumber l= ALLOC_LNUMBER();2171 lnumber l=(lnumber)omAllocBin(rnumber_bin); 1483 2172 l->s=0; 1484 2173 l->z=(napoly)p_Init(nacRing); … … 1494 2183 { 1495 2184 if (npIsZero(c)) return NULL; 1496 lnumber l= ALLOC_LNUMBER();2185 lnumber l=(lnumber)omAllocBin(rnumber_bin); 1497 2186 l->s=2; 1498 2187 l->z=(napoly)p_Init(nacRing); … … 1509 2198 if (npIsZero(c)) return NULL; 1510 2199 int i=(int)((long)c); 1511 if (i>(long)n tMapRing->ch) i-=(long)ntMapRing->ch;1512 number n=npInit(i,n tMapRing);2200 if (i>(long)naMapRing->ch) i-=(long)naMapRing->ch; 2201 number n=npInit(i,naMapRing); 1513 2202 if (npIsZero(n)) return NULL; 1514 lnumber l= ALLOC_LNUMBER();2203 lnumber l=(lnumber)omAllocBin(rnumber_bin); 1515 2204 l->s=2; 1516 2205 l->z=(napoly)p_Init(nacRing); … … 1529 2218 if (npIsZero(n)) return NULL; 1530 2219 npTest(n); 1531 lnumber l= ALLOC_LNUMBER();2220 lnumber l=(lnumber)omAllocBin(rnumber_bin); 1532 2221 l->s=2; 1533 2222 l->z=(napoly)p_Init(nacRing); … … 1537 2226 } 1538 2227 2228 static number (*nacMap)(number); 2229 static int naParsToCopy; 2230 static napoly napMap(napoly p) 2231 { 2232 napoly w, a; 2233 2234 if (p==NULL) return NULL; 2235 a = w = (napoly)p_Init(nacRing); 2236 int i; 2237 for(i=1;i<=naParsToCopy;i++) 2238 napSetExp(a,i,napGetExpFrom(p,i,naMapRing)); 2239 p_Setm(a,nacRing); 2240 pGetCoeff(w) = nacMap(pGetCoeff(p)); 2241 loop 2242 { 2243 pIter(p); 2244 if (p==NULL) break; 2245 pNext(a) = (napoly)p_Init(nacRing); 2246 pIter(a); 2247 for(i=1;i<=naParsToCopy;i++) 2248 napSetExp(a,i,napGetExpFrom(p,i,naMapRing)); 2249 p_Setm(a,nacRing); 2250 pGetCoeff(a) = nacMap(pGetCoeff(p)); 2251 } 2252 pNext(a) = NULL; 2253 return w; 2254 } 2255 2256 static napoly napPerm(napoly p,const int *par_perm,const ring src_ring,const nMapFunc nMap) 2257 { 2258 napoly w, a; 2259 2260 if (p==NULL) return NULL; 2261 w = (napoly)p_Init(nacRing); 2262 int i; 2263 BOOLEAN not_null=TRUE; 2264 loop 2265 { 2266 for(i=1;i<=rPar(src_ring);i++) 2267 { 2268 int e; 2269 if (par_perm!=NULL) e=par_perm[i-1]; 2270 else e=-i; 2271 int ee=napGetExpFrom(p,i,src_ring); 2272 if (e<0) 2273 napSetExp(w,-e,ee); 2274 else if (ee>0) 2275 not_null=FALSE; 2276 } 2277 pGetCoeff(w) = nMap(pGetCoeff(p)); 2278 p_Setm(w,nacRing); 2279 pIter(p); 2280 if (!not_null) 2281 { 2282 if (p==NULL) 2283 { 2284 p_Delete(&w,nacRing); 2285 return NULL; 2286 } 2287 /* else continue*/ 2288 n_Delete(&(pGetCoeff(w)),nacRing); 2289 } 2290 else 2291 { 2292 if (p==NULL) return w; 2293 else 2294 { 2295 pNext(w)=napPerm(p,par_perm,src_ring,nMap); 2296 return w; 2297 } 2298 } 2299 } 2300 } 2301 1539 2302 /*2 1540 2303 * map _(a) -> _(b) … … 1543 2306 { 1544 2307 if (c==NULL) return NULL; 1545 lnumber erg= ALLOC_LNUMBER();2308 lnumber erg= (lnumber)omAlloc0Bin(rnumber_bin); 1546 2309 lnumber src =(lnumber)c; 1547 2310 erg->s=src->s; … … 1573 2336 nMapFunc naSetMap(const ring src, const ring dst) 1574 2337 { 1575 n tMapRing=src;2338 naMapRing=src; 1576 2339 if (rField_is_Q_a(dst)) /* -> Q(a) */ 1577 2340 { … … 1587 2350 { 1588 2351 int i; 1589 n tParsToCopy=0;2352 naParsToCopy=0; 1590 2353 for(i=0;i<rPar(src);i++) 1591 2354 { … … 1593 2356 ||(strcmp(src->parameter[i],dst->parameter[i])!=0)) 1594 2357 return NULL; 1595 n tParsToCopy++;2358 naParsToCopy++; 1596 2359 } 1597 2360 nacMap=nacCopy; 1598 if ((n tParsToCopy==rPar(dst))&&(ntParsToCopy==rPar(src)))2361 if ((naParsToCopy==rPar(dst))&&(naParsToCopy==rPar(src))) 1599 2362 return naCopy; /* Q(a) -> Q(a) */ 1600 2363 return naMapQaQb; /* Q(a..) -> Q(a..) */ … … 1630 2393 } 1631 2394 int i; 1632 n tParsToCopy=0;2395 naParsToCopy=0; 1633 2396 for(i=0;i<rPar(src);i++) 1634 2397 { … … 1636 2399 ||(strcmp(src->parameter[i],dst->parameter[i])!=0)) 1637 2400 return NULL; 1638 n tParsToCopy++;1639 } 1640 if ((n tParsToCopy==rPar(dst))&&(ntParsToCopy==rPar(src))2401 naParsToCopy++; 2402 } 2403 if ((naParsToCopy==rPar(dst))&&(naParsToCopy==rPar(src)) 1641 2404 && (nacMap==nacCopy)) 1642 2405 return naCopy; /* Z/p(a) -> Z/p(a) */ … … 1645 2408 } 1646 2409 return NULL; /* default */ 2410 } 2411 2412 /*2 2413 * convert a napoly number into a poly 2414 */ 2415 poly naPermNumber(number z, int * par_perm, int P, ring oldRing) 2416 { 2417 if (z==NULL) return NULL; 2418 poly res=NULL; 2419 poly p; 2420 napoly za=((lnumber)z)->z; 2421 napoly zb=((lnumber)z)->n; 2422 nMapFunc nMap=naSetMap(oldRing,currRing); 2423 if (currRing->parameter!=NULL) 2424 nMap=currRing->algring->cf->cfSetMap(oldRing->algring, nacRing); 2425 else 2426 nMap=currRing->cf->cfSetMap(oldRing->algring, currRing); 2427 if (nMap==NULL) return NULL; /* emergency exit only */ 2428 do 2429 { 2430 p = pInit(); 2431 pNext(p)=NULL; 2432 nNew(&pGetCoeff(p)); 2433 int i; 2434 for(i=pVariables;i;i--) 2435 pSetExp(p,i, 0); 2436 if (rRing_has_Comp(currRing)) pSetComp(p, 0); 2437 napoly pa=NULL; 2438 lnumber pan; 2439 if (currRing->parameter!=NULL) 2440 { 2441 assume(oldRing->algring!=NULL); 2442 pGetCoeff(p)=(number)omAlloc0Bin(rnumber_bin); 2443 pan=(lnumber)pGetCoeff(p); 2444 pan->s=2; 2445 pan->z=napInitz(nMap(pGetCoeff(za))); 2446 pa=pan->z; 2447 } 2448 else 2449 { 2450 pGetCoeff(p)=nMap(pGetCoeff(za)); 2451 } 2452 for(i=0;i<P;i++) 2453 { 2454 if(napGetExpFrom(za,i+1,oldRing)!=0) 2455 { 2456 if(par_perm==NULL) 2457 { 2458 if ((rPar(currRing)>=i) && (pa!=NULL)) 2459 { 2460 napSetExp(pa,i+1,napGetExpFrom(za,i+1,oldRing)); 2461 p_Setm(pa,nacRing); 2462 } 2463 else 2464 { 2465 pDelete(&p); 2466 break; 2467 } 2468 } 2469 else if(par_perm[i]>0) 2470 pSetExp(p,par_perm[i],napGetExpFrom(za,i+1,oldRing)); 2471 else if((par_perm[i]<0)&&(pa!=NULL)) 2472 { 2473 napSetExp(pa,-par_perm[i], napGetExpFrom(za,i+1,oldRing)); 2474 p_Setm(pa,nacRing); 2475 } 2476 else 2477 { 2478 pDelete(&p); 2479 break; 2480 } 2481 } 2482 } 2483 if (p!=NULL) 2484 { 2485 pSetm(p); 2486 if (zb!=NULL) 2487 { 2488 if (currRing->P>0) 2489 { 2490 pan->n=napPerm(zb,par_perm,oldRing,nMap); 2491 if(pan->n==NULL) /* error in mapping or mapping to variable */ 2492 pDelete(&p); 2493 } 2494 else 2495 pDelete(&p); 2496 } 2497 pTest(p); 2498 res=pAdd(res,p); 2499 } 2500 pIter(za); 2501 } 2502 while (za!=NULL); 2503 pTest(res); 2504 return res; 2505 } 2506 2507 number naGetDenom(number &n, const ring r) 2508 { 2509 lnumber x=(lnumber)n; 2510 if (x->n!=NULL) 2511 { 2512 lnumber rr=(lnumber)omAlloc0Bin(rnumber_bin); 2513 rr->z=p_Copy(x->n,r->algring); 2514 rr->s = 2; 2515 return (number)rr; 2516 } 2517 return n_Init(1,r); 2518 } 2519 2520 number naGetNumerator(number &n, const ring r) 2521 { 2522 lnumber x=(lnumber)n; 2523 lnumber rr=(lnumber)omAlloc0Bin(rnumber_bin); 2524 rr->z=p_Copy(x->z,r->algring); 2525 rr->s = 2; 2526 return (number)rr; 1647 2527 } 1648 2528 … … 1654 2534 return TRUE; 1655 2535 #ifdef LDEBUG 1656 omCheckAddrSize(a, sizeof(s lnumber));2536 omCheckAddrSize(a, sizeof(snumber)); 1657 2537 #endif 1658 2538 napoly p = x->z; … … 1664 2544 while(p!=NULL) 1665 2545 { 1666 if (( ntIsChar0&& nlIsZero(pGetCoeff(p)))1667 || ((!n tIsChar0) && npIsZero(pGetCoeff(p))))2546 if ((naIsChar0 && nlIsZero(pGetCoeff(p))) 2547 || ((!naIsChar0) && npIsZero(pGetCoeff(p)))) 1668 2548 { 1669 2549 Print("coeff 0 in %s:%d\n",f,l); … … 1677 2557 return FALSE; 1678 2558 } 1679 //if (n tIsChar0 && (((int)p->ko &3) == 0) && (p->ko->s==0) && (x->s==2))2559 //if (naIsChar0 && (((int)p->ko &3) == 0) && (p->ko->s==0) && (x->s==2)) 1680 2560 //{ 1681 2561 // Print("normalized with non-normal coeffs in %s:%d\n",f,l); 1682 2562 // return FALSE; 1683 2563 //} 1684 if (n tIsChar0 && !(nlDBTest(pGetCoeff(p),f,l)))2564 if (naIsChar0 && !(nlDBTest(pGetCoeff(p),f,l))) 1685 2565 return FALSE; 1686 2566 pIter(p); … … 1689 2569 while(p!=NULL) 1690 2570 { 1691 if (n tIsChar0 && !(nlDBTest(pGetCoeff(p),f,l)))2571 if (naIsChar0 && !(nlDBTest(pGetCoeff(p),f,l))) 1692 2572 return FALSE; 1693 2573 pIter(p); … … 1696 2576 } 1697 2577 #endif 2578 2579 /*2 2580 * convert a napoly number into a poly 2581 */ 2582 poly napPermNumber(number z, int * par_perm, int P, ring oldRing) 2583 { 2584 if (z==NULL) return NULL; 2585 poly res=NULL; 2586 poly p; 2587 napoly za=((lnumber)z)->z; 2588 napoly zb=((lnumber)z)->n; 2589 nMapFunc nMap=naSetMap(oldRing,currRing); /* todo: check naSetMap 2590 vs. ntSetMap */ 2591 if (currRing->parameter!=NULL) 2592 nMap=currRing->algring->cf->cfSetMap(oldRing->algring, nacRing); 2593 else 2594 nMap=currRing->cf->cfSetMap(oldRing->algring, currRing); 2595 if (nMap==NULL) return NULL; /* emergency exit only */ 2596 while(za!=NULL) 2597 { 2598 p = pInit(); 2599 pNext(p)=NULL; 2600 //nNew(&pGetCoeff(p)); 2601 int i; 2602 //for(i=pVariables;i;i--) pSetExp(p,i, 0); // done by pInit 2603 //if (rRing_has_Comp(currRing)) pSetComp(p, 0); // done by pInit 2604 napoly pa=NULL; 2605 lnumber pan; 2606 if (currRing->parameter!=NULL) 2607 { 2608 assume(oldRing->algring!=NULL); 2609 pGetCoeff(p)=(number)ALLOC0_LNUMBER(); 2610 pan=(lnumber)pGetCoeff(p); 2611 pan->s=2; 2612 pan->z=napInitz(nMap(pGetCoeff(za))); 2613 pa=pan->z; 2614 } 2615 else 2616 { 2617 pGetCoeff(p)=nMap(pGetCoeff(za)); 2618 } 2619 for(i=0;i<P;i++) 2620 { 2621 if(napGetExpFrom(za,i+1,oldRing)!=0) 2622 { 2623 if(par_perm==NULL) 2624 { 2625 if ((rPar(currRing)>=i) && (pa!=NULL)) 2626 { 2627 napSetExp(pa,i+1,napGetExpFrom(za,i+1,oldRing)); 2628 p_Setm(pa,nacRing); 2629 } 2630 else 2631 { 2632 pDelete(&p); 2633 break; 2634 } 2635 } 2636 else if(par_perm[i]>0) 2637 pSetExp(p,par_perm[i],napGetExpFrom(za,i+1,oldRing)); 2638 else if((par_perm[i]<0)&&(pa!=NULL)) 2639 { 2640 napSetExp(pa,-par_perm[i], napGetExpFrom(za,i+1,oldRing)); 2641 p_Setm(pa,nacRing); 2642 } 2643 else 2644 { 2645 pDelete(&p); 2646 break; 2647 } 2648 } 2649 } 2650 if (p!=NULL) 2651 { 2652 pSetm(p); 2653 if (zb!=NULL) 2654 { 2655 if (currRing->P>0) 2656 { 2657 pan->n=napPerm(zb,par_perm,oldRing,nMap); 2658 if(pan->n==NULL) /* error in mapping or mapping to variable */ 2659 pDelete(&p); 2660 } 2661 else 2662 pDelete(&p); 2663 } 2664 nNormalize(pGetCoeff(p)); 2665 if (nIsZero(pGetCoeff(p))) 2666 pDelete(&p); 2667 else 2668 { 2669 pTest(p); 2670 res=pAdd(res,p); 2671 } 2672 } 2673 pIter(za); 2674 } 2675 pTest(res); 2676 return res; 2677 } 2678 number napGetDenom(number &n, const ring r) 2679 { 2680 lnumber x=(lnumber)n; 2681 if (x->n!=NULL) 2682 { 2683 lnumber rr=ALLOC0_LNUMBER(); 2684 rr->z=p_Copy(x->n,r->algring); 2685 rr->s = 2; 2686 return (number)rr; 2687 } 2688 return n_Init(1,r); 2689 } 2690 2691 number napGetNumerator(number &n, const ring r) 2692 { 2693 lnumber x=(lnumber)n; 2694 lnumber rr=ALLOC0_LNUMBER(); 2695 rr->z=p_Copy(x->z,r->algring); 2696 rr->s = 2; 2697 return (number)rr; 2698 } -
kernel/longalg.h
r229530 r3dbee61 11 11 #include <kernel/longrat.h> 12 12 #include <kernel/polys-impl.h> 13 #include <kernel/longtrans.h>14 13 15 /*16 IMPORTANT INFORMATION:17 Instantiation of an algebraic field extension in SINGULAR18 works by first creating a transcendental field extension19 and then providing a minimal polynomial / minimal ideal.20 Consequently, first the code for transcendental field21 extensions will be activated; see longtrans.*.22 When providing a minimal polynomial / minimal ideal, all23 function pointers will be re-defined, using the below method24 redefineFunctionPointers(). After that, the code for algebraic25 field extensions is active; see longalg.*.26 27 NOTE:28 Elements of algebraic and transcendental field extensions29 are polynomials or quotients of two polynomials, respectively.30 All these polynomials, as well as the minimal polynomial (in31 the case of an algebraic extension) live in the globally32 accessible ring 'nacRing', defined in longtrans.*.33 34 METHOD NAMING CONVENTIONS35 (not true for types / structs / global variables):36 nap* macros and methods operating on polynomials living in37 nacRing (defined in longtrans.*),38 na* (but not nap*) methods and macros for algebraic field39 extensions (defined in longalg.*),40 nt* methods and macros for transcendental field extensions,41 (defined in longtrans.*)42 nac* function pointers for computing with the coefficients of43 polynomials living in nacRing (defined in longtrans.*)44 */45 46 struct snaIdeal47 {48 int anz;49 napoly *liste;50 };51 typedef struct snaIdeal * naIdeal;52 extern omBin snaIdeal_bin;53 extern naIdeal naI;54 extern napoly naMinimalPoly;55 56 /* for re-defining function pointers when switching from57 transcendental to algebraic extension (by providing58 a minpoly) */59 void redefineFunctionPointers();60 61 /* specific methods / macros for algebraic field extensions */62 void naSetChar(int p, ring r);63 void naDelete (number *p, const ring r);64 number naInit(int i, const ring r); /* z := i */65 number naPar(int i); /* z := par(i) */66 int naParDeg(number n); /* i := deg(n) */67 int naSize(number n); /* size desc. */68 int naInt(number &n, const ring r);69 BOOLEAN naIsZero(number za); /* za = 0 ? */70 BOOLEAN naIsOne(number za); /* za = 1 ? */71 BOOLEAN naIsMOne(number za); /* za = -1 ? */72 BOOLEAN naEqual(number a, number b); /* a = b ? */73 BOOLEAN naGreater(number a, number b); /* dummy */74 number naNeg(number za); /* za := - za */75 number naInvers(number a);76 void naPower(number x, int exp, number *lo);77 BOOLEAN naGreaterZero(number a);78 number naCopy(number p); /* erg:= p */79 number na_Copy(number p, const ring r); /* erg:= p */80 number naAdd(number la, number li); /* lu := la+li */81 number naMult(number la, number li); /* lo := la*li */82 number naDiv(number la, number li); /* lo := la/li */83 number naIntDiv(number la, number li); /* lo := la/li */84 //number naIntMod(number la, number li); /* lo := la/li */85 number naSub(number la, number li); /* lu := la-li */86 void naNormalize(number &p);87 number naGcd(number a, number b, const ring r);88 number naLcm(number a, number b, const ring r);89 const char * naRead(const char * s, number * p);90 void naWrite(number &p, const ring r);91 char * naName(number n);92 nMapFunc naSetMap(const ring src, const ring dst);93 number naMap0P(number c);94 number naMap00(number c);95 #ifdef LDEBUG96 BOOLEAN naDBTest(number a, const char *f,const int l);97 #endif98 void naSetIdeal(ideal I);99 void naCoefNormalize(number pp);100 extern number (*naMap)(number from);101 102 //extern omBin lnumber_bin;103 //#define ALLOC_LNUMBER() (lnumber)omAllocBin(lnumber_bin)104 //#define ALLOC0_LNUMBER() (lnumber)omAlloc0Bin(lnumber_bin)105 //#define FREE_LNUMBER(x) omFreeBin((ADDRESS)x, lnumber_bin)106 extern omBin rnumber_bin;107 14 #define ALLOC_LNUMBER() (lnumber)omAllocBin(rnumber_bin) 108 15 #define ALLOC0_LNUMBER() (lnumber)omAlloc0Bin(rnumber_bin) 109 16 #define FREE_LNUMBER(x) omFreeBin((ADDRESS)x, rnumber_bin) 17 18 19 typedef polyrec * napoly; 20 21 struct slnumber; 22 typedef struct slnumber * lnumber; 23 24 struct slnumber 25 { 26 napoly z; 27 napoly n; 28 BOOLEAN s; 29 }; 30 31 extern napoly naMinimalPoly; 32 extern ring nacRing; 33 34 35 void naSetChar(int p, ring r); 36 void naDelete (number *p, const ring r); 37 number naInit(int i, const ring r); /* z := i */ 38 number naPar(int i); /* z := par(i) */ 39 int naParDeg(number n); /* i := deg(n) */ 40 int naSize(number n); /* size desc. */ 41 int naInt(number &n, const ring r); 42 BOOLEAN naIsZero(number za); /* za = 0 ? */ 43 BOOLEAN naIsOne(number za); /* za = 1 ? */ 44 BOOLEAN naIsMOne(number za); /* za = -1 ? */ 45 BOOLEAN naEqual(number a, number b); /* a = b ? */ 46 BOOLEAN naGreater(number a, number b); /* dummy */ 47 number naNeg(number za); /* za := - za */ 48 number naInvers(number a); 49 void naPower(number x, int exp, number *lo); 50 BOOLEAN naGreaterZero(number a); 51 number naCopy(number p); /* erg:= p */ 52 number na_Copy(number p, const ring r); /* erg:= p */ 53 number naAdd(number la, number li); /* lu := la+li */ 54 number naMult(number la, number li); /* lo := la*li */ 55 number naDiv(number la, number li); /* lo := la/li */ 56 number naIntDiv(number la, number li); /* lo := la/li */ 57 //number naIntMod(number la, number li); /* lo := la/li */ 58 number naSub(number la, number li); /* lu := la-li */ 59 void naNormalize(number &p); 60 number naGcd(number a, number b, const ring r); 61 number naLcm(number a, number b, const ring r); 62 const char * naRead(const char * s, number * p); 63 void naWrite(number &p, const ring r); 64 char * naName(number n); 65 nMapFunc naSetMap(const ring src, const ring dst); 66 number naMap0P(number c); 67 number naMap00(number c); 68 #ifdef LDEBUG 69 BOOLEAN naDBTest(number a, const char *f,const int l); 110 70 #endif 111 71 72 void naSetIdeal(ideal I); 73 74 // external access to the interna 75 poly naPermNumber(number z, int * par_perm, int P, ring r); 76 #define napAddExp(p,i,e) (p_AddExp(p,i,e,currRing->algring)) 77 #define napLength(p) pLength(p) 78 #define napNeg(p) (p_Neg(p,currRing->algring)) 79 #define napVariables naNumbOfPar 80 #define napGetCoeff(p) pGetCoeff(p) 81 #define napGetExpFrom(p,i,r) (p_GetExp(p,i,r->algring)) 82 #define napSetExp(p,i,e) (p_SetExp(p,i,e,currRing->algring)) 83 #define napNew() (p_Init(currRing->algring)) 84 #define napAdd(p1,p2) (p_Add_q(p1,p2,currRing->algring)) 85 #define napSetm(p) p_Setm(p,currRing->algring) 86 #define nanumber lnumber 87 napoly napRemainder(napoly f, const napoly g); 88 number naGetDenom(number &n, const ring r); 89 number naGetNumerator(number &n, const ring r); 90 number napGetDenom(number &n, const ring r); 91 number napGetNumerator(number &n, const ring r); 92 poly napPermNumber(number z, int * par_perm, int P, ring r); 93 #endif 94 -
kernel/longtrans.cc
r229530 r3dbee61 8 8 */ 9 9 10 #if 0 10 11 #include <stdio.h> 11 12 #include <string.h> … … 2526 2527 } 2527 2528 #endif 2529 #endif -
kernel/longtrans.h
r229530 r3dbee61 10 10 */ 11 11 #include <kernel/structs.h> 12 #include <kernel/longalg.h> 13 #if 0 12 14 #include <kernel/longrat.h> 13 15 #include <kernel/polys-impl.h> … … 168 170 169 171 #endif 172 #endif 170 173 -
kernel/numbers.cc
r229530 r3dbee61 140 140 else if (rField_is_Extension(r)) 141 141 { 142 if (r->minpoly != NULL)143 {144 142 naSetChar(c,r); 145 143 if (rField_is_Q_a()) nInit_bigint=naMap00; 146 144 if (rField_is_Zp_a()) nInit_bigint=naMap0P; 147 }148 else149 {150 ntSetChar(c,r);151 if (rField_is_Q_a()) nInit_bigint=ntMap00;152 if (rField_is_Zp_a()) nInit_bigint=ntMap0P;153 }154 145 } 155 146 #ifdef HAVE_RINGS … … 324 315 if (rField_is_Extension(r)) 325 316 { 326 //n tInitChar(c,TRUE,r);327 n->cfDelete = n tDelete;328 n->nNormalize = n tNormalize;329 n->cfInit = n tInit;330 n->nPar = n tPar;331 n->nParDeg = n tParDeg;332 n->n_Int = n tInt;333 n->nAdd = n tAdd;334 n->nSub = n tSub;335 n->nMult = n tMult;336 n->nDiv = n tDiv;337 n->nExactDiv = n tDiv;338 n->nIntDiv = n tIntDiv;339 n->nNeg = n tNeg;340 n->nInvers = n tInvers;341 n->nCopy = n tCopy;342 n->cfCopy = n t_Copy;343 n->nGreater = n tGreater;344 n->nEqual = n tEqual;345 n->nIsZero = n tIsZero;346 n->nIsOne = n tIsOne;347 n->nIsMOne = n tIsMOne;348 n->nGreaterZero = n tGreaterZero;349 n->cfWrite = n tWrite;350 n->nRead = n tRead;351 n->nPower = n tPower;352 n->nGcd = n tGcd;353 n->nLcm = n tLcm;354 n->cfSetMap = n tSetMap;355 n->nName = n tName;356 n->nSize = n tSize;317 //naInitChar(c,TRUE,r); 318 n->cfDelete = naDelete; 319 n->nNormalize = naNormalize; 320 n->cfInit = naInit; 321 n->nPar = naPar; 322 n->nParDeg = naParDeg; 323 n->n_Int = naInt; 324 n->nAdd = naAdd; 325 n->nSub = naSub; 326 n->nMult = naMult; 327 n->nDiv = naDiv; 328 n->nExactDiv = naDiv; 329 n->nIntDiv = naIntDiv; 330 n->nNeg = naNeg; 331 n->nInvers = naInvers; 332 n->nCopy = naCopy; 333 n->cfCopy = na_Copy; 334 n->nGreater = naGreater; 335 n->nEqual = naEqual; 336 n->nIsZero = naIsZero; 337 n->nIsOne = naIsOne; 338 n->nIsMOne = naIsMOne; 339 n->nGreaterZero = naGreaterZero; 340 n->cfWrite = naWrite; 341 n->nRead = naRead; 342 n->nPower = naPower; 343 n->nGcd = naGcd; 344 n->nLcm = naLcm; 345 n->cfSetMap = naSetMap; 346 n->nName = naName; 347 n->nSize = naSize; 357 348 n->cfGetDenom = napGetDenom; 358 349 n->cfGetNumerator = napGetNumerator; 359 350 #ifdef LDEBUG 360 n->nDBTest = n tDBTest;351 n->nDBTest = naDBTest; 361 352 #endif 362 353 }
Note: See TracChangeset
for help on using the changeset viewer.