/*----------------------------------------------------------*/
/*  Induction by Search (SICStus Prolog 3)                  */
/*----------------------------------------------------------*/
/*  (C) 1998 Zdravko Markov                                 */
/*----------------------------------------------------------*/
lrn(H,Mode) :-
    lrn([],H1,Mode),
    not_covered(H1,H).

lrn(CH,FH,Mode) :-
    example(_,C,E),
    \+ covers(CH,[C|E]), !,
    find_hypothesis(Mode,[C|E],[C|H]),
    lrn([[C|H]|CH],FH,Mode).
lrn(FH,FH,_).

covers([[C|H]|_],[C|H]) :- !.
covers([_|T],E) :-
    covers(T,E).

not_covered(H,H1) :-
    del([C|X],H,R),
    forall(example(I,C,X),(member([C|Y],R),example(I,C,Y))), !,
    not_covered(R,H1).
not_covered(H,H).

find_hypothesis(gen,E,H) :- !,
    gen_search(E,H).
find_hypothesis(spec,[C|E],H) :- !,
    top_element(E,Top),
    spec_search([C|Top],[C|E],H).

gen_search(E,H) :-
    generalize(E,H1), !,
    gen_search(H1,H).
gen_search(H,H).

spec_search([C|H],_,[C|H]) :-
    forall(example(_,C1,H),C1==C), !.
spec_search(H,E,FH) :-
    specialize(H,E,H1), !,
    spec_search(H1,E,FH).

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

generalize([C|X],[C|Y]) :-
%   variabilize(X,Y),
    findall(Y/Cover,(variabilize(X,Y),cover([C|Y],Cover)),All),
    max(All,Y/_),
    forall(example(_,C1,Y),C1==C).
%   write_tree(All,X).

specialize([C|X],[C|E],[C|Y]) :-
%   instantiate(X,E,Y).
    findall(Y/Acc,(instantiate(X,E,Y),accuracy([C|Y],Acc)),All),
    max(All,Y/_).
%   write_tree(All,X).

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

instantiate([X|T],[Y|_],[Y|T]) :-
    var(X).
instantiate([X|T],[_|V],[X|W]) :-
    instantiate(T,V,W).

cover([C|H],Cover) :-
    findall(I,example(I,C,H),L),
    length(L,Cover).

accuracy([C|H],Accuracy) :-
    findall(I,example(I,_,H),L1),
    length(L1,Cover),
    findall(I,example(I,C,H),L2),
    length(L2,TP),
    Accuracy is TP/Cover.

/*----------------------------------------------------------*/
/*    Testing                                               */
/*----------------------------------------------------------*/
av_test(SampleSize,NoOfTests,Mode,AverageAccuracy) :-
    mtest(NoOfTests,SampleSize,Mode,Tests),
    sum(Tests,Sum),
    AverageAccuracy is Sum/NoOfTests.

mtest(0,_,_,[]) :- !.
mtest(N,Set,Mode,[A|T]) :-
    test(Set,Mode,A), write(A), nl,
    M is N-1,
    mtest(M,Set,Mode,T).

test(SampleSize,Mode,Accuracy) :-
    dbase2list(Set),
    sample(SampleSize,Set,Sample),
    list2dbase(Sample),
    lrn(Hypothesis,Mode),
    retractall(example(_,_,_)),
    list2dbase(Set),
    test(Hypothesis,OK),
    length(Set,N),
    Accuracy is OK/N.

dbase2list([example(I,C,E)|T]) :-
    retract(example(I,C,E)), !,
    dbase2list(T).
dbase2list([]).

list2dbase([]).
list2dbase([E|T]) :-
    assertz(E),
    list2dbase(T).

test(H,_) :-
    example(_,C,E),
    check([C|E],H),
    inc_ok,
    fail.
test(_,OK) :-
    retract(ok(OK)).

check([C|E],Hs) :-
    \+ \+ member([C|E],Hs),
    forall(member([C1|E],Hs),C1==C), !.

inc_ok :-
    retract(ok(N)),
    M is N+1,
    assertz(ok(M)), !.
inc_ok :-
    assertz(ok(1)).

sample(Percent,Set,Sample) :-
    length(Set,N),
    SampleSize is (Percent*N) // 100,
    generate_sample(SampleSize,Set,Sample).

generate_sample(0,_,[]) :- !.
generate_sample(N,Set,[E|Sample]) :-
    length(Set,S),
    S1 is S+1,
    random(1,S1,R),
    efface_n(R,E,Set,Rest),
    M is N-1,
    generate_sample(M,Rest,Sample).

/*----------------------------------------------------------*/
/*   Auxilliary Procedures                                  */
/*----------------------------------------------------------*/
member(X,[X|_]).
member(X,[_|T]) :-
    member(X,T).

del(X,[X|T],T).
del(X,[Y|T],[Y|V]) :-
    del(X,T,V).

forall(G,C) :-
    \+((G,\+(C))).

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

efface_n(1,E,[E|T],T) :- !.
efface_n(N,E,[X|T],[X|R]) :-
    M is N-1,
    efface_n(M,E,T,R).

random(A,B,V) :-
   retract(seed(X)), !,
   Y is (25173*X+13849) mod 65536,
   asserta(seed(Y)),
   V is integer(Y*(B-A)/65536)+1.
random(A,B,V) :-
   statistics(runtime,[T,_]),
   Y is T mod 65536,
   assertz(seed(Y)),
   V is integer(Y*(B-A)/65536)+1.

sum([],0).
sum([X|T],S) :-
   sum(T,S1),
   S is X+S1.

write_tree([],_).
write_tree([A/E|T],R) :- 
    write1(R), write(' -> '),
    write1(A), write(' '), write([label=E]), write(' ;'), nl,
    write_tree(T,R).

write1(T) :- 
    numbervars(T,0,_),
    write('"'), write(T), write('"'), 
    fail.
write1(_).
