
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

On Sat, Nov 7, 2009 at 12:44 PM, Michael Mossey
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
I'd try writing quickcheck properties for these cases. That is a really complicated function. It strikes me that a lot of those cases need less available in their scopes than they have. You could force that by breaking the cases and closest into individual functions. Then you could write properties for them. Then you are left with only one complex function determining which case you need. Possibly you could return the case directly? Anyway, that's not as helpful as telling you that you just reinvented a 4 and a half gainer comonad or whatever but if you start cutting this thing up you might notice a structure you already know. -- Darrin

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?
Thanks,
Patrick
On Sat, Nov 7, 2009 at 12:44 PM, Michael Mossey
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
_______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners
-- ===================== Patrick LeBoutillier Rosemère, Québec, Canada

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

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

Hi, Thanks for your help and it looks like you identified some conditions that could be removed. There is one change necessary, I think. closest a b = if (inPitch - a) < (b - inPitch) then a else b Patrick LeBoutillier wrote:
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 Thu, Nov 12, 2009 at 5:31 PM, Michael Mossey
Hi, Thanks for your help and it looks like you identified some conditions that could be removed. There is one change necessary, I think.
closest a b = if (inPitch - a) < (b - inPitch) then a else b
Yes, of course. I just happens that in the test code (testMap2) it gives the same answer... Patrick
Patrick LeBoutillier wrote:
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
-- ===================== Patrick LeBoutillier Rosemère, Québec, Canada
participants (4)
-
Darrin Thompson
-
Michael Mossey
-
Michael P Mossey
-
Patrick LeBoutillier