PageRenderTime 77ms CodeModel.GetById 23ms RepoModel.GetById 1ms app.codeStats 1ms

/kernel/ideals.cc

https://github.com/hannes14/Singular
C++ | 4429 lines | 3593 code | 286 blank | 550 comment | 823 complexity | 8410beffb9efed74f3dd9a0fe5bb46dc MD5 | raw file
Possible License(s): AGPL-1.0, GPL-3.0, Unlicense
  1. /****************************************
  2. * Computer Algebra System SINGULAR *
  3. ****************************************/
  4. /* $Id$ */
  5. /*
  6. * ABSTRACT - all basic methods to manipulate ideals
  7. */
  8. /* includes */
  9. #include <kernel/mod2.h>
  10. #ifndef NDEBUG
  11. # define MYTEST 0
  12. #else /* ifndef NDEBUG */
  13. # define MYTEST 1
  14. #endif /* ifndef NDEBUG */
  15. #include <kernel/options.h>
  16. #include <omalloc/omalloc.h>
  17. #include <kernel/febase.h>
  18. #include <kernel/numbers.h>
  19. #include <kernel/longrat.h>
  20. #include <kernel/polys.h>
  21. #include <kernel/ring.h>
  22. #include <kernel/kstd1.h>
  23. #include <kernel/matpol.h>
  24. #include <kernel/weight.h>
  25. #include <kernel/intvec.h>
  26. #include <kernel/syz.h>
  27. #include <kernel/sparsmat.h>
  28. #include <kernel/ideals.h>
  29. #include <kernel/prCopy.h>
  30. #include <kernel/gring.h>
  31. omBin sip_sideal_bin = omGetSpecBin(sizeof(sip_sideal));
  32. /* #define WITH_OLD_MINOR */
  33. #define pCopy_noCheck(p) pCopy(p)
  34. static poly * idpower;
  35. /*collects the monomials in makemonoms, must be allocated befor*/
  36. static int idpowerpoint;
  37. /*index of the actual monomial in idpower*/
  38. static poly * givenideal;
  39. /*the ideal from which a power is computed*/
  40. /*0 implementation*/
  41. /*2
  42. * initialise an ideal
  43. */
  44. ideal idInit(int idsize, int rank)
  45. {
  46. /*- initialise an ideal -*/
  47. ideal hh = (ideal )omAllocBin(sip_sideal_bin);
  48. hh->nrows = 1;
  49. hh->rank = rank;
  50. IDELEMS(hh) = idsize;
  51. if (idsize>0)
  52. {
  53. hh->m = (poly *)omAlloc0(idsize*sizeof(poly));
  54. }
  55. else
  56. hh->m=NULL;
  57. return hh;
  58. }
  59. #ifdef PDEBUG
  60. // this is only for outputting an ideal within the debugger
  61. void idShow(const ideal id, const ring lmRing, const ring tailRing, const int debugPrint)
  62. {
  63. assume( debugPrint >= 0 );
  64. if( id == NULL )
  65. PrintS("(NULL)");
  66. else
  67. {
  68. Print("Module of rank %ld,real rank %ld and %d generators.\n",
  69. id->rank,idRankFreeModule(id, lmRing, tailRing),IDELEMS(id));
  70. int j = (id->ncols*id->nrows) - 1;
  71. while ((j > 0) && (id->m[j]==NULL)) j--;
  72. for (int i = 0; i <= j; i++)
  73. {
  74. Print("generator %d: ",i); p_DebugPrint(id->m[i], lmRing, tailRing, debugPrint);
  75. }
  76. }
  77. }
  78. #endif
  79. /* index of generator with leading term in ground ring (if any);
  80. otherwise -1 */
  81. int idPosConstant(ideal id)
  82. {
  83. int k;
  84. for (k = IDELEMS(id)-1; k>=0; k--)
  85. {
  86. if (p_LmIsConstantComp(id->m[k], currRing) == TRUE)
  87. return k;
  88. }
  89. return -1;
  90. }
  91. /*2
  92. * initialise the maximal ideal (at 0)
  93. */
  94. ideal idMaxIdeal (void)
  95. {
  96. int l;
  97. ideal hh=NULL;
  98. hh=idInit(pVariables,1);
  99. for (l=0; l<pVariables; l++)
  100. {
  101. hh->m[l] = pOne();
  102. pSetExp(hh->m[l],l+1,1);
  103. pSetm(hh->m[l]);
  104. }
  105. return hh;
  106. }
  107. /*2
  108. * deletes an ideal/matrix
  109. */
  110. void id_Delete (ideal * h, ring r)
  111. {
  112. int j,elems;
  113. if (*h == NULL)
  114. return;
  115. elems=j=(*h)->nrows*(*h)->ncols;
  116. if (j>0)
  117. {
  118. do
  119. {
  120. p_Delete(&((*h)->m[--j]), r);
  121. }
  122. while (j>0);
  123. omFreeSize((ADDRESS)((*h)->m),sizeof(poly)*elems);
  124. }
  125. omFreeBin((ADDRESS)*h, sip_sideal_bin);
  126. *h=NULL;
  127. }
  128. /*2
  129. * Shallowdeletes an ideal/matrix
  130. */
  131. void id_ShallowDelete (ideal *h, ring r)
  132. {
  133. int j,elems;
  134. if (*h == NULL)
  135. return;
  136. elems=j=(*h)->nrows*(*h)->ncols;
  137. if (j>0)
  138. {
  139. do
  140. {
  141. p_ShallowDelete(&((*h)->m[--j]), r);
  142. }
  143. while (j>0);
  144. omFreeSize((ADDRESS)((*h)->m),sizeof(poly)*elems);
  145. }
  146. omFreeBin((ADDRESS)*h, sip_sideal_bin);
  147. *h=NULL;
  148. }
  149. /*2
  150. *gives an ideal the minimal possible size
  151. */
  152. void idSkipZeroes (ideal ide)
  153. {
  154. int k;
  155. int j = -1;
  156. BOOLEAN change=FALSE;
  157. for (k=0; k<IDELEMS(ide); k++)
  158. {
  159. if (ide->m[k] != NULL)
  160. {
  161. j++;
  162. if (change)
  163. {
  164. ide->m[j] = ide->m[k];
  165. }
  166. }
  167. else
  168. {
  169. change=TRUE;
  170. }
  171. }
  172. if (change)
  173. {
  174. if (j == -1)
  175. j = 0;
  176. else
  177. {
  178. for (k=j+1; k<IDELEMS(ide); k++)
  179. ide->m[k] = NULL;
  180. }
  181. pEnlargeSet(&(ide->m),IDELEMS(ide),j+1-IDELEMS(ide));
  182. IDELEMS(ide) = j+1;
  183. }
  184. }
  185. /*2
  186. * copies the first k (>= 1) entries of the given ideal
  187. * and returns these as a new ideal
  188. * (Note that the copied polynomials may be zero.)
  189. */
  190. ideal idCopyFirstK (const ideal ide, const int k)
  191. {
  192. ideal newI = idInit(k, 0);
  193. for (int i = 0; i < k; i++)
  194. newI->m[i] = pCopy(ide->m[i]);
  195. return newI;
  196. }
  197. /*2
  198. * ideal id = (id[i])
  199. * result is leadcoeff(id[i]) = 1
  200. */
  201. void idNorm(ideal id)
  202. {
  203. for (int i=IDELEMS(id)-1; i>=0; i--)
  204. {
  205. if (id->m[i] != NULL)
  206. {
  207. pNorm(id->m[i]);
  208. }
  209. }
  210. }
  211. /*2
  212. * ideal id = (id[i]), c any unit
  213. * if id[i] = c*id[j] then id[j] is deleted for j > i
  214. */
  215. void idDelMultiples(ideal id)
  216. {
  217. int i, j;
  218. int k = IDELEMS(id)-1;
  219. for (i=k; i>=0; i--)
  220. {
  221. if (id->m[i]!=NULL)
  222. {
  223. for (j=k; j>i; j--)
  224. {
  225. if (id->m[j]!=NULL)
  226. {
  227. #ifdef HAVE_RINGS
  228. if (rField_is_Ring(currRing))
  229. {
  230. /* if id[j] = c*id[i] then delete id[j].
  231. In the below cases of a ground field, we
  232. check whether id[i] = c*id[j] and, if so,
  233. delete id[j] for historical reasons (so
  234. that previous output does not change) */
  235. if (pComparePolys(id->m[j], id->m[i])) pDelete(&id->m[j]);
  236. }
  237. else
  238. {
  239. if (pComparePolys(id->m[i], id->m[j])) pDelete(&id->m[j]);
  240. }
  241. #else
  242. if (pComparePolys(id->m[i], id->m[j])) pDelete(&id->m[j]);
  243. #endif
  244. }
  245. }
  246. }
  247. }
  248. }
  249. /*2
  250. * ideal id = (id[i])
  251. * if id[i] = id[j] then id[j] is deleted for j > i
  252. */
  253. void idDelEquals(ideal id)
  254. {
  255. int i, j;
  256. int k = IDELEMS(id)-1;
  257. for (i=k; i>=0; i--)
  258. {
  259. if (id->m[i]!=NULL)
  260. {
  261. for (j=k; j>i; j--)
  262. {
  263. if ((id->m[j]!=NULL)
  264. && (pEqualPolys(id->m[i], id->m[j])))
  265. {
  266. pDelete(&id->m[j]);
  267. }
  268. }
  269. }
  270. }
  271. }
  272. //
  273. // Delete id[j], if Lm(j) == Lm(i) and both LC(j), LC(i) are units and j > i
  274. //
  275. void idDelLmEquals(ideal id)
  276. {
  277. int i, j;
  278. int k = IDELEMS(id)-1;
  279. for (i=k; i>=0; i--)
  280. {
  281. if (id->m[i] != NULL)
  282. {
  283. for (j=k; j>i; j--)
  284. {
  285. if ((id->m[j] != NULL)
  286. && pLmEqual(id->m[i], id->m[j])
  287. #ifdef HAVE_RINGS
  288. && nIsUnit(pGetCoeff(id->m[i])) && nIsUnit(pGetCoeff(id->m[j]))
  289. #endif
  290. )
  291. {
  292. pDelete(&id->m[j]);
  293. }
  294. }
  295. }
  296. }
  297. }
  298. //
  299. // delete id[j], if LT(j) == coeff*mon*LT(i) and vice versa, i.e.,
  300. // delete id[i], if LT(i) == coeff*mon*LT(j)
  301. //
  302. void idDelDiv(ideal id)
  303. {
  304. int i, j;
  305. int k = IDELEMS(id)-1;
  306. for (i=k; i>=0; i--)
  307. {
  308. if (id->m[i] != NULL)
  309. {
  310. for (j=k; j>i; j--)
  311. {
  312. if (id->m[j]!=NULL)
  313. {
  314. #ifdef HAVE_RINGS
  315. if (rField_is_Ring(currRing))
  316. {
  317. if (pDivisibleByRingCase(id->m[i], id->m[j]))
  318. {
  319. pDelete(&id->m[j]);
  320. }
  321. else if (pDivisibleByRingCase(id->m[j], id->m[i]))
  322. {
  323. pDelete(&id->m[i]);
  324. break;
  325. }
  326. }
  327. else
  328. {
  329. #endif
  330. /* the case of a ground field: */
  331. if (pDivisibleBy(id->m[i], id->m[j]))
  332. {
  333. pDelete(&id->m[j]);
  334. }
  335. else if (pDivisibleBy(id->m[j], id->m[i]))
  336. {
  337. pDelete(&id->m[i]);
  338. break;
  339. }
  340. #ifdef HAVE_RINGS
  341. }
  342. #endif
  343. }
  344. }
  345. }
  346. }
  347. }
  348. /*2
  349. *test if the ideal has only constant polynomials
  350. */
  351. BOOLEAN idIsConstant(ideal id)
  352. {
  353. int k;
  354. for (k = IDELEMS(id)-1; k>=0; k--)
  355. {
  356. if (pIsConstantPoly(id->m[k]) == FALSE)
  357. return FALSE;
  358. }
  359. return TRUE;
  360. }
  361. /*2
  362. * copy an ideal
  363. */
  364. ideal id_Copy (ideal h1, const ring r)
  365. {
  366. int i;
  367. ideal h2;
  368. //#ifdef TEST
  369. if (h1 == NULL)
  370. {
  371. h2=idInit(1,1);
  372. }
  373. else
  374. //#endif
  375. {
  376. h2=idInit(IDELEMS(h1),h1->rank);
  377. for (i=IDELEMS(h1)-1; i>=0; i--)
  378. h2->m[i] = p_Copy(h1->m[i],r);
  379. }
  380. return h2;
  381. }
  382. #ifdef PDEBUG
  383. void idDBTest(ideal h1, int level, const char *f,const int l)
  384. {
  385. int i;
  386. if (h1 != NULL)
  387. {
  388. // assume(IDELEMS(h1) > 0); for ideal/module, does not apply to matrix
  389. omCheckAddrSize(h1,sizeof(*h1));
  390. omdebugAddrSize(h1->m,h1->ncols*h1->nrows*sizeof(poly));
  391. /* to be able to test matrices: */
  392. for (i=(h1->ncols*h1->nrows)-1; i>=0; i--)
  393. _p_Test(h1->m[i], currRing, level);
  394. int new_rk=idRankFreeModule(h1);
  395. if(new_rk > h1->rank)
  396. {
  397. dReportError("wrong rank %d (should be %d) in %s:%d\n",
  398. h1->rank, new_rk, f,l);
  399. omPrintAddrInfo(stderr, h1, " for ideal");
  400. h1->rank=new_rk;
  401. }
  402. }
  403. }
  404. #endif
  405. /*3
  406. * for idSort: compare a and b revlex inclusive module comp.
  407. */
  408. static int pComp_RevLex(poly a, poly b,BOOLEAN nolex)
  409. {
  410. if (b==NULL) return 1;
  411. if (a==NULL) return -1;
  412. if (nolex)
  413. {
  414. int r=pLmCmp(a,b);
  415. if (r!=0) return r;
  416. number h=nSub(pGetCoeff(a),pGetCoeff(b));
  417. r = -1+nIsZero(h)+2*nGreaterZero(h); /* -1: <, 0:==, 1: > */
  418. nDelete(&h);
  419. return r;
  420. }
  421. int l=pVariables;
  422. while ((l>0) && (pGetExp(a,l)==pGetExp(b,l))) l--;
  423. if (l==0)
  424. {
  425. if (pGetComp(a)==pGetComp(b))
  426. {
  427. number h=nSub(pGetCoeff(a),pGetCoeff(b));
  428. int r = -1+nIsZero(h)+2*nGreaterZero(h); /* -1: <, 0:==, 1: > */
  429. nDelete(&h);
  430. return r;
  431. }
  432. if (pGetComp(a)>pGetComp(b)) return 1;
  433. }
  434. else if (pGetExp(a,l)>pGetExp(b,l))
  435. return 1;
  436. return -1;
  437. }
  438. /*2
  439. *sorts the ideal w.r.t. the actual ringordering
  440. *uses lex-ordering when nolex = FALSE
  441. */
  442. intvec *idSort(ideal id,BOOLEAN nolex)
  443. {
  444. poly p,q;
  445. intvec * result = new intvec(IDELEMS(id));
  446. int i, j, actpos=0, newpos, l;
  447. int diff, olddiff, lastcomp, newcomp;
  448. BOOLEAN notFound;
  449. for (i=0;i<IDELEMS(id);i++)
  450. {
  451. if (id->m[i]!=NULL)
  452. {
  453. notFound = TRUE;
  454. newpos = actpos / 2;
  455. diff = (actpos+1) / 2;
  456. diff = (diff+1) / 2;
  457. lastcomp = pComp_RevLex(id->m[i],id->m[(*result)[newpos]],nolex);
  458. if (lastcomp<0)
  459. {
  460. newpos -= diff;
  461. }
  462. else if (lastcomp>0)
  463. {
  464. newpos += diff;
  465. }
  466. else
  467. {
  468. notFound = FALSE;
  469. }
  470. //while ((newpos>=0) && (newpos<actpos) && (notFound))
  471. while (notFound && (newpos>=0) && (newpos<actpos))
  472. {
  473. newcomp = pComp_RevLex(id->m[i],id->m[(*result)[newpos]],nolex);
  474. olddiff = diff;
  475. if (diff>1)
  476. {
  477. diff = (diff+1) / 2;
  478. if ((newcomp==1)
  479. && (actpos-newpos>1)
  480. && (diff>1)
  481. && (newpos+diff>=actpos))
  482. {
  483. diff = actpos-newpos-1;
  484. }
  485. else if ((newcomp==-1)
  486. && (diff>1)
  487. && (newpos<diff))
  488. {
  489. diff = newpos;
  490. }
  491. }
  492. if (newcomp<0)
  493. {
  494. if ((olddiff==1) && (lastcomp>0))
  495. notFound = FALSE;
  496. else
  497. newpos -= diff;
  498. }
  499. else if (newcomp>0)
  500. {
  501. if ((olddiff==1) && (lastcomp<0))
  502. {
  503. notFound = FALSE;
  504. newpos++;
  505. }
  506. else
  507. {
  508. newpos += diff;
  509. }
  510. }
  511. else
  512. {
  513. notFound = FALSE;
  514. }
  515. lastcomp = newcomp;
  516. if (diff==0) notFound=FALSE; /*hs*/
  517. }
  518. if (newpos<0) newpos = 0;
  519. if (newpos>actpos) newpos = actpos;
  520. while ((newpos<actpos) && (pComp_RevLex(id->m[i],id->m[(*result)[newpos]],nolex)==0))
  521. newpos++;
  522. for (j=actpos;j>newpos;j--)
  523. {
  524. (*result)[j] = (*result)[j-1];
  525. }
  526. (*result)[newpos] = i;
  527. actpos++;
  528. }
  529. }
  530. for (j=0;j<actpos;j++) (*result)[j]++;
  531. return result;
  532. }
  533. /*2
  534. * concat the lists h1 and h2 without zeros
  535. */
  536. ideal idSimpleAdd (ideal h1,ideal h2)
  537. {
  538. int i,j,r,l;
  539. ideal result;
  540. if (h1==NULL) return idCopy(h2);
  541. if (h2==NULL) return idCopy(h1);
  542. j = IDELEMS(h1)-1;
  543. while ((j >= 0) && (h1->m[j] == NULL)) j--;
  544. i = IDELEMS(h2)-1;
  545. while ((i >= 0) && (h2->m[i] == NULL)) i--;
  546. r = si_max(h1->rank,h2->rank);
  547. if (i+j==(-2))
  548. return idInit(1,r);
  549. else
  550. result=idInit(i+j+2,r);
  551. for (l=j; l>=0; l--)
  552. {
  553. result->m[l] = pCopy(h1->m[l]);
  554. }
  555. r = i+j+1;
  556. for (l=i; l>=0; l--, r--)
  557. {
  558. result->m[r] = pCopy(h2->m[l]);
  559. }
  560. return result;
  561. }
  562. /*2
  563. * insert h2 into h1 (if h2 is not the zero polynomial)
  564. * return TRUE iff h2 was indeed inserted
  565. */
  566. BOOLEAN idInsertPoly (ideal h1, poly h2)
  567. {
  568. if (h2==NULL) return FALSE;
  569. int j = IDELEMS(h1)-1;
  570. while ((j >= 0) && (h1->m[j] == NULL)) j--;
  571. j++;
  572. if (j==IDELEMS(h1))
  573. {
  574. pEnlargeSet(&(h1->m),IDELEMS(h1),16);
  575. IDELEMS(h1)+=16;
  576. }
  577. h1->m[j]=h2;
  578. return TRUE;
  579. }
  580. /*2
  581. * insert h2 into h1 depending on the two boolean parameters:
  582. * - if zeroOk is true, then h2 will also be inserted when it is zero
  583. * - if duplicateOk is true, then h2 will also be inserted when it is
  584. * already present in h1
  585. * return TRUE iff h2 was indeed inserted
  586. */
  587. BOOLEAN idInsertPolyWithTests (ideal h1, const int validEntries,
  588. const poly h2, const bool zeroOk, const bool duplicateOk)
  589. {
  590. if ((!zeroOk) && (h2 == NULL)) return FALSE;
  591. if (!duplicateOk)
  592. {
  593. bool h2FoundInH1 = false;
  594. int i = 0;
  595. while ((i < validEntries) && (!h2FoundInH1))
  596. {
  597. h2FoundInH1 = pEqualPolys(h1->m[i], h2);
  598. i++;
  599. }
  600. if (h2FoundInH1) return FALSE;
  601. }
  602. if (validEntries == IDELEMS(h1))
  603. {
  604. pEnlargeSet(&(h1->m), IDELEMS(h1), 16);
  605. IDELEMS(h1) += 16;
  606. }
  607. h1->m[validEntries] = h2;
  608. return TRUE;
  609. }
  610. /*2
  611. * h1 + h2
  612. */
  613. ideal idAdd (ideal h1,ideal h2)
  614. {
  615. ideal result = idSimpleAdd(h1,h2);
  616. idCompactify(result);
  617. return result;
  618. }
  619. /*2
  620. * h1 * h2
  621. */
  622. ideal idMult (ideal h1,ideal h2)
  623. {
  624. int i,j,k;
  625. ideal hh;
  626. j = IDELEMS(h1);
  627. while ((j > 0) && (h1->m[j-1] == NULL)) j--;
  628. i = IDELEMS(h2);
  629. while ((i > 0) && (h2->m[i-1] == NULL)) i--;
  630. j = j * i;
  631. if (j == 0)
  632. hh = idInit(1,1);
  633. else
  634. hh=idInit(j,1);
  635. if (h1->rank<h2->rank)
  636. hh->rank = h2->rank;
  637. else
  638. hh->rank = h1->rank;
  639. if (j==0) return hh;
  640. k = 0;
  641. for (i=0; i<IDELEMS(h1); i++)
  642. {
  643. if (h1->m[i] != NULL)
  644. {
  645. for (j=0; j<IDELEMS(h2); j++)
  646. {
  647. if (h2->m[j] != NULL)
  648. {
  649. hh->m[k] = ppMult_qq(h1->m[i],h2->m[j]);
  650. k++;
  651. }
  652. }
  653. }
  654. }
  655. {
  656. idCompactify(hh);
  657. return hh;
  658. }
  659. }
  660. /*2
  661. *returns true if h is the zero ideal
  662. */
  663. BOOLEAN idIs0 (ideal h)
  664. {
  665. int i;
  666. if (h == NULL) return TRUE;
  667. i = IDELEMS(h)-1;
  668. while ((i >= 0) && (h->m[i] == NULL))
  669. {
  670. i--;
  671. }
  672. if (i < 0)
  673. return TRUE;
  674. else
  675. return FALSE;
  676. }
  677. /*2
  678. * return the maximal component number found in any polynomial in s
  679. */
  680. long idRankFreeModule (ideal s, ring lmRing, ring tailRing)
  681. {
  682. if (s!=NULL)
  683. {
  684. int j=0;
  685. if (rRing_has_Comp(tailRing) && rRing_has_Comp(lmRing))
  686. {
  687. int l=IDELEMS(s);
  688. poly *p=s->m;
  689. int k;
  690. for (; l != 0; l--)
  691. {
  692. if (*p!=NULL)
  693. {
  694. pp_Test(*p, lmRing, tailRing);
  695. k = p_MaxComp(*p, lmRing, tailRing);
  696. if (k>j) j = k;
  697. }
  698. p++;
  699. }
  700. }
  701. return j;
  702. }
  703. return -1;
  704. }
  705. BOOLEAN idIsModule(ideal id, ring r)
  706. {
  707. if (id != NULL && rRing_has_Comp(r))
  708. {
  709. int j, l = IDELEMS(id);
  710. for (j=0; j<l; j++)
  711. {
  712. if (id->m[j] != NULL && p_GetComp(id->m[j], r) > 0) return TRUE;
  713. }
  714. }
  715. return FALSE;
  716. }
  717. /*2
  718. *returns true if id is homogenous with respect to the aktual weights
  719. */
  720. BOOLEAN idHomIdeal (ideal id, ideal Q)
  721. {
  722. int i;
  723. BOOLEAN b;
  724. if ((id == NULL) || (IDELEMS(id) == 0)) return TRUE;
  725. i = 0;
  726. b = TRUE;
  727. while ((i < IDELEMS(id)) && b)
  728. {
  729. b = pIsHomogeneous(id->m[i]);
  730. i++;
  731. }
  732. if ((b) && (Q!=NULL) && (IDELEMS(Q)>0))
  733. {
  734. i=0;
  735. while ((i < IDELEMS(Q)) && b)
  736. {
  737. b = pIsHomogeneous(Q->m[i]);
  738. i++;
  739. }
  740. }
  741. return b;
  742. }
  743. /*2
  744. *returns a minimized set of generators of h1
  745. */
  746. ideal idMinBase (ideal h1)
  747. {
  748. ideal h2, h3,h4,e;
  749. int j,k;
  750. int i,l,ll;
  751. intvec * wth;
  752. BOOLEAN homog;
  753. homog = idHomModule(h1,currQuotient,&wth);
  754. if (rHasGlobalOrdering_currRing())
  755. {
  756. if(!homog)
  757. {
  758. WarnS("minbase applies only to the local or homogeneous case");
  759. e=idCopy(h1);
  760. return e;
  761. }
  762. else
  763. {
  764. ideal re=kMin_std(h1,currQuotient,(tHomog)homog,&wth,h2,NULL,0,3);
  765. idDelete(&re);
  766. return h2;
  767. }
  768. }
  769. e=idInit(1,h1->rank);
  770. if (idIs0(h1))
  771. {
  772. return e;
  773. }
  774. pEnlargeSet(&(e->m),IDELEMS(e),15);
  775. IDELEMS(e) = 16;
  776. h2 = kStd(h1,currQuotient,isNotHomog,NULL);
  777. h3 = idMaxIdeal();
  778. h4=idMult(h2,h3);
  779. idDelete(&h3);
  780. h3=kStd(h4,currQuotient,isNotHomog,NULL);
  781. k = IDELEMS(h3);
  782. while ((k > 0) && (h3->m[k-1] == NULL)) k--;
  783. j = -1;
  784. l = IDELEMS(h2);
  785. while ((l > 0) && (h2->m[l-1] == NULL)) l--;
  786. for (i=l-1; i>=0; i--)
  787. {
  788. if (h2->m[i] != NULL)
  789. {
  790. ll = 0;
  791. while ((ll < k) && ((h3->m[ll] == NULL)
  792. || !pDivisibleBy(h3->m[ll],h2->m[i])))
  793. ll++;
  794. if (ll >= k)
  795. {
  796. j++;
  797. if (j > IDELEMS(e)-1)
  798. {
  799. pEnlargeSet(&(e->m),IDELEMS(e),16);
  800. IDELEMS(e) += 16;
  801. }
  802. e->m[j] = pCopy(h2->m[i]);
  803. }
  804. }
  805. }
  806. idDelete(&h2);
  807. idDelete(&h3);
  808. idDelete(&h4);
  809. if (currQuotient!=NULL)
  810. {
  811. h3=idInit(1,e->rank);
  812. h2=kNF(h3,currQuotient,e);
  813. idDelete(&h3);
  814. idDelete(&e);
  815. e=h2;
  816. }
  817. idSkipZeroes(e);
  818. return e;
  819. }
  820. /*2
  821. *the minimal index of used variables - 1
  822. */
  823. int pLowVar (poly p)
  824. {
  825. int k,l,lex;
  826. if (p == NULL) return -1;
  827. k = 32000;/*a very large dummy value*/
  828. while (p != NULL)
  829. {
  830. l = 1;
  831. lex = pGetExp(p,l);
  832. while ((l < pVariables) && (lex == 0))
  833. {
  834. l++;
  835. lex = pGetExp(p,l);
  836. }
  837. l--;
  838. if (l < k) k = l;
  839. pIter(p);
  840. }
  841. return k;
  842. }
  843. /*3
  844. *multiplies p with t (!cas) or (t-1)
  845. *the index of t is:1, so we have to shift all variables
  846. *p is NOT in the actual ring, it has no t
  847. */
  848. static poly pMultWithT (poly p,BOOLEAN cas)
  849. {
  850. /*qp is the working pointer in p*/
  851. /*result is the result, qresult is the working pointer*/
  852. /*pp is p in the actual ring(shifted), qpp the working pointer*/
  853. poly result,qp,pp;
  854. poly qresult=NULL;
  855. poly qpp=NULL;
  856. int i,j,lex;
  857. number n;
  858. pp = NULL;
  859. result = NULL;
  860. qp = p;
  861. while (qp != NULL)
  862. {
  863. i = 0;
  864. if (result == NULL)
  865. {/*first monomial*/
  866. result = pInit();
  867. qresult = result;
  868. }
  869. else
  870. {
  871. qresult->next = pInit();
  872. pIter(qresult);
  873. }
  874. for (j=pVariables-1; j>0; j--)
  875. {
  876. lex = pGetExp(qp,j);
  877. pSetExp(qresult,j+1,lex);/*copy all variables*/
  878. }
  879. lex = pGetComp(qp);
  880. pSetComp(qresult,lex);
  881. n=nCopy(pGetCoeff(qp));
  882. pSetCoeff0(qresult,n);
  883. qresult->next = NULL;
  884. pSetm(qresult);
  885. /*qresult is now qp brought into the actual ring*/
  886. if (cas)
  887. { /*case: mult with t-1*/
  888. pSetExp(qresult,1,0);
  889. pSetm(qresult);
  890. if (pp == NULL)
  891. { /*first monomial*/
  892. pp = pCopy(qresult);
  893. qpp = pp;
  894. }
  895. else
  896. {
  897. qpp->next = pCopy(qresult);
  898. pIter(qpp);
  899. }
  900. pGetCoeff(qpp)=nNeg(pGetCoeff(qpp));
  901. /*now qpp contains -1*qp*/
  902. }
  903. pSetExp(qresult,1,1);/*this is mult. by t*/
  904. pSetm(qresult);
  905. pIter(qp);
  906. }
  907. /*
  908. *now p is processed:
  909. *result contains t*p
  910. * if cas: pp contains -1*p (in the new ring)
  911. */
  912. if (cas) qresult->next = pp;
  913. /* else qresult->next = NULL;*/
  914. return result;
  915. }
  916. /*2
  917. * verschiebt die Indizees der Modulerzeugenden um i
  918. */
  919. void pShift (poly * p,int i)
  920. {
  921. poly qp1 = *p,qp2 = *p;/*working pointers*/
  922. int j = pMaxComp(*p),k = pMinComp(*p);
  923. if (j+i < 0) return ;
  924. while (qp1 != NULL)
  925. {
  926. if ((pGetComp(qp1)+i > 0) || ((j == -i) && (j == k)))
  927. {
  928. pAddComp(qp1,i);
  929. pSetmComp(qp1);
  930. qp2 = qp1;
  931. pIter(qp1);
  932. }
  933. else
  934. {
  935. if (qp2 == *p)
  936. {
  937. pIter(*p);
  938. pLmDelete(&qp2);
  939. qp2 = *p;
  940. qp1 = *p;
  941. }
  942. else
  943. {
  944. qp2->next = qp1->next;
  945. if (qp1!=NULL) pLmDelete(&qp1);
  946. qp1 = qp2->next;
  947. }
  948. }
  949. }
  950. }
  951. /*2
  952. *initialized a field with r numbers between beg and end for the
  953. *procedure idNextChoise
  954. */
  955. void idInitChoise (int r,int beg,int end,BOOLEAN *endch,int * choise)
  956. {
  957. /*returns the first choise of r numbers between beg and end*/
  958. int i;
  959. for (i=0; i<r; i++)
  960. {
  961. choise[i] = 0;
  962. }
  963. if (r <= end-beg+1)
  964. for (i=0; i<r; i++)
  965. {
  966. choise[i] = beg+i;
  967. }
  968. if (r > end-beg+1)
  969. *endch = TRUE;
  970. else
  971. *endch = FALSE;
  972. }
  973. /*2
  974. *returns the next choise of r numbers between beg and end
  975. */
  976. void idGetNextChoise (int r,int end,BOOLEAN *endch,int * choise)
  977. {
  978. int i = r-1,j;
  979. while ((i >= 0) && (choise[i] == end))
  980. {
  981. i--;
  982. end--;
  983. }
  984. if (i == -1)
  985. *endch = TRUE;
  986. else
  987. {
  988. choise[i]++;
  989. for (j=i+1; j<r; j++)
  990. {
  991. choise[j] = choise[i]+j-i;
  992. }
  993. *endch = FALSE;
  994. }
  995. }
  996. /*2
  997. *takes the field choise of d numbers between beg and end, cancels the t-th
  998. *entree and searches for the ordinal number of that d-1 dimensional field
  999. * w.r.t. the algorithm of construction
  1000. */
  1001. int idGetNumberOfChoise(int t, int d, int begin, int end, int * choise)
  1002. {
  1003. int * localchoise,i,result=0;
  1004. BOOLEAN b=FALSE;
  1005. if (d<=1) return 1;
  1006. localchoise=(int*)omAlloc((d-1)*sizeof(int));
  1007. idInitChoise(d-1,begin,end,&b,localchoise);
  1008. while (!b)
  1009. {
  1010. result++;
  1011. i = 0;
  1012. while ((i<t) && (localchoise[i]==choise[i])) i++;
  1013. if (i>=t)
  1014. {
  1015. i = t+1;
  1016. while ((i<d) && (localchoise[i-1]==choise[i])) i++;
  1017. if (i>=d)
  1018. {
  1019. omFreeSize((ADDRESS)localchoise,(d-1)*sizeof(int));
  1020. return result;
  1021. }
  1022. }
  1023. idGetNextChoise(d-1,end,&b,localchoise);
  1024. }
  1025. omFreeSize((ADDRESS)localchoise,(d-1)*sizeof(int));
  1026. return 0;
  1027. }
  1028. /*2
  1029. *computes the binomial coefficient
  1030. */
  1031. int binom (int n,int r)
  1032. {
  1033. int i,result;
  1034. if (r==0) return 1;
  1035. if (n-r<r) return binom(n,n-r);
  1036. result = n-r+1;
  1037. for (i=2;i<=r;i++)
  1038. {
  1039. result *= n-r+i;
  1040. if (result<0)
  1041. {
  1042. WarnS("overflow in binomials");
  1043. return 0;
  1044. }
  1045. result /= i;
  1046. }
  1047. return result;
  1048. }
  1049. /*2
  1050. *the free module of rank i
  1051. */
  1052. ideal idFreeModule (int i)
  1053. {
  1054. int j;
  1055. ideal h;
  1056. h=idInit(i,i);
  1057. for (j=0; j<i; j++)
  1058. {
  1059. h->m[j] = pOne();
  1060. pSetComp(h->m[j],j+1);
  1061. pSetmComp(h->m[j]);
  1062. }
  1063. return h;
  1064. }
  1065. ideal idSectWithElim (ideal h1,ideal h2)
  1066. // does not destroy h1,h2
  1067. {
  1068. if (TEST_OPT_PROT) PrintS("intersect by elimination method\n");
  1069. assume(!idIs0(h1));
  1070. assume(!idIs0(h2));
  1071. assume(IDELEMS(h1)<=IDELEMS(h2));
  1072. assume(idRankFreeModule(h1)==0);
  1073. assume(idRankFreeModule(h2)==0);
  1074. // add a new variable:
  1075. int j;
  1076. ring origRing=currRing;
  1077. ring r=rCopy0(origRing);
  1078. r->N++;
  1079. r->block0[0]=1;
  1080. r->block1[0]= r->N;
  1081. omFree(r->order);
  1082. r->order=(int*)omAlloc0(3*sizeof(int*));
  1083. r->order[0]=ringorder_dp;
  1084. r->order[1]=ringorder_C;
  1085. char **names=(char**)omAlloc0(rVar(r) * sizeof(char_ptr));
  1086. for (j=0;j<r->N-1;j++) names[j]=r->names[j];
  1087. names[r->N-1]=omStrDup("@");
  1088. omFree(r->names);
  1089. r->names=names;
  1090. rComplete(r,TRUE);
  1091. // fetch h1, h2
  1092. ideal h;
  1093. h1=idrCopyR(h1,origRing,r);
  1094. h2=idrCopyR(h2,origRing,r);
  1095. // switch to temp. ring r
  1096. rChangeCurrRing(r);
  1097. // create 1-t, t
  1098. poly omt=pOne();
  1099. pSetExp(omt,r->N,1);
  1100. poly t=pCopy(omt);
  1101. pSetm(omt);
  1102. omt=pNeg(omt);
  1103. omt=pAdd(omt,pOne());
  1104. // compute (1-t)*h1
  1105. h1=(ideal)mpMultP((matrix)h1,omt);
  1106. // compute t*h2
  1107. h2=(ideal)mpMultP((matrix)h2,pCopy(t));
  1108. // (1-t)h1 + t*h2
  1109. h=idInit(IDELEMS(h1)+IDELEMS(h2),1);
  1110. int l;
  1111. for (l=IDELEMS(h1)-1; l>=0; l--)
  1112. {
  1113. h->m[l] = h1->m[l]; h1->m[l]=NULL;
  1114. }
  1115. j=IDELEMS(h1);
  1116. for (l=IDELEMS(h2)-1; l>=0; l--)
  1117. {
  1118. h->m[l+j] = h2->m[l]; h2->m[l]=NULL;
  1119. }
  1120. idDelete(&h1);
  1121. idDelete(&h2);
  1122. // eliminate t:
  1123. ideal res=idElimination(h,t);
  1124. // cleanup
  1125. idDelete(&h);
  1126. res=idrMoveR(res,r,origRing);
  1127. rChangeCurrRing(origRing);
  1128. rKill(r);
  1129. return res;
  1130. }
  1131. /*2
  1132. * h3 := h1 intersect h2
  1133. */
  1134. ideal idSect (ideal h1,ideal h2)
  1135. {
  1136. int i,j,k,length;
  1137. int flength = idRankFreeModule(h1);
  1138. int slength = idRankFreeModule(h2);
  1139. int rank=si_min(flength,slength);
  1140. if ((idIs0(h1)) || (idIs0(h2))) return idInit(1,rank);
  1141. ideal first,second,temp,temp1,result;
  1142. poly p,q;
  1143. if (IDELEMS(h1)<IDELEMS(h2))
  1144. {
  1145. first = h1;
  1146. second = h2;
  1147. }
  1148. else
  1149. {
  1150. first = h2;
  1151. second = h1;
  1152. int t=flength; flength=slength; slength=t;
  1153. }
  1154. length = si_max(flength,slength);
  1155. if (length==0)
  1156. {
  1157. if ((currQuotient==NULL)
  1158. && (currRing->OrdSgn==1)
  1159. && (!rIsPluralRing(currRing))
  1160. && ((TEST_V_INTERSECT_ELIM) || (!TEST_V_INTERSECT_SYZ)))
  1161. return idSectWithElim(first,second);
  1162. else length = 1;
  1163. }
  1164. if (TEST_OPT_PROT) PrintS("intersect by syzygy methods\n");
  1165. j = IDELEMS(first);
  1166. ring orig_ring=currRing;
  1167. ring syz_ring=rCurrRingAssure_SyzComp();
  1168. rSetSyzComp(length);
  1169. while ((j>0) && (first->m[j-1]==NULL)) j--;
  1170. temp = idInit(j /*IDELEMS(first)*/+IDELEMS(second),length+j);
  1171. k = 0;
  1172. for (i=0;i<j;i++)
  1173. {
  1174. if (first->m[i]!=NULL)
  1175. {
  1176. if (syz_ring==orig_ring)
  1177. temp->m[k] = pCopy(first->m[i]);
  1178. else
  1179. temp->m[k] = prCopyR(first->m[i], orig_ring);
  1180. q = pOne();
  1181. pSetComp(q,i+1+length);
  1182. pSetmComp(q);
  1183. if (flength==0) pShift(&(temp->m[k]),1);
  1184. p = temp->m[k];
  1185. while (pNext(p)!=NULL) pIter(p);
  1186. pNext(p) = q;
  1187. k++;
  1188. }
  1189. }
  1190. for (i=0;i<IDELEMS(second);i++)
  1191. {
  1192. if (second->m[i]!=NULL)
  1193. {
  1194. if (syz_ring==orig_ring)
  1195. temp->m[k] = pCopy(second->m[i]);
  1196. else
  1197. temp->m[k] = prCopyR(second->m[i], orig_ring);
  1198. if (slength==0) pShift(&(temp->m[k]),1);
  1199. k++;
  1200. }
  1201. }
  1202. intvec *w=NULL;
  1203. temp1 = kStd(temp,currQuotient,testHomog,&w,NULL,length);
  1204. if (w!=NULL) delete w;
  1205. idDelete(&temp);
  1206. if(syz_ring!=orig_ring)
  1207. rChangeCurrRing(orig_ring);
  1208. result = idInit(IDELEMS(temp1),rank);
  1209. j = 0;
  1210. for (i=0;i<IDELEMS(temp1);i++)
  1211. {
  1212. if ((temp1->m[i]!=NULL)
  1213. && (p_GetComp(temp1->m[i],syz_ring)>length))
  1214. {
  1215. if(syz_ring==orig_ring)
  1216. {
  1217. p = temp1->m[i];
  1218. }
  1219. else
  1220. {
  1221. p = prMoveR(temp1->m[i], syz_ring);
  1222. }
  1223. temp1->m[i]=NULL;
  1224. while (p!=NULL)
  1225. {
  1226. q = pNext(p);
  1227. pNext(p) = NULL;
  1228. k = pGetComp(p)-1-length;
  1229. pSetComp(p,0);
  1230. pSetmComp(p);
  1231. /* Warning! multiply only from the left! it's very important for Plural */
  1232. result->m[j] = pAdd(result->m[j],pMult(p,pCopy(first->m[k])));
  1233. p = q;
  1234. }
  1235. j++;
  1236. }
  1237. }
  1238. if(syz_ring!=orig_ring)
  1239. {
  1240. rChangeCurrRing(syz_ring);
  1241. idDelete(&temp1);
  1242. rChangeCurrRing(orig_ring);
  1243. rKill(syz_ring);
  1244. }
  1245. else
  1246. {
  1247. idDelete(&temp1);
  1248. }
  1249. idSkipZeroes(result);
  1250. if (TEST_OPT_RETURN_SB)
  1251. {
  1252. w=NULL;
  1253. temp1=kStd(result,currQuotient,testHomog,&w);
  1254. if (w!=NULL) delete w;
  1255. idDelete(&result);
  1256. idSkipZeroes(temp1);
  1257. return temp1;
  1258. }
  1259. else //temp1=kInterRed(result,currQuotient);
  1260. return result;
  1261. }
  1262. /*2
  1263. * ideal/module intersection for a list of objects
  1264. * given as 'resolvente'
  1265. */
  1266. ideal idMultSect(resolvente arg, int length)
  1267. {
  1268. int i,j=0,k=0,syzComp,l,maxrk=-1,realrki;
  1269. ideal bigmat,tempstd,result;
  1270. poly p;
  1271. int isIdeal=0;
  1272. intvec * w=NULL;
  1273. /* find 0-ideals and max rank -----------------------------------*/
  1274. for (i=0;i<length;i++)
  1275. {
  1276. if (!idIs0(arg[i]))
  1277. {
  1278. realrki=idRankFreeModule(arg[i]);
  1279. k++;
  1280. j += IDELEMS(arg[i]);
  1281. if (realrki>maxrk) maxrk = realrki;
  1282. }
  1283. else
  1284. {
  1285. if (arg[i]!=NULL)
  1286. {
  1287. return idInit(1,arg[i]->rank);
  1288. }
  1289. }
  1290. }
  1291. if (maxrk == 0)
  1292. {
  1293. isIdeal = 1;
  1294. maxrk = 1;
  1295. }
  1296. /* init -----------------------------------------------------------*/
  1297. j += maxrk;
  1298. syzComp = k*maxrk;
  1299. ring orig_ring=currRing;
  1300. ring syz_ring=rCurrRingAssure_SyzComp();
  1301. rSetSyzComp(syzComp);
  1302. bigmat = idInit(j,(k+1)*maxrk);
  1303. /* create unit matrices ------------------------------------------*/
  1304. for (i=0;i<maxrk;i++)
  1305. {
  1306. for (j=0;j<=k;j++)
  1307. {
  1308. p = pOne();
  1309. pSetComp(p,i+1+j*maxrk);
  1310. pSetmComp(p);
  1311. bigmat->m[i] = pAdd(bigmat->m[i],p);
  1312. }
  1313. }
  1314. /* enter given ideals ------------------------------------------*/
  1315. i = maxrk;
  1316. k = 0;
  1317. for (j=0;j<length;j++)
  1318. {
  1319. if (arg[j]!=NULL)
  1320. {
  1321. for (l=0;l<IDELEMS(arg[j]);l++)
  1322. {
  1323. if (arg[j]->m[l]!=NULL)
  1324. {
  1325. if (syz_ring==orig_ring)
  1326. bigmat->m[i] = pCopy(arg[j]->m[l]);
  1327. else
  1328. bigmat->m[i] = prCopyR(arg[j]->m[l], orig_ring);
  1329. pShift(&(bigmat->m[i]),k*maxrk+isIdeal);
  1330. i++;
  1331. }
  1332. }
  1333. k++;
  1334. }
  1335. }
  1336. /* std computation --------------------------------------------*/
  1337. tempstd = kStd(bigmat,currQuotient,testHomog,&w,NULL,syzComp);
  1338. if (w!=NULL) delete w;
  1339. idDelete(&bigmat);
  1340. if(syz_ring!=orig_ring)
  1341. rChangeCurrRing(orig_ring);
  1342. /* interprete result ----------------------------------------*/
  1343. result = idInit(IDELEMS(tempstd),maxrk);
  1344. k = 0;
  1345. for (j=0;j<IDELEMS(tempstd);j++)
  1346. {
  1347. if ((tempstd->m[j]!=NULL) && (p_GetComp(tempstd->m[j],syz_ring)>syzComp))
  1348. {
  1349. if (syz_ring==orig_ring)
  1350. p = pCopy(tempstd->m[j]);
  1351. else
  1352. p = prCopyR(tempstd->m[j], syz_ring);
  1353. pShift(&p,-syzComp-isIdeal);
  1354. result->m[k] = p;
  1355. k++;
  1356. }
  1357. }
  1358. /* clean up ----------------------------------------------------*/
  1359. if(syz_ring!=orig_ring)
  1360. rChangeCurrRing(syz_ring);
  1361. idDelete(&tempstd);
  1362. if(syz_ring!=orig_ring)
  1363. {
  1364. rChangeCurrRing(orig_ring);
  1365. rKill(syz_ring);
  1366. }
  1367. idSkipZeroes(result);
  1368. return result;
  1369. }
  1370. /*2
  1371. *computes syzygies of h1,
  1372. *if quot != NULL it computes in the quotient ring modulo "quot"
  1373. *works always in a ring with ringorder_s
  1374. */
  1375. static ideal idPrepare (ideal h1, tHomog hom, int syzcomp, intvec **w)
  1376. {
  1377. ideal h2, h3;
  1378. int i;
  1379. int j,jj=0,k;
  1380. poly p,q;
  1381. if (idIs0(h1)) return NULL;
  1382. k = idRankFreeModule(h1);
  1383. h2=idCopy(h1);
  1384. i = IDELEMS(h2)-1;
  1385. if (k == 0)
  1386. {
  1387. for (j=0; j<=i; j++) pShift(&(h2->m[j]),1);
  1388. k = 1;
  1389. }
  1390. if (syzcomp<k)
  1391. {
  1392. Warn("syzcomp too low, should be %d instead of %d",k,syzcomp);
  1393. syzcomp = k;
  1394. rSetSyzComp(k);
  1395. }
  1396. h2->rank = syzcomp+i+1;
  1397. //if (hom==testHomog)
  1398. //{
  1399. // if(idHomIdeal(h1,currQuotient))
  1400. // {
  1401. // hom=TRUE;
  1402. // }
  1403. //}
  1404. #if MYTEST
  1405. #ifdef RDEBUG
  1406. Print("Prepare::h2: ");
  1407. idPrint(h2);
  1408. for(j=0;j<IDELEMS(h2);j++) pTest(h2->m[j]);
  1409. #endif
  1410. #endif
  1411. for (j=0; j<=i; j++)
  1412. {
  1413. p = h2->m[j];
  1414. q = pOne();
  1415. pSetComp(q,syzcomp+1+j);
  1416. pSetmComp(q);
  1417. if (p!=NULL)
  1418. {
  1419. while (pNext(p)) pIter(p);
  1420. p->next = q;
  1421. }
  1422. else
  1423. h2->m[j]=q;
  1424. }
  1425. #ifdef PDEBUG
  1426. for(j=0;j<IDELEMS(h2);j++) pTest(h2->m[j]);
  1427. #if MYTEST
  1428. #ifdef RDEBUG
  1429. Print("Prepare::Input: ");
  1430. idPrint(h2);
  1431. Print("Prepare::currQuotient: ");
  1432. idPrint(currQuotient);
  1433. #endif
  1434. #endif
  1435. #endif
  1436. idTest(h2);
  1437. h3 = kStd(h2,currQuotient,hom,w,NULL,syzcomp);
  1438. #if MYTEST
  1439. #ifdef RDEBUG
  1440. Print("Prepare::Output: ");
  1441. idPrint(h3);
  1442. for(j=0;j<IDELEMS(h2);j++) pTest(h3->m[j]);
  1443. #endif
  1444. #endif
  1445. idDelete(&h2);
  1446. return h3;
  1447. }
  1448. /*2
  1449. * compute the syzygies of h1 in R/quot,
  1450. * weights of components are in w
  1451. * if setRegularity, return the regularity in deg
  1452. * do not change h1, w
  1453. */
  1454. ideal idSyzygies (ideal h1, tHomog h,intvec **w, BOOLEAN setSyzComp,
  1455. BOOLEAN setRegularity, int *deg)
  1456. {
  1457. ideal s_h1;
  1458. poly p;
  1459. int j, k, length=0,reg;
  1460. BOOLEAN isMonomial=TRUE;
  1461. int ii, idElemens_h1;
  1462. assume(h1 != NULL);
  1463. idElemens_h1=IDELEMS(h1);
  1464. #ifdef PDEBUG
  1465. for(ii=0;ii<idElemens_h1 /*IDELEMS(h1)*/;ii++) pTest(h1->m[ii]);
  1466. #endif
  1467. if (idIs0(h1))
  1468. {
  1469. ideal result=idFreeModule(idElemens_h1/*IDELEMS(h1)*/);
  1470. int curr_syz_limit=rGetCurrSyzLimit();
  1471. if (curr_syz_limit>0)
  1472. for (ii=0;ii<idElemens_h1/*IDELEMS(h1)*/;ii++)
  1473. {
  1474. if (h1->m[ii]!=NULL)
  1475. pShift(&h1->m[ii],curr_syz_limit);
  1476. }
  1477. return result;
  1478. }
  1479. int slength=(int)idRankFreeModule(h1);
  1480. k=si_max(1,slength /*idRankFreeModule(h1)*/);
  1481. assume(currRing != NULL);
  1482. ring orig_ring=currRing;
  1483. ring syz_ring=rCurrRingAssure_SyzComp();
  1484. if (setSyzComp)
  1485. rSetSyzComp(k);
  1486. if (orig_ring != syz_ring)
  1487. {
  1488. s_h1=idrCopyR_NoSort(h1,orig_ring);
  1489. }
  1490. else
  1491. {
  1492. s_h1 = h1;
  1493. }
  1494. idTest(s_h1);
  1495. ideal s_h3=idPrepare(s_h1,h,k,w); // main (syz) GB computation
  1496. if (s_h3==NULL)
  1497. {
  1498. return idFreeModule( idElemens_h1 /*IDELEMS(h1)*/);
  1499. }
  1500. if (orig_ring != syz_ring)
  1501. {
  1502. idDelete(&s_h1);
  1503. for (j=0; j<IDELEMS(s_h3); j++)
  1504. {
  1505. if (s_h3->m[j] != NULL)
  1506. {
  1507. if (p_MinComp(s_h3->m[j],syz_ring) > k)
  1508. pShift(&s_h3->m[j], -k);
  1509. else
  1510. pDelete(&s_h3->m[j]);
  1511. }
  1512. }
  1513. idSkipZeroes(s_h3);
  1514. s_h3->rank -= k;
  1515. rChangeCurrRing(orig_ring);
  1516. s_h3 = idrMoveR_NoSort(s_h3, syz_ring);
  1517. rKill(syz_ring);
  1518. #ifdef HAVE_PLURAL
  1519. if (rIsPluralRing(currRing))
  1520. {
  1521. idDelMultiples(s_h3);
  1522. idSkipZeroes(s_h3);
  1523. }
  1524. #endif
  1525. idTest(s_h3);
  1526. return s_h3;
  1527. }
  1528. ideal e = idInit(IDELEMS(s_h3), s_h3->rank);
  1529. for (j=IDELEMS(s_h3)-1; j>=0; j--)
  1530. {
  1531. if (s_h3->m[j] != NULL)
  1532. {
  1533. if (p_MinComp(s_h3->m[j],syz_ring) <= k)
  1534. {
  1535. e->m[j] = s_h3->m[j];
  1536. isMonomial=isMonomial && (pNext(s_h3->m[j])==NULL);
  1537. pDelete(&pNext(s_h3->m[j]));
  1538. s_h3->m[j] = NULL;
  1539. }
  1540. }
  1541. }
  1542. idSkipZeroes(s_h3);
  1543. idSkipZeroes(e);
  1544. if ((deg != NULL)
  1545. && (!isMonomial)
  1546. && (!TEST_OPT_NOTREGULARITY)
  1547. && (setRegularity)
  1548. && (h==isHomog)
  1549. && (!rIsPluralRing(currRing))
  1550. )
  1551. {
  1552. ring dp_C_ring = rCurrRingAssure_dp_C();
  1553. if (dp_C_ring != syz_ring)
  1554. e = idrMoveR_NoSort(e, syz_ring);
  1555. resolvente res = sySchreyerResolvente(e,-1,&length,TRUE, TRUE);
  1556. intvec * dummy = syBetti(res,length,&reg, *w);
  1557. *deg = reg+2;
  1558. delete dummy;
  1559. for (j=0;j<length;j++)
  1560. {
  1561. if (res[j]!=NULL) idDelete(&(res[j]));
  1562. }
  1563. omFreeSize((ADDRESS)res,length*sizeof(ideal));
  1564. idDelete(&e);
  1565. if (dp_C_ring != syz_ring)
  1566. {
  1567. rChangeCurrRing(syz_ring);
  1568. rKill(dp_C_ring);
  1569. }
  1570. }
  1571. else
  1572. {
  1573. idDelete(&e);
  1574. }
  1575. idTest(s_h3);
  1576. if (currQuotient != NULL)
  1577. {
  1578. ideal ts_h3=kStd(s_h3,currQuotient,h,w);
  1579. idDelete(&s_h3);
  1580. s_h3 = ts_h3;
  1581. }
  1582. return s_h3;
  1583. }
  1584. /*2
  1585. */
  1586. ideal idXXX (ideal h1, int k)
  1587. {
  1588. ideal s_h1;
  1589. int j;
  1590. intvec *w=NULL;
  1591. assume(currRing != NULL);
  1592. ring orig_ring=currRing;
  1593. ring syz_ring=rCurrRingAssure_SyzComp();
  1594. rSetSyzComp(k);
  1595. if (orig_ring != syz_ring)
  1596. {
  1597. s_h1=idrCopyR_NoSort(h1,orig_ring);
  1598. }
  1599. else
  1600. {
  1601. s_h1 = h1;
  1602. }
  1603. ideal s_h3=kStd(s_h1,NULL,testHomog,&w,NULL,k);
  1604. if (s_h3==NULL)
  1605. {
  1606. return idFreeModule(IDELEMS(h1));
  1607. }
  1608. if (orig_ring != syz_ring)
  1609. {
  1610. idDelete(&s_h1);
  1611. idSkipZeroes(s_h3);
  1612. rChangeCurrRing(orig_ring);
  1613. s_h3 = idrMoveR_NoSort(s_h3, syz_ring);
  1614. rKill(syz_ring);
  1615. idTest(s_h3);
  1616. return s_h3;
  1617. }
  1618. idSkipZeroes(s_h3);
  1619. idTest(s_h3);
  1620. return s_h3;
  1621. }
  1622. /*
  1623. *computes a standard basis for h1 and stores the transformation matrix
  1624. * in ma
  1625. */
  1626. ideal idLiftStd (ideal h1, matrix* ma, tHomog hi, ideal * syz)
  1627. {
  1628. int i, j, k, t, inputIsIdeal=idRankFreeModule(h1);
  1629. poly p=NULL, q, qq;
  1630. intvec *w=NULL;
  1631. idDelete((ideal*)ma);
  1632. BOOLEAN lift3=FALSE;
  1633. if (syz!=NULL) { lift3=TRUE; idDelete(syz); }
  1634. if (idIs0(h1))
  1635. {
  1636. *ma=mpNew(1,0);
  1637. if (lift3)
  1638. {
  1639. *syz=idFreeModule(IDELEMS(h1));
  1640. int curr_syz_limit=rGetCurrSyzLimit();
  1641. if (curr_syz_limit>0)
  1642. for (int ii=0;ii<IDELEMS(h1);ii++)
  1643. {
  1644. if (h1->m[ii]!=NULL)
  1645. pShift(&h1->m[ii],curr_syz_limit);
  1646. }
  1647. }
  1648. return idInit(1,h1->rank);
  1649. }
  1650. BITSET save_verbose=verbose;
  1651. k=si_max(1,(int)idRankFreeModule(h1));
  1652. if ((k==1) && (!lift3)) verbose |=Sy_bit(V_IDLIFT);
  1653. ring orig_ring = currRing;
  1654. ring syz_ring = rCurrRingAssure_SyzComp();
  1655. rSetSyzComp(k);
  1656. ideal s_h1=h1;
  1657. if (orig_ring != syz_ring)
  1658. s_h1 = idrCopyR_NoSort(h1,orig_ring);
  1659. else
  1660. s_h1 = h1;
  1661. ideal s_h3=idPrepare(s_h1,hi,k,&w); // main (syz) GB computation
  1662. ideal s_h2 = idInit(IDELEMS(s_h3), s_h3->rank);
  1663. if (lift3) (*syz)=idInit(IDELEMS(s_h3),IDELEMS(h1));
  1664. if (w!=NULL) delete w;
  1665. i = 0;
  1666. // now sort the result, SB : leave in s_h3
  1667. // T: put in s_h2
  1668. // syz: put in *syz
  1669. for (j=0; j<IDELEMS(s_h3); j++)
  1670. {
  1671. if (s_h3->m[j] != NULL)
  1672. {
  1673. //if (p_MinComp(s_h3->m[j],syz_ring) <= k)
  1674. if (pGetComp(s_h3->m[j]) <= k) // syz_ring == currRing
  1675. {
  1676. i++;
  1677. q = s_h3->m[j];
  1678. while (pNext(q) != NULL)
  1679. {
  1680. if (pGetComp(pNext(q)) > k)
  1681. {
  1682. s_h2->m[j] = pNext(q);
  1683. pNext(q) = NULL;
  1684. }
  1685. else
  1686. {
  1687. pIter(q);
  1688. }
  1689. }
  1690. if (!inputIsIdeal) pShift(&(s_h3->m[j]), -1);
  1691. }
  1692. else
  1693. {
  1694. // we a syzygy here:
  1695. if (lift3)
  1696. {
  1697. pShift(&s_h3->m[j], -k);
  1698. (*syz)->m[j]=s_h3->m[j];
  1699. s_h3->m[j]=NULL;
  1700. }
  1701. else
  1702. pDelete(&(s_h3->m[j]));
  1703. }
  1704. }
  1705. }
  1706. idSkipZeroes(s_h3);
  1707. //extern char * iiStringMatrix(matrix im, int dim,char ch);
  1708. //PrintS("SB: ----------------------------------------\n");
  1709. //PrintS(iiStringMatrix((matrix)s_h3,k,'\n'));
  1710. //PrintLn();
  1711. //PrintS("T: ----------------------------------------\n");
  1712. //PrintS(iiStringMatrix((matrix)s_h2,h1->rank,'\n'));
  1713. //PrintLn();
  1714. if (lift3) idSkipZeroes(*syz);
  1715. j = IDELEMS(s_h1);
  1716. if (syz_ring!=orig_ring)
  1717. {
  1718. idDelete(&s_h1);
  1719. rChangeCurrRing(orig_ring);
  1720. }
  1721. *ma = mpNew(j,i);
  1722. i = 1;
  1723. for (j=0; j<IDELEMS(s_h2); j++)
  1724. {
  1725. if (s_h2->m[j] != NULL)
  1726. {
  1727. q = prMoveR( s_h2->m[j], syz_ring);
  1728. s_h2->m[j] = NULL;
  1729. while (q != NULL)
  1730. {
  1731. p = q;
  1732. pIter(q);
  1733. pNext(p) = NULL;
  1734. t=pGetComp(p);
  1735. pSetComp(p,0);
  1736. pSetmComp(p);
  1737. MATELEM(*ma,t-k,i) = pAdd(MATELEM(*ma,t-k,i),p);
  1738. }
  1739. i++;
  1740. }
  1741. }
  1742. idDelete(&s_h2);
  1743. for (i=0; i<IDELEMS(s_h3); i++)
  1744. {
  1745. s_h3->m[i] = prMoveR_NoSort(s_h3->m[i], syz_ring);
  1746. }
  1747. if (lift3)
  1748. {
  1749. for (i=0; i<IDELEMS(*syz); i++)
  1750. {
  1751. (*syz)->m[i] = prMoveR_NoSort((*syz)->m[i], syz_ring);
  1752. }
  1753. }
  1754. if (syz_ring!=orig_ring) rKill(syz_ring);
  1755. verbose = save_verbose;
  1756. return s_h3;
  1757. }
  1758. static void idPrepareStd(ideal s_temp, int k)
  1759. {
  1760. int j,rk=idRankFreeModule(s_temp);
  1761. poly p,q;
  1762. if (rk == 0)
  1763. {
  1764. for (j=0; j<IDELEMS(s_temp); j++)
  1765. {
  1766. if (s_temp->m[j]!=NULL) pSetCompP(s_temp->m[j],1);
  1767. }
  1768. k = si_max(k,1);
  1769. }
  1770. for (j=0; j<IDELEMS(s_temp); j++)
  1771. {
  1772. if (s_temp->m[j]!=NULL)
  1773. {
  1774. p = s_temp->m[j];
  1775. q = pOne();
  1776. //pGetCoeff(q)=nNeg(pGetCoeff(q)); //set q to -1
  1777. pSetComp(q,k+1+j);
  1778. pSetmComp(q);
  1779. while (pNext(p)) pIter(p);
  1780. pNext(p) = q;
  1781. }
  1782. }
  1783. }
  1784. /*2
  1785. *computes a representation of the generators of submod with respect to those
  1786. * of mod
  1787. */
  1788. ideal idLift(ideal mod, ideal submod,ideal *rest, BOOLEAN goodShape,
  1789. BOOLEAN isSB, BOOLEAN divide, matrix *unit)
  1790. {
  1791. int lsmod =idRankFreeModule(submod), i, j, k;
  1792. int comps_to_add=0;
  1793. poly p;
  1794. if (idIs0(submod))
  1795. {
  1796. if (unit!=NULL)
  1797. {
  1798. *unit=mpNew(1,1);
  1799. MATELEM(*unit,1,1)=pOne();
  1800. }
  1801. if (rest!=NULL)
  1802. {
  1803. *rest=idInit(1,mod->rank);
  1804. }
  1805. return idInit(1,mod->rank);
  1806. }
  1807. if (idIs0(mod)) /* and not idIs0(submod) */
  1808. {
  1809. WerrorS("2nd module does not lie in the first");
  1810. #if 0
  1811. if (unit!=NULL)
  1812. {
  1813. i=IDELEMS(submod);
  1814. *unit=mpNew(i,i);
  1815. for (j=i;j>0;j--)
  1816. {
  1817. MATELEM(*unit,j,j)=pOne();
  1818. }
  1819. }
  1820. if (rest!=NULL)
  1821. {
  1822. *rest=idCopy(submod);
  1823. }
  1824. return idInit(1,mod->rank);
  1825. #endif
  1826. return idInit(IDELEMS(submod),submod->rank);
  1827. }
  1828. if (unit!=NULL)
  1829. {
  1830. comps_to_add = IDELEMS(submod);
  1831. while ((comps_to_add>0) && (submod->m[comps_to_add-1]==NULL))
  1832. comps_to_add--;
  1833. }
  1834. k=si_max(idRankFreeModule(mod),idRankFreeModule(submod));
  1835. if ((k!=0) && (lsmod==0)) lsmod=1;
  1836. k=si_max(k,(int)mod->rank);
  1837. if (k<submod->rank) { WarnS("rk(submod) > rk(mod) ?");k=submod->rank; }
  1838. ring orig_ring=currRing;
  1839. ring syz_ring=rCurrRingAssure_SyzComp();
  1840. rSetSyzComp(k);
  1841. ideal s_mod, s_temp;
  1842. if (orig_ring != syz_ring)
  1843. {
  1844. s_mod = idrCopyR_NoSort(mod,orig_ring);
  1845. s_temp = idrCopyR_NoSort(submod,orig_ring);
  1846. }
  1847. else
  1848. {
  1849. s_mod = mod;
  1850. s_temp = idCopy(submod);
  1851. }
  1852. ideal s_h3;
  1853. if (isSB)
  1854. {
  1855. s_h3 = idCopy(s_mod);
  1856. idPrepareStd(s_h3, k+comps_to_add);
  1857. }
  1858. else
  1859. {
  1860. s_h3 = idPrepare(s_mod,(tHomog)FALSE,k+comps_to_add,NULL);
  1861. }
  1862. if (!goodShape)
  1863. {
  1864. for (j=0;j<IDELEMS(s_h3);j++)
  1865. {
  1866. if ((s_h3->m[j] != NULL) && (pMinComp(s_h3->m[j]) > k))
  1867. pDelete(&(s_h3->m[j]));
  1868. }
  1869. }
  1870. idSkipZeroes(s_h3);
  1871. if (lsmod==0)
  1872. {
  1873. for (j=IDELEMS(s_temp);j>0;j--)
  1874. {
  1875. if (s_temp->m[j-1]!=NULL)
  1876. pShift(&(s_temp->m[j-1]),1);
  1877. }
  1878. }
  1879. if (unit!=NULL)
  1880. {
  1881. for(j = 0;j<comps_to_add;j++)
  1882. {
  1883. p = s_temp->m[j];
  1884. if (p!=NULL)
  1885. {
  1886. while (pNext(p)!=NULL) pIter(p);
  1887. pNext(p) = pOne();
  1888. pIter(p);
  1889. pSetComp(p,1+j+k);
  1890. pSetmComp(p);
  1891. p = pNeg(p);
  1892. }
  1893. }
  1894. }
  1895. ideal s_result = kNF(s_h3,currQuotient,s_temp,k);
  1896. s_result->rank = s_h3->rank;
  1897. ideal s_rest = idInit(IDELEMS(s_result),k);
  1898. idDelete(&s_h3);
  1899. idDelete(&s_temp);
  1900. for (j=0;j<IDELEMS(s_result);j++)
  1901. {
  1902. if (s_result->m[j]!=NULL)
  1903. {
  1904. if (pGetComp(s_result->m[j])<=k)
  1905. {
  1906. if (!divide)
  1907. {
  1908. if (isSB)
  1909. {
  1910. WarnS("first module not a standardbasis\n"
  1911. "// ** or second not a proper submodule");
  1912. }
  1913. else
  1914. WerrorS("2nd module does not lie in the first");
  1915. idDelete(&s_result);
  1916. idDelete(&s_rest);
  1917. s_result=idInit(IDELEMS(submod),submod->rank);
  1918. break;
  1919. }
  1920. else
  1921. {
  1922. p = s_rest->m[j] = s_result->m[j];
  1923. while ((pNext(p)!=NULL) && (pGetComp(pNext(p))<=k)) pIter(p);
  1924. s_result->m[j] = pNext(p);
  1925. pNext(p) = NULL;
  1926. }
  1927. }
  1928. pShift(&(s_result->m[j]),-k);
  1929. pNeg(s_result->m[j]);
  1930. }
  1931. }
  1932. if ((lsmod==0) && (!idIs0(s_rest)))
  1933. {
  1934. for (j=IDELEMS(s_rest);j>0;j--)
  1935. {
  1936. if (s_rest->m[j-1]!=NULL)
  1937. {
  1938. pShift(&(s_rest->m[j-1]),-1);
  1939. s_rest->m[j-1] = s_rest->m[j-1];
  1940. }
  1941. }
  1942. }
  1943. if(syz_ring!=orig_ring)
  1944. {
  1945. idDelete(&s_mod);
  1946. rChangeCurrRing(orig_ring);
  1947. s_result = idrMoveR_NoSort(s_result, syz_ring);
  1948. s_rest = idrMoveR_NoSort(s_rest, syz_ring);
  1949. rKill(syz_ring);
  1950. }
  1951. if (rest!=NULL)
  1952. *rest = s_rest;
  1953. else
  1954. idDelete(&s_rest);
  1955. //idPrint(s_result);
  1956. if (unit!=NULL)
  1957. {
  1958. *unit=mpNew(comps_to_add,comps_to_add);
  1959. int i;
  1960. for(i=0;i<IDELEMS(s_result);i++)
  1961. {
  1962. poly p=s_result->m[i];
  1963. poly q=NULL;
  1964. while(p!=NULL)
  1965. {
  1966. if(pGetComp(p)<=comps_to_add)
  1967. {
  1968. pSetComp(p,0);
  1969. if (q!=NULL)
  1970. {
  1971. pNext(q)=pNext(p);
  1972. }
  1973. else
  1974. {
  1975. pIter(s_result->m[i]);
  1976. }
  1977. pNext(p)=NULL;
  1978. MATELEM(*unit,i+1,i+1)=pAdd(MATELEM(*unit,i+1,i+1),p);
  1979. if(q!=NULL) p=pNext(q);
  1980. else p=s_result->m[i];
  1981. }
  1982. else
  1983. {
  1984. q=p;
  1985. pIter(p);
  1986. }
  1987. }
  1988. pShift(&s_result->m[i],-comps_to_add);
  1989. }
  1990. }
  1991. return s_result;
  1992. }
  1993. /*2
  1994. *computes division of P by Q with remainder up to (w-weighted) degree n
  1995. *P, Q, and w are not changed
  1996. */
  1997. void idLiftW(ideal P,ideal Q,int n,matrix &T, ideal &R,short *w)
  1998. {
  1999. long N=0;
  2000. int i;
  2001. for(i=IDELEMS(Q)-1;i>=0;i--)
  2002. if(w==NULL)
  2003. N=si_max(N,pDeg(Q->m[i]));
  2004. else
  2005. N=si_max(N,pDegW(Q->m[i],w));
  2006. N+=n;
  2007. T=mpNew(IDELEMS(Q),IDELEMS(P));
  2008. R=idInit(IDELEMS(P),P->rank);
  2009. for(i=IDELEMS(P)-1;i>=0;i--)
  2010. {
  2011. poly p;
  2012. if(w==NULL)
  2013. p=ppJet(P->m[i],N);
  2014. else
  2015. p=ppJetW(P->m[i],N,w);
  2016. int j=IDELEMS(Q)-1;
  2017. while(p!=NULL)
  2018. {
  2019. if(pDivisibleBy(Q->m[j],p))
  2020. {
  2021. poly p0=pDivideM(pHead(p),pHead(Q->m[j]));
  2022. if(w==NULL)
  2023. p=pJet(pSub(p,ppMult_mm(Q->m[j],p0)),N);
  2024. else
  2025. p=pJetW(pSub(p,ppMult_mm(Q->m[j],p0)),N,w);
  2026. pNormalize(p);
  2027. if((w==NULL)&&(pDeg(p0)>n)||(w!=NULL)&&(pDegW(p0,w)>n))
  2028. pDelete(&p0);
  2029. else
  2030. MATELEM(T,j+1,i+1)=pAdd(MATELEM(T,j+1,i+1),p0);
  2031. j=IDELEMS(Q)-1;
  2032. }
  2033. else
  2034. {
  2035. if(j==0)
  2036. {
  2037. poly p0=p;
  2038. pIter(p);
  2039. pNext(p0)=NULL;
  2040. if(((w==NULL)&&(pDeg(p0)>n))
  2041. ||((w!=NULL)&&(pDegW(p0,w)>n)))
  2042. pDelete(&p0);
  2043. else
  2044. R->m[i]=pAdd(R->m[i],p0);
  2045. j=IDELEMS(Q)-1;
  2046. }
  2047. else
  2048. j--;
  2049. }
  2050. }
  2051. }
  2052. }
  2053. /*2
  2054. *computes the quotient of h1,h2 : internal routine for idQuot
  2055. *BEWARE: the returned ideals may contain incorrectly ordered polys !
  2056. *
  2057. */
  2058. static ideal idInitializeQuot (ideal h1, ideal h2, BOOLEAN h1IsStb,
  2059. BOOLEAN *addOnlyOne, int *kkmax)
  2060. {
  2061. ideal temph1;
  2062. poly p,q = NULL;
  2063. int i,l,ll,k,kkk,kmax;
  2064. int j = 0;
  2065. int k1 = idRankFreeModule(h1);
  2066. int k2 = idRankFreeModule(h2);
  2067. tHomog hom=isNotHomog;
  2068. k=si_max(k1,k2);
  2069. if (k==0)
  2070. k = 1;
  2071. if ((k2==0) && (k>1)) *addOnlyOne = FALSE;
  2072. intvec * weights;
  2073. hom = (tHomog)idHomModule(h1,currQuotient,&weights);
  2074. if (/**addOnlyOne &&*/ (!h1IsStb))
  2075. temph1 = kStd(h1,currQuotient,hom,&weights,NULL);
  2076. else
  2077. temph1 = idCopy(h1);
  2078. if (weights!=NULL) delete weights;
  2079. idTest(temph1);
  2080. /*--- making a single vector from h2 ---------------------*/
  2081. for (i=0; i<IDELEMS(h2); i++)
  2082. {
  2083. if (h2->m[i] != NULL)
  2084. {
  2085. p = pCopy(h2->m[i]);
  2086. if (k2 == 0)
  2087. pShift(&p,j*k+1);
  2088. else
  2089. pShift(&p,j*k);
  2090. q = pAdd(q,p);
  2091. j++;
  2092. }
  2093. }
  2094. *kkmax = kmax = j*k+1;
  2095. /*--- adding a monomial for the result (syzygy) ----------*/
  2096. p = q;
  2097. while (pNext(p)!=NULL) pIter(p);
  2098. pNext(p) = pOne();
  2099. pIter(p);
  2100. pSetComp(p,kmax);
  2101. pSetmComp(p);
  2102. /*--- constructing the big matrix ------------------------*/
  2103. ideal h4 = idInit(16,kmax+k-1);
  2104. h4->m[0] = q;
  2105. if (k2 == 0)
  2106. {
  2107. if (k > IDELEMS(h4))
  2108. {
  2109. pEnlargeSet(&(h4->m),IDELEMS(h4),k-IDELEMS(h4));
  2110. IDELEMS(h4) = k;
  2111. }
  2112. for (i=1; i<k; i++)
  2113. {
  2114. if (h4->m[i-1]!=NULL)
  2115. {
  2116. p = pCopy_noCheck(h4->m[i-1]);
  2117. pShift(&p,1);
  2118. h4->m[i] = p;
  2119. }
  2120. }
  2121. }
  2122. idSkipZeroes(h4);
  2123. kkk = IDELEMS(h4);
  2124. i = IDELEMS(temph1);
  2125. for (l=0; l<i; l++)
  2126. {
  2127. if(temph1->m[l]!=NULL)
  2128. {
  2129. for (ll=0; ll<j; ll++)
  2130. {
  2131. p = pCopy(temph1->m[l]);
  2132. if (k1 == 0)
  2133. pShift(&p,ll*k+1);
  2134. else
  2135. pShift(&p,ll*k);
  2136. if (kkk >= IDELEMS(h4))
  2137. {
  2138. pEnlargeSet(&(h4->m),IDELEMS(h4),16);
  2139. IDELEMS(h4) += 16;
  2140. }
  2141. h4->m[kkk] = p;
  2142. kkk++;
  2143. }
  2144. }
  2145. }
  2146. /*--- if h2 goes in as single vector - the h1-part is just SB ---*/
  2147. if (*addOnlyOne)
  2148. {
  2149. idSkipZeroes(h4);
  2150. p = h4->m[0];
  2151. for (i=0;i<IDELEMS(h4)-1;i++)
  2152. {
  2153. h4->m[i] = h4->m[i+1];
  2154. }
  2155. h4->m[IDELEMS(h4)-1] = p;
  2156. test |= Sy_bit(OPT_SB_1);
  2157. }
  2158. idDelete(&temph1);
  2159. return h4;
  2160. }
  2161. /*2
  2162. *computes the quotient of h1,h2
  2163. */
  2164. ideal idQuot (ideal h1, ideal h2, BOOLEAN h1IsStb, BOOLEAN resultIsIdeal)
  2165. {
  2166. // first check for special case h1:(0)
  2167. if (idIs0(h2))
  2168. {
  2169. ideal res;
  2170. if (resultIsIdeal)
  2171. {
  2172. res = idInit(1,1);
  2173. res->m[0] = pOne();
  2174. }
  2175. else
  2176. res = idFreeModule(h1->rank);
  2177. return res;
  2178. }
  2179. BITSET old_test=test;
  2180. int i,l,ll,k,kkk,kmax;
  2181. BOOLEAN addOnlyOne=TRUE;
  2182. tHomog hom=isNotHomog;
  2183. intvec * weights1;
  2184. ideal s_h4 = idInitializeQuot (h1,h2,h1IsStb,&addOnlyOne,&kmax);
  2185. hom = (tHomog)idHomModule(s_h4,currQuotient,&weights1);
  2186. ring orig_ring=currRing;
  2187. ring syz_ring=rCurrRingAssure_SyzComp();
  2188. rSetSyzComp(kmax-1);
  2189. if (orig_ring!=syz_ring)
  2190. // s_h4 = idrMoveR_NoSort(s_h4,orig_ring);
  2191. s_h4 = idrMoveR(s_h4,orig_ring);
  2192. idTest(s_h4);
  2193. #if 0
  2194. void ipPrint_MA0(matrix m, const char *name);
  2195. matrix m=idModule2Matrix(idCopy(s_h4));
  2196. PrintS("start:\n");
  2197. ipPrint_MA0(m,"Q");
  2198. idDelete((ideal *)&m);
  2199. PrintS("last elem:");wrp(s_h4->m[IDELEMS(s_h4)-1]);PrintLn();
  2200. #endif
  2201. ideal s_h3;
  2202. if (addOnlyOne)
  2203. {
  2204. s_h3 = kStd(s_h4,currQuotient,hom,&weights1,NULL,0/*kmax-1*/,IDELEMS(s_h4)-1);
  2205. }
  2206. else
  2207. {
  2208. s_h3 = kStd(s_h4,currQuotient,hom,&weights1,NULL,kmax-1);
  2209. }
  2210. test = old_test;
  2211. #if 0
  2212. // only together with the above debug stuff
  2213. idSkipZeroes(s_h3);
  2214. m=idModule2Matrix(idCopy(s_h3));
  2215. Print("result, kmax=%d:\n",kmax);
  2216. ipPrint_MA0(m,"S");
  2217. idDelete((ideal *)&m);
  2218. #endif
  2219. idTest(s_h3);
  2220. if (weights1!=NULL) delete weights1;
  2221. idDelete(&s_h4);
  2222. for (i=0;i<IDELEMS(s_h3);i++)
  2223. {
  2224. if ((s_h3->m[i]!=NULL) && (pGetComp(s_h3->m[i])>=kmax))
  2225. {
  2226. if (resultIsIdeal)
  2227. pShift(&s_h3->m[i],-kmax);
  2228. else
  2229. pShift(&s_h3->m[i],-kmax+1);
  2230. }
  2231. else
  2232. pDelete(&s_h3->m[i]);
  2233. }
  2234. if (resultIsIdeal)
  2235. s_h3->rank = 1;
  2236. else
  2237. s_h3->rank = h1->rank;
  2238. if(syz_ring!=orig_ring)
  2239. {
  2240. rChangeCurrRing(orig_ring);
  2241. s_h3 = idrMoveR_NoSort(s_h3, syz_ring);
  2242. rKill(syz_ring);
  2243. }
  2244. idSkipZeroes(s_h3);
  2245. idTest(s_h3);
  2246. return s_h3;
  2247. }
  2248. /*2
  2249. *computes recursively all monomials of a certain degree
  2250. *in every step the actvar-th entry in the exponential
  2251. *vector is incremented and the other variables are
  2252. *computed by recursive calls of makemonoms
  2253. *if the last variable is reached, the difference to the
  2254. *degree is computed directly
  2255. *vars is the number variables
  2256. *actvar is the actual variable to handle
  2257. *deg is the degree of the monomials to compute
  2258. *monomdeg is the actual degree of the monomial in consideration
  2259. */
  2260. static void makemonoms(int vars,int actvar,int deg,int monomdeg)
  2261. {
  2262. poly p;
  2263. int i=0;
  2264. if ((idpowerpoint == 0) && (actvar ==1))
  2265. {
  2266. idpower[idpowerpoint] = pOne();
  2267. monomdeg = 0;
  2268. }
  2269. while (i<=deg)
  2270. {
  2271. if (deg == monomdeg)
  2272. {
  2273. pSetm(idpower[idpowerpoint]);
  2274. idpowerpoint++;
  2275. return;
  2276. }
  2277. if (actvar == vars)
  2278. {
  2279. pSetExp(idpower[idpowerpoint],actvar,deg-monomdeg);
  2280. pSetm(idpower[idpowerpoint]);
  2281. pTest(idpower[idpowerpoint]);
  2282. idpowerpoint++;
  2283. return;
  2284. }
  2285. else
  2286. {
  2287. p = pCopy(idpower[idpowerpoint]);
  2288. makemonoms(vars,actvar+1,deg,monomdeg);
  2289. idpower[idpowerpoint] = p;
  2290. }
  2291. monomdeg++;
  2292. pSetExp(idpower[idpowerpoint],actvar,pGetExp(idpower[idpowerpoint],actvar)+1);
  2293. pSetm(idpower[idpowerpoint]);
  2294. pTest(idpower[idpowerpoint]);
  2295. i++;
  2296. }
  2297. }
  2298. /*2
  2299. *returns the deg-th power of the maximal ideal of 0
  2300. */
  2301. ideal idMaxIdeal(int deg)
  2302. {
  2303. if (deg < 0)
  2304. {
  2305. WarnS("maxideal: power must be non-negative");
  2306. }
  2307. if (deg < 1)
  2308. {
  2309. ideal I=idInit(1,1);
  2310. I->m[0]=pOne();
  2311. return I;
  2312. }
  2313. if (deg == 1)
  2314. {
  2315. return idMaxIdeal();
  2316. }
  2317. int vars = currRing->N;
  2318. int i = binom(vars+deg-1,deg);
  2319. if (i<=0) return idInit(1,1);
  2320. ideal id=idInit(i,1);
  2321. idpower = id->m;
  2322. idpowerpoint = 0;
  2323. makemonoms(vars,1,deg,0);
  2324. idpower = NULL;
  2325. idpowerpoint = 0;
  2326. return id;
  2327. }
  2328. /*2
  2329. *computes recursively all generators of a certain degree
  2330. *of the ideal "givenideal"
  2331. *elms is the number elements in the given ideal
  2332. *actelm is the actual element to handle
  2333. *deg is the degree of the power to compute
  2334. *gendeg is the actual degree of the generator in consideration
  2335. */
  2336. static void makepotence(int elms,int actelm,int deg,int gendeg)
  2337. {
  2338. poly p;
  2339. int i=0;
  2340. if ((idpowerpoint == 0) && (actelm ==1))
  2341. {
  2342. idpower[idpowerpoint] = pOne();
  2343. gendeg = 0;
  2344. }
  2345. while (i<=deg)
  2346. {
  2347. if (deg == gendeg)
  2348. {
  2349. idpowerpoint++;
  2350. return;
  2351. }
  2352. if (actelm == elms)
  2353. {
  2354. p=pPower(pCopy(givenideal[actelm-1]),deg-gendeg);
  2355. idpower[idpowerpoint]=pMult(idpower[idpowerpoint],p);
  2356. idpowerpoint++;
  2357. return;
  2358. }
  2359. else
  2360. {
  2361. p = pCopy(idpower[idpowerpoint]);
  2362. makepotence(elms,actelm+1,deg,gendeg);
  2363. idpower[idpowerpoint] = p;
  2364. }
  2365. gendeg++;
  2366. idpower[idpowerpoint]=pMult(idpower[idpowerpoint],pCopy(givenideal[actelm-1]));
  2367. i++;
  2368. }
  2369. }
  2370. /*2
  2371. *returns the deg-th power of the ideal gid
  2372. */
  2373. //ideal idPower(ideal gid,int deg)
  2374. //{
  2375. // int i;
  2376. // ideal id;
  2377. //
  2378. // if (deg < 1) deg = 1;
  2379. // i = binom(IDELEMS(gid)+deg-1,deg);
  2380. // id=idInit(i,1);
  2381. // idpower = id->m;
  2382. // givenideal = gid->m;
  2383. // idpowerpoint = 0;
  2384. // makepotence(IDELEMS(gid),1,deg,0);
  2385. // idpower = NULL;
  2386. // givenideal = NULL;
  2387. // idpowerpoint = 0;
  2388. // return id;
  2389. //}
  2390. static void idNextPotence(ideal given, ideal result,
  2391. int begin, int end, int deg, int restdeg, poly ap)
  2392. {
  2393. poly p;
  2394. int i;
  2395. p = pPower(pCopy(given->m[begin]),restdeg);
  2396. i = result->nrows;
  2397. result->m[i] = pMult(pCopy(ap),p);
  2398. //PrintS(".");
  2399. (result->nrows)++;
  2400. if (result->nrows >= IDELEMS(result))
  2401. {
  2402. pEnlargeSet(&(result->m),IDELEMS(result),16);
  2403. IDELEMS(result) += 16;
  2404. }
  2405. if (begin == end) return;
  2406. for (i=restdeg-1;i>0;i--)
  2407. {
  2408. p = pPower(pCopy(given->m[begin]),i);
  2409. p = pMult(pCopy(ap),p);
  2410. idNextPotence(given, result, begin+1, end, deg, restdeg-i, p);
  2411. pDelete(&p);
  2412. }
  2413. idNextPotence(given, result, begin+1, end, deg, restdeg, ap);
  2414. }
  2415. ideal idPower(ideal given,int exp)
  2416. {
  2417. ideal result,temp;
  2418. poly p1;
  2419. int i;
  2420. if (idIs0(given)) return idInit(1,1);
  2421. temp = idCopy(given);
  2422. idSkipZeroes(temp);
  2423. i = binom(IDELEMS(temp)+exp-1,exp);
  2424. result = idInit(i,1);
  2425. result->nrows = 0;
  2426. //Print("ideal contains %d elements\n",i);
  2427. p1=pOne();
  2428. idNextPotence(temp,result,0,IDELEMS(temp)-1,exp,exp,p1);
  2429. pDelete(&p1);
  2430. idDelete(&temp);
  2431. result->nrows = 1;
  2432. idDelEquals(result);
  2433. idSkipZeroes(result);
  2434. return result;
  2435. }
  2436. /*2
  2437. * eliminate delVar (product of vars) in h1
  2438. */
  2439. ideal idElimination (ideal h1,poly delVar,intvec *hilb)
  2440. {
  2441. int i,j=0,k,l;
  2442. ideal h,hh, h3;
  2443. int *ord,*block0,*block1;
  2444. int ordersize=2;
  2445. int **wv;
  2446. tHomog hom;
  2447. intvec * w;
  2448. ring tmpR;
  2449. ring origR = currRing;
  2450. if (delVar==NULL)
  2451. {
  2452. return idCopy(h1);
  2453. }
  2454. if ((currQuotient!=NULL) && rIsPluralRing(origR))
  2455. {
  2456. WerrorS("cannot eliminate in a qring");
  2457. return idCopy(h1);
  2458. }
  2459. if (idIs0(h1)) return idInit(1,h1->rank);
  2460. #ifdef HAVE_PLURAL
  2461. if (rIsPluralRing(origR))
  2462. /* in the NC case, we have to check the admissibility of */
  2463. /* the subalgebra to be intersected with */
  2464. {
  2465. if ((ncRingType(origR) != nc_skew) && (ncRingType(origR) != nc_exterior)) /* in (quasi)-commutative algebras every subalgebra is admissible */
  2466. {
  2467. if (nc_CheckSubalgebra(delVar,origR))
  2468. {
  2469. WerrorS("no elimination is possible: subalgebra is not admissible");
  2470. return idCopy(h1);
  2471. }
  2472. }
  2473. }
  2474. #endif
  2475. hom=(tHomog)idHomModule(h1,NULL,&w); //sets w to weight vector or NULL
  2476. h3=idInit(16,h1->rank);
  2477. for (k=0;; k++)
  2478. {
  2479. if (origR->order[k]!=0) ordersize++;
  2480. else break;
  2481. }
  2482. #if 0
  2483. if (rIsPluralRing(origR)) // we have too keep the odering: it may be needed
  2484. // for G-algebra
  2485. {
  2486. for (k=0;k<ordersize-1; k++)
  2487. {
  2488. block0[k+1] = origR->block0[k];
  2489. block1[k+1] = origR->block1[k];
  2490. ord[k+1] = origR->order[k];
  2491. if (origR->wvhdl[k]!=NULL) wv[k+1] = (int*) omMemDup(origR->wvhdl[k]);
  2492. }
  2493. }
  2494. else
  2495. {
  2496. block0[1] = 1;
  2497. block1[1] = pVariables;
  2498. if (origR->OrdSgn==1) ord[1] = ringorder_wp;
  2499. else ord[1] = ringorder_ws;
  2500. wv[1]=(int*)omAlloc0(pVariables*sizeof(int));
  2501. double wNsqr = (double)2.0 / (double)pVariables;
  2502. wFunctional = wFunctionalBuch;
  2503. int *x= (int * )omAlloc(2 * (pVariables + 1) * sizeof(int));
  2504. int sl=IDELEMS(h1) - 1;
  2505. wCall(h1->m, sl, x, wNsqr);
  2506. for (sl = pVariables; sl!=0; sl--)
  2507. wv[1][sl-1] = x[sl + pVariables + 1];
  2508. omFreeSize((ADDRESS)x, 2 * (pVariables + 1) * sizeof(int));
  2509. ord[2]=ringorder_C;
  2510. ord[3]=0;
  2511. }
  2512. #else
  2513. #endif
  2514. if ((hom==TRUE) && (origR->OrdSgn==1) && (!rIsPluralRing(origR)))
  2515. {
  2516. #if 1
  2517. // we change to an ordering:
  2518. // aa(1,1,1,...,0,0,0),wp(...),C
  2519. // this seems to be better than version 2 below,
  2520. // according to Tst/../elimiate_[3568].tat (- 17 %)
  2521. ord=(int*)omAlloc0(4*sizeof(int));
  2522. block0=(int*)omAlloc0(4*sizeof(int));
  2523. block1=(int*)omAlloc0(4*sizeof(int));
  2524. wv=(int**) omAlloc0(4*sizeof(int**));
  2525. block0[0] = block0[1] = 1;
  2526. block1[0] = block1[1] = rVar(origR);
  2527. wv[0]=(int*)omAlloc0((rVar(origR) + 1)*sizeof(int));
  2528. // use this special ordering: like ringorder_a, except that pFDeg, pWeights
  2529. // ignore it
  2530. ord[0] = ringorder_aa;
  2531. for (j=0;j<rVar(origR);j++)
  2532. if (pGetExp(delVar,j+1)!=0) wv[0][j]=1;
  2533. BOOLEAN wp=FALSE;
  2534. for (j=0;j<rVar(origR);j++)
  2535. if (pWeight(j+1,origR)!=1) { wp=TRUE;break; }
  2536. if (wp)
  2537. {
  2538. wv[1]=(int*)omAlloc0((rVar(origR) + 1)*sizeof(int));
  2539. for (j=0;j<rVar(origR);j++)
  2540. wv[1][j]=pWeight(j+1,origR);
  2541. ord[1] = ringorder_wp;
  2542. }
  2543. else
  2544. ord[1] = ringorder_dp;
  2545. #else
  2546. // we change to an ordering:
  2547. // a(w1,...wn),wp(1,...0.....),C
  2548. ord=(int*)omAlloc0(4*sizeof(int));
  2549. block0=(int*)omAlloc0(4*sizeof(int));
  2550. block1=(int*)omAlloc0(4*sizeof(int));
  2551. wv=(int**) omAlloc0(4*sizeof(int**));
  2552. block0[0] = block0[1] = 1;
  2553. block1[0] = block1[1] = rVar(origR);
  2554. wv[0]=(int*)omAlloc0((rVar(origR) + 1)*sizeof(int));
  2555. wv[1]=(int*)omAlloc0((rVar(origR) + 1)*sizeof(int));
  2556. ord[0] = ringorder_a;
  2557. for (j=0;j<rVar(origR);j++)
  2558. wv[0][j]=pWeight(j+1,origR);
  2559. ord[1] = ringorder_wp;
  2560. for (j=0;j<rVar(origR);j++)
  2561. if (pGetExp(delVar,j+1)!=0) wv[1][j]=1;
  2562. #endif
  2563. ord[2] = ringorder_C;
  2564. ord[3] = 0;
  2565. }
  2566. else
  2567. {
  2568. // we change to an ordering:
  2569. // aa(....),orig_ordering
  2570. ord=(int*)omAlloc0(ordersize*sizeof(int));
  2571. block0=(int*)omAlloc0(ordersize*sizeof(int));
  2572. block1=(int*)omAlloc0(ordersize*sizeof(int));
  2573. wv=(int**) omAlloc0(ordersize*sizeof(int**));
  2574. for (k=0;k<ordersize-1; k++)
  2575. {
  2576. block0[k+1] = origR->block0[k];
  2577. block1[k+1] = origR->block1[k];
  2578. ord[k+1] = origR->order[k];
  2579. if (origR->wvhdl[k]!=NULL) wv[k+1] = (int*) omMemDup(origR->wvhdl[k]);
  2580. }
  2581. block0[0] = 1;
  2582. block1[0] = rVar(origR);
  2583. wv[0]=(int*)omAlloc0((rVar(origR) + 1)*sizeof(int));
  2584. for (j=0;j<rVar(origR);j++)
  2585. if (pGetExp(delVar,j+1)!=0) wv[0][j]=1;
  2586. // use this special ordering: like ringorder_a, except that pFDeg, pWeights
  2587. // ignore it
  2588. ord[0] = ringorder_aa;
  2589. }
  2590. // fill in tmp ring to get back the data later on
  2591. tmpR = rCopy0(origR,FALSE,FALSE); // qring==NULL
  2592. //rUnComplete(tmpR);
  2593. tmpR->p_Procs=NULL;
  2594. tmpR->order = ord;
  2595. tmpR->block0 = block0;
  2596. tmpR->block1 = block1;
  2597. tmpR->wvhdl = wv;
  2598. rComplete(tmpR, 1);
  2599. #ifdef HAVE_PLURAL
  2600. /* update nc structure on tmpR */
  2601. if (rIsPluralRing(origR))
  2602. {
  2603. if ( nc_rComplete(origR, tmpR, false) ) // no quotient ideal!
  2604. {
  2605. Werror("no elimination is possible: ordering condition is violated");
  2606. // cleanup
  2607. rDelete(tmpR);
  2608. if (w!=NULL)
  2609. delete w;
  2610. return idCopy(h1);
  2611. }
  2612. }
  2613. #endif
  2614. // change into the new ring
  2615. //pChangeRing(pVariables,currRing->OrdSgn,ord,block0,block1,wv);
  2616. rChangeCurrRing(tmpR);
  2617. //h = idInit(IDELEMS(h1),h1->rank);
  2618. // fetch data from the old ring
  2619. //for (k=0;k<IDELEMS(h1);k++) h->m[k] = prCopyR( h1->m[k], origR);
  2620. h=idrCopyR(h1,origR,currRing);
  2621. if (origR->qideal!=NULL)
  2622. {
  2623. WarnS("eliminate in q-ring: experimental");
  2624. ideal q=idrCopyR(origR->qideal,origR,currRing);
  2625. ideal s=idSimpleAdd(h,q);
  2626. idDelete(&h);
  2627. idDelete(&q);
  2628. h=s;
  2629. }
  2630. // compute kStd
  2631. #if 1
  2632. //rWrite(tmpR);PrintLn();
  2633. BITSET save=test;
  2634. //test |=1;
  2635. //Print("h: %d gen, rk=%d\n",IDELEMS(h),h->rank);
  2636. //extern char * showOption();
  2637. //Print("%s\n",showOption());
  2638. hh = kStd(h,NULL,hom,&w,hilb);
  2639. test=save;
  2640. idDelete(&h);
  2641. #else
  2642. extern ideal kGroebner(ideal F, ideal Q);
  2643. hh=kGroebner(h,NULL);
  2644. #endif
  2645. // go back to the original ring
  2646. rChangeCurrRing(origR);
  2647. i = IDELEMS(hh)-1;
  2648. while ((i >= 0) && (hh->m[i] == NULL)) i--;
  2649. j = -1;
  2650. // fetch data from temp ring
  2651. for (k=0; k<=i; k++)
  2652. {
  2653. l=pVariables;
  2654. while ((l>0) && (p_GetExp( hh->m[k],l,tmpR)*pGetExp(delVar,l)==0)) l--;
  2655. if (l==0)
  2656. {
  2657. j++;
  2658. if (j >= IDELEMS(h3))
  2659. {
  2660. pEnlargeSet(&(h3->m),IDELEMS(h3),16);
  2661. IDELEMS(h3) += 16;
  2662. }
  2663. h3->m[j] = prMoveR( hh->m[k], tmpR);
  2664. hh->m[k] = NULL;
  2665. }
  2666. }
  2667. id_Delete(&hh, tmpR);
  2668. idSkipZeroes(h3);
  2669. rDelete(tmpR);
  2670. if (w!=NULL)
  2671. delete w;
  2672. return h3;
  2673. }
  2674. /*2
  2675. * compute the which-th ar-minor of the matrix a
  2676. */
  2677. poly idMinor(matrix a, int ar, unsigned long which, ideal R)
  2678. {
  2679. int i,j,k,size;
  2680. unsigned long curr;
  2681. int *rowchoise,*colchoise;
  2682. BOOLEAN rowch,colch;
  2683. ideal result;
  2684. matrix tmp;
  2685. poly p,q;
  2686. i = binom(a->rows(),ar);
  2687. j = binom(a->cols(),ar);
  2688. rowchoise=(int *)omAlloc(ar*sizeof(int));
  2689. colchoise=(int *)omAlloc(ar*sizeof(int));
  2690. if ((i>512) || (j>512) || (i*j >512)) size=512;
  2691. else size=i*j;
  2692. result=idInit(size,1);
  2693. tmp=mpNew(ar,ar);
  2694. k = 0; /* the index in result*/
  2695. curr = 0; /* index of current minor */
  2696. idInitChoise(ar,1,a->rows(),&rowch,rowchoise);
  2697. while (!rowch)
  2698. {
  2699. idInitChoise(ar,1,a->cols(),&colch,colchoise);
  2700. while (!colch)
  2701. {
  2702. if (curr == which)
  2703. {
  2704. for (i=1; i<=ar; i++)
  2705. {
  2706. for (j=1; j<=ar; j++)
  2707. {
  2708. MATELEM(tmp,i,j) = MATELEM(a,rowchoise[i-1],colchoise[j-1]);
  2709. }
  2710. }
  2711. p = mpDetBareiss(tmp);
  2712. if (p!=NULL)
  2713. {
  2714. if (R!=NULL)
  2715. {
  2716. q = p;
  2717. p = kNF(R,currQuotient,q);
  2718. pDelete(&q);
  2719. }
  2720. /*delete the matrix tmp*/
  2721. for (i=1; i<=ar; i++)
  2722. {
  2723. for (j=1; j<=ar; j++) MATELEM(tmp,i,j) = NULL;
  2724. }
  2725. idDelete((ideal*)&tmp);
  2726. omFreeSize((ADDRESS)rowchoise,ar*sizeof(int));
  2727. omFreeSize((ADDRESS)colchoise,ar*sizeof(int));
  2728. return (p);
  2729. }
  2730. }
  2731. curr++;
  2732. idGetNextChoise(ar,a->cols(),&colch,colchoise);
  2733. }
  2734. idGetNextChoise(ar,a->rows(),&rowch,rowchoise);
  2735. }
  2736. return (poly) 1;
  2737. }
  2738. #ifdef WITH_OLD_MINOR
  2739. /*2
  2740. * compute all ar-minors of the matrix a
  2741. */
  2742. ideal idMinors(matrix a, int ar, ideal R)
  2743. {
  2744. int i,j,k,size;
  2745. int *rowchoise,*colchoise;
  2746. BOOLEAN rowch,colch;
  2747. ideal result;
  2748. matrix tmp;
  2749. poly p,q;
  2750. i = binom(a->rows(),ar);
  2751. j = binom(a->cols(),ar);
  2752. rowchoise=(int *)omAlloc(ar*sizeof(int));
  2753. colchoise=(int *)omAlloc(ar*sizeof(int));
  2754. if ((i>512) || (j>512) || (i*j >512)) size=512;
  2755. else size=i*j;
  2756. result=idInit(size,1);
  2757. tmp=mpNew(ar,ar);
  2758. k = 0; /* the index in result*/
  2759. idInitChoise(ar,1,a->rows(),&rowch,rowchoise);
  2760. while (!rowch)
  2761. {
  2762. idInitChoise(ar,1,a->cols(),&colch,colchoise);
  2763. while (!colch)
  2764. {
  2765. for (i=1; i<=ar; i++)
  2766. {
  2767. for (j=1; j<=ar; j++)
  2768. {
  2769. MATELEM(tmp,i,j) = MATELEM(a,rowchoise[i-1],colchoise[j-1]);
  2770. }
  2771. }
  2772. p = mpDetBareiss(tmp);
  2773. if (p!=NULL)
  2774. {
  2775. if (R!=NULL)
  2776. {
  2777. q = p;
  2778. p = kNF(R,currQuotient,q);
  2779. pDelete(&q);
  2780. }
  2781. if (p!=NULL)
  2782. {
  2783. if (k>=size)
  2784. {
  2785. pEnlargeSet(&result->m,size,32);
  2786. size += 32;
  2787. }
  2788. result->m[k] = p;
  2789. k++;
  2790. }
  2791. }
  2792. idGetNextChoise(ar,a->cols(),&colch,colchoise);
  2793. }
  2794. idGetNextChoise(ar,a->rows(),&rowch,rowchoise);
  2795. }
  2796. /*delete the matrix tmp*/
  2797. for (i=1; i<=ar; i++)
  2798. {
  2799. for (j=1; j<=ar; j++) MATELEM(tmp,i,j) = NULL;
  2800. }
  2801. idDelete((ideal*)&tmp);
  2802. if (k==0)
  2803. {
  2804. k=1;
  2805. result->m[0]=NULL;
  2806. }
  2807. omFreeSize((ADDRESS)rowchoise,ar*sizeof(int));
  2808. omFreeSize((ADDRESS)colchoise,ar*sizeof(int));
  2809. pEnlargeSet(&result->m,size,k-size);
  2810. IDELEMS(result) = k;
  2811. return (result);
  2812. }
  2813. #else
  2814. /*2
  2815. * compute all ar-minors of the matrix a
  2816. * the caller of mpRecMin
  2817. * the elements of the result are not in R (if R!=NULL)
  2818. */
  2819. ideal idMinors(matrix a, int ar, ideal R)
  2820. {
  2821. int elems=0;
  2822. int r=a->nrows,c=a->ncols;
  2823. int i;
  2824. matrix b;
  2825. ideal result,h;
  2826. ring origR;
  2827. ring tmpR;
  2828. long bound;
  2829. if((ar<=0) || (ar>r) || (ar>c))
  2830. {
  2831. Werror("%d-th minor, matrix is %dx%d",ar,r,c);
  2832. return NULL;
  2833. }
  2834. h = idMatrix2Module(mpCopy(a));
  2835. bound = smExpBound(h,c,r,ar);
  2836. idDelete(&h);
  2837. tmpR=smRingChange(&origR,bound);
  2838. b = mpNew(r,c);
  2839. for (i=r*c-1;i>=0;i--)
  2840. {
  2841. if (a->m[i])
  2842. b->m[i] = prCopyR(a->m[i],origR);
  2843. }
  2844. if (R!=NULL)
  2845. {
  2846. R = idrCopyR(R,origR);
  2847. //if (ar>1) // otherwise done in mpMinorToResult
  2848. //{
  2849. // matrix bb=(matrix)kNF(R,currQuotient,(ideal)b);
  2850. // bb->rank=b->rank; bb->nrows=b->nrows; bb->ncols=b->ncols;
  2851. // idDelete((ideal*)&b); b=bb;
  2852. //}
  2853. }
  2854. result=idInit(32,1);
  2855. if(ar>1) mpRecMin(ar-1,result,elems,b,r,c,NULL,R);
  2856. else mpMinorToResult(result,elems,b,r,c,R);
  2857. idDelete((ideal *)&b);
  2858. if (R!=NULL) idDelete(&R);
  2859. idSkipZeroes(result);
  2860. rChangeCurrRing(origR);
  2861. result = idrMoveR(result,tmpR);
  2862. smKillModifiedRing(tmpR);
  2863. idTest(result);
  2864. return result;
  2865. }
  2866. #endif
  2867. /*2
  2868. *skips all zeroes and double elements, searches also for units
  2869. */
  2870. void idCompactify(ideal id)
  2871. {
  2872. int i,j;
  2873. BOOLEAN b=FALSE;
  2874. i = IDELEMS(id)-1;
  2875. while ((! b) && (i>=0))
  2876. {
  2877. b=pIsUnit(id->m[i]);
  2878. i--;
  2879. }
  2880. if (b)
  2881. {
  2882. for(i=IDELEMS(id)-1;i>=0;i--) pDelete(&id->m[i]);
  2883. id->m[0]=pOne();
  2884. }
  2885. else
  2886. {
  2887. idDelMultiples(id);
  2888. }
  2889. idSkipZeroes(id);
  2890. }
  2891. /*2
  2892. *returns TRUE if id1 is a submodule of id2
  2893. */
  2894. BOOLEAN idIsSubModule(ideal id1,ideal id2)
  2895. {
  2896. int i;
  2897. poly p;
  2898. if (idIs0(id1)) return TRUE;
  2899. for (i=0;i<IDELEMS(id1);i++)
  2900. {
  2901. if (id1->m[i] != NULL)
  2902. {
  2903. p = kNF(id2,currQuotient,id1->m[i]);
  2904. if (p != NULL)
  2905. {
  2906. pDelete(&p);
  2907. return FALSE;
  2908. }
  2909. }
  2910. }
  2911. return TRUE;
  2912. }
  2913. /*2
  2914. * returns the ideals of initial terms
  2915. */
  2916. ideal idHead(ideal h)
  2917. {
  2918. ideal m = idInit(IDELEMS(h),h->rank);
  2919. int i;
  2920. for (i=IDELEMS(h)-1;i>=0; i--)
  2921. {
  2922. if (h->m[i]!=NULL) m->m[i]=pHead(h->m[i]);
  2923. }
  2924. return m;
  2925. }
  2926. ideal idHomogen(ideal h, int varnum)
  2927. {
  2928. ideal m = idInit(IDELEMS(h),h->rank);
  2929. int i;
  2930. for (i=IDELEMS(h)-1;i>=0; i--)
  2931. {
  2932. m->m[i]=pHomogen(h->m[i],varnum);
  2933. }
  2934. return m;
  2935. }
  2936. /*------------------type conversions----------------*/
  2937. ideal idVec2Ideal(poly vec)
  2938. {
  2939. ideal result=idInit(1,1);
  2940. omFree((ADDRESS)result->m);
  2941. result->m=NULL; // remove later
  2942. pVec2Polys(vec, &(result->m), &(IDELEMS(result)));
  2943. return result;
  2944. }
  2945. #define NEW_STUFF
  2946. #ifndef NEW_STUFF
  2947. // converts mat to module, destroys mat
  2948. ideal idMatrix2Module(matrix mat)
  2949. {
  2950. int mc=MATCOLS(mat);
  2951. int mr=MATROWS(mat);
  2952. ideal result = idInit(si_max(mc,1),si_max(mr,1));
  2953. int i,j;
  2954. poly h;
  2955. for(j=0;j<mc /*MATCOLS(mat)*/;j++) /* j is also index in result->m */
  2956. {
  2957. for (i=1;i<=mr /*MATROWS(mat)*/;i++)
  2958. {
  2959. h = MATELEM(mat,i,j+1);
  2960. if (h!=NULL)
  2961. {
  2962. MATELEM(mat,i,j+1)=NULL;
  2963. pSetCompP(h,i);
  2964. result->m[j] = pAdd(result->m[j],h);
  2965. }
  2966. }
  2967. }
  2968. // obachman: need to clean this up
  2969. idDelete((ideal*) &mat);
  2970. return result;
  2971. }
  2972. #else
  2973. #include <kernel/sbuckets.h>
  2974. // converts mat to module, destroys mat
  2975. ideal idMatrix2Module(matrix mat)
  2976. {
  2977. int mc=MATCOLS(mat);
  2978. int mr=MATROWS(mat);
  2979. ideal result = idInit(si_max(mc,1),si_max(mr,1));
  2980. int i,j, l;
  2981. poly h;
  2982. poly p;
  2983. sBucket_pt bucket = sBucketCreate(currRing);
  2984. for(j=0;j<mc /*MATCOLS(mat)*/;j++) /* j is also index in result->m */
  2985. {
  2986. for (i=1;i<=mr /*MATROWS(mat)*/;i++)
  2987. {
  2988. h = MATELEM(mat,i,j+1);
  2989. if (h!=NULL)
  2990. {
  2991. l=pLength(h);
  2992. MATELEM(mat,i,j+1)=NULL;
  2993. p_SetCompP(h,i, currRing);
  2994. sBucket_Merge_p(bucket, h, l);
  2995. }
  2996. }
  2997. sBucketClearMerge(bucket, &(result->m[j]), &l);
  2998. }
  2999. sBucketDestroy(&bucket);
  3000. // obachman: need to clean this up
  3001. idDelete((ideal*) &mat);
  3002. return result;
  3003. }
  3004. #endif
  3005. /*2
  3006. * converts a module into a matrix, destroyes the input
  3007. */
  3008. matrix idModule2Matrix(ideal mod)
  3009. {
  3010. matrix result = mpNew(mod->rank,IDELEMS(mod));
  3011. int i,cp;
  3012. poly p,h;
  3013. for(i=0;i<IDELEMS(mod);i++)
  3014. {
  3015. p=pReverse(mod->m[i]);
  3016. mod->m[i]=NULL;
  3017. while (p!=NULL)
  3018. {
  3019. h=p;
  3020. pIter(p);
  3021. pNext(h)=NULL;
  3022. // cp = si_max(1,pGetComp(h)); // if used for ideals too
  3023. cp = pGetComp(h);
  3024. pSetComp(h,0);
  3025. pSetmComp(h);
  3026. #ifdef TEST
  3027. if (cp>mod->rank)
  3028. {
  3029. Print("## inv. rank %ld -> %d\n",mod->rank,cp);
  3030. int k,l,o=mod->rank;
  3031. mod->rank=cp;
  3032. matrix d=mpNew(mod->rank,IDELEMS(mod));
  3033. for (l=1; l<=o; l++)
  3034. {
  3035. for (k=1; k<=IDELEMS(mod); k++)
  3036. {
  3037. MATELEM(d,l,k)=MATELEM(result,l,k);
  3038. MATELEM(result,l,k)=NULL;
  3039. }
  3040. }
  3041. idDelete((ideal *)&result);
  3042. result=d;
  3043. }
  3044. #endif
  3045. MATELEM(result,cp,i+1) = pAdd(MATELEM(result,cp,i+1),h);
  3046. }
  3047. }
  3048. // obachman 10/99: added the following line, otherwise memory leack!
  3049. idDelete(&mod);
  3050. return result;
  3051. }
  3052. matrix idModule2formatedMatrix(ideal mod,int rows, int cols)
  3053. {
  3054. matrix result = mpNew(rows,cols);
  3055. int i,cp,r=idRankFreeModule(mod),c=IDELEMS(mod);
  3056. poly p,h;
  3057. if (r>rows) r = rows;
  3058. if (c>cols) c = cols;
  3059. for(i=0;i<c;i++)
  3060. {
  3061. p=pReverse(mod->m[i]);
  3062. mod->m[i]=NULL;
  3063. while (p!=NULL)
  3064. {
  3065. h=p;
  3066. pIter(p);
  3067. pNext(h)=NULL;
  3068. cp = pGetComp(h);
  3069. if (cp<=r)
  3070. {
  3071. pSetComp(h,0);
  3072. pSetmComp(h);
  3073. MATELEM(result,cp,i+1) = pAdd(MATELEM(result,cp,i+1),h);
  3074. }
  3075. else
  3076. pDelete(&h);
  3077. }
  3078. }
  3079. idDelete(&mod);
  3080. return result;
  3081. }
  3082. /*2
  3083. * substitute the n-th variable by the monomial e in id
  3084. * destroy id
  3085. */
  3086. ideal idSubst(ideal id, int n, poly e)
  3087. {
  3088. int k=MATROWS((matrix)id)*MATCOLS((matrix)id);
  3089. ideal res=(ideal)mpNew(MATROWS((matrix)id),MATCOLS((matrix)id));
  3090. res->rank = id->rank;
  3091. for(k--;k>=0;k--)
  3092. {
  3093. res->m[k]=pSubst(id->m[k],n,e);
  3094. id->m[k]=NULL;
  3095. }
  3096. idDelete(&id);
  3097. return res;
  3098. }
  3099. BOOLEAN idHomModule(ideal m, ideal Q, intvec **w)
  3100. {
  3101. if (w!=NULL) *w=NULL;
  3102. if ((Q!=NULL) && (!idHomIdeal(Q,NULL))) return FALSE;
  3103. if (idIs0(m))
  3104. {
  3105. if (w!=NULL) (*w)=new intvec(m->rank);
  3106. return TRUE;
  3107. }
  3108. long cmax=1,order=0,ord,* diff,diffmin=32000;
  3109. int *iscom;
  3110. int i,j;
  3111. poly p=NULL;
  3112. pFDegProc d;
  3113. if (pLexOrder && (currRing->order[0]==ringorder_lp))
  3114. d=p_Totaldegree;
  3115. else
  3116. d=pFDeg;
  3117. int length=IDELEMS(m);
  3118. polyset P=m->m;
  3119. polyset F=(polyset)omAlloc(length*sizeof(poly));
  3120. for (i=length-1;i>=0;i--)
  3121. {
  3122. p=F[i]=P[i];
  3123. cmax=si_max(cmax,(long)pMaxComp(p));
  3124. }
  3125. cmax++;
  3126. diff = (long *)omAlloc0(cmax*sizeof(long));
  3127. if (w!=NULL) *w=new intvec(cmax-1);
  3128. iscom = (int *)omAlloc0(cmax*sizeof(int));
  3129. i=0;
  3130. while (i<=length)
  3131. {
  3132. if (i<length)
  3133. {
  3134. p=F[i];
  3135. while ((p!=NULL) && (iscom[pGetComp(p)]==0)) pIter(p);
  3136. }
  3137. if ((p==NULL) && (i<length))
  3138. {
  3139. i++;
  3140. }
  3141. else
  3142. {
  3143. if (p==NULL) /* && (i==length) */
  3144. {
  3145. i=0;
  3146. while ((i<length) && (F[i]==NULL)) i++;
  3147. if (i>=length) break;
  3148. p = F[i];
  3149. }
  3150. //if (pLexOrder && (currRing->order[0]==ringorder_lp))
  3151. // order=pTotaldegree(p);
  3152. //else
  3153. // order = p->order;
  3154. // order = pFDeg(p,currRing);
  3155. order = d(p,currRing) +diff[pGetComp(p)];
  3156. //order += diff[pGetComp(p)];
  3157. p = F[i];
  3158. //Print("Actual p=F[%d]: ",i);pWrite(p);
  3159. F[i] = NULL;
  3160. i=0;
  3161. }
  3162. while (p!=NULL)
  3163. {
  3164. if (pLexOrder && (currRing->order[0]==ringorder_lp))
  3165. ord=pTotaldegree(p);
  3166. else
  3167. // ord = p->order;
  3168. ord = pFDeg(p,currRing);
  3169. if (iscom[pGetComp(p)]==0)
  3170. {
  3171. diff[pGetComp(p)] = order-ord;
  3172. iscom[pGetComp(p)] = 1;
  3173. /*
  3174. *PrintS("new diff: ");
  3175. *for (j=0;j<cmax;j++) Print("%d ",diff[j]);
  3176. *PrintLn();
  3177. *PrintS("new iscom: ");
  3178. *for (j=0;j<cmax;j++) Print("%d ",iscom[j]);
  3179. *PrintLn();
  3180. *Print("new set %d, order %d, ord %d, diff %d\n",pGetComp(p),order,ord,diff[pGetComp(p)]);
  3181. */
  3182. }
  3183. else
  3184. {
  3185. /*
  3186. *PrintS("new diff: ");
  3187. *for (j=0;j<cmax;j++) Print("%d ",diff[j]);
  3188. *PrintLn();
  3189. *Print("order %d, ord %d, diff %d\n",order,ord,diff[pGetComp(p)]);
  3190. */
  3191. if (order != (ord+diff[pGetComp(p)]))
  3192. {
  3193. omFreeSize((ADDRESS) iscom,cmax*sizeof(int));
  3194. omFreeSize((ADDRESS) diff,cmax*sizeof(long));
  3195. omFreeSize((ADDRESS) F,length*sizeof(poly));
  3196. delete *w;*w=NULL;
  3197. return FALSE;
  3198. }
  3199. }
  3200. pIter(p);
  3201. }
  3202. }
  3203. omFreeSize((ADDRESS) iscom,cmax*sizeof(int));
  3204. omFreeSize((ADDRESS) F,length*sizeof(poly));
  3205. for (i=1;i<cmax;i++) (**w)[i-1]=(int)(diff[i]);
  3206. for (i=1;i<cmax;i++)
  3207. {
  3208. if (diff[i]<diffmin) diffmin=diff[i];
  3209. }
  3210. if (w!=NULL)
  3211. {
  3212. for (i=1;i<cmax;i++)
  3213. {
  3214. (**w)[i-1]=(int)(diff[i]-diffmin);
  3215. }
  3216. }
  3217. omFreeSize((ADDRESS) diff,cmax*sizeof(long));
  3218. return TRUE;
  3219. }
  3220. BOOLEAN idTestHomModule(ideal m, ideal Q, intvec *w)
  3221. {
  3222. if ((Q!=NULL) && (!idHomIdeal(Q,NULL))) { PrintS(" Q not hom\n"); return FALSE;}
  3223. if (idIs0(m)) return TRUE;
  3224. int cmax=-1;
  3225. int i;
  3226. poly p=NULL;
  3227. int length=IDELEMS(m);
  3228. polyset P=m->m;
  3229. for (i=length-1;i>=0;i--)
  3230. {
  3231. p=P[i];
  3232. if (p!=NULL) cmax=si_max(cmax,(int)pMaxComp(p)+1);
  3233. }
  3234. if (w != NULL)
  3235. if (w->length()+1 < cmax)
  3236. {
  3237. // Print("length: %d - %d \n", w->length(),cmax);
  3238. return FALSE;
  3239. }
  3240. if(w!=NULL)
  3241. pSetModDeg(w);
  3242. for (i=length-1;i>=0;i--)
  3243. {
  3244. p=P[i];
  3245. poly q=p;
  3246. if (p!=NULL)
  3247. {
  3248. int d=pFDeg(p,currRing);
  3249. loop
  3250. {
  3251. pIter(p);
  3252. if (p==NULL) break;
  3253. if (d!=pFDeg(p,currRing))
  3254. {
  3255. //pWrite(q); wrp(p); Print(" -> %d - %d\n",d,pFDeg(p,currRing));
  3256. if(w!=NULL)
  3257. pSetModDeg(NULL);
  3258. return FALSE;
  3259. }
  3260. }
  3261. }
  3262. }
  3263. if(w!=NULL)
  3264. pSetModDeg(NULL);
  3265. return TRUE;
  3266. }
  3267. ideal idJet(ideal i,int d)
  3268. {
  3269. ideal r=idInit((i->nrows)*(i->ncols),i->rank);
  3270. r->nrows = i-> nrows;
  3271. r->ncols = i-> ncols;
  3272. //r->rank = i-> rank;
  3273. int k;
  3274. for(k=(i->nrows)*(i->ncols)-1;k>=0; k--)
  3275. {
  3276. r->m[k]=ppJet(i->m[k],d);
  3277. }
  3278. return r;
  3279. }
  3280. ideal idJetW(ideal i,int d, intvec * iv)
  3281. {
  3282. ideal r=idInit(IDELEMS(i),i->rank);
  3283. if (ecartWeights!=NULL)
  3284. {
  3285. WerrorS("cannot compute weighted jets now");
  3286. }
  3287. else
  3288. {
  3289. short *w=iv2array(iv);
  3290. int k;
  3291. for(k=0; k<IDELEMS(i); k++)
  3292. {
  3293. r->m[k]=ppJetW(i->m[k],d,w);
  3294. }
  3295. omFreeSize((ADDRESS)w,(pVariables+1)*sizeof(short));
  3296. }
  3297. return r;
  3298. }
  3299. int idMinDegW(ideal M,intvec *w)
  3300. {
  3301. int d=-1;
  3302. for(int i=0;i<IDELEMS(M);i++)
  3303. {
  3304. int d0=pMinDeg(M->m[i],w);
  3305. if(-1<d0&&(d0<d||d==-1))
  3306. d=d0;
  3307. }
  3308. return d;
  3309. }
  3310. ideal idSeries(int n,ideal M,matrix U,intvec *w)
  3311. {
  3312. for(int i=IDELEMS(M)-1;i>=0;i--)
  3313. {
  3314. if(U==NULL)
  3315. M->m[i]=pSeries(n,M->m[i],NULL,w);
  3316. else
  3317. {
  3318. M->m[i]=pSeries(n,M->m[i],MATELEM(U,i+1,i+1),w);
  3319. MATELEM(U,i+1,i+1)=NULL;
  3320. }
  3321. }
  3322. if(U!=NULL)
  3323. idDelete((ideal*)&U);
  3324. return M;
  3325. }
  3326. matrix idDiff(matrix i, int k)
  3327. {
  3328. int e=MATCOLS(i)*MATROWS(i);
  3329. matrix r=mpNew(MATROWS(i),MATCOLS(i));
  3330. r->rank=i->rank;
  3331. int j;
  3332. for(j=0; j<e; j++)
  3333. {
  3334. r->m[j]=pDiff(i->m[j],k);
  3335. }
  3336. return r;
  3337. }
  3338. matrix idDiffOp(ideal I, ideal J,BOOLEAN multiply)
  3339. {
  3340. matrix r=mpNew(IDELEMS(I),IDELEMS(J));
  3341. int i,j;
  3342. for(i=0; i<IDELEMS(I); i++)
  3343. {
  3344. for(j=0; j<IDELEMS(J); j++)
  3345. {
  3346. MATELEM(r,i+1,j+1)=pDiffOp(I->m[i],J->m[j],multiply);
  3347. }
  3348. }
  3349. return r;
  3350. }
  3351. /*3
  3352. *handles for some ideal operations the ring/syzcomp managment
  3353. *returns all syzygies (componentwise-)shifted by -syzcomp
  3354. *or -syzcomp-1 (in case of ideals as input)
  3355. static ideal idHandleIdealOp(ideal arg,int syzcomp,int isIdeal=FALSE)
  3356. {
  3357. ring orig_ring=currRing;
  3358. ring syz_ring=rCurrRingAssure_SyzComp();
  3359. rSetSyzComp(length);
  3360. ideal s_temp;
  3361. if (orig_ring!=syz_ring)
  3362. s_temp=idrMoveR_NoSort(arg,orig_ring);
  3363. else
  3364. s_temp=arg;
  3365. ideal s_temp1 = kStd(s_temp,currQuotient,testHomog,&w,NULL,length);
  3366. if (w!=NULL) delete w;
  3367. if (syz_ring!=orig_ring)
  3368. {
  3369. idDelete(&s_temp);
  3370. rChangeCurrRing(orig_ring);
  3371. }
  3372. idDelete(&temp);
  3373. ideal temp1=idRingCopy(s_temp1,syz_ring);
  3374. if (syz_ring!=orig_ring)
  3375. {
  3376. rChangeCurrRing(syz_ring);
  3377. idDelete(&s_temp1);
  3378. rChangeCurrRing(orig_ring);
  3379. rKill(syz_ring);
  3380. }
  3381. for (i=0;i<IDELEMS(temp1);i++)
  3382. {
  3383. if ((temp1->m[i]!=NULL)
  3384. && (pGetComp(temp1->m[i])<=length))
  3385. {
  3386. pDelete(&(temp1->m[i]));
  3387. }
  3388. else
  3389. {
  3390. pShift(&(temp1->m[i]),-length);
  3391. }
  3392. }
  3393. temp1->rank = rk;
  3394. idSkipZeroes(temp1);
  3395. return temp1;
  3396. }
  3397. */
  3398. /*2
  3399. * represents (h1+h2)/h2=h1/(h1 intersect h2)
  3400. */
  3401. //ideal idModulo (ideal h2,ideal h1)
  3402. ideal idModulo (ideal h2,ideal h1, tHomog hom, intvec ** w)
  3403. {
  3404. intvec *wtmp=NULL;
  3405. int i,j,k,rk,flength=0,slength,length;
  3406. poly p,q;
  3407. if (idIs0(h2))
  3408. return idFreeModule(si_max(1,h2->ncols));
  3409. if (!idIs0(h1))
  3410. flength = idRankFreeModule(h1);
  3411. slength = idRankFreeModule(h2);
  3412. length = si_max(flength,slength);
  3413. if (length==0)
  3414. {
  3415. length = 1;
  3416. }
  3417. ideal temp = idInit(IDELEMS(h2),length+IDELEMS(h2));
  3418. if ((w!=NULL)&&((*w)!=NULL))
  3419. {
  3420. //Print("input weights:");(*w)->show(1);PrintLn();
  3421. int d;
  3422. int k;
  3423. wtmp=new intvec(length+IDELEMS(h2));
  3424. for (i=0;i<length;i++)
  3425. ((*wtmp)[i])=(**w)[i];
  3426. for (i=0;i<IDELEMS(h2);i++)
  3427. {
  3428. poly p=h2->m[i];
  3429. if (p!=NULL)
  3430. {
  3431. d = pDeg(p);
  3432. k= pGetComp(p);
  3433. if (slength>0) k--;
  3434. d +=((**w)[k]);
  3435. ((*wtmp)[i+length]) = d;
  3436. }
  3437. }
  3438. //Print("weights:");wtmp->show(1);PrintLn();
  3439. }
  3440. for (i=0;i<IDELEMS(h2);i++)
  3441. {
  3442. temp->m[i] = pCopy(h2->m[i]);
  3443. q = pOne();
  3444. pSetComp(q,i+1+length);
  3445. pSetmComp(q);
  3446. if(temp->m[i]!=NULL)
  3447. {
  3448. if (slength==0) pShift(&(temp->m[i]),1);
  3449. p = temp->m[i];
  3450. while (pNext(p)!=NULL) pIter(p);
  3451. pNext(p) = q;
  3452. }
  3453. else
  3454. temp->m[i]=q;
  3455. }
  3456. rk = k = IDELEMS(h2);
  3457. if (!idIs0(h1))
  3458. {
  3459. pEnlargeSet(&(temp->m),IDELEMS(temp),IDELEMS(h1));
  3460. IDELEMS(temp) += IDELEMS(h1);
  3461. for (i=0;i<IDELEMS(h1);i++)
  3462. {
  3463. if (h1->m[i]!=NULL)
  3464. {
  3465. temp->m[k] = pCopy(h1->m[i]);
  3466. if (flength==0) pShift(&(temp->m[k]),1);
  3467. k++;
  3468. }
  3469. }
  3470. }
  3471. ring orig_ring=currRing;
  3472. ring syz_ring=rCurrRingAssure_SyzComp();
  3473. rSetSyzComp(length);
  3474. ideal s_temp;
  3475. if (syz_ring != orig_ring)
  3476. {
  3477. s_temp = idrMoveR_NoSort(temp, orig_ring);
  3478. }
  3479. else
  3480. {
  3481. s_temp = temp;
  3482. }
  3483. idTest(s_temp);
  3484. ideal s_temp1 = kStd(s_temp,currQuotient,hom,&wtmp,NULL,length);
  3485. //if (wtmp!=NULL) Print("output weights:");wtmp->show(1);PrintLn();
  3486. if ((w!=NULL) && (*w !=NULL) && (wtmp!=NULL))
  3487. {
  3488. delete *w;
  3489. *w=new intvec(IDELEMS(h2));
  3490. for (i=0;i<IDELEMS(h2);i++)
  3491. ((**w)[i])=(*wtmp)[i+length];
  3492. }
  3493. if (wtmp!=NULL) delete wtmp;
  3494. for (i=0;i<IDELEMS(s_temp1);i++)
  3495. {
  3496. if ((s_temp1->m[i]!=NULL)
  3497. && (pGetComp(s_temp1->m[i])<=length))
  3498. {
  3499. pDelete(&(s_temp1->m[i]));
  3500. }
  3501. else
  3502. {
  3503. pShift(&(s_temp1->m[i]),-length);
  3504. }
  3505. }
  3506. s_temp1->rank = rk;
  3507. idSkipZeroes(s_temp1);
  3508. if (syz_ring!=orig_ring)
  3509. {
  3510. rChangeCurrRing(orig_ring);
  3511. s_temp1 = idrMoveR_NoSort(s_temp1, syz_ring);
  3512. rKill(syz_ring);
  3513. // Hmm ... here seems to be a memory leak
  3514. // However, simply deleting it causes memory trouble
  3515. // idDelete(&s_temp);
  3516. }
  3517. else
  3518. {
  3519. idDelete(&temp);
  3520. }
  3521. idTest(s_temp1);
  3522. return s_temp1;
  3523. }
  3524. int idElem(const ideal F)
  3525. {
  3526. int i=0,j=IDELEMS(F)-1;
  3527. while(j>=0)
  3528. {
  3529. if ((F->m)[j]!=NULL) i++;
  3530. j--;
  3531. }
  3532. return i;
  3533. }
  3534. /*
  3535. *computes module-weights for liftings of homogeneous modules
  3536. */
  3537. intvec * idMWLift(ideal mod,intvec * weights)
  3538. {
  3539. if (idIs0(mod)) return new intvec(2);
  3540. int i=IDELEMS(mod);
  3541. while ((i>0) && (mod->m[i-1]==NULL)) i--;
  3542. intvec *result = new intvec(i+1);
  3543. while (i>0)
  3544. {
  3545. (*result)[i]=pFDeg(mod->m[i],currRing)+(*weights)[pGetComp(mod->m[i])];
  3546. }
  3547. return result;
  3548. }
  3549. /*2
  3550. *sorts the kbase for idCoef* in a special way (lexicographically
  3551. *with x_max,...,x_1)
  3552. */
  3553. ideal idCreateSpecialKbase(ideal kBase,intvec ** convert)
  3554. {
  3555. int i;
  3556. ideal result;
  3557. if (idIs0(kBase)) return NULL;
  3558. result = idInit(IDELEMS(kBase),kBase->rank);
  3559. *convert = idSort(kBase,FALSE);
  3560. for (i=0;i<(*convert)->length();i++)
  3561. {
  3562. result->m[i] = pCopy(kBase->m[(**convert)[i]-1]);
  3563. }
  3564. return result;
  3565. }
  3566. /*2
  3567. *returns the index of a given monom in the list of the special kbase
  3568. */
  3569. int idIndexOfKBase(poly monom, ideal kbase)
  3570. {
  3571. int j=IDELEMS(kbase);
  3572. while ((j>0) && (kbase->m[j-1]==NULL)) j--;
  3573. if (j==0) return -1;
  3574. int i=pVariables;
  3575. while (i>0)
  3576. {
  3577. loop
  3578. {
  3579. if (pGetExp(monom,i)>pGetExp(kbase->m[j-1],i)) return -1;
  3580. if (pGetExp(monom,i)==pGetExp(kbase->m[j-1],i)) break;
  3581. j--;
  3582. if (j==0) return -1;
  3583. }
  3584. if (i==1)
  3585. {
  3586. while(j>0)
  3587. {
  3588. if (pGetComp(monom)==pGetComp(kbase->m[j-1])) return j-1;
  3589. if (pGetComp(monom)>pGetComp(kbase->m[j-1])) return -1;
  3590. j--;
  3591. }
  3592. }
  3593. i--;
  3594. }
  3595. return -1;
  3596. }
  3597. /*2
  3598. *decomposes the monom in a part of coefficients described by the
  3599. *complement of how and a monom in variables occuring in how, the
  3600. *index of which in kbase is returned as integer pos (-1 if it don't
  3601. *exists)
  3602. */
  3603. poly idDecompose(poly monom, poly how, ideal kbase, int * pos)
  3604. {
  3605. int i;
  3606. poly coeff=pOne(), base=pOne();
  3607. for (i=1;i<=pVariables;i++)
  3608. {
  3609. if (pGetExp(how,i)>0)
  3610. {
  3611. pSetExp(base,i,pGetExp(monom,i));
  3612. }
  3613. else
  3614. {
  3615. pSetExp(coeff,i,pGetExp(monom,i));
  3616. }
  3617. }
  3618. pSetComp(base,pGetComp(monom));
  3619. pSetm(base);
  3620. pSetCoeff(coeff,nCopy(pGetCoeff(monom)));
  3621. pSetm(coeff);
  3622. *pos = idIndexOfKBase(base,kbase);
  3623. if (*pos<0)
  3624. pDelete(&coeff);
  3625. pDelete(&base);
  3626. return coeff;
  3627. }
  3628. /*2
  3629. *returns a matrix A of coefficients with kbase*A=arg
  3630. *if all monomials in variables of how occur in kbase
  3631. *the other are deleted
  3632. */
  3633. matrix idCoeffOfKBase(ideal arg, ideal kbase, poly how)
  3634. {
  3635. matrix result;
  3636. ideal tempKbase;
  3637. poly p,q;
  3638. intvec * convert;
  3639. int i=IDELEMS(kbase),j=IDELEMS(arg),k,pos;
  3640. #if 0
  3641. while ((i>0) && (kbase->m[i-1]==NULL)) i--;
  3642. if (idIs0(arg))
  3643. return mpNew(i,1);
  3644. while ((j>0) && (arg->m[j-1]==NULL)) j--;
  3645. result = mpNew(i,j);
  3646. #else
  3647. result = mpNew(i, j);
  3648. while ((j>0) && (arg->m[j-1]==NULL)) j--;
  3649. #endif
  3650. tempKbase = idCreateSpecialKbase(kbase,&convert);
  3651. for (k=0;k<j;k++)
  3652. {
  3653. p = arg->m[k];
  3654. while (p!=NULL)
  3655. {
  3656. q = idDecompose(p,how,tempKbase,&pos);
  3657. if (pos>=0)
  3658. {
  3659. MATELEM(result,(*convert)[pos],k+1) =
  3660. pAdd(MATELEM(result,(*convert)[pos],k+1),q);
  3661. }
  3662. else
  3663. pDelete(&q);
  3664. pIter(p);
  3665. }
  3666. }
  3667. idDelete(&tempKbase);
  3668. return result;
  3669. }
  3670. /*3
  3671. * searches for the next unit in the components of the module arg and
  3672. * returns the first one;
  3673. */
  3674. static int idReadOutPivot(ideal arg,int* comp)
  3675. {
  3676. if (idIs0(arg)) return -1;
  3677. int i=0,j, generator=-1;
  3678. int rk_arg=arg->rank; //idRankFreeModule(arg);
  3679. int * componentIsUsed =(int *)omAlloc((rk_arg+1)*sizeof(int));
  3680. poly p;
  3681. while ((generator<0) && (i<IDELEMS(arg)))
  3682. {
  3683. memset(componentIsUsed,0,(rk_arg+1)*sizeof(int));
  3684. p = arg->m[i];
  3685. while (p!=NULL)
  3686. {
  3687. j = pGetComp(p);
  3688. if (componentIsUsed[j]==0)
  3689. {
  3690. #ifdef HAVE_RINGS
  3691. if (pLmIsConstantComp(p) &&
  3692. (!rField_is_Ring(currRing) || nIsUnit(pGetCoeff(p))))
  3693. {
  3694. #else
  3695. if (pLmIsConstantComp(p))
  3696. {
  3697. #endif
  3698. generator = i;
  3699. componentIsUsed[j] = 1;
  3700. }
  3701. else
  3702. {
  3703. componentIsUsed[j] = -1;
  3704. }
  3705. }
  3706. else if (componentIsUsed[j]>0)
  3707. {
  3708. (componentIsUsed[j])++;
  3709. }
  3710. pIter(p);
  3711. }
  3712. i++;
  3713. }
  3714. i = 0;
  3715. *comp = -1;
  3716. for (j=0;j<=rk_arg;j++)
  3717. {
  3718. if (componentIsUsed[j]>0)
  3719. {
  3720. if ((*comp==-1) || (componentIsUsed[j]<i))
  3721. {
  3722. *comp = j;
  3723. i= componentIsUsed[j];
  3724. }
  3725. }
  3726. }
  3727. omFree(componentIsUsed);
  3728. return generator;
  3729. }
  3730. #if 0
  3731. static void idDeleteComp(ideal arg,int red_comp)
  3732. {
  3733. int i,j;
  3734. poly p;
  3735. for (i=IDELEMS(arg)-1;i>=0;i--)
  3736. {
  3737. p = arg->m[i];
  3738. while (p!=NULL)
  3739. {
  3740. j = pGetComp(p);
  3741. if (j>red_comp)
  3742. {
  3743. pSetComp(p,j-1);
  3744. pSetm(p);
  3745. }
  3746. pIter(p);
  3747. }
  3748. }
  3749. (arg->rank)--;
  3750. }
  3751. #endif
  3752. static void idDeleteComps(ideal arg,int* red_comp,int del)
  3753. // red_comp is an array [0..args->rank]
  3754. {
  3755. int i,j;
  3756. poly p;
  3757. for (i=IDELEMS(arg)-1;i>=0;i--)
  3758. {
  3759. p = arg->m[i];
  3760. while (p!=NULL)
  3761. {
  3762. j = pGetComp(p);
  3763. if (red_comp[j]!=j)
  3764. {
  3765. pSetComp(p,red_comp[j]);
  3766. pSetmComp(p);
  3767. }
  3768. pIter(p);
  3769. }
  3770. }
  3771. (arg->rank) -= del;
  3772. }
  3773. /*2
  3774. * returns the presentation of an isomorphic, minimally
  3775. * embedded module (arg represents the quotient!)
  3776. */
  3777. ideal idMinEmbedding(ideal arg,BOOLEAN inPlace, intvec **w)
  3778. {
  3779. if (idIs0(arg)) return idInit(1,arg->rank);
  3780. int i,next_gen,next_comp;
  3781. ideal res=arg;
  3782. if (!inPlace) res = idCopy(arg);
  3783. res->rank=si_max(res->rank,idRankFreeModule(res));
  3784. int *red_comp=(int*)omAlloc((res->rank+1)*sizeof(int));
  3785. for (i=res->rank;i>=0;i--) red_comp[i]=i;
  3786. int del=0;
  3787. loop
  3788. {
  3789. next_gen = idReadOutPivot(res,&next_comp);
  3790. if (next_gen<0) break;
  3791. del++;
  3792. syGaussForOne(res,next_gen,next_comp,0,IDELEMS(res));
  3793. for(i=next_comp+1;i<=arg->rank;i++) red_comp[i]--;
  3794. if ((w !=NULL)&&(*w!=NULL))
  3795. {
  3796. for(i=next_comp;i<(*w)->length();i++) (**w)[i-1]=(**w)[i];
  3797. }
  3798. }
  3799. idDeleteComps(res,red_comp,del);
  3800. idSkipZeroes(res);
  3801. omFree(red_comp);
  3802. if ((w !=NULL)&&(*w!=NULL) &&(del>0))
  3803. {
  3804. intvec *wtmp=new intvec((*w)->length()-del);
  3805. for(i=0;i<res->rank;i++) (*wtmp)[i]=(**w)[i];
  3806. delete *w;
  3807. *w=wtmp;
  3808. }
  3809. return res;
  3810. }
  3811. /*2
  3812. * transpose a module
  3813. */
  3814. ideal idTransp(ideal a)
  3815. {
  3816. int r = a->rank, c = IDELEMS(a);
  3817. ideal b = idInit(r,c);
  3818. for (int i=c; i>0; i--)
  3819. {
  3820. poly p=a->m[i-1];
  3821. while(p!=NULL)
  3822. {
  3823. poly h=pHead(p);
  3824. int co=pGetComp(h)-1;
  3825. pSetComp(h,i);
  3826. pSetmComp(h);
  3827. b->m[co]=pAdd(b->m[co],h);
  3828. pIter(p);
  3829. }
  3830. }
  3831. return b;
  3832. }
  3833. intvec * idQHomWeight(ideal id)
  3834. {
  3835. poly head, tail;
  3836. int k;
  3837. int in=IDELEMS(id)-1, ready=0, all=0,
  3838. coldim=pVariables, rowmax=2*coldim;
  3839. if (in<0) return NULL;
  3840. intvec *imat=new intvec(rowmax+1,coldim,0);
  3841. do
  3842. {
  3843. head = id->m[in--];
  3844. if (head!=NULL)
  3845. {
  3846. tail = pNext(head);
  3847. while (tail!=NULL)
  3848. {
  3849. all++;
  3850. for (k=1;k<=coldim;k++)
  3851. IMATELEM(*imat,all,k) = pGetExpDiff(head,tail,k);
  3852. if (all==rowmax)
  3853. {
  3854. ivTriangIntern(imat, ready, all);
  3855. if (ready==coldim)
  3856. {
  3857. delete imat;
  3858. return NULL;
  3859. }
  3860. }
  3861. pIter(tail);
  3862. }
  3863. }
  3864. } while (in>=0);
  3865. if (all>ready)
  3866. {
  3867. ivTriangIntern(imat, ready, all);
  3868. if (ready==coldim)
  3869. {
  3870. delete imat;
  3871. return NULL;
  3872. }
  3873. }
  3874. intvec *result = ivSolveKern(imat, ready);
  3875. delete imat;
  3876. return result;
  3877. }
  3878. BOOLEAN idIsZeroDim(ideal I)
  3879. {
  3880. BOOLEAN *UsedAxis=(BOOLEAN *)omAlloc0(pVariables*sizeof(BOOLEAN));
  3881. int i,n;
  3882. poly po;
  3883. BOOLEAN res=TRUE;
  3884. for(i=IDELEMS(I)-1;i>=0;i--)
  3885. {
  3886. po=I->m[i];
  3887. if ((po!=NULL) &&((n=pIsPurePower(po))!=0)) UsedAxis[n-1]=TRUE;
  3888. }
  3889. for(i=pVariables-1;i>=0;i--)
  3890. {
  3891. if(UsedAxis[i]==FALSE) {res=FALSE; break;} // not zero-dim.
  3892. }
  3893. omFreeSize(UsedAxis,pVariables*sizeof(BOOLEAN));
  3894. return res;
  3895. }
  3896. void idNormalize(ideal I)
  3897. {
  3898. if (rField_has_simple_inverse()) return; /* Z/p, GF(p,n), R, long R/C */
  3899. int i;
  3900. for(i=IDELEMS(I)-1;i>=0;i--)
  3901. {
  3902. pNormalize(I->m[i]);
  3903. }
  3904. }
  3905. #include <kernel/clapsing.h>
  3906. #ifdef HAVE_FACTORY
  3907. poly id_GCD(poly f, poly g, const ring r)
  3908. {
  3909. ring save_r=currRing;
  3910. rChangeCurrRing(r);
  3911. ideal I=idInit(2,1); I->m[0]=f; I->m[1]=g;
  3912. intvec *w = NULL;
  3913. ideal S=idSyzygies(I,testHomog,&w);
  3914. if (w!=NULL) delete w;
  3915. poly gg=pTakeOutComp(&(S->m[0]),2);
  3916. idDelete(&S);
  3917. poly gcd_p=singclap_pdivide(f,gg);
  3918. pDelete(&gg);
  3919. rChangeCurrRing(save_r);
  3920. return gcd_p;
  3921. }
  3922. #endif
  3923. /*2
  3924. * xx,q: arrays of length 0..rl-1
  3925. * xx[i]: SB mod q[i]
  3926. * assume: char=0
  3927. * assume: q[i]!=0
  3928. * destroys xx
  3929. */
  3930. #ifdef HAVE_FACTORY
  3931. ideal idChineseRemainder(ideal *xx, number *q, int rl)
  3932. {
  3933. int cnt=IDELEMS(xx[0])*xx[0]->nrows;
  3934. ideal result=idInit(cnt,xx[0]->rank);
  3935. result->nrows=xx[0]->nrows; // for lifting matrices
  3936. result->ncols=xx[0]->ncols; // for lifting matrices
  3937. int i,j;
  3938. poly r,h,hh,res_p;
  3939. number *x=(number *)omAlloc(rl*sizeof(number));
  3940. for(i=cnt-1;i>=0;i--)
  3941. {
  3942. res_p=NULL;
  3943. loop
  3944. {
  3945. r=NULL;
  3946. for(j=rl-1;j>=0;j--)
  3947. {
  3948. h=xx[j]->m[i];
  3949. if ((h!=NULL)
  3950. &&((r==NULL)||(pLmCmp(r,h)==-1)))
  3951. r=h;
  3952. }
  3953. if (r==NULL) break;
  3954. h=pHead(r);
  3955. for(j=rl-1;j>=0;j--)
  3956. {
  3957. hh=xx[j]->m[i];
  3958. if ((hh!=NULL) && (pLmCmp(r,hh)==0))
  3959. {
  3960. x[j]=pGetCoeff(hh);
  3961. hh=pLmFreeAndNext(hh);
  3962. xx[j]->m[i]=hh;
  3963. }
  3964. else
  3965. x[j]=nlInit(0, currRing);
  3966. }
  3967. number n=nlChineseRemainder(x,q,rl);
  3968. for(j=rl-1;j>=0;j--)
  3969. {
  3970. x[j]=NULL; // nlInit(0...) takes no memory
  3971. }
  3972. if (nlIsZero(n)) pDelete(&h);
  3973. else
  3974. {
  3975. pSetCoeff(h,n);
  3976. //Print("new mon:");pWrite(h);
  3977. res_p=pAdd(res_p,h);
  3978. }
  3979. }
  3980. result->m[i]=res_p;
  3981. }
  3982. omFree(x);
  3983. for(i=rl-1;i>=0;i--) idDelete(&(xx[i]));
  3984. omFree(xx);
  3985. return result;
  3986. }
  3987. #endif
  3988. /* currently unsed:
  3989. ideal idChineseRemainder(ideal *xx, intvec *iv)
  3990. {
  3991. int rl=iv->length();
  3992. number *q=(number *)omAlloc(rl*sizeof(number));
  3993. int i;
  3994. for(i=0; i<rl; i++)
  3995. {
  3996. q[i]=nInit((*iv)[i]);
  3997. }
  3998. return idChineseRemainder(xx,q,rl);
  3999. }
  4000. */
  4001. /*
  4002. * lift ideal with coeffs over Z (mod N) to Q via Farey
  4003. */
  4004. ideal idFarey(ideal x, number N)
  4005. {
  4006. int cnt=IDELEMS(x)*x->nrows;
  4007. ideal result=idInit(cnt,x->rank);
  4008. result->nrows=x->nrows; // for lifting matrices
  4009. result->ncols=x->ncols; // for lifting matrices
  4010. int i;
  4011. for(i=cnt-1;i>=0;i--)
  4012. {
  4013. poly h=pCopy(x->m[i]);
  4014. result->m[i]=h;
  4015. while(h!=NULL)
  4016. {
  4017. number c=pGetCoeff(h);
  4018. pSetCoeff0(h,nlFarey(c,N));
  4019. nDelete(&c);
  4020. pIter(h);
  4021. }
  4022. while((result->m[i]!=NULL)&&(nIsZero(pGetCoeff(result->m[i]))))
  4023. {
  4024. pLmDelete(&(result->m[i]));
  4025. }
  4026. h=result->m[i];
  4027. while((h!=NULL) && (pNext(h)!=NULL))
  4028. {
  4029. if(nIsZero(pGetCoeff(pNext(h))))
  4030. {
  4031. pLmDelete(&pNext(h));
  4032. }
  4033. else pIter(h);
  4034. }
  4035. }
  4036. return result;
  4037. }
  4038. /*2
  4039. * transpose a module
  4040. * NOTE: just a version of "ideal idTransp(ideal)" which works within specified ring.
  4041. */
  4042. ideal id_Transp(ideal a, const ring rRing)
  4043. {
  4044. int r = a->rank, c = IDELEMS(a);
  4045. ideal b = idInit(r,c);
  4046. for (int i=c; i>0; i--)
  4047. {
  4048. poly p=a->m[i-1];
  4049. while(p!=NULL)
  4050. {
  4051. poly h=p_Head(p, rRing);
  4052. int co=p_GetComp(h, rRing)-1;
  4053. p_SetComp(h, i, rRing);
  4054. p_Setm(h, rRing);
  4055. b->m[co] = p_Add_q(b->m[co], h, rRing);
  4056. pIter(p);
  4057. }
  4058. }
  4059. return b;
  4060. }
  4061. /*2
  4062. * The following is needed to compute the image of certain map used in
  4063. * the computation of cohomologies via BGG
  4064. * let M = { w_1, ..., w_k }, k = size(M) == ncols(M), n = nvars(currRing).
  4065. * assuming that nrows(M) <= m*n; the procedure computes:
  4066. * transpose(M) * transpose( var(1) I_m | ... | var(n) I_m ) :== transpose(module{f_1, ... f_k}),
  4067. * where f_i = \sum_{j=1}^{m} (w_i, v_j) gen(j), (w_i, v_j) is a `scalar` multiplication.
  4068. * that is, if w_i = (a^1_1, ... a^1_m) | (a^2_1, ..., a^2_m) | ... | (a^n_1, ..., a^n_m) then
  4069. (a^1_1, ... a^1_m) | (a^2_1, ..., a^2_m) | ... | (a^n_1, ..., a^n_m)
  4070. * var_1 ... var_1 | var_2 ... var_2 | ... | var_n ... var(n)
  4071. * gen_1 ... gen_m | gen_1 ... gen_m | ... | gen_1 ... gen_m
  4072. + =>
  4073. f_i =
  4074. a^1_1 * var(1) * gen(1) + ... + a^1_m * var(1) * gen(m) +
  4075. a^2_1 * var(2) * gen(1) + ... + a^2_m * var(2) * gen(m) +
  4076. ...
  4077. a^n_1 * var(n) * gen(1) + ... + a^n_m * var(n) * gen(m);
  4078. NOTE: for every f_i we run only ONCE along w_i saving partial sums into a temporary array of polys of size m
  4079. */
  4080. ideal id_TensorModuleMult(const int m, const ideal M, const ring rRing)
  4081. {
  4082. // #ifdef DEBU
  4083. // WarnS("tensorModuleMult!!!!");
  4084. assume(m > 0);
  4085. assume(M != NULL);
  4086. const int n = rRing->N;
  4087. assume(M->rank <= m * n);
  4088. const int k = IDELEMS(M);
  4089. ideal idTemp = idInit(k,m); // = {f_1, ..., f_k }
  4090. for( int i = 0; i < k; i++ ) // for every w \in M
  4091. {
  4092. poly pTempSum = NULL;
  4093. poly w = M->m[i];
  4094. while(w != NULL) // for each term of w...
  4095. {
  4096. poly h = p_Head(w, rRing);
  4097. const int gen = p_GetComp(h, rRing); // 1 ...
  4098. assume(gen > 0);
  4099. assume(gen <= n*m);
  4100. // TODO: write a formula with %, / instead of while!
  4101. /*
  4102. int c = gen;
  4103. int v = 1;
  4104. while(c > m)
  4105. {
  4106. c -= m;
  4107. v++;
  4108. }
  4109. */
  4110. int cc = gen % m;
  4111. if( cc == 0) cc = m;
  4112. int vv = 1 + (gen - cc) / m;
  4113. // assume( cc == c );
  4114. // assume( vv == v );
  4115. // 1<= c <= m
  4116. assume( cc > 0 );
  4117. assume( cc <= m );
  4118. assume( vv > 0 );
  4119. assume( vv <= n );
  4120. assume( (cc + (vv-1)*m) == gen );
  4121. p_IncrExp(h, vv, rRing); // h *= var(j) && // p_AddExp(h, vv, 1, rRing);
  4122. p_SetComp(h, cc, rRing);
  4123. p_Setm(h, rRing); // addjust degree after the previous steps!
  4124. pTempSum = p_Add_q(pTempSum, h, rRing); // it is slow since h will be usually put to the back of pTempSum!!!
  4125. pIter(w);
  4126. }
  4127. idTemp->m[i] = pTempSum;
  4128. }
  4129. // simplify idTemp???
  4130. ideal idResult = id_Transp(idTemp, rRing);
  4131. id_Delete(&idTemp, rRing);
  4132. return(idResult);
  4133. }