File Coverage

blib/lib/Music/Interval/Barycentric.pm

Criterion	Covered	Total	%
statement	49	49	100.0
branch			n/a
condition	2	4	50.0
subroutine	12	12	100.0
pod	6	6	100.0
total	69	71	97.1

package Music::Interval::Barycentric;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: Compute barycentric musical interval space

use strict;
use warnings;

our $VERSION = '0.0307';

use List::Util qw( min );

use Exporter 'import';

our @EXPORT = qw(
    barycenter
    distance
    evenness_index
    orbit_distance
    forte_distance
    cyclic_permutation
);

use constant SIZE  => 3;  # Default chord size
use constant SCALE => 12; # Default number of scale notes


sub barycenter {
    my $size  = shift || SIZE;  # Default to a triad
    my $scale = shift || SCALE; # Default to the common scale notes
    return ($scale / $size) x $size;
}


sub distance {
    my ($chord1, $chord2) = @_;
    my $distance = 0;
    for my $note (0 .. @$chord1 - 1) {
        $distance += ($chord1->[$note] - $chord2->[$note]) ** 2;
    }
    $distance /= 2;
    return sqrt $distance;
}


sub orbit_distance {
    my ($chord1, $chord2) = @_;
    my @distance = ();
    for my $perm (cyclic_permutation(@$chord2)) {
        push @distance, distance($chord1, $perm);
    }
    return min(@distance);
}


sub forte_distance {
    my ($chord1, $chord2) = @_;
    my @distance = ();
    for my $perm (cyclic_permutation(@$chord2)) {
        push @distance, distance($chord1, $perm);
        push @distance, distance($chord1, [reverse @$perm]);
    }
    return min(@distance);
}


sub cyclic_permutation {
    my @set = @_;
    my @cycles = ();
    for my $backward (reverse 0 .. @set - 1) {
        for my $forward (0 .. @set - 1) {
            push @{ $cycles[$backward] }, $set[$forward - $backward];
        }
    }
    return @cycles;
}


sub evenness_index {
    my $chord = shift;
    my @b = barycenter( scalar @$chord );
    my $i = distance( $chord, \@b );
    return $i;
}

1;

__END__