[Haskell-beginners] maybe this could be improved?

Michael Mossey mpm at alumni.caltech.edu
Sat Nov 7 12:44:48 EST 2009

I've got some code which could be made simpler, I hope. the problem is
this: I am
implementing a software sampling synthesizer. For a given musical
instrument, like piano, there are sound samples in memory. One purchases
or creates sample sets. To
save time money & resources, most sample sets are not complete---they have
samples for only some of the pitches. Perhaps every third pitch has a
sample. For the software to produce the sound for a non-included pitch,
the software finds the closest included sample and plays it back slightly
slower/faster to get the target pitch.

That leads to the following code. Any ideas for improvement are welcome.
The problem is that there are many cases to check: an empty map? the
requested pitch less than all available pitches, greater than all
available, or somewhere between? I am specifically writing this to run in
O( log n) time. (It would be simpler as O(n).) This particular algorithm
probably doesn't need to run in O(log n) time, but I want to do it as an
educational experience---I will have other applications that need to use
Map in O(log n) time.

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

More information about the Beginners mailing list