module Music.Theory.Pitch where
import Music.Theory.Set
import Data.Maybe
import Data.List
mod12 :: (Integral a) => a -> a
mod12 = (`mod` 12)
pc :: (Integral a) => a -> a
pc = mod12
pcset :: (Integral a) => [a] -> [a]
pcset = set . map pc
tn :: (Integral a) => a -> [a] -> [a]
tn n = map (pc . (+ n))
transposeTo :: (Integral a) => a -> [a] -> [a]
transposeTo _ [] = []
transposeTo n (x:xs) = n : tn (n x) xs
transpositions :: (Integral a) => [a] -> [[a]]
transpositions p = map (`tn` p) [0..11]
invert :: (Integral a) => a -> [a] -> [a]
invert n = map (pc . (\p -> n (p n)))
invertSelf :: (Integral a) => [a] -> [a]
invertSelf [] = []
invertSelf (x:xs) = invert x (x:xs)
tni :: (Integral a) => a -> [a] -> [a]
tni n = tn n . invert 0
rotate :: (Integral n) => n -> [a] -> [a]
rotate n p =
let m = n `mod` genericLength p
(b, a) = genericSplitAt m p
in a ++ b
rotate_right :: (Integral n) => n -> [a] -> [a]
rotate_right = rotate . negate
rotations :: [a] -> [[a]]
rotations p = map (`rotate` p) [0 .. length p 1]
mn :: (Integral a) => a -> [a] -> [a]
mn n = map (pc . (* n))
m5 :: (Integral a) => [a] -> [a]
m5 = mn 5
all_Tn :: (Integral a) => [a] -> [[a]]
all_Tn p = map (`tn` p) [0..11]
all_TnI :: (Integral a) => [a] -> [[a]]
all_TnI p =
let ps = all_Tn p
in ps ++ map (invert 0) ps
all_RTnI :: (Integral a) => [a] -> [[a]]
all_RTnI p =
let ps = all_TnI p
in ps ++ map reverse ps
all_TnMI :: (Integral a) => [a] -> [[a]]
all_TnMI p =
let ps = all_TnI p
in ps ++ map m5 ps
all_RTnMI :: (Integral a) => [a] -> [[a]]
all_RTnMI p =
let ps = all_TnMI p
in ps ++ map reverse ps
all_rRTnMI :: (Integral a) => [a] -> [[a]]
all_rRTnMI = map snd . sros
data SRO a = SRO a Bool a Bool Bool
deriving (Eq, Show)
sro :: (Integral a) => SRO a -> [a] -> [a]
sro (SRO r r' t m i) x =
let x1 = if i then invert 0 x else x
x2 = if m then m5 x1 else x1
x3 = tn t x2
x4 = if r' then reverse x3 else x3
in rotate r x4
sros :: (Integral a) => [a] -> [(SRO a, [a])]
sros x = [ let o = (SRO r r' t m i) in (o, sro o x) |
r <- [0 .. genericLength x 1],
r' <- [False, True],
t <- [0 .. 11],
m <- [False, True],
i <- [False, True] ]
sro_Tn :: (Integral a) => [SRO a]
sro_Tn = [ SRO 0 False n False False |
n <- [0..11] ]
sro_TnI :: (Integral a) => [SRO a]
sro_TnI = [ SRO 0 False n False i |
n <- [0..11],
i <- [False, True] ]
sro_RTnI :: (Integral a) => [SRO a]
sro_RTnI = [ SRO 0 r n False i |
r <- [True, False],
n <- [0..11],
i <- [False, True] ]
sro_TnMI :: (Integral a) => [SRO a]
sro_TnMI = [ SRO 0 False n m i |
n <- [0..11],
m <- [True, False],
i <- [True, False] ]
sro_RTnMI :: (Integral a) => [SRO a]
sro_RTnMI = [ SRO 0 r n m i |
r <- [True, False],
n <- [0..11],
m <- [True, False],
i <- [True, False] ]
dx_d :: (Num a) => a -> [a] -> [a]
dx_d = scanl (+)
d_dx :: (Num a) => [a] -> [a]
d_dx [] = []
d_dx (_:[]) = []
d_dx (x:xs) = zipWith () xs (x:xs)
int :: (Integral a) => [a] -> [a]
int = map mod12 . d_dx
ic :: (Integral a) => a -> a
ic i =
let i' = mod12 i
in if i' <= 6 then i' else 12 i'
difference :: (Eq a) => [a] -> [a] -> [a]
difference p q =
let f e = e `notElem` q
in filter f p
complement :: (Integral a) => [a] -> [a]
complement = difference [0..11]
subsequence :: (Eq a) => [a] -> [a] -> Bool
subsequence = isInfixOf
tmatrix :: (Integral a) => [a] -> [[a]]
tmatrix p = map (`tn` p) (transposeTo 0 (invertSelf p))
icv :: (Integral a) => [a] -> [a]
icv s =
let i = map (ic . uncurry ()) (dyads s)
j = map f (group (sort i))
k = map (`lookup` j) [1..6]
f l = (head l, genericLength l)
in map (fromMaybe 0) k
is_subset :: Eq a => [a] -> [a] -> Bool
is_subset p q = p `intersect` q == p
is_superset :: Eq a => [a] -> [a] -> Bool
is_superset = flip is_subset