AI-NeuralNet-BackProp
view release on metacpan or search on metacpan
BackProp.pm view on Meta::CPAN
#!/usr/bin/perl
# $Id: BackProp.pm,v 0.89 2000/08/12 01:05:27 josiah Exp $
#
# Copyright (c) 2000 Josiah Bryan USA
#
# See AUTHOR section in pod text below for usage and distribution rights.
# See UPDATES section in pod text below for info on what has changed in this release.
#
BEGIN {
$AI::NeuralNet::BackProp::VERSION = "0.89";
}
#
# name: AI::NeuralNet::BackProp
#
# author: Josiah Bryan
# date: Tuesday August 15 2000
# desc: A simple back-propagation, feed-foward neural network with
# learning implemented via a generalization of Dobbs rule and
# several principals of Hoppfield networks.
# online: http://www.josiah.countystart.com/modules/AI/cgi-bin/rec.pl
#
package AI::NeuralNet::BackProp::neuron;
use strict;
# Dummy constructor
sub new {
bless {}, shift
}
# Rounds floats to ints
sub intr {
shift if(substr($_[0],0,4) eq 'AI::');
try { return int(sprintf("%.0f",shift)) }
catch { return 0 }
}
# Receives input from other neurons. They must
# be registered as a synapse of this neuron to effectively
# input.
sub input {
my $self = shift;
my $sid = shift;
my $value = shift;
# We simply weight the value sent by the neuron. The neuron identifies itself to us
# using the code we gave it when it registered itself with us. The code is in $sid,
# (synapse ID) and we use that to track the weight of the connection.
# This line simply multiplies the value by its weight and gets the integer from it.
$self->{SYNAPSES}->{LIST}->[$sid]->{VALUE} = intr($value * $self->{SYNAPSES}->{LIST}->[$sid]->{WEIGHT});
$self->{SYNAPSES}->{LIST}->[$sid]->{FIRED} = 1;
$self->{SYNAPSES}->{LIST}->[$sid]->{INPUT} = $value;
# Debugger
AI::NeuralNet::BackProp::out1("\nRecieved input of $value, weighted to $self->{SYNAPSES}->{LIST}->[$sid]->{VALUE}, synapse weight is $self->{SYNAPSES}->{LIST}->[$sid]->{WEIGHT} (sid is $sid for $self).\n");
AI::NeuralNet::BackProp::out1((($self->input_complete())?"All synapses have fired":"Not all synapses have fired"));
AI::NeuralNet::BackProp::out1(" for $self.\n");
# Check and see if all synapses have fired that are connected to this one.
# If they have, then generate the output value for this synapse.
$self->output() if($self->input_complete());
}
# Loops thru and outputs to every neuron that this
# neuron is registered as synapse of.
sub output {
my $self = shift;
my $size = $self->{OUTPUTS}->{SIZE} || 0;
my $value = $self->get_output();
for (0..$size-1) {
AI::NeuralNet::BackProp::out1("Outputing to $self->{OUTPUTS}->{LIST}->[$_]->{PKG}, index $_, a value of $value with ID $self->{OUTPUTS}->{LIST}->[$_]->{ID}.\n");
$self->{OUTPUTS}->{LIST}->[$_]->{PKG}->input($self->{OUTPUTS}->{LIST}->[$_]->{ID},$value);
}
}
# Used internally by output().
sub get_output {
my $self = shift;
BackProp.pm view on Meta::CPAN
# Now calculates actual difference in numerical value.
sub pdiff {
no strict 'refs';
shift if(substr($_[0],0,4) eq 'AI::');
my $a1 = shift;
my $a2 = shift;
my $a1s = $#{$a1}; #AI::NeuralNet::BackProp::_FETCHSIZE($a1);
my $a2s = $#{$a2}; #AI::NeuralNet::BackProp::_FETCHSIZE($a2);
my ($a,$b,$diff,$t);
$diff=0;
#return undef if($a1s ne $a2s); # must be same length
for my $x (0..$a1s) {
$a = $a1->[$x];
$b = $a2->[$x];
if($a!=$b) {
if($a<$b){$t=$a;$a=$b;$b=$t;}
$a=1 if(!$a);
$diff+=(($a-$b)/$a)*100;
}
}
$a1s = 1 if(!$a1s);
return sprintf("%.10f",($diff/$a1s));
}
# Returns $fa as a percentage of $fb
sub p {
shift if(substr($_[0],0,4) eq 'AI::');
my ($fa,$fb)=(shift,shift);
sprintf("%.3f",((($fb-$fa)*((($fb-$fa)<0)?-1:1))/$fa)*100);
}
# This sub will take an array ref of a data set, which it expects in this format:
# my @data_set = ( [ ...inputs... ], [ ...outputs ... ],
# ... rows ...
# );
#
# This wil sub returns the percentage of 'forgetfullness' when the net learns all the
# data in the set in order. Usage:
#
# learn_set(\@data,[ options ]);
#
# Options are options in hash form. They can be of any form that $net->learn takes.
#
# It returns a percentage string.
#
sub learn_set {
my $self = shift if(substr($_[0],0,4) eq 'AI::');
my $data = shift;
my %args = @_;
my $len = $#{$data}/2-1;
my $inc = $args{inc};
my $max = $args{max};
my $error = $args{error};
my $p = (defined $args{flag}) ?$args{flag} :1;
my $row = (defined $args{pattern})?$args{pattern}*2+1:1;
my ($fa,$fb);
for my $x (0..$len) {
print "\nLearning index $x...\n" if($AI::NeuralNet::BackProp::DEBUG);
my $str = $self->learn( $data->[$x*2], # The list of data to input to the net
$data->[$x*2+1], # The output desired
inc=>$inc, # The starting learning gradient
max=>$max, # The maximum num of loops allowed
error=>$error); # The maximum (%) error allowed
print $str if($AI::NeuralNet::BackProp::DEBUG);
}
my $res;
$data->[$row] = $self->crunch($data->[$row]) if($data->[$row] == 0);
if ($p) {
$res=pdiff($data->[$row],$self->run($data->[$row-1]));
} else {
$res=$data->[$row]->[0]-$self->run($data->[$row-1])->[0];
}
return $res;
}
# This sub will take an array ref of a data set, which it expects in this format:
# my @data_set = ( [ ...inputs... ], [ ...outputs ... ],
# ... rows ...
# );
#
# This wil sub returns the percentage of 'forgetfullness' when the net learns all the
# data in the set in RANDOM order. Usage:
#
# learn_set_rand(\@data,[ options ]);
#
# Options are options in hash form. They can be of any form that $net->learn takes.
#
# It returns a true value.
#
sub learn_set_rand {
my $self = shift if(substr($_[0],0,4) eq 'AI::');
my $data = shift;
my %args = @_;
my $len = $#{$data}/2-1;
my $inc = $args{inc};
my $max = $args{max};
my $error = $args{error};
my @learned;
while(1) {
_GET_X:
my $x=$self->intr(rand()*$len);
goto _GET_X if($learned[$x]);
$learned[$x]=1;
print "\nLearning index $x...\n" if($AI::NeuralNet::BackProp::DEBUG);
my $str = $self->learn($data->[$x*2], # The list of data to input to the net
$data->[$x*2+1], # The output desired
inc=>$inc, # The starting learning gradient
max=>$max, # The maximum num of loops allowed
error=>$error); # The maximum (%) error allowed
print $str if($AI::NeuralNet::BackProp::DEBUG);
}
return 1;
}
# Returns the index of the element in array REF passed with the highest comparative value
sub high {
shift if(substr($_[0],0,4) eq 'AI::');
my $ref1 = shift;
my ($el,$len,$tmp);
foreach $el (@{$ref1}) {
$len++;
}
$tmp=0;
for my $x (0..$len-1) {
$tmp = $x if((@{$ref1})[$x] > (@{$ref1})[$tmp]);
}
return $tmp;
}
# Returns the index of the element in array REF passed with the lowest comparative value
sub low {
shift if(substr($_[0],0,4) eq 'AI::');
my $ref1 = shift;
my ($el,$len,$tmp);
foreach $el (@{$ref1}) {
$len++;
}
$tmp=0;
for my $x (0..$len-1) {
$tmp = $x if((@{$ref1})[$x] < (@{$ref1})[$tmp]);
}
return $tmp;
}
# Returns a pcx object
sub load_pcx {
my $self = shift;
return AI::NeuralNet::BackProp::PCX->new($self,shift);
}
# Crunch a string of words into a map
sub crunch {
my $self = shift;
my (@map,$ic);
my @ws = split(/[\s\t]/,shift);
for my $a (0..$#ws) {
$ic=$self->crunched($ws[$a]);
if(!defined $ic) {
$self->{_CRUNCHED}->{LIST}->[$self->{_CRUNCHED}->{_LENGTH}++]=$ws[$a];
@map[$a]=$self->{_CRUNCHED}->{_LENGTH};
} else {
@map[$a]=$ic;
}
BackProp.pm view on Meta::CPAN
# then there would be 6 neurons in the {NET}->[] list, and $div would be set to
# 3. So we would loop over and every 3 neurons we would connect each of those 3
# neurons to one input of every neuron in the next set of 3 neurons. Of course, this
# is an example. 3 and 2 are set by the new() constructor.
# Flag values:
# 0 - (default) -
# My feed-foward style: Each neuron in layer X is connected to one input of every
# neuron in layer Y. The best and most proven flag style.
#
# ^ ^ ^
# O\ O\ /O Layer Y
# ^\\/^/\/^
# | //|\/\|
# |/ \|/ \|
# O O O Layer X
# ^ ^ ^
#
# 1 -
# In addition to flag 0, each neuron in layer X is connected to every input of
# the neurons ahead of itself in layer X.
# 2 - ("L-U Style") -
# No, its not "Learning-Unit" style. It gets its name from this: In a 2 layer, 3
# neuron network, the connections form a L-U pair, or a W, however you want to look
# at it.
#
# ^ ^ ^
# | | |
# O-->O-->O
# ^ ^ ^
# | | |
# | | |
# O-->O-->O
# ^ ^ ^
# | | |
#
# As you can see, each neuron is connected to the next one in its layer, as well
# as the neuron directly above itself.
for ($z=0; $z<$div; $z++) {
if((!$flag) || ($flag == 1)) {
for ($aa=0; $aa<$div; $aa++) {
$self->{NET}->[$y+$z]->connect($self->{NET}->[$y+$div+$aa]);
}
}
if($flag == 1) {
for ($aa=$z+1; $aa<$div; $aa++) {
$self->{NET}->[$y+$z]->connect($self->{NET}->[$y+$aa]);
}
}
if($flag == 2) {
$self->{NET}->[$y+$z]->connect($self->{NET}->[$y+$div+$z]);
$self->{NET}->[$y+$z]->connect($self->{NET}->[$y+$z+1]) if($z<$div-1);
}
AI::NeuralNet::BackProp::out1 "\n";
}
AI::NeuralNet::BackProp::out1 "\n";
}
# These next two loops connect the _run and _map packages (the IO interface) to
# the start and end 'layers', respectively. These are how we insert data into
# the network and how we get data from the network. The _run and _map packages
# are connected to the neurons so that the neurons think that the IO packages are
# just another neuron, sending data on. But the IO packs. are special packages designed
# with the same methods as neurons, just meant for specific IO purposes. You will
# never need to call any of the IO packs. directly. Instead, they are called whenever
# you use the run(), map(), or learn() methods of your network.
AI::NeuralNet::BackProp::out2 "\nMapping I (_run package) connections to network...\n";
for($y=0; $y<$div; $y++) {
$self->{_tmp_synapse} = $y;
$self->{NET}->[$y]->register_synapse($self->{RUN});
#$self->{NET}->[$y]->connect($self->{RUN});
}
AI::NeuralNet::BackProp::out2 "Mapping O (_map package) connections to network...\n\n";
for($y=$size-$div; $y<$size; $y++) {
$self->{_tmp_synapse} = $y;
$self->{NET}->[$y]->connect($self->{MAP});
}
# And the group is done!
}
# When called with an array refrence to a pattern, returns a refrence
# to an array associated with that pattern. See usage in documentation.
sub run {
my $self = shift;
my $map = shift;
my $t0 = new Benchmark;
$self->{RUN}->run($map);
$self->{LAST_TIME}=timestr(timediff(new Benchmark, $t0));
return $self->map();
}
# This automatically uncrunches a response after running it
sub run_uc {
$_[0]->uncrunch(run(@_));
}
# Returns benchmark and loop's ran or learned
# for last run(), or learn()
# operation preformed.
#
sub benchmarked {
my $self = shift;
return $self->{LAST_TIME};
}
# Used to retrieve map from last internal run operation.
sub map {
my $self = shift;
$self->{MAP}->map();
}
# Forces network to learn pattern passed and give desired
# results. See usage in POD.
sub learn {
BackProp.pm view on Meta::CPAN
=item AI::NeuralNet::BackProp::_map
These two packages, _run and _map are used to insert data into
the network and used to get data from the network. The _run and _map packages
are connected to the neurons so that the neurons think that the IO packages are
just another neuron, sending data on. But the IO packs. are special packages designed
with the same methods as neurons, just meant for specific IO purposes. You will
never need to call any of the IO packs. directly. Instead, they are called whenever
you use the run() or learn() methods of your network.
=head1 BUGS
This is an alpha release of C<AI::NeuralNet::BackProp>, and that holding true, I am sure
there are probably bugs in here which I just have not found yet. If you find bugs in this module, I would
appreciate it greatly if you could report them to me at F<E<lt>jdb@wcoil.comE<gt>>,
or, even better, try to patch them yourself and figure out why the bug is being buggy, and
send me the patched code, again at F<E<lt>jdb@wcoil.comE<gt>>.
=head1 AUTHOR
Josiah Bryan F<E<lt>jdb@wcoil.comE<gt>>
Copyright (c) 2000 Josiah Bryan. All rights reserved. This program is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
The C<AI::NeuralNet::BackProp> and related modules are free software. THEY COME WITHOUT WARRANTY OF ANY KIND.
=head1 THANKS
Below is a list of people that have helped, made suggestions, patches, etc. No particular order.
Tobias Bronx, tobiasb@odin.funcom.com
Pat Trainor, ptrainor@title14.com
Steve Purkis, spurkis@epn.nu
Rodin Porrata, rodin@ursa.llnl.gov
Daniel Macks dmacks@sas.upenn.edu
Tobias was a great help with the initial releases, and helped with learning options and a great
many helpful suggestions. Rodin has gave me some great ideas for the new internals, as well
as disabling Storable. Steve is the author of AI::Perceptron, and gave some good suggestions for
weighting the neurons. Daniel was a great help with early beta testing of the module and related
ideas. Pat has been a great help for running the module through the works. Pat is the author of
the new Inter game, a in-depth strategy game. He is using a group of neural networks internally
which provides a good test bed for coming up with new ideas for the network. Thankyou for all of
your help, everybody.
=head1 DOWNLOAD
You can always download the latest copy of AI::NeuralNet::BackProp
from http://www.josiah.countystart.com/modules/AI/cgi-bin/rec.pl
=head1 MAILING LIST
A mailing list has been setup for AI::NeuralNet::BackProp for discussion of AI and
neural net related topics as they pertain to AI::NeuralNet::BackProp. I will also
announce in the group each time a new release of AI::NeuralNet::BackProp is available.
The list address is at: ai-neuralnet-backprop@egroups.com
To subscribe, send a blank email to: ai-neuralnet-backprop-subscribe@egroups.com
=cut
( run in 0.685 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )