Creating Identification/Classification trees

Question

I have data given in following format; from which I need to create identification/classification trees (three different trees from three different criterion, that is average disorder, gain ratio and information gain).

Weather  Light  Ground  Decision
Sunny    Good   Dry     Play
Overcast Good   Dry     Play
Raining  Good   Dry     No Play
Overcast Poor   Dry     No Play
Overcast Poor   Damp    No Play
Raining  Poor   Damp    No Play
Overcast Good   Damp    Play
Sunny    Poor   Dry     Play

Clustering won't help much since it directly maps the values with averages to generate clusters, which might be "rough"; and I can't find any built in function for the task I need to perform in Mathematica. Is there any built in function which might just create a classification tree depending on implicit parameters (entropy, information gain and gain ratio)?

Answer 1

Some time ago (before Mathematica had the function Classify) I developed a package for construction of Decision trees and classification with them. The trees produced by that package might be a good start for making the trees from the three different perspectives listed in the question.

More precisely, with the package one can build a tree using entropy driven splitting and prune it afterwards using the Minimum Description Length (MDL) principle.

See these blog posts for application examples:

Decision trees posts at MathematicaForPrediction at WordPress.

Below is an example with the sample data in the question.

Assign data:

data = {{"Sunny", "Good", "Dry", "Play"}, {"Overcast", "Good", "Dry", 
    "Play"}, {"Raining", "Good", "Dry", "No-Play"}, {"Overcast", 
    "Poor", "Dry", "No-Play"}, {"Overcast", "Poor", "Damp", 
    "No-Play"}, {"Raining", "Poor", "Damp", "No-Play"}, {"Overcast", 
    "Good", "Damp", "Play"}, {"Sunny", "Poor", "Dry", "Play"}};
colNames = {"Weather", "Light", "Ground", "Decision"};
TableForm[data, TableHeadings -> {None, colNames}]

Import the package:

Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/AVCDecisionTreeForest.m"]

Build a decision tree using "Entropy" as an impurity function ("Gini" is an alternative and used by default):

dtree = BuildDecisionTree[data, "ImpurityFunction" -> "Entropy"]

(* Out[123]= {{0.215762, "Raining", 1, Symbol, 8}, 
{{{2, "No-Play"}}}, {{0.318257, "Good", 2, Symbol, 6}, 
{{{3, "Play"}}}, {{0.636514, "Overcast", 1, Symbol, 3}, 
{{{2, "No-Play"}}}, {{{1, "Play"}}}}}} *)

Visualize the tree:

trules = dtree // DecisionTreeToRules;
trules = trules /. ({m_, v_, cInd_Integer, s_, n_} :> {m, v, 
     colNames[[cInd]], s, n}); 
LayeredGraphPlot[trules, VertexLabeling -> True]

The last commands produce the plot:

In the plot:

1. Each non-leaf node of the tree has the format:

   {impurity, splitting value, splitting variable, variable type, number of rows}.

   Where "variable type" is wither Number of Symbol, and "number of rows" refers to the size of the part of the data that was observed (scanned) at that point of splitting.

2. The leaf nodes are numbered, each leaf shows a label and how many observations adhere to the predicate formed from the root to the leaf.

Using the built tree classification can be done like this:

DecisionTreeClassify[dtree, #] & /@ {{"Overcast", "Good", "Dry"},
{"Overcast", "Poor", "Dry"}}

(* Out[17]= {{{3, "Play"}}, {{2, "No-Play"}}} *)

Answer 2

The first thing I want to say is that I think Anton Antonov's solution is great.

But, you wanted to be able to change the criteria for splitting, and that might be hard given that it is a library (I haven't checked the code, so I don't know). There is no in-built function either. So I got the idea that I would try to create some straight-forward code where one could replace the splitting criteria. However: 1) I don't know the conventions of decision trees. 2) The code became messy.

Yet, here it is:

attributes = {"Weather", "Light", "Ground"};

data = {{{"Sunny", "Good", "Dry"}, 
    "Play"}, {{"Overcast", "Good", "Dry"}, 
    "Play"}, {{"Raining", "Good", "Dry"}, 
    "No-Play"}, {{"Overcast", "Poor", "Dry"}, 
    "No-Play"}, {{"Overcast", "Poor", "Damp"}, 
    "No-Play"}, {{"Raining", "Poor", "Damp"}, 
    "No-Play"}, {{"Overcast", "Good", "Damp"}, 
    "Play"}, {{"Sunny", "Poor", "Dry"}, "Play"}};

InformationGain[attr_] := Module[{probabilities, information},
   (* The information gain, the decrease in entropy. *)
   probabilities = Tally[attr][[All, 2]];
   probabilities = probabilities / (Total @ probabilities);
   information = Total @ (# Log[1/#] & /@ probabilities);
   (* Return information gain from attribute attr. *)
   information
   ];

SplitSet[elems_] := Module[{infoGain, attrPos, newSets},
   (* Split the set by the attribute that gives the most information. \
*)
   infoGain = N@(InformationGain /@ (Transpose @ elems[[All, 1]])); 
   attrPos = First@Ordering[infoGain, -1];
   newSets = GatherBy[elems, #[[1, attrPos]] &];
   (* Return new sets. *)
   {newSets, attrPos}
   ];

CheckStop[set_] := Module[{},
   (* Every element in the subset belongs to the same class. *)
   If[Length @ Union @ set[[All, 2]] == 1, Return@False];
   (* No more information to be gained. *)
   If[N@(Total@(InformationGain /@ (Transpose @ set[[All, 1]]))) == 
     0, Return@False];
   (* Continue. No reason to stop. *)
   True
   ];

FormatLeaf[leaf_, attr_] := Module[{def, outcome},
   (* Retrieve the most common outcome. *)
   outcome = First@Commonest[leaf[[All, 2]], 1];
   (* Select the attributes, 
   and corresponding choices (from any element in leaf.) *)
   def = {Transpose[{attributes[[attr]], leaf[[1, 1]][[attr]]}], 
     outcome};
   (* Return *)
   def
   ];

(* Main function. *)
Iterate[dat_, nodePath_] := 
  Module[{elem, nodes, newNodes, leafs, newNodePath},
   elem = SplitSet@dat;
   newNodePath = Append[nodePath, elem[[2]]];
   nodes = Select[elem[[1]], CheckStop];
   leafs = 
    FormatLeaf[#, newNodePath] & /@ 
     Select[elem[[1]], CheckStop[#] == False &];
   (* Send nodes into the function again. *)
   newNodes = Join @@ (Iterate[#, newNodePath] & /@ nodes);
   leafs = Join[leafs, newNodes];
   (* Return leafs. *)
   leafs
   ];
result = Iterate[data, {}];

(* Visualize a tree. *)
CreateEdges[path_, start_, heads_] := Module[{edges, edgeRules},
   edges = Replace[Flatten[path], "Weather" -> "Data", {1}];
   edges = DeleteCases[edges /. (Rule[#, Null] & /@ heads), Null];
   edgeRules = 
    Table[Rule[ToString[i]  ". "  edges[[i]], 
      ToString[i + 1]  ". "  edges[[i + 1]]], {i, 1, 
      Length@edges - 1}];
   (* Return edge rules. *)
   edgeRules
   ];

splitList = 
  First@Sort[result, Length@#1 > Length@#2 &][[All, 1, All, 1]];
allRules = 
  Union@Flatten@(CreateEdges[#, splitList[[1]], splitList] & /@ 
      result);
(* Show plot. *)
LayeredGraphPlot[allRules, VertexLabeling -> True]

Will output the decision tree:

You can then create rules for prediction:

(* Create rules for prediction. *)
PredictionRules[elem_] := Module[{r, param, attrOrder, rightOrder},
   r = {_, _, _};
   param = elem[[1, All, 2]];
   attrOrder = elem[[1, All, 1]];
   rightOrder = Thread[attributes -> Range[Length@attributes]];
   param = param[[ Ordering @ (attrOrder /. rightOrder)]];
   r[[Range[Length@param]]] = param;
   (* Return rule. *)
   Rule[r, elem[[2]]]
   ];

DecisionTreeRules = PredictionRules /@ result;
data /. DecisionTreeRules

Which will output:

{{"Play", "Play"}, {"Play", "Play"}, {"No-Play", 
  "No-Play"}, {"No-Play", "No-Play"}, {"No-Play", 
  "No-Play"}, {"No-Play", "No-Play"}, {"Play", "Play"}, {"Play", 
  "Play"}}

It's an attempt at implementing the ID3 Algorithm. If you'd like to change the criteria for splitting you would have to at least look at the InformationGain-function which calculates the information gain from each potential split. As well as the CheckStop-function that determines whether a node should be split further or if it's a leaf.