-- | Serial (ordered) pitch-class operations on 'Z'.
module Music.Theory.Z.Sro where

import Data.List {- base -}

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

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

import Music.Theory.Z

-- | Serial operator,of the form rRTMI.
data Sro t = Sro {forall t. Sro t -> Int
sro_r :: Int
                 ,forall t. Sro t -> Bool
sro_R :: Bool
                 ,forall t. Sro t -> t
sro_T :: t
                 ,forall t. Sro t -> t
sro_M :: t -- 1 5
                 ,forall t. Sro t -> Bool
sro_I :: Bool}
             deriving (Sro t -> Sro t -> Bool
forall t. Eq t => Sro t -> Sro t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sro t -> Sro t -> Bool
$c/= :: forall t. Eq t => Sro t -> Sro t -> Bool
== :: Sro t -> Sro t -> Bool
$c== :: forall t. Eq t => Sro t -> Sro t -> Bool
Eq,Int -> Sro t -> ShowS
forall t. Show t => Int -> Sro t -> ShowS
forall t. Show t => [Sro t] -> ShowS
forall t. Show t => Sro t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sro t] -> ShowS
$cshowList :: forall t. Show t => [Sro t] -> ShowS
show :: Sro t -> String
$cshow :: forall t. Show t => Sro t -> String
showsPrec :: Int -> Sro t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> Sro t -> ShowS
Show)

-- | Printer in 'rnRTnMI' form.
sro_pp :: (Show t,Eq t,Num t) => Sro t -> String
sro_pp :: forall t. (Show t, Eq t, Num t) => Sro t -> String
sro_pp (Sro Int
rN Bool
r t
tN t
m Bool
i) =
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [if Int
rN forall a. Eq a => a -> a -> Bool
/= Int
0 then Char
'r' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Int
rN else String
""
           ,if Bool
r then String
"R" else String
""
           ,Char
'T' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show t
tN
           ,if t
m forall a. Eq a => a -> a -> Bool
== t
5 then String
"M" else if t
m forall a. Eq a => a -> a -> Bool
== t
1 then String
"" else forall a. HasCallStack => String -> a
error String
"sro_pp: M?"
           ,if Bool
i then String
"I" else String
""]

-- | Parser for Sro.
p_sro :: Integral t => t -> Parse.P (Sro t)
p_sro :: forall t. Integral t => t -> P (Sro t)
p_sro t
m_mul = do
  let rot :: ParsecT String () Identity Int
rot = forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Int
0 (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'r' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall i. Integral i => P i
Parse.parse_int)
  Int
r <- ParsecT String () Identity Int
rot
  Bool
r' <- Char -> P Bool
Parse.is_char Char
'R'
  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. Int -> Bool -> t -> t -> Bool -> Sro t
Sro Int
r Bool
r' t
t (if Bool
m then t
m_mul else t
1) Bool
i)

-- | Parse a Morris format serial operator descriptor.
--
-- > sro_parse 5 "r2RT3MI" == Sro 2 True 3 5 True
sro_parse :: Integral i => i -> String -> Sro i
sro_parse :: forall i. Integral i => i -> String -> Sro i
sro_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
"sro_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 (Sro t)
p_sro i
m) String
""

-- * Z

-- | The total set of serial operations.
--
-- > let u = z_sro_univ 3 5 z12
-- > zip (map sro_pp u) (map (\o -> z_sro_apply z12 o [0,1,3]) u)
z_sro_univ :: Integral i => Int -> i -> Z i -> [Sro i]
z_sro_univ :: forall i. Integral i => Int -> i -> Z i -> [Sro i]
z_sro_univ Int
n_rot i
m_mul Z i
z =
    [forall t. Int -> Bool -> t -> t -> Bool -> Sro t
Sro Int
r Bool
r' i
t i
m Bool
i |
     Int
r <- [Int
0 .. Int
n_rot forall a. Num a => a -> a -> a
- Int
1],
     Bool
r' <- [Bool
False,Bool
True],
     i
t <- forall i. Integral i => Z i -> [i]
z_univ Z i
z,
     i
m <- [i
1,i
m_mul],
     Bool
i <- [Bool
False,Bool
True]]

-- | The set of transposition 'Sro's.
z_sro_Tn :: Integral i => Z i -> [Sro i]
z_sro_Tn :: forall i. Integral i => Z i -> [Sro i]
z_sro_Tn Z i
z = [forall t. Int -> Bool -> t -> t -> Bool -> Sro t
Sro Int
0 Bool
False i
n i
1 Bool
False | i
n <- forall i. Integral i => Z i -> [i]
z_univ Z i
z]

-- | The set of transposition and inversion 'Sro's.
z_sro_TnI :: Integral i => Z i -> [Sro i]
z_sro_TnI :: forall i. Integral i => Z i -> [Sro i]
z_sro_TnI Z i
z =
    [forall t. Int -> Bool -> t -> t -> Bool -> Sro t
Sro Int
0 Bool
False i
n i
1 Bool
i |
     i
n <- forall i. Integral i => Z i -> [i]
z_univ Z i
z,
     Bool
i <- [Bool
False,Bool
True]]

-- | The set of retrograde and transposition and inversion 'Sro's.
z_sro_RTnI :: Integral i => Z i -> [Sro i]
z_sro_RTnI :: forall i. Integral i => Z i -> [Sro i]
z_sro_RTnI Z i
z =
    [forall t. Int -> Bool -> t -> t -> Bool -> Sro t
Sro Int
0 Bool
r i
n i
1 Bool
i |
     Bool
r <- [Bool
True,Bool
False],
     i
n <- forall i. Integral i => Z i -> [i]
z_univ Z i
z,
     Bool
i <- [Bool
False,Bool
True]]

-- | The set of transposition, @M@ and inversion 'Sro's.
z_sro_TnMI :: Integral i => i -> Z i -> [Sro i]
z_sro_TnMI :: forall i. Integral i => i -> Z i -> [Sro i]
z_sro_TnMI i
m_mul Z i
z =
    [forall t. Int -> Bool -> t -> t -> Bool -> Sro t
Sro Int
0 Bool
False i
n i
m Bool
i |
     i
n <- forall i. Integral i => Z i -> [i]
z_univ Z i
z,
     i
m <- [i
1,i
m_mul],
     Bool
i <- [Bool
True,Bool
False]]

-- | The set of retrograde,transposition,@M5@ and inversion 'Sro's.
z_sro_RTnMI :: Integral i => i -> Z i -> [Sro i]
z_sro_RTnMI :: forall i. Integral i => i -> Z i -> [Sro i]
z_sro_RTnMI i
m_mul Z i
z =
    [forall t. Int -> Bool -> t -> t -> Bool -> Sro t
Sro Int
0 Bool
r i
n i
m Bool
i |
     Bool
r <- [Bool
True,Bool
False],
     i
n <- forall i. Integral i => Z i -> [i]
z_univ Z i
z,
     i
m <- [i
1,i
m_mul],
     Bool
i <- [Bool
True,Bool
False]]

-- * Serial operations

-- | Apply Sro.
--
-- > z_sro_apply z12 (Sro 1 True 1 5 False) [0,1,2,3] == [11,6,1,4]
-- > z_sro_apply z12 (Sro 1 False 4 5 True) [0,1,2,3] == [11,6,1,4]
z_sro_apply :: Integral i => Z i -> Sro i -> [i] -> [i]
z_sro_apply :: forall i. Integral i => Z i -> Sro i -> [i] -> [i]
z_sro_apply Z i
z (Sro Int
r Bool
r' i
t i
m Bool
i) [i]
x =
    let x1 :: [i]
x1 = if Bool
i then forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
z_sro_invert Z i
z i
0 [i]
x else [i]
x
        x2 :: [i]
x2 = if i
m forall a. Eq a => a -> a -> Bool
== i
1 then [i]
x1 else forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
z_sro_mn Z i
z i
m [i]
x1
        x3 :: [i]
x3 = forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
z_sro_tn Z i
z i
t [i]
x2
        x4 :: [i]
x4 = if Bool
r' then forall a. [a] -> [a]
reverse [i]
x3 else [i]
x3
    in forall a. Int -> [a] -> [a]
List.rotate_left Int
r [i]
x4

-- | Find 'Sro's that map /x/ to /y/ given /m/ and /z/.
--
-- > map sro_pp (z_sro_rel 5 z12 [0,1,2,3] [11,6,1,4]) == ["r1T4MI","r1RT1M"]
z_sro_rel :: (Ord t,Integral t) => t -> Z t -> [t] -> [t] -> [Sro t]
z_sro_rel :: forall t. (Ord t, Integral t) => t -> Z t -> [t] -> [t] -> [Sro t]
z_sro_rel t
m Z t
z [t]
x [t]
y = forall a. (a -> Bool) -> [a] -> [a]
filter (\Sro t
o -> forall i. Integral i => Z i -> Sro i -> [i] -> [i]
z_sro_apply Z t
z Sro t
o [t]
x forall a. Eq a => a -> a -> Bool
== [t]
y) (forall i. Integral i => Int -> i -> Z i -> [Sro i]
z_sro_univ (forall (t :: * -> *) a. Foldable t => t a -> Int
length [t]
x) t
m Z t
z)

-- * Plain

-- | Transpose /p/ by /n/.
--
-- > z_sro_tn z5 4 [0,1,4] == [4,0,3]
-- > z_sro_tn z12 4 [1,5,6] == [5,9,10]
z_sro_tn :: (Integral i, Functor f) => Z i -> i -> f i -> f i
z_sro_tn :: forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
z_sro_tn Z i
z i
n = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall i. Integral i => Z i -> i -> i -> i
z_add Z i
z i
n)

-- | Invert /p/ about /n/.
--
-- > z_sro_invert z5 0 [0,1,4] == [0,4,1]
-- > z_sro_invert z12 6 [4,5,6] == [8,7,6]
-- > map (z_sro_invert z12 0) [[0,1,3],[1,4,8]] == [[0,11,9],[11,8,4]]
--
-- > import Data.Word {- base -}
-- > z_sro_invert z12 (0::Word8) [1,4,8] == [3,0,8]
z_sro_invert :: (Integral i, Functor f) => Z i -> i -> f i -> f i
z_sro_invert :: forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
z_sro_invert Z i
z i
n = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\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 'invert' about @0@ and 'tn'.
--
-- > z_sro_tni z5 1 [0,1,3] == [1,0,3]
-- > z_sro_tni z12 4 [1,5,6] == [3,11,10]
-- > (z_sro_invert z12 0 . z_sro_tn z12 4) [1,5,6] == [7,3,2]
z_sro_tni :: (Integral i, Functor f) => Z i -> i -> f i -> f i
z_sro_tni :: forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
z_sro_tni Z i
z i
n = forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
z_sro_tn Z i
z i
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
z_sro_invert Z i
z i
0

-- | Modulo multiplication.
--
-- > z_sro_mn z12 11 [0,1,4,9] == z_sro_tni z12 0 [0,1,4,9]
z_sro_mn :: (Integral i, Functor f) => Z i -> i -> f i -> f i
z_sro_mn :: forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
z_sro_mn Z i
z i
n = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall i. Integral i => Z i -> i -> i -> i
z_mul Z i
z i
n)

-- | M5, ie. 'mn' @5@.
--
-- > z_sro_m5 z12 [0,1,3] == [0,5,3]
z_sro_m5 :: (Integral i, Functor f) => Z i -> f i -> f i
z_sro_m5 :: forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> f i -> f i
z_sro_m5 Z i
z = forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
z_sro_mn Z i
z i
5

-- | T-related sequences of /p/.
--
-- > length (z_sro_t_related z12 [0,3,6,9]) == 12
-- > z_sro_t_related z5 [0,2] == [[0,2],[1,3],[2,4],[3,0],[4,1]]
z_sro_t_related :: (Integral i, Functor f) => Z i -> f i -> [f i]
z_sro_t_related :: forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> f i -> [f i]
z_sro_t_related Z i
z f i
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\i
n -> forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
z_sro_tn Z i
z i
n f i
p) (forall i. Integral i => Z i -> [i]
z_univ Z i
z)

-- | T\/I-related sequences of /p/.
--
-- > length (z_sro_ti_related z12 [0,1,3]) == 24
-- > length (z_sro_ti_related z12 [0,3,6,9]) == 24
-- > z_sro_ti_related z12 [0] == map return [0..11]
z_sro_ti_related :: (Eq (f i), Integral i, Functor f) => Z i -> f i -> [f i]
z_sro_ti_related :: forall (f :: * -> *) i.
(Eq (f i), Integral i, Functor f) =>
Z i -> f i -> [f i]
z_sro_ti_related Z i
z f i
p = forall a. Eq a => [a] -> [a]
nub (forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> f i -> [f i]
z_sro_t_related Z i
z f i
p forall a. [a] -> [a] -> [a]
++ forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> f i -> [f i]
z_sro_t_related Z i
z (forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
z_sro_invert Z i
z i
0 f i
p))

-- | R\/T\/I-related sequences of /p/.
--
-- > length (z_sro_rti_related z12 [0,1,3]) == 48
-- > length (z_sro_rti_related z12 [0,3,6,9]) == 24
z_sro_rti_related :: Integral i => Z i -> [i] -> [[i]]
z_sro_rti_related :: forall i. Integral i => Z i -> [i] -> [[i]]
z_sro_rti_related Z i
z [i]
p = let q :: [[i]]
q = forall (f :: * -> *) i.
(Eq (f i), Integral i, Functor f) =>
Z i -> f i -> [f i]
z_sro_ti_related Z i
z [i]
p in forall a. Eq a => [a] -> [a]
nub ([[i]]
q forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
reverse [[i]]
q)

-- | T\/M\/I-related sequences of /p/, duplicates removed.
z_sro_tmi_related :: Integral i => Z i -> [i] -> [[i]]
z_sro_tmi_related :: forall i. Integral i => Z i -> [i] -> [[i]]
z_sro_tmi_related Z i
z [i]
p = let q :: [[i]]
q = forall (f :: * -> *) i.
(Eq (f i), Integral i, Functor f) =>
Z i -> f i -> [f i]
z_sro_ti_related Z i
z [i]
p in forall a. Eq a => [a] -> [a]
nub ([[i]]
q forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> f i -> f i
z_sro_m5 Z i
z) [[i]]
q)

-- | R\/T\/M\/I-related sequences of /p/, duplicates removed.
z_sro_rtmi_related :: Integral i => Z i -> [i] -> [[i]]
z_sro_rtmi_related :: forall i. Integral i => Z i -> [i] -> [[i]]
z_sro_rtmi_related Z i
z [i]
p = let q :: [[i]]
q = forall i. Integral i => Z i -> [i] -> [[i]]
z_sro_tmi_related Z i
z [i]
p in forall a. Eq a => [a] -> [a]
nub ([[i]]
q forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
reverse [[i]]
q)

-- | r\/R\/T\/M\/I-related sequences of /p/, duplicates removed.
z_sro_rrtmi_related :: Integral i => Z i -> [i] -> [[i]]
z_sro_rrtmi_related :: forall i. Integral i => Z i -> [i] -> [[i]]
z_sro_rrtmi_related Z i
z [i]
p = forall a. Eq a => [a] -> [a]
nub (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall i. Integral i => Z i -> [i] -> [[i]]
z_sro_rtmi_related Z i
z) (forall a. [a] -> [[a]]
List.rotations [i]
p))

-- * Sequence operations

-- | Variant of 'tn', transpose /p/ so first element is /n/.
--
-- > z_sro_tn_to z12 5 [0,1,3] == [5,6,8]
-- > map (z_sro_tn_to z12 0) [[0,1,3],[1,3,0],[3,0,1]] == [[0,1,3],[0,2,11],[0,9,10]]
z_sro_tn_to :: Integral i => Z i -> i -> [i] -> [i]
z_sro_tn_to :: forall i. Integral i => Z i -> i -> [i] -> [i]
z_sro_tn_to Z i
z i
n [i]
p =
    case [i]
p of
      [] -> []
      i
x:[i]
xs -> i
n forall a. a -> [a] -> [a]
: forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
z_sro_tn Z i
z (forall i. Integral i => Z i -> i -> i -> i
z_sub Z i
z i
n i
x) [i]
xs

-- | Variant of 'invert', inverse about /n/th element.
--
-- > map (z_sro_invert_ix z12 0) [[0,1,3],[3,4,6]] == [[0,11,9],[3,2,0]]
-- > map (z_sro_invert_ix z12 1) [[0,1,3],[3,4,6]] == [[2,1,11],[5,4,2]]
z_sro_invert_ix :: Integral i => Z i -> Int -> [i] -> [i]
z_sro_invert_ix :: forall i. Integral i => Z i -> Int -> [i] -> [i]
z_sro_invert_ix Z i
z Int
n [i]
p = forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
z_sro_invert Z i
z ([i]
p forall a. [a] -> Int -> a
!! Int
n) [i]
p

-- | The standard t-matrix of /p/.
--
-- > z_tmatrix z12 [0,1,3] == [[0,1,3],[11,0,2],[9,10,0]]
z_tmatrix :: Integral i => Z i -> [i] -> [[i]]
z_tmatrix :: forall i. Integral i => Z i -> [i] -> [[i]]
z_tmatrix Z i
z [i]
p = forall a b. (a -> b) -> [a] -> [b]
map (\i
n -> forall i (f :: * -> *).
(Integral i, Functor f) =>
Z i -> i -> f i -> f i
z_sro_tn Z i
z i
n [i]
p) (forall i. Integral i => Z i -> i -> [i] -> [i]
z_sro_tn_to Z i
z i
0 (forall i. Integral i => Z i -> Int -> [i] -> [i]
z_sro_invert_ix Z i
z Int
0 [i]
p))