Word ADJ_2D1_COMPLETE(Word c, Word c_l, Word c_r, Word P, Word J) { Word Sol,Sol1,Sol2; Step1: /* Construct list of possible adjacency assignments. */ if (LELTI(c,CHILD) == NIL) { Sol = NIL; goto Return; } if (LELTI(c_l,CHILD) == NIL) Sol1 = LIST1(NIL); else Sol1 = ADJ_2D1(c,c_l,P,J); if (LELTI(c_r,CHILD) == NIL) Sol2 = LIST1(NIL); else Sol2 = ADJ_2D1(c,c_r,P,J); Step2: /* If assignment is not unique, decide which is correct. */ if (LENGTH(Sol1) == 1 && LENGTH(Sol2) == 1) Sol = CCONC(FIRST(Sol1),FIRST(Sol2)); else Sol = ACMADJ2D(c,c_l,c_r,P); Sol = LIST1(Sol); Return: /* Prepare to return. */ return Sol; }
Word HAP3(Word U, Word w_l, Word B) { Word Sol,u,I,w_u,r,c1,c2; Step1: /* Initialization. */ if (U == NIL) { Sol = LIST1(NIL); goto Return; } ADV(U,&u,&U); FIRST2(u,&I,&r); Sol = LIST1(LIST2(I,LIST2(B,AD2D_Infy))); while(U != NIL) { ADV(U,&u,&U); FIRST2(u,&I,&w_u); r = VECTOR_SUM(r,w_u); Sol = COMP(LIST2(I,LIST2(B,AD2D_Infy)),Sol); } while(r != NIL) { ADV(r,&c1,&r); ADV(w_l,&c2,&w_l); if (c1 != 0 && c2 == 0) { Sol = AD2D_FAIL; goto Return; } } Sol = LIST1(Sol); Return: /* Prepare to return. */ return Sol; }
Word CYLIMPFORM(Word C, Word P, Word k, Word A) { Word SF,L,Lp,c,S,t,Q,As,Ap,Fp,F,Lt,Lf,s,Si,Fi,Qp,SF2; Step1: /* Set L to a list of all (k-1)-level cells over which there are k-level cells with SC_TMPM of TRUE. */ if (k == 0) { if (LELTI(C,SC_TMPM) == TRUE) SF = LIST1(TRUE); else SF = LIST1(FALSE); goto Return; } SF = NIL; L = NIL; for(Lp = PCADCL(C,k-1); Lp != NIL; Lp = RED(Lp)) { c = FIRST(Lp); S = LELTI(c,SC_CDTV); if (!ISLIST(S)) continue; for(t = 0; S != NIL && !t; S = RED(S)) t = (LELTI(FIRST(S),SC_TMPM) == TRUE); if (t) L = COMP(c,L); } Step2: /* Construct formula for the k-level cells. */ Lt = NIL; Lf = NIL; S = NIL; for(Lp = L; Lp != NIL; Lp = RED(Lp)) S = CCONC(LELTI(FIRST(Lp),SC_CDTV),S); for(S = PCADCL(C,k); S != NIL; S = RED(S)) { s = FIRST(S); if (LELTI(s,SC_TMPM) == TRUE) Lt = COMP(s,Lt); else Lf = COMP(s,Lf); } F = NAIVESF(SPCADCBDD(Lt,k),Lf,A,P); Step3: /* */ S = GEOPARTII(FMASORT(FMA2DNF(F)),L,P,NIL); /* Construct definiting formula from each (Si,Fi) in S. */ for(; S != NIL; S = RED(S)) { FIRST2(FIRST(S),&Si,&Fi); ESCSLKMF(C,k-1); for(Qp = Si; Qp != NIL; Qp = RED(Qp)) SLELTI(FIRST(Qp),SC_TMPM,TRUE); SF2 = CYLIMPFORM(C,P,k-1,A); SF = COMP(LIST3(ANDOP,SF2,CLEANUPFORM(Si,Fi,P)),SF); } Step4: /* Convert SF from a list of formulas to a formula. */ if (LENGTH(SF) > 1) SF = COMP(OROP,SF); else SF = FIRST(SF); Return: /* Prepare to return. */ return SF; }
Word CF(Word L,Word F,Word P) { Word Fp,A,Ap,f; switch(FIRST(F)) { case (TRUE) : Fp = F; break; case (FALSE) : Fp = F; break; case (ANDOP) : A = RED(F); for(Ap = NIL; A != NIL; A = RED(A)) { f = CF(L,FIRST(A),P); if (FIRST(f) == FALSE) { Fp = f; goto Return; } if (FIRST(f) != TRUE) Ap = COMP(f,Ap); } if (Ap == NIL) Fp = LIST1(TRUE); else if (LENGTH(Ap) == 1) Fp = FIRST(Ap); else Fp = COMP(ANDOP,Ap); break; case (OROP) : A = RED(F); for(Ap = NIL; A != NIL; A = RED(A)) { f = CF(L,FIRST(A),P); if (FIRST(f) == TRUE) { Fp = f; goto Return; } if (FIRST(f) != FALSE) Ap = COMP(f,Ap); } if (Ap == NIL) Fp = LIST1(FALSE); else if (LENGTH(Ap) == 1) Fp = FIRST(Ap); else Fp = COMP(OROP,Ap); break; default: f = UNIFORMTV(L,F,P); if (f == UNDET) Fp = F; else Fp = LIST1(f); break; } Return: return Fp; }
Word QepcadCls::SFCFULLDf(Word D, Word P, Word J, Word n) { Word t,SF,Dp,Pp,Lt,Lf,LA,Q,D1,P1,D0,P0,J0,i,Lp,pflag, L; char e,s,m,c; Step1: /* Space is either empty or R^n. */ t = DOPFSUFF_FULLD(P,LIST1(D)); if (t == TRUE) { SF = LIST1(TRUE); /* CAD is identically TRUE. */ goto Return; } else if (t == FALSE) { SF = LIST1(FALSE); /* CAD is identically FALSE. */ goto Return; } Step2: /* Extended language. */ /* Dp,Pp are a simplified CAD for D,P (based only on full-dimensional cells!) */ CCADCONmod(n,P,D,&Pp,&Dp); Dp = PCAD2ESPCAD(P,Pp,Dp,NIL); /* Get list of all the true and false cells. */ LTFOCALWTV(Dp,n,&Lt,&Lf); /* Filter out all but the full-dimensional true/false cells. */ for(L = NIL; Lt != NIL; Lt = RED(Lt)) if (LELTI(LELTI(FIRST(Lt),SC_REP),LEVEL) == CELLDIM(LELTI(FIRST(Lt),SC_REP))) L = COMP(FIRST(Lt),L); Lt = L; for(L = NIL; Lf != NIL; Lf = RED(Lf)) if (LELTI(LELTI(FIRST(Lf),SC_REP),LEVEL) == CELLDIM(LELTI(FIRST(Lf),SC_REP))) L = COMP(FIRST(Lf),L); Lf = L; if (Lt == NIL && Lf == NIL) { SWRITE("No cells have truth values!\n"); goto Return; } t = ESPCADDOPFSUFF(Pp,LIST1(Dp)); LA = LISTOETAmod(Pp,n,t==NIL); /* Construct formula */ SF = NECCONDS(Lt,Lf,LA,Pp); SF = FMASORT(SF); SF = FMA_REMCONST(SF); SF = FMASMOOTH(SF); SF = FMAOPCOMBINE(SF); Return: /* Prepare to return. */ return SF; }
void testSIimplOI(BDigit r, Word P, Word ZL, Word NZ, Word A) { /* Compute generators A and all its 1st order partials */ Word L = LIST1(A); for(int i = 1; i <= r; ++i) { Word D = IPDER(r,A,i); if (D != 0) L = COMP(D,L); } L = CCONC(L,ZL); /* Compute a variable list for output purposes. */ Word V = NIL; for(int i = r; i > 0; i--) { char s[2]; s[0] = 'a' - 1 + i; s[1] = '\0'; V = COMP(LFS(s),V); } /* Go through assumptions and find non-vanishing conditions. */ Word M = NZ; SWRITE("Test si ==> oi: "); IPDWRITE(r,A,V); SWRITE("\n"); GBTest(r,L,V); }
Word RMNOTOP(Word F) { Word F1,Fb,Fp,Fp1,T; Step1: /* Classify the formula v{F}. */ T = FIRST(F); if (T == ANDOP) goto Step3; if (T == OROP) goto Step3; if (T == NOTOP) goto Step4; Step2: /* Atomic Formula. */ Fp = F; goto Return; Step3: /* Conjunction/Disjunction. */ Fb = RED(F); Fp = LIST1(T); while (Fb != NIL) { ADV(Fb,&F1,&Fb); Fp1 = RMNOTOP(F1); Fp = COMP(Fp1,Fp); } Fp = INV(Fp); goto Return; Step4: /* Negation. */ F1 = SECOND(F); Fp = RMNOTOPN(F1); goto Return; Return: /* Prepare for return. */ return(Fp); }
static void xml_end_element_handler(void *userData, const XML_Char *name) { uim_xml_userdata *data = (uim_xml_userdata *)userData; if (data && data->end_) { uim_scm_call(data->end_, LIST1(MAKE_STR(name))); } }
/* Projection point equal */ BDigit PRJPNTEQUAL(Word A, Word B) { if (LENGTH(A) != LENGTH(B)) return 0; /* Both primitive */ Word a = FIRST(A), b = FIRST(B); if (ISPRIMIT(a) && ISPRIMIT(b)) { Word aC,aK,ac,bC,bK,bc; FIRST3(a,&aC,&aK,&ac); FIRST3(b,&bC,&bK,&bc); if (!EQUAL(aC,bC)) return 0; if (EQUAL(FIRST(aK),SECOND(aK)) && EQUAL(aK,bK)) return 1; if (EQUAL(FIRST(aK),SECOND(aK)) && EQUAL(FIRST(bK),SECOND(bK)) && !EQUAL(aK,bK)) return 0; if (RNCOMP(SECOND(aK),FIRST(bK)) <= 0 || RNCOMP(FIRST(aK),SECOND(bK)) >= 0) return 0; return EQUAL(ac,bc); } /* Both Not Primitive */ if (!ISPRIMIT(a) && !ISPRIMIT(b)) { if (!PRJPNTEQUAL(LIST1(SECOND(A)),LIST1(SECOND(B)))) return 0; Word aC,aK,aM,aI,ac,bC,bK,G,Af,Bf; FIRST5(a,&aC,&aK,&aM,&aI,&ac); FIRST2(b,&bC,&bK); if (EQUAL(FIRST(aK),SECOND(aK)) && EQUAL(FIRST(bK),SECOND(bK)) && !EQUAL(aK,bK)) return 0; if (RNCOMP(SECOND(aK),FIRST(bK)) <= 0 || RNCOMP(FIRST(aK),SECOND(bK)) >= 0) return 0; if (EQUAL(aC,bC)) return 1; AFUPGC(aM,aC,bC,&G,&Af,&Bf); if (PDEG(G) < 1) return 0; Word KL = LIST2(FIRST(aK),LIST2(1,1)); Word KR = LIST2(SECOND(aK),LIST2(1,1)); Word sL = AFSIGN(aM,aI,AFPEMV(1,aM,G,KL)); Word sR = AFSIGN(aM,aI,AFPEMV(1,aM,G,KR)); return EQUAL(KL,KR) && sL == 0 || sL == 1 && sR == -1 || sL == -1 && sR == 1; } /* One primitive, the other not */ if (ISPRIMIT(a) != ISPRIMIT(b)) { SWRITE("This condition not implemented in PRJPNTEQUAL!\n"); FAIL("PRJPNTEQUAL","Incomplete Implementation Error!"); } return -1; }
void GBTest(Word r, Word L, Word N, Word Vp) { if (LENGTH(Vp) < r) { SWRITE("Not enough variables in GBTest!\n"); } Word F = GVCAP->IPFACTGB(r,L,N); SWRITE("\nSYSTEM:\n"); PRINTCOEFFSYS(r,LIST1(L),Vp); SWRITE("\n"); SWRITE("\nGB's:\n"); PRINTCOEFFSYS(r,F,Vp); SWRITE("\n"); }
void QepcadCls::PROJMCECCLOSURE(Word P, Word J, Word Q) { Word N,k,Q_k,PP,NP,pp,L,l,i,S,s; Step1: /* Initialization. */ N = LENGTH(Q); Step2: /* Loop from */ for(k = N; k > 1; k--) { Q_k = LELTI(Q,k); SEPPIVNONPIV(Q_k,k,&PP,&NP); while (PP != NIL) { ADV(PP,&pp,&PP); Step3: /* Add necessary coefficients of pp. */ L = PFSUFFCOEF(pp,P,J); while (L != NIL ) { ADV(L,&l,&L); i = SECOND(LELTI(l,PO_LABEL)); SLELTI(Q,i,PFSUNION(LELTI(Q,i),LIST1(l))); } Step4: /* Add factors of the discriminant of pp. */ if (PDEG(LELTI(pp,PO_POLY)) > 1) { L = PFDISCRIM(pp,P,J); while (L != NIL ) { ADV(L,&l,&L); i = SECOND(LELTI(l,PO_LABEL)); SLELTI(Q,i,PFSUNION(LELTI(Q,i),LIST1(l))); } } Step5: /* Add resultants. */ for(S = CCONC(PP,NP); S != NIL; S = RED(S)) { s = FIRST(S); L = PFRES(pp,s,P,J); while (L != NIL ) { ADV(L,&l,&L); i = SECOND(LELTI(l,PO_LABEL)); SLELTI(Q,i,PFSUNION(LELTI(Q,i),LIST1(l))); } } } } Return:/* Return. */ return; }
static uim_lisp im_acquire_text(uim_lisp uc_, uim_lisp text_id_, uim_lisp origin_, uim_lisp former_len_, uim_lisp latter_len_) { uim_context uc; int err, former_len, latter_len; enum UTextArea text_id; enum UTextOrigin origin; char *former, *latter, *cv_former, *cv_latter; uim_lisp former_, latter_; uc = retrieve_uim_context(uc_); if (!uc->acquire_text_cb) return uim_scm_f(); text_id = C_INT(text_id_); origin = C_INT(origin_); former_len = C_INT(former_len_); latter_len = C_INT(latter_len_); err = uc->acquire_text_cb(uc->ptr, text_id, origin, former_len, latter_len, &former, &latter); if (err) return uim_scm_f(); /* FIXME: string->list is not applied here for each text part. This * interface should be revised when SigScheme has been introduced to * uim. Until then, perform character separation by each input methods if * needed. -- YamaKen 2006-10-07 */ cv_former = uc->conv_if->convert(uc->inbound_conv, former); cv_latter = uc->conv_if->convert(uc->inbound_conv, latter); free(former); free(latter); former_ = (TEXT_EMPTYP(cv_former)) ? uim_scm_null() : LIST1(MAKE_STR_DIRECTLY(cv_former)); latter_ = (TEXT_EMPTYP(cv_latter)) ? uim_scm_null() : LIST1(MAKE_STR_DIRECTLY(cv_latter)); return uim_scm_callf("ustr-new", "oo", former_, latter_); }
void IUPRWR(Word v, Word A, Word I) { Word l,r; Step1: /* Write. */ SWRITE("the unique root of "); IPDWRITE(1,A,LIST1(v)); FIRST2(I,&l,&r); SWRITE(" between "); RNWRITE(l); SWRITE(" and "); RNWRITE(r); Return: /* Prepare for return. */ return; }
Word FMAOPCOMBINE(Word F) { Word L,M,Fp,f,a,b,Lp,Mp,Lb; switch(FIRST(F)) { case OROP: /* Set L to a list of all top level atomic formulas. */ L = NIL; M = NIL; for(Fp = RED(F); Fp != NIL; Fp = RED(Fp)) { f = FIRST(Fp); if (ISLIST(FIRST(f))) L = COMP(f,L); else M = COMP(f,M); } /* Create Lp from L */ Lp = NIL; while(L != NIL) { a = FIRST(L); if (FMAQEXTAF(a)) { Lp = COMP(a,Lp); L = RED(L); continue; } Lb = RED(L); for(L = NIL; Lb != NIL; Lb = RED(Lb)) { b = FIRST(Lb); if (FMAQEXTAF(b) || ! EQUAL(FIRST(b),FIRST(a))) L = COMP(b,L); else a = LIST2(FIRST(a),SECOND(a) | SECOND(b)); } if (SECOND(a) > 6) Lp = COMP(LIST1(TRUE),Lp); else Lp = COMP(a,Lp); } /* Create Mp from M. */ for(Mp = NIL; M != NIL; M = RED(M)) Mp = COMP(FMAOPCOMBINE(FIRST(M)),Mp); Fp = COMP(OROP,CCONC(Lp,Mp)); break; case ANDOP: Fp = NIL; for(L = CINV(RED(F)); L != NIL; L = RED(L)) Fp = COMP(FMAOPCOMBINE(FIRST(L)),Fp); Fp = COMP(ANDOP,Fp); break; default: Fp = F; } return Fp; }
Word CELLSCPCELL(Word C, Word P, Word Ps) { Word c,A,i,L,N,Ps_N,Lp,l,S,s,k,Z,r; Step1: /* Initialize. */ FIRST3(C,&c,&A,&i); if (A == NIL) { Lp = LIST1(c); goto Return; } L = CELLSCPCELL(A,P,Ps); N = LELTI(c,LEVEL); Ps_N = LELTI(Ps,N); Step2: /* Loop over all the cells that form the projection of C. */ Lp = NIL; while (L != NIL) { ADV(L,&l,&L); S = LELTI(l,CHILD); if (S == NIL) { Lp = COMP(l,Lp); } else { Step3: /* Set s to the first child of l which lies in C. */ ADV(S,&s,&S); for(k = 1; k < i; S = RED(S)) { s = FIRST(S); if ( EVEN(k) ) k++; else { Z = LPFZC(s,P); if ( LPFSETINTERSECT(Z,Ps_N) != NIL ) k++; } } Step4: /* Continue adding cells from S until they no longer lie in C. */ if ( EVEN(i) ) Lp = COMP(s,Lp); else { Lp = COMP(s,Lp); while ( S != NIL ) { ADV2(S,&s,&r,&S); Z = LPFZC(s,P); if ( LPFSETINTERSECT(Z,Ps_N) == NIL ) { Lp = COMP(s,Lp); Lp = COMP(r,Lp); } else break; } } } } Return: /* Return. */ return (Lp); }
Word CYLFORM(Word C, Word P, Word k, Word A) { Word SF,L,Lp,c,S,t,Q,As,Ap,Fp,F,Lt,Lf,s; Step1: /* Set L to a list of all (k-1)-level cells over which there are k-level cells with SC_TMPM of TRUE. */ if (k == 0) { SF = LIST1(TRUE); goto Return; } SF = NIL; L = NIL; for(Lp = PCADCL(C,k-1); Lp != NIL; Lp = RED(Lp)) { c = FIRST(Lp); S = LELTI(c,SC_CDTV); if (!ISLIST(S)) continue; for(t = 0; S != NIL && !t; S = RED(S)) t = (LELTI(FIRST(S),SC_TMPM) == TRUE); if (t) L = COMP(c,L); } Step3: /* Construct formula for the k-level cells. */ Lt = NIL; Lf = NIL; S = NIL; for(Lp = L; Lp != NIL; Lp = RED(Lp)) S = CCONC(LELTI(FIRST(Lp),SC_CDTV),S); for(S = PCADCL(C,k); S != NIL; S = RED(S)) { s = FIRST(S); if (LELTI(s,SC_TMPM) == TRUE) Lt = COMP(s,Lt); else Lf = COMP(s,Lf); } F = NAIVESF(SPCADCBDD(Lt,k),Lf,A,P); Step2: /* Formula for the projection. */ for(Q = L; Q != NIL; Q = RED(Q)) SLELTI(FIRST(Q),SC_TMPM,TRUE); As = NIL; for(Ap = CINV(A); Ap != NIL; Ap = RED(Ap)) if (FMALEVEL(FIRST(Ap)) < k) As = COMP(FIRST(Ap),As); Fp = CYLFORM(C,P,k-1,As); SF = LIST3(ANDOP,Fp,F); Return: /* Prepare to return. */ return SF; }
static void xml_characterdata_handler(void *userData, const XML_Char *s, int len) { uim_xml_userdata *data = (uim_xml_userdata *)userData; char *str = uim_malloc(len + 1); memcpy(str, s, len); str[len] = '\0'; if (data && data->characterdata_) { uim_scm_call(data->characterdata_, LIST1(MAKE_STR(str))); } free(str); }
void MODCRDB(Word b, Word S1, Word Ms, Word Ns, Word *b1_) { Word b1; Step1: /* Process. */ if (PCDBUSE == 'n') { MODCR(b,S1,Ms,Ns,&b1); goto Return; } if (DBSRCH(DBMODCR,LIST4(b,S1,Ms,Ns)) == 0) { MODCR(b,S1,Ms,Ns,&b1); DBADD(DBMODCR,LIST4(b,S1,Ms,Ns),LIST1(b1),&DBMODCR); } else b1 = FIRST(DBINFO); goto Return; Return: /* Prepare for return. */ *b1_ = b1; return; }
Word RMCAFS(Word F) { Word F1,F2,Fb,Fp,Fp1,Fp2,T,t,t1,t2; /* hide t,t1,t2; */ Step1: /* Classify the formula F. */ T = FIRST(F); if (T == ANDOP) goto Step3; if (T == OROP) goto Step4; if (T == NOTOP) goto Step5; if (T == RIGHTOP) goto Step6; if (T == LEFTOP) goto Step7; if (T == EQUIOP) goto Step8; Step2: /* Atomic Formula. */ t = TYPEAF(F); if (t == TRUE) { Fp = LIST4(EQOP,0,0,NIL); goto Return; } if (t == FALSE) { Fp = LIST4(NEOP,0,0,NIL); goto Return; } Fp = F; goto Return; Step3: /* Conjunction. */ Fb = RED(F); Fp = LIST1(ANDOP); while (Fb != NIL) { ADV(Fb,&F1,&Fb); Fp1 = RMCAFS(F1); t = TYPEQFF(Fp1); if (t == FALSE) { Fp = LIST4(NEOP,0,0,NIL); goto Return; } if (t == UNDET) Fp = COMP(Fp1,Fp); } if (LENGTH(Fp) == 1) { Fp = LIST4(EQOP,0,0,NIL); goto Return; } if (LENGTH(Fp) == 2) { Fp = FIRST(Fp); goto Return; } Fp = INV(Fp); goto Return; Step4: /* Disjunction. */ Fb = RED(F); Fp = LIST1(OROP); while (Fb != NIL) { ADV(Fb,&F1,&Fb); Fp1 = RMCAFS(F1); t = TYPEQFF(Fp1); if (t == TRUE) { Fp = LIST4(EQOP,0,0,NIL); goto Return; } if (t == UNDET) Fp = COMP(Fp1,Fp); } if (LENGTH(Fp) == 1) { Fp = LIST4(NEOP,0,0,NIL); goto Return; } if (LENGTH(Fp) == 2) { Fp = FIRST(Fp); goto Return; } Fp = INV(Fp); goto Return; Step5: /* Negation. */ F1 = SECOND(F); Fp1 = RMCAFS(F1); t = TYPEQFF(Fp1); if (t == TRUE) Fp = LIST4(NEOP,0,0,NIL); else if (t == FALSE) Fp = LIST4(EQOP,0,0,NIL); else Fp = LIST2(NOTOP,Fp1); goto Return; Step6: /* $\Rightarrow$. */ F1 = SECOND(F); Fp1 = RMCAFS(F1); t1 = TYPEQFF(Fp1); F2 = THIRD(F); Fp2 = RMCAFS(F2); t2 = TYPEQFF(Fp2); if (t1 == TRUE) Fp = Fp2; else if (t1 == FALSE) Fp = LIST4(EQOP,0,0,NIL); else if (t2 == TRUE) Fp = LIST4(EQOP,0,0,NIL); else if (t2 == FALSE) Fp = LIST2(NOTOP,Fp1); else Fp = LIST3(RIGHTOP,Fp1,Fp2); goto Return; Step7: /* $\Leftarrow$. */ F1 = THIRD(F); Fp1 = RMCAFS(F1); t1 = TYPEQFF(Fp1); F2 = SECOND(F); Fp2 = RMCAFS(F2); t2 = TYPEQFF(Fp2); if (t1 == TRUE) Fp = Fp2; else if (t1 == FALSE) Fp = LIST4(EQOP,0,0,NIL); else if (t2 == TRUE) Fp = LIST4(EQOP,0,0,NIL); else if (t2 == FALSE) Fp = LIST2(NOTOP,Fp1); else Fp = LIST3(LEFTOP,Fp2,Fp1); goto Return; Step8: /* $\Leftrightarrow$. */ F1 = SECOND(F); Fp1 = RMCAFS(F1); t1 = TYPEQFF(Fp1); F2 = THIRD(F); Fp2 = RMCAFS(F2); t2 = TYPEQFF(Fp2); if (t1 == TRUE) Fp = Fp2; else if (t2 == TRUE) Fp = Fp1; else if (t1 == FALSE && t2 == FALSE) Fp = LIST4(EQOP,0,0,NIL); else if (t1 == FALSE) Fp = LIST2(NOTOP,Fp2); else if (t2 == FALSE) Fp = LIST2(NOTOP,Fp1); else Fp = LIST3(EQUIOP,Fp1,Fp2); goto Return; Return: /* Prepare for return. */ return(Fp); }
Word CFLCELLLIST(Word L_D) { Word C,r,C_r,L,Lp,T,F,U,c,t,f,u,Fp,Up,h,Cb,Cp,Q; /* Time */ Word tm; Step1: /* Initialize. */ C = NIL; Step2: /* Get the children of L_D. */ L = NIL; for(Q = L_D; Q != NIL; Q = RED(Q)) { L = CCONC(LELTI(FIRST(Q),CHILD),L); } Step3: /* Sort by signiture. */ L = GISL(L,comp); Step4: /* Loop over each block of cells with same signiture. */ while (L != NIL) { Lp = NIL; do { Lp = COMP(FIRST(L),Lp); L = RED(L); } while (L != NIL && comp(FIRST(Lp),FIRST(L)) == 0); Step5: /* Separate into lists of TRUE, FALSE, and UNDET cells. */ T = NIL; F = NIL; U = NIL; C_r = NIL; while (Lp != NIL) { ADV(Lp,&c,&Lp); switch (LELTI(c,TRUTH)) { case (TRUE) : T = COMP(c,T); break; case (FALSE) : F = COMP(c,F); break; case (UNDET) : U = COMP(c,U); break; } } Step6: /* TRUE/FALSE & TRUE/UNDET combinations. */ for(; T != NIL; T = RED(T)) { t = FIRST(T); for(Fp = F; Fp != NIL; Fp = RED(Fp)) { f = FIRST(Fp); C_r = COMP(LIST2(t,f),C_r); } for(Up = U; Up != NIL; Up = RED(Up)) { u = FIRST(Up); h = CATV(u); if (h == FALSE || h == UNDET) C_r = COMP(LIST2(t,u),C_r); } } Step7: /* FALSE/UNDET combinations. */ for(; F != NIL; F = RED(F)) { f = FIRST(F); for(Up = U; Up != NIL; Up = RED(Up)) { u = FIRST(Up); h = CATV(u); if (h == TRUE || h == UNDET) C_r = COMP(LIST2(f,u),C_r); } } Step8: /* Recurse on the UNDET cells. */ if ( U != NIL ) Cb = COMP(C_r,CFLCELLLIST(U)); else Cb = LIST1(C_r); Step9: /* Update C to include the */ Cp = NIL; while( C != NIL && Cb != NIL ) { Cp = COMP(CCONC(FIRST(Cb),FIRST(C)),Cp); C = RED(C); Cb = RED(Cb); } Cp = CINV(Cp); if ( C != NIL ) Cp = CCONC(Cp,C); if ( Cb != NIL ) Cp = CCONC(Cp,Cb); C = Cp; } Return: /* Prepare to return. */ return (C); }
Word QepcadCls::PROJMCmod(Word r, Word A) { Word A1,A2,Ap,Ap1,Ap2,App,D,L,Lh,P,R,W,i,t,Q,j,S,Sp; Step1: /* Obtain coefficients. */ P = NIL; Ap = A; while (Ap != NIL) { ADV(Ap,&A1,&Ap); Ap1 = LELTI(A1,PO_POLY); /* Deal with projection points! */ if (LELTI(A1,PO_TYPE) == PO_POINT) { W = MPOLY(RED(Ap1),NIL,LIST1(LIST2(PT_PRJ,A1)),PO_POINT,PO_KEEP); P = COMP(W,P); continue; } /* Handle the leading coefficient! */ L = PLDCF(Ap1); Lh = NIL; t = 0; /* if (!PCONST(r - 1,L)) {*/ if (!VERIFYCONSTSIGN(r-1,IPIP(r-1,ISIGNF(PLBCF(r-1,L)),L),1,GVNA.W)) { W = MPOLY(L,NIL,LIST1(LIST3(PO_LCO,0,A1)),PO_OTHER,PO_KEEP); P = COMP(W,P); Lh = COMP(L,Lh); t = 1; } /* If r = 2 then we know the leading coefficient is always enough! */ if (r == 2) t = 0; /* If x_{r-1} is a bound variable, and the quantifier is either F or G, then we know we'll only be lifting over full dimensional cells so we don't have to add more coefficients! */ if (t) { j = r - GVNFV - 1; if (j > 0) { Q = LELTI(GVQ,j); /* Quantifier for x_{r-1} */ if (Q == FULLDE || Q == FULLDA) t = 0; } } /* If PCMZERROR is set to true, then we only need leading coefficients when projecting polynomials of level k+1 or lower. */ if (t && PCMZERROR && r <= GVNFV + 1) t = 0; /* If it can be determined that the system of coefficients is inconsistent ... we can stop with just the leading coeff! */ if (t) { j = CLOCK(); S = COEFSYS(r,Ap1); if (S == 1 || (Sp = SIMPLIFYSYSLIST(r-1,S,GVNA == NIL ? TRUE : GVNA.W)) == 1) t = 0; else { QepcadCls Q; Word G; for(t = 0; t == 0 && Sp != NIL; Sp = RED(Sp)) if ((G = SYSSOLVECAD(r-1,FIRST(Sp),GVNA == NIL ? TRUE : GVNA.W,GVVL,Q)) != NIL) { /* If there are finitely many solutions, add those points as projection points. */ if (ISLIST(G)) { for(Word Lp = G; Lp != NIL; Lp = RED(Lp)) { /* ADD POINTS to PROJECTION POLS! */ Word X = NIL; /* List of all sample points up to and inluding FIRST(G) */ Word c = Q.GVPC; for(Word I = LELTI(FIRST(Lp),INDX); I != NIL; I = RED(I)) { c = LELTI(LELTI(c,CHILD),FIRST(I)); Word s = LELTI(c,SAMPLE); X = COMP(ISPRIMIT(s) ? (LENGTH(s) > 3 ? FOURTH(s) : s) : s,X); } W = MPOLY(X,NIL,LIST1(LIST2(PT_NUL,A1)),PO_POINT,PO_KEEP); P = COMP(W,P); } } else t = 1; /* Instead of adding all the other coeffs, better to add system! */ } } j = CLOCK() - j; if (PCVERBOSE) { SWRITE("Coef consistency check took "); IWRITE(j); SWRITE("ms\n"); if (!t) SWRITE("Found system inconsistent for "); else SWRITE("Unable to determine consistency for "); IPDWRITE(r,Ap1,GVVL); SWRITE("\n"); } } /* Handle the rest of the coefficients as needed. */ i = 0; while (t) { Ap1 = PRED(Ap1); i++; L = PLDCF(Ap1); t = 0; if (Ap1 != 0) if (!PCONST(r - 1,L)) if (!IPFZT(r - 1,Lh)) { W = MPOLY(L,NIL,LIST1(LIST3(PO_LCO,i,A1)),PO_OTHER,PO_KEEP); P = COMP(W,P); Lh = COMP(L,Lh); t = 1; } } } Step2: /* Obtain discriminants. */ Ap = A; while (Ap != NIL) { ADV(Ap,&A1,&Ap); if (LELTI(A1,PO_TYPE) == PO_POINT) continue; if (PCEQC && LELTI(A1,PO_TYPE) != PO_ECON) continue; Ap1 = LELTI(A1,PO_POLY); if (PDEG(Ap1) >= 2) { D = IPDSCRQE(r,Ap1); W = MPOLY(D,NIL,LIST1(LIST4(PO_DIS,0,0,A1)),PO_OTHER,PO_KEEP); P = COMP(W,P); } } Step3: /* Obtain resultants. */ Ap = A; while (Ap != NIL) { ADV(Ap,&A1,&Ap); if (LELTI(A1,PO_TYPE) == PO_POINT) continue; Ap1 = LELTI(A1,PO_POLY); App = Ap; while (App != NIL) { ADV(App,&A2,&App); if (LELTI(A2,PO_TYPE) == PO_POINT) continue; if (PCEQC && LELTI(A1,PO_TYPE) != PO_ECON && LELTI(A2,PO_TYPE) != PO_ECON) continue; Ap2 = LELTI(A2,PO_POLY); R = IPRESQE(r,Ap1,Ap2); W = MPOLY(R,NIL,LIST1(LIST6(PO_RES,0,0,A1,0,A2)),PO_OTHER,PO_KEEP); P = COMP(W,P); } } Step4: /* Finish. */ P = INV(P); goto Return; Return: /* Prepare for return. */ return(P); }
Word QepcadCls::PROJHO(Word r, Word A) { Word A1,A2,Ap,Ap1,Ap2,App,D,L,L1,P,Ps,R,R1,R11,R2,Rp,Rp11,Rpp,Rs,Rs1, S1,T,W,ap1,b,d,i,k,w; Step1: /* $r = 2$. */ if (r > 2) goto Step2; P = NIL; Ap = A; while (Ap != NIL) { ADV(Ap,&A1,&Ap); if (PCEQC && LELTI(A1,PO_TYPE) != PO_ECON) continue; Ap1 = LELTI(A1,PO_POLY); W = MPOLY(PLDCF(Ap1),NIL,LIST1(LIST3(PO_LCO,0,A1)),PO_OTHER,PO_KEEP); P = COMP(W,P); if (PDEG(Ap1) >= 2) { D = IPDSCRQE(2,Ap1); W = MPOLY(D,NIL,LIST1(LIST4(PO_DIS,0,0,A1)),PO_OTHER,PO_KEEP); P = COMP(W,P); } } Ap = A; while (Ap != NIL) { ADV(Ap,&A1,&Ap); Ap1 = LELTI(A1,PO_POLY); App = Ap; while (App != NIL) { ADV(App,&A2,&App); if (PCEQC && LELTI(A1,PO_TYPE) != PO_ECON && LELTI(A2,PO_TYPE) != PO_ECON) continue; Ap2 = LELTI(A2,PO_POLY); T = IPRESQE(2,Ap1,Ap2); W = MPOLY(T,NIL,LIST1(LIST6(PO_RES,0,0,A1,0,A2)),PO_OTHER,PO_KEEP); P = COMP(W,P); } } P = INV(P); goto Return; Step2: /* Determine number of reducta needed for each $A_i$. */ Ap = A; R = NIL; while (Ap != NIL) { ADV(Ap,&A1,&Ap); Ap1 = LELTI(A1,PO_POLY); R1 = LIST1(Ap1); ap1 = PLDCF(Ap1); S1 = LIST1(ap1); b = PCONST(r - 1,ap1); d = 0; Ap1 = PRED(Ap1); while (!b && !d && Ap1 != 0) { R1 = COMP(Ap1,R1); ap1 = PLDCF(Ap1); b = PCONST(r - 1,ap1); if (!b) { S1 = COMP(ap1,S1); d = IPFZT(r - 1,S1); } Ap1 = PRED(Ap1); } R1 = INV(R1); R = COMP(R1,R); } R = INV(R); Step3: /* Process each $R_i$. */ P = NIL; Rp = R; Ap = A; while (Rp != NIL) { ADV(Rp,&R1,&Rp); ADV(Ap,&A1,&Ap); if (PCEQC && LELTI(A1,PO_TYPE) != PO_ECON) continue; S1 = NIL; i = 0; do { ADV(R1,&R11,&R1); W = MPOLY(PLDCF(R11),NIL,LIST1(LIST3(PO_LCO,i,A1)), PO_OTHER,PO_KEEP); P = COMP(W,P); if (PDEG(R11) >= 2) { Rp11 = IPDMV(r,R11); L = IPPSCT(r,R11,Rp11,S1); k = 0; while (L != NIL) { ADV(L,&L1,&L); W = MPOLY(L1,NIL,LIST1(LIST4(PO_DIS,k,i,A1)),PO_OTHER,PO_KEEP); P = COMP(W,P); k = k + 1; } S1 = COMP(PLDCF(R11),S1); } i++; } while (R1 != NIL); } Step4: /* Process pairs $R_i$, $R_j$. */ Rp = R; Ap = A; while (Rp != NIL) { ADV(Rp,&R1,&Rp); ADV(Ap,&A1,&Ap); Rpp = Rp; App = Ap; while (Rpp != NIL) { ADV(Rpp,&R2,&Rpp); ADV(App,&A2,&App); if (PCEQC && LELTI(A1,PO_TYPE) != PO_ECON && LELTI(A2,PO_TYPE) != PO_ECON) continue; if (LENGTH(R1) > LENGTH(R2)) { Ps = FIRST(R1); Rs = R2; w = 1; } else { Ps = FIRST(R2); Rs = R1; w = 0; } S1 = NIL; i = 0; while (Rs != NIL) { ADV(Rs,&Rs1,&Rs); if (PDEG(Rs1) >= 1) { if (w == 1) L = IPPSCT(r,Ps,Rs1,S1); else L = IPPSCT(r,Rs1,Ps,S1); k = 0; while (L != NIL) { ADV(L,&L1,&L); if (w == 1) W = MPOLY(L1,NIL,LIST1(LIST6(PO_RES,k,0,A1,i,A2)), PO_OTHER,PO_KEEP); else W = MPOLY(L1,NIL,LIST1(LIST6(PO_RES,k,i,A1,0,A2)), PO_OTHER,PO_KEEP); P = COMP(W,P); k++; } S1 = COMP(PLDCF(Rs1),S1); } i++; } } } Step5: /* Finish. */ P = INV(P); Return: /* Prepare for return. */ return(P); }
Word QepcadCls::PROJMC(Word r, Word A) { Word A1,A2,Ap,Ap1,Ap2,App,D,L,Lh,P,R,W,i,t; Step1: /* Obtain coefficients. */ P = NIL; Ap = A; while (Ap != NIL) { ADV(Ap,&A1,&Ap); if (PCEQC && LELTI(A1,PO_TYPE) != PO_ECON) continue; Ap1 = LELTI(A1,PO_POLY); L = PLDCF(Ap1); Lh = NIL; t = 0; if (!PCONST(r - 1,L)) { W = MPOLY(L,NIL,LIST1(LIST3(PO_LCO,0,A1)),PO_OTHER,PO_KEEP); P = COMP(W,P); Lh = COMP(L,Lh); t = 1; } i = 0; while (t) { Ap1 = PRED(Ap1); i++; L = PLDCF(Ap1); t = 0; if (Ap1 != 0) if (!PCONST(r - 1,L)) if (!IPFZT(r - 1,Lh)) { W = MPOLY(L,NIL,LIST1(LIST3(PO_LCO,i,A1)),PO_OTHER,PO_KEEP); P = COMP(W,P); Lh = COMP(L,Lh); t = 1; } } } Step2: /* Obtain discriminants. */ Ap = A; while (Ap != NIL) { ADV(Ap,&A1,&Ap); if (PCEQC && LELTI(A1,PO_TYPE) != PO_ECON) continue; Ap1 = LELTI(A1,PO_POLY); if (PDEG(Ap1) >= 2) { D = IPDSCRQE(r,Ap1); W = MPOLY(D,NIL,LIST1(LIST4(PO_DIS,0,0,A1)),PO_OTHER,PO_KEEP); P = COMP(W,P); } } Step3: /* Obtain resultants. */ Ap = A; while (Ap != NIL) { ADV(Ap,&A1,&Ap); Ap1 = LELTI(A1,PO_POLY); App = Ap; while (App != NIL) { ADV(App,&A2,&App); if (PCEQC && LELTI(A1,PO_TYPE) != PO_ECON && LELTI(A2,PO_TYPE) != PO_ECON) continue; Ap2 = LELTI(A2,PO_POLY); R = IPRESQE(r,Ap1,Ap2); W = MPOLY(R,NIL,LIST1(LIST6(PO_RES,0,0,A1,0,A2)),PO_OTHER,PO_KEEP); P = COMP(W,P); } } Step4: /* Finish. */ P = INV(P); goto Return; Return: /* Prepare for return. */ return(P); }
Word sacMain() { interval *A; Word P,t,L,n; SWRITE("Enter pol. in x: "); IPEXPREAD(1,LIST1(LFS("x")),&P,&t); CREAD(); I = LBRIREAD(); Step1: /* Convert the isolating interval for \alpha to a hardware interval. */ L = NIL; LBRNIEEEE(FIRST(I), &t,&F1,&n1); if (t != 0) goto Return; w1 = F1.num; LBRNIEEEE(SECOND(I), &t,&F2,&n2); if (t != 0) goto Return; w2 = F2.num; np = MIN(n1,n2); Step2: /* Convert the minimal polynomial to a hardware interval polynomial and refine the hardware interval. */ FPCATCH(); IUPHIP(P,&A,&t); if (t == 0) { t = 1; goto Return; } n = PDEG(M); t = HIPFES(n,A,w2); if (FPCHECK() == 1) { t = 1; goto Return; } if (t == NIL) { t = 2; goto Return; } u = 0; while (u == 0 && np > 0) { p = (w1 + w2) / 2.0; s = HIPFES(n,A,p); if ((FPCHECK() == 1) || (s == NIL)) u = 1; else if (s == t) w2 = p; else if (s == -t) w1 = p; else { w1 = p; w2 = p; } np = np - 1; } K.left = w1; K.right = w2; HIPFES(PDEG(P),A,x); return 0; }
void EC1(Word c, Word L, Word Bs) { Word B,I,J,Lp,M,N,S,Sp,P,a,b,kp,l,r,rp,s,xb,xp,Lp1,OL; /* hide kp,xp; */ Word T; Step1: /* Initialize. */ S = NIL; Lp = L; kp = 1; xp = 0; M = PMON(1,1); J = LIST2(0,0); Step2: /* No real root. */ if (Lp != NIL) goto Step3; a = CSSP(NIL,NIL); b = LIST1(a); s = LIST3(M,J,b); xp = xp + 1; xb = LIST1(xp); P = LIST1(0); Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,NIL); S = COMP(Sp,S); SLELTI(c,CHILD,S); goto Return; Step3: /* First sector. */ ADV(Lp,&Lp1,&Lp); FIRST3(Lp1,&B,&I,&OL); FIRST2(I,&l,&r); a = AFFRN(CSSP(NIL,l)); T = r; b = LIST1(a); s = LIST3(M,J,b); xp = xp + 1; xb = LIST1(xp); P = LIST1(0); Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,NIL); S = COMP(Sp,S); Step4: /* First section. */ if (PDEG(B) == 1) { a = IUPRLP(B); a = AFFRN(a); b = LIST1(a); s = LIST3(M,J,b); } else { a = AFGEN(); b = LIST1(a); s = LIST3(B,I,b); } xp = xp + 1; xb = LIST1(xp); P = LIST1(0); N = NIL; for(Word X = OL; X != NIL; X = RED(X)) { N = COMP(LIST2(THIRD(LELTI(FIRST(X),PO_LABEL)),1),N); } Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,N); S = COMP(Sp,S); Step5: /* Check if there are more roots. */ if (Lp == NIL) goto Step9; rp = r; Step6: /* Next sector. */ ADV(Lp,&Lp1,&Lp); FIRST3(Lp1,&B,&I,&OL); FIRST2(I,&l,&r); a = AFFRN(CSSP(T,l)); T = r; b = LIST1(a); s = LIST3(M,J,b); xp = xp + 1; xb = LIST1(xp); P = LIST1(0); Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,NIL); S = COMP(Sp,S); Step7: /* Next section. */ if (PDEG(B) == 1) { a = IUPRLP(B); a = AFFRN(a); b = LIST1(a); s = LIST3(M,J,b); } else { a = AFGEN(); b = LIST1(a); s = LIST3(B,I,b); } xp = xp + 1; xb = LIST1(xp); P = LIST1(0); N = NIL; for(Word X = OL; X != NIL; X = RED(X)) { N = COMP(LIST2(THIRD(LELTI(FIRST(X),PO_LABEL)),1),N); } Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,N); S = COMP(Sp,S); Step8: /* Loop. */ goto Step5; Step9: /* Last sector. */ a = AFFRN(CSSP(T,NIL)); b = LIST1(a); s = LIST3(M,J,b); xp = xp + 1; xb = LIST1(xp); P = LIST1(0); Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,NIL); S = COMP(Sp,S); Step10: /* Finalize. */ S = INV(S); SLELTI(c,CHILD,S); goto Return; Return: /* Prepare for return. */ return; }