/*evans*/
/*Evan's Geometric Analogy Program - Rational Reconstruction*/
/*Alan Bundy 26.10.79*/


/*top level program*/
evans(FigA,FigB,FigC,AnsList,Ans) :-
        find_rule(FigA,FigB,Rule), rule_is(Rule),
        apply_rule(Rule,FigC,AnsObjs,AnsRels,Sims),
        ans_desc(AnsObjs,AnsRels,Sims),
        select_result(FigC,AnsList,AnsObjs,AnsRels,Sims,Ans),
        ans_is(Ans).


/*find rule given figures*/
find_rule(FigA,FigB,Rule) :-
        relations(FigA,Source), relations(FigB,Target),
        objects(FigA,Alist), objects(FigB,Blist),
        similarities(FigA,FigB,Triples),
        select_set(Triples,Matches),
        takeaway1(Alist,Matches,Removals),
        takeaway2(Blist,Matches,Adds),
        make_rule(Removals,Adds,Matches,Source,Target,Rule).

/* Apply rule to figc to produce answer*/
apply_rule(rule(Removals,Adds,Matches,Source,Target),
                 FigC, AnsObjs,Target,Matches) :-
        relations(FigC,FigDesc), objects(FigC,ObList),
        seteq(FigDesc,Source),
        maplist(second,Matches,NewList), append(NewList,Adds,AnsObjs).

/* Select Result from those provided */
select_result(FigC,[FigN|Rest],AnsObjs,AnsRels,AnsSims,FigN) :-
        relations(FigN,NRels), seteq(NRels,AnsRels),
        similarities(FigC,FigN,NSims), seteq(NSims,AnsSims),
        objects(FigN,NObjs), seteq(NObjs,AnsObjs).

select_result(FigC,[FigN|Rest],AnsObjs,AnsRels,AnsSims,Ans) :-
        select_result(FigC,Rest,AnsObjs,AnsRels,AnsSims,Ans).


/*select legal subset of similarity triples for matches*/
select_set(Triple,Match) :- select_set1([],[],Triple,Match).

select_set1(Aused,Bused,[],[]).

select_set1(Aused,Bused,[[Aobj,Bobj,Trans]|Rest],[[Aobj,Bobj,Trans]|Rest1]) :-
        not(member(Aobj,Aused)), not(member(Bobj,Bused)),
        select_set1([Aobj|Aused],[Bobj|Bused],Rest,Rest1).

select_set1(Aused,Bused,[[Aobj,Bobj,Trans]|Rest],Rest1) :-
        select_set1(Aused,Bused,Rest,Rest1).


/*take away the triples from the list*/
takeaway1(List,Triples,Ans) :-
        maplist(first,Triples,Firsts), subtract(List,Firsts,Ans).

takeaway2(List,Triples,Ans) :-
        maplist(second,Triples,Seconds), subtract(List,Seconds,Ans).

/* First and second elements of a list */
first([A,B,C],A).
second([A,B,C],B).


/* Make rule from descriptions inherited from figs a & b*/
make_rule(Removals,Adds,Matches,Source,Target,Rule) :-
        maplist(first,Matches,Spairs), maplist(second,Matches,Tpairs),
        append(Removals,Spairs,L1), append(L1,Tpairs,L2),
        append(L2,Adds,Consts),
        unbind(Consts,Substs),
        subst(Substs,rule(Removals,Adds,Matches,Source,Target),Rule).

/*find corresponding variable for each constant and produce substitution*/
unbind([],true).

unbind([Const|Rest],Const=X & Rest1) :-
        unbind(Rest,Rest1).


/* Messages */
/*----------*/

rule_is(rule(Removals,Adds,Matches,Source,Target)) :-
        writef('Rule is:
        remove: %t
        add: %t
        match: %t
        source: %t
        target: %t \n\n', [Removals,Adds,Matches,Source,Target]).

ans_desc(Objs,Rels,Sims) :-
        writef('Answer description is:
        objects: %t
        relations: %t
        similarities: %t \n\n', [Objs,Rels,Sims]).

ans_is(Ans) :-
        writef('Answer is %t\n\n\n',[Ans]).