This is my first shot at implementing a solution for the integer partitioning problem in Haskell. It is a very inefficient algorithm, and it would probably either hang forever or crash with a core dump beyond, say, 20, but it is a first step in an efficient implementation of this problem which appears to be egregiously difficult to implement in idiomatic Haskell as compared to say, Java.
This implementation also generates the partitions in lexicographic order.
Here is the code:
module Partitions where
isort :: Ord a => (a -> a -> Bool) -> [a] -> [a]
isort _ [] = []
isort f (x:xs) = insert f x (isort f xs)
where
insert _ x [] = [x]
insert f x (y:ys) | f x y = x : (y:ys)
| otherwise = y : insert f x ys
lexical :: Ord a => [a] -> [a] -> Bool
lexical [] [] = True
lexical [] ys = True
lexical xs [] = True
lexical (x:xs) (y:ys) | x > y = False
| x < y = True
| otherwise = lexical xs ys
clean :: Ord a => [[a]] -> [[a]]
clean xss = h (map (isort (<)) xss) []
where
h [] acc = acc
h [xs] acc = if elem xs acc then acc else (xs:acc)
h (xs:xss) acc = if elem xs acc then h xss acc
else h xss (xs:acc)
partitions :: Int -> [[Int]]
partitions 0 = []
partitions n = isort lexical $ clean $ f start [start]
where
start = replicate n 1
f [_] acc = acc
f xs acc = f (normalise xs) (acc ++ cs) ++ clean (concat (map (\ys -> f ys []) cs))
where
normalise [] = []
normalise [x, y] = [x+y]
normalise (x:xs) = x : normalise xs
combinations [] = []
combinations [x] = [[x]]
combinations xs = g xs (length xs – 2)
where
g xs s | s < 0 = []
| otherwise = [take s xs ++ [xs!!s + xs!!(s+1)] ++ drop (s+2) xs] ++
g xs (s-1)
cs = clean $ combinations xs
Running some sample tests:
$ ghci
Prelude> :l Partitions.hs
[1 of 1] Compiling Partitions (Partitions.hs, interpreted )
Ok, modules loaded: Partitions.
*Partitions> partitions 0
[]
*Partitions> partitions 4
[[1,1,1,1],[1,1,2],[1,3],[2,2],[4]]
*Partitions> partitions 9
[[1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,2],[1,1,1,1,1,1,3],[1,1,1,1,1,2,2],[1,1,1,1,1,4],[1,1,1,1,2,3],[1,1,1,1,5],[1,1,1,2,2,2],[1,1,1,2,4],[1,1,1,3,3],[1,1,1,6],[1,1,2,2,3],[1,1,2,5],[1,1,3,4],[1,1,7],[1,2,2,2,2],[1,2,2,4],[1,2,3,3],[1,2,6],[1,3,5],[1,4,4],[1,8],[2,2,2,3],[2,2,5],[2,3,4],[2,7],[3,3,3],[3,6],[4,5],[9]]
*Partitions> partitions 12
[[1,1,1,1,1,1,1,1,1,1,1,1],[1,1,1,1,1,1,1,1,1,1,2],[1,1,1,1,1,1,1,1,1,3],[1,1,1,1,1,1,1,1,2,2],[1,1,1,1,1,1,1,1,4],[1,1,1,1,1,1,1,2,3],[1,1,1,1,1,1,1,5],[1,1,1,1,1,1,2,2,2],[1,1,1,1,1,1,2,4],[1,1,1,1,1,1,3,3],[1,1,1,1,1,1,6],[1,1,1,1,1,2,2,3],[1,1,1,1,1,2,5],[1,1,1,1,1,3,4],[1,1,1,1,1,7],[1,1,1,1,2,2,2,2],[1,1,1,1,2,2,4],[1,1,1,1,2,3,3],[1,1,1,1,2,6],[1,1,1,1,3,5],[1,1,1,1,4,4],[1,1,1,1,8],[1,1,1,2,2,2,3],[1,1,1,2,2,5],[1,1,1,2,3,4],[1,1,1,2,7],[1,1,1,3,3,3],[1,1,1,3,6],[1,1,1,4,5],[1,1,1,9],[1,1,2,2,2,2,2],[1,1,2,2,2,4],[1,1,2,2,3,3],[1,1,2,2,6],[1,1,2,3,5],[1,1,2,4,4],[1,1,2,8],[1,1,3,3,4],[1,1,3,7],[1,1,4,6],[1,1,5,5],[1,1,10],[1,2,2,2,2,3],[1,2,2,2,5],[1,2,2,3,4],[1,2,2,7],[1,2,3,3,3],[1,2,3,6],[1,2,4,5],[1,2,9],[1,3,3,5],[1,3,4,4],[1,3,8],[1,4,7],[1,5,6],[1,11],[2,2,2,2,2,2],[2,2,2,2,4],[2,2,2,3,3],[2,2,2,6],[2,2,3,5],[2,2,4,4],[2,2,8],[2,3,3,4],[2,3,7],[2,4,6],[2,5,5],[2,10],[3,3,3,3],[3,3,6],[3,4,5],[3,9],[4,4,4],[4,8],[5,7],[6,6],[12]]
An explanation will be provided when the efficient solution has been implemented!