File contents

/*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<Y); eval(X=<Y) ).


/*open and closed are opposites*/
opposite(open,closed).
opposite(closed,open).


/****************************************/
/* X lies in closed or open interval*/
/****************************************/

/* Convert ^(-1) to 1/ */
find_int(X^(-1), Int) :- !,
	find_int(1/X, Int).

/* Deal with exponentials to even power */
find_int(X^N, [L,B,T,R]) :- 
	even(N), !,
	find_int(abs(X), [Lx,Bx,Tx,Rx]),
	calc(^,[[Bx,Lx],[N,closed]],[B,L]),
	calc(^,[[Tx,Rx],[N,closed]],[T,R]).

/* Convert cosecant to sine */
find_int(csc(X), Int) :- !, find_int(1/sin(X), Int).

/* Convert secant to cosine */
find_int(sec(X), Int) :- !, find_int(1/cos(X), Int).

/* Convert cotangent to tangent */
find_int(cot(X), Int) :- !, find_int(1/tan(X), Int).

/* General Case */
/* Use monotonicity of F to calculate interval of Term from Args */
find_int(Term,Int) :-
	not atomic(Term), Term =.. [F|Args],
	maplist(find_int,Args,Reg),
	int_apply(F,Reg,Int).


/* Boundedness of sin, cos, etc */
find_int(sin(X), [closed,(-1),1,closed]) :- !.
find_int(cos(X), [closed,(-1),1,closed]) :- !.


/* numbers have point interval */
find_int(X,[closed,X,X,closed]) :- number(X), !.

/* interval known from type of curve*/
find_int(X,Int) :- atom(X), classify(X,Int), !.

/* ad hoc patch for gravity - proper solution means allowing
equations between quantities and defining g as measure(g,32,ft/sec^2) */
find_int(g,[open,1,infinity,open]) :- !.

/* All quantities assumed positive (NB change defn of drop!!) */
find_int(M,[open,0,infinity,open]) :- measure(Q,M), quantity(Q), !,
	(said(M) -> 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
*/