/*int*/ /*Finds intervals of terms in PRESS*/ /*Alan Bundy 19.12.79*/ /*Revised version 14.3.80*/ /*Further revised 26.3.81*/ /**************************************/ /* Use interval information - top level*/ /**************************************/ /* Check that solution is admissible */ vet(A&B,A1&B1) :- !, vet(A,A1), vet(B,B1). vet(A#B,A1#B1) :- !, vet(A,A1), vet(B,B1). vet(A=B,A=B) :- find_int(A,IntA), find_int(B,IntB), overlap(IntA,IntB), !. vet(A=B,false). /* x interval is contained in second interval */ sub_int([Lx,Bx,Tx,Rx],[L,B,T,R]) :- opposite(L1,L), opposite(R1,R), less_than([B,L1],[Bx,Lx]), less_than([Tx,Rx],[T,R1]). /* Number N is contained in interval */ in(N,[L,B,T,R]) :- !, sub_int([closed,N,N,closed],[L,B,T,R]). /* X is positive, negative, acute, etc */ positive(X) :- find_int(X,[L,B,T,R]), !, less_than([0,closed],[B,L]). negative(X) :- find_int(X,[L,B,T,R]), !, less_than([T,R],[0,closed]). non_neg(X) :- find_int(X,[L,B,T,R]), !, less_than([0,open],[B,L]). non_pos(X) :- find_int(X,[L,B,T,R]), !, less_than([T,R],[0,open]). non_zero(X^N) :- non_zero(X), !. %ad hoc patch (replaces negative(N)) non_zero(X) :- find_int(X,[L,B,T,R]), !, (less_than([0,closed],[B,L]); less_than([T,R],[0,closed])). acute(X) :- find_int(X,[L,B,T,R]), !, less_than([0,open],[B,L]), less_than([T,R],[90,open]). obtuse(X) :- find_int(X,[L,B,T,R]), !, less_than([90,open],[B,L]), less_than([T,R],[180,open]). non_reflex(X) :- find_int(X,[L,B,T,R]), !, less_than([0,open],[B,L]), less_than([T,R],[180,open]). /****************************************** Manipulating Intervals ******************************************/ /*Combine list of intervals*/ /*-------------------------*/ /*basis*/ gen_combine([Int],Int) :- !. /*recursive step*/ gen_combine([Int1 | Rest], Int) :- gen_combine(Rest,Int2), !, combine(Int1,Int2,Int). /* Combine x and y intervals */ combine([Lx,Bx,Tx,Rx], [Ly,By,Ty,Ry], [L,B,T,R]) :- order([Tx,Rx],[Ty,Ry],_,[T,R]), order([Bx,Lx],[By,Ly],[B,L],_). /* Put boundaries in order */ order(Bnd,Bnd,Bnd,Bnd) :- !. %Boundaries are identical order([N,M1],[N,M2],[N,closed],[N,closed]) :- !. %One of Mis is closed order([N1,M1],[N2,M2],[N1,M1],[N2,M2]) :- eval(N1 < N2), !. %Numbers are different, N1 smallest order([N1,M1],[N2,M2],[N2,M2],[N1,M1]) :- !. %N2 is smallest /* x interval is wholly below y interval */ below([Lx,Bx,Tx,Rx],[Ly,By,Ty,Ry]) :- less_than([Tx,Rx],[By,Ly]), !. /* x and y intervals are disjoint */ disjoint(IntX,IntY) :- below(IntX,IntY), !. disjoint(IntX,IntY) :- below(IntY,IntX), !. /* x and y intervals overlap */ overlap(IntX,IntY) :- not disjoint(IntX,IntY), !. /* Ordering of boundaries (assumes intervals are consecutive)*/ less_than([X,Mx],[Y,My]) :- comb([Mx,My],M), ( M=closed -> eval(X true; assert(said(M)) & trace('I assume %t positive.\n',[M],1)). /* Default case */ find_int(X,[open,neginfinity,infinity,open]) :- !. /*************************************************************/ /* Find interval of function from intervals of its arguments */ /*************************************************************/ /* Simple case */ int_apply(F,Reg,Int) :- mono(F,Is,Mono), maplist(sub_int,Reg,Is), !, find_limits(F,Reg,Mono,Int). /* Complex Case */ int_apply(F,Reg,Int) :- mono(F,MReg,Mono), mlmaplist(split,[Reg,MReg,Ints1,Ints2]), make_regions(Ints1,Ints2,[Reg1|Regs]), maplist(int_apply(F),Regs,Ints), !, find_limits(F,Reg1,Mono,Int1), gen_combine([Int1|Ints],Int). /* Split interval into bit we can handle and remainder */ /* --------------------------------------------------- */ /* Intx wholly within Int */ split([Intx,Int,Intx,empty]) :- sub_int(Intx,Int), !. /* Intx and Int overlap with Intx leftmost */ split([[Lx,Bx,Tx,Rx], [L,B,T,R], [L,B,Tx,Rx], [Lx,Bx,B,L1]]) :- opposite(R,R1), opposite(L,L1), opposite(Rx,Rx1), opposite(Lx,Lx1), less_than([Tx,Rx],[T,R1]), less_than([B,L1],[Tx,Rx1]), less_than([Bx,Lx1],[B,L]), !. /* Make 2^n regions from subdivision of each interval */ /* -------------------------------------------------- */ /*basis*/ make_regions([],[],[[]]) :- !. /*recursive case when second interval is empty */ make_regions([Int1|Ints1],[empty|Ints2],Regs) :- !, make_regions(Ints1,Ints2,RegsA), maplist(append([Int1]),RegsA,Regs). /*recursive case when second interval is not empty*/ make_regions([Int1|Ints1],[Int2|Ints2],Regs) :- !, make_regions(Ints1,Ints2,RegsA), maplist(append([Int1]),RegsA,RegsB), maplist(append([Int2]),RegsA,RegsC), append(RegsB,RegsC,Regs). /* Calculate Bottom and Top of Interval */ /* ------------------------------------ */ find_limits(F,Reg,Mono,Int) :- bottom(F,Reg,Mono,[B,L]), top(F,Reg,Mono,[T,R]), ((T=undefined; B=undefined) -> Int=[open,neginfinity,infinity,open]; Int=[L,B,T,R]). bottom(F,Reg,Mono,Bot) :- mlmaplist(bot_bnds,[Reg,Mono,BotBnds]), calc(F,BotBnds,Bot). top(F,Reg,Mono,Top) :- mlmaplist(top_bnds,[Reg,Mono,TopBnds]), calc(F,TopBnds,Top). bot_bnds([[L,B,T,R],down,[T,R]]). bot_bnds([[L,B,T,R],up,[B,L]]). top_bnds([[L,B,T,R],down,[B,L]]). top_bnds([[L,B,T,R],up,[T,R]]). /* Apply Function F to Args */ /*--------------------------*/ calc(F,Args,[X,M]) :- maplist(markers,Args,Ms), comb(Ms,M), maplist(numbers,Args,Xs), Term =.. [F|Xs], eval(Term,X). /* Get Markers */ markers([N,M],M). /* Get Numbers */ numbers([N,M],N). /* Combine Boundary Markers */ comb(Ms,open) :- member(open,Ms), !. comb(Ms,closed). /**********************************************/ /* Monotonicity of Functions in each Interval */ /**********************************************/ /* unary minus */ mono(-, [[closed,neginfinity,infinity,closed]], [down]). /* addition */ mono(+,[[closed,neginfinity,infinity,closed], [closed,neginfinity,infinity,closed]], [up,up]). /* binary minus */ mono(-,[[closed,neginfinity,infinity,closed], [closed,neginfinity,infinity,closed]], [up,down]). /* absolute value */ mono(abs,[[closed,neginfinity,0,closed]], [down]). mono(abs,[[closed,0,infinity,closed]], [up]). /* multiplication */ mono(*,[[closed,0,infinity,closed], [closed,0,infinity,closed]], [up,up]). mono(*,[[closed,0,infinity,closed], [closed,neginfinity,0,closed]], [down,up]). mono(*,[[closed,neginfinity,0,closed], [closed,0,infinity,closed]], [up,down]). mono(*,[[closed,neginfinity,0,closed], [closed,neginfinity,0,closed]], [down,down]). /* division */ mono(/,[[closed,0,infinity,closed], [closed,0,infinity,closed]], [up,down]). mono(/,[[closed,0,infinity,closed], [closed,neginfinity,0,closed]], [down,down]). mono(/,[[closed,neginfinity,0,closed], [closed,0,infinity,closed]], [up,up]). mono(/,[[closed,neginfinity,0,closed], [closed,neginfinity,0,closed]], [down,up]). /* exponentiation */ mono(^,[[open,0,infinity,closed],[closed,0,infinity,closed]], [up,up]). mono(^,[[open,0,infinity,closed],[closed,neginfinity,0,closed]], [down,up]). /* logarithm */ mono(log,[[closed,0,infinity,closed],[closed,0,infinity,closed]], [down,up]). /* sine */ mono(sin,[[closed,(-90),90,closed]],[up]). mono(sin,[[closed,90,270,closed]],[down]). mono(sin,[[closed,270,450,closed]],[up]). /* cosine */ mono(cos,[[closed,0,180,closed]],[down]). mono(cos,[[closed,180,360,closed]],[up]). /* tangent */ mono(tan,[[open,(-90),90,open]],[up]). mono(tan,[[open,90,270,open]],[up]). mono(tan,[[open,270,450,open]],[up]). /* inverse sine */ mono(arcsin,[[closed,(-1),1,closed]],[up]). /* inverse cosine */ mono(arccos,[[closed,(-1),1,closed]],[down]). /* inverse tangent */ mono(arctan,[[open,neginfinity,infinity,open]],[up]). /* inverse cosecant */ mono(arccsc,[[closed,neginfinity,(-1),closed]],[down]). mono(arccsc,[[closed,1,infinity,closed]],[down]). /* inverse secant */ mono(arcsec,[[closed,neginfinity,(-1),closed]],[up]). mono(arcsec,[[closed,1,infinity,closed]],[up]). /* inverse cotangent */ mono(arccot,[[closed,neginfinity,0,open]],[down]). mono(arccot,[[open,0,infinity,closed]],[down]). /**************************************** Calculate Interval of Angle from Curve Type ********************************************/ /*Find interval that angle lies in */ classify(Angle ,Int ) :- measure(Q ,Angle ), angle(Point ,Q ,Curve ), !, interval(angle ,Curve ,Int ). classify(Angle ,Int ) :- measure(Q ,Angle ), incline(Curve ,Q ,Point ), !, interval(incline ,Curve ,Int ). /*Find interval from curve shape */ /*For simple curves */ interval(AI ,Curve ,Int ) :- concavity(Curve ,Conv ), slope(Curve ,Slope ), !, quad(AI ,Slope ,Conv ,Int ). /*For complex curve */ interval(AI ,Curve ,Int ) :- partition(Curve ,Clist ), !, maplist(interval(AI) ,Clist ,Rlist ), gen_combine(Rlist ,Int ). /*Find interval given slope and convavity */ quad(angle,left,right,[closed,0,90,closed]) :- !. quad(incline,left,right,[closed,90,180,closed]) :- !. quad(angle,right,right,[closed,90,180,closed]) :- !. quad(incline,right,right,[closed,180,270,closed]) :- !. quad(angle,left,left,[closed,180,270,closed]) :- !. quad(incline,left,left,[closed,270,360,closed]) :- !. quad(angle,right,left,[closed,270,360,closed]) :- !. quad(incline,right,left,[closed,0,90,closed]) :- !. quad(angle,left,stline,[open,180,270,open]) :- !. quad(incline,left,stline,[open,270,360,open]) :- !. quad(angle,right,stline,[open,270,360,open]) :- !. quad(incline,right,stline,[open,0,90,open]) :- !. quad(angle,hor,stline,[closed,270,270,closed]) :- !. quad(incline,hor,stline,[closed,0,0,closed]) :- !. quad(angle,vert,stline,[closed,180,180,closed]) :- !. quad(incline,vert,stline,[closed,270,270,closed]) :- !. /* JOBS TO DO change some 0s to -0s; eval to eva2; & to number notation write symbolic version for finding max/mins use monotonicity in > >= etc Isolation rules */