Michael,
Here's my stab at it, not sure if it's really better though:
findClosestPitch :: SampleMap -> Pitch -> ErrorT String Identity Pitch
findClosestPitch samples inPitch = do
when (M.null samples) $ throwError "Was given empty sample table."
case M.splitLookup inPitch samples of
(_, Just _, _) -> return inPitch
(ml, _, mh) -> return $ approxPitch ml mh
where
approxPitch ml mh | M.null ml = fst . M.findMin $ mh
approxPitch ml mh | M.null mh = fst . M.findMax $ ml
approxPitch ml mh = closest (fst . M.findMax $ ml)
(fst . M.findMin $ mh)
where closest a b = min (inPitch - a) (b - inPitch)
I tried to separate the approximation part from the rest of the code,
and used a bit of deduction to eliminate (hopefully correctly...) some
of the testing conditions.
Anyways, I had fun doing working on this, and I learned a bit about
computerized music as well!
Thanks,
Patrick
On Wed, Nov 11, 2009 at 9:15 PM, Michael P Mossey
Patrick LeBoutillier wrote:
Michael,
Your code is interesting and I'd like to run it, but I'm not to familiar with Maps and Monad transformers. Could you provide a function to create a SampleMap and a way to test it from ghci?
Sure,
import Control.Monad.Identity import Control.Monad.Error import Control.Monad import qualified Data.Map as M
type Pitch = Int type Sample = String type SampleMap = M.Map Pitch Sample
-- Given a SampleMap and a Pitch, find the Pitch in the SampleMap -- which is closest to the supplied Pitch and return that. Also -- handle case of null map by throwing an error. findClosestPitch :: SampleMap -> Pitch -> ErrorT String Identity Pitch findClosestPitch samples inPitch = do when (M.null samples) $ throwError "Was given empty sample table." case M.splitLookup inPitch samples of (_,Just _,_ ) -> return inPitch (m1,_ ,m2) | (M.null m1) && not (M.null m2) -> case1 | not (M.null m1) && (M.null m2) -> case2 | otherwise -> case3 where case1 = return . fst . M.findMin $ m2 case2 = return . fst . M.findMax $ m1 case3 = return $ closest (fst . M.findMax $ m1) (fst . M.findMin $ m2) closest a b = if abs (a - inPitch) < abs (b - inPitch) then a else b
testMap1 = M.fromList [ (1,"sample1") , (5,"sample2") , (9,"sample3") ]
-- testMap2 ==> Right 1 testMap2 = runIdentity $ runErrorT $ findClosestPitch testMap1 2
-- testMap3 ==> Right 5 testMap3 = runIdentity $ runErrorT $ findClosestPitch testMap1 5
-- testMap4 ==> Left "Was given empty sample table." testMap4 = runIdentity $ runErrorT $ findClosestPitch M.empty 5
-- ===================== Patrick LeBoutillier Rosemère, Québec, Canada