Binpack 0.3 → 0.3.1
raw patch · 3 files changed
+41/−21 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Binpack.cabal +6/−4
- Data/BinPack.hs +28/−17
- NEWS +7/−0
Binpack.cabal view
@@ -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
Data/BinPack.hs view
@@ -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)
NEWS view
@@ -1,3 +1,10 @@+Version 0.3.1 (8/4/2009):+ - Fix trailing whitespace in description. [Brian Lewis <brian@lorf.org>]+ - Spelling corrections. [Brian Lewis <brian@lorf.org>]+ - Enable -Wall and fix a bunch of warnings. [Brian Lewis <brian@lorf.org>]+ - 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.