bach-choral-network

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

use lib map { "$ENV{HOME}/sandbox/$_/lib" } qw(Music-BachChoralHarmony);
use Music::BachChoralHarmony;
use List::Util qw( any );
use Graph::Easy;

my $thresh = shift || 1;
my $name = shift || '003907bv';

# From https://archive.ics.uci.edu/ml/datasets/Bach+Choral+Harmony
my $data_file = shift || $ENV{HOME} . '/sandbox/Music-BachChoralHarmony/share/jsbach_chorals_harmony.data';
my $key_title = shift || $ENV{HOME} . '/sandbox/Music-BachChoralHarmony/share/jsbach_BWV_keys_titles.txt';

# Read-in the chord progression of each song
my $bach = Music::BachChoralHarmony->new(
    data_file => $data_file,
    key_title => $key_title,
);
my $progression = $bach->parse;

# Gather the bigrams of the chord progression
my %seen;
# Count the chords
my %count;

for my $song ( keys %$progression ) {
#    next unless $song eq $name;  # Comment this line to get an enormous network of all song transitions

    my $last = '';

    for my $cluster ( @{ $progression->{$song}{events} } ) {
#        my $notes = $cluster->{notes};
#        my $bass  = $cluster->{bass};
        my $chord = $cluster->{chord};

        $count{$chord}++;

        if ( $last && !any { $last eq $_ } @{ $seen{$chord} } ) {
            push @{ $seen{$last} }, $chord;
        }

        $last = $chord;
    }
}
#use Data::Dumper;warn(__PACKAGE__,' ',__LINE__," MARK: ",Dumper\%seen); exit;
#use Data::Dumper;warn(__PACKAGE__,' ',__LINE__," MARK: ",Dumper\%count); exit;

# Make a network graph of the chord progression
my $graph = Graph::Easy->new();

my %edges;

for my $i ( keys %seen ) {
    next unless $count{$i} >= $thresh;

    my $from = Graph::Easy::Node->new( name => $i );

    for my $j ( @{ $seen{$i} } ) {
        my $to = Graph::Easy::Node->new( name => $j );
        $graph->add_edge( $from, $to )
            unless $edges{"$i $j"}++;
    }
}

print $graph->as_graphviz();

__END__
perl % > bach-choral-network.dot
dot -Tpng bach-choral-network.dot > bach-choral-network.png
open bach-choral-network.png