yap-6.3/Logtalk/examples/birds/expert.lgt

:- object(expert,
	imports(protected::descriptors)).


	:- info([
		author is 'Paulo Moura',
		version is 1.1,
		date is 2005/3/6,
		comment is 'Expert system for bird identification.',
		source is 'Example adopted from an Amzi! Inc Prolog book.']).


	:- public(identify/0).

	:- mode(identify, one).

	:- info(identify/0,
		[comment is 'Starts a bird identification session.']).


	:- private(known_/3).
	:- dynamic(known_/3).

	:- mode(known_(?nonvar, ?nonvar, ?nonvar), zero_or_more).

	:- info(known_/3, [
		comment is 'Table of already known facts.',
		argnames is ['Answer', 'Attribute', 'Value']]).


	identify :-
		::retractall(known_(_, _, _)),
		write('Bird identification expert system'), nl, nl,
		forall(
 			(order::leaf(Bird), check(Bird)),
			(nl, write('Possible identification: '), write(Bird), nl)),
		nl, write('No (more) candidates found.').


	check(Bird) :-
		forall(
			(::descriptor(Functor/Arity),
			 functor(Predicate, Functor, Arity),
			 Bird::Predicate),
			call(Predicate)).


	bill(X):-
		ask(bill, X).

	cheek(X):-
		ask(cheek, X).

	color(X):-
		ask(color, X).

	eats(X):-
		ask(eats, X).

	feed(X):-
		ask(feed,X).

	feet(X):-
		ask(feet, X).

	flight(X):-
		menuask(flight, X, [ponderous, powerful, agile, flap_glide, other]).

	flight_profile(X):-
		menuask(flight_profile, X, [flat, v_shaped, other]).

	head(X):-
		ask(head,X).

	live(X) :-
		ask(live, X).

	neck(X):-
		ask(neck, X).

	nostrils(X):-
		ask(nostrils, X).

	size(X):-
		menuask(size, X, [large, plump, medium, small]).

	tail(X):-
		menuask(tail, X, [narrow_at_tip, forked, long_rusty, square, other]).

	throat(X):-
		ask(throat, X).

	voice(X):-
		ask(voice,X).

	wings(X):-
		ask(wings, X).


	ask(Attribute,Value):-
		::known_(yes, Attribute, Value),
		!.

	ask(Attribute,Value):-
		::known_(_, Attribute, Value),
		!, fail.

	ask(Attribute,_):-
		::known_(yes, Attribute, _),
		!, fail.

	ask(Attribute, Value):-
		write(Attribute), write(': '), write(Value),
		write('? (yes or no): '),
		read(Answer),
		::asserta(known_(Answer, Attribute, Value)),
		Answer = yes.


	menuask(Attribute,Value, _):-
		::known_(yes, Attribute, Value),
		!.

	menuask(Attribute, _, _):-
		::known_(yes, Attribute, _),
		!, fail.

	menuask(Attribute, AskValue, Menu):-
		nl, write('What is the value for '), write(Attribute), write('?'), nl,
		display_menu(Menu),
		write('Enter the number of choice> '),
		read(Num),nl,
		pick_menu(Num, AnswerValue, Menu),
		::asserta(known_(yes,Attribute,AnswerValue)),
		AskValue = AnswerValue.


	display_menu(Menu):-
		display_menu(Menu, 1).


	display_menu([], _).

	display_menu([Item| Rest], N):-
		write(N), write(' : '), write(Item), nl,
		NN is N + 1,
		display_menu(Rest, NN).


	pick_menu(N, Val, Menu):-
		integer(N),
		pic_menu(1, N, Val, Menu), !.

	pick_menu(Val, Val, _).


	pic_menu(_, _, none_of_the_above, []).

	pic_menu(N, N, Item, [Item| _]).

	pic_menu(Ctr, N, Val, [_| Rest]):-
		NextCtr is Ctr + 1,
		pic_menu(NextCtr, N, Val, Rest).


:- end_object.