barycenter3

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


use AI::Genetic;
use List::Util qw/ uniq /;
use MIDI::Util qw(setup_score set_chan_patch); # https://metacpan.org/release/MIDI-Util
use Music::Cadence; # https://metacpan.org/release/Music-Cadence
use Music::Chord::Namer 'chordname';
use Music::Duration::Partition; # https://metacpan.org/release/Music-Duration-Partition
use Music::Interval::Barycentric; # https://metacpan.org/release/Music-Interval-Barycentric
use Music::Note;
use Music::Scales;

my $reps  = shift || 7; # start=0
my $bpm   = shift || 120;
my $patch = shift || 5;

my $population = 50;
my $iterations = 2;

my $max = 48; # Number of evolved results
my $top = 8; # Highest value of chromosome
my $base = 60; # Base of middle C MIDI values
my $size = 4; # Phrase duration size in quarter notes

my $sizes = {
    wn => 4,
    hn => 2,
    qn => 1,
    en => 0.5,
};

my @fittest = evo($max);

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

my $mc = Music::Cadence->new(octave => 5);

my $mdp = Music::Duration::Partition->new(
    size => $size,
    pool => [qw/ hn qn en /],
    #verbose=>1,
);

my $count = 0;

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

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

sub fit {
    my $motif = $mdp->motif;
    for my $n (0 .. $reps) {
        legato($motif->[$n % @$motif], $fittest[$n % @fittest]);
    }
    add_cadence('wn', 1 + int rand 7);
#    add_rest('hn');

    $motif = $mdp->motif;
    for my $n (0 .. $reps) {
        legato($motif->[$n % @$motif], $fittest[$n % @fittest]);
    }
    add_cadence('wn', 1 + int rand 7);
#    add_rest('hn');

    $motif = $mdp->motif;
    for my $n (0 .. $reps) {
        legato($motif->[$n % @$motif], $fittest[$n % @fittest]);
    }
    add_cadence('wn', 1 + int rand 7);
#    add_rest('hn');

    $motif = $mdp->motif;
    for my $n (0 .. $reps) {
        legato($motif->[$n % @$motif], $fittest[$n % @fittest]);
    }
#    add_rest('hn');

    # Resolution
    add_cadence('wn', 1 + int rand 7);
    $score->n('wn', 60, 64, 67); # I
}

sub legato {
    my ($dura, $fit) = @_;
    $score->n($dura, map { $base + $_ } @$fit);
    $count += $sizes->{$dura};
}

sub add_cadence {
    my $dura = shift || 'hn';
    my $n = shift || 1;
    my $chords = $mc->cadence(
        type    => 'half',
        leading => $n,
    );
    $score->n($dura, @$_) for @$chords;
    $count += $sizes->{$dura} * 2;'hn'
}

sub add_rest {
    my $dura = shift;
    $score->r($dura);
    $count += $sizes->{$dura};
}

sub bass {
    set_chan_patch($score, 1, 42);

    my @scale = get_scale_MIDI('C', 3, 'pentatonic');

    for my $duration (('hn') x ($count / 2)) { # Measures of half-notes
        $score->n($duration, $scale[int rand @scale]);
    }

    # Resolution
    $score->n('wn', $scale[0]);
}

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

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

    # Resolution
    $score->n('wn', 49); # crash
}

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 %seen;
    my @genes;
    for my $fit ($ga->getFittest($max)) {
        my @sorted = sort { $a <=> $b } @{ $fit->{GENES} };
        next if $seen{"@sorted"}++;
        push @genes, \@sorted;
    }

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

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

    # Chords with duplicate notes not allowed
    return 0
        if @$chromosome > uniq(@$chromosome);

    # 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);
#        }
#    }

    # Chords with sharps or flats not allowed
    for my $i (@$chromosome) {
        my $note = Music::Note->new($i + $base, 'midinum');
        return 0
            if $note->format('isobase') =~ /#|b/;
    }

    my $e = evenness_index($chromosome);

#    return 0
#        if $e >= 5;

    return $top - $e;
}