File Coverage

blib/lib/Music/Interval/Barycentric.pm
Criterion Covered Total %
statement 51 51 100.0
branch n/a
condition 2 4 50.0
subroutine 13 13 100.0
pod 7 7 100.0
total 73 75 97.3


line stmt bran cond sub pod time code
1             package Music::Interval::Barycentric;
2             our $AUTHORITY = 'cpan:GENE';
3              
4             # ABSTRACT: Compute barycentric musical interval space
5              
6 1     1   811 use strict;
  1         2  
  1         30  
7 1     1   6 use warnings;
  1         2  
  1         43  
8              
9             our $VERSION = '0.0400';
10              
11 1     1   6 use List::Util qw( min );
  1         2  
  1         100  
12              
13 1     1   7 use Exporter 'import';
  1         2  
  1         61  
14              
15             our @EXPORT = qw(
16             barycenter
17             distance
18             evenness_index
19             orbit_distance
20             forte_distance
21             cyclic_permutation
22             inversion
23             );
24              
25 1     1   7 use constant SIZE => 3; # Default chord size
  1         2  
  1         106  
26 1     1   7 use constant SCALE => 12; # Default number of scale notes
  1         2  
  1         558  
27              
28              
29             sub barycenter {
30 13   50 13 1 642 my $size = shift || SIZE; # Default to a triad
31 13   50     49 my $scale = shift || SCALE; # Default to the common scale notes
32 13         55 return ($scale / $size) x $size;
33             }
34              
35              
36             sub distance {
37 95     95 1 167 my ($chord1, $chord2) = @_;
38 95         132 my $distance = 0;
39 95         178 for my $note (0 .. @$chord1 - 1) {
40 300         539 $distance += ($chord1->[$note] - $chord2->[$note]) ** 2;
41             }
42 95         137 $distance /= 2;
43 95         226 return sqrt $distance;
44             }
45              
46              
47             sub orbit_distance {
48 8     8 1 51 my ($chord1, $chord2) = @_;
49 8         17 my @distance = ();
50 8         18 for my $perm (cyclic_permutation(@$chord2)) {
51 25         43 push @distance, distance($chord1, $perm);
52             }
53 8         68 return min(@distance);
54             }
55              
56              
57             sub forte_distance {
58 8     8 1 19 my ($chord1, $chord2) = @_;
59 8         13 my @distance = ();
60 8         19 for my $perm (cyclic_permutation(@$chord2)) {
61 25         43 push @distance, distance($chord1, $perm);
62 25         53 push @distance, distance($chord1, [reverse @$perm]);
63             }
64 8         66 return min(@distance);
65             }
66              
67              
68             sub cyclic_permutation {
69 18     18 1 41 my @set = @_;
70 18         27 my @cycles = ();
71 18         50 for my $backward (reverse 0 .. @set - 1) {
72 56         116 for my $forward (0 .. @set - 1) {
73 176         217 push @{ $cycles[$backward] }, $set[$forward - $backward];
  176         343  
74             }
75             }
76 18         57 return @cycles;
77             }
78              
79              
80             sub evenness_index {
81 12     12 1 27 my $chord = shift;
82 12         31 my @b = barycenter( scalar @$chord );
83 12         32 my $i = distance( $chord, \@b );
84 12         96 return $i;
85             }
86              
87              
88             sub inversion {
89 2     2 1 5 my $chord = shift;
90 2         12 return [ reverse @$chord ];
91             }
92              
93             1;
94              
95             __END__