add perl example code

perl-example/activate.xor.c

@@ -0,0 +1,43 @@
+{
+	double          n_4639, n_4920, n_601, n_1863, n_7065, n_output;
+	n_4639 = 1 / (1 + exp(-1 * 5 * (
+		   0.0000000000000000000000000000000000000000000000000000000
+					+ (n_one * -0.7865729571529459507317483257793355733156204223632812500)
+	+ (n_two * 0.8809346930053569835195048653986304998397827148437500000)
+					)));
+	n_4920 = 1 / (1 + exp(-1 * 5 * (
+		   0.0000000000000000000000000000000000000000000000000000000
+	+ (n_one * 0.8143148554908640202043557110300753265619277954101562500)
+					+ (n_4639 * 0.7663975023791630425407106486090924590826034545898437500)
+					+ (n_two * -0.2546305433438110221722183723613852635025978088378906250)
+					)));
+	n_601 = 1 / (1 + exp(-1 * 5 * (
+		   0.3050293740764479788474261567898793146014213562011718750
+				       + (n_one * -1.7579643686798800406023701725644059479236602783203125000)
+				       + (n_4639 * -0.7117026436492900343111500660597812384366989135742187500)
+				       + (n_4920 * 0.6600543182741239744970584979455452412366867065429687500)
+				       + (n_two * -1.0312303447979600523609633455635048449039459228515625000)
+				       )));
+	n_1863 = 1 / (1 + exp(-1 * 5 * (
+		   0.0000000000000000000000000000000000000000000000000000000
+	+ (n_one * 0.4067102473422800068547644514183048158884048461914062500)
+					+ (n_4639 * 0.8935708684473929741542974625190254300832748413085937500)
+					+ (n_two * -0.0171564060099979008577886219200081541202962398529052734)
+	+ (n_601 * 0.5111012475277429967235320873442105948925018310546875000)
+					)));
+	n_7065 = 1 / (1 + exp(-1 * 5 * (
+		  -0.0614492704162033429038380916153982980176806449890136719
+					+ (n_4639 * 0.7968332799177390013412036751105915755033493041992187500)
+	+ (n_601 * 0.5417244666303689948350097438378725200891494750976562500)
+					)));
+	n_output = 1 / (1 + exp(-1 * 5 * (
+		   0.0520650055457407973102945675236696843057870864868164062
+					  + (n_1863 * -3.8456383168042500564354213565820828080177307128906250000)
+					  + (n_one * 10.0000000000000000000000000000000000000000000000000000000)
+					  + (n_4920 * 0.1524713339586759863752973842565552331507205963134765625)
+					  + (n_7065 * -0.2138580237347930124158779108256567269563674926757812500)
+					  + (n_two * 10.0000000000000000000000000000000000000000000000000000000)
+					  + (n_601 * -2.4282240918724999900746297498699277639389038085937500000)
+					  )));
+	return n_output;
+}

perl-example/neat.txt

@@ -0,0 +1,176 @@
+Generations
+
+# calculate number of offspring allowed per species
+for each species, 
+	identify the average and the min/max fitness values
+	add 1 to all of those numbers (for mathematical simplicity)
+take the sum of the averages
+for each species
+	divide the total by the species average
+	multiply that number by the target population size
+	subtract from it that number times stagnant generations count
+	store the floor()ed result as allowed offspring count
+count the total offspring allocated above
+if less than target population size
+	allocate remaining to most-fit species
+for each species
+	multiply offspring by 10% to get the 'elitism' offspring count
+	if elitism less than 2, set it at 2
+	if this is more than the total offspring allowed, species dies
+	subtract the elitism count from the allowed count to get remaining
+	allocate 50% to be created via crossover
+		50% will include only some weights from less fit parent
+		50% will include one additional structural element, too
+	and the other 50% via mutation
+		all of which are weight adjusted by up to 10% per weight
+		65% of which are by weight adjustment only
+		20% add a new connection
+		10% split a current connection / add node
+		 5% delete an existing connection
+
+# identify rankings within species
+for each species, 
+	make a list of members sorted by fitness, descending
+
+# identify dominance within species
+# used to determine breeding priority
+for each species
+	calculate sum of fitness values of all members of species
+	for each member of species
+		calculate fitness / sum of fitness
+
+# elitism
+take the first N networks from the sorted species member list
+copy each one, verbatim, to the next generation
+
+# mutation
+for each species
+	calculate 'remaining' as number of mutation offspring allowed
+	for each member of the species, in fitness order (descending)
+		multiply its dominance value times allowed offspring
+		round() the number to the nearest integer.
+		if number is 0, round up to 1
+		if number is greater than remaining, reduce to remaining
+		while this number is > 0
+			create a new mutation of this organism
+			and copy it to the next generation
+			decrement the number, and the 'remaining' number
+		if 'remaining' is 0, exit loop
+
+	# to mutate a single organism
+	copy the organism to a new structure
+	give the new one a new ID
+	for each connection
+		assign a new weight that is +/- up to 10% of current value
+	save random() number
+	if random < delete threshold, delete a connection
+	else if < split threshold, split a connection
+	else if < add threshold, add a connection
+
+# crossover
+for each species
+	calculate 'remaining' as number of offspring allowed, times 2
+	for each member of the species, in fitness order (descending)
+		multiply its dominance value times allowed offspring
+		round() the number to the nearest integer.
+		if number is 0, round up to 1
+		if number is greater than remaining, reduce to remaining
+		push this member onto a list of breeders <number> times
+	randomize the list of breeders
+	while the list of breeders is not empty
+		pop the first entry off the front of the list
+		search the list for the first entry that is not the same
+		while the first entry is the same as the other entry
+			pop it off and push it on to the end
+		crossover these two to make a new one
+
+	# to crossover two specimens
+	copy the more fit parent's genome
+	for each connection in the more fit parent's genome
+		if a match occurs in less fit parent
+			50/50 chance of using the weight from the less fit parent
+	50/50 chance of selecting ONE structural element from the less
+		fit parent and copying it into the new genome
+	move the newly created offspring into the next generation
+
+# speciation
+-initially, each member belongs to the species of its parents.
+-if two organisms have the same structure, they belong in the same 
+species, regardless of who their parents were.
+
+for every member of the population
+	compose a string representing the structure of the network
+	store a hash entry with structure as key
+	store in the record
+		list of members
+		highest fitness value of any member
+		total fitness of all members
+		count of members
+for each structure
+	calculate average fitness
+sort the structures by highest average fitness
+start with an empty species list
+for each structure, while species count < max
+	form a new species with that structure as basis
+	sort the members by fitness, highest first
+for the rest of the structures
+	identify the structure(s) that are most compatible with this one
+	if only one, add all members to that species
+	otherwise, assign each member to the compatible structure whose 
+	  average is closest to that of the new member
+	  and update the average for that species
+for each new species
+	build a list of records with:
+	  new species (pointer),
+	  old species name or proposed new name,
+	  number of members from that old species in this new species
+	  average fitness of those members
+	  average fitness of new species
+sort that master list by 
+	average fitness of members voting for a particular assignment
+	average fitness of new species
+	number of members voting for name
+go through the list of species name votes
+	if the proposed name is already taken, reject the vote
+	if the proposed species has already been given a name, reject
+	otherwise, assign that name to that species
+go through the list of species, in fitness order, descending
+	if the species doesn't have a name, give it a new one
+give every member the name of their new species, if different
+	
+	
+
+offspring priority per topology
+	1st place network copied verbatim - elite
+	1st elite with randomly 'adjusted' weights
+	1st elite with 'average' crossover with 2nd place
+	1st elite with 'random' crossover with 2nd place
+	2nd place network copied verbatim
+	2nd elite with randomly adjusted weights
+	1st elite with 'average' crossover with random other
+	2nd elite with 'average' crossover with random other
+	1st elite with 'random' crossover with random other
+	2nd elite with 'random' crossover with random other
+	all new weights
+
+if after allocating offspring, there remain open slots
+	one of
+		75% - add a new connection
+		20% - split a node
+		 5% - delete a connection
+	
+as topologies optimize, their improvement slows
+when it ceases to improve, the investment in it decreases
+	stagnation penalty incremented
+when an improvement is made, cut the penalty in half
+when the investment drops below threshold, the elite is 'archived'
+ and further investment in it ceases
+if a mutation produces this same topology again,
+	treat the event as an improvement
+		cut stagnation penalty in half
+		include archived elite and new member as gene pool
+
+as the investment in a topology decreases, 
+ the more resources are available for more promising avenues
+
+instead of 'species' we will call it 'topology'

perl-example/start.xor.pl

@@ -0,0 +1,68 @@
+$data = {
+	# settings controlling the operation of the experiment
+	'settings' => {
+		'experiment' => 'xor',
+		'population' => 100,	# desired number of networks
+		'limit' => 10,			# max offspring per topology
+		'penalty' => 10,		# max investment/stagnant topology	
+		'retest-elites' => 0,
+		'save-epochs' => 0,
+		'activation' => 'perl',
+		'max-weight' => 10,
+		'gain' => 5,
+		'debug' => 0,
+		'topology-limit' => 50,
+#		'allow-recurrent' => 1,
+		},
+	# the state of the experiment
+	'save' => {
+		'unique-id' => 0,			# innovation id
+		'generation' => 0,			# which generation this is
+		'max-fitness' => 0,
+		'max-weight' => 0,
+		'min-weight' => 0,
+		},
+	# nodes listed by the unique node-id
+	'nodes' => {
+		'one' => {
+			'id' => 'one', 		# redundant, but useful 
+			'type' => 'input',
+			},
+		'two' => {
+			'id' => 'two', 		# redundant, but useful 
+			'type' => 'input',
+			},
+		'bias' => {
+			'id' => 'bias', 		# redundant, but useful 
+			'type' => 'input',
+			},
+		'output' => {
+			'id' => 'output', 		# redundant, but useful 
+			'type' => 'output',
+			'function' => 'sigmoid',
+			'gain' => '5',
+			},
+		},
+	# one entry per network in the population 
+	'population' => {
+		'initial' => {
+			'id' => 'initial',
+			'fitness' => 0,
+			'elite' => 0,
+			'nodes' => {
+				'one' => {},
+				'two' => {},
+				'bias' => {},
+				'output' => {},
+				},
+			},
+		},
+	# a record of all the topologies in the population
+	# this tracks statistics about each one
+	'topologies' => {},
+	# for all nodes formed by splitting connections, the
+	# mapping between the nodes connected and the node created
+	# exists primarily for search-speed
+	# can be removed before saving, 
+	'node-lookup' => {},
+	};

perl-example/xor.pl

@@ -0,0 +1,71 @@
+#!/usr/bin/perl -w
+
+use strict;
+use neat;
+
+my $neat = new neat( "start.xor.pl" );
+
+my $FINISHED = 0;
+
+$SIG{INT} = sub { $FINISHED = 1 };
+
+my $inputs = [
+	{ 'bias' => 1, 'one' => 0, 'two' => 0, 'output' => 0, 'expected' => 0 },
+	{ 'bias' => 1, 'one' => 1, 'two' => 0, 'output' => 0, 'expected' => 1 },
+	{ 'bias' => 1, 'one' => 0, 'two' => 1, 'output' => 0, 'expected' => 1 },
+	{ 'bias' => 1, 'one' => 1, 'two' => 1, 'output' => 0, 'expected' => 0 },
+	];
+
+sub EvaluateXOR
+{
+	my $net = shift;
+
+	# why retest someone who hasn't changed?
+	return $net->{'fitness'}
+		if ( $net->{'elite'} );
+
+	my $total = 0;
+	my $values;
+	my $average;
+	my $i;
+	my $difference;
+	$total = 0;
+	for ( $i = 0 ; $i < 4 ; $i++ )
+	{
+		$values = Copy( $inputs->[$i] );
+		$neat->Activate( $net, $values );
+#		printf( " %d%d=%lf", $values->{'one'}, $values->{'two'},
+#				$values->{'output'} );
+		$difference = abs( $values->{'output'} - $values->{'expected'} );
+		$total += $difference;
+	}
+#	printf( "  %lf\n", 1 - $average );
+	my $fitness = 1 - ( $total / 4 );
+	$FINISHED = 1 if ( $total < 0.04 ); # close enough!
+	return $fitness;
+}
+
+$neat->EvaluationFunction( \&EvaluateXOR );
+
+# initial generation
+$neat->EvaluateAll();
+
+my $count = 0;
+while ( ! $FINISHED )
+{
+	$neat->Epoch();
+	printf( "%s\n", $neat->Stats() );
+	$neat->EvaluateAll();
+	#$FINISHED = 1 if ( ++$count == 100 );
+}
+
+$neat->Champions();
+$neat->Save( "xor.final.pl" );
+
+my $champion = $neat->ChampionNetwork();
+my $code = $neat->ActivationFunction_C_PartialEval( $champion, 
+		{ bias => 1 } );
+open INDENT, "|indent -st > activate.xor.c";
+print INDENT $code;
+close INDENT;
+#system "cat activate.xor.c";