-- | Allen Forte. /The Structure of Atonal Music/. Yale University
-- Press, New Haven, 1973.
module Music.Theory.Z12.Forte_1973 where

import Data.List
import Data.Maybe
import Music.Theory.List
import qualified Music.Theory.Set.List as S
import Music.Theory.Z12
import Music.Theory.Z12.SRO

-- * Prime form

-- | T-related rotations of /p/.
--
-- > t_rotations [0,1,3] == [[0,1,3],[0,2,11],[0,9,10]]
t_rotations :: [Z12] -> [[Z12]]
t_rotations p =
    let r = rotations (sort p)
    in map (tn_to 0) r

-- | T\/I-related rotations of /p/.
--
-- > ti_rotations [0,1,3] == [[0,1,3],[0,2,11],[0,9,10]
-- >                         ,[0,9,11],[0,2,3],[0,1,10]]
ti_rotations :: [Z12] -> [[Z12]]
ti_rotations p =
    let q = invert 0 p
        r = rotations (sort p) ++ rotations (sort q)
    in map (tn_to 0) r

-- | Variant with default value for empty input list case.
minimumBy_or :: a -> (a -> a -> Ordering) -> [a] -> a
minimumBy_or p f q = if null q then p else minimumBy f q

-- | Prime form rule requiring comparator, considering 't_rotations'.
t_cmp_prime :: ([Z12] -> [Z12] -> Ordering) -> [Z12] -> [Z12]
t_cmp_prime f = minimumBy_or [] f . t_rotations

-- | Prime form rule requiring comparator, considering 'ti_rotations'.
ti_cmp_prime :: ([Z12] -> [Z12] -> Ordering) -> [Z12] -> [Z12]
ti_cmp_prime f = minimumBy_or [] f . ti_rotations

-- | Forte comparison function (rightmost first then leftmost outwards).
--
-- > forte_cmp [0,1,3,6,8,9] [0,2,3,6,7,9] == LT
forte_cmp :: (Ord t) => [t] -> [t] -> Ordering
forte_cmp [] [] = EQ
forte_cmp p  q  =
    let r = compare (last p) (last q)
    in if r == EQ then compare p q else r

-- | Forte prime form, ie. 'cmp_prime' of 'forte_cmp'.
--
-- > forte_prime [0,1,3,6,8,9] == [0,1,3,6,8,9]
forte_prime :: [Z12] -> [Z12]
forte_prime = ti_cmp_prime forte_cmp

-- * Set Class Table

-- | Synonym for 'String'.
type SC_Name = String

-- | The set-class table (Forte prime forms).
sc_table :: [(SC_Name,[Z12])]
sc_table =
    [("0-1",[])
    ,("1-1",[0])
    ,("2-1",[0,1])
    ,("2-2",[0,2])
    ,("2-3",[0,3])
    ,("2-4",[0,4])
    ,("2-5",[0,5])
    ,("2-6",[0,6])
    ,("3-1",[0,1,2])
    ,("3-2",[0,1,3])
    ,("3-3",[0,1,4])
    ,("3-4",[0,1,5])
    ,("3-5",[0,1,6])
    ,("3-6",[0,2,4])
    ,("3-7",[0,2,5])
    ,("3-8",[0,2,6])
    ,("3-9",[0,2,7])
    ,("3-10",[0,3,6])
    ,("3-11",[0,3,7])
    ,("3-12",[0,4,8])
    ,("4-1",[0,1,2,3])
    ,("4-2",[0,1,2,4])
    ,("4-3",[0,1,3,4])
    ,("4-4",[0,1,2,5])
    ,("4-5",[0,1,2,6])
    ,("4-6",[0,1,2,7])
    ,("4-7",[0,1,4,5])
    ,("4-8",[0,1,5,6])
    ,("4-9",[0,1,6,7])
    ,("4-10",[0,2,3,5])
    ,("4-11",[0,1,3,5])
    ,("4-12",[0,2,3,6])
    ,("4-13",[0,1,3,6])
    ,("4-14",[0,2,3,7])
    ,("4-Z15",[0,1,4,6])
    ,("4-16",[0,1,5,7])
    ,("4-17",[0,3,4,7])
    ,("4-18",[0,1,4,7])
    ,("4-19",[0,1,4,8])
    ,("4-20",[0,1,5,8])
    ,("4-21",[0,2,4,6])
    ,("4-22",[0,2,4,7])
    ,("4-23",[0,2,5,7])
    ,("4-24",[0,2,4,8])
    ,("4-25",[0,2,6,8])
    ,("4-26",[0,3,5,8])
    ,("4-27",[0,2,5,8])
    ,("4-28",[0,3,6,9])
    ,("4-Z29",[0,1,3,7])
    ,("5-1",[0,1,2,3,4])
    ,("5-2",[0,1,2,3,5])
    ,("5-3",[0,1,2,4,5])
    ,("5-4",[0,1,2,3,6])
    ,("5-5",[0,1,2,3,7])
    ,("5-6",[0,1,2,5,6])
    ,("5-7",[0,1,2,6,7])
    ,("5-8",[0,2,3,4,6])
    ,("5-9",[0,1,2,4,6])
    ,("5-10",[0,1,3,4,6])
    ,("5-11",[0,2,3,4,7])
    ,("5-Z12",[0,1,3,5,6])
    ,("5-13",[0,1,2,4,8])
    ,("5-14",[0,1,2,5,7])
    ,("5-15",[0,1,2,6,8])
    ,("5-16",[0,1,3,4,7])
    ,("5-Z17",[0,1,3,4,8])
    ,("5-Z18",[0,1,4,5,7])
    ,("5-19",[0,1,3,6,7])
    ,("5-20",[0,1,3,7,8])
    ,("5-21",[0,1,4,5,8])
    ,("5-22",[0,1,4,7,8])
    ,("5-23",[0,2,3,5,7])
    ,("5-24",[0,1,3,5,7])
    ,("5-25",[0,2,3,5,8])
    ,("5-26",[0,2,4,5,8])
    ,("5-27",[0,1,3,5,8])
    ,("5-28",[0,2,3,6,8])
    ,("5-29",[0,1,3,6,8])
    ,("5-30",[0,1,4,6,8])
    ,("5-31",[0,1,3,6,9])
    ,("5-32",[0,1,4,6,9])
    ,("5-33",[0,2,4,6,8])
    ,("5-34",[0,2,4,6,9])
    ,("5-35",[0,2,4,7,9])
    ,("5-Z36",[0,1,2,4,7])
    ,("5-Z37",[0,3,4,5,8])
    ,("5-Z38",[0,1,2,5,8])
    ,("6-1",[0,1,2,3,4,5])
    ,("6-2",[0,1,2,3,4,6])
    ,("6-Z3",[0,1,2,3,5,6])
    ,("6-Z4",[0,1,2,4,5,6])
    ,("6-5",[0,1,2,3,6,7])
    ,("6-Z6",[0,1,2,5,6,7])
    ,("6-7",[0,1,2,6,7,8])
    ,("6-8",[0,2,3,4,5,7])
    ,("6-9",[0,1,2,3,5,7])
    ,("6-Z10",[0,1,3,4,5,7])
    ,("6-Z11",[0,1,2,4,5,7])
    ,("6-Z12",[0,1,2,4,6,7])
    ,("6-Z13",[0,1,3,4,6,7])
    ,("6-14",[0,1,3,4,5,8])
    ,("6-15",[0,1,2,4,5,8])
    ,("6-16",[0,1,4,5,6,8])
    ,("6-Z17",[0,1,2,4,7,8])
    ,("6-18",[0,1,2,5,7,8])
    ,("6-Z19",[0,1,3,4,7,8])
    ,("6-20",[0,1,4,5,8,9])
    ,("6-21",[0,2,3,4,6,8])
    ,("6-22",[0,1,2,4,6,8])
    ,("6-Z23",[0,2,3,5,6,8])
    ,("6-Z24",[0,1,3,4,6,8])
    ,("6-Z25",[0,1,3,5,6,8])
    ,("6-Z26",[0,1,3,5,7,8])
    ,("6-27",[0,1,3,4,6,9])
    ,("6-Z28",[0,1,3,5,6,9])
    ,("6-Z29",[0,1,3,6,8,9])
    ,("6-30",[0,1,3,6,7,9])
    ,("6-31",[0,1,3,5,8,9])
    ,("6-32",[0,2,4,5,7,9])
    ,("6-33",[0,2,3,5,7,9])
    ,("6-34",[0,1,3,5,7,9])
    ,("6-35",[0,2,4,6,8,10])
    ,("6-Z36",[0,1,2,3,4,7])
    ,("6-Z37",[0,1,2,3,4,8])
    ,("6-Z38",[0,1,2,3,7,8])
    ,("6-Z39",[0,2,3,4,5,8])
    ,("6-Z40",[0,1,2,3,5,8])
    ,("6-Z41",[0,1,2,3,6,8])
    ,("6-Z42",[0,1,2,3,6,9])
    ,("6-Z43",[0,1,2,5,6,8])
    ,("6-Z44",[0,1,2,5,6,9])
    ,("6-Z45",[0,2,3,4,6,9])
    ,("6-Z46",[0,1,2,4,6,9])
    ,("6-Z47",[0,1,2,4,7,9])
    ,("6-Z48",[0,1,2,5,7,9])
    ,("6-Z49",[0,1,3,4,7,9])
    ,("6-Z50",[0,1,4,6,7,9])
    ,("7-1",[0,1,2,3,4,5,6])
    ,("7-2",[0,1,2,3,4,5,7])
    ,("7-3",[0,1,2,3,4,5,8])
    ,("7-4",[0,1,2,3,4,6,7])
    ,("7-5",[0,1,2,3,5,6,7])
    ,("7-6",[0,1,2,3,4,7,8])
    ,("7-7",[0,1,2,3,6,7,8])
    ,("7-8",[0,2,3,4,5,6,8])
    ,("7-9",[0,1,2,3,4,6,8])
    ,("7-10",[0,1,2,3,4,6,9])
    ,("7-11",[0,1,3,4,5,6,8])
    ,("7-Z12",[0,1,2,3,4,7,9])
    ,("7-13",[0,1,2,4,5,6,8])
    ,("7-14",[0,1,2,3,5,7,8])
    ,("7-15",[0,1,2,4,6,7,8])
    ,("7-16",[0,1,2,3,5,6,9])
    ,("7-Z17",[0,1,2,4,5,6,9])
    ,("7-Z18",[0,1,2,3,5,8,9])
    ,("7-19",[0,1,2,3,6,7,9])
    ,("7-20",[0,1,2,4,7,8,9])
    ,("7-21",[0,1,2,4,5,8,9])
    ,("7-22",[0,1,2,5,6,8,9])
    ,("7-23",[0,2,3,4,5,7,9])
    ,("7-24",[0,1,2,3,5,7,9])
    ,("7-25",[0,2,3,4,6,7,9])
    ,("7-26",[0,1,3,4,5,7,9])
    ,("7-27",[0,1,2,4,5,7,9])
    ,("7-28",[0,1,3,5,6,7,9])
    ,("7-29",[0,1,2,4,6,7,9])
    ,("7-30",[0,1,2,4,6,8,9])
    ,("7-31",[0,1,3,4,6,7,9])
    ,("7-32",[0,1,3,4,6,8,9])
    ,("7-33",[0,1,2,4,6,8,10])
    ,("7-34",[0,1,3,4,6,8,10])
    ,("7-35",[0,1,3,5,6,8,10])
    ,("7-Z36",[0,1,2,3,5,6,8])
    ,("7-Z37",[0,1,3,4,5,7,8])
    ,("7-Z38",[0,1,2,4,5,7,8])
    ,("8-1",[0,1,2,3,4,5,6,7])
    ,("8-2",[0,1,2,3,4,5,6,8])
    ,("8-3",[0,1,2,3,4,5,6,9])
    ,("8-4",[0,1,2,3,4,5,7,8])
    ,("8-5",[0,1,2,3,4,6,7,8])
    ,("8-6",[0,1,2,3,5,6,7,8])
    ,("8-7",[0,1,2,3,4,5,8,9])
    ,("8-8",[0,1,2,3,4,7,8,9])
    ,("8-9",[0,1,2,3,6,7,8,9])
    ,("8-10",[0,2,3,4,5,6,7,9])
    ,("8-11",[0,1,2,3,4,5,7,9])
    ,("8-12",[0,1,3,4,5,6,7,9])
    ,("8-13",[0,1,2,3,4,6,7,9])
    ,("8-14",[0,1,2,4,5,6,7,9])
    ,("8-Z15",[0,1,2,3,4,6,8,9])
    ,("8-16",[0,1,2,3,5,7,8,9])
    ,("8-17",[0,1,3,4,5,6,8,9])
    ,("8-18",[0,1,2,3,5,6,8,9])
    ,("8-19",[0,1,2,4,5,6,8,9])
    ,("8-20",[0,1,2,4,5,7,8,9])
    ,("8-21",[0,1,2,3,4,6,8,10])
    ,("8-22",[0,1,2,3,5,6,8,10])
    ,("8-23",[0,1,2,3,5,7,8,10])
    ,("8-24",[0,1,2,4,5,6,8,10])
    ,("8-25",[0,1,2,4,6,7,8,10])
    ,("8-26",[0,1,2,4,5,7,9,10])
    ,("8-27",[0,1,2,4,5,7,8,10])
    ,("8-28",[0,1,3,4,6,7,9,10])
    ,("8-Z29",[0,1,2,3,5,6,7,9])
    ,("9-1",[0,1,2,3,4,5,6,7,8])
    ,("9-2",[0,1,2,3,4,5,6,7,9])
    ,("9-3",[0,1,2,3,4,5,6,8,9])
    ,("9-4",[0,1,2,3,4,5,7,8,9])
    ,("9-5",[0,1,2,3,4,6,7,8,9])
    ,("9-6",[0,1,2,3,4,5,6,8,10])
    ,("9-7",[0,1,2,3,4,5,7,8,10])
    ,("9-8",[0,1,2,3,4,6,7,8,10])
    ,("9-9",[0,1,2,3,5,6,7,8,10])
    ,("9-10",[0,1,2,3,4,6,7,9,10])
    ,("9-11",[0,1,2,3,5,6,7,9,10])
    ,("9-12",[0,1,2,4,5,6,8,9,10])
    ,("10-1",[0,1,2,3,4,5,6,7,8,9])
    ,("10-2",[0,1,2,3,4,5,6,7,8,10])
    ,("10-3",[0,1,2,3,4,5,6,7,9,10])
    ,("10-4",[0,1,2,3,4,5,6,8,9,10])
    ,("10-5",[0,1,2,3,4,5,7,8,9,10])
    ,("10-6",[0,1,2,3,4,6,7,8,9,10])
    ,("11-1",[0,1,2,3,4,5,6,7,8,9,10])
    ,("12-1",[0,1,2,3,4,5,6,7,8,9,10,11])]

-- | Lookup a set-class name.  The input set is subject to
-- 'forte_prime' before lookup.
--
-- > sc_name [0,2,3,6,7] == "5-Z18"
-- > sc_name [0,1,4,6,7,8] == "6-Z17"
sc_name :: [Z12] -> SC_Name
sc_name p =
    let n = find (\(_,q) -> forte_prime p == q) sc_table
    in fst (fromMaybe (error "sc_name") n)

-- | Lookup a set-class given a set-class name.
--
-- > sc "6-Z17" == [0,1,2,4,7,8]
sc :: SC_Name -> [Z12]
sc n = snd (fromMaybe (error "sc") (find (\(m,_) -> n == m) sc_table))

-- | List of set classes.
scs :: [[Z12]]
scs = map snd sc_table

-- | Cardinality /n/ subset of 'scs'.
--
-- > map (length . scs_n) [2..10] == [6,12,29,38,50,38,29,12,6]
scs_n :: Integral i => i -> [[Z12]]
scs_n n = filter ((== n) . genericLength) scs

-- * BIP Metric

-- | Basic interval pattern, see Allen Forte \"The Basic Interval Patterns\"
-- /JMT/ 17/2 (1973):234-272
--
-- >>> bip 0t95728e3416
-- 11223344556
--
-- > bip [0,10,9,5,7,2,8,11,3,4,1,6] == [1,1,2,2,3,3,4,4,5,5,6]
-- > bip (pco "0t95728e3416") == [1,1,2,2,3,3,4,4,5,5,6]
bip :: [Z12] -> [Z12]
bip = sort . map ic . d_dx

-- * ICV Metric

-- | Interval class of Z12 interval /i/.
--
-- > map ic [5,6,7] == [5,6,5]
ic :: Z12 -> Z12
ic i = if i <= 6 then i else 12 - i

-- | Forte notation for interval class vector.
--
-- > icv [0,1,2,4,7,8] == [3,2,2,3,3,2]
icv :: Integral i => [Z12] -> [i]
icv s =
    let i = map (ic . uncurry (-)) (S.pairs s)
        j = map f (group (sort i))
        k = map (`lookup` j) [1..6]
        f l = (head l,genericLength l)
    in map (fromMaybe 0) k