rose-trees 0.0.4.1 → 0.0.4.2
raw patch · 8 files changed
+150/−67 lines, 8 files
Files
- bench/Bench.hs +2/−0
- bench/Data/Build.hs +37/−0
- bench/Data/Tree/HashBench.hs +41/−0
- bench/Data/Tree/KnuthBench.hs +18/−15
- bench/Data/Tree/SetBench.hs +19/−24
- bench/Data/TreeBench.hs +18/−27
- rose-trees.cabal +7/−1
- test/Data/Tree/RoseSpec.hs +8/−0
bench/Bench.hs view
@@ -4,6 +4,7 @@ import Data.TreeBench import Data.Tree.SetBench import Data.Tree.KnuthBench+import Data.Tree.HashBench import Criterion.Main @@ -14,5 +15,6 @@ [ data_tree_bench , data_settree_bench , data_knuthtree_bench+ , data_hashtree_bench ] ]
+ bench/Data/Build.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE+ GADTs+ , FlexibleContexts+ #-}++module Data.Build where++import Data.Tree.Rose+import Control.Monad.State+++newNode :: ( MonadState Int m+ , RoseTree t+ , Head (t Int) ~ Int+ ) => Tail (t Int)+ -> m (t Int)+newNode xs = do+ x <- get+ modify (+1)+ return $ x @-> xs++makeWith :: ( MonadState Int m+ , Head (t Int) ~ Int+ , RoseTree t+ ) => Int -- Depth+ -> Int -- Width+ -> Int -- Ratio+ -> Tail (t Int)+ -> ([t Int] -> Tail (t Int))+ -> m (t Int)+makeWith d w r empty fromList+ | d <= 1 = newNode empty+ | otherwise = do+ xs <- replicateM w $+ makeWith (d-1) (floor $ (fromIntegral w :: Float)+ / fromIntegral r) r empty fromList+ newNode $ fromList xs
+ bench/Data/Tree/HashBench.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE+ FlexibleContexts+ #-}++module Data.Tree.HashBench (data_hashtree_bench) where++import Data.Build+import Prelude hiding (elem)+import Data.Monoid+import qualified Data.HashSet as HS+import Data.Tree.Hash+import Control.Monad.State+import Criterion+++tree1 = evalState (makeWith 10 10 2 HS.empty HS.fromList) 1+tree2 = evalState (makeWith 20 20 2 HS.empty HS.fromList) 1+tree3 = evalState (makeWith 30 30 2 HS.empty HS.fromList) 1+tree4 = evalState (makeWith 40 40 2 HS.empty HS.fromList) 1+tree5 = evalState (makeWith 50 50 2 HS.empty HS.fromList) 1+++data_hashtree_bench = bgroup "Data.Tree.Hash"+ [ bgroup "depth"+ [ bench "1" $ whnf maximum' tree1+ , bench "2" $ whnf maximum' tree2+ , bench "3" $ whnf maximum' tree3+ , bench "4" $ whnf maximum' tree4+ , bench "5" $ whnf maximum' tree5+ ]+ , bgroup "width"+ [ bench "1" $ whnf maximum' tree1+ , bench "2" $ whnf maximum' tree2+ , bench "3" $ whnf maximum' tree3+ , bench "4" $ whnf maximum' tree4+ , bench "5" $ whnf maximum' tree5+ ]+ ]++maximum' :: HashTree Int -> Int+maximum' = maximum
bench/Data/Tree/KnuthBench.hs view
@@ -25,26 +25,29 @@ modify (+1) return $ F.Fork x xs ws -tree1 = evalState (makeWith 1 1 2 >>= newNode) 1-tree2 = evalState (makeWith 2 2 2 >>= newNode) 1-tree3 = evalState (makeWith 3 3 2 >>= newNode) 1-tree4 = evalState (makeWith 4 4 2 >>= newNode) 1-tree5 = evalState (makeWith 5 5 2 >>= newNode) 1+tree1 = evalState (makeWith 10 10 2 >>= newNode) 1+tree2 = evalState (makeWith 20 20 2 >>= newNode) 1+tree3 = evalState (makeWith 30 30 2 >>= newNode) 1+tree4 = evalState (makeWith 40 40 2 >>= newNode) 1+tree5 = evalState (makeWith 50 50 2 >>= newNode) 1 data_knuthtree_bench = bgroup "Data.Tree.Knuth" [ bgroup "depth"- [ bench "1" $ whnf (elem 1) tree1- , bench "2" $ whnf (elem 2) tree2- , bench "3" $ whnf (elem 5) tree3- , bench "4" $ whnf (elem 18) tree4- , bench "5" $ whnf (elem 23) tree5+ [ bench "1" $ whnf maximum' tree1+ , bench "2" $ whnf maximum' tree2+ , bench "3" $ whnf maximum' tree3+ , bench "4" $ whnf maximum' tree4+ , bench "5" $ whnf maximum' tree5 ] , bgroup "width"- [ bench "1" $ whnf (elem 1) tree1- , bench "2" $ whnf (elem 2) tree2- , bench "3" $ whnf (elem 6) tree3- , bench "4" $ whnf (elem 20) tree4- , bench "5" $ whnf (elem 25) tree5+ [ bench "1" $ whnf maximum' tree1+ , bench "2" $ whnf maximum' tree2+ , bench "3" $ whnf maximum' tree3+ , bench "4" $ whnf maximum' tree4+ , bench "5" $ whnf maximum' tree5 ] ]++maximum' :: KnuthTree Int -> Int+maximum' = maximum
bench/Data/Tree/SetBench.hs view
@@ -4,6 +4,7 @@ module Data.Tree.SetBench (data_settree_bench) where +import Data.Build import Prelude hiding (elem) import Data.Monoid import qualified Data.Set as Set@@ -12,36 +13,30 @@ import Criterion -newNode :: MonadState Int m => Set.Set (SetTree Int) -> m (SetTree Int)-newNode xs = do x <- get- modify (+1)- return $ SetTree x xs --- makeWith :: Int -> Int -> Int -> State Int (Tree Int)-makeWith d w r | d <= 1 = newNode Set.empty- | otherwise = do xs <- replicateM w $ makeWith (d-1) (floor $ fromIntegral w / r) r- newNode $ Set.fromList xs--tree1 = evalState (makeWith 1 1 2) 1-tree2 = evalState (makeWith 2 2 2) 1-tree3 = evalState (makeWith 3 3 2) 1-tree4 = evalState (makeWith 4 4 2) 1-tree5 = evalState (makeWith 5 5 2) 1+tree1 = evalState (makeWith 10 10 2 Set.empty Set.fromList) 1+tree2 = evalState (makeWith 20 20 2 Set.empty Set.fromList) 1+tree3 = evalState (makeWith 30 30 2 Set.empty Set.fromList) 1+tree4 = evalState (makeWith 40 40 2 Set.empty Set.fromList) 1+tree5 = evalState (makeWith 50 50 2 Set.empty Set.fromList) 1 data_settree_bench = bgroup "Data.Tree.Set" [ bgroup "depth"- [ bench "1" $ whnf (elem 1) tree1- , bench "2" $ whnf (elem 2) tree2- , bench "3" $ whnf (elem 5) tree3- , bench "4" $ whnf (elem 18) tree4- , bench "5" $ whnf (elem 23) tree5+ [ bench "1" $ whnf maximum' tree1+ , bench "2" $ whnf maximum' tree2+ , bench "3" $ whnf maximum' tree3+ , bench "4" $ whnf maximum' tree4+ , bench "5" $ whnf maximum' tree5 ] , bgroup "width"- [ bench "1" $ whnf (elem 1) tree1- , bench "2" $ whnf (elem 2) tree2- , bench "3" $ whnf (elem 6) tree3- , bench "4" $ whnf (elem 20) tree4- , bench "5" $ whnf (elem 25) tree5+ [ bench "1" $ whnf maximum' tree1+ , bench "2" $ whnf maximum' tree2+ , bench "3" $ whnf maximum' tree3+ , bench "4" $ whnf maximum' tree4+ , bench "5" $ whnf maximum' tree5 ] ]++maximum' :: SetTree Int -> Int+maximum' = maximum
bench/Data/TreeBench.hs view
@@ -4,6 +4,7 @@ module Data.TreeBench (data_tree_bench) where +import Data.Build import Data.Monoid import Data.Tree import Data.Tree.Rose@@ -11,39 +12,29 @@ import Criterion -newNode :: MonadState Int m => [Tree Int] -> m (Tree Int)-newNode xs = do x <- get- modify (+1)- return $ Node x xs---- makeWith :: Int -> Int -> Int -> State Int (Tree Int)-makeWith d w r | d <= 1 = newNode []- | otherwise = do xs <- replicateM w $ makeWith (d-1) (floor $ (fromIntegral w) / r) r- newNode xs--tree1 = evalState (makeWith 1 1 2) 1-tree2 = evalState (makeWith 2 2 2) 1-tree3 = evalState (makeWith 3 3 2) 1-tree4 = evalState (makeWith 4 4 2) 1-tree5 = evalState (makeWith 5 5 2) 1+tree1 = evalState (makeWith 10 10 2 [] id) 1+tree2 = evalState (makeWith 20 20 2 [] id) 1+tree3 = evalState (makeWith 30 30 2 [] id) 1+tree4 = evalState (makeWith 40 40 2 [] id) 1+tree5 = evalState (makeWith 50 50 2 [] id) 1 data_tree_bench = bgroup "Data.Tree" [ bgroup "depth"- [ bench "1" $ whnf (elemT 1) tree1- , bench "2" $ whnf (elemT 2) tree2- , bench "3" $ whnf (elemT 5) tree3- , bench "4" $ whnf (elemT 18) tree4- , bench "5" $ whnf (elemT 23) tree5+ [ bench "1" $ whnf maximum' tree1+ , bench "2" $ whnf maximum' tree2+ , bench "3" $ whnf maximum' tree3+ , bench "4" $ whnf maximum' tree4+ , bench "5" $ whnf maximum' tree5 ] , bgroup "width"- [ bench "1" $ whnf (elemT 1) tree1- , bench "2" $ whnf (elemT 2) tree2- , bench "3" $ whnf (elemT 6) tree3- , bench "4" $ whnf (elemT 20) tree4- , bench "5" $ whnf (elemT 25) tree5+ [ bench "1" $ whnf maximum' tree1+ , bench "2" $ whnf maximum' tree2+ , bench "3" $ whnf maximum' tree3+ , bench "4" $ whnf maximum' tree4+ , bench "5" $ whnf maximum' tree5 ] ] -elemT :: Eq a => a -> Tree a -> Bool-elemT x (Node y ys) = x == y || getAny (foldMap (Any . elemT x) ys)+maximum' :: Tree Int -> Int+maximum' = maximum
rose-trees.cabal view
@@ -1,5 +1,5 @@ Name: rose-trees-Version: 0.0.4.1+Version: 0.0.4.2 Author: Athan Clark <athan.clark@gmail.com> Maintainer: Athan Clark <athan.clark@gmail.com> License: BSD3@@ -48,11 +48,13 @@ , deepseq , rose-trees , containers+ , hashable , semigroups , semigroupoids , sets , tasty , tasty-quickcheck+ , unordered-containers , witherable , QuickCheck , quickcheck-instances@@ -71,14 +73,18 @@ Data.TreeBench Data.Tree.SetBench Data.Tree.KnuthBench+ Data.Tree.HashBench+ Data.Build Build-Depends: base , deepseq , rose-trees , containers+ , hashable , mtl , semigroups , semigroupoids , sets+ , unordered-containers , witherable , QuickCheck , quickcheck-instances
test/Data/Tree/RoseSpec.hs view
@@ -8,6 +8,8 @@ import qualified Data.Tree.Set as S import qualified Data.Tree.Knuth as K import qualified Data.Tree.Knuth.Forest as KF+import qualified Data.Tree.Hash as HT+import qualified Data.HashSet as HS import Test.Tasty@@ -27,6 +29,9 @@ , testGroup "Data.Tree.Knuth" [ QC.testProperty "element after construction" prop_cons_exists_KnuthTree ]+ , testGroup "Data.Tree.Hash"+ [ QC.testProperty "element after construction" prop_cons_exists_HashTree+ ] ] newtype TreeWithElem t e = TreeWithElem {unTreeWithElem :: (e, t e)}@@ -41,6 +46,9 @@ prop_cons_exists_KnuthTree :: Int -> KF.KnuthForest Int -> Bool prop_cons_exists_KnuthTree x xs = K.elem x $ x @-> xs++prop_cons_exists_HashTree :: Int -> HS.HashSet (HT.HashTree Int) -> Bool+prop_cons_exists_HashTree x xs = HT.elem x $ x @-> xs -- instance (Arbitrary e