tries 0.0.5 → 0.0.6
raw patch · 7 files changed
+221/−39 lines, 7 filesdep −bytestring-triedep ~QuickCheckdep ~basedep ~rose-trees
Dependencies removed: bytestring-trie
Dependency ranges changed: QuickCheck, base, rose-trees, sets
Files
- bench/Build.hs +83/−0
- bench/Main.hs +55/−0
- src/Data/Trie/Class.hs +12/−12
- src/Data/Trie/HashMap.hs +15/−6
- src/Data/Trie/Map.hs +14/−6
- src/Data/Trie/Pseudo.hs +3/−1
- tries.cabal +39/−14
+ bench/Build.hs view
@@ -0,0 +1,83 @@+module Build where++++import Data.List.NonEmpty (NonEmpty (..))+import Data.Tree (Tree (..))+import Data.Trie.List as L+import Data.Trie.Map as M+import Data.Trie.HashMap as HM+import Data.Tree.Knuth.Forest as K+import Data.Trie.Knuth as K+import qualified Data.Map as Map+import qualified Data.HashMap.Lazy as HMap+import Control.Monad.State+++buildMiddleQuery :: Int -> NonEmpty Int+buildMiddleQuery x = 0 :| go x+ where+ go n =+ let half = floor ((fromIntegral n)/2)+ in if half == 0+ then []+ else half : go (floor $ (fromIntegral n)/2)+++genListTrie :: Int -> ListTrie Int Int+genListTrie n = ListTrie $ Node (0, Just 0) $ genTree n+ where+ genTree :: Int -> [Tree (Int, Maybe Int)]+ genTree n = flip evalState 1 $ replicateM n $ do+ i <- getSucc+ return $ Node (i, Just 0) $ genTree (floor $ (fromIntegral n)/2)+++getSucc :: State Int Int+getSucc = do+ i <- get+ modify (+1)+ pure i+++genMapTrie :: Int -> MapTrie Int Int+genMapTrie n = MapTrie . MapStep . Map.singleton 0 $+ MapChildren (Just 0) $ Just . MapTrie . MapStep $ genMapTree n+ where+ genMapTree :: Int -> Map.Map Int (MapChildren MapTrie Int Int)+ genMapTree n =+ Map.unions . flip evalState 1 $+ replicateM n $ do+ i <- getSucc+ pure $ Map.singleton i $+ MapChildren (Just 0) $+ if n <= 1+ then Nothing+ else Just . MapTrie . MapStep $ genMapTree (floor $ (fromIntegral n)/2)+++genHashMapTrie :: Int -> HashMapTrie Int Int+genHashMapTrie n = HashMapTrie $ HashMapStep $ HMap.singleton 0 $+ HashMapChildren (Just 0) $ Just . HashMapTrie . HashMapStep $ genHashMapTree n+ where+ genHashMapTree :: Int -> HMap.HashMap Int (HashMapChildren HashMapTrie Int Int)+ genHashMapTree n = HMap.unions $ flip evalState 1 $+ replicateM n $ do+ i <- getSucc+ return $ HMap.singleton i $+ HashMapChildren (Just 0) $+ if n <= 1+ then Nothing+ else Just . HashMapTrie . HashMapStep $ genHashMapTree (floor $ fromIntegral n / 2)++++-- | This one is ordered largest first+genKnuthTrie :: Int -> KnuthTrie Int Int+genKnuthTrie n = KnuthTrie $ Fork (0, Just 0) (genKnuthForest n n) Nil+ where+ genKnuthForest :: Int -> Int -> KnuthForest (Int, Maybe Int)+ genKnuthForest 0 _ = Nil+ genKnuthForest n s = let cs = if n == 0 then Nil else genKnuthForest (floor $ (fromIntegral n)/2) (n-1)+ ss = if s == 0 then Nil else genKnuthForest n (s-1)+ in Fork (s, Just 0) cs ss
+ bench/Main.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE+ FlexibleContexts+ #-}++module Main where++import Build++import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Tree (Tree (..))+import Data.Trie.List as L+import Data.Trie.Map as M+import Data.Trie.HashMap as HM+import Data.Tree.Knuth.Forest as K+import Data.Trie.Knuth as K+import Data.Trie.Class as TC+import qualified Data.Map as Map+import qualified Data.HashMap.Lazy as HMap+import Criterion.Main+import Control.Monad.State++++deleteMany :: ( Trie NonEmpty Int c+ ) => Int -> c Int a -> c Int a+deleteMany top xs =+ foldr+ (\p -> TC.delete $ buildMiddleQuery top)+ xs+ [1..top]++insertMany :: ( Trie NonEmpty Int c+ ) => Int -> c Int Int -> c Int Int+insertMany top xs =+ foldr+ (\p -> TC.insert (buildMiddleQuery top) 0)+ xs+ [1..top]+++main = defaultMain+ [ bgroup "delete"+ [ bench "ListTrie" $ whnf (deleteMany 100) (genListTrie 100)+ , bench "MapTrie" $ whnf (deleteMany 100) (genMapTrie 100)+ , bench "HashMapTrie" $ whnf (deleteMany 100) (genHashMapTrie 100)+ , bench "KnuthTrie" $ whnf (deleteMany 100) (genKnuthTrie 100)+ ]+ , bgroup "insert"+ [ bench "ListTrie" $ whnf (insertMany 100) (genListTrie 100)+ , bench "MapTrie1" $ whnf (insertMany 100) (genMapTrie 100)+ , bench "HashMapTrie" $ whnf (insertMany 100) (genHashMapTrie 100)+ , bench "KnuthTrie" $ whnf (insertMany 100) (genKnuthTrie 100)+ ]+ ]
src/Data/Trie/Class.hs view
@@ -6,7 +6,7 @@ module Data.Trie.Class where import Prelude hiding (lookup)-import qualified Data.Trie as BT+-- import qualified Data.Trie as BT import qualified Data.ByteString as BS import Data.Maybe (isJust)@@ -37,18 +37,18 @@ fromFoldable = F.foldr (uncurry insert) mempty --- * ByteString-Trie+-- -- * ByteString-Trie --- | Embeds an empty ByteString passed around for type inference.-newtype BSTrie q a = BSTrie {unBSTrie :: (q, BT.Trie a)}+-- -- | Embeds an empty ByteString passed around for type inference.+-- newtype BSTrie q a = BSTrie {unBSTrie :: (q, BT.Trie a)} -makeBSTrie :: BT.Trie a -> BSTrie BS.ByteString a-makeBSTrie x = BSTrie (mempty,x)+-- makeBSTrie :: BT.Trie a -> BSTrie BS.ByteString a+-- makeBSTrie x = BSTrie (mempty,x) -getBSTrie :: BSTrie BS.ByteString a -> BT.Trie a-getBSTrie (BSTrie (_,x)) = x+-- getBSTrie :: BSTrie BS.ByteString a -> BT.Trie a+-- getBSTrie (BSTrie (_,x)) = x -instance Trie Identity BS.ByteString BSTrie where- lookup (Identity ps) (BSTrie (_,xs)) = BT.lookup ps xs- insert (Identity ps) x (BSTrie (q,xs)) = BSTrie (q, BT.insert ps x xs)- delete (Identity ps) (BSTrie (q,xs)) = BSTrie (q, BT.delete ps xs)+-- instance Trie Identity BS.ByteString BSTrie where+-- lookup (Identity ps) (BSTrie (_,xs)) = BT.lookup ps xs+-- insert (Identity ps) x (BSTrie (q,xs)) = BSTrie (q, BT.insert ps x xs)+-- delete (Identity ps) (BSTrie (q,xs)) = BSTrie (q, BT.delete ps xs)
src/Data/Trie/HashMap.hs view
@@ -16,6 +16,7 @@ module Data.Trie.HashMap where import Data.Trie.Class (Trie (..))+import Data.Semigroup (Semigroup) import Data.Monoid (First (..), Last (..), (<>)) import Data.Hashable (Hashable) import Data.Maybe (fromMaybe, fromJust)@@ -52,12 +53,15 @@ ) => Arbitrary (HashMapChildren c p a) where arbitrary = HashMapChildren <$> arbitrary <*> scale (`div` 2) arbitrary +instance ( Semigroup (c p a)+ ) => Semigroup (HashMapChildren c p a) where+ (HashMapChildren mx mxs) <> (HashMapChildren my mys) =+ HashMapChildren (getLast (Last mx <> Last my))+ (mxs <> mys)+ instance ( Monoid (c p a) ) => Monoid (HashMapChildren c p a) where mempty = HashMapChildren Nothing Nothing- mappend (HashMapChildren mx mxs) (HashMapChildren my mys) =- HashMapChildren (getLast (Last mx <> Last my))- (mxs <> mys) newtype HashMapStep c p a = HashMapStep { unHashMapStep :: HM.HashMap p (HashMapChildren c p a)@@ -122,11 +126,16 @@ instance ( Hashable p , Eq p+ , Semigroup (c p a)+ ) => Semigroup (HashMapStep c p a) where+ (HashMapStep xs) <> (HashMapStep ys) =+ HashMapStep (HM.unionWith (<>) xs ys)++instance ( Hashable p+ , Eq p , Monoid (c p a) ) => Monoid (HashMapStep c p a) where mempty = empty- mappend (HashMapStep xs) (HashMapStep ys) =- HashMapStep (HM.unionWith (<>) xs ys) empty :: HashMapStep c p a empty = HashMapStep HM.empty@@ -141,7 +150,7 @@ newtype HashMapTrie p a = HashMapTrie { unHashMapTrie :: HashMapStep HashMapTrie p a- } deriving (Show, Eq, Functor, Foldable, Traversable, Monoid, Arbitrary)+ } deriving (Show, Eq, Functor, Foldable, Traversable, Semigroup, Monoid, Arbitrary) instance ( Hashable p
src/Data/Trie/Map.hs view
@@ -26,6 +26,7 @@ import qualified Data.Key as K import qualified Data.Foldable as F import Data.Maybe (fromMaybe, fromJust)+import Data.Semigroup (Semigroup) import Data.Monoid (First (..), Last (..), (<>)) import Control.Monad (replicateM) @@ -55,12 +56,15 @@ ) => Arbitrary (MapChildren c p a) where arbitrary = MapChildren <$> arbitrary <*> scale (`div` 2) arbitrary +instance ( Semigroup (c p a)+ ) => Semigroup (MapChildren c p a) where+ (MapChildren mx mxs) <> (MapChildren my mys) =+ MapChildren (getLast $ Last mx <> Last my)+ (mxs <> mys)+ instance ( Monoid (c p a) ) => Monoid (MapChildren c p a) where mempty = MapChildren Nothing Nothing- mappend (MapChildren mx mxs) (MapChildren my mys) =- MapChildren (getLast $ Last mx <> Last my)- (mxs <> mys) newtype MapStep c p a = MapStep@@ -113,13 +117,17 @@ {-# INLINEABLE insert #-} +instance ( Ord s+ , Semigroup (c s a)+ ) => Semigroup (MapStep c s a) where+ (MapStep xs) <> (MapStep ys) =+ MapStep (Map.unionWith (<>) xs ys) + instance ( Ord s , Monoid (c s a) ) => Monoid (MapStep c s a) where mempty = empty- mappend (MapStep xs) (MapStep ys) =- MapStep $ Map.unionWith (<>) xs ys empty :: MapStep c s a empty = MapStep Map.empty@@ -132,7 +140,7 @@ newtype MapTrie s a = MapTrie { unMapTrie :: MapStep MapTrie s a- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Monoid, Arbitrary)+ } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Semigroup, Monoid, Arbitrary) instance Ord s => Trie NonEmpty s MapTrie where lookup ts (MapTrie xs) = lookup ts xs
src/Data/Trie/Pseudo.hs view
@@ -23,10 +23,12 @@ | Nil deriving (Show, Eq, Functor, Foldable, Traversable) +instance Eq t => Semigroup (PseudoTrie t a) where+ (<>) = merge+ -- | Overwriting instance instance (Eq t) => Monoid (PseudoTrie t a) where mempty = Nil- mappend = merge beginsWith :: (Eq t) => PseudoTrie t a -> t -> Bool beginsWith Nil _ = False
tries.cabal view
@@ -1,11 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.21.2.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.0. -- -- see: https://github.com/sol/hpack ----- hash: 022bdce10844410f3e9663fa23513d9739331172dc3fbd52e1a4c1e7af9485f3+-- hash: b5b8b6262290f4b3819cf5059836cf61223454ee5d3f4ccebf373af29b582f66 name: tries-version: 0.0.5+version: 0.0.6 synopsis: Various trie implementations in Haskell description: Please see the README on Github at <https://git.localcooking.com/tooling/tries#readme> category: Data, Tree@@ -17,8 +19,6 @@ license: BSD3 license-file: LICENSE build-type: Simple-cabal-version: >= 1.10- extra-source-files: README.md @@ -41,9 +41,8 @@ ghc-options: -Wall build-depends: QuickCheck >=2.9.2- , base >=4.8 && <5.0+ , base >=4.11 && <5.0 , bytestring- , bytestring-trie , composition , containers , deepseq@@ -52,7 +51,7 @@ , quickcheck-instances , rose-trees >=0.0.2.1 , semigroups- , sets >=0.0.5.2+ , sets >=0.0.6 , unordered-containers default-language: Haskell2010 @@ -67,9 +66,8 @@ ghc-options: -Wall -threaded -rtsopts -Wall -with-rtsopts=-N build-depends: QuickCheck- , base >=4.8 && <5.0+ , base >=4.11 && <5.0 , bytestring- , bytestring-trie , composition , containers , deepseq@@ -79,13 +77,41 @@ , quickcheck-instances , rose-trees >=0.0.2.1 , semigroups- , sets >=0.0.5.2+ , sets >=0.0.6 , tasty , tasty-quickcheck , tries , unordered-containers default-language: Haskell2010 +benchmark tries-bench+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Build+ Paths_tries+ hs-source-dirs:+ bench+ ghc-options: -Wall -threaded -rtsopts -Wall -with-rtsopts=-N+ build-depends:+ QuickCheck >=2.9.2+ , base >=4.11 && <5.0+ , bytestring+ , composition+ , containers+ , criterion+ , deepseq+ , hashable+ , keys+ , mtl+ , quickcheck-instances+ , rose-trees+ , semigroups+ , sets >=0.0.6+ , tries+ , unordered-containers+ default-language: Haskell2010+ benchmark tries-bench-lookup type: exitcode-stdio-1.0 main-is: Main.hs@@ -97,9 +123,8 @@ ghc-options: -Wall -threaded -rtsopts -Wall -with-rtsopts=-N build-depends: QuickCheck >=2.9.2- , base >=4.8 && <5.0+ , base >=4.11 && <5.0 , bytestring- , bytestring-trie , composition , containers , criterion@@ -110,7 +135,7 @@ , quickcheck-instances , rose-trees , semigroups- , sets >=0.0.5.2+ , sets >=0.0.6 , tries , unordered-containers default-language: Haskell2010