random-walk

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

# Write-up:
# http://techn.ology.net/musical-random-walks-over-weighted-graphs

use lib map { "$ENV{HOME}/sandbox/$_/lib" } qw(Graph-Weighted MIDI-Util);
use Graph::Weighted;
use List::Util::WeightedChoice qw( choose_weighted );
use MIDI::Util qw(setup_score);

my $n = shift || 4; # Number of notes
my $initial = shift // 0; # Initial graph node

# Treble notes
my $treble = Graph::Weighted->new();
$treble->populate(
    {
        0 => { label => 'C5',  2 => 0.4, 6 => 0.6 },
        1 => { label => 'D5',  3 => 0.4, 4 => 0.6 },
        2 => { label => 'Ds5', 1 => 0.5, 3 => 0.5 },
        3 => { label => 'F5',  5 => 0.4, 4 => 0.6 },
        4 => { label => 'G5',  2 => 0.4, 3 => 0.6 },
        5 => { label => 'Gs5', 4 => 0.4, 6 => 0.6 },
        6 => { label => 'As5', 0 => 0.4, 3 => 0.6 },
    }
);

# Bass notes
my $bass = Graph::Weighted->new();
$bass->populate(
    {
        0 => { label => 'C3',  2 => 0.4, 3 => 0.6 },
        1 => { label => 'Ds3', 2 => 0.5, 3 => 0.5 },
        2 => { label => 'F3',  0 => 0.4, 3 => 0.6 },
        3 => { label => 'G3',  4 => 0.4, 2 => 0.6 },
        4 => { label => 'As3', 0 => 0.4, 1 => 0.6 },
    }
);

# Note durations
my $duration = Graph::Weighted->new();
$duration->populate(
    {
        0 => { label => 'qn', 0 => 0.7, 1 => 0.3 },
        1 => { label => 'en', 0 => 0.6, 1 => 0.4 },
    }
);

# Note velocities
my $velocity = Graph::Weighted->new();
$velocity->populate(
    {
        0 => { label => 'mezzo', 0 => 0.7, 1 => 0.3 },
        1 => { label => 'mf',    0 => 0.6, 1 => 0.4 },
    }
);

# Collect the notes to play
my $notes = collect_notes( $n, $initial, $velocity, $duration, $treble, $bass );

# Invoke MIDI
my $score = setup_score( patch => 42 );

# Add notes to the score
$score->n( @$_ ) for @$notes;

# Write out the MIDI file
$score->write_score( $0 . '.mid' );

sub next_vertex {
    my ( $g, $vertex ) = @_;

    my $successors = [];

    # Collect the vertex successors in the format that choose_weighted understands
    for my $successor ( $g->successors($vertex) ) {
        push @$successors, {
            vertex => $successor,
            weight => $g->get_cost( [ $vertex, $successor ] ),
        };
    }

    # Choose the next vertex based on the successor weights
    my $choice = choose_weighted( $successors, sub { $_[0]->{weight} } );

    return $choice->{vertex};
}

sub collect_notes {
    my ( $n, $initial, $velocity, $duration, $treble, $bass ) = @_;

    # Set the initial vertices to the given initial node
    my ( $t_vertex, $b_vertex, $d_vertex, $v_vertex ) = ($initial) x 4;

    my $notes = [];

    # Collect MIDI data by randomly walking the graphs
    for my $i ( 1 .. $n ) {
        my $treb = $treble->get_vertex_attribute( $t_vertex, 'label' );
        my $low  = $bass->get_vertex_attribute( $b_vertex, 'label' );
        my $dura = $duration->get_vertex_attribute( $d_vertex, 'label' );
        my $velo = $velocity->get_vertex_attribute( $v_vertex, 'label' );

        push @$notes, [ $velo, $dura, $treb, $low ];

        # Find the next vertex for each graph
        if ( $i < $n ) {
            $t_vertex = next_vertex( $treble, $t_vertex );
            $b_vertex = next_vertex( $bass, $b_vertex );
            $d_vertex = next_vertex( $duration, $d_vertex );
            $v_vertex = next_vertex( $velocity, $v_vertex );
        }
    }

    return $notes;
}