view release on metacpan or  search on metacpan

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

#!/usr/bin/perl
package AI::ANN;
BEGIN {
  $AI::ANN::VERSION = '0.008';
}
use strict;
use warnings;

# ABSTRACT: an artificial neural network simulator

use Moose;

use AI::ANN::Neuron;
use Storable qw(dclone);


has 'input_count' => (is => 'ro', isa => 'Int', required => 1);
has 'outputneurons' => (is => 'ro', isa => 'ArrayRef[Int]', required => 1);
has 'network' => (is => 'ro', isa => 'ArrayRef[HashRef]', required => 1);
# network is an arrayref of hashrefs. Each hashref is:
# object => AI::ANN::Neuron
# and has several other elements
has 'inputs' => (is => 'ro', isa => 'ArrayRef[Int]');
has 'rawpotentials' => (is => 'ro', isa => 'ArrayRef[Int]');
has 'minvalue' => (is => 'rw', isa => 'Int', default => 0);
has 'maxvalue' => (is => 'rw', isa => 'Int', default => 1);
has 'afunc' => (is => 'rw', isa => 'CodeRef', default => sub {sub {shift}});
has 'dafunc' => (is => 'rw', isa => 'CodeRef', default => sub {sub {1}});
has 'backprop_eta' => (is => 'rw', isa => 'Num', default => 0.1);

around BUILDARGS => sub {
	my $orig = shift;
	my $class = shift;
	my %data;
	if ( @_ == 1 && ref $_[0] eq 'HASH' ) {
		%data = %{$_[0]};
	} else {
		%data = @_;
	}
	if (exists $data{'inputs'} && not exists $data{'input_count'}) {
		$data{'input_count'} = $data{'inputs'};
		delete $data{'inputs'}; # inputs is used later for the actual 
								# values of the inputs.
	} 
	my $neuronlist = $data{'data'};
	$data{'outputneurons'} = [];
	$data{'network'} = [];
	for (my $i = 0; $i <= $#{$neuronlist} ; $i++) {
		push @{$data{'outputneurons'}}, $i
			if $neuronlist->[$i]->{'iamanoutput'};
		my @pass = (
				$i, 
				$neuronlist->[$i]->{'inputs'}, 
				$neuronlist->[$i]->{'neurons'} );
		push @pass, $neuronlist->[$i]->{'eta_inputs'}, 
			$neuronlist->[$i]->{'eta_neurons'}
			if defined $neuronlist->[$i]->{'eta_neurons'};
		$data{'network'}->[$i]->{'object'} = 
			new AI::ANN::Neuron( @pass );
	}
	delete $data{'data'};
	return $class->$orig(%data);
};


sub execute {
	my $self = shift;
	my $inputs = $self->{'inputs'} = shift;
	# Don't bother dereferencing $inputs only to rereference a lot
	my $net = $self->{'network'}; # For less typing
	my $lastneuron = $#{$net};
	my @neurons = ();
	foreach my $i (0..$lastneuron) {
		$neurons[$i] = 0;
	}
	foreach my $i (0..$lastneuron) {
		delete $net->[$i]->{'done'};
		delete $net->[$i]->{'state'};
	}
	my $progress = 0;
	do {
		$progress = 0;
		foreach my $i (0..$lastneuron) {
			if ($net->[$i]->{'done'}) {next}
			if ($net->[$i]->{'object'}->ready($inputs, \@neurons)) {
				my $potential = $net->[$i]->{'object'}->execute($inputs, \@neurons);
                $self->{'rawpotentials'}->[$i] = $potential;
				$potential = $self->{'maxvalue'} if $potential > $self->{'maxvalue'};
				$potential = $self->{'minvalue'} if $potential < $self->{'minvalue'};
				$potential = &{$self->{'afunc'}}($potential);
				$neurons[$i] = $net->[$i]->{'state'} = $potential;
				$net->[$i]->{'done'} = 1;
				$progress++;
			}
		}
	} while ($progress); # If the network is feed-forward, we are now finished.
	
	my @notdone = grep {not (defined $net->[$_]->{'done'} &&
							 $net->[$_]->{'done'} == 1)} 0..$lastneuron;
	my @neuronstemp = ();
	if ($#notdone > 0) { #This is the part where we deal with loops and bad things
		my $maxerror = 0;
		my $loopcounter = 1;
		while (1) {
			foreach my $i (@notdone) { # Only bother iterating over the
									   # ones we couldn't solve exactly
				# We don't care if it's ready now, we're just going to interate
				# until it stabilizes.
				if (not defined $neurons[$i] && $i <= $lastneuron) {
					# Fixes warnings about uninitialized values, but we make 
					# sure $i is valid first.
					$neurons[$i] = 0;
				}
				my $potential = $net->[$i]->{'object'}->execute($inputs, \@neurons);
                $self->{'rawpotentials'}->[$i] = $potential;
				$potential = &{$self->{'afunc'}}($potential);
				$potential = $self->{'maxvalue'} if $potential > $self->{'maxvalue'};
				$potential = $self->{'minvalue'} if $potential < $self->{'minvalue'};
				$neuronstemp[$i] = $net->[$i]->{'state'} = $potential;
				# We want to know the absolute change
				if (abs($neurons[$i]-$neuronstemp[$i])>$maxerror) {
					$maxerror = abs($neurons[$i]-$neuronstemp[$i]);
				}
			}
			foreach my $i (0..$lastneuron) { 
				# Update $neurons, since that is what gets passed to execute
				$neurons[$i] = $neuronstemp[$i];
			}
			if (($maxerror < 0.0001 && $loopcounter >= 5) || $loopcounter > 250) {last}
			$loopcounter++;
			$maxerror=0;
		}
	}

	# Ok, hopefully all the neurons have happy values by now.
	# Get the output values for neurons corresponding to outputneurons
	my @output = map {$neurons[$_]} @{$self->{'outputneurons'}};
	return \@output;
}


sub get_state {
	my $self = shift;
	my $net = $self->{'network'}; # For less typing
	my @neurons = map {$net->[$_]->{'state'}} 0..$#{$self->{'network'}};
	my @output = map {$net->[$_]->{'state'}} @{$self->{'outputneurons'}};

	return $self->{'inputs'}, \@neurons, \@output;
}


sub get_internals {
	my $self = shift;
	my $net = $self->{'network'}; # For less typing
	my $retval = [];
	for (my $i = 0; $i <= $#{$self->{'network'}}; $i++) {
		$retval->[$i] = { iamanoutput => 0,
						  inputs => $net->[$i]->{'object'}->inputs(),
						  neurons => $net->[$i]->{'object'}->neurons(),
						  eta_inputs => $net->[$i]->{'object'}->eta_inputs(),
						  eta_neurons => $net->[$i]->{'object'}->eta_neurons()
						  };
	}
	foreach my $i (@{$self->{'outputneurons'}}) {
		$retval->[$i]->{'iamanoutput'} = 1;
	}
	return dclone($retval); # Dclone for safety.
}


sub readable {
	my $self = shift;
	my $retval = "This network has ". $self->{'inputcount'} ." inputs and ".
					scalar(@{$self->{'network'}}) ." neurons.\n";
	for (my $i = 0; $i <= $#{$self->{'network'}}; $i++) {
		$retval .= "Neuron $i\n";
		while (my ($k, $v) = each %{$self->{'network'}->[$i]->{'object'}->inputs()}) {
			$retval .= "\tInput from input $k, weight is $v\n";
		}
		while (my ($k, $v) = each %{$self->{'network'}->[$i]->{'object'}->neurons()}) {
			$retval .= "\tInput from neuron $k, weight is $v\n";
		}
		if (map {$_ == $i} $self->{'outputneurons'}) {
			$retval .= "\tThis neuron is a network output\n";
		}
	}
	return $retval;
}


sub backprop {
    my $self = shift;
    my $inputs = shift;
    my $desired = shift;
    my $actual = $self->execute($inputs);
    my $net = $self->{'network'};
    my $lastneuron = $#{$net};
    my $deltas = [];
    my $i = 0;
    foreach my $neuron (@{$self->outputneurons()}) {
        $deltas->[$neuron] = $desired->[$i] - $actual->[$i];
        $i++;
    }
    my $progress = 0;
    foreach my $neuron (reverse 0..$lastneuron) {
        foreach my $i (reverse $neuron..$lastneuron) {
            my $weight = $net->[$i]->{'object'}->neurons()->[$neuron];
            if (defined $weight && $weight != 0 && $deltas->[$i]) {
                $deltas->[$neuron] += $weight * $deltas->[$i];
            }
        }
    } # Finished generating deltas
    foreach my $neuron (0..$lastneuron) {
        my $inputinputs = $net->[$neuron]->{'object'}->inputs();
        my $neuroninputs = $net->[$neuron]->{'object'}->neurons();
        my $dafunc = &{$self->{'dafunc'}}($self->{'rawpotentials'}->[$neuron]);
        my $delta = $deltas->[$neuron] || 0;
        foreach my $i (0..$#{$inputinputs}) {
            $inputinputs->[$i] += $inputs->[$i]*$self->{'backprop_eta'}*$delta*$dafunc;
        }
        foreach my $i (0..$#{$neuroninputs}) {
            $neuroninputs->[$i] += $net->[$i]->{'state'}*$self->{'backprop_eta'}*$delta*$dafunc;
        }
        $net->[$neuron]->{'object'}->inputs($inputinputs);
        $net->[$neuron]->{'object'}->neurons($neuroninputs);
    } # Finished changing weights.
}

__PACKAGE__->meta->make_immutable;

1;

__END__
=pod

=head1 NAME

AI::ANN - an artificial neural network simulator

=head1 VERSION

version 0.008

=head1 SYNOPSIS

AI::ANN is an artificial neural network simulator. It differs from existing 
solutions in that it fully exposes the internal variables and allows - and 
forces - the user to fully customize the topology and specifics of the 
produced neural network. If you want a simple solution, you do not want this 
module. This module was specifically written to be used for a simulation of 
evolution in neural networks, not training. The traditional 'backprop' and