Skip to Content »

Tech Life of Recht » Fun with Haskell

 Fun with Haskell

  • January 19th, 2007
  • 2:02 pm

At JAOO 2006, I attended a session with Erik Meijer on Haskell. The session gave a very quick introduction to Haskell as a very nice functional language, and the enthusiasm of Erik Meijer on the subject only made it more interesting.
So, I've been messing around with Haskell for a while, without producing anything worthwhile - I'm still trying to figure out how to put the language to good use. However, I found a list of Haskell quizzes, derived from Ruby Quiz. Some of these have not yet been solved, so I sat down and began working on Splitting the Loot. After some hours, I suddenly discovered that I have a working solution - somewhat to my surprise.

Anyways, here it is - as it's one of my first Haskell programs, I'm sure there's lots of room for improvement. What it does is basically to find all possible combinations of a list of numbers, and then it tries to combine these combinations in order to find a valid solution:

CODE:
  1. divide :: Integer -> [Integer] -> [(Integer, [Integer])]
  2. divide persons vals
  3.     | toInteger (length vals) <persons = error "Not enough values"
  4.     | not $ mod (sum vals) persons == 0 = error "Values cannot be divided equally"
  5.     | otherwise = divide'' persons vals (div (sum vals) persons) [] 1
  6.  
  7. divide'' persons vals maxval res cnt
  8.     | cnt> persons = res
  9.     | otherwise =
  10.         let p = permut vals maxval
  11.             nx = findE p maxval
  12.             in divide'' persons (deleteFirstsBy (==) vals nx) maxval ((cnt, nx):res) (cnt + 1)
  13.  
  14.  
  15. findE [] c = error "Unable to find fitting element"
  16. findE xs c
  17.     | sum (head xs) == c = head xs
  18.     | otherwise = findE (tail xs) c
  19.  
  20.  
  21. uniq [] sorted = reverse sorted
  22. uniq xs [] = uniq (tail xs) [head xs]
  23. uniq xs sorted
  24.     | head xs == head sorted = uniq (tail xs) sorted
  25.     | otherwise = uniq (tail xs) (head xs:sorted)
  26.  
  27.  
  28. permut :: [Integer] -> Integer -> [[Integer]]
  29. permut nums maxval = permut' nums [] 0 maxval
  30. permut' :: [Integer] -> [[Integer]] -> Int -> Integer -> [[Integer]]
  31. permut' nums [] _ maxval = permut' nums (map (\x -> [x]) nums) 0 maxval
  32. permut' nums xs cnt maxval
  33.     | cnt + 2> length nums = uniq (sort xs) []
  34.     | otherwise =  permut'
  35.         nums
  36.         (xs ++ uniq
  37.             (sort $
  38.                 foldr (++) []
  39.                     [map (\ ys -> appendIfNecessary x ys nums maxval) xs | x <- nums]
  40.                 )
  41.             [])
  42.         (cnt + 1)
  43.         maxval
  44.  
  45.  
  46. appendIfNecessary x xs old maxval
  47.     | elem x (deleteFirstsBy (==) old xs) = if (sum xs) + x> maxval
  48.                                                 then xs
  49.                                                 else x:xs
  50.     | otherwise = xs

Want your say?

* Required fields. Your e-mail address will not be published on this site

You can use the following XHTML tags:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>