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   654932 use strict;
  2         4  
  2         79  
7 2     2   10 use warnings;
  2         4  
  2         171  
8              
9             our $VERSION = '0.0405';
10              
11 2     2   11 use List::Util qw( min );
  2         9  
  2         193  
12              
13 2     2   10 use Exporter 'import';
  2         4  
  2         107  
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   9 use constant SIZE => 3; # Default chord size
  2         4  
  2         133  
26 2     2   8 use constant SCALE => 12; # Default number of scale notes
  2         4  
  2         1238  
27              
28              
29             sub barycenter {
30 38   100 38 1 2201 my $size = shift || SIZE; # Default to a triad
31 38   100     126 my $scale = shift || SCALE; # Default to the common scale notes
32 38         186 return ($scale / $size) x $size;
33             }
34              
35              
36             sub distance {
37 153     153 1 4360 my ($chord1, $chord2) = @_;
38 153         227 my $distance = 0;
39 153         333 for my $note (0 .. @$chord1 - 1) {
40 474         1016 $distance += ($chord1->[$note] - $chord2->[$note]) ** 2;
41             }
42 153         230 $distance /= 2;
43 153         470 return sqrt $distance;
44             }
45              
46              
47             sub orbit_distance {
48 14     14 1 3525 my ($chord1, $chord2) = @_;
49 14         25 my @distance = ();
50 14         47 for my $perm (cyclic_permutation(@$chord2)) {
51 43         112 push @distance, distance($chord1, $perm);
52             }
53 14         143 return min(@distance);
54             }
55              
56              
57             sub forte_distance {
58 12     12 1 5213 my ($chord1, $chord2) = @_;
59 12         26 my @distance = ();
60 12         35 for my $perm (cyclic_permutation(@$chord2)) {
61 37         83 push @distance, distance($chord1, $perm);
62 37         94 push @distance, distance($chord1, [reverse @$perm]);
63             }
64 12         151 return min(@distance);
65             }
66              
67              
68             sub cyclic_permutation {
69 28     28 1 4407 my @set = @_;
70 28         52 my @cycles = ();
71 28         88 for my $backward (reverse 0 .. @set - 1) {
72 86         208 for my $forward (0 .. @set - 1) {
73 266         384 push @{ $cycles[$backward] }, $set[$forward - $backward];
  266         606  
74             }
75             }
76 28         107 return @cycles;
77             }
78              
79              
80             sub evenness_index {
81 22     22 1 5206 my $chord = shift;
82 22         66 my @b = barycenter( scalar @$chord );
83 22         66 my $i = distance( $chord, \@b );
84 22         197 return $i;
85             }
86              
87              
88             sub inversion {
89 22     22 1 5146 my $chord = shift;
90 22         109 return [ reverse @$chord ];
91             }
92              
93             1;
94              
95             __END__