diff --git a/app/Main.hs b/app/Main.hs index ffaf4fe..11dea57 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -3,13 +3,15 @@ module Main (main) where import Prelude hiding (String) import Control.Monad (forM_, replicateM_) +import Data.Data (Proxy (..)) import Data.Word (Word8) import System.IO (hFlush, stdout) import MCSP.Data.String (String) import MCSP.System.Random (Random, generate, uniformR) -import MCSP.TestLib.Heuristics (csvHeader, heuristics, measure, toCsvRow) +import MCSP.TestLib.Heuristics (Measured, heuristics, measure) import MCSP.TestLib.Sample (ShuffleMethod (..), SimpleEnum, StringParameters (..), randomPairWith) +import MCSP.Text.CSV (headers, row) randomPair :: SimpleEnum a => Random (String a, String a) randomPair = do @@ -26,11 +28,11 @@ randomPair = do main :: IO () main = do - putLn csvHeader + putLn $ headers (Proxy @Measured) replicateM_ 10_000 $ do pair <- generate randomPair forM_ heuristics $ \heuristc -> do result <- measure @Word8 heuristc pair - putLn $ toCsvRow result + putLn $ row result where putLn line = putStrLn line >> hFlush stdout diff --git a/bench/blocks/Bench.hs b/bench/blocks/Bench.hs index 1d352bc..8eb9835 100644 --- a/bench/blocks/Bench.hs +++ b/bench/blocks/Bench.hs @@ -4,6 +4,7 @@ module Main (main) where import Prelude import Control.Monad (forM_) +import Data.Data (Proxy (..)) import Data.Time.Clock.System (SystemTime (..), getSystemTime) import Data.Vector qualified as V (Vector) import Data.Vector.Generic qualified as G @@ -21,18 +22,9 @@ import MCSP.Data.Pair (both, ($:)) import MCSP.System.Path (createDirectory, getCurrentTimestamp, packageRoot, (<.>), ()) import MCSP.System.Random (generate) import MCSP.System.Statistics (absolute, cl99, confidenceInterval, sampleCI) -import MCSP.TestLib.Heuristics ( - Debug, - Measured, - NamedHeuristic, - blocks, - csvHeader, - heuristics, - measure, - score, - toCsvRow, - ) +import MCSP.TestLib.Heuristics (Debug, Measured, NamedHeuristic, blocks, heuristics, measure, score) import MCSP.TestLib.Sample (SimpleEnum, StringParameters, benchParams, randomPairWith, repr) +import MCSP.Text.CSV (headers, row) -- ---------------- -- -- Benchmark Limits -- @@ -197,13 +189,14 @@ measuring params heuristic = generate (randomPairWith params) >>= measure heuris -- | Writes the measured information in CSV format and returns it unchanged. writeCsv :: PutStrLn -> Measured -> IO Measured -writeCsv writeLn result = writeLn (toCsvRow result) >> pure result +writeCsv writeLn result = writeLn (row result) >> pure result -- | Run a matrix of benchmarks for each parameter set and heuristic, writing output and results to -- the with the input writers. report :: PutStrLn -> PutStrLn -> IO () -report printLn putRow = putRow csvHeader >> forM_ benchParams (forM_ heuristics . run) +report printLn putRow = putRow csvHeaders >> forM_ benchParams (forM_ heuristics . run) where + csvHeaders = headers (Proxy @Measured) run params heuristic = do printLn $ "benchmarking " ++ repr params ++ "/" ++ fst heuristic -- run benchmark and analyse results diff --git a/package.yaml b/package.yaml index fcbc5c1..8fc5f5e 100644 --- a/package.yaml +++ b/package.yaml @@ -96,7 +96,6 @@ internal-libraries: - MCSP.System.TimeIt - MCSP.TestLib.Heuristics - MCSP.TestLib.Heuristics.Safe - - MCSP.TestLib.Heuristics.TH - MCSP.TestLib.Random - MCSP.TestLib.Sample - MCSP.Text.CSV diff --git a/test/lib/MCSP/TestLib/Heuristics.hs b/test/lib/MCSP/TestLib/Heuristics.hs index 2762911..8a32b3f 100644 --- a/test/lib/MCSP/TestLib/Heuristics.hs +++ b/test/lib/MCSP/TestLib/Heuristics.hs @@ -1,19 +1,19 @@ -- | Tools for testing heuristics. module MCSP.TestLib.Heuristics ( + -- * Standard Heuristics Debug, Heuristic, NamedHeuristic, heuristics, + + -- * Measuring Heuristic input and output Measured (..), measure, - csvHeader, - toCsvRow, ) where import Prelude hiding (String, lookup) import Control.DeepSeq (NFData (..)) -import Data.List (intercalate) import Data.Maybe (fromMaybe) import Data.String qualified as Text import Data.Vector.Generic qualified as Vector (length) @@ -23,14 +23,15 @@ import Safe.Foldable (maximumBound) import MCSP.Data.MatchingGraph (edgeSet) import MCSP.Data.Meta (lookup, (<::)) -import MCSP.Data.Pair (Pair, both, second) +import MCSP.Data.Pair (Pair, both) import MCSP.Data.String (String) import MCSP.Data.String.Extra (occurrences, repeated, singletons) import MCSP.Heuristics (Heuristic, UseSingletons (..), combine, greedy, pso) import MCSP.Heuristics.PSOBased (PSOCombine (..), PSOPure (..), getFirstBestIter) import MCSP.System.TimeIt (timeIt) import MCSP.TestLib.Heuristics.Safe (Debug, checkedDiv, checkedLen, runChecked) -import MCSP.TestLib.Heuristics.TH (mkNamed) +import MCSP.Text.CSV (CSVData (..), mkColumn, readColumn, readColumnWith, strColumn) +import MCSP.Text.ReadP (eof, readP, (<++)) -- | The heuristic with its defined name. type NamedHeuristic a = (Text.String, Heuristic a) @@ -129,51 +130,36 @@ measure (name, heuristic) pair = do pair = show pair } --- | A list of pairs @(columnName, showColumn)@ used to construct the CSV for `Measured`. --- --- >>> map fst csvColumns --- ["size","repeats","singles","heuristic","blocks","score","time","left","right"] -csvColumns :: [(Text.String, Measured -> Text.String)] -csvColumns = - [ second (showColumn 3 show) $(mkNamed 'size), - second (showColumn 2 show) $(mkNamed 'repeats), - second (showColumn 2 show) $(mkNamed 'singles), - second (showColumn 3 show) $(mkNamed 'maxRepeat), - second (showColumn 3 show) $(mkNamed 'edges), - second (showColumn 3 (maybe "" show)) $(mkNamed 'psoIter), - second (showColumn 8 id) $(mkNamed 'heuristic), - second (showColumn 3 show) $(mkNamed 'blocks), - second (showColumn 4 (showDP 2)) $(mkNamed 'score), - second (showColumn 8 (showDP 3)) $(mkNamed 'time), - second (showColumn 0 show) $(mkNamed 'left), - second (showColumn 0 show) $(mkNamed 'right), - second (showColumn 0 show) $(mkNamed 'pair) - ] - --- Compose a function that show a value with one that extracts that value from a measurement. --- --- Also has a parameter for padding the resulting text if it is too short. --- --- >>> showColumn 10 show id 12 --- " 12" -showColumn :: Int -> (b -> Text.String) -> (a -> b) -> (a -> Text.String) -showColumn minWidth showIt = ((padLeft . showIt) .) - where - padLeft str = replicate (minWidth - length str) ' ' ++ str - --- | The CSV header for the columns of `Measured`. --- --- >>> csvHeader --- "size,repeats,singles,heuristic,blocks,score,time,left,right" -csvHeader :: Text.String -csvHeader = intercalate "," (map fst csvColumns) - --- | The CSV row representing the values of a `Measured`. --- --- >>> result <- measure $(mkNamed 'combine) ("abcd", "cdab") --- >>> toCsvRow result --- " 4, 0, 4, combine, 2,0.67, 0.000,\"[ab,cd]\",\"[cd,ab]\"" -toCsvRow :: Measured -> Text.String -toCsvRow measured = intercalate "," (map getValue csvColumns) - where - getValue (_, showIt) = showIt measured +instance CSVData Measured where + writer = + $$(mkColumn [||size||] 3 [||show||]) + <> $$(mkColumn [||repeats||] 2 [||show||]) + <> $$(mkColumn [||singles||] 2 [||show||]) + <> $$(mkColumn [||maxRepeat||] 3 [||show||]) + <> $$(mkColumn [||edges||] 3 [||show||]) + <> $$(mkColumn [||psoIter||] 3 [||maybe "" show||]) + <> $$(mkColumn [||heuristic||] 8 [||id||]) + <> $$(mkColumn [||blocks||] 3 [||show||]) + <> $$(mkColumn [||score||] 4 [||showDP 2||]) + <> $$(mkColumn [||time||] 8 [||showDP 3||]) + <> $$(mkColumn [||left||] 0 [||id||]) + <> $$(mkColumn [||right||] 0 [||id||]) + <> $$(mkColumn [||pair||] 0 [||id||]) + parser = do + heuristic <- strColumn "heuristic" + blocks <- readColumn "blocks" + size <- readColumn "size" + score <- readColumn "score" + time <- readColumn "time" + singles <- readColumn "singles" + repeats <- readColumn "repeats" + maxRepeat <- readColumn "maxRepeat" + edges <- readColumn "edges" + psoIter <- readColumnWith "psoIter" (readNothing <++ readJust) + left <- strColumn "left" + right <- strColumn "right" + pair <- strColumn "pair" + pure Measured {..} + where + readNothing = eof >> pure Nothing + readJust = Just <$> readP diff --git a/test/lib/MCSP/TestLib/Heuristics/TH.hs b/test/lib/MCSP/TestLib/Heuristics/TH.hs deleted file mode 100644 index bfc7e21..0000000 --- a/test/lib/MCSP/TestLib/Heuristics/TH.hs +++ /dev/null @@ -1,87 +0,0 @@ --- | Template to extract name and value of a list of items. -module MCSP.TestLib.Heuristics.TH ( - mkNamed, - mkNamedList, -) where - -import Control.Applicative (pure) -import Control.Monad (fail) -import Data.Bool (not, otherwise) -import Data.Foldable (foldl') -import Data.Function (flip, ($), (.)) -import Data.List (map, null, (++)) -import Data.Maybe (fromMaybe, isJust) -import Data.Monoid (mempty) -import Data.String qualified as Text -import Text.Show (show) - -import Data.Map.Strict (alter, filter, keysSet) -import Data.Set (Set, member, singleton) - -import Language.Haskell.TH (ExpQ, Name, Q, listE, nameBase, nameModule, varE) - --- | The set of all `nameBase` in a collection of names that appear only once. --- --- >>> import Data.Map (Map) --- >>> import Data.Set (Set) --- >>> uniqueBase [''Map, ''Set] --- fromList ["Map","Set"] --- --- >>> import Data.Map.Strict (Map) --- >>> uniqueBase [''Data.Map.Map, ''Data.Map.Strict.Map] --- fromList [] -uniqueBase :: [Name] -> Set Text.String -uniqueBase = keysSet . filter not . repeated . map nameBase - where - increment v = pure (isJust v) - repeated = foldl' (flip $ alter increment) mempty - --- | `nameBase` or fully qualified name for an item, depending if it is in the @uniq@ or not. --- --- >>> import Language.Haskell.TH (runQ) --- >>> import Data.Map.Lazy (Map) --- >>> import Data.Map.Strict (Map) --- >>> import Data.Set (Set) --- >>> names = uniqueBase [''Data.Map.Lazy.Map, ''Data.Map.Strict.Map, ''Data.Set.Set] --- >>> runQ (getUnambiguous names ''Data.Map.Lazy.Map) --- "Data.Map.Internal.Map" --- --- >>> runQ (getUnambiguous names ''Data.Set.Set) --- "Set" -getUnambiguous :: Set Text.String -> Name -> Q Text.String -getUnambiguous uniq name - | base `member` uniq = pure base - | not (null mod) = pure (mod ++ "." ++ base) - | otherwise = fail (show name ++ " cannot be resolved to a unique name") - where - base = nameBase name - mod = fromMaybe "" (nameModule name) - --- | Create an expression that evaluates to @(name, value)@ for the given named item, considering --- the set of unique base names. --- --- >>> (x, y) = (2, 3) --- >>> names = uniqueBase ['x] --- >>> $(mkNamedWith names 'x) --- ("x",2) -mkNamedWith :: Set Text.String -> Name -> ExpQ -mkNamedWith uniq name = do - uniqName <- getUnambiguous uniq name - [e|(uniqName, $(varE name))|] - --- | Maps a list of items to pairs @(name, value)@. --- --- >>> import Data.Int (Int) --- >>> (x, y) = (2, 3) --- >>> $(mkNamedList ['x, 'y]) :: [(Text.String, Int)] --- [("x",2),("y",3)] -mkNamedList :: [Name] -> ExpQ -mkNamedList names = listE (map (mkNamedWith (uniqueBase names)) names) - --- | Create an expression that evaluates to @(name, value)@ for the given named item. --- --- >>> someVal = 12 --- >>> $(mkNamed 'someVal) --- ("someVal",12) -mkNamed :: Name -> ExpQ -mkNamed name = mkNamedWith (singleton (nameBase name)) name