#!/usr/bin/perl
use warnings;
use strict;
use 5.010;
use Carp;

use File::Spec;
use YAML;

use Algorithm::Evolutionary;
use Algorithm::Evolutionary::Individual::Base;
use Algorithm::Evolutionary::Op::CanonicalGA;

use lib 'lib';
use Urb::Dom;
use Urb::Dom::Mutate;
use Urb::Dom::Crossover;
use Urb::Dom::Fitness;

push @Urb::Dom::ISA, 'Algorithm::Evolutionary::Individual::Base';

local $SIG{INT} = \&interrupt;
local $SIG{TERM} = \&interrupt;

croak "Usage: $0 project.dom [other.dom other2.dom ...]" unless scalar @ARGV;

my $max_iterations = $ENV{MAX_ITERATIONS} || 768;
my $max_pop = $ENV{MAX_POP} || 128;

say "[$$] Iterations: $max_iterations";

my $overlay = undef;
if (-e 'occlusion.field')
{
    say STDERR "[$$] Using occlusion overlay field";
    $overlay = Urb::Field::Occlusion->new;
    open my $YAML, '<', 'occlusion.field' or croak "$!";
    my $string = join '', (<$YAML>);
    close $YAML;
    $overlay->Deserialise ($string);
}

my $config = undef;
my $path_patterns = File::Spec->catfile (File::Spec->updir(), 'patterns.config');
if (-e $path_patterns)
{
    say STDERR "[$$] Using project level patterns config file";
    $config = YAML::LoadFile ($path_patterns);
}
if (-e 'patterns.config')
{
    say STDERR "[$$] Using patterns config file";
    my $config_temp = YAML::LoadFile ('patterns.config');
    for my $key (keys %{$config_temp})
    {
        $config->{$key} = $config_temp->{$key};
    }
}

my $costs = undef;
my $path_costs = File::Spec->catfile (File::Spec->updir(), 'costs.config');
if (-e $path_costs)
{
    say STDERR "[$$] Using project level costs config file";
    $costs = YAML::LoadFile ($path_costs);
}
if (-e 'costs.config')
{
    say STDERR "[$$] Using costs config file";
    my $costs_temp = YAML::LoadFile ('costs.config');
    for my $key (keys %{$costs_temp})
    {
        $costs->{$key} = $costs_temp->{$key};
    }
}

my @pop;
while (scalar (@pop) < $max_pop)
{
    for my $path_yaml (@ARGV)
    {
        my $dom = Urb::Dom->new;
        $dom->Deserialise (YAML::LoadFile ($path_yaml));
        push @pop, $dom;
    }
}
pop @pop while (scalar (@pop) > $max_pop);
say STDERR "[$$] Population: ". scalar @pop;

my $mutate = Urb::Dom::Mutate->new;
my $crossover = Urb::Dom::Crossover->new;

my $fitness_object = Urb::Dom::Fitness->new ($config, $costs);

my $plot_area = $pop[0]->Area;
my $plot_ratio = $fitness_object->Conf('plot_ratio')->[0];
my $implied_area = int ($plot_area * $plot_ratio * 10) /10;
say STDERR "[$$] Warning: plot_ratio implies internal area of $implied_area" if $implied_area > 250;

$fitness_object->{_occlusion} = $pop[0]->Occlusion ($overlay);
$fitness_object->{_occlusion}->{nocache} = 1;

my $fitness = sub { $fitness_object->apply (@_) };

my $generation = Algorithm::Evolutionary::Op::CanonicalGA->new ($fitness, 0.4, [$mutate, $crossover]);

for (1 .. $max_iterations)
{
    say STDERR "[$$] Iteration: $_/$max_iterations";
    $generation->apply (\@pop);
    say STDERR "[$$]   Fitness: ". $pop[0]->Fitness;
    say STDERR "[$$]   Area: ". int($pop[0]->Area_Internal*10)/10 .", Floors: ". scalar $pop[0]->Levels_Above +1;
    say STDERR join "\n", map {"[$$]     $_"} $pop[0]->Failures;
    last if defined $ENV{HOMEMAKER_TIMEOUT} and $ENV{HOMEMAKER_TIMEOUT} > 0 and time() > $ENV{HOMEMAKER_TIMEOUT};
}

finish ($pop[0]);

sub interrupt
{
    say STDERR "[$$] caught signal";
    finish ($pop[0]);
    exit 0;
}

sub finish
{
    my $dom_out = shift;
    YAML::DumpFile ($dom_out->Hash .'.dom', $dom_out->Serialise);
    say "[$$] ".$dom_out->Hash;
    return;
}

# This is redefined from Algorithm::Evolutionary::Op::CanonicalGA
# and modified slightly to deal with a memory leak in the Urb::Dom object

# Class-wide constants
sub Algorithm::Evolutionary::Op::CanonicalGA::apply ($) {
  my $self = shift;
  my $pop = shift || croak "No population here";
  # croak "Incorrect type ".(ref $pop) if  ref( $pop ) ne $APPLIESTO;

  my $eval = $self->{_eval};
  for ( @$pop ) {
    if ( !defined ($_->Fitness() ) ) {
	$_->evaluate( $eval );
    }
  }

  my @newPop;
  @$pop = sort { $b->{_fitness} <=> $a->{_fitness} } @$pop;
  my @rates = map( $_->Fitness(), @$pop );

  #Creates a roulette wheel from the op priorities. Theoretically,
  #they might have changed 
  my $popWheel= new Algorithm::Evolutionary::Wheel @rates;
  my $popSize = scalar @$pop;
  my @ops = @{$self->{_ops}};
  for ( my $i = 0; $i < $popSize*(1-$self->{_selrate})/2; $i ++ ) {
      my $clone1 = $ops[0]->apply( $pop->[$popWheel->spin()] ); # This should be a mutation-like op
      my $clone2 = $ops[0]->apply( $pop->[$popWheel->spin()] );
      $ops[1]->apply( $clone1, $clone2 ); #This should be a
                                          #crossover-like op
      $clone1->evaluate( $eval );
      $clone2->evaluate( $eval );
      push @newPop, $clone1, $clone2;
  }
  # following line is added to deal with DESTROY() not being called on overwrite
  map {$_->DESTROY} @{$pop}[$popSize*$self->{_selrate}..$popSize-1];
  #Re-sort
  @{$pop}[$popSize*$self->{_selrate}..$popSize-1] =  @newPop;
  @$pop = sort { $b->{_fitness} <=> $a->{_fitness} } @$pop;
}

0;
