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   644640 use strict;
  2         3  
  2         72  
7 2     2   8 use warnings;
  2         4  
  2         157  
8              
9             our $VERSION = '0.0403';
10              
11 2     2   8 use List::Util qw( min );
  2         8  
  2         250  
12              
13 2     2   9 use Exporter 'import';
  2         3  
  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   7 use constant SIZE => 3; # Default chord size
  2         4  
  2         126  
26 2     2   7 use constant SCALE => 12; # Default number of scale notes
  2         3  
  2         871  
27              
28              
29             sub barycenter {
30 29   100 29 1 1692 my $size = shift || SIZE; # Default to a triad
31 29   100     95 my $scale = shift || SCALE; # Default to the common scale notes
32 29         153 return ($scale / $size) x $size;
33             }
34              
35              
36             sub distance {
37 106     106 1 5350 my ($chord1, $chord2) = @_;
38 106         146 my $distance = 0;
39 106         213 for my $note (0 .. @$chord1 - 1) {
40 333         670 $distance += ($chord1->[$note] - $chord2->[$note]) ** 2;
41             }
42 106         184 $distance /= 2;
43 106         271 return sqrt $distance;
44             }
45              
46              
47             sub orbit_distance {
48 9     9 1 4693 my ($chord1, $chord2) = @_;
49 9         14 my @distance = ();
50 9         24 for my $perm (cyclic_permutation(@$chord2)) {
51 28         47 push @distance, distance($chord1, $perm);
52             }
53 9         72 return min(@distance);
54             }
55              
56              
57             sub forte_distance {
58 9     9 1 5115 my ($chord1, $chord2) = @_;
59 9         17 my @distance = ();
60 9         23 for my $perm (cyclic_permutation(@$chord2)) {
61 28         54 push @distance, distance($chord1, $perm);
62 28         61 push @distance, distance($chord1, [reverse @$perm]);
63             }
64 9         93 return min(@distance);
65             }
66              
67              
68             sub cyclic_permutation {
69 20     20 1 5320 my @set = @_;
70 20         32 my @cycles = ();
71 20         62 for my $backward (reverse 0 .. @set - 1) {
72 62         122 for my $forward (0 .. @set - 1) {
73 194         247 push @{ $cycles[$backward] }, $set[$forward - $backward];
  194         377  
74             }
75             }
76 20         70 return @cycles;
77             }
78              
79              
80             sub evenness_index {
81 13     13 1 5121 my $chord = shift;
82 13         55 my @b = barycenter( scalar @$chord );
83 13         72 my $i = distance( $chord, \@b );
84 13         101 return $i;
85             }
86              
87              
88             sub inversion {
89 3     3 1 5433 my $chord = shift;
90 3         88 return [ reverse @$chord ];
91             }
92              
93             1;
94              
95             __END__