cope-genetic

#!/usr/bin/env perl
use strict;
use warnings;

use AI::Genetic;
use Music::Tension::Cope;
use Data::Dumper::Compact qw(ddc);

use constant THRESHOLD => 0.65; # dissonance threshold: tritone

my $max = shift || 4;

my $tension = Music::Tension::Cope->new;

for my $n (1 .. $max) {
    my $ga = AI::Genetic->new(
        -fitness    => \&fitness,
        -terminate  => \&terminate,
        -type       => 'listvector',
        -population => 500,
        -crossover  => 0.9,
        -mutation   => 0.01,
    );

    $ga->init([
        [0 .. 11],
        [0 .. 11],
        [0 .. 11],
    ]);

    $ga->evolve('rouletteTwoPoint', 100);
    print "$n. Best: [",
        join(', ', sort { $a <=> $b } $ga->getFittest->genes),
        '] => ', $ga->getFittest->score, "\n";
}

sub fitness {
    my $genes = shift;
    $genes = [ sort { $a <=> $b } @$genes ];
    my $fitness = 1;
    my @tension;
    push @tension, scalar $tension->vertical([ $genes->[0], $genes->[1] ]);
    push @tension, scalar $tension->vertical([ $genes->[0], $genes->[2] ]);
    push @tension, scalar $tension->vertical([ $genes->[1], $genes->[2] ]);
    if ($tension[0] == $tension[1] || $tension[0] == $tension[2] || $tension[1] == $tension[2]) {
        return 0;
    }
#warn __PACKAGE__,' L',__LINE__,' ',ddc(\@tension, {max_width=>128});
    for my $t (@tension) {
        my $x = THRESHOLD - $t;
        $fitness += $x;
    }
#warn __PACKAGE__,' L',__LINE__,' FIT: ',,"$fitness\n";
    return $fitness;
}

sub terminate {
    my $ga = shift;
#warn __PACKAGE__,' L',__LINE__,' TERM: ',$ga->getFittest->score,"\n";
    return 1 if $ga->getFittest->score > 1;
    return 0;
}