view release on metacpan or search on metacpan
examples/bp.pl view on Meta::CPAN
my @weightsHO;
main();
#==============================================================
#********** THIS IS THE MAIN PROGRAM **************************
#==============================================================
sub main
{
# initiate the weights
initWeights();
# load in the data
initData();
# train the network
for(my $j = 0;$j <= $numEpochs;$j++)
examples/bp.pl view on Meta::CPAN
#============================================================
#********** END OF THE MAIN PROGRAM **************************
#=============================================================
#***********************************
sub calcNet()
{
#calculate the outputs of the hidden neurons
#the hidden neurons are tanh
for(my $i = 0;$i<$numHidden;$i++)
{
$hiddenVal[$i] = 0.0;
for(my $j = 0;$j<$numInputs;$j++)
{
examples/bp.pl view on Meta::CPAN
for(my $i = 0;$i<$numHidden;$i++)
{
$outPred = $outPred + $hiddenVal[$i] * $weightsHO[$i];
}
#calculate the error
$errThisPat = $outPred - $trainOutput[$patNum];
}
#************************************
sub WeightChangesHO()
#adjust the weights hidden-output
{
for(my $k = 0;$k<$numHidden;$k++)
{
$weightChange = $LR_HO * $errThisPat * $hiddenVal[$k];
$weightsHO[$k] = $weightsHO[$k] - $weightChange;
#regularisation on the output weights
if ($weightsHO[$k] < -5)
{
examples/bp.pl view on Meta::CPAN
}
elsif ($weightsHO[$k] > 5)
{
$weightsHO[$k] = 5;
}
}
}
#************************************
sub WeightChangesIH()
#adjust the weights input-hidden
{
for(my $i = 0;$i<$numHidden;$i++)
{
for(my $k = 0;$k<$numInputs;$k++)
{
my $x = 1 - ($hiddenVal[$i] * $hiddenVal[$i]);
$x = $x * $weightsHO[$i] * $errThisPat * $LR_IH;
$x = $x * $trainInputs[$patNum][$k];
my $weightChange = $x;
$weightsIH[$k][$i] = $weightsIH[$k][$i] - $weightChange;
}
}
}
#************************************
sub initWeights()
{
for(my $j = 0;$j<$numHidden;$j++)
{
$weightsHO[$j] = (rand() - 0.5)/2;
for(my $i = 0;$i<$numInputs;$i++)
{
$weightsIH[$i][$j] = (rand() - 0.5)/5;
}
}
}
#************************************
sub initData()
{
print "initialising data\n";
# the data here is the XOR data
# it has been rescaled to the range
# [-1][1]
# an extra input valued 1 is also added
# to act as the bias
examples/bp.pl view on Meta::CPAN
$trainInputs[3][0] = -1;
$trainInputs[3][1] = -1;
$trainInputs[3][2] = 1; #bias
$trainOutput[3] = -1;
}
#************************************
sub tanh()
{
my $x = shift;
if ($x > 20){ return 1;}
elsif ($x < -20){ return -1;}
else
{
my $a = exp($x);
my $b = exp(-$x);
return ($a-$b)/($a+$b);
}
}
#************************************
sub displayResults()
{
for(my $i = 0;$i<$numPatterns;$i++)
{
$patNum = $i;
calcNet();
print "pat = ".($patNum+1)." actual = ".$trainOutput[$patNum]." neural model = ".$outPred."\n";
}
}
#************************************
sub calcOverallError()
{
$RMSerror = 0.0;
for(my $i = 0;$i<$numPatterns;$i++)
{
$patNum = $i;
calcNet();
$RMSerror = $RMSerror + ($errThisPat * $errThisPat);
}
$RMSerror = $RMSerror/$numPatterns;
$RMSerror = sqrt($RMSerror);
lib/AI/NNFlex.pm view on Meta::CPAN
use AI::NNFlex::Mathlib;
use base qw(AI::NNFlex::Mathlib);
###############################################################################
# AI::NNFlex::new
###############################################################################
sub new
{
my $class = shift;
my $network={};
bless $network,$class;
# intercept the new style 'empty network' constructor call
# Maybe I should deprecate the old one, but its convenient, provided you
# can follow the mess of hashes
if (!grep /HASH/,@_)
lib/AI/NNFlex.pm view on Meta::CPAN
# Adds a layer of given node definitions to the $network object
#
# syntax
#
# $network->add_layer(nodes=>4,activationfunction=>tanh);
#
# returns bool success or failure
#
###############################################################################
sub add_layer
{
my $network = shift;
my %config = @_;
my $layer = AI::NNFlex::layer->new(\%config);
if ($layer)
{
push @{$network->{'layers'}},$layer;
lib/AI/NNFlex.pm view on Meta::CPAN
else
{
return 0;
}
}
###############################################################################
# AI::NNFlex::output
###############################################################################
sub output
{
my $network = shift;
my %params = @_;
my $finalLayer = ${$$network{'layers'}}[-1];
my $outputLayer;
if (defined $params{'layer'})
{
lib/AI/NNFlex.pm view on Meta::CPAN
{
$_=0;
}
}
}
return $output;
}
################################################################################
# sub init
################################################################################
sub init
{
#Revised version of init for NNFlex
my $network = shift;
my @layers = @{$network->{'layers'}};
# if network debug state not set, set it to null
if (!$network->{'debug'})
{
lib/AI/NNFlex.pm view on Meta::CPAN
}
return 1; # return success if we get to here
}
###############################################################################
# sub $network->dbug
###############################################################################
sub dbug
{
my $network = shift;
my $message = shift;
my $level = shift;
my @DEBUGLEVELS;
# cover for debug calls before the network is created
if (!$network->{'debug'})
{
lib/AI/NNFlex.pm view on Meta::CPAN
{
print "$message\n";
}
}
}
###############################################################################
# AI::NNFlex::dump_state
###############################################################################
sub dump_state
{
my $network = shift;
my %params =@_;
my $filename = $params{'filename'};
my $activations = $params{'activations'};
open (OFILE,">$filename") or return "Can't create weights file $filename";
lib/AI/NNFlex.pm view on Meta::CPAN
}
}
close OFILE;
}
###############################################################################
# sub load_state
###############################################################################
sub load_state
{
my $network = shift;
my %config = @_;
my $filename = $config{'filename'};
open (IFILE,$filename) or return "Error: unable to open $filename because $!";
# we have to build a map of nodeids to objects
lib/AI/NNFlex.pm view on Meta::CPAN
$node->{'activation'} = $stateFromFile{$nodeCounter}->{'activation'};
$node->{'connectedNodesEast'} = $stateFromFile{$nodeCounter}->{'connectedNodesEast'};
$node->{'connectedNodesWest'} = $stateFromFile{$nodeCounter}->{'connectedNodesWest'};
$nodeCounter++;
}
}
return 1;
}
##############################################################################
# sub lesion
##############################################################################
sub lesion
{
my $network = shift;
my %params = @_;
my $return;
$network->dbug("Entered AI::NNFlex::lesion with %params",2);
my $nodeLesion = $params{'nodes'};
my $connectionLesion = $params{'connections'};
lib/AI/NNFlex.pm view on Meta::CPAN
#
# Joins layers or nodes together.
#
# takes fromlayer=>INDEX, tolayer=>INDEX or
# fromnode=>[LAYER,NODE],tonode=>[LAYER,NODE]
#
# returns success or failure
#
#
#########################################################################
sub connect
{
my $network = shift;
my %params = @_;
my $result = 0;
if ($params{'fromnode'})
{
$result = $network->connectnodes(%params);
}
elsif ($params{'fromlayer'})
{
$result = $network->connectlayers(%params);
}
return $result;
}
########################################################################
# AI::NNFlex::connectlayers
########################################################################
sub connectlayers
{
my $network=shift;
my %params = @_;
my $fromlayerindex = $params{'fromlayer'};
my $tolayerindex = $params{'tolayer'};
foreach my $node (@{$network->{'layers'}->[$tolayerindex]->{'nodes'}})
{
foreach my $connectedNode ( @{$network->{'layers'}->[$fromlayerindex]->{'nodes'}})
lib/AI/NNFlex.pm view on Meta::CPAN
push @{$connectedNode->{'connectedNodesEast'}->{'nodes'}},$node;
push @{$node->{'connectedNodesWest'}->{'weights'}},$weight1;
push @{$connectedNode->{'connectedNodesEast'}->{'weights'}},$weight2;
}
}
return 1;
}
##############################################################
# sub AI::NNFlex::connectnodes
##############################################################
sub connectnodes
{
my $network = shift;
my %params = @_;
$params{'tonode'} =~ s/\'//g;
$params{'fromnode'} =~ s/\'//g;
my @tonodeindex = split /,/,$params{'tonode'};
my @fromnodeindex = split /,/,$params{'fromnode'};
#make the connections
lib/AI/NNFlex.pm view on Meta::CPAN
##############################################################
# AI::NNFlex::calcweight
##############################################################
#
# calculate an initial weight appropriate for the network
# settings.
# takes no parameters, returns weight
##############################################################
sub calcweight
{
my $network= shift;
my $weight;
if ($network->{'fixedweights'})
{
$weight = $network->{'fixedweights'};
}
elsif ($network->{'randomweights'})
{
$weight = (rand(2*$network->{'randomweights'}))-$network->{'randomweights'};
lib/AI/NNFlex.pm view on Meta::CPAN
###############################################################################
# Package AI::NNFlex::layer
###############################################################################
###############################################################################
package AI::NNFlex::layer;
###############################################################################
# AI::NNFlex::layer::new
###############################################################################
sub new
{
my $class = shift;
my $params = shift;
my $layer ={};
foreach (keys %{$params})
{
$$layer{$_} = $$params{$_}
}
bless $layer,$class;
lib/AI/NNFlex.pm view on Meta::CPAN
$$layer{'nodes'} = \@nodes;
AI::NNFlex::dbug($params,"Created layer $layer",2);
return $layer;
}
###############################################################################
# AI::NNFlex::layer::layer_output
##############################################################################
sub layer_output
{
my $layer = shift;
my $params = shift;
my @outputs;
foreach my $node (@{$$layer{'nodes'}})
{
push @outputs,$$node{'activation'};
}
return \@outputs;
}
##############################################################################
# sub lesion
##############################################################################
sub lesion
{
my $layer = shift;
my %params = @_;
my $return;
my $nodeLesion = $params{'nodes'};
my $connectionLesion = $params{'connections'};
lib/AI/NNFlex.pm view on Meta::CPAN
###############################################################################
# package AI::NNFlex::node
###############################################################################
###############################################################################
package AI::NNFlex::node;
###############################################################################
# AI::NNFlex::node::new
###############################################################################
sub new
{
my $class = shift;
my $params = shift;
my $node = {};
foreach (keys %{$params})
{
$$node{$_} = $$params{$_}
}
lib/AI/NNFlex.pm view on Meta::CPAN
$$node{'active'} = 1;
$$node{'error'} = 0;
bless $node,$class;
AI::NNFlex::dbug($params,"Created node $node",2);
return $node;
}
##############################################################################
# sub lesion
##############################################################################
sub lesion
{
my $node = shift;
my %params = @_;
my $nodeLesion = $params{'nodes'};
my $connectionLesion = $params{'connections'};
lib/AI/NNFlex/Backprop.pm view on Meta::CPAN
###########################################################
#
package AI::NNFlex::Backprop;
use AI::NNFlex;
use AI::NNFlex::Feedforward;
use base qw(AI::NNFlex::Feedforward AI::NNFlex);
use strict;
sub calc_error
{
my $network = shift;
my $outputPatternRef = shift;
my @outputPattern = @$outputPatternRef;
my @debug = @{$network->{'debug'}};
if (scalar @debug > 0)
{$network->dbug ("Output pattern @outputPattern received by Backprop",4);}
lib/AI/NNFlex/Backprop.pm view on Meta::CPAN
{$network->dbug ("Error on output node $_ = ".$_->{'error'},4);}
}
}
########################################################
# AI::NNFlex::Backprop::learn
########################################################
sub learn
{
my $network = shift;
my $outputPatternRef = shift;
# if this is an incorrect dataset call translate it
if ($outputPatternRef =~/Dataset/)
{
return ($outputPatternRef->learn($network))
lib/AI/NNFlex/Backprop.pm view on Meta::CPAN
# calculate network sqErr
my $Err = $network->RMSErr($outputPatternRef);
return $Err;
}
#########################################################
# AI::NNFlex::Backprop::hiddenToOutput
#########################################################
sub hiddenToOutput
{
my $network = shift;
my @debug = @{$network->{'debug'}};
my $outputLayer = $network->{'layers'}->[-1]->{'nodes'};
foreach my $node (@$outputLayer)
{
my $connectedNodeCounter=0;
lib/AI/NNFlex/Backprop.pm view on Meta::CPAN
$node->{'connectedNodesWest'}->{'weights'}->[$connectedNodeCounter] -= $deltaW;
$connectedNodeCounter++;
}
}
}
######################################################
# AI::NNFlex::Backprop::hiddenOrInputToHidden
######################################################
sub hiddenOrInputToHidden
{
my $network = shift;
my @layers = @{$network->{'layers'}};
my @debug = @{$network->{'debug'}};
# remove the last element (The output layer) from the stack
# because we've already calculated dW on that
lib/AI/NNFlex/Backprop.pm view on Meta::CPAN
}
}
}
#########################################################
# AI::NNFlex::Backprop::RMSErr
#########################################################
sub RMSErr
{
my $network = shift;
my $outputPatternRef = shift;
my @outputPattern = @$outputPatternRef;
my @debug = @{$network->{'debug'}};
my $sqrErr;
lib/AI/NNFlex/Dataset.pm view on Meta::CPAN
#
###########################################################
#
use strict;
package AI::NNFlex::Dataset;
###########################################################
# AI::NNFlex::Dataset::new
###########################################################
sub new
{
my $class = shift;
my $params = shift;
my $dataset;
if ($class =~ /HASH/)
{
$dataset = $class;
$dataset->{'data'} = $params;
return 1;
}
lib/AI/NNFlex/Dataset.pm view on Meta::CPAN
$dataset = \%attributes;
bless $dataset,$class;
return $dataset;
}
###########################################################
# AI::NNFlex::Datasets::run
###########################################################
sub run
{
my $self = shift;
my $network = shift;
my @outputs;
my $counter=0;
for (my $itemCounter=0;$itemCounter<(scalar @{$self->{'data'}});$itemCounter +=2)
{
$network->run(@{$self->{'data'}}[$itemCounter]);
$outputs[$counter] = $network->output();
$counter++;
}
return \@outputs;
}
###############################################################
# AI::NNFlex::Dataset::learn
###############################################################
sub learn
{
my $self = shift;
my $network = shift;
my $error;
for (my $itemCounter=0;$itemCounter<(scalar @{$self->{'data'}});$itemCounter +=2)
{
$network->run(@{$self->{'data'}}[$itemCounter]);
$error += $network->learn(@{$self->{'data'}}[$itemCounter+1]);
}
lib/AI/NNFlex/Dataset.pm view on Meta::CPAN
$error = $error*$error;
return $error;
}
#################################################################
# AI::NNFlex::Dataset::save
#################################################################
# save a dataset in an snns .pat file
#################################################################
sub save
{
my $dataset = shift;
my %config = @_;
open (OFILE,">".$config{'filename'}) or return "File error $!";
print OFILE "No. of patterns : ".((scalar @{$dataset->{'data'}})/2)."\n";
print OFILE "No. of input units : ".(scalar @{$dataset->{'data'}->[0]})."\n";
print OFILE "No. of output units : ".(scalar @{$dataset->{'data'}->[1]})."\n\n";
lib/AI/NNFlex/Dataset.pm view on Meta::CPAN
}
close OFILE;
return 1;
}
#############################################################
# AI::NNFlex::Dataset::load
#############################################################
sub load
{
my $dataset = shift;
my %params = @_;
my @data;
my $filename = $params{'filename'};
if (!$filename)
{
return "No filename specified";
lib/AI/NNFlex/Dataset.pm view on Meta::CPAN
$dataset->new(\@data);
return 1;
}
##########################################################
# AI::NNFlex::Dataset::add
##########################################################
# add an input/output pair to the dataset
##########################################################
sub add
{
my $dataset= shift;
my $params = shift;
if (!$params){return "Nothing to add"};
if ($params !~/ARRAY/){return "Need a reference to an array"}
# support adding single patterns (for Hopfield type nets)
if ($$params[0] !~ /ARRAY/)
{
lib/AI/NNFlex/Dataset.pm view on Meta::CPAN
}
return 1;
}
##################################################################
# AI::NNFlex::Dataset::delete
##################################################################
# delete an item from the dataset by index
##################################################################
sub delete
{
my $dataset = shift;
my $index = shift;
my @indexarray;
if (!$index){return 0}
if ($index =~ /ARRAY/)
{
@indexarray = @$index;
lib/AI/NNFlex/Feedforward.pm view on Meta::CPAN
#Feedforward (i.e. west to east) activation flow on the network.
#
#This class is internal to the NNFlex package, and is included
#in the NNFlex namespace by a require on the networktype parameter.
#
#syntax:
# $network->run([0,1,1,1,0,1,1]);
#
#
###########################################################
sub run
{
my $network = shift;
my $inputPatternRef = shift;
# if this is an incorrect dataset call translate it
if ($inputPatternRef =~/Dataset/)
{
return ($inputPatternRef->run($network))
}
lib/AI/NNFlex/Hopfield.pm view on Meta::CPAN
####################################################
#
# The hopfield network has connections from every
# node to every other node, rather than being
# arranged in distinct layers like a feedforward
# network. We can retain the layer architecture to
# give us blocks of nodes, but need to overload init
# to perform full connections
#
#####################################################
sub init
{
my $network = shift;
my @nodes;
# Get a list of all the nodes in the network
foreach my $layer (@{$network->{'layers'}})
{
foreach my $node (@{$layer->{'nodes'}})
{
lib/AI/NNFlex/Hopfield.pm view on Meta::CPAN
return 1;
}
##########################################################
# AI::NNFlex::Hopfield::run
##########################################################
# apply activation patterns & calculate activation
# through the network
##########################################################
sub run
{
my $network = shift;
my $inputPatternRef = shift;
my @inputpattern = @$inputPatternRef;
if (scalar @inputpattern != scalar @{$network->{'nodes'}})
{
return "Error: input pattern does not match number of nodes"
lib/AI/NNFlex/Hopfield.pm view on Meta::CPAN
return $network->output;
}
#######################################################
# AI::NNFlex::Hopfield::output
#######################################################
# This needs to be overloaded, because the default
# nnflex output method returns only the rightmost layer
#######################################################
sub output
{
my $network = shift;
my @array;
foreach my $node (@{$network->{'nodes'}})
{
unshift @array,$node->{'activation'};
}
return \@array;
}
########################################################
# AI::NNFlex::Hopfield::learn
########################################################
sub learn
{
my $network = shift;
my $dataset = shift;
# calculate the weights
# turn the dataset into a matrix
my @matrix;
foreach (@{$dataset->{'data'}})
{
lib/AI/NNFlex/Mathlib.pm view on Meta::CPAN
#
#######################################################
#Copyright (c) 2004-2005 Charles Colbourn. All rights reserved. This program is free software; you can redistribute it and/or modify
package AI::NNFlex::Mathlib;
use strict;
#######################################################
# tanh activation function
#######################################################
sub tanh
{
my $network = shift;
my $value = shift;
my @debug = @{$network->{'debug'}};
my $a = exp($value);
my $b = exp(-$value);
if ($value > 20){ $value=1;}
lib/AI/NNFlex/Mathlib.pm view on Meta::CPAN
{
my $a = exp($value);
my $b = exp(-$value);
$value = ($a-$b)/($a+$b);
}
if (scalar @debug > 0)
{$network->dbug("Tanh activation returning $value",5)};
return $value;
}
sub tanh_slope
{
my $network = shift;
my $value = shift;
my @debug = @{$network->{'debug'}};
my $return = 1-($value*$value);
if (scalar @debug > 0)
{$network->dbug("Tanh_slope returning $value",5);}
return $return;
}
#################################################################
# Linear activation function
#################################################################
sub linear
{
my $network = shift;
my $value = shift;
my @debug = @{$network->{'debug'}};
if (scalar @debug >0)
{$network->dbug("Linear activation returning $value",5)};
return $value;
}
sub linear_slope
{
my $network = shift;
my $value = shift;
my @debug = @{$network->{'debug'}};
if (scalar @debug >0)
{$network->dbug("Linear slope returning $value",5)};
return $value;
}
############################################################
# P&B sigmoid activation (needs slope)
############################################################
sub sigmoid2
{
my $network = shift;
my $value = shift;
$value = (1+exp(-$value))**-1;
$network->dbug("Sigmoid activation returning $value",5);
return $value;
}
sub sigmoid2_slope
{
my $network = shift;
my $value = shift;
my @debug = @{$network->{'debug'}};
my $return = exp(-$value) * ((1 + exp(-$value)) ** -2);
if (scalar @debug > 0)
{$network->dbug("sigmoid_slope returning $value",5);}
return $return;
}
############################################################
# standard sigmoid activation
############################################################
sub sigmoid
{
my $network = shift;
my $value = shift;
$value = 1/(1+exp(1)**-$value);
$network->dbug("Sigmoid activation returning $value",5);
return $value;
}
sub sigmoid_slope
{
my $network = shift;
my $value = shift;
my @debug = @{$network->{'debug'}};
my $return = $value * (1-$value);
if (scalar @debug > 0)
{$network->dbug("sigmoid_slope returning $value",5);}
return $return;
}
############################################################
# hopfield_threshold
# standard hopfield threshold activation - doesn't need a
# slope (because hopfield networks don't use them!)
############################################################
sub hopfield_threshold
{
my $network = shift;
my $value = shift;
if ($value <0){return -1}
if ($value >0){return 1}
return $value;
}
############################################################
# atanh error function
############################################################
sub atanh
{
my $network = shift;
my $value = shift;
if ($value >-0.5 && $value <0.5)
{
$value = log((1+$value)/(1-$value))/2;
}
return $value;
}
lib/AI/NNFlex/Reinforce.pm view on Meta::CPAN
package AI::NNFlex::Reinforce;
use AI::NNFlex;
use AI::NNFlex::Feedforward;
use base qw(AI::NNFlex AI::NNFlex::Feedforward);
use strict;
###########################################################
#AI::NNFlex::Reinforce::learn
###########################################################
sub learn
{
my $network = shift;
my @layers = @{$network->{'layers'}};
# no connections westwards from input, so no weights to adjust
shift @layers;
# reverse to start with the last layer first