view release on metacpan or  search on metacpan

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

  $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'));
  }