module Main where import Game.Mastermind (Eval(Eval), matching) import qualified Game.Mastermind.CodeSet.Tree as CodeSetTree import qualified Game.Mastermind.CodeSet.Union as CodeSetUnion import qualified Game.Mastermind.CodeSet as CodeSet import Criterion.Main (Benchmark, defaultMain, bgroup, bench, whnf) import qualified Data.NonEmpty as NonEmpty import qualified Data.Set as Set import Data.NonEmpty ((!:)) import Data.Set (Set) import Data.Tuple.HT (mapSnd) alphabet, digits :: Set Char alphabet = Set.fromList ['a'..'z'] digits = Set.fromList ['0'..'9'] type List1 = NonEmpty.T [] type List2 = NonEmpty.T List1 gamesWords, gamesNumbers :: [List2 (String, Eval)] gamesWords = [ ("flq", Eval 0 0) !: ("chx", Eval 0 0) !: ("sez", Eval 2 0) : ("aes", Eval 1 1) : ("bde", Eval 0 1) : ("gij", Eval 0 0) : ("kmn", Eval 0 0) : ("opr", Eval 0 0) : ("tuv", Eval 0 1) : ("set", Eval 3 0) : [], ("ncqy", Eval 0 1) !: ("yxcl", Eval 0 0) !: ("ikjn", Eval 0 2) : ("dnoj", Eval 0 2) : ("jbnz", Eval 1 0) : ("ofnk", Eval 1 0) : ("adni", Eval 1 2) : ("eghm", Eval 0 1) : ("gaah", Eval 0 0) : ("mind", Eval 4 0) : [], ("ozdtp", Eval 0 1) !: ("cxgkz", Eval 1 1) !: ("gbqvz", Eval 0 1) : ("ctdng", Eval 0 2) : ("dwghk", Eval 1 0) : ("sygpc", Eval 2 0) : ("gogfm", Eval 2 0) : ("ploir", Eval 1 2) : ("logic", Eval 5 0) : [], ("tynrsu", Eval 0 3) !: ("msycnl", Eval 1 1) !: ("uslher", Eval 2 1) : ("pceeyr", Eval 1 1) : ("psugen", Eval 1 1) : ("kscdur", Eval 1 1) : ("zwghob", Eval 0 0) : ("masafa", Eval 3 0) : ("master", Eval 6 0) : [] ] gamesNumbers = [ ("092", Eval 1 0) !: ("009", Eval 2 0) !: ("130", Eval 0 1) : ("456", Eval 0 0) : ("007", Eval 3 0) : [], ("7483", Eval 0 0) !: ("2066", Eval 2 0) !: ("0106", Eval 0 2) : ("2501", Eval 1 2) : ("2012", Eval 3 0) : ("2019", Eval 4 0) : [], ("04575", Eval 1 1) !: ("43465", Eval 0 3) !: ("32556", Eval 2 2) : ("16553", Eval 1 3) : ("58536", Eval 3 1) : ("65536", Eval 5 0) : [], ("899820", Eval 1 1) !: ("872456", Eval 2 3) !: ("256296", Eval 0 2) : ("142857", Eval 5 0) : [] ] addWidth :: NonEmpty.T f ([a], b) -> (Int, NonEmpty.T f ([a], b)) addWidth xs = (length $ fst $ NonEmpty.head xs, xs) singleBench :: (CodeSet.C set) => (set Char -> Integer) -> Set Char -> (Int, List1 (String, Eval)) -> Benchmark singleBench setSize symbols (width, xs) = bench (show width) $ whnf (setSize . CodeSet.intersections . fmap (uncurry (matching symbols))) xs benchWordsAndNumbers :: (CodeSet.C set) => (set Char -> Integer) -> (List2 (String, Eval) -> List1 (String, Eval)) -> [Benchmark] benchWordsAndNumbers setSize cut = bgroup "words" (map (singleBench setSize alphabet . mapSnd cut . addWidth) gamesWords) : bgroup "numbers" (map (singleBench setSize digits . mapSnd cut . addWidth) gamesNumbers) : [] benchCodeSets :: (CodeSet.C set) => (set Char -> Integer) -> [Benchmark] benchCodeSets setSize = bgroup "3 evaluations" (benchWordsAndNumbers setSize (NonEmpty.mapTail (take 2) . NonEmpty.flatten)) : bgroup "all but one evaluation" (benchWordsAndNumbers setSize NonEmpty.init) : [] main :: IO () main = defaultMain $ bgroup "tree" (benchCodeSets CodeSetTree.size) : bgroup "union" (benchCodeSets CodeSetUnion.size) : []