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__ |