all possibilities of dividing a list in two in Haskell

Question

What's the most direct/efficient way to create all possibilities of dividing one (even) list into two in Haskell? I toyed with splitting all permutations of the list but that would add many extras - all the instances where each half contains the same elements, just in a different order. For example,

[1,2,3,4] should produce something like:

[ [1,2],  [3,4] ]
[ [1,3],  [2,4] ]
[ [1,4],  [2,3] ]

Edit: thank you for your comments -- the order of elements and the type of the result is less important to me than the concept - an expression of all two-groups from one group, where element order is unimportant.

Answer 1

To find all partitions of a non-empty list (of even length n) into two equal-sized parts, we can, to avoid repetitions, posit that the first element shall be in the first part. Then it remains to find all ways to split the tail of the list into one part of length n/2 - 1 and one of length n/2.

-- not to be exported
splitLen :: Int -> Int -> [a] -> [([a],[a])]
splitLen 0 _ xs = [([],xs)]
splitLen _ _ [] = error "Oops"
splitLen k l ys@(x:xs)
    | k == l    = [(ys,[])]
    | otherwise = [(x:us,vs) | (us,vs) <- splitLen (k-1) (l-1) xs]
                  ++ [(us,x:vs) | (us,vs) <- splitLen k (l-1) xs]

does that splitting if called appropriately. Then

partitions :: [a] -> [([a],[a])]
partitions [] = [([],[])]
partitions (x:xs)
    | even len  = error "Original list with odd length"
    | otherwise = [(x:us,vs) | (us,vs) <- splitLen half len xs]
      where
        len = length xs
        half = len `quot` 2

generates all the partitions without redundantly computing duplicates.

luqui raises a good point. I haven't taken into account the possibility that you'd want to split lists with repeated elements. With those, it gets a little more complicated, but not much. First, we group the list into equal elements (done here for an Ord constraint, for only Eq, that could still be done in O(length²)). The idea is then similar, to avoid repetitions, we posit that the first half contains more elements of the first group than the second (or, if there is an even number in the first group, equally many, and similar restrictions hold for the next group etc.).

repartitions :: Ord a => [a] -> [([a],[a])]
repartitions = map flatten2 . halves . prepare
  where
    flatten2 (u,v) = (flatten u, flatten v)

prepare :: Ord a => [a] -> [(a,Int)]
prepare = map (\xs -> (head xs, length xs)) . group . sort

halves :: [(a,Int)] -> [([(a,Int)],[(a,Int)])]
halves [] = [([],[])]
halves ((a,k):more)
    | odd total = error "Odd number of elements"
    | even k    = [((a,low):us,(a,low):vs) | (us,vs) <- halves more] ++ [normalise ((a,c):us,(a,k-c):vs) | c <- [low + 1 .. min half k], (us,vs) <- choose (half-c) remaining more]
    | otherwise = [normalise ((a,c):us,(a,k-c):vs) | c <- [low + 1 .. min half k], (us,vs) <- choose (half-c) remaining more]
      where
        remaining = sum $ map snd more
        total = k + remaining
        half = total `quot` 2
        low = k `quot` 2
        normalise (u,v) = (nz u, nz v)
        nz = filter ((/= 0) . snd)

choose :: Int -> Int -> [(a,Int)] -> [([(a,Int)],[(a,Int)])]
choose 0 _ xs = [([],xs)]
choose _ _ [] = error "Oops"
choose need have ((a,k):more) = [((a,c):us,(a,k-c):vs) | c <- [least .. most], (us,vs) <- choose (need-c) (have-k) more]
  where
    least = max 0 (need + k - have)
    most  = min need k

flatten :: [(a,Int)] -> [a]
flatten xs = xs >>= uncurry (flip replicate)

Answer 2

Here's an implementation, closely following the definition.

The first element always goes into the left group. After that, we add the next head element into one, or the other group. If one of the groups becomes too big, there is no choice anymore and we must add all the rest into the the shorter group.

divide :: [a] -> [([a], [a])]
divide []     = [([],[])]
divide (x:xs) = go ([x],[], xs, 1,length xs) []
  where
    go (a,b,   [],     i,j) zs = (a,b) : zs   -- i == lengh a - length b
    go (a,b, s@(x:xs), i,j) zs                -- j == length s
       | i    >= j = (a,b++s) : zs
       | (-i) >= j = (a++s,b) : zs
       | otherwise = go (x:a, b, xs, i+1, j-1) $ go (a, x:b, xs, i-1, j-1) zs

This produces

*Main> divide [1,2,3,4]
[([2,1],[3,4]),([3,1],[2,4]),([1,4],[3,2])]

The limitation of having an even length list is unnecessary:

*Main> divide [1,2,3]
[([2,1],[3]),([3,1],[2]),([1],[3,2])]

_{(the code was re-written in the "difference-list" style for efficiency: go2 A zs == go1 A ++ zs).}

edit: How does this work? Imagine yourself sitting at a pile of stones, dividing it into two. You put the first stone to a side, which one it doesn't matter (so, left, say). Then there's a choice where to put each next stone — unless one of the two piles becomes too small by comparison, and we thus must put all the remaining stones there at once.

Answer 3

Daniel Fischer's answer is a good way to solve the problem. I offer a worse (more inefficient) way, but one which more obviously (to me) corresponds to the problem description. I will generate all partitions of the list into two equal length sublists, then filter out equivalent ones according to your definition of equivalence. The way I usually solve problems is by starting like this -- create a solution that is as obvious as possible, then gradually transform it into a more efficient one (if necessary).

import Data.List (sort, nubBy, permutations)

type Partition a = ([a],[a])

-- Your notion of equivalence (sort to ignore the order)
equiv :: (Ord a) => Partition a -> Partition a -> Bool
equiv p q = canon p == canon q
    where
    canon (xs,ys) = sort [sort xs, sort ys]

-- All ordered partitions
partitions :: [a] -> [Partition a]
partitions xs = map (splitAt l) (permutations xs)
    where
    l = length xs `div` 2

-- All partitions filtered out by the equivalence
equivPartitions :: (Ord a) => [a] -> [Partition a]
equivPartitions = nubBy equiv . partitions

Testing

>>> equivPartitions [1,2,3,4]
[([1,2],[3,4]),([3,2],[1,4]),([3,1],[2,4])]

Note

After using QuickCheck to test the equivalence of this implementation with Daniel's, I found an important difference. Clearly, mine requires an (Ord a) constraint and his does not, and this hints at what the difference would be. In particular, if you give his [0,0,0,0], you will get a list with three copies of ([0,0],[0,0]), whereas mine will give only one copy. Which of these is correct was not specified; Daniel's is natural when considering the two output lists to be ordered sequences (which is what that type is usually considered to be), mine is natural when considering them as sets or bags (which is how this question seemed to be treating them).

Splitting The Difference

It is possible to get from an implementation that requires Ord to one that doesn't, by operating on the positions rather than the values in a list. I came up with this transformation -- an idea which I believe originates with Benjamin Pierce in his work on bidirectional programming.

import Data.Traversable
import Control.Monad.Trans.State

data Labelled a = Labelled { label :: Integer, value :: a }

instance Eq (Labelled a) where
    a == b = compare a b == EQ
instance Ord (Labelled a) where
    compare a b = compare (label a) (label b)

labels :: (Traversable t) => t a -> t (Labelled a)
labels t = evalState (traverse trav t) 0
    where
    trav x = state (\i -> i `seq` (Labelled i x, i + 1))

onIndices :: (Traversable t, Functor u)
          => (forall a. Ord a => t a -> u a)
          -> forall b. t b -> u b
onIndices f = fmap value . f . labels

Using onIndices on equivPartitions wouldn't speed it up at all, but it would allow it to have the same semantics as Daniel's (up to equiv of the results) without the constraint, and with my more naive and obvious way of expressing it -- and I just thought it was an interesting way to get rid of the constraint.

Answer 4

My own generalized version, added much later, inspired by Will's answer:

import Data.Map (adjust, fromList, toList)
import Data.List (groupBy, sort)

divide xs n evenly = divide' xs (zip [0..] (replicate n [])) where
  evenPSize = div (length xs) n
  divide' []     result = [result]
  divide' (x:xs) result = do
    index <- indexes
    divide' xs (toList $ adjust (x :) index (fromList result)) where
      notEmptyBins = filter (not . null . snd) $ result
      partlyFullBins | evenly == "evenly" = map fst . filter ((<evenPSize) . length . snd) $ notEmptyBins
                     | otherwise          = map fst notEmptyBins
      indexes = partlyFullBins 
             ++ if any (null . snd) result
                   then map fst . take 1 . filter (null . snd) $ result
                   else if null partlyFullBins
                           then map fst. head . groupBy (\a b -> length (snd a) == length (snd b)) . sort $ result
                           else []