-- | Generalised twelve-tone operations on un-ordered pitch-class sets with arbitrary Z.
module Music.Theory.Z.Tto where

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

import qualified Text.Parsec as P {- parsec -}

import qualified Music.Theory.Parse as Parse {- hmt -}

import Music.Theory.Z {- hmt -}

-- * Tto

-- | Twelve-tone operator, of the form TMI.
data Tto t = Tto {forall t. Tto t -> t
tto_T :: t,forall t. Tto t -> t
tto_M :: t,forall t. Tto t -> Bool
tto_I :: Bool}
             deriving (Tto t -> Tto t -> Bool
forall t. Eq t => Tto t -> Tto t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tto t -> Tto t -> Bool
$c/= :: forall t. Eq t => Tto t -> Tto t -> Bool
== :: Tto t -> Tto t -> Bool
$c== :: forall t. Eq t => Tto t -> Tto t -> Bool
Eq,Int -> Tto t -> ShowS
forall t. Show t => Int -> Tto t -> ShowS
forall t. Show t => [Tto t] -> ShowS
forall t. Show t => Tto t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tto t] -> ShowS
$cshowList :: forall t. Show t => [Tto t] -> ShowS
show :: Tto t -> String
$cshow :: forall t. Show t => Tto t -> String
showsPrec :: Int -> Tto t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> Tto t -> ShowS
Show)

-- | T0
tto_identity :: Num t => Tto t
tto_identity :: forall t. Num t => Tto t
tto_identity = forall t. t -> t -> Bool -> Tto t
Tto t
0 t
1 Bool
False

-- | Pretty printer.  It is an error here is M is not 1 or 5.
tto_pp :: (Show t,Num t,Eq t) => Tto t -> String
tto_pp :: forall t. (Show t, Num t, Eq t) => Tto t -> String
tto_pp (Tto t
t t
m Bool
i) =
  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Char
'T' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show t
t
         ,if t
m forall a. Eq a => a -> a -> Bool
== t
1 then String
"" else if t
m forall a. Eq a => a -> a -> Bool
== t
5 then String
"M" else forall a. HasCallStack => String -> a
error String
"tto_pp: M?"
         ,if Bool
i then String
"I" else String
""]

-- | Parser for Tto, requires value for M (ordinarily 5 for 12-tone Tto).
p_tto :: Integral t => t -> Parse.P (Tto t)
p_tto :: forall t. Integral t => t -> P (Tto t)
p_tto t
m_mul = do
  Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'T'
  t
t <- forall i. Integral i => P i
Parse.parse_int
  Bool
m <- Char -> P Bool
Parse.is_char Char
'M'
  Bool
i <- Char -> P Bool
Parse.is_char Char
'I'
  forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall t. t -> t -> Bool -> Tto t
Tto t
t (if Bool
m then t
m_mul else t
1) Bool
i)

-- | Parser, transposition must be decimal.
--
-- > map (tto_pp . tto_parse 5) (words "T5 T3I T11M T9MI") == ["T5","T3I","T11M","T9MI"]
tto_parse :: Integral i => i -> String -> Tto i
tto_parse :: forall i. Integral i => i -> String -> Tto i
tto_parse i
m = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ParseError
e -> forall a. HasCallStack => String -> a
error (String
"tto_parse failed\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ParseError
e)) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
P.parse (forall t. Integral t => t -> P (Tto t)
p_tto i
m) String
""

-- | Set M at Tto.
tto_M_set :: Integral t => t -> Tto t -> Tto t
tto_M_set :: forall t. Integral t => t -> Tto t -> Tto t
tto_M_set t
m (Tto t
t t
_ Bool
i) = forall t. t -> t -> Bool -> Tto t
Tto t
t t
m Bool
i

-- * Z

-- | The set of all 'Tto', given 'Z'.
--
-- > length (z_tto_univ 5 z12) == 48
-- > map tto_pp (z_tto_univ 5 z12)
z_tto_univ :: Integral t => t -> Z t -> [Tto t]
z_tto_univ :: forall t. Integral t => t -> Z t -> [Tto t]
z_tto_univ t
m_mul Z t
z = [forall t. t -> t -> Bool -> Tto t
Tto t
t t
m Bool
i | t
m <- [t
1,t
m_mul], Bool
i <- [Bool
False,Bool
True], t
t <- forall i. Integral i => Z i -> [i]
z_univ Z t
z]

-- | Apply Tto to pitch-class.
--
-- > map (z_tto_f z12 (tto_parse 5 "T1M")) [0,1,2,3] == [1,6,11,4]
z_tto_f :: Integral t => Z t -> Tto t -> (t -> t)
z_tto_f :: forall t. Integral t => Z t -> Tto t -> t -> t
z_tto_f Z t
z (Tto t
t t
m Bool
i) =
    let i_f :: t -> t
i_f = if Bool
i then forall i. Integral i => Z i -> i -> i
z_negate Z t
z else forall a. a -> a
id
        m_f :: t -> t
m_f = if t
m forall a. Eq a => a -> a -> Bool
== t
1 then forall a. a -> a
id else forall i. Integral i => Z i -> i -> i -> i
z_mul Z t
z t
m
        t_f :: t -> t
t_f = if t
t forall a. Ord a => a -> a -> Bool
> t
0 then forall i. Integral i => Z i -> i -> i -> i
z_add Z t
z t
t else forall a. a -> a
id
    in t -> t
t_f forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> t
m_f forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> t
i_f

-- | 'nub' of 'sort' of 'z_tto_f'.  (nub because M may be 0).
--
-- > z_tto_apply z12 (tto_parse 5 "T1M") [0,1,2,3] == [1,4,6,11]
z_tto_apply :: Integral t => Z t -> Tto t -> [t] -> [t]
z_tto_apply :: forall t. Integral t => Z t -> Tto t -> [t] -> [t]
z_tto_apply Z t
z Tto t
o = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall t. Integral t => Z t -> Tto t -> t -> t
z_tto_f Z t
z Tto t
o)

-- | Find 'Tto's that map pc-set /x/ to pc-set /y/ given /m/ and /z/.
--
-- > map tto_pp (z_tto_rel 5 z12 [0,1,2,3] [1,4,6,11]) == ["T1M","T4MI"]
z_tto_rel :: (Ord t,Integral t) => t -> Z t -> [t] -> [t] -> [Tto t]
z_tto_rel :: forall t. (Ord t, Integral t) => t -> Z t -> [t] -> [t] -> [Tto t]
z_tto_rel t
m Z t
z [t]
x [t]
y =
  let f :: Tto t -> Maybe (Tto t)
f Tto t
o = if forall t. Integral t => Z t -> Tto t -> [t] -> [t]
z_tto_apply Z t
z Tto t
o [t]
x forall a. Eq a => a -> a -> Bool
== [t]
y then forall a. a -> Maybe a
Just Tto t
o else forall a. Maybe a
Nothing
  in forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Tto t -> Maybe (Tto t)
f (forall t. Integral t => t -> Z t -> [Tto t]
z_tto_univ t
m Z t
z)

-- * Plain

-- | 'nub' of 'sort' of 'z_mod' of /z/.
--
-- > z_pcset z12 [1,13] == [1]
-- > map (z_pcset z12) [[0,6],[6,12],[12,18]] == replicate 3 [0,6]
z_pcset :: (Integral t,Ord t) => Z t -> [t] -> [t]
z_pcset :: forall t. (Integral t, Ord t) => Z t -> [t] -> [t]
z_pcset Z t
z = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall i. Integral i => Z i -> i -> i
z_mod Z t
z)

-- | Transpose by n.
--
-- > z_tto_tn z12 4 [1,5,6] == [5,9,10]
-- > z_tto_tn z12 4 [0,4,8] == [0,4,8]
z_tto_tn :: Integral i => Z i -> i -> [i] -> [i]
z_tto_tn :: forall i. Integral i => Z i -> i -> [i] -> [i]
z_tto_tn Z i
z i
n = forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall i. Integral i => Z i -> i -> i -> i
z_add Z i
z i
n)

-- | Invert about n.
--
-- > z_tto_invert z12 6 [4,5,6] == [6,7,8]
-- > z_tto_invert z12 0 [0,1,3] == [0,9,11]
z_tto_invert :: Integral i => Z i -> i -> [i] -> [i]
z_tto_invert :: forall i. Integral i => Z i -> i -> [i] -> [i]
z_tto_invert Z i
z i
n = forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\i
p -> forall i. Integral i => Z i -> i -> i -> i
z_sub Z i
z i
n (forall i. Integral i => Z i -> i -> i -> i
z_sub Z i
z i
p i
n))

-- | Composition of 'z_tto_invert' about @0@ and 'z_tto_tn'.
--
-- > z_tto_tni z12 4 [1,5,6] == [3,10,11]
-- > (z_tto_invert z12 0 . z_tto_tn z12 4) [1,5,6] == [2,3,7]
z_tto_tni :: Integral i => Z i -> i -> [i] -> [i]
z_tto_tni :: forall i. Integral i => Z i -> i -> [i] -> [i]
z_tto_tni Z i
z i
n = forall i. Integral i => Z i -> i -> [i] -> [i]
z_tto_tn Z i
z i
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => Z i -> i -> [i] -> [i]
z_tto_invert Z i
z i
0

-- | Modulo-z multiplication
--
-- > z_tto_mn z12 11 [0,1,4,9] == z_tto_invert z12 0 [0,1,4,9]
z_tto_mn :: Integral i => Z i -> i -> [i] -> [i]
z_tto_mn :: forall i. Integral i => Z i -> i -> [i] -> [i]
z_tto_mn Z i
z i
n = forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall i. Integral i => Z i -> i -> i -> i
z_mul Z i
z i
n)

-- | M5, ie. 'mn' @5@.
--
-- > z_tto_m5 z12 [0,1,3] == [0,3,5]
z_tto_m5 :: Integral i => Z i -> [i] -> [i]
z_tto_m5 :: forall i. Integral i => Z i -> [i] -> [i]
z_tto_m5 Z i
z = forall i. Integral i => Z i -> i -> [i] -> [i]
z_tto_mn Z i
z i
5

-- * Sequence

-- | T-related sets of /p/.
z_tto_t_related_seq :: Integral i => Z i -> [i] -> [[i]]
z_tto_t_related_seq :: forall i. Integral i => Z i -> [i] -> [[i]]
z_tto_t_related_seq Z i
z [i]
p = forall a b. (a -> b) -> [a] -> [b]
map (\i
q -> forall i. Integral i => Z i -> i -> [i] -> [i]
z_tto_tn Z i
z i
q [i]
p) [i
0..i
11]

-- | Unique elements of 'z_tto_t_related_seq'.
--
-- > length (z_tto_t_related z12 [0,1,3]) == 12
-- > z_tto_t_related z12 [0,3,6,9] == [[0,3,6,9],[1,4,7,10],[2,5,8,11]]
z_tto_t_related :: Integral i => Z i -> [i] -> [[i]]
z_tto_t_related :: forall i. Integral i => Z i -> [i] -> [[i]]
z_tto_t_related Z i
z = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => Z i -> [i] -> [[i]]
z_tto_t_related_seq Z i
z

-- | T\/I-related set of /p/.
z_tto_ti_related_seq :: Integral i => Z i -> [i] -> [[i]]
z_tto_ti_related_seq :: forall i. Integral i => Z i -> [i] -> [[i]]
z_tto_ti_related_seq Z i
z [i]
p = forall i. Integral i => Z i -> [i] -> [[i]]
z_tto_t_related Z i
z [i]
p forall a. [a] -> [a] -> [a]
++ forall i. Integral i => Z i -> [i] -> [[i]]
z_tto_t_related Z i
z (forall i. Integral i => Z i -> i -> [i] -> [i]
z_tto_invert Z i
z i
0 [i]
p)

-- | Unique elements of 'z_tto_ti_related_seq'.
--
-- > length (z_tto_ti_related z12 [0,1,3]) == 24
-- > z_tto_ti_related z12 [0,3,6,9] == [[0,3,6,9],[1,4,7,10],[2,5,8,11]]
z_tto_ti_related :: Integral i => Z i -> [i] -> [[i]]
z_tto_ti_related :: forall i. Integral i => Z i -> [i] -> [[i]]
z_tto_ti_related Z i
z = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => Z i -> [i] -> [[i]]
z_tto_ti_related_seq Z i
z