/**
 * Author: R.Morelli, CPSC 352
 * vss.pl -- an implementation of the Version Space Search as described in
     Luger and Stubblefield. For this implementation, training instaces and
     concepts are represented as simple lists. For example, an instance of a
     large, white, ball would be [large,white,ball].  A minimally more general
     concept would be [X,white,ball]. The concept ball would be [X,Y,ball].

     The current implementation works, more or less, in the specific to general
     direction and in the general to specific direction, although these only work
     separately. 

     The vss/4 predicate is a partial implementation of the bi-directional search.
     It is lacking an adequate definition of delete_G_Specs/3, a predicate that will
     delete from G any hypothesis more specific than some hypothesis in S and
     delete_S_Gens/3, a predicate that will delete from S any hypothesis not more
     specific than some hypothesis in G.

     Many of the individual predicates have been tested independently and appear
     to be working correctly.
*/

/*
 * training_set(Positives,Negatives).
 */

%% training_set([[small,red,ball],[small,white,ball],[large,blue,ball]],[]).
%% training_set([[large,white,ball],[small,blue,ball]],[[small,red,brick],[large,blue,cube]]).
%%training_set([[small,red,ball],[large,red,ball]],[[small,blue,brick],[large,red,cube]]).
training_set([[small,red,ball],[large,blue,ball],[small,white,ball]],[[small,red,cube],[large,white,brick],[small,white,brick]]).

/*
 * get_alt_properties/2 provides a list of the alternate values for a property of a given
 *  value. In this example, the color property has three possible values: red, white, blue.
 */

get_alt_properties(small,[large]).
get_alt_properties(large,[small]).
get_alt_properties(white,[blue,red]).
get_alt_properties(red,[white,red]).
get_alt_properties(blue,[white,red]).
get_alt_properties(ball,[brick,cube]).
get_alt_properties(brick,[ball,cube]).
get_alt_properties(cube,[ball,brick]).

/*
 * do_vss is supposed to do the full version space search. It is not quite complete,
 *  as noted.
 */
do_vss :-
   training_set([P|Pos],Negs),
   vss([X,Y,Z],[P],Pos,Negs).

vss([],[],_,_) :- write('Sorry no concept convers all positives and none of negatives'),nl.
vss(G,S,[],[]) :- G==[C], H==[C],printlist(C),nl.

vss(G,S,[],[Neg|Negs]) :-           /* For each negative instance */
    delete_S(S,Neg,NewS),
    specialize(G,Neg,[],NewG),    
    delete_G_Specs(NewG,NewNewG),        /* This predicate is incomplete */
    delete_G_Pos(NewNewG,S,NewNewNewG),
    vss(NewNewNewG,NewS,[],Negs).

vss(G,S,[P1|Pos],Negs) :-           /* For each positive instance */
    delete_G(G,P1,NewG),
    generalize(S,P1,[],NewS),
    delete_S_Gens(NewS, NewNewS),   /* This predicate is incomplete */
    delete_S_Negs(NewNewS, G, NewNewNewS),
    vss(NewG,NewNewNewS,Pos,Negs).    
    
/*
 * do_spec_to_gen performs the candidate elimination algorithm in the specific to
 *  general direction. It starts with the first positive training instance and
 *  eliminates candidates that match negative instances and generalizes candidates
 *  that don't match positive instances.
 */

do_spec_to_gen :-
    training_set([P|Pos],Negs),
    spec_to_gen([P],[],Pos,Negs).

spec_to_gen(S, N, [], []) :-  printlist(S),nl. %% S is the learned concept

spec_to_gen(S, N, [], [Neg|Negs]) :-        /* For each negative instance */
    delete_S(S,Neg, NewS),
    spec_to_gen(NewS, [Neg|N], [], Negs).

spec_to_gen(S, N, [P|Pos], Negs) :-         /* For each positive instance */
    generalize(S, P, [], NewS),
    delete_S_Gens(NewS, NewNewS),
    delete_S_Negs(NewNewS, N, NewNewNewS),
    spec_to_gen(NewNewNewS,N, Pos, Negs).


/*
 * generalize(S,P,NewS).
 * For every element of S, if it does not match P, replace it with its
 *  most specific generalization that matches P.
 */

generalize([],P,NewS,NewS).
generalize([S1|Ss],P, OldSs, NewSs ) :-
              match(S1,P),
              generalize(Ss, P, [S1|OldSs], NewSs).
generalize([S1|Ss],P, OldSs, NewSs) :-
              more_general(S1,P,NewS1),
              generalize(Ss, P, [NewS1|OldSs], NewSs).
              
/*
 * more_general(S,P,NewS).
 * Replace S with a more general NewS that matches P.
 */

more_general([],[],[]).
more_general([H1|T1],[H2|T2],[H1|T3]) :-
    H1==H2,
    more_general(T1,T2,T3).
more_general([H1|T1],[H2|T2],[H1|T3]) :-
    var(H1),
    more_general(T1,T2,T3).
more_general([H1|T1],[H2|T2],[H3|T3]) :-
    atom(H1),
    more_general(T1,T2,T3).


/*
 * do_gen_to_spec performs the candidate elimination algorithm in the general to
 *  specific direction. It starts with the most general hypothesis and
 *  eliminates candidates that fail to match positive instances and specializes candidates
 *  that match negative instances.
 */
   
do_gen_to_spec :-
    training_set(Pos,Negs),
    gen_to_spec([[X,Y,Z]],[],Pos,Negs).

gen_to_spec(G, P, [], []) :-  printlist(G). %% G is the learned concept
gen_to_spec(G, P, [P1|Pos], []) :-
    delete_G(G,P1,NewG),
    gen_to_spec(NewG, [P1|P], Pos, []).
gen_to_spec(G, P, Pos, [Neg|Negs]) :-
    specialize(G,Neg,[],NewG),
    delete_G_Specs(NewG,NewNewG),
    delete_G_Pos(NewNewG,P,NewNewNewG),
    gen_to_spec(NewNewNewG,P,Pos,Negs).

/*
 * specialize(G,N,NewG).
 * For every element of G, if it matches N, replace it with its
 *  most general specializations that don't match N.
 */

specialize([],N,NewG,NewG).
specialize([G1|Gs],N, OldGs, NewGs ) :-
              match(G1,N),
              more_special(G1,N,NewG1s),
              append(NewG1s,OldGs,NewG1s),
              specialize(Gs, N, NewG1s, NewGs).
specialize([G1|Gs],N, OldGs, NewGs) :-
              specialize(Gs, N, [G1|OldGs], NewGs).

/*
 * more_special(G,N,NewGs).
 * Replace G with a more special NewG that don't match N.
 */

more_special(G,N,NewGs) :-
    generate_alt_prop_lists(G,N,[],Props),
    apply_prop_list(Props,[],G,[],NewGs).

/*
 * generate_alt_prop_lists/4 generates a list of alternative properties
 *  for a given concept. it is used in the Gen_to_specific search. For example, 
 *  in order to specialize the concept [large,Y,Z] relative to the negative instance
 *  [large,blue,cube], the algorithm needs the following list: [[],[white,red],[brick,ball]].
 *  The first element are the properties alternative to _large_ -- there are none because
 *  it cannot be specialized because it is already a constant. But the alternatives to
 *  _blue_ in the training instance are [white,red]. These are used to specialize the Y
 *  in the hypothesis.
 */

generate_alt_prop_lists([],[],Props,Props).
generate_alt_prop_lists([H1|T1],[H2|T2],Props,NewProps) :-
   atom(H1),H1==H2,
   append(Props,[[]],Props2),
   generate_alt_prop_lists(T1,T2,Props2,NewProps).
generate_alt_prop_lists([H1|T1],[H2|T2],Props,NewProps) :-
   var(H1),
   get_alt_properties(H2,AltProps),
   append(Props,[AltProps],Props2),
   generate_alt_prop_lists(T1,T2,Props2,NewProps).

/*
 * apply_prop_list/5 applies a property list of the form [[],[red,white],[brick,ball]]
 *  to the concept [large,Y,Z] resulting in a set of more specialized concepts that
 *  don't match a negative instance. The negative instance is represented by a Prefix
 *  and a Tail. So initially the instance [large,blue,cube] would be represented by
 *  [],[large,blue,cube], and as each value is processed, the prefix grows and the
 *  tail shrinks. Thus, [large],[blue,cube] would be the next case, and so on.
 */

apply_prop_list([],_,_,Gs,Gs).
apply_prop_list([[]|Ps],Pre,[H|T],GsIn,GsOut) :-
    append(Pre,[H],NewPre),
    apply_prop_list(Ps,NewPre,T,GsIn,GsOut).
apply_prop_list([PList|Ps],Pre,[H|T],GsIn,GsOut) :-
    apply(PList,Pre,H,T,[],G1s),
    append(Pre,[H],NewPre),
    append(GsIn,G1s,NewG1s),
    apply_prop_list(Ps,NewPre,T,NewG1s,GsOut).

apply([],_,_,_,Gs,Gs).
apply([H|T],Pre,Prop,Tail,GsIn,GsOut) :-
    append(Pre,[H],NewPre),
    append(NewPre,Tail,Gs),
    append(GsIn,[Gs],G1s),
    apply(T,Pre,Prop,Tail,G1s,GsOut).   

/*
 * delete_S(S,Neg,NewS).
 * Delete all members of S that match Neg giving NewS.
 */

delete_S([],_,[]).
delete_S([S1|Ss],Neg,NewS) :-
   match(S1,Neg),
   delete_S(Ss,Neg,NewS).
delete_S([S1|Ss],Neg,[S1|NewS]) :-
   delete_S(Ss,Neg,NewS).

/*
 * delete_G(G,Pos,NewG).
 * Delete all members of G that fail to match Pos giving NewG.
 */

delete_G([],_,[]).
delete_G([G1|Gs],Pos,NewG) :-
   not(match(G1,Pos)),
   delete_G(Gs,Pos,NewG).
delete_G([G1|Gs],Pos,[G1|NewG]) :-
   delete_G(Gs,Pos,NewG).


/*
 * delete_S_Gens(S, NewS).
 * Delete all members of S more general than some other hypothesis giving NewS.
 */
delete_S_Gens(S,S).

/*
 * delete_G_Specs(G, NewG).
 * Delete all members of G more specific than some other hypothesis in S giving NewG.
 */
delete_G_Specs(G,G).

/*
 * Delete all members of S that match a negative instance in N giving NewS.
 * delete_S_Negs(S, N, NewS).
 */
delete_S_Negs(S,[],S) :- !.
delete_S_Negs(S,[N|Negs],NewS) :-
   delete_S(S,N,S1),
   delete_S_Negs(S1,Negs,NewS).

/*
 * Delete all members of G that fail to match a positive instance in P giving NewG.
 * delete_S_Negs(S, N, NewS).
 */
delete_G_Pos(G,[],G) :- !.
delete_G_Pos(G,[P|Pos],NewG) :-
   delete_G(G,P,G1),
   delete_G_Pos(G1,Pos,NewG).


match([],[]).
match([H1|T1], [H2|T2]) :-
   H1==H2, match(T1,T2).
match([H1|T1], [H2|T2]) :-
   var(H1),atom(H2), match(T1,T2).
match([H1|T1], [H2|T2]) :-
   atom(H1),var(H2), match(T1,T2).
match([H1|T1], [H2|T2]) :-
   var(H1),var(H2), match(T1,T2).

not(P) :- call(P),!,fail.
not(P).
    
append([],Ys,Ys).
append([X|Xs],Ys,[X|Zs]) :- append(Xs,Ys,Zs).

printlist([]) :- nl.
printlist([H|T]) :- write(H), write(' '), printlist(T).