-- | Marcus Castrén.
--   /RECREL: A Similarity Measure for Set-Classes/.
--   PhD thesis, Sibelius Academy, Helsinki, 1994.
module Music.Theory.Z.Castren_1994 where

import Data.Int {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}
import Data.Ratio {- base -}

import qualified Music.Theory.List as List
import Music.Theory.Z
import qualified Music.Theory.Z.Forte_1973 as Forte
import qualified Music.Theory.Z.Sro as Sro

type Z12 = Int8

-- | Is /p/ symmetrical under inversion.
--
-- > map inv_sym (Forte.scs_n 2) == [True,True,True,True,True,True]
-- > map (fromEnum.inv_sym) (Forte.scs_n 3) == [1,0,0,0,0,1,0,0,1,1,0,1]
inv_sym :: [Z12] -> Bool
inv_sym :: [Z12] -> Bool
inv_sym [Z12]
x = [Z12]
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map (\Z12
i -> forall a. Ord a => [a] -> [a]
sort (forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
Sro.z_sro_tn forall i. Num i => Z i
z12 Z12
i (forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
Sro.z_sro_invert forall i. Num i => Z i
z12 Z12
0 [Z12]
x))) [Z12
0..Z12
11]

-- | If /p/ is not 'inv_sym' then @(p,invert 0 p)@ else 'Nothing'.
--
-- > sc_t_ti [0,2,4] == Nothing
-- > sc_t_ti [0,1,3] == Just ([0,1,3],[0,2,3])
sc_t_ti :: [Z12] -> Maybe ([Z12], [Z12])
sc_t_ti :: [Z12] -> Maybe ([Z12], [Z12])
sc_t_ti [Z12]
p =
    if [Z12] -> Bool
inv_sym [Z12]
p
    then forall a. Maybe a
Nothing
    else forall a. a -> Maybe a
Just ([Z12]
p,forall i. Integral i => Z i -> [i] -> [i]
Forte.z_t_prime forall i. Num i => Z i
z12 (forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
Sro.z_sro_invert forall i. Num i => Z i
z12 Z12
0 [Z12]
p))

-- | Transpositional equivalence variant of Forte's 'sc_table'.  The
-- inversionally related classes are distinguished by labels @A@ and
-- @B@; the class providing the /best normal order/ (Forte 1973) is
-- always the @A@ class. If neither @A@ nor @B@ appears in the name of
-- a set-class, it is inversionally symmetrical.
--
-- > (length Forte.sc_table,length t_sc_table) == (224,352)
-- > lookup "5-Z18B" t_sc_table == Just [0,2,3,6,7]
t_sc_table :: [(Forte.SC_Name,[Z12])]
t_sc_table :: [(SC_Name, [Z12])]
t_sc_table =
    let f :: [Z12] -> [(SC_Name, [Z12])]
f [Z12]
x = let nm :: SC_Name
nm = forall i. Integral i => [i] -> SC_Name
Forte.sc_name [Z12]
x
              in case [Z12] -> Maybe ([Z12], [Z12])
sc_t_ti [Z12]
x of
                   Maybe ([Z12], [Z12])
Nothing -> [(SC_Name
nm,[Z12]
x)]
                   Just ([Z12]
p,[Z12]
q) -> [(SC_Name
nmforall a. [a] -> [a] -> [a]
++SC_Name
"A",[Z12]
p),(SC_Name
nmforall a. [a] -> [a] -> [a]
++SC_Name
"B",[Z12]
q)]
    in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Z12] -> [(SC_Name, [Z12])]
f forall n. Num n => [[n]]
Forte.scs

-- | Lookup a set-class name.  The input set is subject to
-- 't_prime' before lookup.
--
-- > t_sc_name [0,2,3,6,7] == "5-Z18B"
-- > t_sc_name [0,1,4,6,7,8] == "6-Z17B"
t_sc_name :: [Z12] -> Forte.SC_Name
t_sc_name :: [Z12] -> SC_Name
t_sc_name [Z12]
p =
    let n :: Maybe (SC_Name, [Z12])
n = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(SC_Name
_,[Z12]
q) -> forall i. Integral i => Z i -> [i] -> [i]
Forte.z_t_prime forall i. Num i => Z i
z12 [Z12]
p forall a. Eq a => a -> a -> Bool
== [Z12]
q) [(SC_Name, [Z12])]
t_sc_table
    in forall a b. (a, b) -> a
fst (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (SC_Name, [Z12])
n)

-- | Lookup a set-class given a set-class name.
--
-- > t_sc "6-Z17A" == [0,1,2,4,7,8]
t_sc :: Forte.SC_Name -> [Z12]
t_sc :: SC_Name -> [Z12]
t_sc SC_Name
n = forall a b. (a, b) -> b
snd (forall a. HasCallStack => Maybe a -> a
fromJust (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(SC_Name
m,[Z12]
_) -> SC_Name
n forall a. Eq a => a -> a -> Bool
== SC_Name
m) [(SC_Name, [Z12])]
t_sc_table))

-- | List of set classes.
t_scs :: [[Z12]]
t_scs :: [[Z12]]
t_scs = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(SC_Name, [Z12])]
t_sc_table

-- | Cardinality /n/ subset of 't_scs'.
--
-- > map (length . t_scs_n) [2..10] == [6,19,43,66,80,66,43,19,6]
t_scs_n :: Integral i => i -> [[Z12]]
t_scs_n :: forall i. Integral i => i -> [[Z12]]
t_scs_n i
n = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== i
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a. Num i => [a] -> i
genericLength) [[Z12]]
t_scs

-- | T-related /q/ that are subsets of /p/.
--
-- > t_subsets [0,1,2,3,4] [0,1]  == [[0,1],[1,2],[2,3],[3,4]]
-- > t_subsets [0,1,2,3,4] [0,1,4] == [[0,1,4]]
-- > t_subsets [0,2,3,6,7] [0,1,4] == [[2,3,6]]
t_subsets :: [Z12] -> [Z12] -> [[Z12]]
t_subsets :: [Z12] -> [Z12] -> [[Z12]]
t_subsets [Z12]
x [Z12]
a = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => [a] -> [a] -> Bool
`List.is_subset` [Z12]
x) (forall a b. (a -> b) -> [a] -> [b]
map forall a. Ord a => [a] -> [a]
sort (forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> f i -> [f i]
Sro.z_sro_t_related forall i. Num i => Z i
z12 [Z12]
a))

-- | T\/I-related /q/ that are subsets of /p/.
--
-- > ti_subsets [0,1,2,3,4] [0,1]  == [[0,1],[1,2],[2,3],[3,4]]
-- > ti_subsets [0,1,2,3,4] [0,1,4] == [[0,1,4],[0,3,4]]
-- > ti_subsets [0,2,3,6,7] [0,1,4] == [[2,3,6],[3,6,7]]
ti_subsets :: [Z12] -> [Z12] -> [[Z12]]
ti_subsets :: [Z12] -> [Z12] -> [[Z12]]
ti_subsets [Z12]
x [Z12]
a = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => [a] -> [a] -> Bool
`List.is_subset` [Z12]
x) (forall a. Eq a => [a] -> [a]
nub (forall a b. (a -> b) -> [a] -> [b]
map forall a. Ord a => [a] -> [a]
sort (forall (f :: * -> *) i.
(Eq (f i), Integral i, Functor f) =>
Z i -> f i -> [f i]
Sro.z_sro_ti_related forall i. Num i => Z i
z12 [Z12]
a)))

-- | Trivial run length encoder.
--
-- > rle "abbcccdde" == [(1,'a'),(2,'b'),(3,'c'),(2,'d'),(1,'e')]
rle :: (Eq a,Integral i) => [a] -> [(i,a)]
rle :: forall a i. (Eq a, Integral i) => [a] -> [(i, a)]
rle =
    let f :: [b] -> (a, b)
f [b]
x = (forall i a. Num i => [a] -> i
genericLength [b]
x,forall a. [a] -> a
head [b]
x)
    in forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. Num a => [b] -> (a, b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [[a]]
group

-- | Inverse of 'rle'.
--
-- > rle_decode [(5,'a'),(4,'b')] == "aaaaabbbb"
rle_decode :: (Integral i) => [(i,a)] -> [a]
rle_decode :: forall i a. Integral i => [(i, a)] -> [a]
rle_decode =
    let f :: (i, a) -> [a]
f (i
i,a
j) = forall i a. Integral i => i -> a -> [a]
genericReplicate i
i a
j
    in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {i} {a}. Integral i => (i, a) -> [a]
f

-- | Length of /rle/ encoded sequence.
--
-- > rle_length [(5,'a'),(4,'b')] == 9
rle_length :: (Integral i) => [(i,a)] -> i
rle_length :: forall i a. Integral i => [(i, a)] -> i
rle_length = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst

-- | T-equivalence /n/-class vector (subset-class vector, nCV).
--
-- > t_n_class_vector 2 [0..4] == [4,3,2,1,0,0]
-- > rle (t_n_class_vector 3 [0..4]) == [(1,3),(2,2),(2,1),(4,0),(1,1),(9,0)]
-- > rle (t_n_class_vector 4 [0..4]) == [(1,2),(3,1),(39,0)]
t_n_class_vector :: (Num a, Integral i) => i -> [Z12] -> [a]
t_n_class_vector :: forall a i. (Num a, Integral i) => i -> [Z12] -> [a]
t_n_class_vector i
n [Z12]
x =
    let a :: [[Z12]]
a = forall i. Integral i => i -> [[Z12]]
t_scs_n i
n
    in forall a b. (a -> b) -> [a] -> [b]
map (forall i a. Num i => [a] -> i
genericLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Z12] -> [Z12] -> [[Z12]]
t_subsets [Z12]
x) [[Z12]]
a

-- | T\/I-equivalence /n/-class vector (subset-class vector, nCV).
--
-- > ti_n_class_vector 2 [0..4] == [4,3,2,1,0,0]
-- > ti_n_class_vector 3 [0,1,2,3,4] == [3,4,2,0,0,1,0,0,0,0,0,0]
-- > rle (ti_n_class_vector 4 [0,1,2,3,4]) == [(2,2),(1,1),(26,0)]
ti_n_class_vector :: (Num b, Integral i) => i -> [Z12] -> [b]
ti_n_class_vector :: forall a i. (Num a, Integral i) => i -> [Z12] -> [a]
ti_n_class_vector i
n [Z12]
x =
    let a :: [[Z12]]
a = forall i n. (Integral i, Num n) => i -> [[n]]
Forte.scs_n i
n
    in forall a b. (a -> b) -> [a] -> [b]
map (forall i a. Num i => [a] -> i
genericLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Z12] -> [Z12] -> [[Z12]]
ti_subsets [Z12]
x) [[Z12]]
a

-- | 'icv' scaled by sum of /icv/.
--
-- > dyad_class_percentage_vector [0,1,2,3,4] == [40,30,20,10,0,0]
-- > dyad_class_percentage_vector [0,1,4,5,7] == [20,10,20,20,20,10]
dyad_class_percentage_vector :: Integral i => [Z12] -> [i]
dyad_class_percentage_vector :: forall i. Integral i => [Z12] -> [i]
dyad_class_percentage_vector [Z12]
p =
    let p' :: [i]
p' = forall i n. (Integral i, Num n) => Z i -> [i] -> [n]
Forte.z_icv forall i. Num i => Z i
z12 [Z12]
p
    in forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [i]
p' forall a. Num a => a -> a -> a
*) [i]
p'

-- | /rel/ metric.
--
-- > rel [0,1,2,3,4] [0,1,4,5,7] == 40
-- > rel [0,1,2,3,4] [0,2,4,6,8] == 60
-- > rel [0,1,4,5,7] [0,2,4,6,8] == 60
rel :: Integral i => [Z12] -> [Z12] -> Ratio i
rel :: forall i. Integral i => [Z12] -> [Z12] -> Ratio i
rel [Z12]
x [Z12]
y =
    let x' :: [i]
x' = forall i. Integral i => [Z12] -> [i]
dyad_class_percentage_vector [Z12]
x
        y' :: [i]
y' = forall i. Integral i => [Z12] -> [i]
dyad_class_percentage_vector [Z12]
y
    in forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map forall a. Num a => a -> a
abs (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [i]
x' [i]
y')) forall a. Integral a => a -> a -> Ratio a
% i
2