module Music.Theory.Z.TTO where
import Data.List
import Data.Maybe
import qualified Text.ParserCombinators.Parsec as P
import qualified Music.Theory.Parse as T
import qualified Music.Theory.Set.List as T
import Music.Theory.Z
data TTO t = TTO {tto_T :: t,tto_M :: Bool,tto_I :: Bool}
deriving (Eq,Show)
tto_identity :: Num t => TTO t
tto_identity = TTO 0 False False
tto_pp :: Show t => TTO t -> String
tto_pp (TTO t m i) = concat ['T' : show t,if m then "M" else "",if i then "I" else ""]
p_tto :: Integral t => P.GenParser Char () (TTO t)
p_tto = do
_ <- P.char 'T'
t <- T.parse_int
m <- T.is_char 'M'
i <- T.is_char 'I'
P.eof
return (TTO t m i)
tto_parse :: Integral i => String -> TTO i
tto_parse = either (\e -> error ("tto_parse failed\n" ++ show e)) id . P.parse p_tto ""
z_tto_univ :: Integral t => Z t -> [TTO t]
z_tto_univ z = [TTO t m i | m <- [False,True], i <- [False,True], t <- z_univ z]
z_tto_f :: Integral t => t -> Z t -> TTO t -> (t -> t)
z_tto_f mn z (TTO t m i) =
let i_f = if i then z_negate z else id
m_f = if m then z_mul z mn else id
t_f = if t > 0 then z_add z t else id
in t_f . m_f . i_f
z_tto_apply :: Integral t => t -> Z t -> TTO t -> [t] -> [t]
z_tto_apply mn z o = sort . map (z_tto_f mn z o)
tto_apply :: Integral t => t -> TTO t -> [t] -> [t]
tto_apply mn = z_tto_apply mn id
z_tto_rel :: (Ord t,Integral t) => t -> Z t -> [t] -> [t] -> [TTO t]
z_tto_rel m z x y =
let q = T.set y
in mapMaybe (\o -> if z_tto_apply m z o x == q then Just o else Nothing) (z_tto_univ z)
z_pcset :: Ord t => Z t -> [t] -> [t]
z_pcset z = nub . sort . map z