LinearSplit (empty) → 0.1

raw patch · 8 files changed

+1428/−0 lines, 8 filesdep +QuickCheckdep +arraydep +basesetup-changed

Dependencies added: QuickCheck, array, base, cmdargs, haskell98

Files

Data/LinearSplit.hs +131/−0
LICENSE +30/−0
LinearSplit.cabal +29/−0
README +17/−0
Setup.hs +2/−0
examples/Splitter.hs +105/−0
examples/test1.txt +995/−0
tests/Properties.hs +119/−0

+ Data/LinearSplit.hs view

@@ -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))+

+ LICENSE view

@@ -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.

+ LinearSplit.cabal view

@@ -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

+ README view

@@ -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++

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ examples/Splitter.hs view

@@ -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:  <account> <weight> <eol>"+    ,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)+++++

+ examples/test1.txt view

@@ -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

+ tests/Properties.hs view

@@ -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+    ]