#!/usr/bin/env perl

# Brief and dirty attempt to solve a system of simultaneous equations (2)
# using Genetic Algorithms in particular CPAN module
#   Algorithm::Evolutionary
#   Perl module for performing paradigm-free evolutionary algorithms
#   by J. J. Merelo, jmerelo (at) geneura.ugr.es
# (parts of my program were copied from manpage)
#
# The toy problem here is to find INTEGER solutions to the system of equations y-x=2 and y-2x=11
# wrt x and y.
# Our 2 genes are 'x' and 'y'. We encode these as 8-bit integers
# 7+1sign bit. The algorithm will mutate/crossover etc the bit string of each member of
# the population. Then it will evaluate how well the genes of each member of the population
# solve the problem at hand. This is called the fitness. The fittest genes survive and the
# rest are discarded, with some probability.
# Author: bliako
# Date: 16/04/2018

use strict;
use warnings;

use Algorithm::Evolutionary::Experiment;
use Algorithm::Evolutionary::Op::Easy;
use Algorithm::Evolutionary::Op::Bitflip;
use Algorithm::Evolutionary::Op::Crossover;

my $num_genes = 2;

my $fitness = sub {
	my $individual = shift;
	my $genes = chromosome2genes($individual->Chrom());
	return calculate_discrepancy($genes);
};

my $m = Algorithm::Evolutionary::Op::Bitflip->new(2); # flip this number of bits randomly
my $c = Algorithm::Evolutionary::Op::Crossover->new(2); # crossover with 2 points
# every iteration applies the above operations to the population along with a fitness function
# and selection rate (prob of good genes to survive, lower means more "bad" genes enter the next generation) 
my $ez = new Algorithm::Evolutionary::Op::Easy $fitness, 0.4, [$m,$c];
my $popSize = 500; # population size, each individual in this pop has a chromosome which consists of 2 genes
my $indiType = 'BitString'; # the chromosome is a sequence of bits as a string
my $indiSize = 8*$num_genes; # 8 bits per gene
my $e = new Algorithm::Evolutionary::Experiment $popSize, $indiType, $indiSize, $ez;
my $populationRef;
my $previous_fitness = 0;
my ($current_fitness, $best);
while(1){
	$populationRef = $e->go();
	$best = $populationRef->[0];
	print "Best so far: ", $best->asString(), " (", individual2string($best),")\n";
	$current_fitness = $best->Fitness();
	if( $current_fitness == 0 ){ print "bingo!\n"; last }
	#if( ($previous_fitness - $current_fitness) == 0 ){ last }
	$previous_fitness = $current_fitness;
}

print "\nI tried to solve the system of equations: y-x=2 and y-2x=11. The solution should be x=3, y=5\n";
print "Final solution found: ".individual2string($best)."\n";

exit(0);

sub individual2string {
	my $individual = $_[0];
	my $genes = chromosome2genes($individual->Chrom());
	my $fit = calculate_discrepancy($genes);
	return genes2string($genes) . " -> discrepancy=" . $fit
}
# interpret an array of genes wrt our problem, i.e. an x and a y
sub genes2string {
	my $genes = $_[0];
	return "x=".$genes->[0].", y=".$genes->[1];
}
# convert a huge bit string into an array of genes
# the array to place the genes in is given
sub chromosome2genes {
	my $achromosome = $_[0]; # chromosome bit string containing all genes as 10101

	my @retgenes = (0)x$num_genes;

	# convert a chromosome which consists of genes which consist of bits(alleles)
	# into a set of numbers to be applied to our problem.
	# each chromosome below consists of 2 genes which consist of 8 bits (1sign+7)
	# these 8bits are interpreted as integers in +-127 range (which is enough for our problem
	# however if solution involved bigger numbers we need to increase range/bits)
	my $i=0;
	while( $achromosome =~ /([01])([01]{7})/g ){
		my $sig = $1 eq '1' ? -1 : 1;
		my $g2 = $2;

		# Here is how a sequence of 8bits is converted to integers. 1st bit is sign.
		# I am sure there is a better way using pack.
		my $g = 0;
		my $j = 1;
		map { $g += $_*$j; $j*=2; } split(//, $g2);
		$g *= $sig;

		$retgenes[$i++] = $g;
		#print "$g2->num=$g\n";
	}
	return \@retgenes
}
sub	calculate_discrepancy {
	my $genes = $_[0];

	# Our problem is to solve the simultaneous equation: y-x=2 and y-2x=11
	# where genes[0] -> y, genes[1]->x
	my $e1 = $genes->[0] - $genes->[1] - 2;
	my $e2 = $genes->[0] + 2*$genes->[1] - 11;
	# we calculate discrepancy but we need to return fitness:
	return -($e1*$e1 + $e2*$e2);
}