data-stringmap 0.9.2 → 1.0.0
raw patch · 11 files changed
+927/−469 lines, 11 filesdep +bytestringdep +data-sizedep ~basedep ~containersdep ~deepseq
Dependencies added: bytestring, data-size
Dependency ranges changed: base, containers, deepseq
Files
- Data/StringMap.hs +36/−17
- Data/StringMap/Base.hs +354/−200
- Data/StringMap/FuzzySearch.hs +15/−35
- Data/StringMap/Lazy.hs +12/−16
- Data/StringMap/Strict.hs +173/−39
- Data/StringMap/StringSet.hs +1/−1
- Data/StringMap/Types.hs +1/−1
- data-stringmap.cabal +118/−51
- tests/SimpleStrictTest.hs +3/−1
- tests/StringMapProperties.hs +84/−90
- tests/StringMapStrict.hs +130/−18
Data/StringMap.hs view
@@ -4,15 +4,35 @@ {- | Module : Data.StringMap- Copyright : Copyright (C) 2009-2012 Uwe Schmidt+ Copyright : Copyright (C) 2009-2014 Uwe Schmidt, Sebastian Philipp License : MIT - Maintainer : Uwe Schmidt (uwe@fh-wedel.de)+ Maintainer : Uwe Schmidt (uwe@fh-wedel.de), Sebastian Philipp (sebastian@spawnhost.de) Stability : experimental Portability: not portable - Facade for prefix tree implementation+ An efficient implementation of maps from strings to arbitrary values. + Values can be associated with an arbitrary [Char] key. Searching for keys is very fast.+ The main differences to Data.Map and Data.IntMap are the special+ 'prefixFind' functions, which can be used to perform prefix queries. The interface is+ heavily borrowed from "Data.Map" and "Data.IntMap".++ Most other function names clash with "Prelude" names, therefore this module is usually+ imported @qualified@, e.g.++ > import Data.StringMap (StringMap)+ > import qualified Data.StringMap as M++ Many functions have a worst-case complexity of /O(min(n,L))/. This means that the operation+ can become linear with the number of elements with a maximum of /L/, the length of the+ key (the number of bytes in the list). The functions for searching a prefix have a worst-case+ complexity of /O(max(L,R))/. This means that the operation can become linear with+ /R/, the number of elements found for the prefix, with a minimum of /L/.++ This module reexports all generally usefull types and operations+ from Data.StringMap.Base.+ -} -- ----------------------------------------------------------------------------@@ -59,6 +79,7 @@ -- ** Union , union , unionWith+ , unionMapWith , unionWithKey -- ** Difference@@ -66,7 +87,10 @@ , differenceWith , differenceWithKey -+ -- ** Interset+ , intersection+ , intersectionWith+ -- * Traversal -- ** Map , map@@ -78,6 +102,10 @@ -- * Folds , fold , foldWithKey+ , foldr+ , foldrWithKey+ , foldl+ , foldlWithKey -- * Conversion , keys@@ -86,29 +114,20 @@ -- ** Lists , fromList , toList- , toListBF+ , toListShortestFirst -- ** Maps , fromMap , toMap - -- * Debugging- , space- , keyChars- -- * Prefix and Fuzzy Search- , prefixFindCaseWithKey -- fuzzy search- , prefixFindNoCaseWithKey- , prefixFindNoCase+ , prefixFilter -- fuzzy search+ , prefixFilterNoCase , lookupNoCase-- , prefixFindCaseWithKeyBF- , prefixFindNoCaseWithKeyBF- , lookupNoCaseBF ) where -import Prelude hiding (lookup, map, mapM, null,+import Prelude hiding (foldl, foldr, lookup, map, mapM, null, succ) import Data.StringMap.Base
Data/StringMap/Base.hs view
@@ -1,10 +1,12 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-} -- ---------------------------------------------------------------------------- {- |- Module : Data.StringMap.Base- Copyright : Copyright (C) 2009-2012 Uwe Schmidt+ Module : Data.StringMap.Strict+ Copyright : Copyright (C) 2009-2014 Uwe Schmidt, Sebastian Philipp (sebastian@spawnhost.de) License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de)@@ -13,16 +15,16 @@ An efficient implementation of maps from strings to arbitrary values. - Values can associated with an arbitrary byte key. Searching for keys is very fast, but- the prefix tree probably consumes more memory than "Data.Map". The main differences are the special+ Values can be associated with an arbitrary [Char] key. Searching for keys is very fast.+ The main differences to Data.Map and Data.IntMap are the special 'prefixFind' functions, which can be used to perform prefix queries. The interface is heavily borrowed from "Data.Map" and "Data.IntMap". Most other function names clash with "Prelude" names, therefore this module is usually imported @qualified@, e.g. - > import Data.StringMap (StringMap)- > import qualified Data.StringMap as T+ > import Data.StringMap (StringMap)+ > import qualified Data.StringMap as M Many functions have a worst-case complexity of /O(min(n,L))/. This means that the operation can become linear with the number of elements with a maximum of /L/, the length of the@@ -30,10 +32,6 @@ complexity of /O(max(L,R))/. This means that the operation can become linear with /R/, the number of elements found for the prefix, with a minimum of /L/. - The module export list includes the internal data types, their constructors and access- functions for ultimate flexibility. Derived modules should not export these- (as shown in "Data.StringMap") to provide only a restricted interface.- -} -- ----------------------------------------------------------------------------@@ -41,9 +39,10 @@ module Data.StringMap.Base ( -- * Map type- StringMap (Empty, Val, Branch) -- the constructors are exported for pattern matching only- -- use cases occur in Data.StringMap.Strict+ StringMap (..) -- the constructors are exported for pattern matching only+ -- use cases occur in Data.StringMap.Strict , Key+ , Key1(..) -- * Operators , (!)@@ -83,6 +82,7 @@ -- ** Union , union , unionWith+ , unionMapWith , unionWithKey -- ** Difference@@ -90,6 +90,9 @@ , differenceWith , differenceWithKey + -- ** Interset+ , intersection+ , intersectionWith -- * Traversal -- ** Map@@ -102,6 +105,10 @@ -- * Folds , fold , foldWithKey+ , foldl+ , foldlWithKey+ , foldr+ , foldrWithKey -- * Conversion , keys@@ -110,45 +117,51 @@ -- ** Lists , fromList , toList- , toListBF+ , toListShortestFirst -- ** Maps , fromMap , toMap - -- * Debugging- , space- , stat- , keyChars-- -- Internal+ -- * Internal , cutPx' , cutAllPx' , branch , val , siseq , fromKey+ , toKey , norm , normError'+ , unNorm+ , deepUnNorm , deepNorm+ , visit+ , StringMapVisitor(..) ) where -import Prelude hiding (lookup, map, mapM, null, succ)+import Prelude hiding (foldl, foldr, lookup, map,+ mapM, null, succ) +import Control.Applicative (pure, (<$>), (<*>)) import Control.Arrow import Control.DeepSeq -import qualified Data.Foldable as F- import Data.Binary+import qualified Data.Foldable as F import qualified Data.List as L import qualified Data.Map as M import Data.Maybe hiding (mapMaybe)- import Data.StringMap.StringSet import Data.StringMap.Types+import qualified Data.Traversable as T+import Data.Typeable +#if sizeable+import Data.Size+#endif+ -- ---------------------------------------- data StringMap v = Empty@@ -194,7 +207,7 @@ ! Sym -- a last node with a single char , value' :: v -- and a value }- deriving (Show, Eq, Ord)+ deriving (Show, Eq, Ord, Typeable) -- ---------------------------------------- @@ -207,81 +220,81 @@ | S1 {-# UNPACK #-} ! Sym | S2 {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym | S3 {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym+ | S4 {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym | C1 {-# UNPACK #-} ! Sym ! Key1 | C2 {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym ! Key1 | C3 {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym ! Key1- deriving (Eq, Ord)+ | C4 {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym {-# UNPACK #-} ! Sym+ ! Key1+ deriving (Eq, Ord, Typeable) instance Show Key1 where show k = show (toKey k) mk1 :: Sym -> Key1 mk1 s1 = S1 s1--- mk1 s1 = C1 s1 Nil mk2 :: Sym -> Sym -> Key1 mk2 s1 s2 = S2 s1 s2--- mk2 s1 s2 = C1 s1 (mk1 s2)--- mk2 s1 s2 = C1 s1 (C1 s2 Nil) mk3 :: Sym -> Sym -> Sym -> Key1 mk3 s1 s2 s3 = S3 s1 s2 s3 -cons1 :: Sym -> Key1 -> Key1-cons1 s Nil = mk1 s-cons1 s (S1 s2) = mk2 s s2-cons1 s (S2 s2 s3) = mk3 s s2 s3-cons1 s (C1 s2 k2) = C2 s s2 k2-cons1 s (C2 s2 s3 k3) = C3 s s2 s3 k3-cons1 s k = C1 s k+mk4 :: Sym -> Sym -> Sym -> Sym -> Key1+mk4 s1 s2 s3 s4 = S4 s1 s2 s3 s4 -uncons1 :: Key1 -> (Sym, Key1)-uncons1 (S1 s) = (s, Nil)-uncons1 (S2 s s2) = (s, mk1 s2)-uncons1 (S3 s s2 s3) = (s, mk2 s2 s3)-uncons1 (C1 s k1) = (s, k1)-uncons1 (C2 s s2 k1) = (s, C1 s2 k1)-uncons1 (C3 s s2 s3 k1) = (s, C2 s2 s3 k1)-uncons1 Nil = error "uncons1 with Nil"+cons1 :: Sym -> Key1 -> Key1+cons1 s Nil = mk1 s+cons1 s (S1 s2) = mk2 s s2+cons1 s (S2 s2 s3) = mk3 s s2 s3+cons1 s (S3 s2 s3 s4) = mk4 s s2 s3 s4+cons1 s (C1 s2 k2) = C2 s s2 k2+cons1 s (C2 s2 s3 k3) = C3 s s2 s3 k3+cons1 s (C3 s2 s3 s4 k4) = C4 s s2 s3 s4 k4+cons1 s k = C1 s k +uncons1 :: Key1 -> (Sym, Key1)+uncons1 (S1 s) = (s, Nil)+uncons1 (S2 s s2) = (s, mk1 s2)+uncons1 (S3 s s2 s3) = (s, mk2 s2 s3)+uncons1 (S4 s s2 s3 s4) = (s, mk3 s2 s3 s4)+uncons1 (C1 s k1) = (s, k1)+uncons1 (C2 s s2 k1) = (s, C1 s2 k1)+uncons1 (C3 s s2 s3 k1) = (s, C2 s2 s3 k1)+uncons1 (C4 s s2 s3 s4 k1) = (s, C3 s2 s3 s4 k1)+uncons1 Nil = error "uncons1 with Nil"+ {-# INLINE mk1 #-} {-# INLINE mk2 #-} {-# INLINE mk3 #-}+{-# INLINE mk4 #-} {-# INLINE cons1 #-} {-# INLINE uncons1 #-} --toKey :: Key1 -> Key-toKey (C3 s1 s2 s3 k) = s1 : s2 : s3 : toKey k-toKey (C2 s1 s2 k) = s1 : s2 : toKey k-toKey (C1 s1 k) = s1 : toKey k-toKey (S3 s1 s2 s3) = s1 : s2 : s3 : []-toKey (S2 s1 s2 ) = s1 : s2 : []-toKey (S1 s1 ) = s1 : []-toKey Nil = []--fromKey :: Key -> Key1-fromKey k1 = foldr cons1 Nil k1--length1 :: Key1 -> Int-length1 = length . toKey+toKey :: Key1 -> Key+toKey (S2 s1 s2 ) = s1 : s2 : []+toKey (S3 s1 s2 s3 ) = s1 : s2 : s3 : []+toKey (S4 s1 s2 s3 s4) = s1 : s2 : s3 : s4 : []+toKey (S1 s1 ) = s1 : []+toKey (C1 s1 k) = s1 : toKey k+toKey (C2 s1 s2 k) = s1 : s2 : toKey k+toKey (C3 s1 s2 s3 k) = s1 : s2 : s3 : toKey k+toKey (C4 s1 s2 s3 s4 k) = s1 : s2 : s3 : s4 : toKey k+toKey Nil = [] -space1 :: Key1 -> Int-space1 Nil = 0-space1 (S1 _) = 2-space1 (S2 _ _) = 3-space1 (S3 _ _ _) = 4-space1 (C1 _ k1) = 3 + space1 k1-space1 (C2 _ _ k1) = 4 + space1 k1-space1 (C3 _ _ _ k1) = 5 + space1 k1+fromKey :: Key -> Key1+fromKey k1 = L.foldr cons1 Nil k1 -- ---------------------------------------- -- smart constructors +-- | Creates an empty string map+--+-- > null $ empty == True empty :: StringMap v empty = Empty @@ -358,6 +371,21 @@ -- ---------------------------------------- +unNorm :: StringMap v -> StringMap v+unNorm t = case norm t of+ (Branch k c n) -> branch k c n+ (Val v t') -> val v t'+ t' -> t'+++deepUnNorm :: StringMap v -> StringMap v+deepUnNorm t = case norm t of+ (Branch k c n) -> branch k (deepUnNorm c) (deepUnNorm n)+ (Val v t') -> val v (deepUnNorm t')+ t' -> t'++-- ----------------------------------------+ deepNorm :: StringMap v -> StringMap v deepNorm t0 = case norm t0 of@@ -405,7 +433,7 @@ valueWithDefault :: a -> StringMap a -> a valueWithDefault d t = fromMaybe d . value $ t -+{- not yet used -- | /O(1)/ Extract the successors of a node succ :: StringMap a -> StringMap a@@ -413,7 +441,7 @@ Val _ t' -> succ t' t' -> t' {-# INLINE succ #-}-+-- -} -- ---------------------------------------- -- | /O(min(n,L))/ Find the value associated with a key. The function will @return@ the result in@@ -564,7 +592,9 @@ look _ _ = normError "lookupLE" -- | Combination of 'lookupLE' and 'lookupGE'--- @keys $ lookupRange "a" "b" $ fromList $ zip ["", "a", "ab", "b", "ba", "c"] [1..] = ["a","ab","b"]@+-- +-- > keys $ lookupRange "a" "b" $ fromList $ zip ["", "a", "ab", "b", "ba", "c"] [1..] = ["a","ab","b"]+-- -- For all keys in @k = keys $ lookupRange lb ub m@, this property holts true: @k >= ub && k <= lb@ lookupRange :: Key -> Key -> StringMap a -> StringMap a@@ -583,6 +613,8 @@ prefixFindWithKey :: Key -> StringMap a -> [(Key, a)] prefixFindWithKey k = fmap (first (k ++)) . toList . lookupPx' k +{-# DEPRECATED prefixFindWithKey "use @ 'toList' . 'prefixFilter' @ instead" #-}+ -- ---------------------------------------- insert' :: (a -> a -> a) -> a -> Key -> StringMap a -> StringMap a@@ -636,14 +668,18 @@ -- | /O(n+m)/ Left-biased union of two maps. It prefers the first map when duplicate keys are -- encountered, i.e. ('union' == 'unionWith' 'const'). -union :: StringMap a -> StringMap a -> StringMap a-union = union' const+union :: StringMap a -> StringMap a -> StringMap a+union = union' const --- | /O(n+m)/ Union with a combining function.+{-# INLINE union #-} -unionWith :: (a -> a -> a) -> StringMap a -> StringMap a -> StringMap a-unionWith = union'+-- | /O(n+m)/ 'union' with a combining function. +unionWith :: (a -> a -> a) -> StringMap a -> StringMap a -> StringMap a+unionWith = union'++{-# INLINE unionWith #-}+ union' :: (a -> a -> a) -> StringMap a -> StringMap a -> StringMap a union' f pt1 pt2 = uni (norm pt1) (norm pt2) where@@ -668,8 +704,41 @@ -- ---------------------------------------- --- | /O(n+m)/ Union with a combining function, including the key.+-- | Generalisation of 'unionWith'. The second map may have another attribute type than the first one.+-- Conversion and merging of the maps is done in a single step.+-- This is much more efficient than mapping the second map and then call 'unionWith'+--+-- @unionWithConf to (\ x y -> x `op` to y) m1 m2 = unionWith op m1 (fmap to m2)@ +unionMapWith :: (b -> a) -> (a -> b -> a) -> StringMap a -> StringMap b -> StringMap a+unionMapWith = unionG'++unionG' :: (b -> a) -> (a -> b -> a) -> StringMap a -> StringMap b -> StringMap a+unionG' to f pt1 pt2 = uni (norm pt1) (norm pt2)+ where+ uni' t1' t2' = unionG' to f (norm t1') (norm t2')++ uni Empty Empty = empty+ uni Empty (Val v2 t2) = val (to v2) (map to t2)+ uni Empty (Branch c2 s2 n2)+ = branch c2 (map to s2) (map to n2)++ uni (Val v1 t1) Empty = val v1 t1+ uni (Val v1 t1) (Val v2 t2) = val (f v1 v2) (uni' t1 t2)+ uni (Val v1 t1) t2@(Branch _ _ _) = val v1 (uni' t1 t2)++ uni (Branch c1 s1 n1) Empty = branch c1 s1 n1+ uni t1@(Branch _ _ _ ) (Val v2 t2) = val (to v2) (uni' t1 t2)+ uni t1@(Branch c1 s1 n1) t2@(Branch c2 s2 n2)+ | c1 < c2 = branch c1 s1 (uni' n1 t2)+ | c1 > c2 = branch c2 (map to s2) (uni' t1 n2)+ | otherwise = branch c1 (uni' s1 s2) (uni' n1 n2)+ uni _ _ = normError "union'"++-- ----------------------------------------++-- | /O(n+m)/ 'union' with a combining function, including the key.+ unionWithKey :: (Key -> a -> a -> a) -> StringMap a -> StringMap a -> StringMap a unionWithKey f = union'' f id @@ -698,18 +767,18 @@ -- ---------------------------------------- ----- | /(O(min(n,m))/ Difference between two tries (based on keys).+-- | /(O(min(n,m))/ Difference between two string maps (based on keys). difference :: StringMap a -> StringMap b -> StringMap a difference = differenceWith (const (const Nothing)) --- | /(O(min(n,m))/ Difference with a combining function. If the combining function always returns+-- | /(O(min(n,m))/ 'difference' with a combining function. If the combining function always returns -- 'Nothing', this is equal to proper set difference. differenceWith :: (a -> b -> Maybe a) -> StringMap a -> StringMap b -> StringMap a differenceWith f = differenceWithKey (const f) --- | /O(min(n,m))/ Difference with a combining function, including the key. If two equal keys are+-- | /O(min(n,m))/ 'difference' with a combining function, including the key. If two equal keys are -- encountered, the combining function is applied to the key and both values. If it returns -- 'Nothing', the element is discarded, if it returns 'Just' a value, the element is updated -- with the new value.@@ -741,7 +810,34 @@ | otherwise = branch c1 (diff'' f (kf . (c1:)) s1 s2) (dif' n1 n2) dif _ _ = normError "diff''" +-- ----------------------------------------+-- | /O(min(n,m))/ intersection is required to allow all major set operations:+-- AND = 'intersection'+-- OR = 'union'+-- AND NOT = 'difference' +intersection :: StringMap a -> StringMap a -> StringMap a+intersection t1 t2 = intersectionWith const t1 t2++-- | /O(min(n,m))/ 'intersection' with a modification function++intersectionWith :: (a -> b -> c) -> StringMap a -> StringMap b -> StringMap c+intersectionWith f tree1 tree2 = intersection' (norm tree1) (norm tree2)+ where+ intersection'' t1' t2' = intersection' (norm t1') (norm t2')++ intersection' Empty _ = empty+ intersection' _ Empty = empty++ intersection' (Val v1 t1) (Val v2 t2) = val (f v1 v2) $ intersection'' t1 t2+ intersection' (Val _ t1) t2@(Branch _ _ _) = intersection'' t1 t2+ intersection' t1@(Branch _ _ _) (Val _ t2) = intersection'' t1 t2+ intersection' t1@(Branch c1 s1 n1) t2@(Branch c2 s2 n2)+ | c1 < c2 = intersection'' n1 t2+ | c1 > c2 = intersection'' t1 n2+ | otherwise = branch c1 (intersection'' s1 s2) (intersection'' n1 n2)+ intersection' _ _ = normError "intersectionWith"+ -- ---------------------------------------- -- | cut off all branches from a tree @t2@ that are not part of set @t1@@@ -765,42 +861,61 @@ | otherwise = branch c1 (cutPx'' cf s1 s2) (cutPx'' cf n1 n2) cut _ _ = normError "cutPx''" +{-# INLINE cutPx'' #-}+ cutPx' :: StringSet -> StringMap a -> StringMap a cutPx' = cutPx'' id +{-# INLINE cutPx' #-}+ cutAllPx' :: StringSet -> StringMap a -> StringMap a cutAllPx' = cutPx'' (cv . norm) where cv (Val v _) = val v empty cv _ = empty +{-# INLINE cutAllPx' #-}+ -- ---------------------------------------- --- | /O(n)/ Map a function over all values in the prefix tree.+-- | /O(n)/ Map a function over all values in the string map. map :: (a -> b) -> StringMap a -> StringMap b map f = mapWithKey (const f) +{-# INLINE map #-} +-- | /O(n)/ Same as 'map', but with an additional paramter+ mapWithKey :: (Key -> a -> b) -> StringMap a -> StringMap b mapWithKey f = map' f id +{-# INLINE mapWithKey #-} map' :: (Key -> a -> b) -> (Key -> Key) -> StringMap a -> StringMap b-map' _ _ (Empty) = Empty-map' f k (Val v t) = Val (f (k []) v) (map' f k t)-map' f k (Branch c s n) = Branch c (map' f ((c :) . k) s) (map' f k n)-map' f k (Leaf v) = Leaf (f (k []) v)-map' f k (Last c s) = Last c (map' f ((c :) . k) s)-map' f k (LsSeq cs s) = LsSeq cs (map' f ((toKey cs ++) . k) s)-map' f k (BrSeq cs s n) = BrSeq cs (map' f ((toKey cs ++) . k) s) (map' f k n)-map' f k (LsSeL cs v) = LsSeL cs (f (k []) v)-map' f k (BrSeL cs v n) = BrSeL cs (f (k []) v) (map' f k n)-map' f k (LsVal c v) = LsVal c (f (k []) v)-map' f k (BrVal c v n) = BrVal c (f (k []) v) (map' f k n)+map' f = mp'+ where+ mp' k = mp+ where+ f' = f (k []) --- | /O(n)/ Updates a value or deletes the element if the result of the updating function is 'Nothing'.+ mp (Empty) = Empty+ mp (Val v t) = Val (f' v) (mp t)+ mp (Branch c s n) = Branch c (mp' ((c :) . k) s) (mp n)+ mp (Leaf v) = Leaf (f' v)+ mp (Last c s) = Last c (mp' ((c :) . k) s)+ mp (LsSeq cs s) = LsSeq cs (mp' ((toKey cs ++) . k) s)+ mp (BrSeq cs s n) = BrSeq cs (mp' ((toKey cs ++) . k) s) (mp n)+ mp (LsSeL cs v) = LsSeL cs (f' v)+ mp (BrSeL cs v n) = BrSeL cs (f' v) (mp n)+ mp (LsVal c v) = LsVal c (f' v)+ mp (BrVal c v n) = BrVal c (f' v) (mp n) +{-# INLINE map' #-}++-- | /O(n)/ Updates a value or deletes the element,+-- if the result of the updating function is 'Nothing'.+ mapMaybe :: (a -> Maybe b) -> StringMap a -> StringMap b mapMaybe = mapMaybe' @@ -810,12 +925,15 @@ mapMaybe' f = upd . norm where upd' = mapMaybe' f+ upd (Branch c' s' n') = branch c' (upd' s') (upd' n') upd Empty = empty upd (Val v' t') = maybe t (flip val t) $ f v' where t = upd' t' upd _ = normError "update'" +{-# INLINE mapMaybe' #-}+ -- ---------------------------------------- {- not yet used @@ -839,12 +957,12 @@ -- ---------------------------------------- --- | Monadic map+-- | Monadic 'map' mapM :: Monad m => (a -> m b) -> StringMap a -> m (StringMap b) mapM f = mapWithKeyM (const f) --- | Monadic mapWithKey+-- | Monadic 'mapWithKey' mapWithKeyM :: Monad m => (Key -> a -> m b) -> StringMap a -> m (StringMap b) mapWithKeyM f = mapM'' f id@@ -865,7 +983,7 @@ -- ---------------------------------------- ----- A prefix tree visitor+-- A string map visitor data StringMapVisitor a b = PTV { v_empty :: b@@ -896,101 +1014,70 @@ visit v (BrVal c v' n) = v_brval v c v' (visit v n) -- ---------------------------------------------- | space required by a prefix tree (logically)------ Singletons are counted as 0, all other n-ary constructors--- are counted as n+1 (1 for the constructor and 1 for every field)--- cons nodes of char lists are counted 2, 1 for the cons, 1 for the char--- for values only the ref to the value is counted, not the space for the value itself--- key chars are assumed to be unboxed -space :: StringMap a -> Int-space = visit $- PTV- { v_empty = 0- , v_val = const (3 +)- , v_branch = const $ \ s n -> 4 + s + n- , v_leaf = const 2- , v_last = const (3 +)- , v_lsseq = \ cs s -> space1 cs + s- , v_brseq = \ cs s n -> 4 + space1 cs + s + n- , v_lssel = \ cs _ -> 3 + space1 cs- , v_brsel = \ cs _ n -> 4 + space1 cs + n- , v_lsval = \ _ _ -> 3- , v_brval = \ _ _ n -> 4 + n- }+-- | /O(n)/ Fold over all key\/value pairs in the map. -keyChars :: StringMap a -> Int-keyChars = visit $- PTV- { v_empty = 0- , v_val = \ _ t -> t- , v_branch = \ _ s n -> 1 + s + n- , v_leaf = \ _ -> 0- , v_last = \ _ s -> 1 + s- , v_lsseq = \ cs s -> length1 cs + s- , v_brseq = \ cs s n -> length1 cs + s + n- , v_lssel = \ cs _ -> length1 cs- , v_brsel = \ cs _ n -> length1 cs + n- , v_lsval = \ _ _ -> 1- , v_brval = \ _ _ n -> 1 + n- }+foldWithKey :: (Key -> a -> b -> b) -> b -> StringMap a -> b+foldWithKey f e = rfold' f e id --- ---------------------------------------------- | statistics about the # of different nodes in an optimized prefix tree+{-# DEPRECATED foldWithKey "use @foldrWithKey@ instead" #-} -stat :: StringMap a -> StringMap Int-stat = visit $- PTV- { v_empty = singleton "empty" 1- , v_val = \ _ t -> singleton "val" 1- `add` t- , v_branch = \ _ s n -> singleton "branch" 1- `add` (s `add` n)- , v_leaf = \ _ -> singleton "leaf" 1- , v_last = \ _ s -> singleton "last" 1- `add` s- , v_lsseq = \ cs s -> singleton (show' "lsseq" cs) 1- `add` singleton "size-key1" (length1 cs)- `add` singleton "space-key1" (space1 cs)- `add` s- , v_brseq = \ cs s n -> singleton (show' "brseq" cs) 1- `add` singleton "size-key1" (length1 cs)- `add` singleton "space-key1" (space1 cs)- `add` (s `add` n)- , v_lssel = \ cs _ -> singleton (show' "lssel" cs) 1- `add` singleton "size-key1" (length1 cs)- `add` singleton "space-key1" (space1 cs)- , v_brsel = \ cs _ n -> singleton (show' "brseq" cs) 1- `add` singleton "size-key1" (length1 cs)- `add` singleton "space-key1" (space1 cs)- `add` n- , v_lsval = \ _ _ -> singleton "lsval" 1- , v_brval = \ _ _ n -> singleton "brval" 1- `add` n- }+-- | /O(n)/ Right fold over all keys and values in the map.++foldrWithKey :: (Key -> a -> b -> b) -> b -> StringMap a -> b+foldrWithKey f e = rfold' f e id++{-# INLINE foldrWithKey #-}+++-- | /O(n)/ Fold over all values in the map.++fold :: (a -> b -> b) -> b -> StringMap a -> b+fold f = foldWithKey $ const f++{-# DEPRECATED fold "use @foldr@ instead" #-}++-- | /O(n)/ Right fold over all values in the map.++foldr :: (a -> b -> b) -> b -> StringMap a -> b+foldr f = foldrWithKey $ const f++{-# INLINE foldr #-}++rfold' :: (Key -> a -> b -> b) -> b -> (Key -> Key) -> StringMap a -> b+rfold' f r k0 = fo k0 . norm where- add = unionWith (+)- show' c k1 = c ++ "-" ++ show (length1 k1)+ fo kf (Branch c' s' n') = let r' = rfold' f r kf n' in rfold' f r' (kf . (c':)) s'+ fo _ (Empty) = r+ fo kf (Val v' t') = let r' = rfold' f r kf t' in f (kf []) v' r'+ fo _ _ = normError "rfold'" --- ----------------------------------------+{-# INLINE rfold' #-} --- | /O(n)/ Fold over all key\/value pairs in the map.+-- | /O(n)/ Left fold over all values in the map. -foldWithKey :: (Key -> a -> b -> b) -> b -> StringMap a -> b-foldWithKey f e = fold' f e id+foldl :: (b -> a -> b) -> b -> StringMap a -> b+foldl f = foldlWithKey $ \ x -> const (f x) -{-# INLINE foldWithKey #-}+{-# INLINE foldl #-} --- | /O(n)/ Fold over all values in the map.+-- | /O(n)/ Left fold over all keys and values in the map. -fold :: (a -> b -> b) -> b -> StringMap a -> b-fold f = foldWithKey $ const f+foldlWithKey :: (b -> Key -> a -> b) -> b -> StringMap a -> b+foldlWithKey f e = lfold' f e id -{-# INLINE fold #-}+{-# INLINE foldlWithKey #-} +lfold' :: (b -> Key -> a -> b) -> b -> (Key -> Key) -> StringMap a -> b+lfold' f r k0 = fo k0 . norm+ where+ fo kf (Branch c' s' n') = let r' = lfold' f r (kf . (c':)) s' in lfold' f r' kf n'+ fo _ (Empty) = r+ fo kf (Val v' t') = let r' = f r (kf []) v' in lfold' f r' kf t'+ fo _ _ = normError "lfold'"++{-# INLINE lfold' #-}+ {- not yet used foldTopDown :: (Key -> a -> b -> b) -> b -> (Key -> Key) -> StringMap a -> b@@ -1002,20 +1089,12 @@ fo _ _ = normError "foldTopDown" -- -} -fold' :: (Key -> a -> b -> b) -> b -> (Key -> Key) -> StringMap a -> b-fold' f r k0 = fo k0 . norm- where- fo kf (Branch c' s' n') = let r' = fold' f r kf n' in fold' f r' (kf . (c':)) s'- fo _ (Empty) = r- fo kf (Val v' t') = let r' = fold' f r kf t' in f (kf []) v' r'- fo _ _ = normError "fold'"- -- | /O(n)/ Convert into an ordinary map. toMap :: StringMap a -> M.Map Key a toMap = foldWithKey M.insert M.empty --- | /O(n)/ Convert an ordinary map into a Prefix tree+-- | /O(n)/ Convert an ordinary map into a string map fromMap :: M.Map Key a -> StringMap a fromMap = M.foldrWithKey insert empty@@ -1025,7 +1104,8 @@ toList :: StringMap a -> [(Key, a)] toList = foldWithKey (\k v r -> (k, v) : r) [] --- | /O(n)/ Creates a trie from a list of key\/value pairs.+-- | /O(n)/ Creates a string map from a list of key\/value pairs.+ fromList :: [(Key, a)] -> StringMap a fromList = L.foldl' (\p (k, v) -> insert k v p) empty @@ -1037,7 +1117,7 @@ elems :: StringMap a -> [a] elems = fold (:) [] --- | /O(n)/ Returns all values.+-- | /O(n)/ Returns all keys. keys :: StringMap a -> [Key] keys = foldWithKey (\ k _v r -> k : r) [] @@ -1045,7 +1125,7 @@ -- | returns all key-value pairs in breadth first order (short words first) -- this enables prefix search with upper bounds on the size of the result set--- e.g. @ search ... >>> toListBF >>> take 1000 @ will give the 1000 shortest words+-- e.g. @ search ... >>> toListShortestFirst >>> take 1000 @ will give the 1000 shortest words -- found in the result set and will ignore all long words -- -- toList is derived from the following code found in the net when searching haskell breadth first search@@ -1058,16 +1138,16 @@ -- > takeWhile (not . null) $ -- > iterate (concatMap subForest) [t] -toListBF :: StringMap v -> [(Key, v)]-toListBF = (\ t0 -> [(id, t0)])- >>>- iterate (concatMap (second norm >>> uncurry subForest))- >>>- takeWhile (not . L.null)- >>>- concat- >>>- concatMap (second norm >>> uncurry rootLabel)+toListShortestFirst :: StringMap v -> [(Key, v)]+toListShortestFirst = (\ t0 -> [(id, t0)])+ >>>+ iterate (concatMap (second norm >>> uncurry subForest))+ >>>+ takeWhile (not . L.null)+ >>>+ concat+ >>>+ concatMap (second norm >>> uncurry rootLabel) rootLabel :: (Key -> Key) -> StringMap v -> [(Key, v)] rootLabel kf (Val v _) = [(kf [], v)]@@ -1085,8 +1165,10 @@ -- in the result. The result list contains short words first prefixFindWithKeyBF :: Key -> StringMap a -> [(Key, a)]-prefixFindWithKeyBF k = fmap (first (k ++)) . toListBF . lookupPx' k+prefixFindWithKeyBF k = fmap (first (k ++)) . toListShortestFirst . lookupPx' k +{-# DEPRECATED prefixFindWithKeyBF "use @ 'toListShortestFirst' . 'prefixFilter' @ instead" #-}+ -- ---------------------------------------- instance Functor StringMap where@@ -1095,6 +1177,19 @@ instance F.Foldable StringMap where foldr = fold +instance T.Traversable StringMap where+ traverse _ (Empty) = pure Empty+ traverse f (Val v t) = Val <$> f v <*> T.traverse f t+ traverse f (Branch c s n) = Branch c <$> T.traverse f s <*> T.traverse f n+ traverse f (Leaf v) = Leaf <$> f v+ traverse f (Last c s) = Last c <$> T.traverse f s+ traverse f (LsSeq ks s) = LsSeq ks <$> T.traverse f s+ traverse f (BrSeq ks s n) = BrSeq ks <$> T.traverse f s <*> T.traverse f n+ traverse f (LsSeL ks v) = LsSeL ks <$> f v+ traverse f (BrSeL ks v n) = BrSeL ks <$> f v <*> T.traverse f n+ traverse f (LsVal k v) = LsVal k <$> f v+ traverse f (BrVal k v n) = BrVal k <$> f v <*> T.traverse f n+ {- for debugging not yet enabled instance Show a => Show (StringMap a) where@@ -1193,4 +1288,63 @@ return $! BrVal k v n _ -> fail "StringMap.get: error while decoding StringMap" +-- ----------------------------------------+#if sizeable+--+-- space statistics++instance Sizeable Key1 where+ dataOf x+ = case x of+ Nil -> dataOfSingleton+ (S1 _) -> dataOfChar+ (S2 _ _) -> 2 .*. dataOfChar+ (S3 _ _ _) -> 3 .*. dataOfChar+ (S4 _ _ _ _) -> 4 .*. dataOfChar+ (C1 _ _k) -> dataOfChar <> dataOfPtr+ (C2 _ _ _k) -> 2 .*. dataOfChar <> dataOfPtr+ (C3 _ _ _ _k) -> 3 .*. dataOfChar <> dataOfPtr+ (C4 _ _ _ _ _k) -> 4 .*. dataOfChar <> dataOfPtr++ statsOf x+ = case x of+ Nil -> constrStats "Nil" x+ (S1 _) -> constrStats "S1" x+ (S2 _ _) -> constrStats "S2" x+ (S3 _ _ _) -> constrStats "S3" x+ (S4 _ _ _ _) -> constrStats "S4" x+ (C1 _ k1) -> constrStats "C1" x <> statsOf k1+ (C2 _ _ k1) -> constrStats "C2" x <> statsOf k1+ (C3 _ _ _ k1) -> constrStats "C3" x <> statsOf k1+ (C4 _ _ _ _ k1) -> constrStats "C4" x <> statsOf k1++instance (Sizeable v, Typeable v) => Sizeable (StringMap v) where+ dataOf x+ = case x of+ Empty -> dataOfSingleton+ (Val _v _t) -> 2 .*. dataOfPtr+ (Branch _ _c _n) -> dataOfChar <> 2 .*. dataOfPtr+ (Leaf _v ) -> dataOfPtr+ (Last _ _c ) -> dataOfChar <> dataOfPtr+ (LsSeq _k _c ) -> 2 .*. dataOfPtr+ (BrSeq _k _c _n) -> 3 .*. dataOfPtr+ (LsSeL _k _v ) -> 2 .*. dataOfPtr+ (BrSeL _k _v _n) -> 3 .*. dataOfPtr+ (BrVal _ _v _n) -> dataOfChar <> 2 .*. dataOfPtr+ (LsVal _ _v ) -> dataOfChar <> dataOfPtr++ statsOf x+ = case x of+ Empty -> constrStats "Empty" x+ (Val v t) -> constrStats "Val" x <> statsOf v <> statsOf t+ (Branch _ c n) -> constrStats "Branch" x <> statsOf c <> statsOf n+ (Leaf v) -> constrStats "Leaf" x <> statsOf v+ (Last _ c) -> constrStats "Last" x <> statsOf c+ (LsSeq k c) -> constrStats "LsSeq" x <> statsOf k <> statsOf c+ (BrSeq k c n) -> constrStats "BrSeq" x <> statsOf k <> statsOf c <> statsOf n+ (LsSeL k v) -> constrStats "LsSeL" x <> statsOf k <> statsOf v+ (BrSeL k v n) -> constrStats "BrSeL" x <> statsOf k <> statsOf v <> statsOf n+ (BrVal _ v n) -> constrStats "BrVal" x <> statsOf v <> statsOf n+ (LsVal _ v) -> constrStats "LsVal" x <> statsOf v+#endif -- ----------------------------------------
Data/StringMap/FuzzySearch.hs view
@@ -1,10 +1,8 @@-{-# LANGUAGE BangPatterns #-}- -- ---------------------------------------------------------------------------- {- | Module : Data.StringMap.FuzzySearch- Copyright : Copyright (C) 2009-2012 Uwe Schmidt+ Copyright : Copyright (C) 2009-2014 Uwe Schmidt, Sebastian Philipp License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de)@@ -18,13 +16,9 @@ -- ---------------------------------------------------------------------------- module Data.StringMap.FuzzySearch- ( prefixFindCaseWithKey- , prefixFindNoCaseWithKey- , prefixFindNoCase+ ( prefixFilter+ , prefixFilterNoCase , lookupNoCase- , lookupNoCaseBF --redundant- , prefixFindCaseWithKeyBF- , prefixFindNoCaseWithKeyBF , noCaseKeys , noLowerCaseKeys , noCasePS@@ -42,39 +36,25 @@ -- | /O(max(L,R))/ Find all values where the string is a prefix of the key. -prefixFindCaseWithKey :: Key -> StringMap a -> [(Key, a)]-prefixFindCaseWithKey k = toList . cutPx' (singlePS k)--prefixFindNoCaseWithKey :: Key -> StringMap a -> [(Key, a)]-prefixFindNoCaseWithKey k = toList . cutPx' (noCaseKeys k)--prefixFindNoCase :: Key -> StringMap a -> [a]-prefixFindNoCase k = elems . cutPx' (noCaseKeys k)--lookupNoCase :: Key -> StringMap a -> [(Key, a)]-lookupNoCase k = toList . cutAllPx' (noCaseKeys k)---- -------------------------------------------- | /O(max(L,R))/ Find all values where the string is a prefix of the key.--- Breadth first variant, short words first in the result list+prefixFilter :: Key -> StringMap a -> StringMap a +prefixFilter k = cutPx' (singlePS k) -prefixFindCaseWithKeyBF :: Key -> StringMap a -> [(Key, a)]-prefixFindCaseWithKeyBF k = toListBF . cutPx' (singlePS k)+-- | Same as 'prefixFilterNoCase', bur case insensitive -prefixFindNoCaseWithKeyBF :: Key -> StringMap a -> [(Key, a)]-prefixFindNoCaseWithKeyBF k = toListBF . cutPx' (noCaseKeys k)+prefixFilterNoCase :: Key -> StringMap a -> StringMap a +prefixFilterNoCase k = cutPx' (noCaseKeys k) -lookupNoCaseBF :: Key -> StringMap a -> [(Key, a)]-lookupNoCaseBF k = toListBF . cutAllPx' (noCaseKeys k)+-- | Same as 'Lazy.lookup', but case insensitive+lookupNoCase :: Key -> StringMap a -> StringMap a +lookupNoCase k = cutAllPx' (noCaseKeys k) -- ---------------------------------------- -noCaseKeys :: Key -> StringSet-noCaseKeys = noCasePS . singlePS+noCaseKeys :: Key -> StringSet+noCaseKeys = noCasePS . singlePS -noLowerCaseKeys :: Key -> StringSet-noLowerCaseKeys = noLowerCasePS . singlePS+noLowerCaseKeys :: Key -> StringSet+noLowerCaseKeys = noLowerCasePS . singlePS -- ----------------------------------------
Data/StringMap/Lazy.hs view
@@ -2,10 +2,10 @@ {- | Module : Data.StringMap.Lazy- Copyright : Copyright (C) 2009-2012 Uwe Schmidt+ Copyright : Copyright (C) 2009-2014 Uwe Schmidt License : MIT - Maintainer : Uwe Schmidt (uwe@fh-wedel.de)+ Maintainer : Uwe Schmidt (uwe@fh-wedel.de), Sebastian Philipp (sebastian@spawnhost.de) Stability : experimental Portability: not portable @@ -76,6 +76,7 @@ -- ** Union , union , unionWith+ , unionMapWith , unionWithKey -- ** Difference@@ -83,6 +84,9 @@ , differenceWith , differenceWithKey + -- ** Interset+ , intersection+ , intersectionWith -- * Traversal -- ** Map@@ -103,30 +107,22 @@ -- ** Lists , fromList , toList- , toListBF+ , toListShortestFirst -- ** Maps , fromMap , toMap - -- * Debugging- , space- , keyChars- -- * Prefix and Fuzzy Search- , prefixFindCaseWithKey -- fuzzy search- , prefixFindNoCaseWithKey- , prefixFindNoCase+ , prefixFilter -- fuzzy search+ , prefixFilterNoCase , lookupNoCase-- , prefixFindCaseWithKeyBF- , prefixFindNoCaseWithKeyBF- , lookupNoCaseBF ) where import Data.StringMap.Base import Data.StringMap.FuzzySearch-import Prelude hiding (lookup, map, mapM, null,- succ)+import Prelude ()++-- ----------------------------------------------------------------------------
Data/StringMap/Strict.hs view
@@ -4,25 +4,25 @@ {- | Module : Data.StringMap.Strict- Copyright : Copyright (C) 2009-2012 Uwe Schmidt+ Copyright : Copyright (C) 2009-2014 Uwe Schmidt, Sebastian Philipp License : MIT - Maintainer : Uwe Schmidt (uwe@fh-wedel.de)+ Maintainer : Uwe Schmidt (uwe@fh-wedel.de), Sebastian Philipp (sebastian@spawnhost.de) Stability : experimental Portability: not portable An efficient implementation of maps from strings to arbitrary values. - Values can associated with an arbitrary byte key. Searching for keys is very fast, but- the prefix tree probably consumes more memory than "Data.Map". The main differences are the special+ Values can be associated with an arbitrary [Char] key. Searching for keys is very fast.+ The main differences to Data.Map and Data.IntMap are the special 'prefixFind' functions, which can be used to perform prefix queries. The interface is heavily borrowed from "Data.Map" and "Data.IntMap". Most other function names clash with "Prelude" names, therefore this module is usually imported @qualified@, e.g. - > import Data.StringMap (StringMap)- > import qualified Data.StringMap as T+ > import Data.StringMap.Strict (StringMap)+ > import qualified Data.StringMap.Strict as M Many functions have a worst-case complexity of /O(min(n,L))/. This means that the operation can become linear with the number of elements with a maximum of /L/, the length of the@@ -30,9 +30,11 @@ complexity of /O(max(L,R))/. This means that the operation can become linear with /R/, the number of elements found for the prefix, with a minimum of /L/. - The module exports include the internal data types, their constructors and access- functions for ultimate flexibility. Derived modules should not export these- (as shown in "Holumbus.Data.StrMap") to provide only a restricted interface.+ This module has versions of the \"modifying\" operations,+ like insert, update, delete and map, that force evaluating+ the attribute values before doing the operation.+ All \"reading\" operations and the data types are reexported+ from Data.StringMap.Base. -} @@ -80,6 +82,7 @@ -- ** Union , union , unionWith+ , unionMapWith , unionWithKey -- ** Difference@@ -87,6 +90,9 @@ , differenceWith , differenceWithKey + -- ** Interset+ , intersection+ , intersectionWith -- * Traversal -- ** Map@@ -99,6 +105,10 @@ -- * Folds , fold , foldWithKey+ , foldr+ , foldrWithKey+ , foldl+ , foldlWithKey -- * Conversion , keys@@ -107,43 +117,33 @@ -- ** Lists , fromList , toList- , toListBF+ , toListShortestFirst -- ** Maps , fromMap , toMap - -- * Debugging- , space- , keyChars- -- * Prefix and Fuzzy Search- , prefixFindCaseWithKey -- fuzzy search- , prefixFindNoCaseWithKey- , prefixFindNoCase+ , prefixFilter -- fuzzy search+ , prefixFilterNoCase , lookupNoCase - , prefixFindCaseWithKeyBF- , prefixFindNoCaseWithKeyBF- , lookupNoCaseBF ) where import Data.StringMap.Base hiding (adjust, adjustWithKey, delete, fromList, insert,- insertWith, insertWithKey,- singleton, union, unionWith,- update, updateWithKey)+ insertWith, insertWithKey, map,+ mapM, mapMaybe, mapWithKey,+ mapWithKeyM, singleton, union,+ unionWith, unionMapWith, update, updateWithKey) import qualified Data.StringMap.Base as Base import Data.StringMap.FuzzySearch -import Prelude hiding (lookup, map, mapM, null,- succ)+import Prelude hiding (foldl, foldr, lookup, map,+ mapM, null, succ) ---import Data.Strict.Tuple import qualified Data.List as L---import Data.BitUtil---import Data.StrictPair -- ---------------------------------------- @@ -183,11 +183,7 @@ insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> StringMap a -> StringMap a insertWithKey f !k = insertWith (f k) k --- | /O(n)/ Creates a trie from a list of key\/value pairs. -fromList :: [(Key, a)] -> StringMap a-fromList = L.foldl' (\p (k, v) -> insert k v p) empty- -- | /O(min(n,L))/ Updates a value at a given key (if that key is in the trie) or deletes the -- element if the result of the updating function is 'Nothing'. If the key is not found, the trie -- is returned unchanged.@@ -201,7 +197,7 @@ -- | /O(min(n,L))/ Updates a value at a given key (if that key is in the trie) or deletes the -- element if the result of the updating function is 'Nothing'. If the key is not found, the trie -- is returned unchanged.--- The updated value is evaluated to WHNF before insertion.+-- The updated value is evaluated to WHNF before insertion. updateWithKey :: (Key -> a -> Maybe a) -> Key -> StringMap a -> StringMap a updateWithKey f k = update' (f k) k@@ -226,7 +222,17 @@ {-# INLINE adjustWithKey #-} ++++++ -- ----------------------------------------+--+-- internal functions forcing evaluation of attribute values to WHNF+--+-- ---------------------------------------- insert' :: (a -> a -> a) -> a -> Key -> StringMap a -> StringMap a insert' f v k0 = ins k0 . norm@@ -281,14 +287,18 @@ -- | /O(n+m)/ Left-biased union of two maps. It prefers the first map when duplicate keys are -- encountered, i.e. ('union' == 'unionWith' 'const'). -union :: StringMap a -> StringMap a -> StringMap a-union = union' const+union :: StringMap a -> StringMap a -> StringMap a+union = union' const --- | /O(n+m)/ Union with a combining function.+{-# INLINE union #-} -unionWith :: (a -> a -> a) -> StringMap a -> StringMap a -> StringMap a-unionWith = union'+-- | /O(n+m)/ 'union' with a combining function. +unionWith :: (a -> a -> a) -> StringMap a -> StringMap a -> StringMap a+unionWith = union'++{-# INLINE unionWith #-}+ -- like union' from Base, but attr value is evaluated to WHNF union' :: (a -> a -> a) -> StringMap a -> StringMap a -> StringMap a@@ -302,7 +312,7 @@ = branch c2 s2 n2 uni (Val v1 t1) Empty = val v1 t1- uni (Val v1 t1) (Val v2 t2) = flip val (uni' t1 t2) $! (f v1 v2)+ uni (Val v1 t1) (Val v2 t2) = (val $! f v1 v2) (uni' t1 t2) -- force attr value evaluation to WHNF uni (Val v1 t1) t2@(Branch _ _ _) = val v1 (uni' t1 t2) @@ -315,3 +325,127 @@ uni _ _ = normError "union'" -- ----------------------------------------++-- | Generalisation of 'unionWith'. The second map may have another attribute type than the first one.+-- Conversion and merging of the maps is done in a single step.+-- This is much more efficient than mapping the second map and then call 'unionWith'+--+-- @unionWithConf to (\ x y -> x `op` to y) m1 m2 = unionWith op m1 (fmap to m2)@++unionMapWith :: (b -> a) -> (a -> b -> a) -> StringMap a -> StringMap b -> StringMap a+unionMapWith = unionG'++unionG' :: (b -> a) -> (a -> b -> a) -> StringMap a -> StringMap b -> StringMap a+unionG' to f pt1 pt2 = uni (norm pt1) (norm pt2)+ where+ uni' t1' t2' = unionG' to f (norm t1') (norm t2')++ uni Empty Empty = empty+ uni Empty (Val v2 t2) = (val $! (to v2)) (map to t2)+ uni Empty (Branch c2 s2 n2)+ = branch c2 (map to s2) (map to n2)++ uni (Val v1 t1) Empty = val v1 t1+ uni (Val v1 t1) (Val v2 t2) = (val $! (f v1 v2)) (uni' t1 t2)+ uni (Val v1 t1) t2@(Branch _ _ _) = val v1 (uni' t1 t2)++ uni (Branch c1 s1 n1) Empty = branch c1 s1 n1+ uni t1@(Branch _ _ _ ) (Val v2 t2) = (val $! (to v2)) (uni' t1 t2)+ uni t1@(Branch c1 s1 n1) t2@(Branch c2 s2 n2)+ | c1 < c2 = branch c1 s1 (uni' n1 t2)+ | c1 > c2 = branch c2 (map to s2) (uni' t1 n2)+ | otherwise = branch c1 (uni' s1 s2) (uni' n1 n2)+ uni _ _ = normError "union'"++-- ----------------------------------------+++-- | /O(n)/ Map a function over all values in the string map.++map :: (a -> b) -> StringMap a -> StringMap b+map f = mapWithKey (const f)++{-# INLINE map #-}++-- | /O(n)/ Same as 'map', but with an additional paramter++mapWithKey :: (Key -> a -> b) -> StringMap a -> StringMap b+mapWithKey f = map' f id++{-# INLINE mapWithKey #-}++-- map functions forcing evaluation of attr to WHNF++map' :: (Key -> a -> b) -> (Key -> Key) -> StringMap a -> StringMap b+map' _ _ (Empty) = Empty+map' f k (Val v t) = (Val $! (f (k []) v)) (map' f k t)+map' f k (Branch c s n) = Branch c (map' f ((c :) . k) s) (map' f k n)+map' f k (Leaf v) = Leaf $! (f (k []) v)+map' f k (Last c s) = Last c (map' f ((c :) . k) s)+map' f k (LsSeq cs s) = LsSeq cs (map' f ((toKey cs ++) . k) s)+map' f k (BrSeq cs s n) = BrSeq cs (map' f ((toKey cs ++) . k) s) (map' f k n)+map' f k (LsSeL cs v) = LsSeL cs $! (f (k []) v)+map' f k (BrSeL cs v n) =(BrSeL cs $! (f (k []) v)) (map' f k n)+map' f k (LsVal c v) = LsVal c $! (f (k []) v)+map' f k (BrVal c v n) =(BrVal c $! (f (k []) v)) (map' f k n)+++-- | /O(n)/ Updates a value or deletes the element,+-- if the result of the updating function is 'Nothing'.++mapMaybe :: (a -> Maybe b) -> StringMap a -> StringMap b+mapMaybe = mapMaybe'++{-# INLINE mapMaybe #-}++mapMaybe' :: (a -> Maybe b) -> StringMap a -> StringMap b+mapMaybe' f = upd . norm+ where+ upd' = mapMaybe' f++ upd (Branch c' s' n') = branch c' (upd' s') (upd' n')+ upd Empty = empty+ upd (Val v' t') = case f v' of+ Nothing -> t+ Just !v'' -> val v'' t -- force WHNF for v+ where t = upd' t'+ upd _ = normError "update'"+++-- ----------------------------------------+-- | Monadic 'map'++mapM :: Monad m => (a -> m b) -> StringMap a -> m (StringMap b)+mapM f = mapWithKeyM (const f)++{-# INLINE mapM #-}++-- | Monadic 'mapWithKey'++mapWithKeyM :: Monad m => (Key -> a -> m b) -> StringMap a -> m (StringMap b)+mapWithKeyM f = mapM'' f id++{-# INLINE mapWithKeyM #-}++mapM'' :: Monad m => (Key -> a -> m b) -> (Key -> Key) -> StringMap a -> m (StringMap b)+mapM'' f k = mapn . norm+ where+ mapn' = mapM'' f++ mapn Empty = return $ empty+ mapn (Val v t) = do+ !v' <- f (k []) v -- force WHNF for v'+ t' <- mapn' k t+ return $ val v' t'+ mapn (Branch c s n) = do+ s' <- mapn' ((c :) . k) s+ n' <- mapn' k n+ return $ branch c s' n'+ mapn _ = normError "mapM''"++-- ----------------------------------------++-- | /O(n)/ Creates a string map from a list of key\/value pairs.++fromList :: [(Key, a)] -> StringMap a+fromList = L.foldl' (\p (k, v) -> insert k v p) empty
Data/StringMap/StringSet.hs view
@@ -4,7 +4,7 @@ {- | Module : Data.StringMap.StringSet- Copyright : Copyright (C) 2010 Uwe Schmidt+ Copyright : Copyright (C) 2010-2014 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
Data/StringMap/Types.hs view
@@ -4,7 +4,7 @@ {- | Module : Data.StringMap.Types- Copyright : Copyright (C) 2009-2012 Uwe Schmidt+ Copyright : Copyright (C) 2009-2014 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
data-stringmap.cabal view
@@ -1,9 +1,9 @@ name: data-stringmap-version: 0.9.2+version: 1.0.0 license: MIT license-file: LICENSE author: Uwe Schmidt, Sebastian Philipp-maintainer: uwe@fh-wedel.de, sebastian@spawnhost.de+maintainer: Uwe Schmidt (uwe@fh-wedel.de), Sebastian Philipp (sebastian@spawnhost.de) bug-reports: https://github.com/sebastian-philipp/StringMap/issues synopsis: An efficient implementation of maps from strings to arbitrary values category: Data Structures@@ -14,64 +14,131 @@ "Data.Map". The main differences are the special 'prefixFind' functions, which can be used to perform prefix queries. -build-type: Simple-cabal-version: >=1.8+build-type: Simple+cabal-version: >= 1.10+ extra-source-files:- tests/*.hs- benchmarks/*.hs+ tests/*.hs+ benchmarks/*.hs +flag with-sizeable+ default: False+ manual: True++-- disable with cabal test -f-test-properties+flag test-properties+ default: True+ manual: True++-- enable with cabal test -ftest-strict+flag test-strict+ default: False+ manual: True+ source-repository head- type: git- location: https://github.com/sebastian-philipp/StringMap.git+ type: git+ location: https://github.com/sebastian-philipp/StringMap.git -Library- build-depends: base >= 4.5 && < 5,- deepseq >= 1.2 && < 2,- binary >= 0.5 && < 1,- containers >= 0.4 && < 1+library+ build-depends:+ base >= 4.5 && < 5+ , deepseq >= 1.2 && < 2+ , binary >= 0.5 && < 1+ , containers >= 0.4 && < 1 - ghc-options: -O2 -Wall -fwarn-tabs -fno-warn-unused-binds+ ghc-options: -O2 -Wall -fwarn-tabs -fno-warn-unused-binds - exposed-modules:- Data.StringMap- Data.StringMap.StringSet- Data.StringMap.Lazy- Data.StringMap.Strict- Data.StringMap.Types+ exposed-modules:+ Data.StringMap+ Data.StringMap.Lazy+ Data.StringMap.Strict+ Data.StringMap.StringSet+ Data.StringMap.Types+ Data.StringMap.Base - other-modules:- Data.StringMap.Base- Data.StringMap.FuzzySearch+ other-modules:+ Data.StringMap.FuzzySearch + default-language:+ Haskell2010++ default-extensions:+ CPP++ other-extensions:+ DeriveDataTypeable+ , BangPatterns++ if flag(test-strict)+ build-depends:+ bytestring == 0.10.0.2++ if flag(with-sizeable)+ build-depends:+ data-size >= 0.1.3 && < 1++ cpp-options:+ -Dsizeable=1+ test-suite properties- type: exitcode-stdio-1.0- main-is: StringMapProperties.hs- build-depends: data-stringmap,- base >= 4.5,- containers >= 0.4,- HUnit >= 1.2,- QuickCheck >= 2.4,- test-framework >= 0.6,- test-framework-quickcheck2 >= 0.2,- test-framework-hunit >= 0.2,- ghc-heap-view >= 0.5,- deepseq >= 1.2 && < 2+ type: exitcode-stdio-1.0+ main-is: StringMapProperties.hs - ghc-options: -Wall -fwarn-tabs- hs-source-dirs: tests+ if !flag(test-properties)+ buildable: False+ else+ build-depends:+ data-stringmap+ , base+ , containers+ , deepseq+ , ghc-heap-view >= 0.5+ , HUnit >= 1.2+ , QuickCheck >= 2.4+ , test-framework >= 0.6+ , test-framework-quickcheck2 >= 0.2+ , test-framework-hunit >= 0.2++ if flag(with-sizeable)+ build-depends:+ data-size++ default-language:+ Haskell2010++ ghc-options: -Wall -fwarn-tabs++ hs-source-dirs:+ tests+ test-suite strict- type: exitcode-stdio-1.0- main-is: StringMapStrict.hs- build-depends: data-stringmap,- base >= 4.5,- containers >= 0.4,- HUnit >= 1.2,- QuickCheck >= 2.4,- test-framework >= 0.6,- test-framework-quickcheck2 >= 0.2,- test-framework-hunit >= 0.2,- ghc-heap-view >= 0.5,- deepseq >= 1.2 && < 2+ type: exitcode-stdio-1.0+ main-is: StringMapStrict.hs - ghc-options: -Wall -fwarn-tabs- hs-source-dirs: tests+ if !flag(test-strict)+ buildable: False+ else+ build-depends:+ data-stringmap+ , base+ , bytestring == 0.10.0.2+ , containers+ , deepseq+ , ghc-heap-view >= 0.5+ , HUnit >= 1.2+ , QuickCheck >= 2.4+ , test-framework >= 0.6+ , test-framework-quickcheck2 >= 0.2+ , test-framework-hunit >= 0.2++ if flag(with-sizeable)+ build-depends:+ data-size++ default-language:+ Haskell2010++ ghc-options: -Wall -fwarn-tabs++ hs-source-dirs:+ tests
tests/SimpleStrictTest.hs view
@@ -41,7 +41,9 @@ consA n a = mkA [n] `mappend` a check :: String -> Map -> IO ()-check msg !m = assertNFNamed msg m+check msg !m+ = do putStrLn msg+ assertNFNamed msg m main :: IO () main =
tests/StringMapProperties.hs view
@@ -1,15 +1,15 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} module Main where import Data.StringMap-+import Data.StringMap.Base (deepUnNorm) import qualified Data.Char as Char (intToDigit)-import qualified Data.List as List (nubBy, (!!), foldl)+import qualified Data.List as List (foldl, nubBy) import qualified Data.Map as Map (empty, fromList, map, toList)-import qualified Data.Set as Set (fromList)+import qualified Data.Set as Set import Prelude hiding (filter, foldl, foldr, lookup, map, null) @@ -19,7 +19,12 @@ import Test.HUnit hiding (Test, Testable) import Text.Show.Functions () +#if sizeable+import Data.Size+#endif +-- ----------------------------------------+ default (Int) main :: IO ()@@ -47,6 +52,7 @@ , testCase "updateWithKey" test_updateWithKey , testCase "union" test_union , testCase "unionWith" test_unionWith+ , testCase "unionMapWith" test_unionMapWith , testCase "unionWithKey" test_unionWithKey , testCase "difference" test_difference , testCase "differenceWith" test_differenceWith@@ -56,31 +62,32 @@ , testCase "mapMaybe" test_mapMaybe -- , testCase "mapM" test_mapM -- , testCase "mapWithKeyM" test_mapWithKeyM- , testCase "fold" test_fold- , testCase "foldWithKey" test_foldWithKey+ , testCase "foldl" test_foldl+ , testCase "foldlWithKey" test_foldlWithKey+ , testCase "foldr" test_foldr+ , testCase "foldrWithKey" test_foldrWithKey , testCase "keys" test_keys , testCase "elems" test_elems , testCase "fromList" test_fromList , testCase "toList" test_toList- , testCase "toListBF" test_toListBF+ , testCase "toListShortestFirst" test_toListShortestFirst , testCase "fromMap" test_fromMap , testCase "toMap" test_toMap -- , testCase "space" test_space -- , testCase "keyChars" test_keyChars- , testCase "prefixFindCaseWithKey" test_prefixFindCaseWithKey -- fuzzy search- , testCase "prefixFindNoCaseWithKey" test_prefixFindNoCaseWithKey- , testCase "prefixFindNoCase" test_prefixFindNoCase+ , testCase "prefixFilter" test_prefixFilter -- fuzzy search+ , testCase "prefixFilterNoCase" test_prefixFilterNoCase , testCase "lookupNoCase" test_lookupNoCase- , testCase "prefixFindCaseWithKeyBF" test_prefixFindCaseWithKeyBF- , testCase "prefixFindNoCaseWithKeyBF" test_prefixFindNoCaseWithKeyBF -- , testCase "lookupNoCaseBF" test_lookupNoCaseBF , testCase "lookuprange" test_range , testProperty "insert to singleton" prop_singleton , testProperty "map a StringMap" prop_map , testProperty "fromList - toList" prop_fromListToList- , testProperty "space" prop_space- , testProperty "lookupNoCaseBF is redundant" prop_lookupNoCaseBF , testProperty "prop_range" prop_range+ , testProperty "prop_intersection" prop_intersection+#if sizeable+ , testProperty "sizeof" prop_sizeof+#endif ] ------------------------------------------------------------------------@@ -162,17 +169,21 @@ test_prefixFindWithKey :: Assertion test_prefixFindWithKey = do- prefixFindWithKey "a" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) `cmpset` [("a",_1), ("ab", 2), ("aaa", 4)]- prefixFindWithKey "" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) `cmpset` [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]- prefixFindWithKey "foo" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) @?= []- prefixFindWithKey "" (empty :: UMap) @?= []+ prefixFindWithKey' "a" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) `cmpset` [("a",_1), ("ab", 2), ("aaa", 4)]+ prefixFindWithKey' "" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) `cmpset` [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]+ prefixFindWithKey' "foo" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) @?= []+ prefixFindWithKey' "" (empty :: UMap) @?= []+ where+ prefixFindWithKey' k = toList . prefixFilter k test_prefixFindWithKeyBF :: Assertion test_prefixFindWithKeyBF = do- prefixFindWithKeyBF "a" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) @?= [("a",_1), ("ab", 2), ("aaa", 4)]- prefixFindWithKeyBF "" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) @?= [("a",_1), ("b", 5), ("ab", 2), ("aaa", 4), ("cab", 3)]- prefixFindWithKeyBF "foo" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) @?= []- prefixFindWithKeyBF "" (empty :: UMap) @?= []+ prefixFindWithKeyBF' "a" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) @?= [("a",_1), ("ab", 2), ("aaa", 4)]+ prefixFindWithKeyBF' "" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) @?= [("a",_1), ("b", 5), ("ab", 2), ("aaa", 4), ("cab", 3)]+ prefixFindWithKeyBF' "foo" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) @?= []+ prefixFindWithKeyBF' "" (empty :: UMap) @?= []+ where+ prefixFindWithKeyBF' k = toListShortestFirst . prefixFilter k test_empty :: Assertion test_empty = do@@ -236,6 +247,10 @@ unionWith (+) (fromList [("a",_1), ("ab", 3)]) (fromList [("a", 2), ("c",_4)]) @?= fromList [("a", 3), ("ab", 3), ("c",_4)] unionWith (+) empty (fromList [("a", 2), ("c",_4)]) @?= fromList [("a", 2), ("c",_4)] +test_unionMapWith :: Assertion+test_unionMapWith = do+ unionMapWith read (\ x y -> x + read y) (fromList [("a",_1), ("ab", 3)]) (fromList [("a", "2"), ("c",show _4)]) @?= fromList [("a", 3), ("ab", 3), ("c",_4)]+ unionMapWith read (\ x y -> x + read y) empty (fromList [("a", "2"), ("c", show _4)]) @?= fromList [("a", 2), ("c",_4)] test_unionWithKey :: Assertion test_unionWithKey =@@ -278,15 +293,21 @@ test_mapWithKeyM :: Assertion test_mapWithKeyM = undefined -test_fold :: Assertion-test_fold = do- fold (\ l r -> (Char.intToDigit $ fromIntegral l) : r) "0" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6)]) @?= "45260"- error "In Which Order?"+test_foldl :: Assertion+test_foldl = do+ foldl (\ r l -> '(' : r ++ [(Char.intToDigit $ fromIntegral l)] ++ ")") "()" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6)]) @?= "((((()4)5)2)6)" -test_foldWithKey :: Assertion-test_foldWithKey = do- foldWithKey f "0" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6)]) @?= "a:4|aa:5|ab:2|b:6|0"- error "In Which Order?"+test_foldlWithKey :: Assertion+test_foldlWithKey = do+ foldlWithKey (\ r k l -> '(' : r ++ k ++ ':' : [(Char.intToDigit $ fromIntegral l)] ++ ")") "()" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6)]) @?= "((((()a:4)aa:5)ab:2)b:6)"++test_foldr :: Assertion+test_foldr = do+ foldr (\ l r -> '(' : (Char.intToDigit $ fromIntegral l) : r ++ ")") "()" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6)]) @?= "(4(5(2(6()))))"++test_foldrWithKey :: Assertion+test_foldrWithKey = do+ foldrWithKey f "0" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6)]) @?= "a:4|aa:5|ab:2|b:6|0" where f k l = mergeString k [Char.intToDigit $ fromIntegral l] @@ -308,11 +329,11 @@ (toList.fromList) [("a",_4), ("ab", 2), ("aa", 5), ("b", 6)] @?= [("a",_4), ("aa", 5), ("ab", 2), ("b", 6)] toList (empty :: UMap) @?= [] -test_toListBF :: Assertion-test_toListBF = do- (toListBF.fromList) [("a",_4), ("Ab", 2)] @?= [("a",_4), ("Ab", 2)]- (toListBF.fromList) [("a",_4), ("ab", 2), ("aa", 5), ("b", 6)] @?= [("a",_4), ("b", 6), ("aa", 5), ("ab", 2)]- toListBF (empty :: UMap) @?= []+test_toListShortestFirst :: Assertion+test_toListShortestFirst = do+ (toListShortestFirst.fromList) [("a",_4), ("Ab", 2)] @?= [("a",_4), ("Ab", 2)]+ (toListShortestFirst.fromList) [("a",_4), ("ab", 2), ("aa", 5), ("b", 6)] @?= [("a",_4), ("b", 6), ("aa", 5), ("ab", 2)]+ toListShortestFirst (empty :: UMap) @?= [] test_fromMap :: Assertion@@ -333,50 +354,25 @@ test_keyChars :: Assertion test_keyChars = undefined -test_prefixFindCaseWithKey :: Assertion-test_prefixFindCaseWithKey = do- prefixFindCaseWithKey "" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("Ab", 7), ("a",_4), ("aa", 5), ("ab", 2), ("b", 6)]- prefixFindCaseWithKey "a" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("a",_4), ("aa", 5), ("ab", 2)]- prefixFindCaseWithKey "b" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("b", 6)]- prefixFindCaseWithKey "c" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= []--test_prefixFindNoCaseWithKey :: Assertion-test_prefixFindNoCaseWithKey = do- prefixFindNoCaseWithKey "" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("Ab", 7), ("a",_4), ("aa", 5), ("ab", 2), ("b", 6)]- prefixFindNoCaseWithKey "a" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("Ab", 7), ("a",_4), ("aa", 5), ("ab", 2)]- prefixFindNoCaseWithKey "b" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("b", 6)]- prefixFindNoCaseWithKey "c" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= []+test_prefixFilter :: Assertion+test_prefixFilter = do+ deepUnNorm (prefixFilter "" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)])) @?= fromList [("Ab", 7), ("a",_4), ("aa", 5), ("ab", 2), ("b", 6)]+ deepUnNorm (prefixFilter "a" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)])) @?= fromList [("a",_4), ("aa", 5), ("ab", 2)]+ deepUnNorm (prefixFilter "b" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)])) @?= fromList [("b", 6)]+ deepUnNorm (prefixFilter "c" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)])) @?= fromList [] -test_prefixFindNoCase :: Assertion-test_prefixFindNoCase = do- prefixFindNoCase "" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("aB", 7)]) @?= [4, 7, 5, 2, 6]- prefixFindNoCase "a" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("aB", 7)]) @?= [4, 7, 5, 2]- prefixFindNoCase "b" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("aB", 7)]) @?= [6]- prefixFindNoCase "c" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("aB", 7)]) @?= []+test_prefixFilterNoCase :: Assertion+test_prefixFilterNoCase = do+ deepUnNorm (prefixFilterNoCase "" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)])) @?= fromList [("Ab", 7), ("a",_4), ("aa", 5), ("ab", 2), ("b", 6)]+ deepUnNorm (prefixFilterNoCase "a" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)])) @?= fromList [("Ab", 7), ("a",_4), ("aa", 5), ("ab", 2)]+ deepUnNorm (prefixFilterNoCase "b" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)])) @?= fromList [("b", 6)]+ deepUnNorm (prefixFilterNoCase "c" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)])) @?= fromList [] test_lookupNoCase :: Assertion test_lookupNoCase = do- lookupNoCase "ab" (fromList [("a",_1), ("Ab", 2)]) @?= [("Ab", 2)]- lookupNoCase "aB" (fromList [("a",_1), ("Ab", 2)]) @?= [("Ab", 2)]- lookupNoCase "" (empty :: UMap) @?= []--test_prefixFindCaseWithKeyBF :: Assertion-test_prefixFindCaseWithKeyBF = do- prefixFindCaseWithKeyBF "" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("a",_4), ("b", 6), ("Ab", 7), ("aa", 5), ("ab", 2)]- prefixFindCaseWithKeyBF "a" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("a",_4), ("aa", 5), ("ab", 2)]- prefixFindCaseWithKeyBF "b" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("b", 6)]- prefixFindCaseWithKeyBF "c" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= []---test_prefixFindNoCaseWithKeyBF :: Assertion-test_prefixFindNoCaseWithKeyBF = do- prefixFindNoCaseWithKeyBF "" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("a",_4), ("b", 6), ("Ab", 7), ("aa", 5), ("ab", 2)]- prefixFindNoCaseWithKeyBF "a" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("a",_4), ("Ab", 7), ("aa", 5), ("ab", 2)]- prefixFindNoCaseWithKeyBF "b" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("b", 6)]- prefixFindNoCaseWithKeyBF "c" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= []--test_lookupNoCaseBF :: Assertion-test_lookupNoCaseBF = undefined+ lookupNoCase "ab" (fromList [("a",_1), ("Ab", 2)]) @?= fromList [("Ab", 2)]+ lookupNoCase "aB" (fromList [("a",_1), ("Ab", 2)]) @?= fromList [("Ab", 2)]+ lookupNoCase "" (empty :: UMap) @?= fromList [] test_range :: Assertion test_range = do@@ -395,25 +391,16 @@ prop_singleton k x = insert k x empty == singleton k x prop_map :: (Int -> Int) -> [(Key, Int)] -> Bool-prop_map f l = (toListBF.(map f).fromList) l `cmpset'` ((Map.toList).(Map.map f).(Map.fromList)) l+prop_map f l = (toListShortestFirst.(map f).fromList) l `cmpset'` ((Map.toList).(Map.map f).(Map.fromList)) l prop_fromListToList :: [(Key, Int)] -> Bool prop_fromListToList l = ((toList.fromList.makeUnique) l) `cmpset'` (makeUnique l) -prop_space :: [(Key, Int)] -> Bool-prop_space [] = True-prop_space l = (space.fromList) l >= (space.fromList.tail) l--prop_lookupNoCaseBF :: [(Key, Int)] -> Int -> Bool-prop_lookupNoCaseBF [] _ = True-prop_lookupNoCaseBF l k = (test' lookupNoCaseBF) == (test' lookupNoCase)- where- ul = makeUnique l- key :: Key- key = fst $ ul List.!! (k `mod` length ul)- test' :: (Key -> StringMap Int -> [(Key, Int)]) -> [(Key, Int)]- test' f = f key (fromList ul)-+#if sizeable+prop_sizeof :: [(Key, Int)] -> Bool+prop_sizeof [] = True+prop_sizeof l = (dataSize . objectsOf . fromList) l >= (dataSize . objectsOf . fromList . tail) l+#endif prop_range :: [Key] -> Key -> Key -> Bool prop_range l lower' upper' = validInside && validOutside@@ -434,5 +421,12 @@ validOutside :: Bool validOutside = List.foldl validKeyOutside True (toList outside) +prop_intersection :: [Key] -> [Key] -> Bool+prop_intersection k1s k2s = ((lToM k1s) `intersection` (lToM k2s)) `eqMS` ((Set.fromList k1s) `Set.intersection` (Set.fromList k2s))+ where+ lToM ks = fromList $ zip ks [1..]+ eqMS :: StringMap Int -> Set.Set Key -> Bool+ eqMS m s = (keys m) == (Set.toList s) +-- ----------------------------------------
tests/StringMapStrict.hs view
@@ -1,37 +1,60 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ScopedTypeVariables #-} module Main where -import Prelude hiding (lookup, map, mapM, null, succ)-import Data.StringMap.Strict+-- import qualified Data.StringMap as Lazy -- just for dev.+import Prelude hiding (lookup, map, mapM,+ null, succ) -import Control.Arrow (second)-import Control.DeepSeq (($!!))+import Control.Arrow (second)+import Control.DeepSeq (($!!))+ import Data.Monoid+import Data.StringMap.Strict import GHC.AssertNF +-- import System.IO+ import Test.Framework import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2-import qualified Test.QuickCheck as Q (arbitrary, Property)-import qualified Test.QuickCheck.Monadic as Q (assert, monadicIO, pick, run, PropertyM) import Test.HUnit hiding (Test, Testable)+import qualified Test.QuickCheck as Q (Property, arbitrary)+import qualified Test.QuickCheck.Monadic as Q (PropertyM, assert,+ monadicIO, pick,+ run) newtype Attr = A [Int] deriving (Show) instance Monoid Attr where mempty = mkA []- mappend (A xs) (A ys) = mkA $! xs ++ ys -- mappend needs to be strict, because the stingList won't evaluate A deep.+ mappend (A xs) (A ys) = mkA (xs ++ ys) +-- evaluation of x `mappend` y to WHNF leads to NF+-- because of the $!! in mkA+--+-- example+--+-- A [1,2] `mappend` A [3,4]+-- = { subst of mappend }+-- mkA ([1,2] ++ [3,4])+-- = { subst of mkA }+-- A $!! ([1,2] ++ [3,4])+-- = { subst of $!! }+-- A [1,2,3,4]+--+-- in a call of Data.StringMap.insert k (x `mappend` y) m+-- the attribute is forced to be in WHNF, and this leads to NF type Map = StringMap Attr --- strict constructor for Attr+-- smart constructor for evaluation into NF+-- before calling the constructor A mkA :: [Int] -> Attr mkA xs = A $!! xs@@ -51,33 +74,41 @@ , testCase "m3" (checkIsNF m3) , testCase "m5" (checkIsNF m3) , testCase "m6" (checkIsNF m3)+ , testCase "m7 (map test)" (checkIsNF m7) , testCase "fromList l4" (checkIsNF $ fromList l4)- , testCase "m2 union m3" (checkIsNF $ m2 `union` m3)- , testCase "m2 unionWith m2" (checkIsNF $ unionWith mappend m2 m2)+ , testCase "m8 (fromList''' ll)" (checkIsNF m8)+ , testCase "adjust m6" (checkIsNF $ adjust (consA 42) "ab" m6) , testCase "adjust m1" (checkIsNF $ adjust (consA 42) "xx" m1) , testCase "delete m6" (checkIsNF $ delete "ab" m6)- , testCase "delete m1" (checkIsNF $ delete "xx" m1) + , testCase "delete m1" (checkIsNF $ delete "xx" m1) + , testCase "m2 union m3" (checkIsNF $ m2 `union` m3)+ , testCase "m2 unionWith m2" (checkIsNF $ unionWith mappend m2 m2)++ -- these test do not run properly with ghc-7.7-pre and ghc-heap-view-0.5.2+ -- no idea, whether patched ghc-heap-view or QuickCheck is the reason , testProperty "prop_simple" prop_simple , testProperty "prop_union" prop_union , testProperty "prop_diff" prop_diff ] -test_isNF :: Assertion +test_isNF :: Assertion test_isNF = fmap not (isNF [(1::Int)..10]) @? "isNF" checkIsNF :: Map -> Assertion checkIsNF !m = isNF m @? ("isNF " ++ show m) -- some simple test data-m0, m1, m2, m3, m5, m6 :: Map+m0, m1, m2, m3, m5, m6, m7, m8 :: Map m0 = insert "" (mkA [0,1+2]) empty m1 = insert "abc" (mkA [1,2,3]) empty m2 = insert "x" (mkA [0,1]) empty m3 = insertWith mappend "abc" (mkA [4,5,6]) m1 m5 = singleton "abc" (mkA [42]) m6 = fromList l4+m7 = map (consA 0) $ fromList l4+m8 = fromList''' ll fromList' :: [(d, [Int])] -> [(d, Attr)] fromList' = fmap (second mkA)@@ -95,7 +126,9 @@ prop_simple :: Q.Property prop_simple = Q.monadicIO $ do l <- Q.pick Q.arbitrary- passed <- Q.run $ isNF $! fromList''' l+ passed <- Q.run $ do -- hPutStrLn stderr $ "\n" ++ show l+ -- hPutStrLn stderr $ "\n" ++ show (fromList''' l)+ isNF $! fromList''' l Q.assert passed prop_union :: Q.Property@@ -104,8 +137,8 @@ l2 <- Q.pick Q.arbitrary let sm = fromList''' l1 `union` fromList''' l2 checkIsNFProp sm- + prop_diff :: Q.Property prop_diff = Q.monadicIO $ do l1 <- Q.pick Q.arbitrary@@ -113,8 +146,87 @@ let sm = fromList''' l1 `difference` fromList''' l2 checkIsNFProp sm -checkIsNFProp :: a -> Q.PropertyM IO () +checkIsNFProp :: a -> Q.PropertyM IO () checkIsNFProp sm = do passed <- Q.run $ isNF $! sm Q.run $ assertNF $! sm Q.assert passed++ll :: [Key] -- QuickCheck generated+ll = ["|6s\FS-\184Cc9\SI=!\137^\r5\221w\151cq\140\&9K\173z\RSu\159Y`\143et"+ ,"\ta\DEL>\236^\219~\197q\STX\194q\248Jn-\USk\a B?\v>(d\RS\232\130\247?]\STX_\249i_\216d"+ ,"\DLEIJ}5\153\CAN\ETX'_M*i<\STX\SUBUr\SI\ETX3zT\155"+ ,"\FS\184\223F\204\t\GS\SI\NAK#\v\"&u\175\195\DEL\150hl\142\DLEB&\\d\249:Qq\RS!\162\&2'\DC4\206>\EOTg\250o\GSLD\185H~a|&\SUBU\b\211aZ;\244\ETB\237\203"+ ,""+ ,"J@\192\ESC\SI\ESCK\158\ETB\ETXit\v \SOH]I%Vd5V`cq\214@\128\248w\226\244F#\DC3z$Bz\134=\ENQ\t\SOH\NAK\f\NUL\231@zsk(A\SI\186d\241:\SI\162\219\SYN\189\ESC\161\&4\153tTp\FS\\\FSEH\\x\r"+ ,"p\174~ q\t\SI]\185\GS\DELD3\243r61\221k\244j?-,\"loxb."+ ,"\135k\ETX\t<*\247\212\211U%\236]\186!\USj\243\252)R\146uU\184Fg\ENQ<'\134m\171\t?~w\139\231?\175\151`\aMKY\CAN\141K$N:\154L\DC3*io\201<\175"+ ,""+ ," Z0\DC2?\n2Q\SO\170 d\132|l\151:9\SUB<\239\EOT\188D_\254N5\224\CAN\236"+ ,",\RS\RSz`Fkw`TD`\SI^+'\197\162\196\ENQ\CAN\155k"+ ,"qi\220qz\220\DC1\US\nE\157HHt<UXK\r..JcJ#.\242Q\163\255AyT\214~\NUL,V0\STXa)\155Dy\247\SOHL\250:?\NUL\139\200rx#MIg\CAN\US\r\222\"\a\203:6\NUL\140=\b:'-g\DC3L\219\&0K\178_\180\202\193zH\234fL.B."+ ,";'T53,9r{tS\SOH\a\ENQGE\STX\148\&6n^B\240\SOH\FS\166@pj\r`-\191.`\145-\172a\131\159\161w5Z\234"+ ,"z\RS\CANDY\212?\150*\ACK\v\192\CAN\221\&0\146Kgv\RSV,Jz\234J57y\130\DC4\152\ETB\SIp\DC2\ETX\\b\SOA}\232?*R\DC2\165\218\DC3\ACKx@\130/M9\193fc4\208\221:N\155\DLEv\138"+ ,"q\ENQP\241+}1\DC2\188\191!Q\163#\EOT\219t~%\SYN@\134!%8i&\ESC\DC1\182\255\SUBx \242\v\179\135J\ENQ\GSKH\SI=|u\DEL"+ ,"5>\246\153\&1L\t{u\DEL2\\6oM\EOT\180-\GS\NUL\SUB\DELn\236"+ ,"nA\158B\"\GSr]5\SIgo\224\&8\246!c\165\bZp*<\n\RS\DC4*oY"+ ,"\DC4\233O3Q0N\243\197=O\EM)>\fQ[2bS>x1R\STX\214^\217\177\EOT\243c\224\167y$aC\SO\144?1"+ ,"\188<"+ ,"l\nou?\168{\184\&9zB\139\146.\221\214\160b\ACKL*\222\aUV\US\202\DC2#\SYN \DC4;3\252xa\148?rP=4\170/\EOT\245\ACK\188"+ ,"\221\\\SOHP\DEL9\169\161\&0\195\NAKKA&\193\141\EM\rScr\229&\179@\212\STXM%\143{\NAK\FSU\216\198\235eQ\NAK\NUL:\DLErg^\SOH8<\f\SO\236\SYN$O\ESCv\RSg\tV\DC2\214[W%\221\ETBY\231\192\200\179?\ESC\199|\DC4c\144XG \145#E7\225q|\189\141\&6\255\228"+ ,"\f\239]\DLElD\EMKy\236\171z93!\ACKD~\200UV\EOT}\RSB\181<%{?| >\228\166I<\205\208\"\218@{\DELk"+ ,"\US(s\254\SUB-e\DC4\"_[r$j\241\212\231\243\SI9\CAN9gv\249i\148\157+G\a\ETB"+ ,"z\189`,\224\SOH.\189\149\&8S]}\227ix\169dA.L\163FW\nH\rUV(~Q>_y,p&[{!8\218\&2\168\155qN\EM_o\218J\170x\a2E\ETB\DC1T\222\&1Cl<\181@HS]\ENQ\t\SOi\ESC\DC22\180;%\231|#w\t\234\""+ ,"\144N8\FS\215IX}\238\&0=7\247\&1\f\SYN\240H6\f7%~h\f@g\214\DC4J8A\200\&0\fU}\NUL\132B.=Bd([H\148,D\EM\SOHV ?\226\DC4\184\202o8\160\FS+0"+ ," \ETX~h su-\230\DC4\ETB0\"\DEL+^\DELg\DC4w\SYN9\SOi\133\241\197a5\217(\162\EM\CAN\181\&8W\DELK\GSVItdh2\SO\202\nm\233\182\205h>"+ ,"Ulu1I\tG\165\202\CAN\DLE[Etr\236t\156\DELO\247\151\DLE\226\223rPXhJ\t\242\SOHd\CAN5\214GY\161hzm#\NAKxD/"+ ,">?\DC4Z<b?\143\206D;~\135eWaR\ACKW\r+o"+ ,"\146^gx9Z)iz"+ ,"12\218'1\SUB\ETXbH_\161\a]>*M\NAK?IB\STX\USd\251?.\242c3\r\141"+ ,"\EOT\200,\USq\RSZ\141\NAK~\146\SYNR\GS?\STXS"+ ,"\SUBw$,un'[4Ev\139\ACK*\150c\a\210 \242\&4\bC,i\DEL\197\197E"+ ,"Jo\SI\ACK!BK\242{*\NAK\191\155\223xt\bJPt\FS\DEL \157\202yXhu@\244T\bG#\245\DLE\248T\DC1%q\141+{\142\DLE\199\&3Y\149\174\178H\138\187"+ ,"B|i\\of\234\228`IIT\242\192\tu\222\STX{T\147\\n(=aWuO\191;\f0R\213\CANOOL\241\n\ESC"+ ,",3?\170=(1H\DEL}\180+1\209\nn\142\ETX9vp\204qxP\ndON*s\t;\EOTU\180&\NAK\173,4AjW9TLEZk\208T\130\ESCa\NUL]vvQD%;\SUBs#\210D\158Ie\164\EM=x\DC1\236"+ ,"\ACK,\rN\219o?\189\&356"+ ,"\DELWZm#TW\ESC\235\234J\RSfK3\167\SUB\133\&7 A\253T\172\\k=\NAK#<&\240mCk'\162\&0^%\DLEm's\EM(rV\235\n~\168\&6\224\DC3\CAN\195+\DC1i\225\191\nU\207&#?\226\&1RY"+ ,"*Hy4\as6\ACK K\168\US<\166\145\135<?\254\129\DC1\143S96q(\240\203HWF,\SUB\a\a\aZ\225\&1\ACK\216\131~\f\220&\DLEW\245fl\r\238P\SYN\250\178\"\246oz.\r\SUB\171\ETBd{9[\vv~<S\DC4rT\182$\DC4h6w\ETBXdx\247<w\ETX"+ ,"xg@BI'\160^\SOH\\\NULul\EOT\FS\DELK/\bQ\163\142`\DC3\181\219\223\244\&3#W\176\ETX`\231B1*:'\206\t\228q?:\nS\194\221T\237>xN\170\129D/-TH\230\STX =\167-Bk-\134n[\201\nsX6wl948\DLEC\240"+ ,"\150.%Z};U?\146]\213%\ETBe\DC4[<\DLEY\185L?\221\DC2\USi\228\NUL2y\ETB]I\150"+ ,"^\DC2\231\&9h\DC36P\DC3V0\208x\ACK\240)\198`A\ENQR\EM9ZW\DLE\239\&1\b8D\"\DEL{u<\r,"+ ,"B1\ESC#GRj\209\f\ACK1\177\SUB\227\190\180\ETBrj\DC2-B$\n\219\249!1$\SI\t\ETXd%\FSr\ETXt)N \186\v<\EM! \DC4p0CYZ\DC2\200\207V\194\"n{\208"+ ,"\EOTf\134X(\ENQ\201'\188\228<S\169\&0\158\167\255\DC4\SUBm3\t[\143\231*!q\RSUj=\SOu\209>K\242\nA0nE\255\EOT\td\235\253\151A\145a#T\ACK\145"+ ,"8Pe\185\\\135\194\130=o3"+ ,"#\210\FSJ:\221r\ETX%gmS$\132\SOH8X|s3+>k"+ ,"\165\tzL3\141\GSc\GSC]]\245lME2{;@R'\GSLXASD\DEL\SUB\158C`?d\SI\157V1\r\174#\ENQ\SYN\220\DEL}\SOHpTn_6\"\199\GS?o\201\182\186\&5H~a}\aN\194C;f(s \f31i,"+ ,"9D.Dd\SO[\133y\DC1\190.]\SYN0C\177\194H\232;\251\SYN\140\133\ACK3\DEL(j*9(\DC3\239XPWlO\EMh&\151?f\209\&9!e\250l\241E\DEL\DC2>\235\146\206e>W \155m\166D7"+ ,"\ETB\156\167\245e\153|\190Gq\SO\SYN)#\n\USy\GS"+ ,"n\149"+ ,"\196L\130^DJ\US\DLE\155wBo\DLE|\158\SYN.-W%,\DC2O^f\238g\EOTX4"+ ,"\US\205j\DEL\160;*`- OI\SI\230\171\ESC9^-e&-/\195\143qszB2GS-\""+ ,"\160Xb2\DC1\197zH\214\ETX*HWt\176'\NAK\180l<\158kj\237_\202jB\RS\147\186\ACK\v\\p\244~\149qu^\EMK\201\152A\229-Uj=\219\SUB\DC2,RU\SI\SIm\194T1\205"+ ,"\bO>\DELr\NAKc\DC49\NUL\169\144dx\187Xk\RSC\SOH\DELI\DC3=k\GST@\DEL\134mdE\US0\134\236l~\DEL\\{\210ZNxJP\r5\EMPb+W\ENQ\b0I\128\EOTJIy\232\159\233"+ ,"\DEL\t/-B~\f\161\182\ACKp\157\f\174mX*\203\t8\185"+ ,"\\y\SI}TJ<|<\241(Et_\237\CAN\SOH\DC1\FS\FS0Bo\191)9\145\148\165\ETB\ACKasr\135(\209\132]\181x\DC3o\SYNs4%}]"+ ,"\204\218`f}\173\SYN{\167\254OPs5,oGq$F\179xf\135'D\EOT\200\166QHL[\224\bY\219\130q\EM\t"+ ,"-*r\SI\ETX\a\242\194\&4\ETX8,Iu\ETX4}\172N\SYN\fD\208\133\137\r\183&\224\DC4\179\222\201\&7\185\150\217\ETBxM\NAK-\225\252ya\246xx\202(kh\144!\175\158\239=/&D~'\185\196Q\207\&9Q\135\CAN`v)Lj\212\nK{\DC4\\9%.t"+ ,"}=q\FS^\176\\O\\\SO\f\130\bLIkb\DEL\RS\"5\f+f|j\NAK`\162\DELE\162\160\197v7n\158\t\218\205\DC2b4D`\200\GS:\US1\251`\201\180\242\190^h:\158\ETB\NUL\248\184Z\203\187E\DC1\248\237~\254U\USlSIcw`<bO\n\211\136\247\180\DLE:\135$"+ ,"\SI_!\EM\228xjwD@\fA_\DC2\DELO\f%*\CAN \n\rY/\193O\"\rg\tz\174"+ ,"\SOl\251uN\ENQ\DC1-v@\204\152%Hdy\\\177 `{H\128\f\r&\180\rvU\225\135\184M,}\134;M\169+m2\133?\SOH\176\225K1\219,\tR\202\221X\DC4Hb\201\234O\r\207\FS\194\ACK"+ ,">F\129_[-z^\EM\DELy^[-\SOIh\167h\222\134^3jGh\US\USd,\238\145\182b]\SO\146s\b\205\r\149\&8\250d\EM[j\254R\NAK?\162r\226\tci"+ ,"\EMoBm\ETX8"+ ,"B\f\249\148ljNt\f\FS\USyj&\234K&m\164\&2\172pKg"+ ,"\tg\161\253\GSjkKRRY\163:2\224\&6$\206:e\ETX*0\210\ACK\\*H0\194\139\171c\ACK\135c(3Y\DELS5\241\140Z*\NAK\212\159\DC4=m\184\SYNm_c\tC\202/A\SOH\SUB"+ ,"\ETB\235\tX@)B\DLE\b\141-sF('g\ENQ\193\202C>\236\ESC\186J^[RQ\250\DC2<oa\US\141\224~^txx\156\150\234~O>ag\b\246Ck\ETB6W\228\ETXC\ESCM\150\vKutG\CAN%\154z\220t\NAK\SIa\200\219<\v\201<\GSM"+ ,"\190\247;\209]\128\bGCaS\DEL<\240|rx\245\203}\170W\174(\162\SOBQ\230\222#HJxmhUZS\SUB\DC1#\166\165\139\184\&8]W\NUL4y\CAN\191\EM\b\179%}/'\r\a\ni} \SUB\EM$Z\DC3{it\NAK\138\164]s,@!-4\a0L\139"+ ,"'(^n4F\190+\ETB\a_u\ETXn\a"+ ,"{(\250EO|#\213==U<\STXOP\152\t\141\200+}\173\166\r\186mw\236~\RSg\187\ENQ\212\240\185P\RS;\ao^\250\128.@MHx66\"\195\232h\GSm\ttQ.|\NUL0\157{\244"+ ,"\251h\167\v0ao\165s3\GS;cB-\246CO3\DC3\RS/W\ETB\184\SOH~ \nV\"\223\189I\EM\139u\182C\DLET]\137\233\205`\229t|\v\n\163\&8f\255\GSX\NAK\nl\172"+ ,"\CAN?mAj\138\156\177?\RS\ESC\156Vv\225\&0\ACK\186\ESC\SOH <\190\NAK\239\&2\DLEW\193nF@2%kS\riL\US\246\DLE\249\137CO\DC1!{"+ ,"\DC2[M&\190\&1K\167\170O|\SI\tTE\150qL\tYP\FS_MvC\FSd|\DC1\168\f\SOD"+ ,"-;\136O\228f\USo\ENQZo\194g\SO\b\SOHY\DLE`f\r\ESC\243\&1\b\207\211| \201s\DC1-?R\RSlz Q\160\US\SIt:\ENQp\202&*1\n\205\233p*\NAK\SUBAC}\160\bX\217S\234]\187q\DLE\f\216dT\235\156\DC4\SO7\r\159Z#pgO\SI\FS"+ ,"kv\\"+ ,"HI\130+f$d\206Y\128\NULZ\228;[4\158uxnC\182"+ ,"\FSo[!Qx\198A64;\GSO#\US\f\172\DELv\ETXt\241\CAN)\227\195\DC4M)9\DC3D\150\182\185{\172Fby#Y3\"\DLE\133\DLE\241\140@4\251\EOT%\252al\SYN\RSmW`\172\207\\H?\144jx\STX\196Q.iy\SYN\n5S\142\&4H<\199\&3Wd\172"+ ,"\159%\EOT\f,\132\185\244jn}\b7\145 <\182~\v\138\ENQ}OA\a\RS<SH\222U\EMIE\184\n\GS"+ ]