#!/usr/bin/env perl

# Evolve barycentic chords

use AI::Genetic::Pro;
use List::MoreUtils qw(uniq);
use lib $ENV{HOME} . '/sandbox/MIDI-Util/lib';
use MIDI::Util;
use lib $ENV{HOME} . '/sandbox/Music-Interval-Barycentric/lib';
use Music::Interval::Barycentric;

my $max   = shift || 8;
my $bpm   = shift || 100;
my $patch = shift || 0;

my $top = 8; # Number above the highest evenness_index
my $threshold = 5; # Allowed top - evenness_index
my $base = 59; # Base of middle C MIDI values

my $notes = [ ([0 .. 11]) x 3 ]; # vectors of chromatc scales

my $score = MIDI::Util::setup_score(bpm => $bpm, patch => $patch);

my $ga = AI::Genetic::Pro->new(        
    -fitness         => \&fitness,     # fitness function
    -terminate       => \&terminate,   # terminate function
    -type            => 'listvector',  # type of chromosome
    -population      => 100,           # population
    -crossover       => 0.9,           # probab. of crossover
    -mutation        => 0.5,           # probab. of mutation
    -parents         => 2,             # number  of parents
    -selection       => ['Roulette'],  # selection strategy
    -strategy        => ['PMX'],       # crossover strategy
    -cache           => 1,             # cache results
    -history         => 1,             # remember best results
    -preserve        => 1,             # remember the bests
    -variable_length => 0,             # turn variable length OFF
);

$ga->init($notes);
$ga->evolve(100);

for my $fit ($ga->getFittest($max)) {
    $score->n('qn', map { $base + $_ } @{ get_chromosome($ga, $fit) });
    $score->r('qn');
}
$score->write_score("$0.mid");

# "The higher the value, the bigger the chance of an individual passing its genes on in future generations through mating (crossover)."
sub fitness {
    my ($ga, $chromosome) = @_;
    $chromosome = get_chromosome($ga, $chromosome);
    return 0 if @$chromosome > scalar uniq(@$chromosome); # Duplicates not allowed
    return $top - evenness_index($chromosome); # More "even" chords are deemed fittest
}

sub terminate {
    my ($ga) = @_;
    my $chromosome = get_chromosome($ga);
    return 1 if $ga->as_value($ga->getFittest) > $threshold;
    return;
}

sub get_chromosome {
    my ($ga, $chromosome) = @_;
    $chromosome ||= $ga->getFittest;
    return [ split /_+/, $ga->as_string($chromosome) ];
}
