MissingH 1.0.0 → 1.0.1
raw patch · 3 files changed
+185/−6 lines, 3 filesdep ~haskell98
Dependency ranges changed: haskell98
Files
- MissingH.cabal +3/−4
- src/Data/BinPacking.hs +126/−0
- src/Data/Quantity.hs +56/−2
MissingH.cabal view
@@ -1,5 +1,5 @@ Name: MissingH-Version: 1.0.0+Version: 1.0.1 License: GPL Maintainer: John Goerzen <jgoerzen@complete.org> Author: John Goerzen@@ -31,6 +31,7 @@ Network.Email.Sendmail, Data.CSV, System.Cmd.Utils,+ Data.BinPacking, Data.Progress.Tracker, Data.Progress.Meter, Data.Quantity,@@ -64,8 +65,6 @@ -- does not understand the PatternSignatures extension. -- The Cabal that comes with ghc-6.8.2 does understand it, so -- this hack can be dropped if we require Cabal-Version: >=1.2.3- If impl(ghc >= 6.8)- GHC-Options: -XPatternSignatures Build-Depends: network, parsec, base, haskell98, mtl, HUnit, regex-compat, QuickCheck, filepath,@@ -83,4 +82,4 @@ Main-Is: runtests.hs HS-Source-Dirs: testsrc, . Extensions: ExistentialQuantification, OverlappingInstances,- UndecidableInstances, CPP+ UndecidableInstances, CPP, PatternSignatures
+ src/Data/BinPacking.hs view
@@ -0,0 +1,126 @@+{-+Copyright (C) 2008 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++{- |+ Module : Data.BinPacking+ Copyright : Copyright (C) 2008 John Goerzen+ License : GNU GPL, version 2 or above++ Maintainer : John Goerzen <jgoerzen@complete.org> + Stability : provisional+ Portability: portable++Tools for packing into bins++Written by John Goerzen, jgoerzen\@complete.org++This module is designed to solve this type of problem: Given a bunch of+objects of varying sizes, what is the best possible way to pack them into+fixed-size bins? This can be used, for instance, by the datapacker program+to pack files onto CDs or DVDs; by manufacturing environments to pack+physical items into physicl bins; etc.++A description of bin packing algorithms can be found at+<http://en.wikipedia.org/wiki/Bin_packing_problem>.+-}++module Data.BinPacking (BinPacker,+ BinPackerError(..),+ packByOrder,+ packLargeFirst+ )++where+import Data.List+import Control.Monad.Error++{- | Potential errors returned as Left values by 'BinPacker' functions. +Calling 'show' on this value will produce a nice error message suitable for+display. -}+data (Num size, Ord size, Show size, Show obj) => BinPackerError size obj = + BPTooFewBins [(size, obj)] -- ^ Ran out of bins; attached value is the list of objects that don't fit+ | BPSizeTooLarge size (size, obj) -- ^ Bin size1 exceeded by at least the given object and size+ | BPOther String -- ^ Other error+ deriving (Eq, Read)++instance (Num size, Ord size, Show size, Show obj) => Show (BinPackerError size obj) where+ show (BPTooFewBins _) = "Too few bins"+ show (BPSizeTooLarge binsize (objsize, obj)) =+ "Size " ++ show objsize ++ " greater than bin size " ++ show binsize+ ++ " at " ++ show obj+ show (BPOther x) = x++{- | Let us use this as part of the Either monad -}+instance (Num size, Ord size, Show size, Show obj) => Error (BinPackerError size obj) where+ strMsg = BPOther++{- | The primary type for bin-packing functions.++These functions take a list of size of bins. If every bin is the same size,+you can pass @(repeat binSize)@ to pass an infinite list of bins if the+same size. Any surplus bins will simply be ignored. -}+type BinPacker = (Num size, Ord size, Show size, Show obj) => + [size] -- ^ The sizes of bins+ -> [(size, obj)] -- ^ The sizes and objects+ -> Either (BinPackerError size obj) [[(size, obj)]] -- ^ Either error or results+++{- | Pack objects into bins, preserving order. Objects will be taken from the+input list one by one, and added to each bin until the bin is full. Work will+then proceed on the next bin. No attempt is made to optimize allocations to+bins. This is the simplest and most naive bin-packing algorithm, but+may not make very good use of bin space. -}+packByOrder :: BinPacker+packByOrder _ [] = Right [] -- Ran out of sizes+packByOrder [] remainder = Left (BPTooFewBins remainder)+packByOrder (thisbinsize:otherbins) sizes =+ let fillBin _ [] = Right []+ fillBin accumsize ((s, o):xs) + | s > thisbinsize = Left $ BPSizeTooLarge thisbinsize (s, o)+ | s + accumsize > thisbinsize = Right []+ | otherwise = do next <- fillBin (accumsize + s) xs+ return $ (s, o) : next+ in do thisset <- fillBin 0 sizes+ next <- packByOrder otherbins (drop (length thisset) sizes)+ return (thisset : next)++{- | Pack objects into bins. For each bin, start with the largest objects,+and keep packing the largest object from the remainder until no object can+be found to put in the bin. This is substantially more efficient than+'packByOrder', but requires sorting the input. -}+packLargeFirst :: BinPacker+packLargeFirst bins sizes = packLargeFirst' bins (sortBy fstSort sizes)+ where fstSort a b = compare (fst a) (fst b)++packLargeFirst' :: BinPacker+packLargeFirst' _ [] = Right [] -- Ran out of sizes+packLargeFirst' [] remainder = Left (BPTooFewBins remainder)+packLargeFirst' (thisbinsize:otherbins) sizes =+ let fillBin _ [] = Right []+ fillBin accumsize sizelist =+ case break (\x -> (fst x) + accumsize <= thisbinsize) sizelist of+ (_, []) ->+ if accumsize == 0+ then Left $ BPSizeTooLarge thisbinsize (head sizelist)+ else Right []+ (nonmatches, ((s, o):matchxs)) ->+ do next <- fillBin (accumsize + s) (nonmatches ++ matchxs)+ return $ (s, o) : next+ in do thisset <- fillBin 0 sizes+ next <- packLargeFirst' otherbins (drop (length thisset) sizes)+ return (thisset : next)
src/Data/Quantity.hs view
@@ -1,5 +1,5 @@ {--Copyright (C) 2006 John Goerzen <jgoerzen@complete.org>+Copyright (C) 2006-2008 John Goerzen <jgoerzen@complete.org> This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by@@ -18,7 +18,7 @@ {- | Module : Data.Quantity- Copyright : Copyright (C) 2006 John Goerzen+ Copyright : Copyright (C) 2006-2008 John Goerzen License : GNU GPL, version 2 or above Maintainer : John Goerzen <jgoerzen@complete.org> @@ -32,6 +32,8 @@ module Data.Quantity ( renderNum, renderNums,+ parseNum,+ parseNumInt, quantifyNum, quantifyNums, SizeOpts(..),@@ -42,6 +44,7 @@ where import Data.List import Text.Printf+import Data.Char {- | The options for 'quantifyNum' and 'renderNum' -} data SizeOpts = SizeOpts { base :: Int, -- ^ The base from which calculations are made@@ -165,3 +168,54 @@ (printf ("%." ++ show prec ++ "f") num) ++ [suffix] (convnums, suffix) = (quantifyNums opts numbers)::([Double], Char)++{- | Parses a String, possibly generated by 'renderNum'. Parses the suffix+and applies it to the number, which is read via the Read class.++Returns Left "error message" on error, or Right number on successful parse.++If you want an Integral result, the convenience function 'parseNumInt' is for+you.+-}+parseNum :: (Read a, Fractional a) => + SizeOpts -- ^ Information on how to parse this data+ -> Bool -- ^ Whether to perform a case-insensitive match+ -> String -- ^ The string to parse+ -> Either String a+parseNum opts insensitive inp =+ case reads inp of+ [] -> Left "Couldn't parse numeric component of input"+ [(num, "")] -> Right num -- No suffix; pass number unhindered+ [(num, [suffix])] ->+ case lookup (caseTransformer suffix) suffixMap of+ Nothing -> Left $ "Unrecognized suffix " ++ show suffix+ Just power -> Right $ num * multiplier power+ [(_, suffix)] -> Left $ "Multi-character suffix " ++ show suffix+ _ -> Left "Multiple parses for input"+ where suffixMap = zip (map caseTransformer . suffixes $ opts) + (iterate (+ (powerIncr opts)) (firstPower opts))+ caseTransformer x+ | insensitive = toLower x+ | otherwise = x+ multiplier :: (Read a, Fractional a) => Int -> a+ multiplier power =+ fromRational . toRational $ + fromIntegral (base opts) ** fromIntegral power+{- | Parse a number as with 'parseNum', but return the result as+an 'Integral'. Any type such as Integer, Int, etc. can be used for the+result type.++This function simply calls 'round' on the result of 'parseNum'. A+'Double' is used internally for the parsing of the numeric component.++By using this function, a user can still say something like 1.5M and get an+integral result. -}+parseNumInt :: (Read a, Integral a) => + SizeOpts -- ^ Information on how to parse this data+ -> Bool -- ^ Whether to perform a case-insensitive match+ -> String -- ^ The string to parse+ -> Either String a+parseNumInt opts insensitive inp =+ case (parseNum opts insensitive inp)::Either String Double of+ Left x -> Left x+ Right n -> Right (round n)