[Haskell-beginners] maybe this could be improved?

[Patrick LeBoutillier]

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
<mpm at alumni.caltech.edu> wrote:
> 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