LinearSplit 0.1 → 0.2

raw patch · 4 files changed

+66/−96 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/LinearSplit.hs +23/−45
• LinearSplit.cabal +2/−2
• examples/Splitter.hs +21/−9
• tests/Properties.hs +20/−40

@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveDataTypeable   #-}- -- | -- Module      :  Main -- Copyright   :  (c) Vitaliy Rukavishnikov, 2011@@ -21,50 +19,34 @@ --   module Data.LinearSplit (-    Item (..),-    Range (..),-    lPartition,-    ltPartition,-    gPartition+     Item (..)+    ,lPartition+    ,ltPartition+    ,gPartition ) where import Data.Array  import Data.List (nub, groupBy, inits)  -- | Representation of the work item data Item a b = Item {-   item :: a,       -- item id-   weight :: b      -- weight of the item-} deriving (Eq, Show, Ord)---- | Range of work items-data Range a b = Range {-   price :: b,      -- cost of the range-   low :: a,        -- first item of the range-   high :: a        -- last item of the range+   item :: a,       -- ^ item id+   weight :: b      -- ^ weight of the item } deriving (Eq, Show, Ord)  -- | The table cell to store the computed partitions data Cell b = Cell {-   cost :: b,       -- cost of the partition-   ind  :: Int      -- partition index in the work items+   cost :: b,       -- ^ cost of the partition+   ind  :: Int      -- ^ partition index in the work items } deriving (Eq, Show, Ord)  -- | Combine the consecutive items to decrease the space of the input merge :: (Ord b) => b -> Item a b -> Item a b -> Bool merge i x y = weight x <= i && weight y <= i --- | Create ranges-ranges :: (Ord b, Num b) => [[Item a b]] -> [Range a b]-ranges xss =  map mkRange xss where-   mkRange xs = Range (sum $ map weight xs) (item $ head xs) (item $ last xs)- -- | Partition the items based on the greedy algoritm-gPartition :: (Ord b, Num b) => ([Item a b] -> Bool) -> Int -> [Item a b] -> [Range a b]-gPartition fun n = ranges . gPartition' fun n --gPartition' :: ([Item a b] -> Bool) -> Int -> [Item a b] -> [[Item a b]] -gPartition' f n xs -  | n <= 0 = gPartition' f 1 xs+gPartition :: ([Item a b] -> Bool) -> Int -> [Item a b] -> [[Item a b]] +gPartition f n xs +  | n <= 0 = gPartition f 1 xs   | otherwise = go n xs f where     go _ [] _ = []     go 1 ys _ = [ys] @@ -74,18 +56,15 @@           rest = drop (length chunk) ys        in chunk : go (n-1) rest f --- | Partition items to minimize the maximum cost over all ranges-lPartition :: (Num b, Ord b) => Int -> [Item a b] -> [Range a b]-lPartition n = ranges . lPartition' n---- | Partition items with accumulating small items -ltPartition :: (Num b, Ord b) => Int -> [Item a b] -> b -> [Range a b]+-- | Partition items with accumulating items +ltPartition :: (Num b, Ord b) => Int -> [Item a b] -> b -> [[Item a b]] ltPartition n xs threshold =       unshrink $ lPartition n (shrink (merge threshold) xs) -lPartition' :: (Num b, Ord b) => Int -> [Item a b] -> [[Item a b]]-lPartition' size items -  | size <= 0 = lPartition' 1 items+-- | Partition items to minimize the maximum cost over all ranges+lPartition :: (Num b, Ord b) => Int -> [Item a b] -> [[Item a b]]+lPartition size items +  | size <= 0 = lPartition 1 items   | otherwise = slices dividers items where       dividers | noItems <= size = [0..noItems-1]                | otherwise = nub $ reverse $ cells size $ valOf noItems size@@ -118,14 +97,13 @@         ls = zip xs (tail (xs ++ [length items]))         slice (lo, hi) = take (hi-lo) $ drop lo items --- | Grouping the small items-shrink :: Num b => (Item a b -> Item a b -> Bool) -> [Item a b] -> [Item (a,a) b]+-- | Grouping the items+shrink :: Num b => (Item a b -> Item a b -> Bool) -> [Item a b] -> [Item [Item a b] b] shrink thr items = map mkItem' $ groupBy thr items where-  mkItem' xs = Item (lo xs, hi xs) $ sum $ map weight xs-  lo = item . head-  hi = item . last+  mkItem' xs = Item xs (sum $ map weight xs)  -- | Ungrouping the items-unshrink :: [Range (a,a) b] -> [Range a b]-unshrink = map (\(Range cost lo hi) -> Range cost (fst lo) (snd hi))+unshrink :: [[Item [Item a b] b]] -> [[Item a b]]+unshrink = map (concatMap item)+ 

@@ -1,9 +1,9 @@ Name:                LinearSplit-Version:             0.1+Version:             0.2 Synopsis:            Partition the sequence of items to the subsequences in the order given Description:         The LinearSplit module implements partitioning the sequence of items to the                       subsequences in the order given. The items can be splitted using greedy -                     heuristic or using linear partition algorithm to minimize the maximum cost+                     heuristic or using the linear partition algorithm to minimize the maximum cost                      over all ranges (see the 'The Algorithm Design Manual' by Steven S. Skiena..) License:             BSD3 License-File:        LICENSE

@@ -23,6 +23,13 @@ type NumRecords = Int type Account = Item AccountId NumRecords +-- | Range of accounts+data Range = Range {+   price :: NumRecords,     -- cost of the range+   low :: AccountId,        -- first item of the range+   high :: AccountId        -- last item of the range+} deriving (Eq, Show, Ord)+ -- / Splitter configuration parameters data Splitter = Splitter {   file_ :: FilePath,@@ -46,6 +53,11 @@     help "Partition the list of accounts into number of ranges for the parallel execution" &=     details [] +-- | Create ranges+--ranges :: (Ord b, Num b) => [[Item a b]] -> [Range a b]+ranges xss =  map mkRange xss where+   mkRange xs = Range (sum $ map weight xs) (item $ head xs) (item $ last xs)+ -- / Partitions algorithms optimal = ltPartition @@ -69,24 +81,24 @@   rows <- hGetContents inh   let items = map mkItem $ filter ((== 2).length) $ map words $ lines rows   let numRanges = numranges_ cnf-  +    when (optimal_ cnf) $ do     let threshold = threshold_ cnf-    let ranges = optimal numRanges items threshold-    display "Approximation Best" ranges+    let rs = ranges $ optimal numRanges items threshold+    display "Approximation Best" rs        when (greedy_ cnf) $ do   -    let ranges = greedy numRanges items-    display "Greedy" ranges+    let rs = ranges $ greedy numRanges items+    display "Greedy" rs       when (trivial_ cnf) $ do-    let ranges = trivial numRanges items-    display "Trivial" ranges-     +    let rs = ranges $ trivial numRanges items+    display "Trivial" rs+      hClose inh   -- | Display the results of the Splitter execution -display :: String -> [Range AccountId NumRecords] -> IO ()+display :: String -> [Range] -> IO () display title ranges = do    putStrLn $ "\n     " ++ title    t1 <- getCPUTime

@@ -3,7 +3,7 @@ module Main where  import Data.LinearSplit-import Test.QuickCheck+import Test.QuickCheck hiding (ranges) import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) @@ -35,8 +35,8 @@       let is = map mkItem $ zip [1..length ws] ws       return $ Split n is thr --- |-splitters (Split n xs t) = +-- | Different partition strategies to test+splitters (Split n xs t) = --map ranges    [lPartition n xs, ltPartition n xs t, byLength n xs, byAvgCost n xs]   where     byLength n xs = @@ -51,59 +51,39 @@ -- | Ensure that the sum of the items weights equals to  -- the total ranges costs  prop_totalCost s = -   let totalCosts = map (floor . sum . map price) (splitters s)+   let totalCosts = map (floor . sum . map rangeCost) (splitters s)        itemsCost = floor $ sum $ map weight (items s)    in all (== itemsCost) totalCosts  -- | The optimal algorithm has to produce the lowest partition cost prop_bestCost s =     let (n,xs) = (chunks s, items s)-       maxCost ys = foldr max 0.0 (map price ys)-       partitionCost = floor . maxCost         bestCost = partitionCost (lPartition (chunks s) (items s))-   in all (>= bestCost) (map partitionCost (splitters s))+   in all (>= bestCost) $ map partitionCost (splitters s)  -- | Ensure that the real number of ranges no more than required prop_numRanges = forAll (arbitrary :: Gen Split) $ \s ->-   all (<= (chunks s)) (map length (splitters s))+   all (<= chunks s) $ map length (splitters s) --- | Ensure that the splitting dividers are ordered as working items-prop_ordered s = -  let divs = map (foldr dividers []) (splitters s)-      dividers r xs = if low r == high r then low r : xs-                       else low r : (high r : xs)-   in all (ordered (map item (items s))) divs+-- | Ensure that the items after splitting the same as the items +-- before splitting+prop_equal s = +  let inpIds = map item (items s)+      outIds = concatMap (map item)+  in all (inpIds ==) (map outIds (splitters s))  -- | Reverse working items preserves the optimal cost prop_reverse s =   let (n,xs) = (chunks s, items s)-      maxCost ys = foldr max 0.0 (map price ys)-      partitionCost = floor . maxCost-  in partitionCost (lPartition n xs) == partitionCost (lPartition n (reverse xs))---- | Ensure that the ranges prices equal to the sum of weight corresponding--- work items-prop_rangeCost s =-  and [eqCost rs (items s) | rs <- splitters s] +  in partitionCost (lPartition n xs) == +     partitionCost (lPartition n (reverse xs))  -- | Testing helpers-ordered :: [Int] -> [Int] -> Bool-ordered [] [] = True-ordered (x:xs) (y:ys) -   | x == y = ordered xs ys-   | otherwise = ordered xs (y:ys)-ordered _ _ = False+--rangeCost :: [Item Int Double] -> Double+rangeCost = sum . map weight -eqCost :: [Range Int Double] -> [Item Int Double] -> Bool-eqCost [] [] = True-eqCost (Range p l h:xs) ys =-        let (ks,zs) = span (\(Item i _) -> i /= h) ys-            (ks',zs') = (ks ++ [head zs], tail zs)-        in and [(item . head) ks' == l-               ,(item . last) ks' == h-               ,floor (sum (map weight ks')) == floor p -               ,eqCost xs zs'-               ] +partitionCost = floor . maxCost where+   maxCost = foldr (max . rangeCost) 0.0  main :: IO () main = defaultMain tests@@ -111,9 +91,9 @@ tests :: [Test] tests =     [ testProperty "numRanges" prop_numRanges-    , testProperty "ordered" prop_ordered+    , testProperty "equal" prop_equal     , testProperty "reverse" prop_reverse     , testProperty "totalCost" prop_totalCost     , testProperty "bestCost" prop_bestCost-    , testProperty "rangeCost" prop_rangeCost     ]+