>>>>ARCH3PRB<<<< (Message 5) From: HELEN HPS (on ERCC DEC-10) Date: Wednesday, 16-Jan-85 14:05:54-GMT To: ecmi08@2972,Pain@EDXA Via: uk.ac.edinburgh.edxa ; (to uk.ac.edinburgh.emas) 16 Jan 85 14:09:59 gmt Msg ID: <132001-454-610@EDXA> -------- /* arch2.prb Winston arch domain Alan Bundy 5.12.80 use with winston */ /* space of description trees */ space(arch,[shapetree,touchtree,orienttree,directiontree,supporttree]). /* description tree */ tree(shapetree,1,shape(prism(wedge,block),pyramid)). tree(touchtree,2,touchrel(separate,touch(marries,abuts))). default(touchtree,separate). /* default predicate */ tree(orienttree,1,orientation(lying,standing)). tree(directiontree,2,direction(leftof,rightof)). tree(supporttree,2,undef(supports,unsupports)). /* Examples */ specimen(arch1, [block(a), block(b), block(c), standing(a), standing(b), lying(c), leftof(a,b), supports(a,c), supports(b,c), marries(a,c), marries(c,a), marries(b,c), marries(c,b)]). specimen(arch2, [block(a), block(b), wedge(c), standing(a), standing(b), lying(c), leftof(a,b), supports(a,c), supports(b,c), marries(a,c), marries(c,a), marries(b,c), marries(c,b)]). specimen(arch3, [block(a), block(b), block(c), standing(a), standing(b), lying(c), leftof(a,b), supports(a,c), supports(b,c), abuts(a,c), abuts(c,a), abuts(b,c), abuts(c,b)]). /* Near Misses */ specimen(archn1, [block(a), block(b), block(c), standing(a), standing(b), lying(c), leftof(a,b), supports(a,c), supports(b,c), marries(a,c), marries(c,a), marries(b,c), marries(c,b), marries(a,b), marries(b,a)]). specimen(archn2, [block(a), block(b), block(c), standing(a), standing(b), lying(c), leftof(a,b), marries(a,c), marries(c,a), marries(b,c), marries(c,b)]). specimen(archn3, [block(a), block(b), block(c), standing(a), standing(b), lying(c), leftof(a,b)]). -------- >>>>CLASSI<<<< (Message 8) From: HELEN HPS (on ERCC DEC-10) Date: Wednesday, 16-Jan-85 14:08:28-GMT To: ecmi08@2972,Pain@EDXA Via: uk.ac.edinburgh.edxa ; (to uk.ac.edinburgh.emas) 16 Jan 85 14:16:43 gmt Msg ID: <132001-455-533@EDXA> -------- /* classify1 Classify as example, non-example or grey Alan Bundy 7.7.82 */ classify(CObjs,VObjs,CDefn,VRec,ExDiff,yes) :- make_diff(CObjs,VObjs,CDefn,VRec,ExDiff,yes), !. classify(CObjs,VObjs,CDefn,VRec,BestDiff,grey) :- bagof(Diff, make_diff(CObjs,VObjs,CDefn,VRec,Diff,grey), Diffs), Diffs \== [], !, best(Diffs,BestDiff). classify(CObjs,VObjs,CDefn,VRec,NonExDiff,no) :- make_diff(CObjs,VObjs,CDefn,VRec,NonExDiff,no), !. /* Find the difference between example and concept */ make_diff(CObjs,VObjs,CDefn,CRec,Diff,Verdict) :- perm(CObjs,VObjs), pair_off(CDefn,CRec,Diff,Verdict). /*Pair off concept definition and example record to make differences */ pair_off([],[],[],_) :- !. pair_off([],ERec,Diff,Verdict) :- !, maplist(new_defn(Verdict),ERec,Diff). pair_off([define(Args,Name,UpPosn,LowPosn) | CDefn], ERec, [differ(Args,Name,UpPosn,ExPosn,LowPosn,Verdict1) | Diff], Verdict) :- select(record(Args,Name,ExPosn),ERec,Rest), !, compare(UpPosn,ExPosn,LowPosn,Verdict1), acceptable(Verdict,Verdict1), pair_off(CDefn,Rest,Diff,Verdict). pair_off([Define|CDefn], ERec, [Differ|Diff], Verdict) :- !, extra_rec(Verdict,Define,Differ), pair_off(CDefn,ERec,Diff,Verdict). /* invent new bits of definition as necessary */ new_defn(Verdict,record(Args,Name,ExPosn), differ(Args,Name,[],ExPosn,DfPosn,Verdict1)) :- default_posn(Name,DfPosn), compare([],ExPosn,DfPosn,Verdict1), acceptable(Verdict,Verdict1). /* invent extra bits of example record as necessary */ extra_rec(Verdict,define(Args,Name,UpPosn,LowPosn), differ(Args,Name,UpPosn,DfPosn,LowPosn,Verdict1)) :- default_posn(Name,DfPosn), compare(UpPosn,DfPosn,LowPosn,Verdict1), acceptable(Verdict,Verdict1). /* Find position of default predicate on tree */ default_posn(TreeName,Posn) :- default(TreeName,Pred), !, tree(TreeName,_,Tree), node_at(Pred,Tree,Posn). default_posn(TreeName,[]). /* Compare positions in tree to give verdict */ compare(U,E,L,anything(notno(yes))) :- append(L,_,E), !. compare(U,E,L,anything(notno(grey))) :- append(U,_,E), !. compare(U,E,L,anything(no)) :- !. /* What local verdicts indicate what global ones */ acceptable(yes,anything(notno(yes))). acceptable(grey,anything(notno(X))). acceptable(no,anything(X)). /* Find best difference and return it */ best(Diffs,Diff) :- !, maplist(score,Diffs,Scores), writef('Scores are %t \n',[Scores]), lowest(Diffs,Scores,Diff,Score). /* Return difference with lowest score */ lowest([Diff],[Score],Diff,Score) :- !. lowest([Diff1|Diffs], [Score1|Scores], Diff2, Score2) :- lowest(Diffs,Scores,Diff2,Score2), Score2>>>CONN<<<< (Message 2) From: HELEN HPS (on ERCC DEC-10) Date: Wednesday, 16-Jan-85 14:04:47-GMT To: ecmi08@2972,Pain@EDXA Via: uk.ac.edinburgh.edxa ; (to uk.ac.edinburgh.emas) 16 Jan 85 14:06:00 gmt Msg ID: <132001-454-275@EDXA> -------- /* CONN. Operator Declarations for Logical Connectives Alan Bundy 27.8.82 */ :- op(980,xfy,['->','<->']). /* implication and equivalence */ :- op(850,xfy,v). /* disjunction */ :- op(710,fy,~). /* negation */ -------- >>>>FOCUS<<<< (Message 9) From: HELEN HPS (on ERCC DEC-10) Date: Wednesday, 16-Jan-85 15:55:01-GMT To: ecmi08@2972,Pain@EDXA Via: uk.ac.edinburgh.edxa ; (to uk.ac.edinburgh.emas) 16 Jan 85 15:56:27 gmt Msg ID: <132001-523-442@EDXA> -------- /* focus1 Rational Reconstruction of Winston Learning Program Alan Bundy 1.12.80 Version for functions More Efficient Version 25.6.82 */ /* Top Level Program - learn new concept */ /* ------------------------------------- */ /*First time only accept an example */ focus(Concept) :- abolish(definition,3), writef('Please give me an example of a %t \n', [Concept]), read(Ex), nl, make_rec(Concept,Ex,CObjs,CRec,Pairs), checklist(gensym(plato),CObjs), writef('Idealizing objects as follows:\n\t%t\n',[Pairs]), maplist(add_ups,CRec,CDefn), assert(definition(Concept,CObjs,CDefn)), !, continue(Concept). /* Is grey area in definition eliminated? */ continue(Concept) :- definition(Concept,CObjs,CDefn), checklist(same,CDefn), !, writef('I have learnt the concept of %t now. \n', [Concept]). /*Subsequently accept either examples or near misses */ continue(Concept) :- writef('Please give me an example or near miss of a %t. \n', [Concept]), read(Ex), nl, writef('Is this example (yes./no.)? \n',[]), read(YesNo), nl, learn(Concept,Ex,YesNo), fail. continue(Concept) :- continue(Concept). /* try again */ /* add default upper bounds in concept record */ add_ups(record(Args,Name,Posn), define(Args,Name,[],Posn)). /* are upper and lower bound of concept definition the same? */ same(define(Args,Name,Posn,Posn)). /* learn from this example or near miss */ learn(Concept, Example, YesNo) :- !, definition(Concept,CObjs,CDefn), make_rec(Concept,Example,VObjs,VRec,Pairs), classify(CObjs,VObjs,CDefn,VRec,Diff,Verdict), writef('Pairing objects as follows:\n\t%t\n',[Pairs]), writef('I classify specimen as %t . \n', [Verdict]), learn1(Concept,Diff,YesNo,Verdict), !. /* Find out what grey areas still exist in concept */ grey(Concept) :- !, writef('Grey areas in %t are:\n',[Concept]), definition(Concept,CObjs,CDefn), checklist(grey1,CDefn). grey1(define(Args,Name,Posn,Posn)) :- !. grey1(Defn) :- !, write(Defn), nl. -------- >>>>INFER<<<< (Message 10) From: HELEN HPS (on ERCC DEC-10) Date: Wednesday, 16-Jan-85 15:55:21-GMT To: ecmi08@2972,Pain@EDXA Via: uk.ac.edinburgh.edxa ; (to uk.ac.edinburgh.emas) 16 Jan 85 15:58:01 gmt Msg ID: <132001-523-536@EDXA> -------- /* infer Inference package for focus program Alan Bundy 7.7.82 */ infer(Concept) :- /* to forward infer from current defn */ rule(Rule), /* find a rule */ eval(Concept,Rule,Conc), /* evaluate rule in current defn */ simp(Conc,New), /* simplify conclusion */ insert(Concept,New), /* insert new conclusion in defn */ infer_mess(New), /* announce inference */ fail. /* force backtracking */ infer(_). /* until no new inferences remain */ eval(Concept,record(Args,Tree,Posn),Ans) :- /* to evaluate record */ definition(Concept,CObjs,CDefn), /* get concept defn */ member(define(Args,Tree,UpPosn,LowPosn),CDefn), /* match define and record */ get_tv(Args,Tree,Posn,UpPosn,Ans). /* get truth value */ /* to evaluate record in definition */ get_tv(_,_,Posn,UpPosn,t) :- /* return true if */ append(Posn,_,UpPosn), !. /* Posn is above upper mark */ get_tv(_,_,Posn,UpPosn,f) :- /* return false if */ common(Posn,UpPosn,Comm), /* shared part of positions */ Comm \== Posn, /* is equal to neither */ Comm \== UpPosn, !. get_tv(Args,Tree,Posn,_,record(Args,Tree,Posn)). /* otherwise return input */ eval(Concept,Formula,Formula1) :- /* to evaluate anything else */ Formula =.. [Func|Args], /* break it apart */ Func \== record, /* check it is not a record */ maplist(eval(Concept),Args,Args1), /* recurse on its args */ Formula1 =.. [Func|Args1]. /* and put answer together */ /* to simplify formula */ simp(t,t) :- !. /* do nothing if formula is t */ simp(f,f) :- !. /* do nothing if formula is f */ simp(record(Args,Tree,Posn),record(Args,Tree,Posn)) :- !. /* do nothing if formula is record */ simp(P,Q) :- !, /* to simplify complex formula */ P =.. [Func|Args], /* break it apart */ maplist(simp,Args,Args1), /* recurse on its args */ P1 =.. [Func|Args1], /* put it together again */ simp1(P1,Q). /* and perform simplification to it */ simp1(P,Q) :- /* to simplify at top level */ simp2(P,Q), !. /* apply rules if possible */ simp1(P,P). /* otherwise do nothing */ /* simplification rules */ simp2(P v t, t). simp2(P v f, P). simp2(t v P, t). simp2(f v P, P). simp2(P & t, P). simp2(P & f, f). simp2(t & P, P). simp2(f & P, f). simp2(P <-> t, P). simp2(P <-> f, NP) :- simp1(~P,NP). simp2(t <-> P, P). simp2(f <-> P, NP) :- simp1(~P,NP). simp2(P -> t, t). simp2(P -> f, NP) :- simp1(~P,NP). simp2(t -> P, P). simp2(f -> P, t). simp2(~t, f). simp2(~f, t). insert(Concept,record(Args,Tree,Posn)) :- /* to use inferred record */ make_tv(Concept,t,record(Args,Tree,Posn)). /* make it true */ insert(Concept,~record(Args,Tree,Posn)) :- /* to use inferred negation */ make_tv(Concept,f,record(Args,Tree,Posn)). /* make it false */ make_tv(Concept,TV,Record) :- /* to make record have truth value TV */ definition(Concept,CObjs,CDefn), /* get old definition */ one_of(make_tv1(TV,Record),CDefn,New), /* alter it */ assert(definition(Concept,CObjs,New)), /* assert new version */ retract(definition(Concept,CObjs,CDefn)). /* remove old definition */ make_tv1(t,record(Args,Tree,Posn), /* to make a record true */ define(Args,Tree,UpPosn,LowPosn), /* get current tree */ define(Args,Tree,Posn,LowPosn)) :- /* and replace upper mark with record position */ discriminate_mess(Args,Tree,UpPosn,Posn). /* print message */ make_tv1(f,record(Args,Tree,Posn), /* to make a record false */ define(Args,Tree,UpPosn,LowPosn), /* get current tree */ define(Args,Tree,New,LowPosn)) :- /* and replace upper mark with */ common(Posn,LowPosn,Comm), /* common part of record posn and lower mark */ append(Comm,[ N|_],LowPosn), /* with one more step */ append(Comm,[N],New), /* towards lower mark */ discriminate_mess(Args,Tree,UpPosn,New). /* print message */ /* Announce Inference */ infer_mess(record(Args,Name,Posn)) :- /* to announce positive deduction */ tree(Name,_,Tree), /* work out what relation is infered */ position(Pred,Tree,Posn), Reln =.. [Pred|Args], writef('I infer that %t is true. \n', [Reln]). /* and print message */ infer_mess(~record(Args,Name,Posn)) :- /* to announce negative deduction */ tree(Name,_,Tree), /* work out what relation is infered */ position(Pred,Tree,Posn), Reln =.. [Pred|Args], writef('I infer that %t is false. \n', [Reln]). /* and print message */ -------- >>>>LEARN<<<< (Message 4) From: HELEN HPS (on ERCC DEC-10) 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]). -------- >>>>MAKERC<<<< (Message 3) From: HELEN HPS (on ERCC DEC-10) Date: Wednesday, 16-Jan-85 14:05:05-GMT To: ecmi08@2972,Pain@EDXA Via: uk.ac.edinburgh.edxa ; (to uk.ac.edinburgh.emas) 16 Jan 85 14:07:08 gmt Msg ID: <132001-454-365@EDXA> -------- /* make_rec Make records from list of relations Alan Bundy 7.7.82 */ make_rec(Concept,Example,VObjs,VRec,Pairs) :- !, specimen(Example,ERelns), gen_list(ERelns,VRelns,Pairs), maplist(second,Pairs,VObjs), maplist(convert,VRelns,VRec). /* Take list of terms and apply gen_term to each member */ gen_list([],[],[]). gen_list([ETerm|ERest], [VTerm|VRest], Pairs) :- gen_term(ETerm,VTerm,Pairs1), gen_list(ERest,VRest,Pairs2), union(Pairs1,Pairs2,Pairs). /* Take term, find all atoms in it and replace with variables, returning list of atom, variable pairs */ gen_term([],[],[]) :- !. gen_term(N,N,[]) :- integer(N), !. gen_term(Atom,Var,[pair(Atom,Var)]) :- atom(Atom), !. gen_term(EStruc,VStruc,Pairs) :- !, EStruc =.. [Func|EArgs], gen_list(EArgs,VArgs,Pairs), VStruc =.. [Func|VArgs]. /* take second argument of pair */ second(pair(F,S),S). /* Convert input relation style into internal representation as predicate tree */ convert(Reln, record(Args,Name,ExPosn)) :- Reln =.. [Pred|Args], length(Args,N), tree(Name,N,Tree), node_at(Pred,Tree,ExPosn). /* find nth element of list */ nth_el(1,[Hd|Tl],Hd). nth_el(N,[Hd|Tl],El) :- nth_el(PN,Tl,El), N is PN + 1. /* Find Position of Node in Tree */ node_at(Node,Tree,[]) :- Tree =.. [Node|SubTrees]. node_at(Node,Tree,[N|Posn]) :- Tree =.. [Root|SubTrees], nth_el(N,SubTrees,SubTree), node_at(Node,SubTree,Posn). -------- >>>>WINST<<<< (Message 1) From: HELEN HPS (on ERCC DEC-10) Date: Wednesday, 16-Jan-85 14:04:30-GMT To: ecmi08@2972,Pain@EDXA Via: uk.ac.edinburgh.edxa ; (to uk.ac.edinburgh.emas) 16 Jan 85 14:05:26 gmt Msg ID: <132001-454-212@EDXA> -------- /* winst Consulting all focussing files Alan Bundy 8.7.82 */ ?- [ conn, /* operator declarations */ focus, /* top level stuff */ makerc, /* make records from specimens */ classi, /* classify as exs, non-exs or grey */ learn /* and apply focussing */ ]. --------