% -*- Prolog -*-
%
% ID3-ish decision tree inductor.
%
% Written purely for the hell of it. Most of this is flogged directly
% from Bratko, although there is much hacking involved due to the lack
% of built in predicates.
%
% Peter Gammie, peteg@cse.unsw.edu.au, sometime in 1999.
% $Id: 091,v 1.4 2000/08/26 14:02:58 peteg Exp $

:- dynamic(queue/1).

%
% Attributes are ground facts that look like:
%
%  attribute(AttributeName, [Values]).
%
% where AttributeName is the name of the attribute, and the Valuei's are 
% the possible values of it.
%

%
% Examples are ground facts of the form:
%
%  example(ExampleName, [attribute(AttributeName, Value)]).
%
% interpreted to mean ExampleName has attributes (and values) as listed.
%

%
% induce_tree(Tree)
%
% A convenience front end that collects the attributes and examples into
% lists for use by the real inductor.
%
induce_tree(Tree) :-
 	collect_examples_attributes(Attributes, Examples),
	induce_tree(Attributes, Examples, Tree).
%	write(Examples), nl, write(Attributes), nl.

collect_examples_attributes(Attributes, Examples) :-
 	findall(AttributeName, attribute(AttributeName, _), Attributes),
	findall(example(Class, Values), example(Class, Values), Examples).

%
% induce_tree(Attributes, Examples, Tree)
%
% Given a set of Examples and Attributes, build a decision tree. See
% Bratko for more details.
%

induce_tree(_, [], null) :- !.
induce_tree(_, [example(Class, _)|Examples], leaf(Class)) :-
	same_class(Class, Examples), !.
induce_tree(Attributes, Examples, tree(Attribute, SubTrees)) :-
	choose_attribute(Attributes, Examples, Attribute),
	delete(Attribute, Attributes, RestAttributes),
	attribute(Attribute, Values),
	induce_trees(Attribute, Values, RestAttributes, Examples, SubTrees).

% All examples in the list are of the same class.
same_class(_, []) :- !.
same_class(Class, [example(Class, _)|Examples]) :-
	same_class(Class, Examples).

%
% induce_trees(Attribute, Values, RestAttributes, Examples, SubTrees)
%
% Induce the subtrees assuming we split the Examples on this Attribute.
%
induce_trees(_, [], _, _, []) :- !.
induce_trees(Attribute, [Value|Values], RestAttributes, Examples, [vt(Value, Tree)|Trees]) :-
	example_subset(attribute(Attribute, Value), Examples, ExampleSubset),
	induce_tree(RestAttributes, ExampleSubset, Tree),
	induce_trees(Attribute, Values, RestAttributes, Examples, Trees).

% Extract Examples with this Value for that Attribute.
example_subset(A, Examples, ExampleSubset) :-
	findall(example(Class, Values),
		satisfy(A, Examples, Class, Values),
		ExampleSubset).

% This Example has this Value for that Attribute.
satisfy(A, [example(Class, Values)|Examples], Class, Values) :-
	member(A, Values).
satisfy(A, [_|Examples], Class, Values) :-
	satisfy(A, Examples, Class, Values).

% Dumb way to choose attributes.
%choose_attribute([Attribute|Attributes], Examples, Attribute).

% Choose the "best" attribute according to some metric (small is good).
choose_attribute(Attributes, Examples, Attribute) :-
	select_attribute(Attributes, Examples, ba(none, 999999), Attribute).
%	write("Selected: "), write(Attribute), nl.

select_attribute([], _, ba(BestAttribute, _), BestAttribute) :- !.
select_attribute([Attribute|Attributes], Examples, ba(A, Best), BestAttribute) :-
	ires(Attribute, Examples, Res),
%	write(Attribute), write(": "), write(Res), nl,
	Res < Best,
	select_attribute(Attributes, Examples, ba(Attribute, Res), BestAttribute), !.
select_attribute([_|Attributes], Examples, BA, BestAttribute) :-
	select_attribute(Attributes, Examples, BA, BestAttribute).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%
% Information-theoretic heuristic for selecting attribute.
%  More info in Bratko.
%
%  ires(Attribute) = - sum(attribute_values) (p(v) * sum(classes) Tlg(T))
%
% Initial implementation is proof-of-concept. Efficiency - forget it.

%
% Compute the residual information if we split these Examples on this
% Attribute. Smaller is better.
%
ires(Attribute, Examples, Res) :-
	findall(Class, example(Class, _), Classes),
 	attribute(Attribute, Values),
%	write(Attribute), write(": "), write(Values), nl,
%	write("Examples: "), write(Examples), nl,
	ires_values(Attribute, Values, Classes, Examples, Res0),
	Res is 0 - Res0.

%
% Sum over all values: ires_classes(value)
%
ires_values(_, [], _, _, 0) :- !.
ires_values(Attribute, [Value|Values],  Classes, Examples, Res) :-
	ires_values(Attribute, Values,  Classes, Examples, Res0),
	prob_val(attribute(Attribute, Value), Examples, ProbVal),
%	write("ProbVal: "), write(ProbVal), nl,
	ires_classes(attribute(Attribute, Value), Classes, Examples, ProbVal, IRes0),
%	write(Attribute), write(" = "), write(Value), write(": "), write(IRes0), nl,
	Res is Res0 + ProbVal * IRes0.

%
% Sum over all classes: Tlg(T), where  T = p(v, c) / p(v)
%
ires_classes(_, [], _, _, 0) :- !.
ires_classes(AttributeVal, [Class|Classes], Examples, ProbVal, IRes) :-
	ProbVal > 0,
	prob_val_class(AttributeVal, Class, Examples, ProbValClass),
%	write(Class), write(": "), write(AttributeVal), write(": "), write("ProbValClass: "), write(ProbValClass), nl,
	ProbValClass >  0,
	T is ProbValClass / ProbVal,
	IRes1 is (T * log(T)) / log(2),
	ires_classes(AttributeVal, Classes, Examples, ProbVal, IRes0),
	IRes is IRes0 + IRes1, !.
ires_classes(AttributeVal, [Class|Classes], Examples, ProbVal, IRes) :-
	ires_classes(AttributeVal, Classes, Examples, ProbVal, IRes).

%
% Probability of a Value for an Attribute (= attribute(Attribute, Value))
% in these Examples
%
% p(v) in Bratko.
%
prob_val(AttributeVal, Examples, Prob) :-
	length(Examples, Number),
	Number > 0,
	example_subset(AttributeVal, Examples, ExampleSubset),
	length(ExampleSubset, Count),
	Prob is Count / Number, !.
prob_val(_, _, 0).

%
% Probability of a Value for an Attribute (= attribute(Attribute, Value))
% and Class occurring in the same object in these Examples.
%
% p(v, c) in Bratko.
%
prob_val_class(AttributeVal, Class, Examples, Prob) :-
	length(Examples, Number),
	Number > 0,
	class_subset(Class, Examples, Examples0),
	example_subset(AttributeVal, Examples0, ExampleSubset),
	length(ExampleSubset, Count),
	Prob is Count / Number, !.
prob_val_class(_, _, _, 0).

% Extract all examples from the specified class
class_subset(_, [], []) :- !.
class_subset(Class, [example(Class, Values)|Examples], [example(Class, Values)|Examples0]) :-
	class_subset(Class, Examples, Examples0), !.
class_subset(Class, [_|Examples], Examples0) :-
	class_subset(Class, Examples, Examples0).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%
% print_tree(Tree)
%
% Pretty-print a tree. Standard stuff.
%
print_tree(Tree) :-
	print_tree(Tree, 0), !.

print_tree([], _).
print_tree(tree(Attribute, Tree), Indent) :-
	Indent2 is Indent + 1,
	tab(Indent), write("Attribute: "), write(Attribute), nl,
	print_tree(Tree, Indent2),
	print_tree(Trees, Indent).
print_tree(leaf(Class), Indent) :-
	tab(Indent), write("Class: "), write(Class), nl.
print_tree(null, Indent) :-
	tab(Indent), write("(null)"), nl.
print_tree([vt(Value, Tree)|Trees], Indent) :-
	Indent2 is Indent + 2,
	tab(Indent), write("Value: "), write(Value), nl,
	print_tree(Tree, Indent2),
	print_tree(Trees, Indent).
print_tree([leaf(Class)|Trees], Indent) :-
	tab(Indent), write("Class: "), write(Class), nl,
	print_tree(Trees, Indent).
print_tree(_, _) :-
	write("case not handled."), nl.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Support predicates for a fledgling Prolog.

% delete/3: Remove an element from a list.
delete(X, [X|Xs], Xs).
delete(X, [Y|Ys], [Y|Z]) :- delete(X, Ys, Z).

% usual findall/3 predicate.
findall(X, Goal, _) :-
	call(Goal),
	assertz(queue(X)),
	fail.
findall(_, _, Xlist) :-
	assertz(queue(bottom)),
	collect(Xlist), !.

collect(L) :-
	retract(queue(X)), !,
	new_list(X, L).

new_list(bottom, []).
new_list(X, [X|L1]) :-
	collect(L1).

% length/2: accumulator effort.
length(List, Length) :-
	length(List, 0, Length).

length([], L0, L0).
length([_|Xs], L, L0) :-
	L1 is L + 1,
	length(Xs, L1, L0).

% member/2: an old friend.
member(X, [X|_]).
member(X, [_|Ys]) :- member(X, Ys).

% not/1: It's easier in prolog than native.
not(X) :- call(X), !, fail.
not(X).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% test code.
attribute(size, [small, large]).
attribute(shape, [long, compact, other]).
attribute(holes, [none, 1, 2, 3, many]).

example(nut, [attribute(size, small), attribute(shape, compact), attribute(holes, 1)]).
example(screw, [attribute(size, small), attribute(shape, long), attribute(holes, none)]).
example(key, [attribute(size, small), attribute(shape, long), attribute(holes, 1)]).
example(nut, [attribute(size, small), attribute(shape, compact), attribute(holes, 1)]).
example(key, [attribute(size, large), attribute(shape, long), attribute(holes, 1)]).
example(screw, [attribute(size, small), attribute(shape, compact), attribute(holes, none)]).
example(nut, [attribute(size, small), attribute(shape, compact), attribute(holes, 1)]).
example(pen, [attribute(size, large), attribute(shape, long), attribute(holes, none)]).
example(scissors, [attribute(size, large), attribute(shape, long), attribute(holes, 2)]).
example(pen, [attribute(size, large), attribute(shape, long), attribute(holes, none)]).
example(scissors, [attribute(size, large), attribute(shape, other), attribute(holes, 2)]).
example(key, [attribute(size, small), attribute(shape, other), attribute(holes, 2)]).

main :-
	induce_tree(T),
	print_tree(T).
