Sponsoring The Perl Toolchain Summit 2025: Help make this important event another success Learn more

#!/usr/bin/env perl
use strict;
# Roman numeral analysis plot over all songs
# WARNING: This will produce a GIANT png file.
#use lib map { "$ENV{HOME}/sandbox/$_/lib" } qw(Music-BachChoralHarmony Music-ToRoman); # local author libs
my $in_note = shift // ''; # Show all connections if not given
my $in_key = shift || 'major'; # maj, minor, min, m
my $min = shift // 0;
$in_key = 'major'
if $in_key eq 'maj';
$in_key = 'minor'
if $in_key eq 'm' || $in_key eq 'min';
#my $data_file = 'share/jsbach_chorals_harmony.data'; # local author files
#my $key_title = 'share/jsbach_BWV_keys_titles.txt'; # "
my $bach = Music::BachChoralHarmony->new(
# data_file => $data_file,
# key_title => $key_title,
);
my $songs = $bach->parse();
# Show all keys:
#use Data::Dumper;warn(Dumper[map{"$_: $songs->{$_}{key}"}sort keys%$songs]);exit;
my %score;
# Process each song for key and chord
for my $song ( sort keys %$songs ) {
next if $song eq '003907bv' || $song eq '014806bv'; # XXX These keys are not found among the chord notes?
my $key = $songs->{$song}{key};
# Get the scale name
my $name = $key =~ /M/ ? 'major' : 'minor';
$key =~ s/_?M//i;
next if $in_note && $key ne $in_note;
# Skip unless we are in the right key
next unless $name eq $in_key;
my $mtr = Music::ToRoman->new(
scale_note => $key,
scale_name => $name,
);
# print "SONG: $song in $key $name\n";
# The last seen roman
my $last;
# Turn the chord into a roman representation
for my $event ( @{ $songs->{$song}{events} } ) {
my $chord = $event->{chord};
$chord =~ s/_//;
$chord =~ s/d/o/;
my $roman = $mtr->parse($chord);
# print "CHORD: $chord, ROMAN: $roman\n";
# Tally the bigram
$score{ $last . ' ' . $roman }++ if $last;
$last = $roman;
}
}
my $g = GraphViz2->new(
global => { directed => 1 },
node => { shape => 'oval' },
edge => { color => 'grey' },
);
my %nodes;
my %edges;
for my $bigram ( keys %score ) {
next if $min && $score{$bigram} <= $min;
my ( $i, $j ) = split ' ', $bigram;
$g->add_node( name => $i )
unless $nodes{$i}++;
$g->add_node( name => $j )
unless $nodes{$j}++;
$g->add_edge( from => $i, to => $j, label => $score{$bigram} )
unless $edges{$bigram}++;
}
$g->run( format => 'png', output_file => $0 . '.png' );