package Urb::Dom::Crossover;

use strict;
use warnings;
use 5.010;

our $DEBUG = $ENV{DEBUG};

=head1 NAME

Urb::Dom::Crossover - Crossover operator for Urb::Dom objects

=head1 SYNOPSIS

A class that can be used as a crossover operator for domestic spaces.

=head1 DESCRIPTION

The eventual intention is to make this an Op for L<Algorithm::Evolutionary>

=head1 USAGE

=over

=item new

Create a new Urb::Dom::Crossover object:

  $crossover = new Urb::Dom::Crossover;

=cut

# FIXME need tests
sub new
{
    my $class = shift;
    $class = ref $class || $class;
    my $self = {};
    bless $self, $class;
    return $self;
}

=item apply

Crossover two L<Urb::Dom> objects:

  $crossover->apply ($dom_a, $dom_b);

This exchanges random parts of the tree of two Urb::Dom objects.

=cut

sub apply
{
    my $self = shift;
    my $dom_a = shift;
    my $dom_b = shift;

    # pick a random quad from A
    my $victim_a = victim ($dom_a);

    # pick a random quad from B from the nearest third by area
    my $victim_b = victim_byarea ($dom_b, $victim_a->Area);
    debug ('crossover victims:', $victim_a->Id, $victim_b->Id) if $DEBUG;

    # no point combining a wide quad with a narrow quad, rotate to fix
    my $aspect_a = ($victim_a->Length (0) + $victim_a->Length (2)) /
                   ($victim_a->Length (1) + $victim_a->Length (3));
    my $aspect_b = ($victim_b->Length (0) + $victim_b->Length (2)) /
                   ($victim_b->Length (1) + $victim_b->Length (3));
    if (($aspect_a < 1 and $aspect_b > 1) or ($aspect_a > 1 and $aspect_b < 1))
    {
        int rand (2) ? $victim_b->Rotate : $victim_b->Unrotate;
        debug ('rotating to fit');
    }

    # exchange victims
    $victim_a->Crossover ($victim_b);

    $dom_a->Split_Undivided_Up;
    $dom_a->Highest->Split_Undivided_Down;
    $dom_b->Split_Undivided_Up;
    $dom_b->Highest->Split_Undivided_Down;

    return ($dom_a, $dom_b);
}

sub victim
{
    my $dom = shift;
    my @all = map {$_->Children} $dom, $dom->Levels_Above;
    my $index = int rand (scalar @all);
    return $all[$index];
}

sub victim_byarea
{
    my $dom = shift;
    my $area = shift;
    my $list = $dom->By_Area ($area);
    my $toget = int (scalar (@{$list}) / 3) + 1;
    my $index = int rand ($toget);
    return $list->[$index]->[1];
}

=item debug

Any text sent to debug() gets printed to STDERR if $ENV{DEBUG} is set

=cut

sub debug
{
    my @text = @_;
    return unless $DEBUG;
    say STDERR join ' ', @text;
    return 1;
}

=back

=cut

1;
