barycenter

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

use AI::Genetic;
use List::Util qw/ uniq /;
use lib map { "$ENV{HOME}/sandbox/$_/lib" } qw(MIDI-Util Music-Interval-Barycentric);
use MIDI::Util qw(setup_score set_chan_patch); # https://metacpan.org/release/MIDI-Util
use Music::Interval::Barycentric; # https://metacpan.org/release/Music-Interval-Barycentric
use Music::Chord::Namer 'chordname';
use Music::Note;

my $bpm   = shift || 200;
my $patch = shift || 0;

my $population = 100;
my $iterations = 2;

my $max = 48; # Number of results
my $top = 8; # Highest value of chromosome
my $base = 60; # Base of middle C MIDI values

my @fittest = evo($max);

for my $fit (@fittest) {
    my @named;
    for my $n (sort { $a <=> $b } @$fit) {
        my $note = Music::Note->new($n + $base, 'midinum');
        push @named, $note->format('isobase');
    }
    printf "[%d,%d,%d] => (%s,%s,%s) => %s\n", @$fit, @named, scalar chordname(@named);
}

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

my $count = 0;

$score->synch(
    \&fit,
    \&drums,
);

$score->write_score("$0.mid");

sub fit {
    for my $fit (@fittest[0 .. 7]) {
        legato($fit);
    }
    for my $fit (@fittest[8 .. 15]) {
        staccato($fit);
    }
    for my $fit (@fittest[16 .. 23]) {
        leading($fit);
    }
    for my $fit (@fittest[24 .. 31]) {
        legato($fit);
    }
    for my $fit (@fittest[32 .. 39]) {
        staccato($fit);
    }
    for my $fit (@fittest[40 .. 47]) {
        legato($fit);
    }

    # Resolution
    $score->n('qn', 65, 69, 72); # IV
    $score->r('qn');
    $score->n('qn', 67, 71, 74); # V
    $score->r('qn');
    $score->n('wn', 60, 64, 67); # I
}

sub drums {
    set_chan_patch($score, 9, 44);

    for my $duration (('qn') x $count) { # Measures of quarter-notes
        $score->n($duration, 44, 'm'); # hi-hat
    }

    $score->n('qn', 38, 'm'); # snare
    $score->n('qn', 35, 'm'); # kick
    $score->n('qn', 38, 'm'); # snare
    $score->n('qn', 35, 'm'); # kick
    $score->n('wn', 49, 'm'); # crash
}

sub legato {
    my ($fit) = @_;
    $score->n('qn', map { $base + $_ } @$fit);
    $score->r('qn');
    $count += 2;
}

sub staccato {
    my ($fit) = @_;
    for my $note (@$fit) {
        $score->n('sn', $base + $note);
        $score->r('sn');
        $count += 0.5;
    }
}

sub leading {
    my ($fit) = @_;
    $score->n('qn', $base + $fit->[0]);
    $score->n('qn', map { $base + $_ } @{ $fit }[1,2]);
    $count += 2;
}

sub evo {
    my $max = shift;

    my $ga = AI::Genetic->new(
        -fitness    => \&fitness,
        -type       => 'listvector',
        -population => $population,
        -crossover  => 0.95,
        -mutation   => 0.01,
    );

    my $items = [ ([ 0 .. 11 ]) x 3 ]; # Chromatic triad
    
    $ga->init($items);
    $ga->evolve('rouletteTwoPoint', $iterations);

    my @genes;
    for my $fit ($ga->getFittest($max)) {
        push @genes, $fit->{GENES};
    }

    return @genes;
}
 
 sub fitness {
    my $chromosome = shift;

    return 0
        if @$chromosome > uniq(@$chromosome); # Duplicates not allowed

    # Chords with adjacent half-steps are not allowed
    for my $i (@$chromosome) {
        for my $j (@$chromosome) {
            return 0
                if ($j == $i + 1) || ($j == $i - 1);
        }
    }

    return $top - evenness_index($chromosome);
}