Annotation of OpenXM/src/Ti/gset.c, Revision 1.1
1.1 ! maekawa 1: /*
! 2: ** gset.c Birk Huber, 4/99
! 3: ** -- definitions and basic operations on gsets
! 4: **
! 5: **
! 6: ** TiGERS, Toric Groebner Basis Enumeration by Reverse Search
! 7: ** copyright (c) 1999 Birk Huber
! 8: **
! 9: */
! 10: #include<stdio.h>
! 11: #include<stdlib.h>
! 12: #include "utils.h"
! 13: #include "gset.h"
! 14: #include "matrices.h"
! 15: #include "Rsimp.h"
! 16: extern int NT;
! 17:
! 18: /* uncomment the following to cause use sainity checks (not fully tested)*/
! 19: /*
! 20: #define GTEST 0
! 21: #include "gtesting.h"
! 22: */
! 23:
! 24: /*
! 25: ** create an empty gset, initialize all its pointers to null.
! 26: */
! 27: gset gset_new(){
! 28: gset g=0;
! 29: if ((g=(gset)malloc(sizeof(struct gset_tag)))==0){
! 30: fprintf(stderr,"gset_new(): malloc failed\n");
! 31: return 0;
! 32: }
! 33: gset_first(g)=0;
! 34: gset_cache_vtx(g)=0;
! 35: gset_cache_edge(g)=0;
! 36: return g;
! 37: }
! 38:
! 39: /*
! 40: ** delete a gset and all binomials in it.
! 41: */
! 42: void gset_free(gset g){
! 43: binomial b;
! 44: while((b=gset_first(g))!=0){
! 45: gset_first(g)=binomial_next(b);
! 46: binomial_free(b);
! 47: }
! 48: free((void *)g);
! 49: }
! 50:
! 51:
! 52: /*
! 53: ** read a gset from an input stream
! 54: ** (return TRUE if gset read in )
! 55: */
! 56: int gset_read(FILE *is,gset g){
! 57: char c;
! 58: binomial b;
! 59:
! 60: eatwhite(is);
! 61: c=getc(is);
! 62: if (c!='{') return FALSE;
! 63: c=',';
! 64: while(c==','){
! 65: b=binomial_new();
! 66: binomial_read(is,b);
! 67: gset_insert(g,b);
! 68: eatwhite(is);
! 69: c=getc(is);
! 70: }
! 71: if (c!='}'){
! 72: fprintf(stderr,"gset_read(): gset should end with a '}'\n");
! 73: return FALSE;
! 74: }
! 75: ungetc(c,is);
! 76: return TRUE;
! 77: }
! 78:
! 79: /*
! 80: ** Display a gset
! 81: */
! 82: void gset_print(FILE *of,gset g){
! 83: binomial b;
! 84:
! 85: if (NT == 1) {
! 86: fprintf(of,"[");
! 87: for(b=g->bottom;b!=0;b=b->next){
! 88: binomial_print(of,b);
! 89: if (b->next!=0) fprintf(of," , ");
! 90: }
! 91: fprintf(of,"]");
! 92: }else{
! 93: fprintf(of,"{");
! 94: for(b=g->bottom;b!=0;b=b->next){
! 95: binomial_print(of,b);
! 96: if (b->next!=0) fprintf(of,", ");
! 97: }
! 98: fprintf(of,"}");
! 99: }
! 100: }
! 101:
! 102: /*
! 103: ** Display a gsets initial ideal
! 104: */
! 105: void gset_init_print(FILE *of,gset g){
! 106: binomial b;
! 107: fprintf(of,"{");
! 108: for(b=g->bottom;b!=0;b=b->next){
! 109: print_monomial(of,binomial_lead(b));
! 110: if (b->next!=0) fprintf(of,", ");
! 111: }
! 112: fprintf(of,"}");
! 113: }
! 114:
! 115: /*
! 116: ** Display a facet binomials
! 117: */
! 118: void gset_facet_print(FILE *of,gset g){
! 119: binomial b;
! 120: int tog=0;
! 121: fprintf(of,"{");
! 122: for(b=g->bottom;b!=0;b=b->next){
! 123: if (b->ff==FACET){
! 124: if (tog==1) fprintf(of,",");
! 125: else tog=1;
! 126: binomial_print(of,b);
! 127: }
! 128: }
! 129: fprintf(of,"}");
! 130: }
! 131:
! 132: /*
! 133: ** place binomial in gset in decreasing lexicographic order.
! 134: ** (using binomial_compair(,) to determine reletive order or
! 135: ** binomials)
! 136: */
! 137: void gset_insert(gset g, binomial b){
! 138: binomial t1,t2;
! 139: if (gset_first(g)==0 || binomial_compair(gset_first(g),b)==FALSE){
! 140: binomial_next(b)=gset_first(g);
! 141: gset_first(g)=b;
! 142: }
! 143: else{
! 144: t1=gset_first(g);
! 145: while(t1!=0){
! 146: t2=binomial_next(t1);
! 147: if (t2==0 || binomial_compair(t2,b)==FALSE){
! 148: binomial_next(t1)=b;
! 149: binomial_next(b)=t2;
! 150: break;
! 151: }
! 152: t1=t2;
! 153: }
! 154: }
! 155: }
! 156:
! 157: /*
! 158: ** return first facet binomial which is mis-marked
! 159: */
! 160: binomial gset_downedge(gset g){
! 161: binomial ptr=0;
! 162: for(ptr=gset_first(g);ptr!=0;ptr=binomial_next(ptr)){
! 163: if (binomial_ordered(ptr)==FALSE && gset_isfacet(g,ptr)==TRUE)break;
! 164: }
! 165: return ptr;
! 166: }
! 167:
! 168:
! 169: /*
! 170: ++void bmprint(FILE *of,binomial B, binomial M):
! 171: ++ simple output function for a generating set consisting of a binomial and
! 172: ++ a list of monomials --- usefull mainly for debugging. -- gset output
! 173: ++ routing may be modified in such a way as to use code which could double
! 174: ++ for this purpose.
! 175: ++
! 176: */
! 177: void bmprint(FILE *of,binomial B, binomial M){
! 178: fprintf(of,"{ ");
! 179: if (B!=0) binomial_print(of,B);
! 180: while(M!=0){
! 181: fprintf(of,",");
! 182: binomial_print(of,M);
! 183: M=binomial_next(M);
! 184: }
! 185: fprintf(of,"}\n");
! 186: }
! 187:
! 188: /*
! 189: **binomial bmleadreduce(binomial m1, binomial B, binomial mlist):
! 190: ** "lift" monomial m1 to a binomial using bmlist B,mlist.
! 191: */
! 192: binomial bmleadreduce(binomial m1, binomial B, binomial mlist){
! 193: binomial res,ptr;
! 194: /* case 1: the binomial is used in the decomp:*/
! 195: if (monomial_divides(binomial_lead(B),binomial_lead(m1))==TRUE){
! 196: res=binomial_new();
! 197: binomial_copy(B,res);
! 198: binomial_bumpto(res,m1);
! 199:
! 200: /* now reduce by lt(b) as many times as possible */
! 201: while(monomial_divides(binomial_lead(B),binomial_trail(res))==TRUE){
! 202: reducetrail(res,B);
! 203: }
! 204:
! 205: /* now find a monomial deviding whats left and reduce by it*/
! 206: for(ptr=mlist;ptr!=0;ptr=ptr->next){
! 207: if (monomial_divides(binomial_lead(ptr),binomial_trail(res))==TRUE){
! 208: reducetrail(res,ptr);
! 209: return res;
! 210: }
! 211: }
! 212: }
! 213: else { /* case 2 -- our monomial is a multiple of some monomial*/
! 214: for(ptr=mlist;ptr!=0;ptr=ptr->next){
! 215: if (monomial_divides(binomial_lead(ptr),binomial_lead(m1))==TRUE){
! 216: res=binomial_new();
! 217: binomial_copy(ptr,res);
! 218: binomial_set(res);
! 219: binomial_bumpto(res,m1);
! 220: return res;
! 221: }
! 222: }
! 223: }
! 224: fprintf(stderr, "Warning BMreduce does not get to zero\n");
! 225: }
! 226:
! 227:
! 228:
! 229: /*
! 230: ++ binomial find_divisor(binomial S,binomial L):
! 231: ++ search list starting at L for a monomial dividing S
! 232: ++ return this binomial or zero if no such binomial exists on list.
! 233: ++
! 234: */
! 235: binomial find_divisor(binomial S,binomial L){
! 236: binomial ptr;
! 237: for(ptr=L;ptr!=0;ptr=ptr->next){
! 238: if(ptr!=S&&monomial_divides(binomial_lead(ptr),binomial_lead(S))==TRUE){
! 239: break;
! 240: }
! 241: }
! 242: return ptr;
! 243: }
! 244:
! 245:
! 246: /*
! 247: ++ void remove_multiples(binomial S, binomial *L):
! 248: ++ Pass through list starting at *L, removing all multiples of *S
! 249: ++ encountered (except S if it is on the list).
! 250: ++
! 251: */
! 252: void remove_multiples(binomial S, binomial *L){
! 253: binomial tlist=*L,ptr;
! 254: *L=0;
! 255: while(tlist!=0){
! 256: ptr=tlist; tlist=tlist->next; ptr->next=0; /* pop tlist*/
! 257: if (S==ptr || monomial_divides(binomial_lead(S),binomial_lead(ptr))==FALSE) {
! 258: ptr->next=*L; /* push L */
! 259: *L=ptr;
! 260: }
! 261: else binomial_free(ptr);
! 262: }
! 263: }
! 264:
! 265: /*
! 266: ** void bmrgb(binomial B, binomial *ms):
! 267: ** transform a marked binomial and a list of monomials into the
! 268: ** reduced grobner basis for the ideal the generate.
! 269: **
! 270: */
! 271: void bmrgb(binomial B, binomial *ms){
! 272: int i,jk;
! 273: binomial DL,SL,tlist,S,tmp,ptr;
! 274: int szero;
! 275:
! 276: DL=*ms;
! 277: SL=0;
! 278:
! 279: while(DL!=0){
! 280: tmp=DL; DL=DL->next; /* pop DL */
! 281: tmp->next=SL; SL=tmp; /* push SL */
! 282:
! 283: /* calculate normal form of S pair with respect to {B}*/
! 284: S=monomial_spair(B,binomial_lead(tmp));
! 285:
! 286: /* check if anything on DL or on SL divides S*/
! 287: if (find_divisor(S,SL)!=0||find_divisor(S,DL)!=0)binomial_free(S);
! 288: else {
! 289: remove_multiples(S,&SL); /* remove any multiples of S from SL*/
! 290: remove_multiples(S,&DL); /* remove any multiples of S from DL*/
! 291: S->next=DL; DL=S; /* finally push S onto DL */
! 292: }
! 293: }
! 294:
! 295: remove_multiples(B,&SL); /* now that we have a grobner basis
! 296: we can remove multiples of lead(B)
! 297: from the monomial list */
! 298:
! 299: // replace list bottom pointer
! 300: *ms=SL;
! 301:
! 302: }
! 303:
! 304: /*
! 305: ** gset gset_flip(gset g1, binomial b):
! 306: ** Take a gset and one of its facet binomials and produce the new gset
! 307: ** corresponding to the grobner cone which shares the given facet binomial.
! 308: **
! 309: */
! 310: gset gset_flip(gset g1, binomial b){
! 311: binomial old=0,new=0,tmp,ptr,B,Bold;
! 312: gset gres=0, gtest=0;
! 313:
! 314: /* sainity check -- remove eventually*/
! 315: #ifdef GTEST
! 316: if (lp_isfacet(g1,b)!=FACET){
! 317: fprintf(stdout,"WARNING flip asked to flip non-binomial\n");
! 318: }
! 319: #endif
! 320:
! 321: /* copy all binomials of g's list ecept b to old and new lists*/
! 322: for(ptr=gset_first(g1);ptr!=0;ptr=ptr->next){
! 323: if (ptr!=b){
! 324: tmp=binomial_new();
! 325: binomial_copy(ptr,tmp);
! 326: monomial_set(tmp);
! 327: binomial_next(tmp)=new;
! 328: new=tmp;
! 329: tmp=binomial_new();
! 330: binomial_copy(ptr,tmp);
! 331: monomial_set(tmp);
! 332: binomial_next(tmp)=old;
! 333: old=tmp;
! 334: }
! 335: }
! 336: Bold=binomial_new();
! 337: binomial_copy(b,Bold);
! 338:
! 339: /* make fliped copy of b*/
! 340: B=binomial_new();
! 341: binomial_copy(b,B);
! 342: binomial_flip(B);
! 343:
! 344: /* calculate the reduced GB of the binomial b and the monomials in M */
! 345: bmrgb(B,&new);
! 346:
! 347: /* create new gset and insert flipped copy of b */
! 348: gres=gset_new();
! 349: gset_insert(gres,B);
! 350:
! 351: /* do lifting of elements in mlist and add them to new gset*/
! 352: while((tmp=new)!=0){
! 353: new=new->next;
! 354: ptr=bmleadreduce(tmp,Bold,old);
! 355: gset_insert(gres,ptr);
! 356: binomial_free(tmp);
! 357: }
! 358:
! 359: /* sainity check -- remove eventually*/
! 360: #ifdef GTEST
! 361: if (gset_is_gb(gres)==FALSE){
! 362: fprintf(stderr,"flipped failed to find grobner basis \n");
! 363: fprintf(stderr,"g1=");gset_print(stderr,g1);fprintf(stderr,"\n");
! 364: fprintf(stderr,"b=");binomial_print(stderr,b);fprintf(stderr,"\n");
! 365: exit(1);
! 366: }
! 367: #endif
! 368:
! 369: binomial_free(Bold);
! 370: while(old!=0){
! 371: ptr=old;
! 372: old=old->next;
! 373: binomial_free(ptr);
! 374: }
! 375:
! 376: gset_autoreduce(gres);
! 377:
! 378: /* sainity check -- remove eventually */
! 379: #ifdef GTEST
! 380: if ( gset_is_reduced(gres)==FALSE){
! 381: fprintf(stderr,"flipped failed to find reduced grobner basis \n");
! 382: fprintf(stderr,"g1=");gset_print(stderr,g1);fprintf(stderr,"\n");
! 383: fprintf(stderr,"b=");binomial_print(stderr,b);fprintf(stderr,"\n");
! 384: exit(1);
! 385: }
! 386: #endif
! 387:
! 388: return gres;
! 389: }
! 390:
! 391:
! 392: /*
! 393: ** void gset_autoreduce(gset g):
! 394: ** autoreduce g according to its marking
! 395: */
! 396: void gset_autoreduce(gset g){
! 397: binomial b1,b2;
! 398: int changed;
! 399:
! 400: /* First remove redundant elements from the grobner basis*/
! 401: while(find_divisor(gset_first(g),gset_first(g))!=0){
! 402: gset_first(g)=(b1=gset_first(g))->next;
! 403: binomial_free(b1);
! 404: }
! 405: b1=gset_first(g);
! 406: while(b1!=0 && binomial_next(b1)!=0){
! 407: if (find_divisor(binomial_next(b1),gset_first(g))!=0) {
! 408: b2=binomial_next(b1);
! 409: binomial_next(b1)=binomial_next(b2);
! 410: binomial_free(b2);
! 411: }
! 412: else b1=binomial_next(b1);
! 413: }
! 414:
! 415: /* now reduce trailing terms */
! 416: b1=gset_first(g);
! 417: while(b1!=0){
! 418: changed=1;
! 419: while(changed==1){
! 420: changed=0;
! 421: b2=gset_first(g);
! 422: while(b2!=0){
! 423: if (b2!=b1 &&
! 424: monomial_divides(binomial_lead(b2),binomial_trail(b1))==TRUE){
! 425: reducetrail(b1,b2);
! 426: changed=1;
! 427: }
! 428: b2=binomial_next(b2);
! 429: }
! 430: }
! 431: b1=binomial_next(b1);
! 432: }
! 433:
! 434: /* now reinsert terms to ensure list is in order */
! 435: b1=gset_first(g);
! 436: gset_first(g)=0;
! 437: while((b2=b1)!=0) {
! 438: b1=binomial_next(b1);
! 439: gset_insert(g,b2);
! 440: }
! 441:
! 442: }
! 443:
! 444: /*
! 445: ** void gset_rgb(gset g, int (*comp)(monomial,monomial))
! 446: ** Use buchberger's algorithm to transform g into groebner basis
! 447: ** wrt the term order implemented by comp
! 448: */
! 449: #define ordered(b) ((comp(binomial_lead(b),binomial_trail(b))>=0)?TRUE:FALSE)
! 450: int changed;
! 451: void gset_rgb(gset g, int (*comp)(monomial,monomial)){
! 452: void process_pair(binomial,binomial,binomial,binomial,binomial *,int (*comp)());
! 453: binomial ptr,b,DL=0,SL=0,NL=0;
! 454: int passes=0;
! 455:
! 456: do{
! 457: DL=0; SL=0; NL=0;
! 458: changed=FALSE;
! 459:
! 460: /* reorient g and put binomial list on DL*/
! 461: ptr=gset_first(g);
! 462: while((b=ptr)!=0){
! 463: ptr=binomial_next(ptr);
! 464: if (ordered(b)==FALSE) binomial_flip(b);
! 465: binomial_next(b)=DL;
! 466: DL=b;
! 467: }
! 468:
! 469: /* */
! 470: while(DL!=0){
! 471: NL=0;
! 472: b=DL; DL=DL->next; /* pop DL*/
! 473: b->next=SL; SL=b; /* push ptr onto SL*/
! 474: for(ptr=SL;ptr!=0;ptr=binomial_next(ptr)) process_pair(b,ptr,DL,SL,&NL,comp);
! 475: for(ptr=DL;ptr!=0;ptr=binomial_next(ptr)){
! 476: process_pair(b,ptr,DL,SL,&NL,comp);
! 477: if (binomial_next(ptr)==0){ binomial_next(ptr)=NL; NL=0;}
! 478: }
! 479: }
! 480:
! 481: /* reinsert elements in SL into gset */
! 482: ptr=SL;
! 483: gset_first(g)=0;
! 484: while(ptr!=0){
! 485: ptr=(b=ptr)->next;
! 486: gset_insert(g,b);
! 487: }
! 488:
! 489:
! 490: gset_autoreduce(g);
! 491:
! 492: if (passes>1){
! 493: if (changed==TRUE ){fprintf(stderr,"looping pass (%d)\n",passes);}
! 494: else {fprintf(stderr,"stopping after %d passes\n",passes);}
! 495: }
! 496: passes++;
! 497: }while(changed==TRUE);
! 498:
! 499: }
! 500:
! 501: /*
! 502: -- process_pair(b1,b2,DL,SL,NL,comp):
! 503: -- process spair defined by binomials b1 and b2.
! 504: -- taking spair wrt union of DL SL and *NL lists
! 505: -- if non-zero add result to NL list.
! 506: -- comp is a monomial compairison function used throuout.
! 507: */
! 508: void process_pair(binomial b1,binomial b2,binomial DL,binomial SL,binomial *NL,
! 509: int (*comp)(monomial,monomial)){
! 510: binomial S,ptr,find_divisor(binomial,binomial);
! 511: int i,tmp;
! 512:
! 513: /* test is lead terms are rel prime [buchberger's first criterion]*/
! 514: if (monomial_rel_prime(binomial_lead(b1),binomial_lead(b2))==TRUE)return;
! 515:
! 516: /* buchberger's second criterion ?*/
! 517:
! 518:
! 519: S=binomial_new();
! 520: binomial_copy(b1,S);
! 521: if (binomial_spair(S,b2)==TRUE){
! 522: binomial_free(S);
! 523: return;
! 524: }
! 525: if (ordered(S)==FALSE) binomial_flip(S);
! 526: while(((ptr=find_divisor(S,DL))!=0)||
! 527: ((ptr=find_divisor(S,SL))!=0)||
! 528: ((ptr=find_divisor(S,*NL))!=0)){
! 529: if (binomial_spair(S,ptr)==TRUE){
! 530: binomial_free(S);
! 531: return;
! 532: }
! 533: if (ordered(S)==FALSE) binomial_flip(S);
! 534: }
! 535: changed=TRUE;
! 536: binomial_next(S)=*NL;
! 537: *NL=S;
! 538: }
! 539:
! 540: /*
! 541: ** void gset_setfacets(gset g):
! 542: ** Use repeated calls to gset_isfacet to ensure that all facet flags
! 543: ** are set.
! 544: ** Also sets nfacets, nelts and deg counters (these contain garbage except
! 545: ** right after a call to set facets).
! 546: **
! 547: ** NOTE 4/20 the deg counter was just added and the code to load it is
! 548: ** cludged in here -- logically it should be part of the
! 549: ** binomial.c file -- for now it is here.
! 550: */
! 551: #define max(a,b) (((a)>(b))?(a):(b))
! 552: void gset_setfacets(gset g){
! 553: binomial b;
! 554: monomial ml,mt;
! 555: int i,d=0,dl,dt;
! 556: gset_nfacets(g)=0;
! 557: gset_nelts(g)=0;
! 558: for(b=gset_first(g);b!=0;b=binomial_next(b)){
! 559: if (gset_isfacet(g,b)==FACET) gset_nfacets(g)++;
! 560: gset_nelts(g)++;
! 561: ml=binomial_lead(b); dl=0;
! 562: mt=binomial_trail(b); dt=0;
! 563: for(i=0;i<ring_N;i++){ dl+=ml[i]; dt+=mt[i];}
! 564: d=max(d,max(dl,dt));
! 565: }
! 566: gset_deg(g)=d;
! 567: }
! 568:
! 569: /*
! 570: ** int gset_isfacet(gset g,binomial b):
! 571: ** check whether b is known to be a facet or not. if not call lp_isfacet()
! 572: ** to use a linear program to set b's facet flag.
! 573: **
! 574: */
! 575: int lptest=1; /* 1 test only LP, 2 test only flipability, 3 test both */
! 576: int gset_isflippable(gset g,binomial b);
! 577: int gset_isfacet(gset g,binomial b){
! 578: int rval=UNKNOWN;
! 579: rval=b->ff;
! 580: if (rval!=FACET && rval!=NONFACET){
! 581: switch(lptest){
! 582: case 1: rval=(b->ff=lp_isfacet(g,b));
! 583: break;
! 584: case 2: if (gset_isflippable(g,b)==FALSE) rval=(b->ff=NONFACET);
! 585: else rval=(b->ff=FACET);
! 586: break;
! 587: case 3: if (gset_isflippable(g,b)==FALSE) rval=(b->ff=NONFACET);
! 588: else rval=(b->ff=lp_isfacet(g,b));
! 589: break;
! 590: default: fprintf(stderr,"Warning lptest has invalid value in gset_isflippable()\n");
! 591: exit(4);
! 592: }
! 593: }
! 594: return rval;
! 595: }
! 596:
! 597: /*
! 598: **
! 599: */
! 600: int gset_isflippable(gset g,binomial b){
! 601: int ctg=0,ctn=1,val=TRUE;
! 602: binomial new=0,tmp,ptrg,ptrn,btmp;
! 603: /* copy all binomials of g's list ecept b to old and new lists*/
! 604: for(ptrg=gset_first(g);ptrg!=0;ptrg=ptrg->next){
! 605: ctg++;
! 606: if (ptrg!=b){
! 607: tmp=binomial_new();
! 608: binomial_copy(ptrg,tmp);
! 609: monomial_set(tmp);
! 610: binomial_next(tmp)=new;
! 611: new=tmp;
! 612: }
! 613: }
! 614: btmp=binomial_new();
! 615: binomial_copy(b,btmp);
! 616:
! 617:
! 618: /* calculate the reduced GB of the binomial b and the monomials in M */
! 619: bmrgb(btmp,&new);
! 620:
! 621: /* test if new and old have same leading terms */
! 622: for(ptrn=new ;ptrn!=0;ptrn=ptrn->next) ctn++;
! 623: if (ptrn!=ptrg) val=FALSE; /* initial ideals have diferent numbers of generators */
! 624: else {
! 625: for(ptrn=new;ptrn!=0;ptrn=ptrn->next){
! 626: for(ptrg=gset_first(g);ptrg!=0;ptrg=ptrg->next){
! 627: if (monomial_equal(binomial_lead(ptrn),binomial_lead(ptrg))==TRUE)break;
! 628: }
! 629: if (ptrg==0)break; /* no match found */
! 630: }
! 631: if (ptrn!=0)val=FALSE; /* not all terms had matches found */
! 632: }
! 633:
! 634: /* clean up */
! 635: binomial_free(btmp);
! 636: while(new!=0){
! 637: ptrn=new;
! 638: new=new->next;
! 639: binomial_free(ptrn);
! 640: }
! 641:
! 642: return val;
! 643: }
! 644:
! 645: /*
! 646: ** int lp_isfacet(gset g,binomial b):
! 647: ** set up and run linear program to set b's facet flag.
! 648: **
! 649: */
! 650: int lp_isfacet(gset g,binomial b){
! 651: binomial ptr;
! 652: int D=ring_N,M=0;
! 653: int idx=0,i;
! 654: double dtmp0,dtmp;
! 655:
! 656: /* need cheeper way to determine the size of g */
! 657: for(ptr=gset_first(g);ptr!=0;ptr=binomial_next(ptr)){
! 658: if (ptr->ff!=NONFACET)M++;
! 659: }
! 660:
! 661: /* make sure the lp structures have enough space for the program*/
! 662: LP_get_space(M,D+2*M);
! 663:
! 664: /* Set up linear program. */
! 665: ptr=gset_first(g);
! 666: idx=0;
! 667: while(ptr!=0){
! 668: if (ptr->ff!=NONFACET){
! 669: for(i=0;i<D;i++){ /* make sure supports of trail and lead disjoint? */
! 670: LP_A(idx,i)=binomial_lead(ptr)[i]-binomial_trail(ptr)[i];
! 671: }
! 672: for(i=0;i<M;i++){
! 673: LP_A(idx,D+i)=0;
! 674: LP_A(idx,D+M+i)=0;
! 675: }
! 676: if (ptr==b) {for(i=0;i<D;i++) LP_A(idx,i)*=-1;}
! 677: LP_A(idx,D+M+idx)=1;
! 678: LP_A(idx,D+idx)=-1;
! 679: LP_B[idx]=1;
! 680: idx++;
! 681: }
! 682: ptr=ptr->next;
! 683: }
! 684: for(i=0;i<D+M;i++){
! 685: LP_C[i]=0;
! 686: LP_X[i]=0;
! 687: LP_NonBasis[i]=i;
! 688: }
! 689: for(i=0;i<M;i++){
! 690: LP_Basis[i]=D+M+i;
! 691: LP_X[D+M+i]=1;
! 692: LP_C[D+M+i]=1;
! 693: }
! 694:
! 695: /* Run simplex algorithm */
! 696: Rsimp(LP_M,LP_N,LP_A,LP_B,LP_C,LP_X,LP_Basis,LP_NonBasis,
! 697: LP_R,LP_Q,LP_t1,LP_t2);
! 698:
! 699: /* use results to determine if the b is a facet*/
! 700: b->ff=FACET;
! 701: for(i=0;i<M;i++) if (LP_Basis[i]>=M+D) {b->ff=NONFACET;break;}
! 702:
! 703: return b->ff;
! 704: }
! 705:
! 706:
! 707:
! 708:
! 709:
! 710:
! 711:
! 712:
! 713:
! 714:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>