(Message 4)
From:     HELEN    HPS (on ERCC DEC-10) <Pain@EDXA>
Date:     Wednesday, 16-Jan-85 14:05:36-GMT
To:       ecmi08@2972,Pain@EDXA
Via:      uk.ac.edinburgh.edxa  ; (to uk.ac.edinburgh.emas) 16 Jan 85  14:08:35 gmt
Msg ID:   <132001-454-523@EDXA>

--------
/* learn1

Adjust definition  appropriately
Alan Bundy 7.7.82  */

/* if new example found */
learn1(Concept,Diff,yes,grey) :- !,
	writef('This is a new sort of %t. \n', [Concept]),
	maplist(lub,Diff,New),
	retract(definition(Concept,CObjs,Old)),
	assert(definition(Concept,CObjs,New)).

/* if near miss found */
learn1(Concept,Diff,no,grey) :- !,
	writef('This limits my idea of %t. \n', [Concept]),
	one_of(discriminate,Diff,Diff1),
	maplist(diff_to_defn,Diff1,New),
	retract(definition(Concept,CObjs,Old)),
	assert(definition(Concept,CObjs,New)).

/* if nothing new is discovered */
learn1(Concept,Diff,Agree,Agree) :- !,
	writef('I have seen one of these before. \n',[]).

/* or if contradiction is discovered */
learn1(Concept,Diff,Agree,Disagree) :- !,
	writef('Uh Oh, somethings gone wrong. I will think again.\n',[]),
	fail.

/* Move lower definition up a bit to include new example */
lub(differ(Args,Name,UpPosn,ExPosn,Old,anything(notno(grey))),
    define(Args,Name,UpPosn,New)) :- !,
	common(ExPosn,Old,New),
	generalize_mess(Args,Name,Old,New).

/* Lower definition already includes new example */
lub(differ(Args,Name,UpPosn,ExPosn,LowPosn,anything(notno(yes))),
    define(Args,Name,UpPosn,LowPosn)) :- !.

/* Move upper definition down a bit to exclude near miss */
discriminate(differ(Args,Name,Old,ExPosn,LowPosn,anything(notno(grey))),
    differ(Args,Name,New,ExPosn,LowPosn,anything(notno(grey)))) :- !,
	common(ExPosn,LowPosn,Comm), append(Comm,[N|_],LowPosn),
	append(Comm,[N],New),
	discriminate_mess(Args,Name,Old,New).

/* Take unnecessary bits out of difference  */
diff_to_defn(differ(Args,Name,UpPosn,ExPosn,LowPosn,Verdict),
             define(Args,Name,UpPosn,LowPosn)).


/* Find common initial sublist of two lists */
common([N|Rest1], [N|Rest2], [N|Rest]) :- !,
	common(Rest1,Rest2,Rest).

common(List1,List2,[]) :- !.

/* change just one member of list */
one_of(Prop, [Old|Tl], [New|Tl]) :- apply(Prop,[Old,New]).
one_of(Prop, [Hd|Old], [Hd|New]) :- one_of(Prop,Old,New).


/* Messages */

generalize_mess(Args,Name,Old,New) :-
	tree(Name,_,Tree),
	node_at(OldP,Tree,Old), OldR =.. [OldP|Args],
	node_at(NewP,Tree,New), NewR =.. [NewP|Args],
	writef('Moving lower mark from %t to %t. \n', [OldR,NewR]).

discriminate_mess(Args,Name,Old,New) :-
	tree(Name,_,Tree),
	node_at(OldP,Tree,Old), OldR =.. [OldP|Args],
	node_at(NewP,Tree,New), NewR =.. [NewP|Args],
	writef('Moving upper mark from %t to %t. \n', [OldR,NewR]).


--------
�