File Coverage

blib/lib/AI/Perceptron.pm

Criterion	Covered	Total	%
statement	82	88	93.1
branch	15	24	62.5
condition	7	11	63.6
subroutine	13	14	92.8
pod	5	12	41.6
total	122	149	81.8

=head1 NAME

AI::Perceptron - example of a node in a neural network.

=head1 SYNOPSIS

 use AI::Perceptron;

 my $p = AI::Perceptron->new
           ->num_inputs( 2 )
           ->learning_rate( 0.04 )
           ->threshold( 0.02 )
           ->weights([ 0.1, 0.2 ]);

 my @inputs  = ( 1.3, -0.45 );   # input can be any number
 my $target  = 1;                # output is always -1 or 1
 my $current = $p->compute_output( @inputs );

 print "current output: $current, target: $target\n";

 $p->add_examples( [ $target, @inputs ] );

 $p->max_iterations( 10 )->train or
   warn "couldn't train in 10 iterations!";

 print "training until it gets it right\n";
 $p->max_iterations( -1 )->train; # watch out for infinite loops

=cut

package AI::Perceptron;

use strict;
use accessors qw( num_inputs learning_rate _weights threshold
		  training_examples max_iterations );

our $VERSION = '1.0';
our $Debug   = 0;

sub new {
    my $class = shift;
    my $self  = bless {}, $class;
    return $self->init( @_ );
}

sub init {
    my $self = shift;
    my %args = @_;

    $self->num_inputs( $args{Inputs} || 1 )
         ->learning_rate( $args{N} || 0.05 )
	 ->max_iterations( -1 )
	 ->threshold( $args{T} || 0.0 )
	 ->training_examples( [] )
	 ->weights( [] );

    # DEPRECATED: backwards compat
    if ($args{W}) {
	$self->threshold( shift @{ $args{W} } )
	     ->weights( [ @{ $args{W} } ] );
    }

    return $self;
}

sub verify_weights {
    my $self = shift;

    for my $i (0 .. $self->num_inputs-1) {
	$self->weights->[$i] ||= 0.0;
    }

    return $self;
}

# DEPRECATED: backwards compat
sub weights {
    my $self = shift;
    my $ret  = $self->_weights(@_);
    return wantarray ? ( $self->threshold, @{ $self->_weights } ) : $ret;
}

sub add_examples {
    my $self = shift;

    foreach my $ex (@_) {
	die "training examples must be arrayrefs!" unless (ref $ex eq 'ARRAY');
	my @inputs = @{$ex}; # be nice, take a copy
	my $target = shift @inputs;
	die "expected result must be either -1 or 1, not $target!"
	  unless (abs $target == 1);
	# TODO: avoid duplicate entries
	push @{ $self->training_examples }, [$target, @inputs];
    }

    return $self;
}

sub add_example {
    shift->add_examples(@_);
}

sub compute_output {
    my $self   = shift;
    my @inputs = @_;

    my $sum = $self->threshold; # start at threshold
    for my $i (0 .. $self->num_inputs-1) {
	$sum += $self->weights->[$i] * $inputs[$i];
    }

    # binary (returning the real $sum is not part of this model)
    return ($sum > 0) ? 1 : -1;
}

##
# $p->train( [ @training_examples ] )
#                    \--> [ $target_output, @inputs ]
sub train {
    my $self = shift;
    $self->add_examples( @_ ) if @_;

    $self->verify_weights;

    # adjust the weights for each training example until the output
    # function correctly classifies all the training examples.
    my $iter = 0;
    while(! $self->classifies_examples_correctly ) {

	if (($self->max_iterations > 0) and
	    ($iter >= $self->max_iterations)) {
	    $self->emit( "stopped training after $iter iterations" );
	    return;
	}

	$iter++;
	$self->emit( "Training iteration $iter" );

	foreach my $training_example (@{ $self->training_examples }) {
	    my ($expected_output, @inputs) = @$training_example;

	    $self->emit( "Training X=<", join(',', @inputs),
			 "> with target $expected_output" ) if $Debug > 1;

	    # want the perceptron's output equal to training output
	    # TODO: this duplicates work by classifies_examples_correctly()
	    my $output = $self->compute_output(@inputs);
	    next if ($output == $expected_output);

	    $self->adjust_threshold( $expected_output, $output )
	         ->adjust_weights( \@inputs, $expected_output, $output );
	}
    }

    $self->emit( "completed in $iter iterations." );

    return $self;
}

# return true unless all training examples are correctly classified
sub classifies_examples_correctly {
    my $self = shift;
    my $training_examples = $self->training_examples;

    foreach my $training_example (@$training_examples) {
	my ($output, @inputs) = @{$training_example};
	return if ($self->compute_output( @inputs ) != $output);
    }

    return 1;
}

sub adjust_threshold {
    my $self            = shift;
    my $expected_output = shift;
    my $output          = shift;
    my $n               = $self->learning_rate;

    my $delta = $n * ($expected_output - $output);
    $self->threshold( $self->threshold + $delta );

    return $self;
}

sub adjust_weights {
    my $self            = shift;
    my $inputs          = shift;
    my $expected_output = shift;
    my $output          = shift;
    my $n               = $self->learning_rate;

    for my $i (0 .. $self->num_inputs-1) {
	my $delta = $n * ($expected_output - $output) * $inputs->[$i];
	$self->weights->[$i] += $delta;
    }

    return $self;
}

sub emit {
    return unless $Debug;
    my $self = shift;
    push @_, "\n" unless grep /\n/, @_;
    warn( @_ );
}

1;

__END__