view release on metacpan or  search on metacpan

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

  $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
}