view release on metacpan or  search on metacpan

lib/AI/NNFlex/Backprop.pm  view on Meta::CPAN

##########################################################
# AI::NNFlex::Backprop
##########################################################
# Backprop with simple (non adaptive) momentum
##########################################################
# Versions
# ========
#
# 1.0	20050121	CColbourn	New module
# 1.1	20050201	CColbourn	Added call to activation
#					function slope instead
#					of hardcoded 1-y*y
#
# 1.2	20050218	CColbourn	Mod'd to change weight
#					indexing to array for
#					nnflex 0.16
#
# 1.3	20050307	CColbourn	packaged as a subclass of NNFLex
#
# 1.4	20050313	CColbourn	modified the slope function call
#					to avoid using eval
#
# 1.5	20050314	CColbourn	applied fahlman constant
# 					Renamed Backprop.pm, see CHANGES
#
##########################################################
# ToDo
# ----
#
#
###########################################################
#

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


	my $outputLayer = $network->{'layers'}->[-1]->{'nodes'};

	if (scalar @$outputLayer != scalar @outputPattern)
	{	
		$network->dbug ("Wrong number of output values, net has ".scalar @$outputLayer." nodes",0);
		return 0;
	}

	# Now calculate the error
	my $counter=0;
	foreach (@$outputLayer)
	{	
		my $value = $_->{'activation'} - $outputPattern[$counter];


		if ($_->{'errorfunction'})
		{
			my $errorfunction = $_->{'errorfunction'};
			$value = $network->$errorfunction($value);
		}
		
		$_->{'error'} = $value;
		$counter++;
		if (scalar @debug > 0)
		{$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))
	}


	# Set a default value on the Fahlman constant
	if (!$network->{'fahlmanconstant'})
	{
		$network->{'fahlmanconstant'} = 0.1;
	}

	my @outputPattern = @$outputPatternRef;

	$network->calc_error($outputPatternRef);

	#calculate & apply dWs
	$network->hiddenToOutput;
	if (scalar @{$network->{'layers'}} > 2) 
	{
		$network->hiddenOrInputToHidden;
	}

	# 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;
		foreach my $connectedNode (@{$node->{'connectedNodesWest'}->{'nodes'}})
		{
			my $momentum = 0;
			if ($network->{'momentum'})
			{

				if ($node->{'connectedNodesWest'}->{'lastdelta'}->[$connectedNodeCounter])
				{
					$momentum = ($network->{'momentum'})*($node->{'connectedNodesWest'}->{'lastdelta'}->[$connectedNodeCounter]);
				}
			}
			if (scalar @debug > 0)
			{$network->dbug("Learning rate is ".$network->{'learningrate'},4);}
			my $deltaW = (($network->{'learningrate'}) * ($node->{'error'}) * ($connectedNode->{'activation'}));
			$deltaW = $deltaW+$momentum;
			$node->{'connectedNodesWest'}->{'lastdelta'}->[$connectedNodeCounter] = $deltaW;
			
			if (scalar @debug > 0)
			{$network->dbug("Applying delta $deltaW on hiddenToOutput $connectedNode to $node",4);}
			# 
			$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
	pop @layers;

	if (scalar @debug > 0)
	{$network->dbug("Starting Backprop of error on ".scalar @layers." hidden layers",4);}

	foreach my $layer (reverse @layers)
	{
		foreach my $node (@{$layer->{'nodes'}})
		{
			my $connectedNodeCounter=0;
			if (!$node->{'connectedNodesWest'}) {last}

			my $nodeError;
			foreach my $connectedNode (@{$node->{'connectedNodesEast'}->{'nodes'}})
			{
				$nodeError += ($connectedNode->{'error'}) * ($connectedNode->{'connectedNodesWest'}->{'weights'}->[$connectedNodeCounter]);
				$connectedNodeCounter++;
			}

			if (scalar @debug > 0)
			{$network->dbug("Hidden node $node error = $nodeError",4);}

			# Apply error function
			if ($node->{'errorfunction'})
			{
				my $functioncall = $node->{'errorfunction'};
				$nodeError = $network->$functioncall($nodeError);
			}

			$node->{'error'} = $nodeError;


			# update the weights from nodes inputting to here
			$connectedNodeCounter=0;
			foreach my $westNodes (@{$node->{'connectedNodesWest'}->{'nodes'}})
			{
				
				my $momentum = 0;
				if ($network->{'momentum'})
				{
					if($node->{'connectedNodesWest'}->{'lastdelta'}->{$westNodes})
					{
						$momentum = ($network->{'momentum'})*($node->{'connectedNodesWest'}->{'lastdelta'}->{$westNodes});
					}
				}

				# get the slope from the activation function component
				my $value = $node->{'activation'};

				my $functionSlope = $node->{'activationfunction'}."_slope";
				$value = $network->$functionSlope($value);

				# Add the Fahlman constant
				$value += $network->{'fahlmanconstant'};

				$value = $value * $node->{'error'} * $network->{'learningrate'} * $westNodes->{'activation'};

				
				my $dW = $value;
				$dW = $dW + $momentum;
				if (scalar @debug > 0)
				{$network->dbug("Applying deltaW $dW to inputToHidden connection from $westNodes to $node",4);}

				$node->{'connectedNodesWest'}->{'lastdelta'}->{$westNodes} = $dW;

				$node->{'connectedNodesWest'}->{'weights'}->[$connectedNodeCounter] -= $dW;
				if (scalar @debug > 0)
				{$network->dbug("Weight now ".$node->{'connectedNodesWest'}->{'weights'}->[$connectedNodeCounter],4);}
				$connectedNodeCounter++;

			}	


		}
	}
								
				

}

#########################################################
# AI::NNFlex::Backprop::RMSErr
#########################################################
sub RMSErr
{
	my $network = shift;

	my $outputPatternRef = shift;
	my @outputPattern = @$outputPatternRef;

	my @debug = @{$network->{'debug'}};

	my $sqrErr;

	my $outputLayer = $network->{'layers'}->[-1]->{'nodes'};

	if (scalar @$outputLayer != scalar @outputPattern)
	{	
		$network->dbug("Wrong number of output values, net has ".scalar @$outputLayer." nodes",0);
		return 0;
	}

	# Now calculate the error
	my $counter=0;
	foreach (@$outputLayer)
	{	
		my $value = $_->{'activation'} - $outputPattern[$counter];

		$sqrErr += $value *$value;
		$counter++;
		if (scalar @debug > 0)
		{$network->dbug("Error on output node $_ = ".$_->{'error'},4);}
	}

	my $error = sqrt($sqrErr);

	return $error;
}

1;

=pod

=head1 NAME

AI::NNFlex::Backprop - a fast, pure perl backprop Neural Net simulator

=head1 SYNOPSIS

 use AI::NNFlex::Backprop;

 my $network = AI::NNFlex::Backprop->new(config parameter=>value);

 $network->add_layer(nodes=>x,activationfunction=>'function');

 $network->init(); 



 use AI::NNFlex::Dataset;

 my $dataset = AI::NNFlex::Dataset->new([
			[INPUTARRAY],[TARGETOUTPUT],
			[INPUTARRAY],[TARGETOUTPUT]]);