AI-NeuralNet-BackProp
view release on metacpan or search on metacpan
BackProp.pm view on Meta::CPAN
}
}
print "\n";
}
# Returns percentage difference between all elements of two
# array refs of exact same length (in elements).
# 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);
}
BackProp.pm view on Meta::CPAN
$_[++$#_] = $b;
$ref = \@_;
#print "Found ranged definition, joined to ",join(',',@{$ref}),"\n";
}
}
my $rA = 0;
my $rB = $#{$ref};
my $rS = 0; #shift;
if(!$rA && !$rB) {
$self->{rA}=$self->{rB}=-1;
return undef;
}
if($rB<$rA){my $t=$rA;$rA=$rB;$rB=$t};
$self->{rA}=$rA;
$self->{rB}=$rB;
$self->{rS}=$rS if($rS);
$self->{rRef} = $ref;
return $ref;
}
# Used internally to scale outputs to fit range
sub _range {
my $self = shift;
my $in = shift;
my $rA = $self->{rA};
my $rB = $self->{rB};
my $rS = $self->{rS};
my $r = $rB;#-$rA+1;
return $in if(!$rA && !$rB);
my $l = $self->{OUT}-1;
my $out = [];
# Adjust for a maximum outside what we have seen so far
for my $i (0..$l) {
$rS=$in->[$i] if($in->[$i]>$rS);
}
#print "\$l:$l,\$rA:$rA,\$rB:$rB,\$rS:$rS,\$r:$r\n";
# Loop through, convert values to percentage of maximum, then multiply
# percentage by range and add to base of range to get finaly value
for my $i (0..$l) {
#print "\$i:$i,\$in:$in->[$i]\n";
$rS=1 if(!$rS);
my $t=intr((($rS-$in->[$i])/$rS)*$r+$rA);
#print "t:$t,$self->{rRef}->[$t],i:$i\n";
$out->[$i] = $self->{rRef}->[$t];
}
$self->{rS}=$rS;
return $out;
}
# Initialzes the base for a new neural network.
# It is recomended that you call learn() before run()ing a pattern.
# See documentation above for usage.
sub new {
no strict;
my $type = shift;
my $self = {};
my $layers = shift;
my $size = shift;
my $out = shift || $size;
my $flag = shift || 0;
bless $self, $type;
# If $layers is a string, then it will be nummerically equal to 0, so try to load it
# as a network file.
if($layers == 0) {
# We use a "1" flag as the second argument to indicate that we want load()
# to call the new constructor to make a network the same size as in the file
# and return a refrence to the network, instead of just creating the network from
# pre-exisiting refrence
return $self->load($layers,1);
}
#print "Creating $size neurons in each layer for $layers layer(s)...\n";
AI::NeuralNet::BackProp::out2 "Creating $size neurons in each layer for $layers layer(s)...\n";
# Error checking
return undef if($out>$size);
# When this is called, they tell us howmany layers and neurons in each layer.
# But really what we store is a long line of neurons that are only divided in theory
# when connecting the outputs and inputs.
my $div = $size;
my $size = $layers * $size;
AI::NeuralNet::BackProp::out2 "Creating RUN and MAP systems for network...\n";
#print "Creating RUN and MAP systems for network...\n";
# Create a new runner and mapper for the network.
$self->{RUN} = new AI::NeuralNet::BackProp::_run($self);
$self->{MAP} = new AI::NeuralNet::BackProp::_map($self);
$self->{SIZE} = $size;
$self->{DIV} = $div;
$self->{OUT} = $out;
$self->{FLAG} = $flag;
$self->{col_width}= 5;
$self->{random} = 0.001;
$self->initialize_group();
return $self;
}
# Save entire network state to disk.
sub save {
my $self = shift;
my $file = shift;
my $size = $self->{SIZE};
my $div = $self->{DIV};
my $out = $self->{OUT};
my $flag = $self->{FLAG};
open(FILE,">$file");
print FILE "size=$size\n";
print FILE "div=$div\n";
print FILE "out=$out\n";
print FILE "flag=$flag\n";
print FILE "rand=$self->{random}\n";
print FILE "cw=$self->{col_width}\n";
print FILE "crunch=$self->{_CRUNCHED}->{_LENGTH}\n";
print FILE "rA=$self->{rA}\n";
print FILE "rB=$self->{rB}\n";
print FILE "rS=$self->{rS}\n";
print FILE "rRef=",(($self->{rRef})?join(',',@{$self->{rRef}}):''),"\n";
for my $a (0..$self->{_CRUNCHED}->{_LENGTH}-1) {
print FILE "c$a=$self->{_CRUNCHED}->{LIST}->[$a]\n";
}
my $w;
for my $a (0..$self->{SIZE}-1) {
$w="";
for my $b (0..$self->{DIV}-1) {
$w .= "$self->{NET}->[$a]->{SYNAPSES}->{LIST}->[$b]->{WEIGHT},";
}
chop($w);
print FILE "n$a=$w\n";
}
close(FILE);
return $self;
}
# Load entire network state from disk.
sub load {
my $self = shift;
my $file = shift;
my $load_flag = shift || 0;
return undef if(!(-f $file));
open(FILE,"$file");
my @lines=<FILE>;
close(FILE);
my %db;
for my $line (@lines) {
chomp($line);
my ($a,$b) = split /=/, $line;
$db{$a}=$b;
}
return undef if(!$db{"size"});
if($load_flag) {
undef $self;
# Create new network
$self = AI::NeuralNet::BackProp->new(intr($db{"size"}/$db{"div"}),
$db{"div"},
$db{"out"},
$db{"flag"});
} else {
$self->{DIV} = $db{"div"};
$self->{SIZE} = $db{"size"};
$self->{OUT} = $db{"out"};
$self->{FLAG} = $db{"flag"};
}
# Load variables
$self->{col_width} = $db{"cw"};
$self->{random} = $db{"rand"};
$self->{rA} = $db{"rA"};
$self->{rB} = $db{"rB"};
$self->{rS} = $db{"rS"};
my @tmp = split /\,/, $db{"rRef"};
$self->{rRef} = \@tmp;
$self->{_CRUNCHED}->{_LENGTH} = $db{"crunch"};
for my $a (0..$self->{_CRUNCHED}->{_LENGTH}-1) {
$self->{_CRUNCHED}->{LIST}->[$a] = $db{"c$a"};
}
$self->initialize_group();
my ($w,@l);
for my $a (0..$self->{SIZE}-1) {
$w=$db{"n$a"};
@l=split /\,/, $w;
for my $b (0..$self->{DIV}-1) {
$self->{NET}->[$a]->{SYNAPSES}->{LIST}->[$b]->{WEIGHT}=$l[$b];
}
}
return $self;
}
# Dumps the complete weight matrix of the network to STDIO
sub show {
my $self = shift;
for my $a (0..$self->{SIZE}-1) {
print "Neuron $a: ";
for my $b (0..$self->{DIV}-1) {
print $self->{NET}->[$a]->{SYNAPSES}->{LIST}->[$b]->{WEIGHT},"\t";
}
print "\n";
}
}
# Used internally by new() and learn().
# This is the sub block that actually creats
# the connections between the synapse chains and
# also connects the run packages and the map packages
# to the appropiate ends of the neuron grids.
sub initialize_group() {
my $self = shift;
my $size = $self->{SIZE};
my $div = $self->{DIV};
my $out = $self->{OUT};
my $flag = $self->{FLAG};
my $x = 0;
my $y = 0;
# Reset map and run synapse counters.
$self->{RUN}->{REGISTRATION} = $self->{MAP}->{REGISTRATION} = 0;
AI::NeuralNet::BackProp::out2 "There will be $size neurons in this network group, with a divison value of $div.\n";
#print "There will be $size neurons in this network group, with a divison value of $div.\n";
# Create initial neuron packages in one long array for the entire group
for($y=0; $y<$size; $y++) {
#print "Initalizing neuron $y... \r";
$self->{NET}->[$y]=new AI::NeuralNet::BackProp::neuron();
}
AI::NeuralNet::BackProp::out2 "Creating synapse grid...\n";
my $z = 0;
my $aa = 0;
my ($n0,$n1,$n2);
# Outer loop loops over every neuron in group, incrementing by the number
# of neurons supposed to be in each layer
for($y=0; $y<$size; $y+=$div) {
if($y+$div>=$size) {
last;
}
# Inner loop connects every neuron in this 'layer' to one input of every neuron in
# the next 'layer'. Remeber, layers only exist in terms of where the connections
# are divided. For example, if a person requested 2 layers and 3 neurons per layer,
# 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 {
my $self = shift;
my $omap = shift;
my $res = shift;
my %args = @_;
my $inc = $args{inc} || 0.20;
my $max = $args{max} || 1024;
my $_mx = intr($max/10);
my $_mi = 0;
my $error = ($args{error}>-1 && defined $args{error}) ? $args{error} : -1;
my $div = $self->{DIV};
my $size = $self->{SIZE};
my $out = $self->{OUT};
my $divide = AI::NeuralNet::BackProp->intr($div/$out);
my ($a,$b,$y,$flag,$map,$loop,$diff,$pattern,$value);
my ($t0,$it0);
no strict 'refs';
# Take care of crunching strings passed
$omap = $self->crunch($omap) if($omap == 0);
$res = $self->crunch($res) if($res == 0);
# Fill in empty spaces at end of results matrix with a 0
if($#{$res}<$out) {
for my $x ($#{$res}+1..$out) {
#$res->[$x] = 0;
}
}
# Debug
AI::NeuralNet::BackProp::out1 "Num output neurons: $out, Input neurons: $size, Division: $divide\n";
# Start benchmark timer and initalize a few variables
$t0 = new Benchmark;
$flag = 0;
$loop = 0;
my $ldiff = 0;
my $dinc = 0.0001;
my $cdiff = 0;
$diff = 100;
$error = ($error>-1)?$error:-1;
# $flag only goes high when all neurons in output map compare exactly with
# desired result map or $max loops is reached
#
while(!$flag && ($max ? $loop<$max : 1)) {
$it0 = new Benchmark;
# Run the map
$self->{RUN}->run($omap);
# Retrieve last mapping and initialize a few variables.
$map = $self->map();
$y = $size-$div;
$flag = 1;
# Compare the result map we just ran with the desired result map.
$diff = pdiff($map,$res);
# This adjusts the increment multiplier to decrease as the loops increase
if($_mi > $_mx) {
$dinc *= 0.1;
$_mi = 0;
}
$_mi++;
# We de-increment the loop ammount to prevent infinite learning loops.
# In old versions of this module, if you used too high of an initial input
# $inc, then the network would keep jumping back and forth over your desired
# results because the increment was too high...it would try to push close to
# the desired result, only to fly over the other edge too far, therby trying
# to come back, over shooting again.
# This simply adjusts the learning gradient proportionally to the ammount of
# convergance left as the difference decreases.
$inc -= ($dinc*$diff);
$inc = 0.0000000001 if($inc < 0.0000000001);
# This prevents it from seeming to get stuck in one location
# by attempting to boost the values out of the hole they seem to be in.
if($diff eq $ldiff) {
$cdiff++;
$inc += ($dinc*$diff)+($dinc*$cdiff*10);
} else {
$cdiff=0;
}
# Save last $diff
$ldiff = $diff;
# This catches a max error argument and handles it
if(!($error>-1 ? $diff>$error : 1)) {
$flag=1;
last;
}
# Debugging
AI::NeuralNet::BackProp::out4 "Difference: $diff\%\t Increment: $inc\tMax Error: $error\%\n";
AI::NeuralNet::BackProp::out1 "\n\nMapping results from $map:\n";
# This loop compares each element of the output map with the desired result map.
# If they don't match exactly, we call weight() on the offending output neuron
# and tell it what it should be aiming for, and then the offending neuron will
# try to adjust the weights of its synapses to get closer to the desired output.
# See comments in the weight() method of AI::NeuralNet::BackProp for how this works.
my $l=$self->{NET};
for my $i (0..$out-1) {
$a = $map->[$i];
$b = $res->[$i];
AI::NeuralNet::BackProp::out1 "\nmap[$i] is $a\n";
AI::NeuralNet::BackProp::out1 "res[$i] is $b\n";
for my $j (0..$divide-1) {
if($a!=$b) {
AI::NeuralNet::BackProp::out1 "Punishing $self->{NET}->[($i*$divide)+$j] at ",(($i*$divide)+$j)," ($i with $a) by $inc.\n";
$l->[$y+($i*$divide)+$j]->weight($inc,$b) if($l->[$y+($i*$divide)+$j]);
$flag = 0;
}
}
}
# This counter is just used in the benchmarking operations.
$loop++;
AI::NeuralNet::BackProp::out1 "\n\n";
# Benchmark this loop.
AI::NeuralNet::BackProp::out4 "Learning itetration $loop complete, timed at".timestr(timediff(new Benchmark, $it0),'noc','5.3f')."\n";
# Map the results from this loop.
AI::NeuralNet::BackProp::out4 "Map: \n";
AI::NeuralNet::BackProp::join_cols($map,$self->{col_width}) if ($AI::NeuralNet::BackProp::DEBUG);
AI::NeuralNet::BackProp::out4 "Res: \n";
AI::NeuralNet::BackProp::join_cols($res,$self->{col_width}) if ($AI::NeuralNet::BackProp::DEBUG);
}
# Compile benchmarking info for entire learn() process and return it, save it, and
# display it.
$self->{LAST_TIME}="$loop loops and ".timestr(timediff(new Benchmark, $t0));
my $str = "Learning took $loop loops and ".timestr(timediff(new Benchmark, $t0),'noc','5.3f');
AI::NeuralNet::BackProp::out2 $str;
return $str;
}
1;
# Internal input class. Not to be used directly.
package AI::NeuralNet::BackProp::_run;
use strict;
# Dummy constructor.
sub new {
bless { PARENT => $_[1] }, $_[0]
}
# This is so we comply with the neuron interface.
sub weight {}
sub input {}
# Again, compliance with neuron interface.
sub register_synapse {
my $self = shift;
my $sid = $self->{REGISTRATION} || 0;
$self->{REGISTRATION} = ++$sid;
$self->{RMAP}->{$sid-1} = $self->{PARENT}->{_tmp_synapse};
return $sid-1;
}
# Here is the real meat of this package.
# run() does one thing: It fires values
# into the first layer of the network.
sub run {
my $self = shift;
my $map = shift;
my $x = 0;
$map = $self->{PARENT}->crunch($map) if($map == 0);
return undef if(substr($map,0,5) ne "ARRAY");
foreach my $el (@{$map}) {
# Catch ourself if we try to run more inputs than neurons
return $x if($x>$self->{PARENT}->{DIV}-1);
# Here we add a small ammount of randomness to the network.
# This is to keep the network from getting stuck on a 0 value internally.
$self->{PARENT}->{NET}->[$x]->input(0,$el+(rand()*$self->{ramdom}));
$x++;
};
# Incase we tried to run less inputs than neurons, run const 1 in extra neurons
if($x<$self->{PARENT}->{DIV}) {
for my $y ($x..$self->{PARENT}->{DIV}-1) {
$self->{PARENT}->{NET}->[$y]->input(0,1);
}
}
return $x;
}
1;
# Internal output class. Not to be used directly.
package AI::NeuralNet::BackProp::_map;
use strict;
# Dummy constructor.
sub new {
bless { PARENT => $_[1] }, $_[0]
}
# Compliance with neuron interface
sub weight {}
# Compliance with neuron interface
sub register_synapse {
my $self = shift;
my $sid = $self->{REGISTRATION} || 0;
$self->{REGISTRATION} = ++$sid;
$self->{RMAP}->{$sid-1} = $self->{PARENT}->{_tmp_synapse};
return $sid-1;
}
# This acts just like a regular neuron by receiving
# values from input synapes. Yet, unlike a regularr
# neuron, it doesnt weight the values, just stores
# them to be retrieved by a call to map().
sub input {
no strict 'refs';
my $self = shift;
my $sid = shift;
my $value = shift;
my $size = $self->{PARENT}->{DIV};
my $flag = 1;
$self->{OUTPUT}->[$sid]->{VALUE} = $self->{PARENT}->intr($value);
$self->{OUTPUT}->[$sid]->{FIRED} = 1;
AI::NeuralNet::BackProp::out1 "Received value $self->{OUTPUT}->[$sid]->{VALUE} and sid $sid, self $self.\n";
}
# Here we simply collect the value of every neuron connected to this
# one from the layer below us and return an array ref to the final map..
sub map {
my $self = shift;
my $size = $self->{PARENT}->{DIV};
my $out = $self->{PARENT}->{OUT};
my $divide = AI::NeuralNet::BackProp->intr($size/$out);
my @map = ();
my $value;
AI::NeuralNet::BackProp::out1 "Num output neurons: $out, Input neurons: $size, Division: $divide\n";
for(0..$out-1) {
$value=0;
for my $a (0..$divide-1) {
$value += $self->{OUTPUT}->[($_*$divide)+$a]->{VALUE};
AI::NeuralNet::BackProp::out1 "\$a is $a, index is ".(($_*$divide)+$a).", value is $self->{OUTPUT}->[($_*$divide)+$a]->{VALUE}\n";
}
$map[$_] = AI::NeuralNet::BackProp->intr($value/$divide);
AI::NeuralNet::BackProp::out1 "Map position $_ is $map[$_] in @{[\@map]} with self set to $self.\n";
$self->{OUTPUT}->[$_]->{FIRED} = 0;
}
my $ret=\@map;
return $self->{PARENT}->_range($ret);
}
1;
# load_pcx() wrapper package
package AI::NeuralNet::BackProp::PCX;
# Called by load_pcx in AI::NeuralNet::BackProp;
sub new {
my $type = shift;
my $self = {
parent => $_[0],
file => $_[1]
};
my (@a,@b)=load_pcx($_[1]);
$self->{image}=\@a;
$self->{palette}=\@b;
bless \%{$self}, $type;
}
# Returns a rectangular block defined by an array ref in the form of
# [$x1,$y1,$x2,$y2]
# Return value is an array ref
sub get_block {
my $self = shift;
my $ref = shift;
my ($x1,$y1,$x2,$y2) = @{$ref};
my @block = ();
my $count = 0;
for my $x ($x1..$x2-1) {
for my $y ($y1..$y2-1) {
$block[$count++] = $self->get($x,$y);
}
BackProp.pm view on Meta::CPAN
my $result = $net->run(\@map);
Now, this call would probably not give what you want, because
the network hasn't "learned" any patterns yet. But this
illustrates the call. Run now allows strings to be used as
input. See run() for more information.
Run returns a refrence with $size elements (Remember $size? $size
is what you passed as the second argument to the network
constructor.) This array contains the results of the mapping. If
you ran the example exactly as shown above, $result would probably
contain (1,1) as its elements.
To make the network learn a new pattern, you simply call the learn
method with a sample input and the desired result, both array
refrences of $size length. Example:
use AI;
my $net = new AI::NeuralNet::BackProp(2,2);
my @map = (0,1);
my @res = (1,0);
$net->learn(\@map,\@res);
my $result = $net->run(\@map);
Now $result will conain (1,0), effectivly flipping the input pattern
around. Obviously, the larger $size is, the longer it will take
to learn a pattern. Learn() returns a string in the form of
Learning took X loops and X wallclock seconds (X.XXX usr + X.XXX sys = X.XXX CPU).
With the X's replaced by time or loop values for that loop call. So,
to view the learning stats for every learn call, you can just:
print $net->learn(\@map,\@res);
If you call "$net->debug(4)" with $net being the
refrence returned by the new() constructor, you will get benchmarking
information for the learn function, as well as plenty of other information output.
See notes on debug() in the METHODS section, below.
If you do call $net->debug(1), it is a good
idea to point STDIO of your script to a file, as a lot of information is output. I often
use this command line:
$ perl some_script.pl > .out
Then I can simply go and use emacs or any other text editor and read the output at my leisure,
rather than have to wait or use some 'more' as it comes by on the screen.
=head2 METHODS
=over 4
=item new AI::NeuralNet::BackProp($layers, $size [, $outputs, $topology_flag])
Returns a newly created neural network from an C<AI::NeuralNet::BackProp>
object. The network will have C<$layers> number layers in it
and each layer will have C<$size> number of neurons in that layer.
There is an optional parameter of $outputs, which specifies the number
of output neurons to provide. If $outputs is not specified, $outputs
defaults to equal $size. $outputs may not exceed $size. If $outputs
exceeds $size, the new() constructor will return undef.
The optional parameter, $topology_flag, defaults to 0 when not used. There are
three valid topology flag values:
B<0> I<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
^ ^ ^
(Sorry about the bad art...I am no ASCII artist! :-)
B<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.
B<2> I<("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.
Before you can really do anything useful with your new neural network
object, you need to teach it some patterns. See the learn() method, below.
=item $net->learn($input_map_ref, $desired_result_ref [, options ]);
This will 'teach' a network to associate an new input map with a desired resuly.
It will return a string containg benchmarking information. You can retrieve the
pattern index that the network stored the new input map in after learn() is complete
with the pattern() method, below.
UPDATED: You can now specify strings as inputs and ouputs to learn, and they will be crunched
automatically. Example:
$net->learn('corn', 'cob');
# Before update, you have had to do this:
# $net->learn($net->crunch('corn'), $net->crunch('cob'));
Note, the old method of calling crunch on the values still works just as well.
UPDATED: You can now learn inputs with a 0 value. Beware though, it may not learn() a 0 value
in the input map if you have randomness disabled. See NOTES on using a 0 value with randomness
disabled.
The first two arguments may be array refs (or now, strings), and they may be of different lengths.
Options should be written on hash form. There are three options:
inc => $learning_gradient
max => $maximum_iterations
error => $maximum_allowable_percentage_of_error
$learning_gradient is an optional value used to adjust the weights of the internal
connections. If $learning_gradient is ommitted, it defaults to 0.20.
$maximum_iterations is the maximum numbers of iteration the loop should do.
It defaults to 1024. Set it to 0 if you never want the loop to quit before
the pattern is perfectly learned.
$maximum_allowable_percentage_of_error is the maximum allowable error to have. If
this is set, then learn() will return when the perecentage difference between the
actual results and desired results falls below $maximum_allowable_percentage_of_error.
If you do not include 'error', or $maximum_allowable_percentage_of_error is set to -1,
then learn() will not return until it gets an exact match for the desired result OR it
reaches $maximum_iterations.
=item $net->learn_set(\@set, [ options ]);
UPDATE: Inputs and outputs in the dataset can now be strings. See information on auto-crunching
in learn()
This takes the same options as learn() and allows you to specify a set to learn, rather
than individual patterns. A dataset is an array refrence with at least two elements in the
array, each element being another array refrence (or now, a scalar string). For each pattern to
learn, you must specify an input array ref, and an ouput array ref as the next element. Example:
my @set = (
# inputs outputs
[ 1,2,3,4 ], [ 1,3,5,6 ],
[ 0,2,5,6 ], [ 0,2,1,2 ]
);
See the paragraph on measuring forgetfulness, below. There are
two learn_set()-specific option tags available:
flag => $flag
pattern => $row
If "flag" is set to some TRUE value, as in "flag => 1" in the hash of options, or if the option "flag"
is not set, then it will return a percentage represting the amount of forgetfullness. Otherwise,
learn_set() will return an integer specifying the amount of forgetfulness when all the patterns
are learned.
If "pattern" is set, then learn_set() will use that pattern in the data set to measure forgetfulness by.
If "pattern" is omitted, it defaults to the first pattern in the set. Example:
my @set = (
[ 0,1,0,1 ], [ 0 ],
[ 0,0,1,0 ], [ 1 ],
[ 1,1,0,1 ], [ 2 ], # <---
[ 0,1,1,0 ], [ 3 ]
);
If you wish to measure forgetfulness as indicated by the line with the arrow, then you would
pass 2 as the "pattern" option, as in "pattern => 2".
Now why the heck would anyone want to measure forgetfulness, you ask? Maybe you wonder how I
even measure that. Well, it is not a vital value that you have to know. I just put in a
"forgetfulness measure" one day because I thought it would be neat to know.
How the module measures forgetfulness is this: First, it learns all the patterns in the set provided,
then it will run the very first pattern (or whatever pattern is specified by the "row" option)
in the set after it has finished learning. It will compare the run() output with the desired output
as specified in the dataset. In a perfect world, the two should match exactly. What we measure is
how much that they don't match, thus the amount of forgetfulness the network has.
NOTE: In version 0.77 percentages were disabled because of a bug. Percentages are now enabled.
Example (from examples/ex_dow.pl):
# Data from 1989 (as far as I know..this is taken from example data on BrainMaker)
my @data = (
# Mo CPI CPI-1 CPI-3 Oil Oil-1 Oil-3 Dow Dow-1 Dow-3 Dow Ave (output)
[ 1, 229, 220, 146, 20.0, 21.9, 19.5, 2645, 2652, 2597], [ 2647 ],
[ 2, 235, 226, 155, 19.8, 20.0, 18.3, 2633, 2645, 2585], [ 2637 ],
[ 3, 244, 235, 164, 19.6, 19.8, 18.1, 2627, 2633, 2579], [ 2630 ],
[ 4, 261, 244, 181, 19.6, 19.6, 18.1, 2611, 2627, 2563], [ 2620 ],
[ 5, 276, 261, 196, 19.5, 19.6, 18.0, 2630, 2611, 2582], [ 2638 ],
[ 6, 287, 276, 207, 19.5, 19.5, 18.0, 2637, 2630, 2589], [ 2635 ],
[ 7, 296, 287, 212, 19.3, 19.5, 17.8, 2640, 2637, 2592], [ 2641 ]
);
# Learn the set
my $f = learn_set(\@data,
inc => 0.1,
max => 500,
p => 1
);
# Print it
print "Forgetfullness: $f%";
This is a snippet from the example script examples/ex_dow.pl, which demonstrates DOW average
prediction for the next month. A more simple set defenition would be as such:
my @data = (
[ 0,1 ], [ 1 ],
[ 1,0 ], [ 0 ]
( run in 1.052 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )