view release on metacpan or  search on metacpan

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

# 0.20 20050307		CColbourn	Modified for inheritance to simplify
#					future network types
#
# 0.21 20050316		CColbourn	Rewrote perldocs, implemented fahlman
#					constant, chopped out old legacy stuff
#					put math functions in mathlib, etc etc
#
# 0.22 20050317		CColbourn	Implemented ::connect method
#
# 0.23 20050424		CColbourn	Included Hopfield module in dist.
#
# 0.24 20050620		CColbourn	Corrected a bug in the bias weight
#					calculation
#
#
###############################################################################
# ToDo
# ====
#
# Modify init to allow recurrent layer/node connections
# write cmd & gui frontends
# Speed the bugger up!
#
# Odd thought - careful coding of a network would allow grafting of
# two different network types or learning algorithms, like an effectve
# single network with 2 layers unsupervised and 2 layers supervised
#
# Clean up the perldocs
#
###############################################################################
$VERSION = "0.24";


###############################################################################
my @DEBUG; 	# a single, solitary, shameful global variable. Couldn't
		#avoid it really. It allows correct control of debug
		#information before the $network object is created
		# (in ::layer->new & ::node->new for  example).


###############################################################################
###############################################################################
# package NNFlex
###############################################################################
###############################################################################
package AI::NNFlex;
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/,@_)
	{
		my %config = @_;
		foreach (keys %config)
		{
			$network->{$_} = $config{$_};
		}

		return $network;
	}

	# Otherwise, continue assuming that the whole network is defined in 
	# a pair of anonymous hashes	



	my $params = shift;
	my $netParams = shift;
	my @layers;
	dbug ($netParams,"Entered AI::NNFlex::new with params $params $netParams",2);


	# clean up case & spaces in layer defs from pre 0.14 constructor calls:
	my $cleanParams;
	foreach my $layer(@{$params})
	{
		my %cleanLayer;
		foreach (keys %$layer)
		{
			my $key = lc($_);
			$key =~ s/\s//g;
			$cleanLayer{$key} = $$layer{$_};
		}
		push @$cleanParams,\%cleanLayer;
	}



	# Network wide parameters (e.g. random weights)
	foreach (keys %$netParams)
	{
		my $key = lc($_);
		$key =~ s/\s//g; # up to 0.14 we had params with spaces in, now deprecated
		$network->{$key} = ${$netParams}{$_};
	}

	if( $network->{'debug'})
	{
		@DEBUG = @{$network->{'debug'}};
	}

	# build the network
	foreach (@$cleanParams)
	{
		if (!($$_{'nodes'})){next}

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

	return 1;
}



##############################################################
# 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'};
	}
	else
	{
		$weight = (rand(2))-1;
	}
				

	return $weight;
}





###############################################################################
###############################################################################
# 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;
	 
	my $numNodes = $$params{'nodes'};
	
	my @nodes;

	for (1..$numNodes)
	{
		push @nodes, AI::NNFlex::node->new($params);
	}

	$$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'};

        # go through the layers & node inactivating random nodes according
        # to probability
        
        foreach my $node (@{$layer->{'nodes'}})
        {
                $return = $node->lesion(%params);
        }

        return $return;

}



###############################################################################
###############################################################################
# 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{$_}
	}	

	if ($$params{'randomactivation'})
	{
		$$node{'activation'} = 
			rand($$params{'random'});
			AI::NNFlex::dbug($params,"Randomly activated at ".$$node{'activation'},2);
	}
	else
	{
		$$node{'activation'} = 0;
	}
	$$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'};

        # go through the layers & node inactivating random nodes according
        # to probability
        
	if ($nodeLesion)
	{
		my $probability = rand(1);
		if ($probability < $nodeLesion)
		{
			$node->{'active'} = 0;
		}
	}

	if ($connectionLesion)
	{
		# init works from west to east, so we should here too
		my $nodeCounter=0;
		foreach my $connectedNode (@{$node->{'connectedNodesEast'}->{'nodes'}})
		{
			my $probability = rand(1);
			if ($probability < $connectionLesion)
			{
				my $reverseNodeCounter=0; # maybe should have done this differntly in init, but 2 late now!
				${$node->{'connectedNodesEast'}->{'nodes'}}[$nodeCounter] = undef;
				foreach my $reverseConnection (@{$connectedNode->{'connectedNodesWest'}->{'nodes'}})
				{
					if ($reverseConnection == $node)
					{
						${$connectedNode->{'connectedNodesEast'}->{'nodes'}}[$reverseNodeCounter] = undef;
					}
					$reverseNodeCounter++;
				}

			}
                                
			$nodeCounter++;
		}


        }
        

        return 1;