view release on metacpan or  search on metacpan

lib/AI/Perceptron.pm  view on Meta::CPAN

=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(@_);
}