/*--------------------------------------------------------*/
/*  Rule Induction by Set Covering (Sicstus Prolog)       */
/*--------------------------------------------------------*/
/*  (C) 1994 Zdravko Markov                               */
/*--------------------------------------------------------*/
/*  Call: lrn                                             */
/*--------------------------------------------------------*/
?- op(100,fx,if).
?- op(99,xfy,then).
/*--------------------------------------------------------*/
lrn :-
    initialize,
    build_sets,
    class(Class,Examples),
    write('Processing class' - Class/Examples),nl,
    lrn(Class,Cover),
    write('Cover' = Cover),nl,
    assert_rules(Cover,Class),
    fail.
lrn.

lrn(Class,GeneralRules) :-
    class(Class,Examples),
    cover(Examples,Examples,Rules), !,
    remove_subsumed(Rules,GeneralRules).

initialize :-
    retractall(class(_,_)),
    retractall(attribute(_,_)),
    retractall(if(_)), !.

cover([],_,[]).
cover([E|Es],Examples,[Rule/CoverSet|Rules]) :-
    example(E,_,L), !,
    combine(Rule,L),
    intersect(Rule,CoverSet),
    subset(CoverSet,Examples), !,
    difference(Es,CoverSet,Rest),
    cover(Rest,Examples,Rules).

remove_subsumed([],[]) :- !.
remove_subsumed([_/Cover|Rest],Rules) :-
    subsumed(Cover,Rest), !,
    remove_subsumed(Rest,Rules).
remove_subsumed([Rule/_|Rest],[Rule|Rules]) :-
    remove_subsumed(Rest,Rules).

subsumed(X,[_/Y|_]) :-
    subset(X,Y), !.
subsumed(X,[_|T]) :-
    subsumed(X,T).

build_sets :-
    example(E,C,L),
    class_sets(E,C),
    member_all(A=V,L),
    attribute_sets(E,A=V),
    fail.
build_sets.

class_sets(E,C) :-
    retract(class(C,L)),
    asserta(class(C,[E|L])), !.
class_sets(E,C) :-
    asserta(class(C,[E])).

attribute_sets(E,A=V) :-
    retract(attribute(A=V,L)),
    asserta(attribute(A=V,[E|L])), !.
attribute_sets(E,A=V) :-
    asserta(attribute(A=V,[E])).

assert_rules([],_) :- !.
assert_rules([Cond|T],Class) :-
    assertz(if Cond then Class),
    assert_rules(T,Class).

/*------------------- Auxiliary --------------------------*/
intersect([X],A) :-
    attribute(X,A), !.
intersect([X|T],C) :-
    intersect(T,B), !,
    attribute(X,A),
    intersect2(A,B,C).

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

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

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

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

efface(X,[X|T],T) :- !.
efface(X,[Y|T],[Y|L]) :-
   efface(X,T,L).

combine(S,L) :-
   length(L,N),
   gen_list(S,N),
   sublist(S,L).

gen_list(_,0) :- !,fail.
gen_list([_],_).
gen_list([_|T],N) :-
    M is N-1,
    gen_list(T,M).

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

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