# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

#########################

use Test;
BEGIN { plan tests => 31 };
use AI::DecisionTree;
ok(1); # If we made it this far, we're ok.

#########################

my @attributes = qw(outlook  temperature  humidity  wind    play_tennis);               
my @cases      = qw(
		    sunny    hot          high      weak    no
		    sunny    hot          high      strong  no
		    overcast hot          high      weak    yes
		    rain     mild         high      weak    yes
		    rain     cool         normal    weak    yes
		    rain     cool         normal    strong  no
		    overcast cool         normal    strong  yes
		    sunny    mild         high      weak    no
		    sunny    cool         normal    weak    yes
		    rain     mild         normal    weak    yes
		    sunny    mild         normal    strong  yes
		    overcast mild         high      strong  yes
		    overcast hot          normal    weak    yes
		    rain     mild         high      strong  no
		   );
my $outcome = pop @attributes;


my $dtree = new AI::DecisionTree(purge => 0);
while (@cases) {
  my @values = splice @cases, 0, 1 + scalar(@attributes);
  my $result = pop @values;
  my %pairs;
  @pairs{@attributes} = @values;

  $dtree->add_instance(attributes => \%pairs,
		       result => $result,
		      );
}
$dtree->train;


# Make sure a training example is correctly categorized
my $result = $dtree->get_result(
				attributes => {
					       outlook => 'rain',
					       temperature => 'mild',
					       humidity => 'high',
					       wind => 'strong',
					      }
			       );
ok($result, 'no');

# Try a new unseen example
$result = $dtree->get_result(
				attributes => {
					       outlook => 'sunny',
					       temperature => 'hot',
					       humidity => 'normal',
					       wind => 'strong',
					      }
			       );
ok($result, 'yes');

# Make sure rule_statements() works
{
  my @rules = $dtree->rule_statements;
  ok @rules, 5;
  ok !!grep {$_ eq "if outlook='overcast' -> 'yes'"} @rules;
}

# Make sure rule_tree() works
ok $dtree->rule_tree->[0], 'outlook';
ok $dtree->rule_tree->[1]{overcast}, 'yes';

($result, my $confidence) = $dtree->get_result(
				attributes => {
					       outlook => 'rain',
					       temperature => 'mild',
					       humidity => 'high',
					       wind => 'strong',
					      }
					      );
ok $result, 'no';
ok $confidence, 1;

{
  # Test attribute callbacks
  my %attributes = (
		    outlook => 'rain',
		    temperature => 'mild',
		    humidity => 'high',
		    wind => 'strong',
		   );

  my $result  = $dtree->get_result( callback => sub { $attributes{$_[0]} } );
  ok $result, 'no';
}


#print map "$_\n", $dtree->rule_statements;
#use YAML; print Dump $dtree;

if (eval "use GraphViz; 1") {
  my $graphviz = $dtree->as_graphviz;
  ok $graphviz;

  if (0) {
    # Only works on Mac OS X
    my $file = '/tmp/tree.png';
    open my($fh), "> $file" or die "$file: $!";
    print $fh $graphviz->as_png;
    close $fh;
    system('open', $file);
  }
} else {
  skip("Skipping: GraphViz is not installed", 0);
}

# Make sure there are 8 nodes
ok $dtree->nodes, 8;

{
  # Test max_depth
  $dtree->train(max_depth => 1);
  my @rules = $dtree->rule_statements;
  ok @rules, 3;
  ok $dtree->depth, 1;
}

{
  # Should barf on inconsistent data
  my $t2 = new AI::DecisionTree;
  $t2->add_instance( attributes => { foo => 'bar' },
		     result => 1 );
  $t2->add_instance( attributes => { foo => 'bar' },
		     result => 0 );
  eval {$t2->train};
  ok( "$@", '/Inconsistent data/' );
}

{
  # Make sure two trees can be trained concurrently
  my $t1 = new AI::DecisionTree;
  my $t2 = new AI::DecisionTree;
  
  my @train = (
	       [farming => 'sheep very valuable farming'],
	       [farming => 'farming requires many kinds animals'],
	       [vampire => 'vampires drink blood vampires may staked'],
	       [vampire => 'vampires cannot see their images mirrors'],
	      );
  foreach my $doc (@train) {
    $t1->add_instance( attributes => {map {$_,1} split ' ', $doc->[1]},
		       result => 0+($doc->[0] eq 'farming'));
  }
  foreach my $doc (@train) {
    $t2->add_instance( attributes => {map {$_,1} split ' ', $doc->[1]},
		       result => 0+($doc->[0] eq 'vampire'));
  }
  
  $t1->train;
  $t2->train;
  ok(1);

  my @test = (
	      [farming => 'I would like to begin farming sheep'],
	      [vampire => "I see that many vampires may have eaten my beautiful daughter's blood"],
	     );

  foreach my $doc (@test) {
    my $result = $t1->get_result( attributes => {map {$_,1} split ' ', $doc->[1]} );
    ok $result, 0+($doc->[0] eq 'farming');

    $result = $t2->get_result( attributes => {map {$_,1} split ' ', $doc->[1]} );
    ok $result, 0+($doc->[0] eq 'vampire');
  }

}

{
  my $t1 = new AI::DecisionTree(purge => 0);
  my $t2 = new AI::DecisionTree;
  $t1->add_instance( attributes => { foo => 'bar' },
		     result => 1, name => 1 );
  $t1->add_instance( attributes => { foo => 'baz' },
		     result => 0, name => 2 );

  eval {$t1->train};
  ok !$@;

  ok $t1->instances->[0]->name, 1;
  ok $t1->instances->[1]->name, 2;
  ok $t1->_result($t1->instances->[0]), 1;  # Not a public interface
  ok $t1->_result($t1->instances->[1]), 0;  # Not a public interface

  $t2->copy_instances(from => $t1);
  ok $t2->instances->[0]->name, 1;
  ok $t2->instances->[1]->name, 2;
  ok $t2->_result($t2->instances->[0]), 1;  # Not a public interface
  ok $t2->_result($t2->instances->[1]), 0;  # Not a public interface

  $t2->set_results( {1=>0, 2=>1} );
  ok $t2->_result($t2->instances->[0]), 0;  # Not a public interface
  ok $t2->_result($t2->instances->[1]), 1;  # Not a public interface
}