AI-NNFlex

 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



( run in 1.032 second using v1.01-cache-2.11-cpan-a5abf4f5562 )