module Music.Theory.Pitch.Spelling.Cluster where
import Data.List
import qualified Music.Theory.List as T
import qualified Music.Theory.Pitch as T
import qualified Music.Theory.Pitch.Note as T
import Music.Theory.Pitch.Note.Name
cluster_normal_order :: [T.PitchClass] -> [T.PitchClass]
cluster_normal_order :: [PitchClass] -> [PitchClass]
cluster_normal_order =
let with_bounds :: [a] -> (a, [a])
with_bounds [a]
x = ((forall a. [a] -> a
last [a]
x forall a. Num a => a -> a -> a
- forall a. [a] -> a
head [a]
x) forall a. Integral a => a -> a -> a
`mod` a
12,[a]
x)
in forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Integral a => [a] -> (a, [a])
with_bounds forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
T.rotations
cluster_normal_order_octpc :: T.Octave -> [T.PitchClass] -> [T.OctPc]
cluster_normal_order_octpc :: PitchClass -> [PitchClass] -> [OctPc]
cluster_normal_order_octpc PitchClass
o [PitchClass]
pc =
let pc_n :: [PitchClass]
pc_n = [PitchClass] -> [PitchClass]
cluster_normal_order [PitchClass]
pc
pc_0 :: PitchClass
pc_0 = forall a. [a] -> a
head [PitchClass]
pc_n
in forall a b. (a -> b) -> [a] -> [b]
map (\PitchClass
x -> (if PitchClass
x forall a. Ord a => a -> a -> Bool
>= PitchClass
pc_0 then PitchClass
o else PitchClass
o forall a. Num a => a -> a -> a
+ PitchClass
1,PitchClass
x)) [PitchClass]
pc_n
cluster_is_multiple_octave :: [T.PitchClass] -> Bool
cluster_is_multiple_octave :: [PitchClass] -> Bool
cluster_is_multiple_octave [PitchClass]
x = forall a. Ord a => [a] -> [a]
sort [PitchClass]
x forall a. Eq a => a -> a -> Bool
/= [PitchClass] -> [PitchClass]
cluster_normal_order [PitchClass]
x
spell_cluster_table :: [([T.PitchClass],[(T.Note,T.Alteration)])]
spell_cluster_table :: [([PitchClass], [(Note, Alteration)])]
spell_cluster_table =
[([PitchClass
0,PitchClass
1,PitchClass
2,PitchClass
3],[(Note, Alteration)
bis,(Note, Alteration)
cis,(Note, Alteration)
d,(Note, Alteration)
ees])
,([PitchClass
0,PitchClass
1,PitchClass
2],[(Note, Alteration)
bis,(Note, Alteration)
cis,(Note, Alteration)
d])
,([PitchClass
0,PitchClass
1,PitchClass
3],[(Note, Alteration)
c,(Note, Alteration)
des,(Note, Alteration)
ees])
,([PitchClass
0,PitchClass
1],[(Note, Alteration)
c,(Note, Alteration)
des])
,([PitchClass
0,PitchClass
2,PitchClass
3],[(Note, Alteration)
c,(Note, Alteration)
d,(Note, Alteration)
ees])
,([PitchClass
0,PitchClass
2],[(Note, Alteration)
c,(Note, Alteration)
d])
,([PitchClass
0],[(Note, Alteration)
c])
,([PitchClass
1,PitchClass
2,PitchClass
3],[(Note, Alteration)
cis,(Note, Alteration)
d,(Note, Alteration)
ees])
,([PitchClass
1,PitchClass
2],[(Note, Alteration)
cis,(Note, Alteration)
d])
,([PitchClass
10,PitchClass
0,PitchClass
1,PitchClass
2],[(Note, Alteration)
ais,(Note, Alteration)
bis,(Note, Alteration)
cis,(Note, Alteration)
d])
,([PitchClass
10,PitchClass
0,PitchClass
1,PitchClass
3],[(Note, Alteration)
bes,(Note, Alteration)
c,(Note, Alteration)
des,(Note, Alteration)
ees])
,([PitchClass
10,PitchClass
0,PitchClass
1],[(Note, Alteration)
bes,(Note, Alteration)
c,(Note, Alteration)
des])
,([PitchClass
10,PitchClass
0,PitchClass
2,PitchClass
3],[(Note, Alteration)
bes,(Note, Alteration)
c,(Note, Alteration)
d,(Note, Alteration)
ees])
,([PitchClass
10,PitchClass
0,PitchClass
2],[(Note, Alteration)
bes,(Note, Alteration)
c,(Note, Alteration)
d])
,([PitchClass
10,PitchClass
1,PitchClass
2,PitchClass
3],[(Note, Alteration)
bes,(Note, Alteration)
cis,(Note, Alteration)
d,(Note, Alteration)
ees])
,([PitchClass
10,PitchClass
1,PitchClass
2],[(Note, Alteration)
ais,(Note, Alteration)
cis,(Note, Alteration)
d])
,([PitchClass
10,PitchClass
11,PitchClass
0,PitchClass
1,PitchClass
2,PitchClass
3],[(Note, Alteration)
ais,(Note, Alteration)
b,(Note, Alteration)
c,(Note, Alteration)
cis,(Note, Alteration)
d,(Note, Alteration)
ees])
,([PitchClass
10,PitchClass
11,PitchClass
0,PitchClass
1],[(Note, Alteration)
ais,(Note, Alteration)
b,(Note, Alteration)
c,(Note, Alteration)
des])
,([PitchClass
10,PitchClass
11,PitchClass
0,PitchClass
2],[(Note, Alteration)
ais,(Note, Alteration)
b,(Note, Alteration)
c,(Note, Alteration)
d])
,([PitchClass
10,PitchClass
11,PitchClass
0,PitchClass
3],[(Note, Alteration)
ais,(Note, Alteration)
b,(Note, Alteration)
c,(Note, Alteration)
dis])
,([PitchClass
10,PitchClass
11,PitchClass
0],[(Note, Alteration)
ais,(Note, Alteration)
b,(Note, Alteration)
c])
,([PitchClass
10,PitchClass
11,PitchClass
1,PitchClass
2],[(Note, Alteration)
ais,(Note, Alteration)
b,(Note, Alteration)
cis,(Note, Alteration)
d])
,([PitchClass
10,PitchClass
11,PitchClass
1,PitchClass
3],[(Note, Alteration)
ais,(Note, Alteration)
b,(Note, Alteration)
cis,(Note, Alteration)
dis])
,([PitchClass
10,PitchClass
11,PitchClass
1],[(Note, Alteration)
ais,(Note, Alteration)
b,(Note, Alteration)
cis])
,([PitchClass
10,PitchClass
11,PitchClass
2,PitchClass
3],[(Note, Alteration)
bes,(Note, Alteration)
ces,(Note, Alteration)
d,(Note, Alteration)
ees])
,([PitchClass
10,PitchClass
11,PitchClass
2],[(Note, Alteration)
ais,(Note, Alteration)
b,(Note, Alteration)
d])
,([PitchClass
10,PitchClass
11],[(Note, Alteration)
ais,(Note, Alteration)
b])
,([PitchClass
10],[(Note, Alteration)
bes])
,([PitchClass
11,PitchClass
0,PitchClass
1,PitchClass
2],[(Note, Alteration)
aisis,(Note, Alteration)
bis,(Note, Alteration)
cis,(Note, Alteration)
d])
,([PitchClass
11,PitchClass
0,PitchClass
1,PitchClass
3],[(Note, Alteration)
b,(Note, Alteration)
c,(Note, Alteration)
des,(Note, Alteration)
ees])
,([PitchClass
11,PitchClass
0,PitchClass
1],[(Note, Alteration)
b,(Note, Alteration)
c,(Note, Alteration)
des])
,([PitchClass
11,PitchClass
0,PitchClass
2,PitchClass
3],[(Note, Alteration)
b,(Note, Alteration)
c,(Note, Alteration)
d,(Note, Alteration)
ees])
,([PitchClass
11,PitchClass
0,PitchClass
2],[(Note, Alteration)
b,(Note, Alteration)
c,(Note, Alteration)
d])
,([PitchClass
11,PitchClass
0,PitchClass
3],[(Note, Alteration)
b,(Note, Alteration)
c,(Note, Alteration)
dis])
,([PitchClass
11,PitchClass
0],[(Note, Alteration)
b,(Note, Alteration)
c])
,([PitchClass
11,PitchClass
1,PitchClass
2,PitchClass
3],[(Note, Alteration)
b,(Note, Alteration)
cis,(Note, Alteration)
d,(Note, Alteration)
ees])
,([PitchClass
11,PitchClass
1,PitchClass
2],[(Note, Alteration)
b,(Note, Alteration)
cis,(Note, Alteration)
d])
,([PitchClass
11,PitchClass
1,PitchClass
3],[(Note, Alteration)
b,(Note, Alteration)
cis,(Note, Alteration)
dis])
,([PitchClass
11,PitchClass
1],[(Note, Alteration)
b,(Note, Alteration)
cis])
,([PitchClass
11,PitchClass
2,PitchClass
3],[(Note, Alteration)
b,(Note, Alteration)
d,(Note, Alteration)
ees])
,([PitchClass
11,PitchClass
2],[(Note, Alteration)
b,(Note, Alteration)
d])
,([PitchClass
11],[(Note, Alteration)
b])
,([PitchClass
1],[(Note, Alteration)
cis])
,([PitchClass
2,PitchClass
3,PitchClass
4,PitchClass
5],[(Note, Alteration)
d,(Note, Alteration)
ees,(Note, Alteration)
fes,(Note, Alteration)
geses])
,([PitchClass
2,PitchClass
3,PitchClass
4],[(Note, Alteration)
d,(Note, Alteration)
ees,(Note, Alteration)
fes])
,([PitchClass
2,PitchClass
3,PitchClass
5],[(Note, Alteration)
d,(Note, Alteration)
ees,(Note, Alteration)
f])
,([PitchClass
2,PitchClass
3],[(Note, Alteration)
d,(Note, Alteration)
ees])
,([PitchClass
2,PitchClass
4,PitchClass
5],[(Note, Alteration)
d,(Note, Alteration)
e,(Note, Alteration)
f])
,([PitchClass
2,PitchClass
4],[(Note, Alteration)
d,(Note, Alteration)
e])
,([PitchClass
2,PitchClass
5],[(Note, Alteration)
d,(Note, Alteration)
f])
,([PitchClass
2],[(Note, Alteration)
d])
,([PitchClass
3,PitchClass
4,PitchClass
5],[(Note, Alteration)
dis,(Note, Alteration)
e,(Note, Alteration)
f])
,([PitchClass
3,PitchClass
4],[(Note, Alteration)
dis,(Note, Alteration)
e])
,([PitchClass
3,PitchClass
5],[(Note, Alteration)
ees,(Note, Alteration)
f])
,([PitchClass
3],[(Note, Alteration)
ees])
,([PitchClass
4,PitchClass
5],[(Note, Alteration)
e,(Note, Alteration)
f])
,([PitchClass
4],[(Note, Alteration)
e])
,([PitchClass
5,PitchClass
6,PitchClass
7,PitchClass
8,PitchClass
9],[(Note, Alteration)
eis,(Note, Alteration)
fis,(Note, Alteration)
g,(Note, Alteration)
aes,(Note, Alteration)
beses])
,([PitchClass
5,PitchClass
6,PitchClass
7,PitchClass
8],[(Note, Alteration)
eis,(Note, Alteration)
fis,(Note, Alteration)
g,(Note, Alteration)
aes])
,([PitchClass
5,PitchClass
6,PitchClass
7,PitchClass
9],[(Note, Alteration)
eis,(Note, Alteration)
fis,(Note, Alteration)
g,(Note, Alteration)
a])
,([PitchClass
5,PitchClass
6,PitchClass
7],[(Note, Alteration)
eis,(Note, Alteration)
fis,(Note, Alteration)
g])
,([PitchClass
5,PitchClass
6,PitchClass
8,PitchClass
9],[(Note, Alteration)
eis,(Note, Alteration)
fis,(Note, Alteration)
gis,(Note, Alteration)
a])
,([PitchClass
5,PitchClass
6,PitchClass
8],[(Note, Alteration)
f,(Note, Alteration)
ges,(Note, Alteration)
aes])
,([PitchClass
5,PitchClass
6,PitchClass
9],[(Note, Alteration)
f,(Note, Alteration)
ges,(Note, Alteration)
a])
,([PitchClass
5,PitchClass
6],[(Note, Alteration)
f,(Note, Alteration)
ges])
,([PitchClass
5,PitchClass
7,PitchClass
8,PitchClass
9],[(Note, Alteration)
f,(Note, Alteration)
g,(Note, Alteration)
aes,(Note, Alteration)
beses])
,([PitchClass
5,PitchClass
7,PitchClass
8],[(Note, Alteration)
f,(Note, Alteration)
g,(Note, Alteration)
aes])
,([PitchClass
5,PitchClass
7,PitchClass
9],[(Note, Alteration)
f,(Note, Alteration)
g,(Note, Alteration)
a])
,([PitchClass
5,PitchClass
7],[(Note, Alteration)
f,(Note, Alteration)
g])
,([PitchClass
5,PitchClass
8,PitchClass
9],[(Note, Alteration)
f,(Note, Alteration)
gis,(Note, Alteration)
a])
,([PitchClass
5,PitchClass
8],[(Note, Alteration)
f,(Note, Alteration)
aes])
,([PitchClass
5,PitchClass
9],[(Note, Alteration)
f,(Note, Alteration)
a])
,([PitchClass
5],[(Note, Alteration)
f])
,([PitchClass
6,PitchClass
7,PitchClass
8,PitchClass
9],[(Note, Alteration)
fis,(Note, Alteration)
g,(Note, Alteration)
aes,(Note, Alteration)
beses])
,([PitchClass
6,PitchClass
7,PitchClass
8],[(Note, Alteration)
fis,(Note, Alteration)
g,(Note, Alteration)
aes])
,([PitchClass
6,PitchClass
7,PitchClass
9],[(Note, Alteration)
fis,(Note, Alteration)
g,(Note, Alteration)
a])
,([PitchClass
6,PitchClass
7],[(Note, Alteration)
fis,(Note, Alteration)
g])
,([PitchClass
6,PitchClass
8,PitchClass
9],[(Note, Alteration)
fis,(Note, Alteration)
gis,(Note, Alteration)
a])
,([PitchClass
6,PitchClass
8],[(Note, Alteration)
fis,(Note, Alteration)
gis])
,([PitchClass
6,PitchClass
9],[(Note, Alteration)
fis,(Note, Alteration)
a])
,([PitchClass
6],[(Note, Alteration)
fis])
,([PitchClass
7,PitchClass
8,PitchClass
9],[(Note, Alteration)
fisis,(Note, Alteration)
gis,(Note, Alteration)
a])
,([PitchClass
7,PitchClass
8],[(Note, Alteration)
g,(Note, Alteration)
aes])
,([PitchClass
7,PitchClass
9],[(Note, Alteration)
g,(Note, Alteration)
a])
,([PitchClass
7],[(Note, Alteration)
g])
,([PitchClass
8,PitchClass
10],[(Note, Alteration)
aes,(Note, Alteration)
bes])
,([PitchClass
8,PitchClass
9,PitchClass
10],[(Note, Alteration)
gis,(Note, Alteration)
a,(Note, Alteration)
bes])
,([PitchClass
8,PitchClass
9],[(Note, Alteration)
gis,(Note, Alteration)
a])
,([PitchClass
8],[(Note, Alteration)
aes])
,([PitchClass
9,PitchClass
10],[(Note, Alteration)
a,(Note, Alteration)
bes])
,([PitchClass
9],[(Note, Alteration)
a])]
spell_cluster :: [T.PitchClass] -> Maybe [(T.Note,T.Alteration)]
spell_cluster :: [PitchClass] -> Maybe [(Note, Alteration)]
spell_cluster = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [([PitchClass], [(Note, Alteration)])]
spell_cluster_table
spell_cluster_octpc :: [T.OctPc] -> Maybe [T.Pitch]
spell_cluster_octpc :: [OctPc] -> Maybe [Pitch]
spell_cluster_octpc [OctPc]
o =
let p :: [PitchClass]
p = [PitchClass] -> [PitchClass]
cluster_normal_order (forall a. Ord a => [a] -> [a]
sort (forall a. Eq a => [a] -> [a]
nub (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [OctPc]
o)))
na_f :: [(Note, Alteration)] -> [Pitch]
na_f [(Note, Alteration)]
na =
let na_tbl :: [(PitchClass, (Note, Alteration))]
na_tbl = forall a b. (a -> b) -> [a] -> [b]
map (\(Note, Alteration)
x -> ((Note, Alteration) -> PitchClass
T.note_alteration_to_pc_err (Note, Alteration)
x,(Note, Alteration)
x)) [(Note, Alteration)]
na
o_f :: OctPc -> Pitch
o_f (PitchClass
oct,PitchClass
pc) = let (Note
n,Alteration
alt) = forall k v. Eq k => k -> [(k, v)] -> v
T.lookup_err PitchClass
pc [(PitchClass, (Note, Alteration))]
na_tbl in Note -> Alteration -> PitchClass -> Pitch
T.Pitch Note
n Alteration
alt PitchClass
oct
in forall a b. (a -> b) -> [a] -> [b]
map OctPc -> Pitch
o_f [OctPc]
o
in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Note, Alteration)] -> [Pitch]
na_f ([PitchClass] -> Maybe [(Note, Alteration)]
spell_cluster [PitchClass]
p)
spell_cluster_c4 :: [T.PitchClass] -> Maybe [T.Pitch]
spell_cluster_c4 :: [PitchClass] -> Maybe [Pitch]
spell_cluster_c4 [PitchClass]
p =
let o_0 :: PitchClass
o_0 = if [PitchClass] -> Bool
cluster_is_multiple_octave [PitchClass]
p then PitchClass
3 else PitchClass
4
oct :: [PitchClass]
oct = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (PitchClass -> [PitchClass] -> [OctPc]
cluster_normal_order_octpc PitchClass
o_0 [PitchClass]
p)
in case [PitchClass] -> Maybe [(Note, Alteration)]
spell_cluster [PitchClass]
p of
Maybe [(Note, Alteration)]
Nothing -> forall a. Maybe a
Nothing
Just [(Note, Alteration)]
na -> forall a. a -> Maybe a
Just (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(Note
n,Alteration
alt) PitchClass
o -> Note -> Alteration -> PitchClass -> Pitch
T.Pitch Note
n Alteration
alt PitchClass
o) [(Note, Alteration)]
na [PitchClass]
oct)
spell_cluster_c :: T.Octave -> [T.PitchClass] -> Maybe [T.Pitch]
spell_cluster_c :: PitchClass -> [PitchClass] -> Maybe [Pitch]
spell_cluster_c PitchClass
o =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map ((PitchClass -> PitchClass) -> Pitch -> Pitch
T.pitch_edit_octave (forall a. Num a => a -> a -> a
+ (PitchClass
o forall a. Num a => a -> a -> a
- PitchClass
4)))) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[PitchClass] -> Maybe [Pitch]
spell_cluster_c4
spell_cluster_f :: (T.PitchClass -> T.Octave) -> [T.PitchClass] -> Maybe [T.Pitch]
spell_cluster_f :: (PitchClass -> PitchClass) -> [PitchClass] -> Maybe [Pitch]
spell_cluster_f PitchClass -> PitchClass
o_f [PitchClass]
p =
let fn :: [Pitch] -> [Pitch]
fn [Pitch]
r = case [Pitch]
r of
[] -> []
Pitch
l:[Pitch]
_ -> let (PitchClass
o,PitchClass
n) = forall i. Integral i => Pitch -> Octave_PitchClass i
T.pitch_to_octpc Pitch
l
oct_f :: PitchClass -> PitchClass
oct_f = (forall a. Num a => a -> a -> a
+ (PitchClass -> PitchClass
o_f PitchClass
n forall a. Num a => a -> a -> a
- PitchClass
o))
in forall a b. (a -> b) -> [a] -> [b]
map ((PitchClass -> PitchClass) -> Pitch -> Pitch
T.pitch_edit_octave PitchClass -> PitchClass
oct_f) [Pitch]
r
in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Pitch] -> [Pitch]
fn ([PitchClass] -> Maybe [Pitch]
spell_cluster_c4 [PitchClass]
p)
spell_cluster_left :: T.Octave -> [T.PitchClass] -> Maybe [T.Pitch]
spell_cluster_left :: PitchClass -> [PitchClass] -> Maybe [Pitch]
spell_cluster_left PitchClass
o [PitchClass]
p =
let fn :: [Pitch] -> [Pitch]
fn [Pitch]
r = case [Pitch]
r of
[] -> []
Pitch
l:[Pitch]
_ -> let oct_f :: PitchClass -> PitchClass
oct_f = (forall a. Num a => a -> a -> a
+ (PitchClass
o forall a. Num a => a -> a -> a
- Pitch -> PitchClass
T.octave Pitch
l))
in forall a b. (a -> b) -> [a] -> [b]
map ((PitchClass -> PitchClass) -> Pitch -> Pitch
T.pitch_edit_octave PitchClass -> PitchClass
oct_f) [Pitch]
r
in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Pitch] -> [Pitch]
fn ([PitchClass] -> Maybe [Pitch]
spell_cluster_c4 [PitchClass]
p)