package Music::BachChoralHarmony;
our $AUTHORITY = 'cpan:GENE';
# ABSTRACT: Parse the UCI Bach choral harmony data set
our $VERSION = '0.0412';
use Moo;
use strictures 2;
use Text::CSV ();
use File::ShareDir qw/ dist_dir /;
use List::Util qw/ any /;
use namespace::clean;
has data_file => (
is => 'ro',
default => sub { dist_dir('Music-BachChoralHarmony') . '/jsbach_chorals_harmony.data' },
);
has key_title => (
is => 'ro',
default => sub { dist_dir('Music-BachChoralHarmony') . '/jsbach_BWV_keys_titles.txt' },
);
has data => (
is => 'rw',
init_arg => undef,
default => sub { {} },
);
sub parse {
my ($self) = @_;
# Collect the key signatures and titles
my %data;
open my $fh, '<', $self->key_title
or die "Can't read ", $self->key_title, ": $!";
while ( my $line = readline($fh) ) {
chomp $line;
next if $line =~ /^\s*$/ || $line =~ /^#/;
my @parts = split /\s+/, $line, 4;
$data{ $parts[0] } = {
bwv => $parts[1],
key => $parts[2],
title => $parts[3],
};
}
close $fh;
# Collect the events
my $csv = Text::CSV->new( { binary => 1 } )
or die "Can't use CSV: ", Text::CSV->error_diag;
open $fh, '<', $self->data_file
or die "Can't read ", $self->data_file, ": $!";
my $progression;
# 000106b_ 2 YES NO NO NO YES NO NO YES NO NO NO NO E 5 C_M
while ( my $row = $csv->getline($fh) ) {
( my $id = $row->[0] ) =~ s/\s*//g;
my $notes = '';
for my $note ( 2 .. 13 ) {
$notes .= $row->[$note] eq 'YES' ? 1 : 0;
}
( my $bass = $row->[14] ) =~ s/\s*//g;
( my $accent = $row->[15] ) =~ s/\s*//g;
( my $chord = $row->[16] ) =~ s/\s*//g;
$progression->{$id}{key} ||= $data{$id}{key};
$progression->{$id}{bwv} ||= $data{$id}{bwv};
$progression->{$id}{title} ||= $data{$id}{title};
my $struct = {
notes => $notes,
bass => $bass,
accent => $accent,
chord => $chord,
};
push @{ $progression->{$id}{events} }, $struct;
}
$csv->eof or die $csv->error_diag;
close $fh;
$self->data($progression);
return $self->data;
}
sub search {
my ( $self, %args ) = @_;
my %results = ();
if ( $args{id} ) {
my @ids = split /\s+/, $args{id};
for my $id ( @ids ) {
$results{$id} = $self->data->{$id};
}
}
if ( $args{key} ) {
my @iter = keys %results ? keys %results : keys %{ $self->data };
my @keys = split /\s+/, $args{key};
for my $id ( @iter ) {
if ( $results{$id} ) {
delete $results{$id}
unless any { $_ eq $results{$id}{key} } @keys;
}
else {
$results{$id} = $self->data->{$id}
if any { $_ eq $self->data->{$id}{key} } @keys;
}
}
}
if ( $args{bass} ) {
%results = $self->_search_param( bass => $args{bass}, \%results );
}
if ( $args{chord} ) {
%results = $self->_search_param( chord => $args{chord}, \%results );
}
if ( $args{notes} ) {
my @iter = keys %results ? keys %results : keys %{ $self->data };
my $and = $args{notes} =~ /&/ ? 1 : 0;
my $re = $and ? qr/\s*&\s*/ : qr/\s+/;
my @notes = split $re, $args{notes};
my %index = (
'C' => 0,
'C#' => 1,
'Db' => 1,
'D' => 2,
'D#' => 3,
'Eb' => 3,
'E' => 4,
'F' => 5,
'F#' => 6,
'Gb' => 6,
'G' => 7,
'G#' => 8,
'Ab' => 8,
'A' => 9,
'A#' => 10,
'Bb' => 10,
'B' => 11,
);
ID: for my $id ( @iter ) {
my %and_notes = ();
my $match = 0;
for my $event ( @{ $self->data->{$id}{events} } ) {
my @bitstring = split //, $event->{notes};
my $i = 0;
for my $bit ( @bitstring ) {
if ( $bit ) {
for my $note ( sort @notes ) {
if ( defined $index{$note} && $i == $index{$note} ) {
if ( $and ) {
$and_notes{$note}++;
}
else {
$match++;
}
}
}
}
$i++;
}
}
if ( $and ) {
if ( keys %and_notes ) {
my %notes;
@notes{@notes} = undef;
my $i = 0;
for my $n ( keys %and_notes ) {
$i++
if exists $notes{$n};
}
if ( $i == scalar keys %notes ) {
$results{$id} = $self->data->{$id};
}
else {
delete $results{$id}
if $results{$id};
}
}
}
else {
if ( $results{$id} && $match <= 0 ) {
delete $results{$id};
}
elsif ( $match > 0 ) {
$results{$id} = $self->data->{$id};
}
}
}
}
return \%results;
}
sub bits2notes {
my ( $self, $string, $accidental ) = @_;
$accidental ||= 'b';
my @notes = ();
no warnings 'qw';
my @positions = qw( C C#|Db D D#|Eb E F F#|Gb G G#|Ab A A#|Bb B );
my @bits = split //, $string;
my $i = 0;
for my $bit ( @bits ) {
if ( $bit ) {
my @note = split /\|/, $positions[$i];
my $note = '';
if ( @note > 1 ) {
$note = $accidental eq '#' ? $note[0] : $note[1];
}
else {
$note = $note[0];
}
push @notes, $note;
}
$i++;
}
return \@notes;
}
sub _search_param {
my ( $self, $name, $param, $seen ) = @_;
my @iter = keys %$seen ? keys %$seen : keys %{ $self->data };
my %results = ();
my $and = $param =~ /&/ ? 1 : 0;
my $re = $and ? qr/\s*&\s*/ : qr/\s+/;
my %notes = ();
@notes{ split $re, $param } = undef;
ID: for my $id ( @iter ) {
my %and_notes = ();
my $match = 0;
for my $event ( @{ $self->data->{$id}{events} } ) {
for my $note ( keys %notes ) {
if ( $note eq $event->{$name} ) {
if ( $and ) {
$and_notes{$note}++;
}
else {
$match++;
}
}
}
}
if ( $and ) {
if ( keys %and_notes ) {
my $i = 0;
for my $n ( keys %and_notes ) {
$i++
if exists $notes{$n};
}
if ( $i == scalar keys %notes ) {
$results{$id} = $self->data->{$id};
}
else {
delete $results{$id}
if $results{$id};
}
}
}
else {
if ( $results{$id} && $match <= 0 ) {
delete $results{$id};
}
elsif ( $match > 0 ) {
$results{$id} = $self->data->{$id};
}
}
}
return %results;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Music::BachChoralHarmony - Parse the UCI Bach choral harmony data set
=head1 VERSION
version 0.0412
=head1 SYNOPSIS
use Music::BachChoralHarmony;
my $bach = Music::BachChoralHarmony->new;
my $songs = $bach->parse;
# show all the song ids:
print Dumper [ sort keys %$songs ];
print Dumper [ sort keys %{ $bach->data } ]; # Same
# show all the song titles:
print Dumper [ map { $songs->{$_}{title} } sort keys %$songs ];
$songs = $bach->search( id => '000106b_' );
$songs = $bach->search( id => '000106b_ 000206b_' );
$songs = $bach->search( key => 'C_M' ); # In C major
$songs = $bach->search( key => 'C_M C_m' ); # In C major or C minor
$songs = $bach->search( bass => 'C' ); # With a C note in the bass
$songs = $bach->search( bass => 'C D' ); # With C or D in the bass
$songs = $bach->search( bass => 'C & D' ); # With C and D in the bass
$songs = $bach->search( chord => 'C_M' ); # With a C major chord
$songs = $bach->search( chord => 'C_M D_m' ); # With a C major or a D minor chord
$songs = $bach->search( chord => 'C_M & D_m' ); # With C major and D minor chords
$songs = $bach->search( notes => 'C E G' ); # With the notes C or E or G
$songs = $bach->search( notes => 'C & E & G' ); # With C and E and G
# Args can be combined too:
$songs = $bach->search( key => 'C_M C_m', chord => 'X_m & F_M' );
# Possibly handy:
my $notes = $bach->bits2notes('100000000000'); # [ C ]
$notes = $bach->bits2notes('010000000000'); # [ Db ]
$notes = $bach->bits2notes('000000000010'); # [ Bb ]
$notes = $bach->bits2notes( '000000000010', '#' ); # [ A# ]
$notes = $bach->bits2notes('110000000010'); # [ C Db Bb ]
=head1 DESCRIPTION
C<Music::BachChoralHarmony> parses the UCI Bach choral harmony data set of 60
chorales and does a few things:
* It turns the UCI CSV data into a perl data structure.
* It combines the Bach BWV number, song title and key with the data.
* It converts the UCI YES/NO note specification into a bit string and
named note list.
* It allows searching by ids, keys, notes, and chords.
The BWV and titles were collected from an Internet Archive and
filled-in from L<https://bach-chorales.com/>. The keys were computed
with a L<music21|https://web.mit.edu/music21/> program, and if missing
filled-in again from L<https://bach-chorales.com/>. Check out the
links in the L</SEE ALSO> section for more information.
The main purpose of this module is to produce the results of the
F<eg/*> programs. So check 'em out!
=head1 ATTRIBUTES
=head2 data_file
$file = $bach->data_file;
The local file where the Bach choral harmony data set resides.
Default: F<dist_dir()/jsbach_chorals_harmony.data>
=head2 key_title
$file = $bach->key_title;
The local file where the key signatures and titles for each song are listed by
BWV number.
Default: F<dist_dir()/jsbach_BWV_keys_titles.txt>
=head2 data
$songs = $bach->data;
The data resulting from the L</parse> method.
=head1 METHODS
=head2 new
$bach = Music::BachChoralHarmony->new;
Create a new C<Music::BachChoralHarmony> object.
=head2 parse
$songs = $bach->parse;
Parse the B<data_file> and B<key_title> files into the B<data> hash
reference of each song keyed by the song id. Each song includes a BWV
identifier, title, key and list of events. The event list is made of
hash references with a B<notes> bit-string, B<bass> note, the
B<accent> value and the resonating B<chord>.
=head2 search
$songs = $bach->search( $k => $v ); # As in the SYNOPSIS above
Search the parsed result B<data> by song B<id>s, B<key>s, B<bass>
notes, B<chord>s, or individual B<notes> and return a hash reference
of the format:
{ $song_id => $song_data, ... }
The B<id>, and B<key> can be searched by single or multiple values
returning all songs that match. Note names must be separated with a
space character.
The B<bass>, B<chord>, and B<notes> can be searched either as C<or>
(separating note names with a space character), or as inclusive C<and>
(separating note names with an C<&> character).
=head2 bits2notes
$notes = $bach->bits2notes($string);
$notes = $bach->bits2notes( $string, $accidental );
Convert a bit-string of 12 binary positions to a note list array
reference.
The B<accidental> can be given as C<#> sharp or C<b> flat in the case
of enharmonic notes. Default: C<b>
The dataset B<notes> bit-string is defined by position as follows:
0 => C
1 => C# or Db
2 => D
3 => D# or Eb
4 => E
5 => F
6 => F# or Gb
7 => G
8 => G# or Ab
9 => A
10 => A# or Bb
11 => B
=head1 SEE ALSO
The F<eg/*> and F<t/01-methods.t> files in this distribution.
L<File::ShareDir>
L<List::Util>
L<Moo>
L<Text::CSV>
L<https://archive.ics.uci.edu/ml/datasets/Bach+Choral+Harmony>
is the dataset itself.
L<https://web.archive.org/web/20140515065053/http://www.jsbchorales.net/bwv.shtml>
was the original site.
L<http://www.bach-chorales.com/BachChorales.htm>
is a more modern site.
L<https://github.com/ology/Bach-Chorales/>
is a web app that displays chord transitions with this module.
L<https://github.com/ology/Bach-Chorales/blob/master/bin/key.py>
is a program written to extract the key signature.
L<https://github.com/ology/Bach-Chorales/blob/master/chorales.zip>
are the collected MIDI files and PDF transcriptions.
L<https://en.wikipedia.org/wiki/Chorale_cantata_(Bach)>
describes the context.
=head1 THANK YOU
Dan Book (L<DBOOK|https://metacpan.org/author/DBOOK>)
for the ShareDir clues.
=head1 AUTHOR
Gene Boggs <gene@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2022 by Gene Boggs.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut