-- | John Clough. "Aspects of Diatonic Sets".
-- _Journal of Music Theory_, 23(1):45--61, 1979.
module Music.Theory.Z.Clough_1979 where

import Data.List {- base -}

import qualified Music.Theory.List as T {- hmt -}

-- | Shift sequence so the initial value is zero.
--
-- > transpose_to_zero [1,2,5] == [0,1,4]
transpose_to_zero :: Num n => [n] -> [n]
transpose_to_zero :: forall n. Num n => [n] -> [n]
transpose_to_zero [n]
p =
    case [n]
p of
      [] -> []
      n
n:[n]
_ -> forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
subtract n
n) [n]
p

-- | Diatonic pitch class (Z7) set to /chord/.
--
-- > map dpcset_to_chord [[0,1],[0,2,4],[2,3,4,5,6]] == [[1,6],[2,2,3],[1,1,1,1,3]]
dpcset_to_chord :: Integral n => [n] -> [n]
dpcset_to_chord :: forall n. Integral n => [n] -> [n]
dpcset_to_chord = forall n. Num n => [n] -> [n]
T.d_dx forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ [n
7]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Num n => [n] -> [n]
transpose_to_zero forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort

-- | Inverse of 'dpcset_to_chord'.
--
-- > map chord_to_dpcset [[1,6],[2,2,3]] == [[0,1],[0,2,4]]
chord_to_dpcset :: Integral n => [n] -> [n]
chord_to_dpcset :: forall n. Integral n => [n] -> [n]
chord_to_dpcset = forall a. Int -> [a] -> [a]
T.dropRight Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> [a] -> [a]
T.dx_d n
0

-- | Complement, ie. in relation to 'z7_univ'.
--
-- > map dpcset_complement [[0,1],[0,2,4]] == [[2,3,4,5,6],[1,3,5,6]]
dpcset_complement :: Integral n => [n] -> [n]
dpcset_complement :: forall n. Integral n => [n] -> [n]
dpcset_complement [n]
p = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [n]
p) forall n. Integral n => [n]
z7_univ

-- | Interval class predicate (ie. 'is_z4').
--
-- > map is_ic [-1 .. 4] == [False,True,True,True,True,False]
is_ic :: Integral n => n -> Bool
is_ic :: forall n. Integral n => n -> Bool
is_ic = forall n. Integral n => n -> Bool
is_z4

-- | Interval to interval class.
--
-- > map i_to_ic [0..7] == [0,1,2,3,3,2,1,0]
i_to_ic :: Integral n => n -> n
i_to_ic :: forall n. Integral n => n -> n
i_to_ic n
n = if n
n forall a. Ord a => a -> a -> Bool
> n
3 then n
7 forall a. Num a => a -> a -> a
- n
n else n
n

-- | Is /chord/, ie. is 'sum' @7@.
--
-- > is_chord [2,2,3]
is_chord :: Integral n => [n] -> Bool
is_chord :: forall n. Integral n => [n] -> Bool
is_chord = (forall a. Eq a => a -> a -> Bool
== n
7) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum

-- | Interval vector, given list of intervals.
--
-- > iv [2,2,3] == [0,2,1]
iv :: Integral n => [n] -> [n]
iv :: forall n. Integral n => [n] -> [n]
iv [n]
p =
    let h :: [(n, n)]
h = forall a i. (Ord a, Integral i) => [a] -> [(a, i)]
T.generic_histogram [n]
p
        f :: n -> n
f n
n = forall k v. Eq k => k -> v -> [(k, v)] -> v
T.lookup_def n
n n
0 [(n, n)]
h
    in forall a b. (a -> b) -> [a] -> [b]
map n -> n
f [n
1,n
2,n
3]

-- | Comparison function for 'inv'.
inf_cmp :: Ord a => [a] -> [a] -> Ordering
inf_cmp :: forall a. Ord a => [a] -> [a] -> Ordering
inf_cmp [a]
p [a]
q =
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
p Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
q
    then Ordering
EQ
    else case forall a. Ord a => a -> a -> Ordering
compare (forall a. [a] -> a
last [a]
p) (forall a. [a] -> a
last [a]
q) of
           Ordering
EQ -> forall a. Ord a => [a] -> [a] -> Ordering
inf_cmp (forall a. Int -> [a] -> [a]
T.dropRight Int
1 [a]
p) (forall a. Int -> [a] -> [a]
T.dropRight Int
1 [a]
q)
           Ordering
r -> Ordering
r

-- | Interval normal form.
--
-- > map inf [[2,2,3],[1,2,4],[2,1,4]] == [[2,2,3],[1,2,4],[2,1,4]]
inf :: Integral n => [n] -> [n]
inf :: forall n. Integral n => [n] -> [n]
inf = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy forall a. Ord a => [a] -> [a] -> Ordering
inf_cmp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
T.rotations

-- | Inverse of chord (retrograde).
--
-- > let p = [1,2,4] in (inf p,invert p,inf (invert p)) == ([1,2,4],[4,2,1],[2,1,4])
invert :: [n] -> [n]
invert :: forall n. [n] -> [n]
invert = forall n. [n] -> [n]
reverse

-- | Complement of /chord/.
--
-- > let r = [[1,1,1,1,3],[1,1,1,2,2],[1,1,2,1,2],[1,1,1,4],[2,1,1,3],[1,2,1,3],[1,2,2,2]]
-- > in map complement [[1,6],[2,5],[3,4],[1,1,5],[1,2,4],[1,3,3],[2,2,3]] == r
complement :: Integral n => [n] -> [n]
complement :: forall n. Integral n => [n] -> [n]
complement = forall n. Integral n => [n] -> [n]
inf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Integral n => [n] -> [n]
dpcset_to_chord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Integral n => [n] -> [n]
dpcset_complement forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Integral n => [n] -> [n]
chord_to_dpcset

-- | Z7 pitch sequence to Z7 interval sequence, ie. 'mod7' of 'T.d_dx'.
--
-- > map iseq (permutations [0,1,2]) == [[1,1],[6,2],[6,6],[1,5],[5,1],[2,6]]
-- > map iseq (permutations [0,1,3]) == [[1,2],[6,3],[5,6],[2,4],[4,1],[3,5]]
-- > map iseq (permutations [0,2,3]) == [[2,1],[5,3],[6,5],[1,4],[4,2],[3,6]]
-- > map iseq (permutations [0,1,4]) == [[1,3],[6,4],[4,6],[3,3],[3,1],[4,4]]
-- > map iseq (permutations [0,2,4]) == [[2,2],[5,4],[5,5],[2,3],[3,2],[4,5]]
iseq :: Integral n => [n] -> [n]
iseq :: forall n. Integral n => [n] -> [n]
iseq = forall a b. (a -> b) -> [a] -> [b]
map forall n. Integral n => n -> n
mod7 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Num n => [n] -> [n]
T.d_dx

-- * Z

-- | Is /n/ in (0,/m/ - 1).
is_z_n :: Integral n => n -> n -> Bool
is_z_n :: forall n. Integral n => n -> n -> Bool
is_z_n n
m n
n = n
n forall a. Ord a => a -> a -> Bool
>= n
0 Bool -> Bool -> Bool
&& n
n forall a. Ord a => a -> a -> Bool
< n
m

-- | Z /m/ universe, ie [0 .. m-1].
z_n_univ :: Integral n => n -> [n]
z_n_univ :: forall n. Integral n => n -> [n]
z_n_univ n
m = [n
0 .. n
m forall a. Num a => a -> a -> a
- n
1]

-- | 'is_z_n' of 4.
is_z4 :: Integral n => n -> Bool
is_z4 :: forall n. Integral n => n -> Bool
is_z4 = forall n. Integral n => n -> n -> Bool
is_z_n n
4

-- | 'z_n_univ' of 7.
--
-- > z7_univ == [0 .. 6]
z7_univ :: Integral n => [n]
z7_univ :: forall n. Integral n => [n]
z7_univ = forall n. Integral n => n -> [n]
z_n_univ n
7

-- | 'is_z_n' of 7.
is_z7 :: Integral n => n -> Bool
is_z7 :: forall n. Integral n => n -> Bool
is_z7 = forall n. Integral n => n -> n -> Bool
is_z_n n
7

-- | 'mod' 7.
mod7 :: Integral n => n -> n
mod7 :: forall n. Integral n => n -> n
mod7 n
n = n
n forall a. Integral a => a -> a -> a
`mod` n
7