[Haskell-cafe] help with musical data structures
Stephen Tetley
stephen.tetley at gmail.com
Sun Nov 15 04:05:07 EST 2009
Hello Mike
A pitch class set represents Z12 numbers so I'd define a Z12 number
type then store it in a list (if you have need a multiset -
duplicates) or Data.Set (if you need uniqueness).
Having a Z12 numeric type isn't the full story, some operations like
finding prime form have easier algorithms if they are transitory -
i.e. they go out of Z12 to the integers and back.
You might want to look at Richard Bird's Sudoko solver for the other
problem (slides and the code are a web search away) which takes a very
elegant look at a matrix problem.
Below is a Z12 modulo I made earlier - adding QuickCheck tests would
have been wise (also I seem to remember there is a pitch class package
on Hackage):
-- Show instance is hand written to escape constructor noise
-- It seemed useful to have mod12 as a shortcut - tastes may vary
-- The Modulo12 coercion type class is a bit extraneous (fromInteger
which suffice).
-- I use it to allay coercion warnings in other modules
module Z12
(
-- * Integers mod 12
Z12
-- * Integral coercion
, Modulo12(..)
, mod12
) where
-- Data types
newtype Z12 = Z12 Int
deriving (Eq,Ord)
--------------------------------------------------------------------------------
class Modulo12 a where
fromZ12 :: Z12 -> a
toZ12 :: a -> Z12
instance Modulo12 Int where
fromZ12 (Z12 i) = i
toZ12 i = Z12 $ mod i 12
instance Modulo12 Integer where
fromZ12 (Z12 i) = fromIntegral i
toZ12 i = Z12 $ fromIntegral $ mod i 12
--------------------------------------------------------------------------------
instance Show Z12 where
showsPrec p (Z12 i) = showsPrec p i
--------------------------------------------------------------------------------
-- Num Instances
liftUZ12 :: (Int -> Int) -> Z12 -> Z12
liftUZ12 op (Z12 a) = Z12 $ mod (op a) 12
liftBZ12 :: (Int -> Int -> Int) -> Z12 -> Z12 -> Z12
liftBZ12 op (Z12 a) (Z12 b) = Z12 $ mod (a `op` b) 12
instance Num Z12 where
(+) = liftBZ12 (+)
(-) = liftBZ12 (-)
(*) = liftBZ12 (*)
negate = liftUZ12 negate
fromInteger i = Z12 $ (fromInteger i) `mod` 12
signum _ = error "Modular numbers are not signed"
abs _ = error "Modular numbers are not signed"
--------------------------------------------------------------------------------
mod12 :: Integral a => a -> a
mod12 = (`mod` 12)
More information about the Haskell-Cafe
mailing list