neat/perl-example/xor.pl

#!/usr/bin/perl -w
 
use strict;
use neat;
 
my $neat = new neat( "start.xor.pl" );
 
my $FINISHED = 0;
 
$SIG{INT} = sub { $FINISHED = 1 };
 
my $inputs = [
{ 'bias' => 1, 'one' => 0, 'two' => 0, 'output' => 0, 'expected' => 0 },
{ 'bias' => 1, 'one' => 1, 'two' => 0, 'output' => 0, 'expected' => 1 },
{ 'bias' => 1, 'one' => 0, 'two' => 1, 'output' => 0, 'expected' => 1 },
{ 'bias' => 1, 'one' => 1, 'two' => 1, 'output' => 0, 'expected' => 0 },
];
 
sub EvaluateXOR
{
my $net = shift;
 
# why retest someone who hasn't changed?
return $net->{'fitness'}
if ( $net->{'elite'} );
 
my $total = 0;
my $values;
my $average;
my $i;
my $difference;
$total = 0;
for ( $i = 0 ; $i < 4 ; $i++ )
{
$values = Copy( $inputs->[$i] );
$neat->Activate( $net, $values );
# printf( " %d%d=%lf", $values->{'one'}, $values->{'two'},
# $values->{'output'} );
$difference = abs( $values->{'output'} - $values->{'expected'} );
$total += $difference;
}
# printf( " %lf\n", 1 - $average );
my $fitness = 1 - ( $total / 4 );
$FINISHED = 1 if ( $total < 0.04 ); # close enough!
return $fitness;
}
 
$neat->EvaluationFunction( \&EvaluateXOR );
 
# initial generation
$neat->EvaluateAll();
 
my $count = 0;
while ( ! $FINISHED )
{
$neat->Epoch();
printf( "%s\n", $neat->Stats() );
$neat->EvaluateAll();
#$FINISHED = 1 if ( ++$count == 100 );
}
 
$neat->Champions();
$neat->Save( "xor.final.pl" );
 
my $champion = $neat->ChampionNetwork();
my $code = $neat->ActivationFunction_C_PartialEval( $champion,
{ bias => 1 } );
open INDENT, "|indent -st > activate.xor.c";
print INDENT $code;
close INDENT;
#system "cat activate.xor.c";