diff --git a/Data/LinearSplit.hs b/Data/LinearSplit.hs new file mode 100644 --- /dev/null +++ b/Data/LinearSplit.hs @@ -0,0 +1,131 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +-- | +-- Module : Main +-- Copyright : (c) Vitaliy Rukavishnikov, 2011 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : virukav@gmail.com +-- Stability : experimental +-- Portability : non-portable +-- +-- The LinearSplit module implements partitioning the sequence of items to the +-- subsequences in the order given. The next functions are exported: +-- a) gPartition - split the sequence of items items using greedy heuristic. +-- b) lPartition - split the sequence of items to minimize the maximum cost over +-- all the subsequences using linear partition algorithm +-- (see the 'The Algorithm Design Manual' by Steven S. Skiena..) +-- c) ltPartition - the approximation of the linear partition algorithm. +-- The large size of the work items space is decreased by +-- combining the consecutive items based on the threshold parameter. +-- + +module Data.LinearSplit ( + Item (..), + Range (..), + 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 +} 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 +} 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 + | otherwise = go n xs f where + go _ [] _ = [] + go 1 ys _ = [ys] + go n ys f = + let cands = dropWhile f ((tail . inits) ys) + chunk = if null cands then ys else head cands + 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] +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 + | otherwise = slices dividers items where + dividers | noItems <= size = [0..noItems-1] + | otherwise = nub $ reverse $ cells size $ valOf noItems size + + cells 1 cell = [0] + cells k cell = ind cell : cells (k-1) (valOf (ind cell) (k-1)) + + table = array ((1,1), (noItems, size)) + [ + ((m,n), cell m n) | + m <- [1..noItems], + n <- [1..size] + ] + + valOf m n + | m == 1 = Cell (weight $ itemsArr ! 1) 1 + | n == 1 = Cell (prefSums ! m) 1 + | otherwise = table ! (m,n) + + cell m n = foldr1 min $ map maxCost [1..m] where + maxCost x = Cell (max (curCost x) $ newCost x) x + curCost x = cost $ valOf x (n-1) + newCost x = prefSums ! m - prefSums ! x + + noItems = length items + itemsArr = listArray (1, noItems) items + prefSums = listArray (1, noItems) $ scanl1 (+) (map weight items) + + slices xs items = map slice ls where + 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] +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 + +-- | Ungrouping the items +unshrink :: [Range (a,a) b] -> [Range a b] +unshrink = map (\(Range cost lo hi) -> Range cost (fst lo) (snd hi)) + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2011, Vitaliy Rukavishnikov + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Vitaliy Rukavishnikov nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/LinearSplit.cabal b/LinearSplit.cabal new file mode 100644 --- /dev/null +++ b/LinearSplit.cabal @@ -0,0 +1,29 @@ +Name: LinearSplit +Version: 0.1 +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 + over all ranges (see the 'The Algorithm Design Manual' by Steven S. Skiena..) +License: BSD3 +License-File: LICENSE +Author: Vitaliy Rukavishnikov +Maintainer: virukav@gmail.com +Homepage: http://github.com/rukav/LinearSplit +Bug-Reports: mailto:virukav@gmail.com +Build-Type: Simple +Tested-with: GHC==6.12.3 +Category: Algorithms +Data-Dir: examples +Data-Files: test1.txt +Cabal-Version: >=1.2 +Extra-Source-Files: README, + examples/Splitter.hs, + tests/Properties.hs +Library + Exposed-Modules: Data.LinearSplit + Build-Depends: base >= 3.0.3.2 && < 5, + cmdargs >= 0.3, + array, + QuickCheck >= 1.2.0.1, + haskell98 diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,17 @@ +The LinearSplit module implements partitioning the sequence of items to the +subsequences in the order given. The next functions are provided: + gPartition - split the sequence of items items using greedy heuristic. + lPartition - split the sequence of items to minimize the maximum cost + over all the subsequences using linear partition algorithm + (see the 'The Algorithm Design Manual' by Steven S. Skiena..) + ltPartition - the approximation of the linear partition algorithm. + The large size of the work items space is decreased by + combining the consecutive items based on the threshold + parameter. +See examples/Splitter.hs for the usage help. + +For example, the next command will split the items in test1.txt on 5 ranges using +greedy heuristics and linear partition algorithm. +$ Splitter -f test1.txt -n -o -g -t500 -s5 + + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/examples/Splitter.hs b/examples/Splitter.hs new file mode 100644 --- /dev/null +++ b/examples/Splitter.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +-- | +-- Module : Main +-- Copyright : (c) Vitaliy Rkavishnikov, 2011 +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : virukav@gmail.com +-- Stability : experimental +-- Portability : non-portable + +-- Balance the work items accross processors to minimize the total elapsed time. +-- For help use ./Splitter --help + +module Main where +import System.IO +import System.CPUTime (getCPUTime) +import Control.Monad (when) +import System.Console.CmdArgs +import Data.LinearSplit + +type AccountId = Int +type NumRecords = Int +type Account = Item AccountId NumRecords + +-- / Splitter configuration parameters +data Splitter = Splitter { + file_ :: FilePath, + numranges_ :: Int, + greedy_ :: Bool, + trivial_ :: Bool, + optimal_ :: Bool, + threshold_ :: Int +} deriving (Show, Data, Typeable) + +splitter = cmdArgsMode $ Splitter + {file_ = def &= typFile &= help "Input file name. Format: " + ,numranges_ = def &= name "s" &= typ "Int" &= help "Number of ranges" + ,greedy_ = def &= name "g" &= help "Greedy algorithm based on the average cost of a partition" + ,trivial_ = def &= name "n" &= help "Greedy algorithm based on the average size of a partition" + ,optimal_ = def &= name "o" &= help "Approximate linear partition algorithm" + ,threshold_ = def &= help "Threshold to combine the consequtive weights" + } &= + program "Splitter" &= + summary "Splitter 0.1" &= + help "Partition the list of accounts into number of ranges for the parallel execution" &= + details [] + +-- / Partitions algorithms +optimal = ltPartition + +trivial n xs = gPartition fun n xs where + fit = length xs `div` n + fun ys = fit > length ys + +greedy n xs = gPartition fun n xs where + cost = sum . map weight + fit = cost xs `div` n + fun ys = fit > cost ys + +main :: IO () +main = do + cnf <- cmdArgsRun splitter + eval cnf + +eval :: Splitter -> IO () +eval cnf = do + inh <- openFile (file_ cnf) ReadMode + 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 + + when (greedy_ cnf) $ do + let ranges = greedy numRanges items + display "Greedy" ranges + + when (trivial_ cnf) $ do + let ranges = trivial numRanges items + display "Trivial" ranges + + hClose inh + +-- | Display the results of the Splitter execution +display :: String -> [Range AccountId NumRecords] -> IO () +display title ranges = do + putStrLn $ "\n " ++ title + t1 <- getCPUTime + mapM_ print ranges + t2 <- getCPUTime + print $ " Partition cost = " ++ show (foldr1 max ranges) + print $ " Time to execute = " ++ show (div (t2-t1) 1000000000) + +-- / Parse items +mkItem :: [String] -> Account +mkItem xs = Item (read $ head xs) (read $ (head . tail) xs) + + + + + diff --git a/examples/test1.txt b/examples/test1.txt new file mode 100644 --- /dev/null +++ b/examples/test1.txt @@ -0,0 +1,995 @@ +10008 52 +10114 88 +10274 56 +10302 99 +10321 33 +10332 52 +10502 748894 +10769 25 +10773 86 +10807 100 +10990 15 +11008 14813 +11012 99 +11138 45538 +11241 246722 +11310 805404 +11364 39 +11392 83 +11488 60 +11516 62088 +11568 1 +11646 5 +11771 59387 +11836 98 +11881 603742 +11907 72 +11948 75 +12024 27 +12132 22 +12212 37 +12221 50665 +12301 8 +12303 11052 +12482 30298 +12685 58 +12706 29 +12830 147611 +13052 70028 +13196 36249 +13272 50 +13391 42 +13552 32 +13555 83 +13588 57 +13675 394278 +13717 83 +13921 64 +13960 82 +14010 63 +14227 976995 +14236 3 +14312 11 +14527 62 +14645 36 +14677 89 +14714 138710 +14729 11 +14736 61 +14871 11 +15135 16 +15152 539688 +15221 100 +15258 44 +15323 77 +15492 44537 +15560 54 +15693 74 +15718 13 +15794 2 +15834 25 +15890 99 +15978 33 +16317 36 +16388 91 +16410 7 +16424 95 +16463 9 +16514 7399 +16515 96 +16531 93 +16655 9 +16841 95 +16850 63 +16899 85 +16939 27 +16975 87 +17123 33023 +17661 59 +17719 765039 +17857 710594 +18053 31 +18077 49 +18117 4 +18155 96 +18164 49 +18181 92 +18494 97 +18498 446288 +18533 4 +18589 78 +18679 887684 +18685 46 +18762 94 +18793 31 +18812 32 +18827 13 +18915 68 +19243 88098 +19305 67 +19461 28497 +19577 693804 +19678 92 +19682 45 +20265 581259 +20360 78 +20651 96 +20664 81 +20780 952990 +20806 91 +20823 35 +20958 74 +20987 92 +21054 50 +21077 1 +21136 43 +21145 41854 +21169 98 +21239 15 +21304 42 +21543 78 +21667 27 +21749 158873 +21817 50 +22005 81 +22013 4 +22092 51966 +22201 91 +22288 95 +22333 27 +22335 19 +22473 38 +22644 529766 +22653 17 +22656 20 +22751 24 +22760 53302 +22762 2 +22884 16 +22923 28 +23037 80 +23197 41560 +23224 548105 +23250 27 +23424 23 +23569 62841 +23639 62 +23666 94 +23706 66 +23805 98 +23947 868608 +23959 24711 +24087 84 +24322 92 +24326 2 +24345 82 +24425 52 +24632 3 +24640 977531 +25089 93 +25140 60 +25143 50 +25160 28 +25209 934961 +25443 80616 +25712 130114 +26141 421698 +26286 42 +26395 53 +26406 57 +26481 57827 +26615 19495 +26647 66 +26907 340479 +26943 83787 +26968 36 +27052 42963 +27068 58 +27077 87 +27260 42 +27272 100 +27628 75 +27642 77346 +27679 13452 +27807 1 +28064 21732 +28079 57 +28148 21 +28229 73 +28234 53 +28640 361023 +28773 25 +28901 42 +29087 91 +29121 172792 +29179 65 +29474 62 +29702 53 +29829 684839 +29876 72 +30493 74 +30516 63 +30522 69 +30546 78 +30610 34 +30686 155350 +30719 25 +30928 27 +31085 88180 +31136 10 +31202 58 +31516 7668 +31817 80 +31916 25 +31971 386473 +32003 88205 +32164 2038 +32188 67 +32317 748006 +32325 12 +32472 299727 +32591 12 +32600 10 +32622 21 +32658 33 +32789 85 +32804 83 +32918 40925 +32963 3 +33027 33 +33205 21 +33265 71261 +33324 37 +33446 879745 +33456 696077 +33459 58 +33625 81 +33696 53 +33756 56092 +33884 381468 +34024 31 +34029 31 +34099 12959 +34151 12 +34385 61461 +34393 73461 +34740 82 +34741 28 +34954 99 +34963 96584 +35009 92 +35102 13 +35128 96 +35167 70 +35181 11 +35465 81 +35492 22945 +35578 100 +35715 40 +35756 482772 +35787 63 +35898 46 +36034 93 +36119 92 +36207 622407 +36225 58 +36252 52 +36284 31 +36300 40673 +36349 188398 +36362 53 +36403 100 +36585 36 +36671 97 +36687 98608 +36688 276486 +36766 26 +36789 99 +36848 82 +36926 19758 +37036 52 +37039 15 +37258 21 +37281 391026 +37418 40 +37582 100 +37598 16063 +37612 663616 +37625 54035 +37673 69 +37812 49385 +37883 41 +37914 679694 +37980 96 +38034 543383 +38220 84 +38279 16 +38285 61 +38345 69 +38598 329392 +38670 468043 +38765 605792 +38930 638081 +38980 94 +39046 43 +39083 57 +39184 75 +39434 91 +39438 71412 +39441 13 +39568 88425 +39654 51 +39758 82093 +39862 81 +39968 89 +40021 34660 +40134 71 +40136 85 +40209 933232 +40306 39 +40325 15 +40349 74 +40400 393221 +40464 443003 +40505 58 +40619 104 +40789 5 +40819 54 +40903 1 +40957 943784 +41044 829939 +41056 41 +41350 161980 +41355 10 +41484 61 +41588 72 +41635 17 +41664 70153 +41665 72968 +41826 6 +41877 668008 +41892 93643 +41895 2 +41910 526254 +41912 10 +42032 95968 +42105 288151 +42253 67 +42268 14 +42283 907962 +42473 83 +42596 23904 +42613 80 +42685 60 +42999 70 +43063 32606 +43107 874250 +43134 40 +43158 61 +43255 45139 +43289 54 +43335 151075 +43485 393711 +43506 70814 +43605 7 +43634 87289 +43772 20 +43967 10 +44110 85 +44164 81 +44196 70 +44198 22 +44288 68833 +44410 98 +44411 79 +44464 37 +44562 89 +44702 94 +44736 19 +44770 12 +44919 12 +44948 28 +45127 23 +45462 26 +45484 72 +45583 57783 +45628 16 +45694 63 +45795 2 +45837 84 +46055 45 +46083 89320 +46089 37 +46091 48 +46134 40 +46157 20079 +46239 21 +46241 16599 +46306 88 +46392 193330 +46482 56 +46668 84 +46761 58 +47022 94770 +47120 77 +47270 92 +47334 50 +47344 10 +47376 51 +47404 97 +47424 7248 +47451 32 +47452 14 +47498 97 +47526 16 +47576 855708 +47617 74094 +47643 37 +47662 68 +47679 37 +47720 16 +47802 83 +47832 15 +47836 304343 +47882 49 +48133 530165 +48169 74 +48371 67 +48373 85839 +48441 779624 +48442 41 +48654 72 +48920 159857 +49075 47 +49081 16 +49179 54204 +49208 97 +49225 92 +49383 53149 +49395 76 +49443 92 +49452 28 +49556 29 +49745 56 +49909 143693 +49976 100 +50193 10 +50248 230820 +50333 23 +50351 4 +50491 80 +50547 44 +50620 81 +50714 20 +50735 79 +50955 46363 +50957 41 +51170 76 +51224 88 +51272 4 +51410 46 +51495 25 +51656 43 +51757 89 +51847 72 +51911 1355 +52354 14 +52377 10505 +52392 3 +52538 98 +52618 27 +52827 64 +52830 24 +52884 47 +52899 51 +52918 93 +52997 51 +53144 89969 +53381 6 +53382 83 +53414 31 +53415 13 +53449 77 +53540 93 +53542 75 +53564 6 +53588 32762 +53659 64 +53776 30 +53820 73 +53905 37 +54050 92 +54141 88 +54371 94 +54414 40727 +54492 29 +54511 83 +54576 93 +54835 93 +54872 76056 +55016 874345 +55233 15285 +55247 74 +55248 83 +55250 289988 +55483 489833 +55523 733473 +55631 70879 +55869 26 +55920 27 +55938 73 +56056 29 +56171 54 +56221 22 +56469 28 +56574 54603 +56684 62 +56924 63 +56950 56 +57080 51 +57171 66 +57232 85 +57279 79 +57694 19586 +57741 13 +57776 17483 +57837 536171 +57846 24 +57862 96 +57945 64 +58058 80 +58061 96 +58383 76 +58629 448524 +58834 66 +58897 82 +58900 85 +58943 51 +59028 52 +59153 597813 +59166 775825 +59368 22 +59570 721811 +59780 17878 +59842 67 +60087 49 +60173 12 +60197 24 +60276 28 +60396 38710 +60444 19116 +60577 15 +60618 553603 +60636 100 +60779 55853 +60914 14 +60932 65 +60962 87551 +61268 13 +61283 88 +61314 132786 +61401 984013 +61447 76 +61596 71 +61705 43 +61709 87 +61846 2573 +61925 733985 +62078 274552 +62277 903664 +62325 60 +62383 61 +62436 65 +62443 40864 +62685 25 +62719 91 +62738 39 +62943 88 +63067 1 +63091 79828 +63157 22 +63242 610519 +63276 2 +63316 44 +63438 33999 +63550 9 +63683 78 +63707 45316 +63972 33 +64177 411779 +64214 96 +64340 898243 +64499 54 +64711 33 +64756 73 +64871 11 +64902 24 +64956 80 +64963 22 +64976 89 +65233 34 +65237 133381 +65285 86331 +65722 18 +65801 33 +65929 40 +65979 11761 +66495 27910 +66513 37 +66565 42841 +66600 44 +66687 7 +66957 3 +67081 100 +67098 53 +67120 29 +67142 100 +67394 866639 +67419 8 +67476 2604 +67719 91 +67827 50 +67863 83 +67918 41 +67955 31249 +68163 63 +68240 20 +68274 27 +68317 66 +68341 84 +68350 46 +68485 4 +68712 8 +68717 28 +68809 793419 +69010 66 +69085 633176 +69308 51 +69362 428485 +69402 31 +69543 20 +69600 21 +69666 62563 +69792 851240 +69813 418663 +69873 97 +70063 28 +70083 82 +70088 51 +70118 63972 +70176 37 +70194 277350 +70282 71 +70500 22 +70556 47 +70789 99901 +70913 68 +70925 86 +70997 60 +71037 8 +71091 85 +71268 11 +71334 14 +71365 92565 +71378 74 +71404 57 +71456 85208 +71642 74079 +71715 88 +71817 50 +71826 83 +71832 1 +71850 58 +71889 96 +71926 816789 +72042 3 +72127 4173 +72368 41 +72396 86 +72457 64746 +72622 44 +72636 50 +72739 8 +72750 38 +72773 254059 +72885 98 +72890 31 +72986 72 +73171 9 +73267 50228 +73278 2253 +73529 45 +73537 5706 +73557 31 +73772 1 +73792 38 +73843 99 +73850 23986 +73960 37 +73983 61262 +74036 75 +74126 45 +74149 11 +74197 50 +74391 43 +74536 14709 +74956 67882 +74971 53 +75117 518532 +75444 960911 +75492 831066 +75613 45 +75638 38 +75699 6935 +75921 3 +76090 90 +76250 96 +76333 73 +76416 54 +76747 28 +76803 48775 +76819 113545 +76889 47 +76896 90 +76952 14 +77083 14 +77174 45 +77253 27 +77266 21 +77273 47 +77374 43 +77375 97 +77517 43 +77569 402549 +77594 79 +77643 64 +77646 44 +78025 6568 +78069 24873 +78118 240755 +78145 30 +78173 37 +78177 21 +78249 7018 +78270 47 +78286 76 +78294 32 +78351 6 +78503 100 +78548 97413 +78597 48 +78793 4 +78923 63 +79116 31 +79305 39 +79396 540438 +79437 63 +79499 779091 +79739 88 +79762 98 +79763 99 +79866 40 +80141 55 +80212 566906 +80256 75 +80439 76 +80482 94 +80596 254341 +80633 51434 +80920 81 +81068 620939 +81110 45 +81160 923139 +81209 100 +81221 19 +81254 729507 +81296 50 +81398 851196 +81477 46 +81492 304214 +81503 72215 +81703 96397 +81761 22 +81785 66 +81925 71 +82113 67433 +82221 51660 +82349 81 +82415 5 +82501 36135 +82611 818800 +82621 964057 +82644 647799 +82771 21 +82820 78 +83287 63 +83373 77 +83394 55 +83455 90 +83597 9 +83674 19403 +83821 50 +83833 87 +83877 24 +83880 40 +84008 508997 +84013 13 +84241 64 +84463 3 +84635 22 +84739 30 +84757 14773 +84840 69 +84842 856575 +84918 813449 +85072 289538 +85241 6 +85305 32 +85628 66 +85641 90 +85752 46 +85855 60 +85959 22 +86102 3 +86137 71 +86243 58 +86259 2 +86286 30 +86337 18349 +86405 548956 +86424 50 +86457 70 +86484 94 +86492 22 +86548 31871 +86591 54 +86618 88 +86665 87 +86762 45 +86883 6 +87166 91 +87444 34 +87461 80481 +87479 58 +87640 85 +87644 677071 +87687 55 +87738 232965 +87766 41 +87778 31 +87948 70 +88015 61 +88022 75 +88344 80 +88445 50 +88534 79 +88580 27 +88603 52 +88671 12 +88906 33 +88937 83 +89053 2 +89097 56 +89131 37011 +89155 47 +89276 82 +89285 15 +89627 51 +89633 4 +89819 5 +89903 598537 +90010 72744 +90213 39 +90249 75 +90284 52 +90467 94 +90580 824690 +90688 33 +90766 161500 +90796 297782 +90910 17 +90955 14 +90971 4 +91151 13 +91500 10 +91640 84 +91686 26 +91898 69 +91970 808070 +92001 69 +92095 57 +92132 57 +92148 80 +92224 21 +92344 62 +92501 14 +92648 55 +92667 26 +92763 589 +92786 79 +92959 66 +92979 192558 +92980 22 +93009 36 +93060 976326 +93211 552658 +93227 180003 +93465 45 +93481 73 +93627 93 +93639 71512 +93644 882402 +93885 90034 +93886 72 +94161 12 +94456 14 +94530 147899 +94655 76 +94677 17 +94781 111467 +94854 390399 +94937 48 +94970 189751 +94997 31 +95016 16 +95161 398210 +95273 943397 +95400 59 +95433 16 +95613 65 +95783 93 +95785 43 +95880 47700 +95887 14 +95894 39 +96116 68 +96142 45691 +96156 20780 +96172 850881 +96227 79 +96255 71 +96298 73 +96368 80 +96634 6665 +96663 91 +96667 29 +96692 712793 +96755 21 +96812 95 +96905 9 +96976 29 +97102 478379 +97201 861132 +97309 38 +97428 92 +97464 12 +97480 46 +97518 13 +97557 18405 +97577 79 +97607 82 +97720 36 +98258 16 +98297 51088 +98395 67 +98509 35 +98667 18 +98716 4 +98776 97 +98799 69683 +98849 96304 +99005 327169 +99008 26 +99020 39 +99064 70 +99084 53 +99101 89 +99105 57 +99193 18508 +99384 10 +99409 33 +99441 232166 +99461 7 +99503 60 +99927 39 +99955 39 diff --git a/tests/Properties.hs b/tests/Properties.hs new file mode 100644 --- /dev/null +++ b/tests/Properties.hs @@ -0,0 +1,119 @@ +-- | Tests for the Utils.LinearSplit module. + +module Main where + +import Data.LinearSplit +import Test.QuickCheck +import Test.Framework (Test, defaultMain, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) + +-- | A datatype to model the generation the arbitrary splitting processers. +-- There are the restrictions to items of type Item Int Double +data Split = Split { + chunks :: Int, + items :: [Item Int Double], + threshold :: Double +} deriving (Show) + +-- | A datatype to generate a positive item weight. The weight +-- is restricted to the arbitrary values from 0.0 to 1000000.0 +data Weight = W { + unW :: Double +} + +instance Arbitrary Weight where + arbitrary = do + w <- choose (0.0, 1000000.0) + return $ W w + +instance Arbitrary Split where + arbitrary = do + n <- choose (1,25) :: Gen Int + ws <- arbitrary :: Gen [Weight] + thr <- choose (0.0, 10000.0) :: Gen Double + let mkItem (id, W w) = Item id w + let is = map mkItem $ zip [1..length ws] ws + return $ Split n is thr + +-- | +splitters (Split n xs t) = + [lPartition n xs, ltPartition n xs t, byLength n xs, byAvgCost n xs] + where + byLength n xs = + let fit = length xs `div` n + fun ys = fit > length ys + in gPartition fun n xs + byAvgCost n xs = + let fit = (sum . map weight) xs / fromIntegral n + fun ys = fit > (sum . map weight) ys + in gPartition fun n xs + +-- | 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) + 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)) + +-- | 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)) + +-- | 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 + +-- | 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] + +-- | 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 + +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' + ] + +main :: IO () +main = defaultMain tests + +tests :: [Test] +tests = + [ testProperty "numRanges" prop_numRanges + , testProperty "ordered" prop_ordered + , testProperty "reverse" prop_reverse + , testProperty "totalCost" prop_totalCost + , testProperty "bestCost" prop_bestCost + , testProperty "rangeCost" prop_rangeCost + ]