File Coverage

blib/lib/Music/Intervals/Numeric.pm

Criterion	Covered	Total	%
statement	76	76	100.0
branch	3	4	75.0
condition			n/a
subroutine	18	18	100.0
pod	6	6	100.0
total	103	104	99.0

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

# ABSTRACT: Breakdown of numeric musical intervals

use strict;
use warnings;

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


has notes => (
    is => 'ro',
    default => sub { [qw( 1/1 5/4 3/2 )] },
);


has ratios => (
    is      => 'ro',
    builder => 1,
);
sub _build_ratios {
  my ($self) = @_;
  no warnings 'once';
  my $ratios = { map {
    $Music::Intervals::Ratios::ratio->{$_}{ratio} => $Music::Intervals::Ratios::ratio->{$_}{name}
  } keys %$Music::Intervals::Ratios::ratio };
  return $ratios;
}

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

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


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

    my %frequencies = map { $_ => $self->ratios->{$_} } @{ $self->notes };

    return \%frequencies;
}

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

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

    my %intervals = map {
        $_ => {
            $dyads{$_} => $self->ratios->{ $dyads{$_} }
        }
    } keys %dyads;

    return \%intervals;
}

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

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

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

    return \%cent_vals;
}

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

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

    my %prime_factor = map {
        $_ => {
            $dyads{$_} => scalar ratio_factorize( $dyads{$_} )
        }
    } keys %dyads;

    return \%prime_factor;
}


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( $i->[1] );
        my $denominator = Number::Fraction->new( $i->[0] );
        my $fraction = $numerator / $denominator;

        $dyads{"@$i"} = $fraction->to_string;
    }

    return %dyads;
}


sub ratio_factorize {
    my $dyad = shift;

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

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

1;

__END__