#!/usr/bin/perl

use Game::Life;
use Algorithm::Genetic;
use Clone qw( clone );

my $lifesize = 10;      # How big of initial Lifes to look at
my $boardsize = 25;     # How big of a Life board to play on
my $lifetime = 50;      # How many Life generations to look through
my $popsize = 100;      # How many initial Life organizes to start with
my $generations = 100;  # How many GA generations to run through

my $algo = new Algorithm::Genetic( {
    FITNESS => \&fitness,
    MUTATOR => \&mutate,
    BREEDER => \&breed,
    MUTATE_CRITERIA => sub { $_[ 0 ]->{ FITNESS }**2 },
    MUTATE_FRACTION => .1,
    BREED_CRITERIA => sub{ $_[ 0 ]->{ FITNESS }**2 },
    BREED_FRACTION => 1
} );

my @pop;
for (1..$popsize) {
	my $life = [ map { [ map { int rand 2 } (1..$lifesize) ] }
	           (1..$lifesize) ] ;
	push @pop, $life;
}

$algo->init_population( @pop );
for ( 1..$generations ) {
	$algo->process_generation();
	my $life = ($algo->get_population())[0];
	foreach ( @$life ) {
		print map { $_ ? 'X' : '.' } @$_;
		print "\n";
	}
	print "\n\n";
}

sub fitness {
	print "doing fitness\n";
	my $life = $_[0]->{ DATA };
	my $game = new Game::Life( $boardsize );
	$game->place_points( ($boardsize-$lifesize)/2,				
	                     ($boardsize-$lifesize)/2, $life );
	my $before_com = calculate_com( $game->get_grid() );
	$game->process( $lifetime );
	my $after_com = calculate_com( $game->get_grid() );
	my $value;
	# if it died out, it sucks!
	if ( $after_com->[0] == 0 ) { 
		$value = 0;
	} else {
		$value = sqrt( ( $before_com->[1]-$after_com->[1] )**2 + 
		          ( $before_com->[2]-$after_com->[2] )**2 );
		my $weight = ( $after_com->[0] * 
					   ( 2*$before_com->[0] - $after_com->[0] ) )/
			         $before_com->[0]**2;
		$value = ( $weight > 0 ) ? $weight * $value : 0;
	}
	print $value, "\n";
	return $value;
}

sub breed {
	print "doing breeding\n";
	# Breed by take a section of the grid and moving between.
	my $life1 = clone( $_[0]->{ PARENT1 } );
	my $life2 = clone( $_[0]->{ PARENT2 } );

	if ( rand(1.0) < 0.8 ) {
		my $pointx = int rand $lifesize;
		my $pointy = int rand $lifesize;
		my $quad = int rand 4;
		my @xrange;
		my @yrange;
		if ( $quad < 2 ) {
			@xrange = ( 0..$pointx );
		} else {
			@xrange = ( $pointx..$lifesize-1 );
		}
		if ( $quad % 2 ) {
			@yrange = ( 0..$pointy );
		} else {
			@yrange = ( $pointy..$lifesize-1 );
		}
		my $test =0;
		for my $i ( @xrange ) {
			for my $j ( @yrange ) {
				$test++;
				my $t = $life1->[$i]->[$j];
				$life1->[$i]->[$j] = $life2->[$i]->[$j];
				$life2->[$i]->[$j] = $t;
			}
		}
	}
	return ( $life1, $life2 );
}

sub mutate {
	print "doing mutate\n";

	my $life = clone( $_[0]->{ DATA } );
	my $x = int rand @lifesize;
	my $y = int rand @lifesize;
	$life->[$x]->[$y] = !($life->[$x]->[$y]);
	return $life;
}

sub calculate_com {
	my $life = shift;
	my $xsum = 0;
	my $ysum = 0;
	my $total = 0;
	for my $i ( 0..@$life - 1 ) {
		for my $j ( 0..@{$life->[0]} - 1 ) {
			if ( $life->[$i]->[$j] ) {
				$xsum += $i;
				$ysum += $j;
				$total++;
			}
		}
	}
	if ( !$total ) { 
		return [ 0, -1, -1 ]; 
	} else {
		return [ $total, $xsum / $total , $ysum / $total ];
	}
}