[Haskell-cafe] Coin changing algorithm
Mark Carroll
markc at chiark.greenend.org.uk
Wed Jul 13 10:28:04 EDT 2005
On Wed, 13 Jul 2005, Dinh Tien Tuan Anh wrote:
(snip)
> eg: m = 75, k = 5
> => [50, 20, 5]
> [50, 20, 1,2,2]
(snip)
> Is this problem suitable for functional programming language ?
Oh, what fun. I like this sort of thing. My quick attempt is:
module Coins where
import Data.Maybe
nextChange :: Num a => (Int, [a]) -> [(Int, [a])]
nextChange (n, xs) = [ (n', increment n' xs) | n' <- [ n .. length xs - 1 ] ]
where
increment 0 (x:xs) = x+1 : xs
increment n (x:xs) = x : increment (n-1) xs
makeChange :: (Num a, Ord a) => [a] -> a -> a -> [[a]]
makeChange coins total number =
helper (0, replicate (length coins) 0)
where
helper state@(_, change)
| sum change > number = [] -- too many coins
| otherwise =
case compare (sum (zipWith (*) coins change)) total of
EQ -> [change] -- correct amount
LT -> concatMap helper (nextChange state) -- too little
GT -> [] -- too much
showResults :: Num a => [a] -> [a] -> [String]
showResults coins change =
mapMaybe showResult (zip coins change)
where
showResult (_,0) = Nothing
showResult (c,n) = Just (show n ++ " x " ++ show c)
test =
let coins = [1,2,5,10,20,50,100,200]
printChange change = do mapM_ putStrLn (showResults coins change)
putChar '\n'
in mapM_ printChange (makeChange coins 75 5)
I post it here because, whenever I do, someone else shows a much better
solution that's shorter and clearer! Especially, I don't see myself using
much real functional programming in the above, and I'd love to see a
better approach.
-- Mark
More information about the Haskell-Cafe
mailing list