/*----------------------------------------------------*/
/*  Rule induction by search                          */
/*----------------------------------------------------*/
/*  (C) 2001 Zdravko Markov                           */
/*----------------------------------------------------*/
/*  Example format: example(ID, Class, [A=V,...]).    */
/*  Use:                                              */
/*   Create a set of rules:  ?- lrn.                  */
/*   Print rules:            ?- listing(if).          */
/*----------------------------------------------------*/
?-  op(100,fx,if).
?-  op(99,xfy,then).
/*----------------------------------------------------*/

lrn :-
    retractall(if _ then _),
    findall(E/C,example(_,C,E),Examples),
    lrn(Examples), !.

lrn([]) :- !.
lrn([E/C|T]) :- 
    example(Id,C,E), 
    write('Generalizing:     '),write(example(Id,C,E)), nl,
    findall(H/N,(generalize(E,H),
                 model(H,M),
                 \+ (member(X,M),example(X,C1,_),C\=C1),
                 length(H,N)),
            All),
    min(All,H/_),
    remove_subsumed(H,C), 
    assertz(if H then C),
    model(H,M),
    write('Hypothesis found: '),write(H),nl,
    write('Covered examples: '),write(M),nl,nl,
    remove_covered(T,H,R),
    lrn(R).

remove_covered([],_,[]) :- !.
remove_covered([E/_|T],H,L) :- 
    covers(H,E), !,
    remove_covered(T,H,L).
remove_covered([E|T],H,[E|L]) :- 
    remove_covered(T,H,L).

remove_subsumed(H,C) :-
    if H1 then C,
    sem_covers(H,H1),
    model(H1,M),
    write('*** Removing:     '), write(H1-M),nl,
    retract(if H1 then C),
    fail.
remove_subsumed(_,_).

generalize(H1,H2) :-
    length(H1,N),
    template(H2,N),
    sublist(H2,H1).

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).

model(C,M) :-
    atom(C), C\=[], !,
    setof(N,H^L^W^(if H then C,example(N,W,L),covers(H,L)),M).
model(H,M) :-
    findall(N,(example(N,_,L),covers(H,L)),M).

covers(H1,H2) :-
     subset(H1,H2).

sem_covers(H1,H2) :-
    model(H1,M1),
    model(H2,M2),
    subset(M2,M1).

subset([],_).
subset([X|T],L) :-
     member(X,L), !,
     subset(T,L).

min([X],X) :- !.
min([X/M|T],Y/N) :-
    min(T,Z/K),
    (M<K,Y/N=X/M;Y/N=Z/K), !.