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:
-
divide :: Integer -> [Integer] -> [(Integer, [Integer])]
-
divide persons vals
-
| toInteger (length vals) <persons = error "Not enough values"
-
| not $ mod (sum vals) persons == 0 = error "Values cannot be divided equally"
-
| otherwise = divide'' persons vals (div (sum vals) persons) [] 1
-
-
divide'' persons vals maxval res cnt
-
| cnt> persons = res
-
| otherwise =
-
let p = permut vals maxval
-
nx = findE p maxval
-
in divide'' persons (deleteFirstsBy (==) vals nx) maxval ((cnt, nx):res) (cnt + 1)
-
-
-
findE [] c = error "Unable to find fitting element"
-
findE xs c
-
| sum (head xs) == c = head xs
-
| otherwise = findE (tail xs) c
-
-
-
uniq [] sorted = reverse sorted
-
uniq xs [] = uniq (tail xs) [head xs]
-
uniq xs sorted
-
| head xs == head sorted = uniq (tail xs) sorted
-
| otherwise = uniq (tail xs) (head xs:sorted)
-
-
-
permut :: [Integer] -> Integer -> [[Integer]]
-
permut nums maxval = permut' nums [] 0 maxval
-
permut' :: [Integer] -> [[Integer]] -> Int -> Integer -> [[Integer]]
-
permut' nums [] _ maxval = permut' nums (map (\x -> [x]) nums) 0 maxval
-
permut' nums xs cnt maxval
-
| cnt + 2> length nums = uniq (sort xs) []
-
| otherwise = permut'
-
nums
-
(xs ++ uniq
-
(sort $
-
foldr (++) []
-
[map (\ ys -> appendIfNecessary x ys nums maxval) xs | x <- nums]
-
)
-
[])
-
(cnt + 1)
-
maxval
-
-
-
appendIfNecessary x xs old maxval
-
| elem x (deleteFirstsBy (==) old xs) = if (sum xs) + x> maxval
-
then xs
-
else x:xs
-
| otherwise = xs



