File Coverage

blib/lib/Music/Intervals.pm

Criterion	Covered	Total	%
statement	122	122	100.0
branch	6	6	100.0
condition	4	9	44.4
subroutine	29	29	100.0
pod	13	13	100.0
total	174	179	97.2

package Music::Intervals;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: Breakdown of musical intervals

use strict;
use warnings;

our $VERSION = '0.0903';

use Algorithm::Combinatorics qw( combinations );
use Math::Factor::XS qw( prime_factors );
use MIDI::Pitch qw( name2freq );
use Moo;
use Music::Intervals::Ratios;
use Number::Fraction ();
use strictures 2;
use namespace::clean;


has notes => (
    is      => 'ro',
    default => sub { [qw( C E G )] },
);

has _dyads => (
    is      => 'ro',
    lazy    => 1,
    builder => 1,
);
sub _build__dyads {
    my $self = shift;
    my %dyads = $self->dyads($self->notes);
    return \%dyads;
}

has _octave => ( is => 'ro', default => sub { 4 } );
has _concert => ( is => 'ro', default => sub { 440 } );
has _tonic => ( is => 'ro', default => sub { 'C' } );
has _semitones => ( is => 'ro', default => sub { 12 } );
has _midikey => ( is => 'ro', default => sub { 69 } );

has _temper => (
    is      => 'ro',
    lazy    => 1,
    builder => 1,
);
sub _build__temper {
    my $self = shift;
    $self->_semitones * 100 / log(2);
}

has _tonic_frequency => (
    is      => 'ro',
    lazy    => 1,
    builder => 1,
);
sub _build__tonic_frequency {
    my $self = shift;
    return name2freq($self->_tonic . $self->_octave);
}

has _note_index => (
    is      => 'ro',
    lazy    => 1,
    builder => 1,
);
sub _build__note_index {
    my $self = shift;
    return { map { $_ => eval "$Music::Intervals::Ratios::ratio->{$_}{ratio}" } @{ $self->notes } };
}

has _ratio_index => (
    is      => 'ro',
    lazy    => 1,
    builder => 1,
);
sub _build__ratio_index {
    my $self = shift;
    return { map { $_ => $Music::Intervals::Ratios::ratio->{$_}{ratio} } @{ $self->notes } };
}

has _ratio_name_index => (
    is      => 'ro',
    lazy    => 1,
    builder => 1,
);
sub _build__ratio_name_index {
    my $self = shift;
    return {
        map { $Music::Intervals::Ratios::ratio->{$_}{ratio} => {
            symbol => $_,
            name   => $Music::Intervals::Ratios::ratio->{$_}{name} }
        } keys %$Music::Intervals::Ratios::ratio
    }
}


sub integer_notation {
    my ($self) = @_;

    my %integer_notation = map { $_ => sprintf '%.0f',
        $self->_midikey + $self->_semitones
        * log( ($self->_tonic_frequency * (eval $self->_ratio_index->{$_})) / $self->_concert ) / log(2)
    } @{ $self->notes };

    return \%integer_notation;
}


sub eq_tempered_cents {
    my ($self) = @_;

    my %dyads = %{ $self->_dyads };

    my %eq_tempered_cents = map {
        $_ => log( $dyads{$_}->{eq_tempered} ) * $self->_temper
    } keys %dyads;

    return \%eq_tempered_cents;
}


sub eq_tempered_frequencies {
    my ($self) = @_;

    my %eq_tempered_frequencies = map {
        $_ => name2freq( $_ . $self->_octave ) || $self->_concert * $self->_note_index->{$_}
    } @{ $self->notes };

    return \%eq_tempered_frequencies;
}


sub eq_tempered_intervals {
    my ($self) = @_;

    my %dyads = %{ $self->_dyads };

    my %eq_tempered_intervals = map {
        $_ => $dyads{$_}->{eq_tempered}
    } keys %dyads;

    return \%eq_tempered_intervals;
}


sub natural_cents {
    my ($self) = @_;

    my %dyads = %{ $self->_dyads };

    my %natural_cents = map {
        $_ => log( eval $dyads{$_}->{natural} ) * $self->_temper
    } keys %dyads;

    return \%natural_cents;
}


sub natural_frequencies {
    my ($self) = @_;

    my %natural_frequencies = map {
        $_ => {
            $self->_tonic_frequency * eval $self->_ratio_index->{$_} . ''
                => { $self->_ratio_index->{$_} => $Music::Intervals::Ratios::ratio->{$_}{name} }
        }
    } @{ $self->notes };

    return \%natural_frequencies;
}


sub natural_intervals {
    my ($self) = @_;

    my %dyads = %{ $self->_dyads };

    my %natural_intervals = map {
        $_ => {
            $dyads{$_}->{natural} => $self->_ratio_name_index->{ $dyads{$_}->{natural} }{name}
        }
    } keys %dyads;

    return \%natural_intervals;
}


sub natural_prime_factors {
    my ($self) = @_;

    my %dyads = %{ $self->_dyads };

    my %natural_prime_factors = map {
        $_ => {
            $dyads{$_}->{natural} => $self->ratio_factorize( $dyads{$_}->{natural} )
        }
    } keys %dyads;

    return \%natural_prime_factors;
}


sub dyads {
    my $self = shift;
    my ($c) = @_;

    return () if @$c <= 1;

    my @pairs = combinations( $c, 2 );

    my %dyads;
    for my $i (@pairs) {
        # Construct our "dyadic" fraction.
        my $numerator   = Number::Fraction->new( $self->_ratio_index->{ $i->[1] } );
        my $denominator = Number::Fraction->new( $self->_ratio_index->{ $i->[0] } );
        my $fraction = $numerator / $denominator;

        my $str = $fraction->to_string;
        # Handle the octave.
        $str .= '/1' if $fraction->to_string eq 2;

        # Calculate both natural and equal temperament values for our ratio.
        $dyads{"@$i"} = {
            natural => $str,
            # The value is either the known pitch ratio or ...
            eq_tempered =>
              ( name2freq( $i->[1] . $self->_octave ) || ( $self->_concert * $self->_note_index->{ $i->[1] } ) )
                /
              ( name2freq( $i->[0] . $self->_octave ) || ( $self->_concert * $self->_note_index->{ $i->[0] } ) ),
        };
    }

    return %dyads;
}


sub ratio_factorize {
    my ($self, $dyad) = @_;

    my ( $numerator, $denominator ) = split /\//, $dyad;
    $numerator   = [ prime_factors($numerator) ];
    $denominator = [ prime_factors($denominator) ];

    return sprintf( '(%s) / (%s)',
        join( '*', @$numerator ),
        join( '*', @$denominator )
    );
}


sub by_name {
    my ( $self, $name ) = @_;
    return $Music::Intervals::Ratios::ratio->{$name};
}


sub by_ratio {
    my ( $self, $ratio ) = @_;
    return $self->_ratio_name_index->{$ratio};
}


sub by_description {
    my ( $self, $string ) = @_;
    $string = lc $string;
    my %matches;
    for my $ratio (keys %$Music::Intervals::Ratios::ratio) {
        my $found = $Music::Intervals::Ratios::ratio->{$ratio};
        $matches{$ratio} = $found
            if lc($found->{name}) =~ /$string/;
    }
    return \%matches;
}

1;

__END__