ai-genetic

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

use AI::Genetic;
use List::Util qw( shuffle );
use MIDI::Simple;
use Music::AtonalUtil;
use Getopt::Long;

my $HTML       = 0;
my $ALTERATION = 3;
my $BITS       = 23;
my $DEGREES    = 7;
my $DIATONIC   = 1;
my $PATCH      = 1;
my $PHRASES    = 1;
my $RHYTHM     = 1;
my $TEMPO      = 600_000;
my $THRESHOLD  = 0.6;
my $VELOCITY   = 1;
my $POPULATION = 500;
my $CROSSOVER  = 0.9;
my $MUTATION   = 0.01;
my $OUTFILE    = "$0.mid";
GetOptions(
    'html'         => \$HTML,
    'alteration=i' => \$ALTERATION,
    'bits=i'       => \$BITS,
    'degrees=i'    => \$DEGREES,
    'diatonic'     => \$DIATONIC,
    'patch=i'      => \$PATCH,
    'phrases=i'    => \$PHRASES,
    'rhythm'       => \$RHYTHM,
    'tempo=i'      => \$TEMPO,
    'threshold=s'  => \$THRESHOLD,
    'velocity'     => \$VELOCITY,
    'population=i' => \$POPULATION,
    'crossover=s'  => \$CROSSOVER,
    'mutation=s'   => \$MUTATION,
    'outfile=s'    => \$OUTFILE,
) or die( "Error in command line arguments\n" );

my $ga = AI::Genetic->new(
    -fitness    => \&fitness,
    -type       => 'bitvector',
    -population => $POPULATION,
    -crossover  => $CROSSOVER,
    -mutation   => $MUTATION,
    -terminate  => \&terminate,
);
$ga->init($BITS);

## PITCHES ##
$ga->evolve( 'rouletteTwoPoint', 100 );
print 'Best pitch genes: ', $ga->getFittest->genes, "\n", ( $HTML ? '<br/>' : '' );
print 'Best pitch score: ', $ga->getFittest->score, "\n", ( $HTML ? '<br/>' : '' );
my $pitches = bits2pitches( scalar $ga->getFittest->genes );
# Perform gymnastics with the pitches
$pitches = [ @$pitches, @{ alteration($pitches) } ];
# What have we now?
print '(', join( ',', @$pitches ), ')', "\n", ( $HTML ? '<br/>' : '' );

my $rhythms;
if ($RHYTHM)
{
    $ga->evolve( 'rouletteTwoPoint', 100 );
    print 'Best rhythm genes: ', $ga->getFittest->genes, "\n", ( $HTML ? '<br/>' : '' );
    print 'Best rhythm score: ', $ga->getFittest->score, "\n", ( $HTML ? '<br/>' : '' );
    $rhythms = bits2rhythms( scalar $ga->getFittest->genes, $pitches );
}

my $velocities;
if ($VELOCITY)
{
    $velocities = bits2velocities($pitches);
}

process_midi( $pitches, $rhythms, $velocities );


sub fitness {
    my $genes = shift;
    my $chrom = join '', @$genes;

    my $fitness = 0;

    # Include consonant pitches
#    $fitness = substr( $chrom, 0, 1 ) ? 1 : 0;
    for my $n (qw( 4 5 7 9 11 12 16 17 19 21 23 ))
    {
        $fitness++ if $BITS >= $n && substr( $chrom, $n, 1 );
    }

    # Count the number of zeros and ones
    my $zeros =()= $chrom =~ /0/g;
    my $ones  =()= $chrom =~ /1/g;
#warn "0,1:$zeros,$ones => $chrom\n";
    # There should be more ones than zeros
    $fitness++ if $zeros < $ones;

    return $fitness / 12;
}

sub terminate {
    my $ga = shift;
    # Terminate if reached some threshold
    return 1 if $ga->getFittest->score > $THRESHOLD;
    return 0;
}

sub int2name {
    # Convert integer pitch notation into MIDI note names
    my %name;
    my @notes;

    # Use the diatonic scale notes if requested
    if ($DIATONIC)
    {
        @notes = qw( C D E F G A B );
    }
    else {
        @notes = qw( C Cs D Ds E F G Gs A As B );
    }
    my $int = -@notes;
    for my $octave ( 3, 4, 5, 6 )
    {
        for my $note (@notes)
        {
            $name{$int} = $note . $octave;
#warn "N:$int $name{$int} = $note . $octave\n";
            $int++;
        }
    }
    return %name;
}

sub bits2pitches {
    # Convert 1001001000101000 form to [0,3,6,10,12] set form
    my $bits = shift;

    my $pitches = [];

    my $i = 0;
    for my $bit ( @$bits ) {
        push @$pitches, $i % $DEGREES if $bit;
        $i++;
    }

    return $pitches;
}

sub bits2rhythms {
    # Convert 1001001000101 form to [tsn dsn tqn thn ddqn] set form
    my $bits = shift;
    my $pitches = shift;

    # List possible rhythmic durations
    my @durations = qw( tsn sn ten dsn ddsn en tqn den dden qn thn dqn ddqn hn );

    my @bitrhythms;
    my $i = 0;
    for my $bit ( @$bits ) {
        push @bitrhythms, $durations[ $i % @durations ] if $bit;
        $i++;
    }

    my @rhythms;
    for ( @$pitches )
    {
        # TODO Be more clever.
        push @rhythms, $bitrhythms[ int rand @bitrhythms ];
    }

    return \@rhythms;
}

sub bits2velocities {
    my $pitches = shift;

    my $velocities = [];
    my $velo = 96;

    for my $p (@$pitches)
    {
        # Velocity is randomly up-down or stationary
        if ( int( rand 3 ) == 1 )
        {
            # Decrease
            $velo--;
        }
        elsif ( int( rand 3 ) == 2 )
        {
            # Increase
            $velo++;
        }

        push @$velocities, 'V' . $velo;
    }

    return $velocities;
}

sub set_score {
    my %conf = (
        tempo     => $TEMPO,
        volume    => 100,
        velocity  => 96,
        signature => 4,
        unit      => 'en',
        channel   => 1,
        patch     => $PATCH,
        octave    => 4,
        kit       => 9,
        pad       => 38,
    );

    my $score = MIDI::Simple->new_score();

    $score->Volume($conf{volume});
    $score->set_tempo($conf{tempo});

    # Lead-in
#    $score->Channel($conf{kit});
#    $score->n($conf{unit}, $conf{pad}) for 1 .. $conf{signature};

    $score->patch_change($conf{channel}, $conf{patch});
    $score->Channel($conf{channel});
    $score->Octave($conf{octave});

    # For future use:
    $score->Cookies(unit => $conf{unit});
    $score->Cookies(velocity => $conf{velocity});

    return $score;
}

sub process_midi {
    my ( $pitches, $rhythms, $velocities ) = @_;

    # Convert the pitch-set to MIDI note names
    my %name  = int2name();
    # Setup the MIDI score
    my $score = set_score();

    # Repeat!
    for ( 1 .. $PHRASES )
    {
        # Add a note to the score for each pitch
        my $i = 0;
        for my $pitch ( @$pitches )
        {
            # Add a duration from the given rhythms or the score default
            my $duration = $RHYTHM ? $rhythms->[$i] : { $score->Cookies }->{unit};

            my $velocity = $VELOCITY ? $velocities->[$i] : { $score->Cookies }->{velocity};

            # Add the note!
            $score->n( $duration, $name{$pitch}, $velocity );

            # Increment the phrase counter
            $i++;
        }
    }

    $score->write_score($OUTFILE);
}

sub alteration {
    my $pitches = shift;

    # Apply pitch set rules:
    @$pitches = shuffle( @$pitches );

    my $atu = Music::AtonalUtil->new;
    my $altered = $atu->transpose( 0, $pitches );

    # Post mutation, phrase alterations
    my $funct = {
        invert     => sub { my $x = shift; $atu->invert( $x, $altered ) },
        retrograde => sub { $atu->retrograde( @$pitches ) },
        rotate     => sub { my $x = shift; $atu->rotate( $x, $altered ) },
        transpose  => sub { my $x = shift; $atu->transpose( $x, $altered ) },
    };

    # Choose a random function and execute it with the given alteration factor
    my $x = $ALTERATION
        ? $ALTERATION
        : int( rand 3 ) + 2;
    my $alteration = ( keys %$funct )[ rand keys %$funct ];
    print "Alteration: $alteration by $x\n", ( $HTML ? '<br/>' : '' );
    $altered = $funct->{$alteration}->($x);

    # Constrain to the DEGREES
    for my $alt ( @$altered )
    {
        $alt %= $DEGREES;
    }

    return $altered;
}