view release on metacpan or  search on metacpan

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

    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);