2

在Haskell中创建将一个（偶数）列表分成两个的所有可能性的最直接/有效的方法是什么？我玩弄了拆分列表的所有排列，但这会增加许多额外内容 - 每一半都包含相同元素的所有实例，只是顺序不同。例如，

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

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

编辑：感谢您的评论——元素的顺序和结果的类型对我来说不如概念重要——一个组中所有两组的表达，其中元素顺序并不重要。

4

4 回答 4

4

这是一个实现，紧跟定义。

第一个元素总是进入左组。之后，我们将下一个头元素添加到一个或另一个组中。如果其中一个组变得太大，就别无选择了，我们必须将其余的都添加到较短的组中。

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

这产生

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

具有偶数长度列表的限制是不必要的：

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

（代码以“差异列表”样式重新编写以提高效率：）go2 A zs == go1 A ++ zs。

编辑：这是如何工作的？想象自己坐在一堆石头前，把它一分为二。你把第一块石头放在一边，哪一块没关系（所以，左，说）。然后有一个选择，将每块下一块石头放在哪里——除非两堆中的一个相比之下变得太小，因此我们必须一次将所有剩余的石头放在那里。

于 2013-03-02T21:21:08.917 回答
4

为了将非空列表（长度为偶数n）的所有分区分成大小相等的两个部分，我们可以为避免重复，假设第一个元素应位于第一部分中。然后剩下的就是寻找所有方法将列表的尾部拆分为 length 的一部分和 lengthn/2 - 1的一部分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]

如果适当调用，会进行拆分。然后

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

生成所有分区，而无需冗余计算重复项。

luqui提出了一个很好的观点。我没有考虑到您希望使用重复元素拆分列表的可能性。有了这些，它变得有点复杂，但并不多。首先，我们将列表分组为相等的元素（此处为Ord约束完成，仅用于Eq，仍然可以在 中完成O(length²)）。然后这个想法是相似的，为了避免重复，我们假设前半部分包含第一组的元素多于第二组（或者，如果第一组中有偶数，则同样多，并且下一组具有类似的限制组等）。

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)
于 2013-03-02T20:10:09.167 回答
3

Daniel Fischer 的回答是解决问题的好方法。我提供了一种更糟糕（效率更低）的方法，但（对我而言）更明显的是对应于问题描述。我会将列表的所有分区生成两个等长的子列表，然后根据您对等价的定义过滤掉等价的子列表。我通常解决问题的方法是这样开始——创建一个尽可能明显的解决方案，然后逐渐将其转变为更有效的解决方案（如有必要）。

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

测试

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

笔记

在使用 QuickCheck 测试了这个实现与 Daniel 的等效性之后，我发现了一个重要的区别。显然，我的需要一个(Ord a)约束，而他的不需要，这暗示了不同之处。特别是，如果你给他的[0,0,0,0]，你会得到一个包含三个副本的列表([0,0],[0,0])，而我的只会给一个副本。未指定哪些是正确的；在考虑将两个输出列表作为有序序列（通常认为是该类型）时，Daniel 很自然，当将它们视为集合或包时，我的很自然（这个问题似乎是如何对待它们的）。

分裂差异

Ord通过对位置而不是列表中的值进行操作，可以从需要的实现中获得不需要的实现。我想出了这个转变——我相信这个想法起源于 Benjamin Pierce 在他的双向编程工作中。

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

使用onIndicesonequivPartitions根本不会加速它，但它会允许它具有与 Daniel 相同的语义（直到equiv结果），没有约束，并且用我更天真和明显的表达方式 - 我只是认为这是摆脱约束的一种有趣方式。

于 2013-03-02T20:21:46.887 回答
2

我自己的通用版本，后来添加，灵感来自 Will 的回答：

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 []
于 2013-04-29T01:57:53.077 回答