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   816 use strict;
  1         2  
  1         28  
7 1     1   5 use warnings;
  1         2  
  1         40  
8              
9             our $VERSION = '0.0401';
10              
11 1     1   6 use List::Util qw( min );
  1         2  
  1         87  
12              
13 1     1   21 use Exporter 'import';
  1         3  
  1         54  
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   6 use constant SIZE => 3; # Default chord size
  1         2  
  1         101  
26 1     1   7 use constant SCALE => 12; # Default number of scale notes
  1         4  
  1         541  
27              
28              
29             sub barycenter {
30 13   50 13 1 626 my $size = shift || SIZE; # Default to a triad
31 13   50     46 my $scale = shift || SCALE; # Default to the common scale notes
32 13         52 return ($scale / $size) x $size;
33             }
34              
35              
36             sub distance {
37 95     95 1 1180 my ($chord1, $chord2) = @_;
38 95         131 my $distance = 0;
39 95         175 for my $note (0 .. @$chord1 - 1) {
40 300         545 $distance += ($chord1->[$note] - $chord2->[$note]) ** 2;
41             }
42 95         152 $distance /= 2;
43 95         247 return sqrt $distance;
44             }
45              
46              
47             sub orbit_distance {
48 8     8 1 703 my ($chord1, $chord2) = @_;
49 8         14 my @distance = ();
50 8         17 for my $perm (cyclic_permutation(@$chord2)) {
51 25         46 push @distance, distance($chord1, $perm);
52             }
53 8         69 return min(@distance);
54             }
55              
56              
57             sub forte_distance {
58 8     8 1 700 my ($chord1, $chord2) = @_;
59 8         13 my @distance = ();
60 8         17 for my $perm (cyclic_permutation(@$chord2)) {
61 25         45 push @distance, distance($chord1, $perm);
62 25         50 push @distance, distance($chord1, [reverse @$perm]);
63             }
64 8         70 return min(@distance);
65             }
66              
67              
68             sub cyclic_permutation {
69 18     18 1 732 my @set = @_;
70 18         33 my @cycles = ();
71 18         47 for my $backward (reverse 0 .. @set - 1) {
72 56         105 for my $forward (0 .. @set - 1) {
73 176         266 push @{ $cycles[$backward] }, $set[$forward - $backward];
  176         313  
74             }
75             }
76 18         52 return @cycles;
77             }
78              
79              
80             sub evenness_index {
81 12     12 1 714 my $chord = shift;
82 12         26 my @b = barycenter( scalar @$chord );
83 12         27 my $i = distance( $chord, \@b );
84 12         113 return $i;
85             }
86              
87              
88             sub inversion {
89 2     2 1 735 my $chord = shift;
90 2         24 return [ reverse @$chord ];
91             }
92              
93             1;
94              
95             __END__