Haskell中的平衡分区

时间:2014-08-17 17:25:47

标签: algorithm haskell partitioning

在haskell中,如何生成集合的平衡分区?

假设我有一个集合{1,3,4,6,9},该集合的平衡分区为s1{9,3}s2{6,4,1}s1-s21

3 个答案:

答案 0 :(得分:6)

嗯,对于蛮力,我们可以通过为尾部生成分区然后将头放在左侧列表或右侧来递归生成所有分区:

partitions :: [a] -> [([a], [a])]
partitions [] = [([], [])]
partitions (x : xs) = let ps = partitions xs in
    [(x : ys, zs) | (ys, zs) <- ps] ++ [(ys, x : zs) | (ys, zs) <- ps]

有办法计算不平衡:

unbalance :: Num a => ([a], [a]) -> a
unbalance (ys, zs) = abs (sum ys - sum zs)

然后把它们放在一起:

balancedPartition :: (Num a, Ord a) => [a] -> ([a], [a])
balancedPartition = minimumBy (comparing unbalance) . partitions

这是完整的模块:

module Balance where

import Data.List(minimumBy)
import Data.Ord(comparing)

partitions :: [a] -> [([a], [a])]
partitions [] = [([], [])]
partitions (x : xs) = let ps = partitions xs in
    [(x : ys, zs) | (ys, zs) <- ps] ++ [(ys, x : zs) | (ys, zs) <- ps]

unbalance :: Num a => ([a], [a]) -> a
unbalance (ys, zs) = abs (sum ys - sum zs)

balancedPartition :: (Num a, Ord a) => [a] -> ([a], [a])
balancedPartition = minimumBy (comparing unbalance) . partitions

答案 1 :(得分:1)

这是一个做得更好的解决方案:

balancedPartition :: (Num a, Ord a) => [a] -> ([a], [a])
balancedPartition = snd . head . partitionsByBadness . sort
  where
    -- recursively builds a list of possible partitionings and their badness
    -- sorted by their (increasing) badness
    partitionsByBadness []     = [(0, ([], []))]
    partitionsByBadness (x:xs) = let res = partitionsByBadness xs
                                     withX = map (      (+x) *** first  (x:)) res
                                     sansX = map (subtract x *** second (x:)) res
                                 in merge withX $ normalize sansX

    -- When items are added to the second list, the difference between the sums
    -- decreases - and might become negative
    -- We take those cases and swap the lists, so that the first list has always
    -- a greater sum and the difference is always positive
    -- So that we can sort the list again (with linear complexity)
    normalize xs = let (neg, pos) = span ((<0) . fst) xs
                   in merge pos $ reverse $ map (negate *** swap) neg

-- merge two sorted lists (as known from mergesort, but
-- omits "duplicates" with same badness)
merge :: Ord k => [(k, v)] -> [(k, v)] -> [(k, v)]
merge []         zss        = zss
merge yss        []         = yss
merge yss@(y:ys) zss@(z:zs) = case comparing fst y z of
                                LT -> y : merge ys zss
                                EQ -> merge ys zss
                                GT -> z : merge yss zs

答案 2 :(得分:1)

Bin包装效果很好:

% stack ghci --package Binpack
λ: import Data.BinPack
λ: let bins numberOfBins items = let totalSize = sum items; binSize = succ (totalSize `div` (max 1 numberOfBins)) in binpack WorstFit Decreasing id (replicate numberOfBins (emptyBin binSize)) items
λ: bins 2 [1,3,4,6,9]
([(0,[3,9]),(1,[1,4,6])],[])

如果您知道您的输入符合垃圾箱,则可以提取分区:

λ: map snd . fst . bins 2 $ [1,3,4,6,9]
[[3,9],[1,4,6]]