/**************************************** * Computer Algebra System SINGULAR * ****************************************/ /* * ABSTRACT: resolutions */ #ifdef HAVE_CONFIG_H #include "singularconfig.h" #endif /* HAVE_CONFIG_H */ #include #include #include #include #include #include #include #include //#include "cntrlc.h" #include #include #include #include #include #include #include #include static void syInitSort(ideal arg,intvec **modcomp) { int i,j,k,kk,kkk,jj; idSkipZeroes(arg); polyset F,oldF=arg->m; int Fl=IDELEMS(arg); int rkF=id_RankFreeModule(arg,currRing); int syComponentOrder=currRing->ComponentOrder; while ((Fl!=0) && (oldF[Fl-1]==NULL)) Fl--; if (*modcomp!=NULL) delete modcomp; *modcomp = new intvec(rkF+2); F=(polyset)omAlloc0(IDELEMS(arg)*sizeof(poly)); j=0; for(i=0;i<=rkF;i++) { k=0; jj = j; (**modcomp)[i] = j; while (kkk;kkk--) { F[kkk] = F[kkk-1]; } F[kk] = oldF[k]; //Print("Element %d: ",kk);pWrite(F[kk]); j++; k++; } } } (**modcomp)[rkF+1] = Fl; arg->m = F; omFreeSize((ADDRESS)oldF,IDELEMS(arg)*sizeof(poly)); } static void syCreatePairs(polyset F,int lini,int wend,int k,int j,int i, polyset pairs,int regularPairs=0,ideal mW=NULL) { int l,ii=0,jj; poly p,q; while (((kN);jj++) pSetExp(q,jj,pGetExp(q,jj) -pGetExp(mW->m[pGetComp(q)-1],jj)); pSetm(q); } pLcm(q,currQuotient->m[ii],p); if (mW!=NULL) { for(jj=1;jj<=(currRing->N);jj++) pSetExp(p,jj,pGetExp(p,jj) +pGetExp(mW->m[pGetComp(p)-1],jj)); pSetm(p); } pDelete(&q); k = regularPairs+ii; ii++; } l=lini; while ((lm[Fl-1]==NULL)) Fl--; ideal result=idInit(16,arg->rank+Fl); polyset F=arg->m,*Shdl=&(result->m); if (Fl==0) return result; int i,j,l,k,totalToRed,ecartToRed,kk; int bestEcart,totalmax,rkF,Sl=0,smax,tmax,tl; int *ecartS, *ecartT, *totalS, *totalT=NULL, *temp=NULL; polyset pairs,S,T,ST/*,oldF*/; poly p,q,toRed; BOOLEAN notFound = FALSE; intvec * newmodcomp = new intvec(Fl+2); intvec * tempcomp; //Print("Naechster Modul\n"); //idPrint(arg); /*-------------initializing the sets--------------------*/ ST=(polyset)omAlloc0(Fl*sizeof(poly)); S=(polyset)omAlloc0(Fl*sizeof(poly)); ecartS=(int*)omAlloc(Fl*sizeof(int)); totalS=(int*)omAlloc(Fl*sizeof(int)); T=(polyset)omAlloc0(2*Fl*sizeof(poly)); ecartT=(int*)omAlloc(2*Fl*sizeof(int)); totalT=(int*)omAlloc(2*Fl*sizeof(int)); pairs=(polyset)omAlloc0(Fl*sizeof(poly)); smax = Fl; tmax = 2*Fl; for (j=1;jm[j] != NULL) { assume (arg->m[j-1] != NULL); assume (pGetComp(arg->m[j-1])-pGetComp(arg->m[j])<=0); } } rkF=id_RankFreeModule(arg,currRing); /*----------------construction of the new ordering----------*/ if (rkF>0) rSetSyzComp(rkF, currRing); else rSetSyzComp(1, currRing); /*----------------creating S--------------------------------*/ for(j=0;jtotalmax) totalmax=totalS[k]; for (kk=1;kk<=rkF;kk++) { for (k=0;k<=totalmax;k++) { for (l=0;lComponentOrder; int lini,wend; if (syComponentOrder==1) { lini=k=j+1; wend=Fl; } else { lini=k=0; while ((k=tmax) { pEnlargeSet(&T,tmax,16); tmax += 16; temp = (int*)omAlloc((tmax+16)*sizeof(int)); for(l=0;llength()-1;l>comptR;l--) { if ((*tempcomp)[l]>0) (*tempcomp)[l]++; } l=0; while ((lpGetComp(T[l]))) l++; while ((ll;kk--) { T[kk]=T[kk-1]; totalT[kk]=totalT[kk-1]; ecartT[kk]=ecartT[kk-1]; } q = pCopy(toRed); pNorm(q); T[l] = q; totalT[l] = totalToRed; ecartT[l] = ecartToRed; tl++; } toRed = ksOldSpolyRed(p,toRed); } } //Print("toRed finally (neuer ecart %d): ",ecartToRed);pWrite(toRed); //PrintS("s"); if (pGetComp(toRed)>rkF) { if (Sl>=IDELEMS(result)) { pEnlargeSet(Shdl,IDELEMS(result),16); IDELEMS(result) += 16; } //p_Shift(&toRed,-rkF,currRing); pNorm(toRed); (*Shdl)[Sl] = toRed; Sl++; } /*----------------deleting all polys not from ST--------------*/ for(l=0;l=smax) { pDelete(&T[l]); //Print ("#"); } } delete tempcomp; } } for(k=lini;kN);j++) pSetExp(p,j,pGetExp(p,j) -pGetExp(mW->m[pGetComp(p)-1],j)); } while ((p!=NULL) && (im[i],p)) { //pNorm(toNorm); toNorm = ksOldSpolyRed(currQuotient->m[i],toNorm); pDelete(&p); if (toNorm==NULL) return NULL; p = pHead(toNorm); if (mW!=NULL) { for(j=1;j<=(currRing->N);j++) pSetExp(p,j,pGetExp(p,j) -pGetExp(mW->m[pGetComp(p)-1],j)); } i = 0; } else { i++; } } pDelete(&p); return toNorm; } /*2 * computes the Schreyer syzygies in the global case * input: F * output: Shdl, Smax * modcomp, length stores the start position of the module comp. in arg */ static ideal sySchreyersSyzygiesFB(ideal arg,intvec ** modcomp,ideal mW,BOOLEAN redTail=TRUE) { kBucket_pt sy0buck = kBucketCreate(currRing); int Fl=IDELEMS(arg); while ((Fl!=0) && (arg->m[Fl-1]==NULL)) Fl--; ideal result=idInit(16,Fl); int i,j,l,k,kkk,/*rkF,*/Sl=0,syComponentOrder=currRing->ComponentOrder; int /*fstart,*/wend,lini,ltR,gencQ=0; intvec *newmodcomp; int *Flength; polyset pairs,F=arg->m,*Shdl=&(result->m); poly /*p,*/q,toRed,syz,lastmonom,multWith; BOOLEAN isNotReduced=TRUE; //#define WRITE_BUCKETS #ifdef WRITE_BUCKETS PrintS("Input: \n"); ideal twr=idHead(arg); idPrint(arg); idDelete(&twr); if (modcomp!=NULL) (*modcomp)->show(0,0); #endif newmodcomp = new intvec(Fl+2); //for (j=0;jcf); syz = pCopy(pairs[k]); //syz->coef = nCopy(F[k]->coef); syz->coef = an; //syz->coef = nNeg(syz->coef); pNext(syz) = pairs[k]; lastmonom = pNext(syz); //lastmonom->coef = nCopy(F[j]->coef); lastmonom->coef = bn; lastmonom->coef = nNeg(lastmonom->coef); pSetComp(lastmonom,k+1); } else { syz = pairs[k]; syz->coef = nCopy(currQuotient->m[k-Fl]->coef); syz->coef = nNeg(syz->coef); lastmonom = syz; multWith = pDivide(syz,F[j]); multWith->coef = nCopy(currQuotient->m[k-Fl]->coef); } pSetComp(syz,j+1); pairs[k] = NULL; //the next term of the syzygy //constructs the spoly if (TEST_OPT_DEBUG) { if (km[k-Fl]); } } if (k=Fl) l = (**modcomp)[pGetComp(toRed)+1]-1; kkk = (**modcomp)[pGetComp(toRed)]; while ((l>=kkk) && (!pDivisibleBy(F[l],toRed))) l--; #ifdef WRITE_BUCKETS kBucketClear(sy0buck,&toRed,<R); printf("toRed in Pair[%d, %d]:", j, k); pWrite(toRed); kBucketInit(sy0buck,toRed,-1); #endif if (lcoef = nDiv(lastmonom->coef,F[l]->coef); //lastmonom->coef = nNeg(lastmonom->coef); pSetComp(lastmonom,l+1); //computes the new toRed number up = kBucketPolyRed(sy0buck,F[l],Flength[l],NULL); if (! nIsOne(up)) { // Thomas: Now do whatever you need to do #ifdef WRITE_BUCKETS PrintS("multiplied with: ");nWrite(up);PrintLn(); #endif pMult_nn(syz,up); } nDelete(&up); toRed = kBucketGetLm(sy0buck); //the module component of the new monom //pWrite(toRed); } } kBucketClear(sy0buck,&toRed,<R); //Zur Sichereheit //PrintLn(); if (syz!=NULL) { if (Sl>=IDELEMS(result)) { pEnlargeSet(Shdl,IDELEMS(result),16); IDELEMS(result) += 16; } pNorm(syz); if (BTEST1(OPT_REDTAIL) && redTail) { (*newmodcomp)[j+2] = Sl; (*Shdl)[Sl] = syRedtail2(syz,*Shdl,newmodcomp); (*newmodcomp)[j+2] = 0; } else (*Shdl)[Sl] = syz; Sl++; } } } // for(k=j;k=initial) { for(i=0;im[i]; while (p!=NULL) { if (res[syzIndex-1]->m[pGetComp(p)-1]!=NULL) { for(j=1;j<=(currRing->N);j++) { pSetExp(p,j,pGetExp(p,j) -pGetExp(res[syzIndex-1]->m[pGetComp(p)-1],j)); } } else PrintS("error in the resolvent\n"); pSetm(p); pIter(p); } } syzIndex--; } } static void syMergeSortResolventFB(resolvente res,int length, int initial=1) { int syzIndex=length-1,i,j; poly qq,pp,result=NULL; poly p; while ((syzIndex!=0) && (res[syzIndex]==NULL)) syzIndex--; while (syzIndex>=initial) { for(i=0;im[i]; if (p != NULL) { for (;;) { qq = p; for(j=1;j<=(currRing->N);j++) { pSetExp(p,j,pGetExp(p,j) -pGetExp(res[syzIndex-1]->m[pGetComp(p)-1],j)); } pSetm(p); for (;;) { if (pNext(p) == NULL) { pAdd(result, qq); break; } pp = pNext(p); for(j=1;j<=(currRing->N);j++) { pSetExp(pp,j,pGetExp(pp,j) -pGetExp(res[syzIndex-1]->m[pGetComp(pp)-1],j)); } pSetm(pp); if (pCmp(p,pNext(p)) != 1) { pp = p; pIter(p); pNext(pp) = NULL; result = pAdd(result, qq); break; } pIter(p); } } } res[syzIndex]->m[i] = p; } syzIndex--; } } BOOLEAN syTestOrder(ideal M) { int i=id_RankFreeModule(M,currRing); if (i == 0) return FALSE; int j=0; while ((currRing->order[j]!=ringorder_c) && (currRing->order[j]!=ringorder_C)) j++; if (currRing->order[j+1]!=0) return TRUE; return FALSE; } static void idShift(ideal arg,int index) { int i,j=rGetMaxSyzComp(index, currRing); for (i=0;im[i]!=NULL) p_Shift(&arg->m[i],-j,currRing); } } #if 0 /*debug only */ static void syPrintResolution(resolvente res,int start,int length) { while ((start < length) && (res[start])) { Print("Syz(%d): \n",start); idTest(res[start]); //idPrint(res[start]); start++; } } #endif resolvente sySchreyerResolvente(ideal arg, int maxlength, int * length, BOOLEAN isMonomial, BOOLEAN /*notReplace*/) { ideal mW=NULL; int i,syzIndex = 0,j=0; intvec * modcomp=NULL,*w=NULL; // int ** wv=NULL; tHomog hom=(tHomog)idHomModule(arg,NULL,&w); ring origR = currRing; ring syRing = NULL; if ((!isMonomial) && syTestOrder(arg)) { WerrorS("sres only implemented for modules with ordering ..,c or ..,C"); return NULL; } *length = 4; resolvente res = (resolvente)omAlloc0(4*sizeof(ideal)),newres; res[0] = idCopy(arg); while ((!idIs0(res[syzIndex])) && ((maxlength==-1) || (syzIndexm[i-1])) i--; if (syzIndex+1==*length) { newres = (resolvente)omAlloc0((*length+4)*sizeof(ideal)); // for (j=0;j<*length+4;j++) newres[j] = NULL; for (j=0;j<*length;j++) newres[j] = res[j]; omFreeSize((ADDRESS)res,*length*sizeof(ideal)); *length += 4; res=newres; } if ((hom==isHomog)|| (rHasGlobalOrdering(origR))) { if (syzIndex==0) syInitSort(res[0],&modcomp); if ((syzIndex==0) && !rRing_has_CompLastBlock(currRing)) res[syzIndex+1] = sySchreyersSyzygiesFB(res[syzIndex],&modcomp,mW,FALSE); else res[syzIndex+1] = sySchreyersSyzygiesFB(res[syzIndex],&modcomp,mW); mW = res[syzIndex]; } //idPrint(res[syzIndex+1]); if ( /*(*/ syzIndex==0 /*)*/ ) { if ((hom==isHomog)|| (rHasGlobalOrdering(origR))) { syRing = rAssure_CompLastBlock(origR, TRUE); if (syRing != origR) { rChangeCurrRing(syRing); for (i=0; im[i] = prMoveR( res[1]->m[i], origR, syRing); } } idTest(res[1]); } else { syRing = rAssure_SyzComp_CompLastBlock(origR, TRUE); if (syRing != origR) { rChangeCurrRing(syRing); for (i=0; im[i] = prMoveR( res[0]->m[i], origR, syRing); } } idTest(res[0]); } } if ((hom!=isHomog) && (rHasLocalOrMixedOrdering(origR))) { if (syzIndex==0) syInitSort(res[0],&modcomp); res[syzIndex+1] = sySchreyersSyzygiesFM(res[syzIndex],&modcomp); } syzIndex++; if (TEST_OPT_PROT) Print("[%d]\n",syzIndex); } //syPrintResolution(res,1,*length); if ((hom!=isHomog) && (rHasLocalOrMixedOrdering(origR))) { syzIndex = 1; while ((syzIndex < *length) && (!idIs0(res[syzIndex]))) { idShift(res[syzIndex],syzIndex); syzIndex++; } } if ((hom==isHomog) || (rHasGlobalOrdering(origR))) syzIndex = 1; else syzIndex = 0; syReOrderResolventFB(res,*length,syzIndex+1); if (/*ringOrderChanged:*/ origR!=syRing && syRing != NULL) { rChangeCurrRing(origR); // Thomas: Here I assume that all (!) polys of res live in tmpR while ((syzIndex < *length) && (res[syzIndex])) { for (i=0;im[i]) { res[syzIndex]->m[i] = prMoveR( res[syzIndex]->m[i], syRing, origR); } } syzIndex++; } // j = 0; while (currRing->order[j]!=0) j++; // What was this for???! rDelete(syRing); } else { // Thomas -- are you sure that you have to "reorder" here? while ((syzIndex < *length) && (res[syzIndex])) { for (i=0;im[i]) res[syzIndex]->m[i] = pSortCompCorrect(res[syzIndex]->m[i]); } syzIndex++; } } if ((hom==isHomog) || (rHasGlobalOrdering(origR))) { if (res[1]!=NULL) { syReOrderResolventFB(res,2,1); for (i=0;im[i]) res[1]->m[i] = pSort(res[1]->m[i]); } } } //syPrintResolution(res,0,*length); //syMergeSortResolventFB(res,*length); if (modcomp!=NULL) delete modcomp; if (w!=NULL) delete w; return res; } syStrategy sySchreyer(ideal arg, int maxlength) { int rl; resolvente fr = sySchreyerResolvente(arg,maxlength,&(rl)); if (fr==NULL) return NULL; // int typ0; syStrategy result=(syStrategy)omAlloc0(sizeof(ssyStrategy)); result->length=rl; result->fullres = (resolvente)omAlloc0((rl /*result->length*/+1)*sizeof(ideal)); for (int i=rl /*result->length*/-1;i>=0;i--) { if (fr[i]!=NULL) result->fullres[i] = fr[i]; fr[i] = NULL; } if (currQuotient!=NULL) { for (int i=0; ifullres[i]!=NULL) { ideal t=kNF(currQuotient,NULL,result->fullres[i]); idDelete(&result->fullres[i]); result->fullres[i]=t; if (i=0; j--) { if ((t->m[j]==NULL) && (result->fullres[i+1]!=NULL)) { for(int k=IDELEMS(result->fullres[i+1])-1;k>=0; k--) { if (result->fullres[i+1]->m[k]!=NULL) { pDeleteComp(&(result->fullres[i+1]->m[k]),j+1); } } } } } idSkipZeroes(result->fullres[i]); } } if ((rl>maxlength) && (result->fullres[rl-1]!=NULL)) { idDelete(&result->fullres[rl-1]); } } omFreeSize((ADDRESS)fr,(rl /*result->length*/)*sizeof(ideal)); return result; }