File Coverage

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


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 2     2   614277 use strict;
  2         5  
  2         68  
7 2     2   7 use warnings;
  2         3  
  2         144  
8              
9             our $VERSION = '0.0404';
10              
11 2     2   9 use List::Util qw( min );
  2         7  
  2         188  
12              
13 2     2   9 use Exporter 'import';
  2         3  
  2         108  
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 2     2   10 use constant SIZE => 3; # Default chord size
  2         4  
  2         141  
26 2     2   14 use constant SCALE => 12; # Default number of scale notes
  2         6  
  2         1000  
27              
28              
29             sub barycenter {
30 38   100 38 1 1562 my $size = shift || SIZE; # Default to a triad
31 38   100     121 my $scale = shift || SCALE; # Default to the common scale notes
32 38         198 return ($scale / $size) x $size;
33             }
34              
35              
36             sub distance {
37 141     141 1 3482 my ($chord1, $chord2) = @_;
38 141         219 my $distance = 0;
39 141         339 for my $note (0 .. @$chord1 - 1) {
40 438         1033 $distance += ($chord1->[$note] - $chord2->[$note]) ** 2;
41             }
42 141         237 $distance /= 2;
43 141         436 return sqrt $distance;
44             }
45              
46              
47             sub orbit_distance {
48 14     14 1 8262 my ($chord1, $chord2) = @_;
49 14         30 my @distance = ();
50 14         43 for my $perm (cyclic_permutation(@$chord2)) {
51 43         96 push @distance, distance($chord1, $perm);
52             }
53 14         182 return min(@distance);
54             }
55              
56              
57             sub forte_distance {
58 10     10 1 6038 my ($chord1, $chord2) = @_;
59 10         21 my @distance = ();
60 10         28 for my $perm (cyclic_permutation(@$chord2)) {
61 31         78 push @distance, distance($chord1, $perm);
62 31         83 push @distance, distance($chord1, [reverse @$perm]);
63             }
64 10         116 return min(@distance);
65             }
66              
67              
68             sub cyclic_permutation {
69 26     26 1 5584 my @set = @_;
70 26         43 my @cycles = ();
71 26         94 for my $backward (reverse 0 .. @set - 1) {
72 80         212 for my $forward (0 .. @set - 1) {
73 248         456 push @{ $cycles[$backward] }, $set[$forward - $backward];
  248         613  
74             }
75             }
76 26         102 return @cycles;
77             }
78              
79              
80             sub evenness_index {
81 22     22 1 5660 my $chord = shift;
82 22         80 my @b = barycenter( scalar @$chord );
83 22         85 my $i = distance( $chord, \@b );
84 22         159 return $i;
85             }
86              
87              
88             sub inversion {
89 22     22 1 6830 my $chord = shift;
90 22         140 return [ reverse @$chord ];
91             }
92              
93             1;
94              
95             __END__