diff --git a/Binpack.cabal b/Binpack.cabal --- a/Binpack.cabal +++ b/Binpack.cabal @@ -1,5 +1,5 @@ Name: Binpack -Version: 0.3 +Version: 0.3.1 Cabal-Version: >= 1.2 License: BSD3 License-File: LICENSE @@ -15,8 +15,7 @@ order of both decreasing and increasing size (and, of course, in unmodified order). . - . - The module supports both the standard (textbook) minimization problem + The module supports both the standard (textbook) minimization problem (/How many bins do I need?/) and the more practical fitting problem (/I've got n bins; which items can I take?/). . @@ -31,4 +30,7 @@ Library Exposed-Modules: Data.BinPack - build-depends: base >= 3 && < 5, haskell98, QuickCheck + Build-Depends: base >= 3 && < 5, haskell98, QuickCheck + Ghc-Options: -Wall -fno-warn-unused-binds -fno-warn-unused-imports + if impl(ghc >= 6.8) + Ghc-Options: -fwarn-tabs diff --git a/Data/BinPack.hs b/Data/BinPack.hs --- a/Data/BinPack.hs +++ b/Data/BinPack.hs @@ -27,8 +27,8 @@ {- | -This module implements a number of common bin packing heurstics: 'FirstFit', -'LastFit', 'BestFit', 'WorstFit', and 'AlmostWorstFit'. In addtion, the +This module implements a number of common bin packing heuristics: 'FirstFit', +'LastFit', 'BestFit', 'WorstFit', and 'AlmostWorstFit'. In addition, the not-so-common, but analytically superior (in terms of worst-case behavior), 'ModifiedFirstFit' heuristic is also supported. Items can be packed in order of both 'Decreasing' and 'Increasing' size (and, of course, in unmodified order; @@ -64,7 +64,7 @@ [@lB@] All items of size at most @cap\/2@ and strictly larger than @cap\/3@. -[@lC@] All items of size at most @cap\/3@ and stricly larger than @(cap - x)\/5@. +[@lC@] All items of size at most @cap\/3@ and strictly larger than @(cap - x)\/5@. [@lD@] The rest, /i.e./, all items of size at most @(cap - x)\/5@. @@ -149,7 +149,7 @@ -- bin. deriving (Show, Eq, Ord) --- | The list of all possible 'PlacmentPolicy' choices. Useful for benchmarking. +-- | The list of all possible 'PlacementPolicy' choices. Useful for benchmarking. allPlacements :: [PlacementPolicy] allPlacements = [FirstFit, ModifiedFirstFit, LastFit, BestFit, WorstFit, AlmostWorstFit] @@ -169,7 +169,7 @@ type Measure a b = (b -> a) -- | Given a 'Measure', an item @b@, a list of capacities @[a]@, and a list of --- bins @['Bin' b]@, a placment heuristic returns @Just@ an updated lists of +-- bins @['Bin' b]@, a placement heuristic returns @Just@ an updated lists of -- capacities and bins if the item could be placed, and @Nothing@ otherwise. type Placement a b = Measure a b -> b -> [a] -> [Bin b] -> Maybe ([a],[Bin b]) @@ -180,6 +180,7 @@ placement FirstFit = firstfit placement LastFit = lastfit placement AlmostWorstFit = almostWorstfit +placement ModifiedFirstFit = error "Not a simple placment policy." order :: (Ord a) => OrderPolicy -> Order a b order AsGiven = const id @@ -212,7 +213,7 @@ Examples: -* Pack the words of the senctene /"Bin packing heuristics are a lot of fun!"/ +* Pack the words of the sentence /"Bin packing heuristics are a lot of fun!"/ into bins of size 11, assuming the size of a word is its length. The 'Increasing' ordering yields a sub-optimal result that leaves a lot of empty space in the bins. @@ -315,6 +316,15 @@ ModifiedFirstFit -> binpackMFF ordPol size capacities emptyBins items' _ -> binpack' (fit size) capacities emptyBins items' [] +-- | Actual binpacking function. Tries to place each item in order. +binpack' :: (Num a, Ord a) => + (b -> [a] -> [Bin b] -> Maybe ([a], [Bin b])) -- ^ Function to + -- place on item. + -> [a] -- ^ Remaining capacities. + -> [Bin b] -- ^ The bins. + -> [b] -- ^ Items yet to be placed. + -> [b] -- ^ Items that didn't fit anywhere (accumulator). + -> ([a], [Bin b], [b]) binpack' _ caps bins [] misfits = (caps, bins, misfits) binpack' fit caps bins (x : xs) misfits = case fit x caps bins of @@ -329,20 +339,20 @@ xfit cmp size item caps bins = case best Nothing caps of Nothing -> Nothing - opt -> Just (drop False opt caps bins [] []) + opt -> Just (drop' False opt caps bins [] []) where fit c = if size item <= c then Just (c - size item) else Nothing - better Nothing y = False - better x Nothing = True + better Nothing _ = False + better _ Nothing = True better (Just a) (Just b) = a `cmp` b best = foldl (\ a b -> if better (fit b) a then fit b else a) - drop _ _ [] [] caps' bins' = (reverse caps', reverse bins') - drop dropped opt (c : caps) (b : bins) caps' bins' = + drop' _ _ [] [] caps' bins' = (reverse caps', reverse bins') + drop' dropped opt (c : caps) (b : bins) caps' bins' = if not dropped && better (fit c) opt - then drop True opt caps bins + then drop' True opt caps bins ((c - size item) : caps') ((item : b) : bins') - else drop dropped opt caps bins (c : caps') (b : bins') + else drop' dropped opt caps bins (c : caps') (b : bins') bestfit, firstfit, lastfit, worstfit :: (Ord a, Num a) => Placement a b bestfit = xfit (>=) @@ -363,8 +373,8 @@ in case space of [] -> Nothing - (c, i) : [] -> Just (insertAt i item s caps bins) - _ : ((c, i) : _) -> Just (insertAt i item s caps bins) + (_, i) : [] -> Just (insertAt i item s caps bins) + _ : ((_, i) : _) -> Just (insertAt i item s caps bins) -------------------------------------------------------------- -- Modified first fit heuristic (see above). @@ -485,13 +495,14 @@ prop_notLossy :: PlacementPolicy -> OrderPolicy -> [Double] -> Bool prop_notLossy pPol oPol nums = sort nums == sort nums' - where (caps, bins) = minimizeBins pPol oPol id 1.0 nums - nums' = concat bins + where (_, bins) = minimizeBins pPol oPol id 1.0 nums + nums' = concat bins prop_remCap :: PlacementPolicy -> OrderPolicy -> [Int] -> Bool prop_remCap pPol oPol nums = all (\ (c, b) -> sum b == 100 - c) $ zip caps bins where (caps, bins) = minimizeBins pPol oPol id 100 nums +runTests :: IO () runTests = do let n = 100 i = replicateM n $ choose (1, 100) diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,3 +1,10 @@ +Version 0.3.1 (8/4/2009): + - Fix trailing whitespace in description. [Brian Lewis ] + - Spelling corrections. [Brian Lewis ] + - Enable -Wall and fix a bunch of warnings. [Brian Lewis ] + - Silence some more warnings. + - Compile with -fno-warn-unused-binds -fno-warn-unused-imports until + the QuickCheck tests have moved to their own module. If enabled, the options add too much noise. Version 0.3 (8/3/2009): - Cabalized module.