view release on metacpan or  search on metacpan

t/01-simple.t  view on Meta::CPAN

# 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;