%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                                                      %
%   Prolog programs from Chapter 9 of the book         %
%   SIMPLY LOGICAL: Intelligent reasoning by example   %
%   (c) Peter A. Flach/John Wiley & Sons, 1994.        %
%                                                      %
%   Predicates: induce_rlgg/2                          %
%               theta_subsumes/2                       %
%               anti_unify/3                           %
%               theta_lgg/3                            %
%   Modifications and extensions: Zdravko Markov, 2004 %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%% 9.1  Generalisation and specialisation %%%

theta_subsumes((H1:-B1),(H2:-B2)):-
	\+((H1=H2,ground(B2),
	\+(subset(B1,B2)))).

:-op(600,xfx,'<-').

anti_unify(Term1,Term2,Term):-
	anti_unify(Term1,Term2,Term,[],S1,[],S2).

anti_unify(Term1,Term2,Term1,S1,S1,S2,S2):-
	Term1 == Term2,!.
anti_unify(Term1,Term2,V,S1,S1,S2,S2):-
	subs_lookup(S1,S2,Term1,Term2,V),!.
anti_unify(Term1,Term2,Term,S10,S1,S20,S2):-
	nonvar(Term1),nonvar(Term2),
	functor(Term1,F,N),functor(Term2,F,N),!,
	functor(Term,F,N),
	anti_unify_args(N,Term1,Term2,Term,S10,S1,S20,S2).
anti_unify(Term1,Term2,V,S10,[Term1<-V|S10],S20,[Term2<-V|S20]).

anti_unify_args(0,Term1,Term2,Term,S1,S1,S2,S2).
anti_unify_args(N,Term1,Term2,Term,S10,S1,S20,S2):-
	N>0,N1 is N-1,
	arg(N,Term1,Arg1),
	arg(N,Term2,Arg2),
	arg(N,Term,Arg),
	anti_unify(Arg1,Arg2,Arg,S10,S11,S20,S21),
	anti_unify_args(N1,Term1,Term2,Term,S11,S1,S21,S2).

subs_lookup([T1<-V|Subs1],[T2<-V|Subs2],Term1,Term2,V):-
	T1 == Term1,
	T2 == Term2,!.
subs_lookup([S1|Subs1],[S2|Subs2],Term1,Term2,V):-
	subs_lookup(Subs1,Subs2,Term1,Term2,V).

% ?-anti_unify(2*2=2+2,3*2=3+3,T,[],S1,[],S2).
% T = X*2=X+X
% S1 = [2<-X]
% S2 = [3<-X]

theta_lgg((H1:-B1),(H2:-B2),(H:-B)):-
	anti_unify(H1,H2,H,[],S10,[],S20),
	theta_lgg_bodies(B1,B2,[],B,S10,S1,S20,S2).

theta_lgg_bodies([],B2,B,B,S1,S1,S2,S2).
theta_lgg_bodies([L|B1],B2,B0,B,S10,S1,S20,S2):-
	theta_lgg_literal(L,B2,B0,B00,S10,S11,S20,S21),
	theta_lgg_bodies(B1,B2,B00,B,S11,S1,S21,S2).

theta_lgg_literal(L1,[],B,B,S1,S1,S2,S2).
theta_lgg_literal(L1,[L2|B2],B0,B,S10,S1,S20,S2):-
	same_predicate(L1,L2),
	anti_unify(L1,L2,L,S10,S11,S20,S21),
	theta_lgg_literal(L1,B2,[L|B0],B,S11,S1,S21,S2).
theta_lgg_literal(L1,[L2|B2],B0,B,S10,S1,S20,S2):-
	\+(same_predicate(L1,L2)),
	theta_lgg_literal(L1,B2,B0,B,S10,S1,S20,S2).

%%% same_predicate/2: see file 'library'

% theta_lgg((element(c,[b,c]):-[element(c,[c])]),
%           (element(d,[b,c,d]):-[element(d,[c,d]),element(d,[d])]),
%           C).
% C = element(X,[b,c|Y]):-[element(X,[X]),element(X,[c|Y])]

/*==================================================================*/

%%% 9.2  Bottom-up induction %%%

induce_rlgg(Exs,Clauses):-
	pos_neg(Exs,Poss,Negs),
	(clause(bg_model(BG),true); BG=[]), !,
	append(Poss,BG,Model),
	induce_rlgg(Poss,Negs,Model,Clauses).

induce_rlgg(Poss,Negs,Model,Clauses):-
	covering(Poss,Negs,Model,[],Clauses).

% split positive and negative examples
pos_neg([],[],[]).
pos_neg([+E|Exs],[E|Poss],Negs):-
	pos_neg(Exs,Poss,Negs).
pos_neg([-E|Exs],Poss,[E|Negs]):-
	pos_neg(Exs,Poss,Negs).

% covering algorithm
covering(Poss,Negs,Model,H0,H):-
	construct_hypothesis(Poss,Negs,Model,Hyp),!,
	remove_pos(Poss,Model,Hyp,NewPoss),
	covering(NewPoss,Negs,Model,[Hyp|H0],H).
covering(P,N,M,H0,H):-
	append(H0,P,H).	% add uncovered examples to hypothesis

% remove covered positive examples
remove_pos([],M,H,[]).
remove_pos([P|Ps],Model,Hyp,NewP):-
	covers_ex(Hyp,P,Model),!,
	write('  Covered example: '),write(P),nl,
	remove_pos(Ps,Model,Hyp,NewP).
remove_pos([P|Ps],Model,Hyp,[P|NewP]):-
	remove_pos(Ps,Model,Hyp,NewP).


% extensional coverage, relative to a ground model
% the original verison does not work with non-generative clauses
% => fixed (ZM)
covers_ex((Head:-Body),Example,Model):-
%  try((Head=Example,forall(element(L,Body),element(L,Model)))). Wrong !!!
   try((Head=Example,subset(Body,Model))).

% construct a clause by means of RLGG
construct_hypothesis([E1,E2|Es],Negs,Model,Clause):-
	nl,write('RLGG of '),write(E1),write(' and '),write(E2),write(' is '),
	rlgg(E1,E2,Model,Cl),
	reduce(Cl,Negs,Model,Clause),!,
	nl,write('  '), clausify(Clause,CL), portray_clause(CL),nl.
construct_hypothesis([E1,E2|Es],Negs,Model,Clause):-
	write(' too general'), nl, write('  Adding: '), write(E1), nl,
	construct_hypothesis([E2|Es],Negs,Model,Clause).


% rlgg(E1,E2,M,C) <- C is RLGG of E1 and E2 relative to M

rlgg(E1,E2,M,(H:-B)):-
    theta_lgg((E1:-M),(E2:-M),(H:-B1)),
    var_delete(H,B1,B).

% remove redundant literals
reduce((H:-B0),Negs,M,(H:-B)):-
        reduce_ground(B0,M,B1),
        reduce_negs(H,B1,B,Negs,M).     % ZM
%       reduce_negs(H,B1,[],B,Negs,M).  % Original

/* ZM */
reduce_negs(H,Literals,Body,Negs,Model) :-
   length(Literals,N),
   template(Body,N),
   sublist(Body,Literals),
   \+(covers_neg((H:-Body),Negs,Model,_)).

/* ZM */
reduce_ground([],_,[]) :- !.
reduce_ground([L|T],M,V) :- var_element(L,M), !, reduce_ground(T,M,V).
reduce_ground([L|T],M,[L|V]) :- reduce_ground(T,M,V).

% reduce_negs(H,B1,B0,B,N,M) <- B is a subsequence of B1
%                               such that H:-B does not
%                               cover elements of N
reduce_negs(H,[L|B0],In,B,Negs,M):-
	append(In,B0,Body),
	\+(covers_neg((H:-Body),Negs,M,N)), !,
	reduce_negs(H,B0,In,B,Negs,M).
reduce_negs(H,[L|B0],In,B,Negs,M):-
	reduce_negs(H,B0,[L|In],B,Negs,M).
reduce_negs(H,[],Body,Body,Negs,M):-
	\+(covers_neg((H:-Body),Negs,M,N)).

covers_neg(Clause,Negs,Model,N):-
	element(N,Negs),
	covers_ex(Clause,N,Model).


/*=================== Utility predicates =========================*/

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                                                      %
%   Prolog programs from Appendix A.2 of the book      %
%   SIMPLY LOGICAL: Intelligent reasoning by example   %
%   (c) Peter A. Flach/John Wiley & Sons, 1994.        %
%                                                      %
%   Predicates: element/2                              %
%               append/3                               %
%               remove_one/3                           %
%               subset/2                               %
%               proper_subset/2                        %
%               var_element/2                          %
%               var_remove_one/3                       %
%               var_proper_subset/2                    %
%               disj_element/2                         %
%               conj_append/3                          %
%               disj_append/3                          %
%               conj_remove_one/3                      %
%               copy_term/2                            %
%               copy_element/2                         %
%               try/1                                  %
%               same_predicate/2                       %
%                                                      %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Lists and sets

% element(X,Ys) <- X is an element of the list Ys
element(X,[X|Ys]).
element(X,[Y|Ys]):-
	element(X,Ys).

% append(Xs,Ys,Zs) <- list Zs is Xs followed by Ys
append([],Ys,Ys).
append([X|Xs],Ys,[X|Zs]):-
	append(Xs,Ys,Zs).

% remove_one(X,Ys,Zs) <- Zs is list Ys minus one occurrence of X
remove_one(X,[X|Ys],Ys).
remove_one(X,[Y|Ys],[Y|Zs]):-
	remove_one(X,Ys,Zs).

% subset(Xs,Ys) <- every element of list Xs occurs in list Ys
subset([],Ys).
subset([X|Xs],Ys):-
	element(X,Ys),
	subset(Xs,Ys).

% proper_subset(Xs,Ys) <- Xs is a subset of Ys, and Ys contains
%                         at least one element more
proper_subset([],Ys):-
	\+(Ys=[]).
proper_subset([X|Xs],Ys):-
	remove_one(X,Ys,Ys1),
	proper_subset(Xs,Ys1).

var_element(X,[Y|Ys]):-
	X == Y.	% syntactic identity
var_element(X,[Y|Ys]):-
	var_element(X,Ys).

var_remove_one(X,[Y|Ys],Ys):-
	X == Y.	% syntactic identity
var_remove_one(X,[Y|Ys],[Y|Zs]):-
	var_remove_one(X,Ys,Zs).

var_proper_subset([],Ys):-
	\+(Ys=[]).
var_proper_subset([X|Xs],Ys):-
	var_remove_one(X,Ys,Zs),
	var_proper_subset(Xs,Zs).


%%% Conjunctions and disjunctions.

disj_element(X,X):-	% single-element disjunction
	\+(X=false),
	\+(X=(One;TheOther)).
disj_element(X,(X;Ys)).
disj_element(X,(Y;Ys)):-
	disj_element(X,Ys).

conj_append(true,Ys,Ys).
conj_append(X,Ys,(X,Ys)):-	% single-element conjunction
	\+(X=true),
	\+(X=(One,TheOther)).
conj_append((X,Xs),Ys,(X,Zs)):-
	conj_append(Xs,Ys,Zs).

disj_append(false,Ys,Ys).
disj_append(X,Ys,(X;Ys)):-	% single-element disjunction
	\+(X=false),
	\+(X=(One;TheOther)).
disj_append((X;Xs),Ys,(X;Zs)):-
	disj_append(Xs,Ys,Zs).

conj_remove_one(X,X,true):-	% single-element conjunction
	\+(X=true),
	\+(X=(One,TheOther)).
conj_remove_one(X,(X,Ys),Ys).
conj_remove_one(X,(Y,Ys),(Y,Zs)):-
	conj_remove_one(X,Ys,Zs).


copy_element(X,Ys):-
	element(X1,Ys),
	copy_term(X1,X).

% try(Goal) <- Goal succeeds, but variables are not instantiated
try(Goal):-
	\+(\+(Goal)).


%%% Various.

% same_predicate(L1,L2) <- literals L1 and L2 have
%                          the same predicate and arity
same_predicate(L1,L2):-
	functor(L1,P,N),functor(L2,P,N).

varsin1(T,[]) :- atomic(T), !.
varsin1(V,[V]) :- var(V), !.
varsin1(T,Vars) :- T =.. [_|Args],
                  varsin_args(Args,Vars).

varsin_args([],[]).
varsin_args([A|T],V) :- varsin1(A,V1), !,
                        varsin_args(T,V2),
                        append(V1,V2,V).

varsin(T,V) :- varsin1(T,V1), single_out(V1,V).

single_out([],[]).
single_out([X|T],R) :- var_element(X,T), !, single_out(T,R).
single_out([X|T],[X|R]) :- single_out(T,R).

% Built-in SWI Prolog
% forall(G,C) :- \+((G,\+(C))). 

otherwise.

clausify((Head:-[]),Head) :- !.
clausify((Head:-BodyList),(Head:-Body)) :-
   clsf(BodyList,Body).

clsf([X],X) :- !.
clsf([X|T],(X,V)) :-
   clsf(T,V).

var_delete(_,[],[]):- !.
var_delete(X,[Y|Ys],Zs):-
	X == Y, !,
        var_delete(X,Ys,Zs).	
var_delete(X,[Y|Ys],[Y|Zs]):-
	var_delete(X,Ys,Zs).

/* ZM */
template(_,0) :- !, fail.
template([_],_).
template([_|T],N) :-
    M is N-1,
    template(T,M).

sublist([X],[X|_]).
sublist(X,[_|T]) :-
    sublist(X,T).
sublist([X|T],[X|V]) :-
    sublist(T,V).