/*winst
Rational Reconstruction of Winston Learning Program
Alan Bundy 1.12.80
Version for functions */

/* Top Level Program - learn new concept */
/* ------------------------------------- */

/*First time only accept an example */
winston(Concept) :- !,
        writef('Please give me an example of a %t \n', [Concept]),
        read(Ex), nl,
        make_rec(Concept,Ex,EObjs,ERec),
        maplist(gensym1(plato),EObjs,CObjs),
        make_subst(EObjs,CObjs,Subst),
        subst(Subst,ERec,CRec),
        maplist(add_ups,CRec,CDefn),
        assert(definition(Concept,CObjs,CDefn)),
        winston1(Concept).

/* Is grey area in definition eliminated? */
winston1(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 */
winston1(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),
        winston1(Concept).

/* add default upper bounds in concept record */
add_ups(record(Args,Name,Posn), define(Args,Name,[],Posn)).


/* slight modify to gensym, so it can be used in maplist */
gensym1(Prefix,_,NewConst) :- !, gensym(Prefix,NewConst).


/* 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,EObjs,ERec),
        classify(CObjs,EObjs,CDefn,ERec,Diff,Verdict),
        learn1(Concept,Diff,YesNo,Verdict).


/* Make  records from list of relations */
/* ------------------------------------ */

make_rec(Concept,Example,EObjs,ERec) :- !,
        specimen(Example,Relns),
        maplist(consts_in,Relns,CL), flatten(CL,EObjs),
        maplist(convert,Relns,ERec).

/* Find all constants in terms */
consts_in([],[]).

consts_in(N,[]) :-
        integer(N), !.

consts_in(Const,[Const]) :-
        atom(Const), !.

consts_in(Exp,Consts) :-
        Exp =.. [Sym|Args], maplist(consts_in,Args,CL),
        flatten(CL,Consts).

/*Flatten List */
flatten([],[]).

flatten([Hd|Tl],Ans):-
        flatten(Tl,Rest), union(Hd,Rest,Ans).


/* 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),
        position(Pred,Tree,ExPosn).

/* Find Position of Node in Tree */
position(Node,Tree,[]) :-
        Tree =.. [Node|SubTrees].

position(Node,Tree,[N|Posn]) :-
        Tree =.. [Root|SubTrees],
        nth_el(N,SubTrees,SubTree),
        position(Node,SubTree,Posn).

/* 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.

/* Is this example, non-example or in grey area, by my definition? */
/* --------------------------------------------------------------- */

classify(CObjs,EObjs,CDefn,ERec,BestDiff,Verdict) :- !,
        findall(Diff, make_diff(CObjs,EObjs,CDefn,ERec,Diff), Diffs),
        best(Diffs,BestDiff),
        verdict(BestDiff,Verdict).

/* Find the difference between example and concept */
make_diff(CObjs,EObjs,CDefn,ERec,Diff) :- !,
        perm(EObjs,EObjs1), make_subst(EObjs1,CObjs,Subst),
        subst(Subst,ERec,ERec1),
        pair_off(CDefn,ERec1,Diff).

/*Pair off concept definition and example record to make differences */
pair_off([],[],[]) :- !.

pair_off([],ERec,Diff) :- !,
        maplist(new_defn,ERec,Diff).

pair_off(CDefn,[],Diff) :- !,
        maplist(extra_rec,CDefn,Diff).

pair_off([define(Args,Name,UpPosn,LowPosn) | CDefn],
         ERec,
         [differ(Args,Name,UpPosn,ExPosn,LowPosn,Verdict) | Diff]) :-
                select(record(Args,Name,ExPosn),ERec,Rest), !,
                compare(UpPosn,ExPosn,LowPosn,Verdict),
                pair_off(CDefn,Rest,Diff).

/* invent new bits of definition as necessary */
new_defn(record(Args,Name,ExPosn),
         differ(Args,Name,[],ExPosn,DfPosn,Verdict)) :-
                default_posn(Name,DfPosn),
                compare([],ExPosn,DfPosn,Verdict).

/* invent extra bits of example record as necessary */
extra_rec(define(Args,Name,UpPosn,LowPosn),
          differ(Args,Name,UpPosn,DfPosn,LowPosn,Verdict)) :-
                default_posn(Name,DfPosn),
                compare(UpPosn,DfPosn,LowPosn,Verdict).


/* Find position of default predicate on tree */
default_posn(TreeName,Posn) :-
        default(TreeName,Pred), !,
        tree(TreeName,_,Tree), position(Pred,Tree,Posn).

default_posn(TreeName,[]).


/* Compare positions in tree to give verdict */
compare(U,E,L,yes) :- append(L,_,E), !.
compare(U,E,L,grey) :- append(U,_,E), !.
compare(U,E,L,no) :- !.

/* Find best difference and return it */
best(Diffs,Diff) :- !,
        maplist(score,Diffs,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<Score1, !.

lowest([Diff|Diffs], [Score|Scores], Diff, Score) :- !.

/* Find score of difference */
score(Diff,Score) :- !,
        maplist(score1,Diff,Scores),
        sumlist(Scores,Score).

/* Find score of individual differ */
score1(differ(_,_,_,_,_,yes), 0) :- !.
score1(differ(_,_,_,_,_,grey), 1) :- !.
score1(differ(_,_,_,_,_,no), 2) :- !.

/* add up all the numbers in a list */
sumlist([], 0).
sumlist([N|Rest], Total) :- !,
        sumlist(Rest,SubT), Total is SubT + N.

/* Make a substitution for replacing all members of one list
by corresponding members of another list */
make_subst([],[],true).

make_subst([X|XRest],[Y|YRest],X=Y & Subst) :-
        make_subst(XRest,YRest,Subst).


/* Decide whether example falls inside definition on basis of differs */
verdict(Diff,yes) :- checklist(verdict1(yes),Diff), !.
verdict(Diff,no) :- some(verdict1(no),Diff), !.
verdict(Diff,grey) :- some(verdict1(grey),Diff), !.

/* verdict on individual differ */
verdict1(V, differ(_,_,_,_,_,V)).


/* adjust definition  appropriately */
/* -------------------------------- */

/* 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(exclude,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,grey),
    define(Args,Name,UpPosn,New)) :- !,
        common(ExPosn,Old,New).

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

/* Move upper definition down a bit to exclude near miss */
exclude(differ(Args,Name,Old,ExPosn,LowPosn,grey),
    differ(Args,Name,New,ExPosn,LowPosn,grey)) :- !,
        common(ExPosn,LowPosn,Comm), append(Comm,[N|_],LowPosn),
        append(Comm,[N],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).


/* 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.