File Preview

% nacteni:
/* ['11.1_16.pl']. */

%:-consult('11.1_16_pocasi_golf.pl').
%:-consult('11.1_16_naradi.pl').
:-consult('11.1_16_restaurace.pl').

% prevod z faktu na parametry
induce_tree( Tree)  :-
    findall( example( Class, Obj), example( Class, Obj), Examples),
    findall( Att, attribute( Att, _ ), Attributes),
    induce_tree( Attributes, Examples, Tree).

% induce_tree( Attributes , Examples, Tree)
induce_tree(_,[], null ) :- !.
induce_tree(_,[example( Class,_) | Examples], leaf( Class)) :- 
    \+ ((member(example( ClassX,_), Examples), ClassX \== Class)), !. % priklady stejne klasifikace
induce_tree(Attributes , Examples, tree( Attribute , SubTrees)) :-
    choose_attribute( Attributes , Examples, Attribute/_), ! ,
    del( Attribute , Attributes , RestAtts),
    attribute( Attribute , Values),
    induce_trees( Attribute , Values, RestAtts, Examples, SubTrees).
induce_tree(_, Examples, leaf( ExClasses)) :- % zadny uzitecny atribut, list s stribuci klasifikaci
    findall(Class, member( example( Class, _), Examples), ExClasses).
    
% induce_trees( Att, Values, RestAtts, Examples, SubTrees):
% najdi podstromy SubTrees pro podmnoziny prikladu Examples podle hodnot (Values) atributu Att
induce_trees(_, [],_,_, [] ). % No attributes, no subtrees
induce_trees( Att , [Val1 | Vals ], RestAtts, Exs, [Val1 : Tree1 | Trees]) :-
    attval_subset( Att = Val1, Exs, ExampleSubset),
    induce_tree( RestAtts, ExampleSubset, Tree1),
    induce_trees( Att , Vals, RestAtts, Exs, Trees).
    
% attval_subset(Attribute = Value, Examples, Subset):
% Subset je podmnozina prikladu z Examples, ktere splnuji podminku Attribute = Value
attval_subset( AttributeValue, Examples, ExampleSubset) :-
    findall(example(Class, Obj),
        (member( example( Class, Obj), Examples), satisfy( Obj, [ AttributeValue ])),
        ExampleSubset).

% slide 17

% satisfy( Object, Description)
satisfy( Object, Conj) :- \+ ((member( Att = Val, Conj), member( Att = ValX, Object), ValX \== Val)).

% choose_attribute( +Atts, +Examples, -BestAtt/BestGain) - vybirame atribut podle informacniho zisku
choose_attribute([], _, 0/0).
choose_attribute([Att], Examples, Att/Gain):-!, gain(Examples, Att, Gain).
choose_attribute([Att|Atts], Examples, BestAtt/BestGain):-
    choose_attribute(Atts,Examples,BestAtt1/BestGain1),
    gain(Examples, Att, Gain),
    (Gain>BestGain1,!,BestAtt=Att,BestGain=Gain;
    BestAtt=BestAtt1,BestGain=BestGain1).

% gain( +Examples, +Attribute, -Gain) - zisk atributu
gain( Exs, Att , Gain) :- attribute( Att , AttVals ),
	length(Exs, Total),
	setof(Class, X^example(Class,X), Classes),         % mnozina vsech Class, viz 'help(setof)'
	findall(Nc, (member(C,Classes), cntclass(C,Exs,Nc)), CCnts),
	info(CCnts,Total,I),
	rem(Att, AttVals,Exs,Classes,Total,Rem),
	Gain is I-Rem.

% info(+ValueCounts, +Total, -I) - mira informace
info([], _, 0).
info([VC|ValueCounts], Total, I) :-
	info(ValueCounts,Total,I1),
	(VC = 0, !, I is I1;
	Pvi is VC / Total,
	log2(Pvi, LogPvi), I is - Pvi * LogPvi + I1).

% rem( +Att, +AttVals, +Exs, +Classes, +Total, -Rem) - "zbytkova informace" po testu na vsechny hodnoty atributu Att
rem( _, [], _, _, _, 0).
rem( Att, [V | Vs], Exs, Classes, Total, Rem) :-
	findall(1, (member(example(_, AVs),Exs), member(Att = V, AVs)), L1), length(L1, Nv),
	findall(Ni, (member(C, Classes), cntclassattv(Att,V,C,Exs,Ni)), VCnts),
	Pv is Nv / Total,  % P(v)
	info(VCnts,Nv,I),
	rem(Att,Vs,Exs,Classes,Total,Rem1),
	Rem is Pv * I + Rem1.

% cntclass( +Class, +Exs, -Cnt) - pocet prikladu tridy Class
cntclass( Class, Exs, Cnt) :-
	findall(1, member(example(Class,_),Exs), L), length(L, Cnt).

% cntclass( +Att, +Val, +Class, +Exs, -Cnt) - pocet prikladu tridy Class pro hodnotu Val atributu Att
cntclassattv( Att, Val, Class, Exs, Cnt) :-
	findall(1, (member(example(Class,AVs),Exs), member(Att = Val, AVs)), L), length(L, Cnt).

% log2(+X, -Y)
log2(X, Y) :- Y is log(X) / log(2).

% ===================================================================

% show(+X,+L,-L1)
del(A,[A|T],T).
del(A,[H|T1],[H|T2]) :- del(A,T1,T2).

% show(+Tree)
show(Tree) :-
	show(Tree, 0).

% show(+Tree, +Ind)
show(leaf(Class), Ind) :-
    tab(Ind), write(Class), nl.
show(tree(A, SubTrees), Ind) :-
    tab(Ind), write(A), write('?'), nl,
    NI is Ind+2, show(SubTrees, NI).
show([], _).
show([_ : null | SubTrees], Ind) :- !, show(SubTrees, Ind).
show([V1 : ST1 | SubTrees], Ind) :-
    tab(Ind), write('= '), write(V1), nl,
    NI is Ind+2, show(ST1, NI),
    show(SubTrees, Ind).

:-induce_tree(T),show(T).