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


line stmt bran cond sub pod time code
1             package Music::Intervals::Numeric;
2             $Music::Intervals::Numeric::VERSION = '0.0904';
3             our $AUTHORITY = 'cpan:GENE';
4              
5             # ABSTRACT: Breakdown of numeric musical intervals
6              
7 1     1   645 use strict;
  1         3  
  1         26  
8 1     1   4 use warnings;
  1         1  
  1         24  
9              
10 1     1   469 use Algorithm::Combinatorics qw( combinations );
  1         3255  
  1         58  
11 1     1   402 use Math::Factor::XS qw( prime_factors );
  1         25010  
  1         53  
12 1     1   509 use Number::Fraction ();
  1         50812  
  1         33  
13 1     1   658 use Music::Intervals::Ratios;
  1         13  
  1         32  
14 1     1   7 use Moo;
  1         2  
  1         6  
15 1     1   744 use strictures 2;
  1         1374  
  1         34  
16 1     1   598 use namespace::clean;
  1         7311  
  1         22  
17              
18              
19             has notes => (
20             is => 'ro',
21             default => sub { [qw( 1/1 5/4 3/2 )] },
22             );
23              
24              
25             has ratios => (
26             is => 'ro',
27             builder => 1,
28             );
29             sub _build_ratios {
30 2     2   7 my ($self) = @_;
31 1     1   328 no warnings 'once';
  1         12  
  1         1157  
32             my $ratios = { map {
33 2         99 $Music::Intervals::Ratios::ratio->{$_}{ratio} => $Music::Intervals::Ratios::ratio->{$_}{name}
34 1016         2117 } keys %$Music::Intervals::Ratios::ratio };
35 2         91 return $ratios;
36             }
37              
38             has _dyads => (
39             is => 'ro',
40             lazy => 1,
41             builder => 1,
42             );
43             sub _build__dyads {
44 2     2   14 my $self = shift;
45 2         6 my %dyads = $self->dyads($self->notes);
46 2         8 return \%dyads;
47             }
48              
49             has _semitones => ( is => 'ro', default => sub { 12 } );
50             has _temper => ( is => 'ro', lazy => 1, default => sub { my $self = shift;
51             $self->_semitones * 100 / log(2) },
52             );
53              
54              
55             sub frequencies {
56 2     2 1 770 my ($self) = @_;
57              
58 2         4 my %frequencies = map { $_ => $self->ratios->{$_} } @{ $self->notes };
  4         13  
  2         6  
59              
60 2         11 return \%frequencies;
61             }
62              
63             sub intervals {
64 2     2 1 283 my ($self) = @_;
65              
66 2         2 my %dyads = %{ $self->_dyads };
  2         43  
67              
68             my %intervals = map {
69 2         5 $_ => {
70 3         19 $dyads{$_} => $self->ratios->{ $dyads{$_} }
71             }
72             } keys %dyads;
73              
74 2         12 return \%intervals;
75             }
76              
77             sub cent_vals {
78 4     4 1 278 my ($self) = @_;
79              
80 4         4 my %dyads = %{ $self->_dyads };
  4         87  
81              
82             my %cent_vals = map {
83 4         37 $_ => log( eval $dyads{$_} ) * $self->_temper
  9         417  
84             } keys %dyads;
85            
86 4         73 return \%cent_vals;
87             }
88              
89             sub prime_factor {
90 2     2 1 263 my ($self) = @_;
91              
92 2         3 my %dyads = %{ $self->_dyads };
  2         38  
93              
94             my %prime_factor = map {
95 2         18 $_ => {
96 3         7 $dyads{$_} => scalar ratio_factorize( $dyads{$_} )
97             }
98             } keys %dyads;
99              
100 2         13 return \%prime_factor;
101             }
102              
103              
104             sub dyads {
105 2     2 1 3 my $self = shift;
106 2         3 my ($c) = @_;
107              
108 2 100       6 return () if @$c <= 1;
109              
110 1         13 my @pairs = combinations( $c, 2 );
111              
112 1         122 my %dyads;
113 1         2 for my $i (@pairs) {
114             # Construct our "dyadic" fraction.
115 3         63 my $numerator = Number::Fraction->new( $i->[1] );
116 3         2883 my $denominator = Number::Fraction->new( $i->[0] );
117 3         549 my $fraction = $numerator / $denominator;
118              
119 3         511 $dyads{"@$i"} = $fraction->to_string;
120             }
121              
122 1         17 return %dyads;
123             }
124              
125              
126             sub ratio_factorize {
127 3     3 1 3 my $dyad = shift;
128              
129 3         7 my ( $numerator, $denominator ) = split /\//, $dyad;
130 3         19 $numerator = [ prime_factors($numerator) ];
131 3         7 $denominator = [ prime_factors($denominator) ];
132              
133             return wantarray
134 3 50       19 ? ( $numerator, $denominator )
135             : sprintf( '(%s) / (%s)',
136             join( '*', @$numerator ),
137             join( '*', @$denominator )
138             );
139             }
140              
141             1;
142              
143             __END__