dawg 0.8.2 → 0.9

raw patch · 27 files changed

+1351/−1356 lines, 27 filesdep +vector-binarydep −vector-binary-instancesdep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies added: vector-binary

Dependencies removed: vector-binary-instances

Dependency ranges changed: containers

API changes (from Hackage documentation)

Files

• Data/DAWG/Dynamic.hs +238/−0
• Data/DAWG/Dynamic/Internal.hs +27/−0
• Data/DAWG/Dynamic/Node.hs +80/−0
• Data/DAWG/Graph.hs +213/−0
• Data/DAWG/HashMap.hs +110/−0
• Data/DAWG/Static.hs +274/−0
• Data/DAWG/Static/Node.hs +98/−0
• Data/DAWG/Trans.hs +26/−0
• Data/DAWG/Trans/Hashed.hs +63/−0
• Data/DAWG/Trans/Map.hs +45/−0
• Data/DAWG/Trans/Vector.hs +58/−0
• Data/DAWG/Types.hs +12/−0
• Data/DAWG/Util.hs +58/−0
• README.md +0/−0
• dawg.cabal +49/−50
• src/Data/DAWG.hs +0/−41
• src/Data/DAWG/Graph.hs +0/−208
• src/Data/DAWG/HashMap.hs +0/−110
• src/Data/DAWG/Internal.hs +0/−269
• src/Data/DAWG/Node.hs +0/−114
• src/Data/DAWG/Static.hs +0/−302
• src/Data/DAWG/Trans.hs +0/−26
• src/Data/DAWG/Trans/Hashed.hs +0/−63
• src/Data/DAWG/Trans/Map.hs +0/−45
• src/Data/DAWG/Trans/Vector.hs +0/−58
• src/Data/DAWG/Types.hs +0/−12
• src/Data/DAWG/Util.hs +0/−58

@@ -0,0 +1,238 @@+-- | The module implements /directed acyclic word graphs/ (DAWGs) internaly+-- represented as /minimal acyclic deterministic finite-state automata/.+-- The implementation provides fast insert and delete operations+-- which can be used to build the DAWG structure incrementaly.++module Data.DAWG.Dynamic+(+-- * DAWG type+  DAWG+-- * Query+, numStates+, numEdges+, lookup+-- * Construction+, empty+, fromList+, fromListWith+, fromLang+-- ** Insertion+, insert+, insertWith+-- ** Deletion+, delete+-- * Conversion+, assocs+, keys+, elems+) where++import Prelude hiding (lookup)+import Control.Applicative ((<$>), (<*>))+import Control.Arrow (first)+import Data.List (foldl')+import qualified Control.Monad.State.Strict as S++import Data.DAWG.Types+import Data.DAWG.Graph (Graph)+import Data.DAWG.Dynamic.Internal+import qualified Data.DAWG.Trans as T+import qualified Data.DAWG.Graph as G+import qualified Data.DAWG.Dynamic.Node as N++type GraphM a b = S.State (Graph (N.Node a)) b++mkState :: (Graph a -> Graph a) -> Graph a -> ((), Graph a)+mkState f g = ((), f g)++-- | Return node with the given identifier.+nodeBy :: ID -> GraphM a (N.Node a)+nodeBy i = G.nodeBy i <$> S.get++-- Evaluate the 'G.insert' function within the monad.+insertNode :: Ord a => N.Node a -> GraphM a ID+insertNode = S.state . G.insert++-- | Leaf node with no children and 'Nothing' value.+insertLeaf :: Ord a => GraphM a ID+insertLeaf = do+    i <- insertNode (N.Leaf Nothing)+    insertNode (N.Branch i T.empty)++-- Evaluate the 'G.delete' function within the monad.+deleteNode :: Ord a => N.Node a -> GraphM a ()+deleteNode = S.state . mkState . G.delete++-- | Invariant: the identifier points to the 'Branch' node.+insertM :: Ord a => [Sym] -> a -> ID -> GraphM a ID+insertM (x:xs) y i = do+    n <- nodeBy i+    j <- case N.onSym x n of+        Just j  -> return j+        Nothing -> insertLeaf+    k <- insertM xs y j+    deleteNode n+    insertNode (N.insert x k n)+insertM [] y i = do+    n <- nodeBy i+    w <- nodeBy (N.eps n)+    deleteNode w+    deleteNode n+    j <- insertNode (N.Leaf $ Just y)+    insertNode (n { N.eps = j })++insertWithM+    :: Ord a => (a -> a -> a)+    -> [Sym] -> a -> ID -> GraphM a ID+insertWithM f (x:xs) y i = do+    n <- nodeBy i+    j <- case N.onSym x n of+        Just j  -> return j+        Nothing -> insertLeaf+    k <- insertWithM f xs y j+    deleteNode n+    insertNode (N.insert x k n)+insertWithM f [] y i = do+    n <- nodeBy i+    w <- nodeBy (N.eps n)+    deleteNode w+    deleteNode n+    let y'new = case N.value w of+            Just y' -> f y y'+            Nothing -> y+    j <- insertNode (N.Leaf $ Just y'new)+    insertNode (n { N.eps = j })++deleteM :: Ord a => [Sym] -> ID -> GraphM a ID+deleteM (x:xs) i = do+    n <- nodeBy i+    case N.onSym x n of+        Nothing -> return i+        Just j  -> do+            k <- deleteM xs j+            deleteNode n+            insertNode (N.insert x k n)+deleteM [] i = do+    n <- nodeBy i+    w <- nodeBy (N.eps n)+    deleteNode w+    deleteNode n+    j <- insertLeaf+    insertNode (n { N.eps = j })+    +lookupM :: [Sym] -> ID -> GraphM a (Maybe a)+lookupM [] i = do+    j <- N.eps <$> nodeBy i+    N.value <$> nodeBy j+lookupM (x:xs) i = do+    n <- nodeBy i+    case N.onSym x n of+        Just j  -> lookupM xs j+        Nothing -> return Nothing++assocsAcc :: Graph (N.Node a) -> ID -> [([Sym], a)]+assocsAcc g i =+    here w ++ concatMap there (N.edges n)+  where+    n = G.nodeBy i g+    w = G.nodeBy (N.eps n) g+    here v = case N.value v of+        Just x  -> [([], x)]+        Nothing -> []+    there (sym, j) = map (first (sym:)) (assocsAcc g j)++-- | Empty DAWG.+empty :: Ord b => DAWG a b+empty = +    let (i, g) = S.runState insertLeaf G.empty+    in  DAWG g i++-- | Number of states in the automaton.+numStates :: DAWG a b -> Int+numStates = G.size . graph++-- | Number of edges in the automaton.+numEdges :: DAWG a b -> Int+numEdges = sum . map (length . N.edges) . G.nodes . graph++-- | Insert the (key, value) pair into the DAWG.+insert :: (Enum a, Ord b) => [a] -> b -> DAWG a b -> DAWG a b+insert xs' y d =+    let xs = map fromEnum xs'+        (i, g) = S.runState (insertM xs y $ root d) (graph d)+    in  DAWG g i+{-# INLINE insert #-}+{-# SPECIALIZE insert :: Ord b => String -> b -> DAWG Char b -> DAWG Char b #-}++-- | Insert with a function, combining new value and old value.+-- 'insertWith' f key value d will insert the pair (key, value) into d if+-- key does not exist in the DAWG. If the key does exist, the function+-- will insert the pair (key, f new_value old_value).+insertWith+    :: (Enum a, Ord b) => (b -> b -> b)+    -> [a] -> b -> DAWG a b -> DAWG a b+insertWith f xs' y d =+    let xs = map fromEnum xs'+        (i, g) = S.runState (insertWithM f xs y $ root d) (graph d)+    in  DAWG g i+{-# SPECIALIZE insertWith+        :: Ord b => (b -> b -> b) -> String -> b+        -> DAWG Char b -> DAWG Char b #-}++-- | Delete the key from the DAWG.+delete :: (Enum a, Ord b) => [a] -> DAWG a b -> DAWG a b+delete xs' d =+    let xs = map fromEnum xs'+        (i, g) = S.runState (deleteM xs $ root d) (graph d)+    in  DAWG g i+{-# SPECIALIZE delete :: Ord b => String -> DAWG Char b -> DAWG Char b #-}++-- | Find value associated with the key.+lookup :: (Enum a, Ord b) => [a] -> DAWG a b -> Maybe b+lookup xs' d =+    let xs = map fromEnum xs'+    in  S.evalState (lookupM xs $ root d) (graph d)+{-# SPECIALIZE lookup :: Ord b => String -> DAWG Char b -> Maybe b #-}++-- | Return all key/value pairs in the DAWG in ascending key order.+assocs :: (Enum a, Ord b) => DAWG a b -> [([a], b)]+assocs+    = map (first (map toEnum))+    . (assocsAcc <$> graph <*> root)+{-# SPECIALIZE assocs :: Ord b => DAWG Char b -> [(String, b)] #-}++-- | Return all keys of the DAWG in ascending order.+keys :: (Enum a, Ord b) => DAWG a b -> [[a]]+keys = map fst . assocs+{-# SPECIALIZE keys :: Ord b => DAWG Char b -> [String] #-}++-- | Return all elements of the DAWG in the ascending order of their keys.+elems :: Ord b => DAWG a b -> [b]+elems = map snd . (assocsAcc <$> graph <*> root)++-- | Construct DAWG from the list of (word, value) pairs.+fromList :: (Enum a, Ord b) => [([a], b)] -> DAWG a b+fromList xs =+    let update t (x, v) = insert x v t+    in  foldl' update empty xs+{-# INLINE fromList #-}+{-# SPECIALIZE fromList :: Ord b => [(String, b)] -> DAWG Char b #-}++-- | Construct DAWG from the list of (word, value) pairs+-- with a combining function.  The combining function is+-- applied strictly.+fromListWith+    :: (Enum a, Ord b) => (b -> b -> b)+    -> [([a], b)] -> DAWG a b+fromListWith f xs =+    let update t (x, v) = insertWith f x v t+    in  foldl' update empty xs+{-# SPECIALIZE fromListWith+        :: Ord b => (b -> b -> b)+        -> [(String, b)] -> DAWG Char b #-}++-- | Make DAWG from the list of words.  Annotate each word with+-- the @()@ value.+fromLang :: Enum a => [[a]] -> DAWG a ()+fromLang xs = fromList [(x, ()) | x <- xs]+{-# SPECIALIZE fromLang :: [String] -> DAWG Char () #-}

@@ -0,0 +1,27 @@+-- | The module exports internal representation of dynamic DAWG.++module Data.DAWG.Dynamic.Internal+(+-- * DAWG type+  DAWG (..)+) where++import Control.Applicative ((<$>), (<*>))+import Data.Binary (Binary, put, get)++import Data.DAWG.Types+import Data.DAWG.Graph (Graph)+import qualified Data.DAWG.Dynamic.Node as N++-- | A directed acyclic word graph with phantom type @a@ representing+-- type of alphabet elements.+data DAWG a b = DAWG+    { graph :: !(Graph (N.Node b))+    , root  :: !ID }+    deriving (Show, Eq, Ord)++instance (Ord b, Binary b) => Binary (DAWG a b) where+    put d = do+        put (graph d)+        put (root d)+    get = DAWG <$> get <*> get

@@ -0,0 +1,80 @@+{-# LANGUAGE RecordWildCards #-}++-- | Internal representation of dynamic automata nodes.++module Data.DAWG.Dynamic.Node+( Node(..)+, onSym+, edges+, children+, insert+) where++import Control.Applicative ((<$>), (<*>))+import Data.Binary (Binary, Get, put, get)++import Data.DAWG.Types+import Data.DAWG.Util (combine)+import Data.DAWG.HashMap (Hash, hash)+import Data.DAWG.Trans.Map (Trans)+import qualified Data.DAWG.Trans as T+import qualified Data.DAWG.Trans.Hashed as H++-- | Two nodes (states) belong to the same equivalence class (and,+-- consequently, they must be represented as one node in the graph)+-- iff they are equal with respect to their values and outgoing+-- edges.+--+-- Since 'Leaf' nodes are distinguished from 'Branch' nodes, two values+-- equal with respect to '==' function are always kept in one 'Leaf'+-- node in the graph.  It doesn't change the fact that to all 'Branch'+-- nodes one value is assigned through the epsilon transition.+--+-- Invariant: the 'eps' identifier always points to the 'Leaf' node.+-- Edges in the 'edgeMap', on the other hand, point to 'Branch' nodes.+data Node a+    = Branch {+        -- | Epsilon transition.+          eps       :: {-# UNPACK #-} !ID+        -- | Transition map (outgoing edges).+        , transMap  :: !(H.Hashed Trans) }+    | Leaf { value  :: !(Maybe a) }+    deriving (Show, Eq, Ord)++instance Ord a => Hash (Node a) where+    hash Branch{..} = combine eps (H.hash transMap)+    hash Leaf{..}   = case value of+    	Just _	-> (-1)+	Nothing	-> (-2)++instance Binary a => Binary (Node a) where+    put Branch{..} = put (1 :: Int) >> put eps >> put transMap+    put Leaf{..}   = put (2 :: Int) >> put value+    get = do+        x <- get :: Get Int+        case x of+            1 -> Branch <$> get <*> get+            _ -> Leaf <$> get++-- | Transition function.+onSym :: Sym -> Node a -> Maybe ID+onSym x (Branch _ t)    = T.lookup x t+onSym _ (Leaf _)        = Nothing+{-# INLINE onSym #-}++-- | List of symbol/edge pairs outgoing from the node.+edges :: Node a -> [(Sym, ID)]+edges (Branch _ t)  = T.toList t+edges (Leaf _)      = []+{-# INLINE edges #-}++-- | List of children identifiers.+children :: Node a -> [ID]+children = map snd . edges+{-# INLINE children #-}++-- | Substitue edge determined by a given symbol.+insert :: Sym -> ID -> Node a -> Node a+insert x i (Branch w t) = Branch w (T.insert x i t)+insert _ _ l            = l+{-# INLINE insert #-}

@@ -0,0 +1,213 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DoAndIfThenElse #-}++-- | Internal representation of the "Data.DAWG" automaton.  Names in this+-- module correspond to a graphical representation of automaton: nodes refer+-- to states and edges refer to transitions.++module Data.DAWG.Graph+( Graph (..)+, empty+, size+, nodes+, nodeBy+, insert+, delete+) where++import Control.Applicative ((<$>), (<*>))+import Data.Binary (Binary, put, get)+import qualified Data.IntSet as S+import qualified Data.IntMap as M++import Data.DAWG.HashMap (Hash)+import qualified Data.DAWG.HashMap as H++type ID = Int++-- | A set of nodes.  To every node a unique identifier is assigned.+-- Invariants: +--+--   * freeIDs \\intersection occupiedIDs = \\emptySet,+--+--   * freeIDs \\sum occupiedIDs =+--     {0, 1, ..., |freeIDs \\sum occupiedIDs| - 1},+--+-- where occupiedIDs = elemSet idMap.+--+-- TODO: Is it possible to merge 'freeIDs' with 'ingoMap' to reduce+-- the memory footprint?+data Graph n = Graph {+    -- | Map from nodes to IDs with hash values interpreted+    -- as keys and (node, ID) pairs interpreted as map elements.+      idMap     :: !(H.HashMap n ID)+    -- | Set of free IDs.+    , freeIDs   :: !S.IntSet+    -- | Map from IDs to nodes. +    , nodeMap   :: !(M.IntMap n)+    -- | Number of ingoing paths (different paths from the root+    -- to the given node) for each node ID in the graph.+    -- The number of ingoing paths can be also interpreted as+    -- a number of occurences of the node in a tree representation+    -- of the graph.+    , ingoMap   :: !(M.IntMap Int) }+    deriving (Show, Eq, Ord)++instance (Ord n, Binary n) => Binary (Graph n) where+    put Graph{..} = do+        put idMap+        put freeIDs+        put nodeMap+        put ingoMap+    get = Graph <$> get <*> get <*> get <*> get++-- | Empty graph.+empty :: Graph n+empty = Graph H.empty S.empty M.empty M.empty++-- | Size of the graph (number of nodes).+size :: Graph n -> Int+size = H.size . idMap++-- | List of graph nodes.+nodes :: Graph n -> [n]+nodes = M.elems . nodeMap++-- | Node with the given identifier.+nodeBy :: ID -> Graph n -> n+nodeBy i g = nodeMap g M.! i++-- | Retrieve identifier of a node assuming that the node+-- is present in the graph.  If the assumption is not+-- safisfied, the returned identifier may be incorrect.+nodeID'Unsafe :: Hash n => n -> Graph n -> ID+nodeID'Unsafe n g = H.lookupUnsafe n (idMap g)++-- | Add new graph node (assuming that it is not already a member+-- of the graph).+newNode :: Hash n => n -> Graph n -> (ID, Graph n)+newNode n Graph{..} =+    (i, Graph idMap' freeIDs' nodeMap' ingoMap')+  where+    idMap'      = H.insertUnsafe n i idMap+    nodeMap'    = M.insert i n nodeMap+    ingoMap'    = M.insert i 1 ingoMap+    (i, freeIDs') = if S.null freeIDs+        then (H.size idMap, freeIDs)+        else S.deleteFindMin freeIDs++-- | Remove node from the graph (assuming that it is a member+-- of the graph).+remNode :: Hash n => ID -> Graph n -> Graph n+remNode i Graph{..} =+    Graph idMap' freeIDs' nodeMap' ingoMap'+  where+    idMap'      = H.deleteUnsafe n idMap+    nodeMap'    = M.delete i nodeMap+    ingoMap'    = M.delete i ingoMap+    freeIDs'    = S.insert i freeIDs+    n           = nodeMap M.! i++-- | Increment the number of ingoing paths.+incIngo :: ID -> Graph n -> Graph n+incIngo i g = g { ingoMap = M.insertWith' (+) i 1 (ingoMap g) }++-- | Decrement the number of ingoing paths and return+-- the resulting number.+decIngo :: ID -> Graph n -> (Int, Graph n)+decIngo i g =+    let k = (ingoMap g M.! i) - 1+    in  (k, g { ingoMap = M.insert i k (ingoMap g) })++-- | Insert node into the graph.  If the node was already a member+-- of the graph, just increase the number of ingoing paths.+-- NOTE: Number of ingoing paths will not be changed for any descendants+-- of the node, so the operation alone will not ensure that properties+-- of the graph are preserved.+insert :: Hash n => n -> Graph n -> (ID, Graph n)+insert n g = case H.lookup n (idMap g) of+    Just i  -> (i, incIngo i g)+    Nothing -> newNode n g++-- | Delete node from the graph.  If the node was present in the graph+-- at multiple positions, just decrease the number of ingoing paths.+-- Function crashes if the node is not a member of the graph. +-- NOTE: The function does not delete descendant nodes which may become+-- inaccesible nor does it change the number of ingoing paths for any+-- descendant of the node.+delete :: Hash n => n -> Graph n -> Graph n+delete n g = if num == 0+    then remNode i g'+    else g'+  where+    i = nodeID'Unsafe n g+    (num, g') = decIngo i g++-- -- | Construct a graph from a list of node/ID pairs and a root ID.+-- -- Identifiers must be consistent with edges outgoing from+-- -- individual nodes.+-- fromNodes :: Ord a => [(Node a, ID)] -> ID -> Graph a+-- fromNodes xs rootID = graph+--   where+--     graph = Graph+--         (M.fromList xs)+--         IS.empty+--         (IM.fromList $ map swap xs)+--         ( foldl' updIngo (IM.singleton rootID 1)+--             $ topSort graph rootID )+--     swap (x, y) = (y, x)+--     updIngo m i =+--         let n = nodeBy i graph+--             ingo = m IM.! i+--         in  foldl' (push ingo) m (edges n)+--     push x m j = IM.adjust (+x) j m+-- +-- postorder :: T.Tree a -> [a] -> [a]+-- postorder (T.Node a ts) = postorderF ts . (a :)+-- +-- postorderF :: T.Forest a -> [a] -> [a]+-- postorderF ts = foldr (.) id $ map postorder ts+-- +-- postOrd :: Graph a -> ID -> [ID]+-- postOrd g i = postorder (dfs g i) []+-- +-- -- | Topological sort given a root ID.+-- topSort :: Graph a -> ID -> [ID]+-- topSort g = reverse . postOrd g+-- +-- -- | Depth first search starting with given ID.+-- dfs :: Graph a -> ID -> T.Tree ID+-- dfs g = prune . generate g+-- +-- generate :: Graph a -> ID -> T.Tree ID+-- generate g i = T.Node i+--     ( T.Node (eps n) []+--     : map (generate g) (edges n) )+--   where+--     n = nodeBy i g+-- +-- type SetM a = S.State IS.IntSet a+-- +-- run :: SetM a -> a+-- run act = S.evalState act IS.empty+-- +-- contains :: ID -> SetM Bool+-- contains i = IS.member i <$> S.get+-- +-- include :: ID -> SetM ()+-- include i = S.modify (IS.insert i)+-- +-- prune :: T.Tree ID -> T.Tree ID+-- prune t = head $ run (chop [t])+-- +-- chop :: T.Forest ID -> SetM (T.Forest ID)+-- chop [] = return []+-- chop (T.Node v ts : us) = do+--     visited <- contains v+--     if visited then+--         chop us+--     else do+--         include v+--         as <- chop ts+--         bs <- chop us+--         return (T.Node v as : bs)

@@ -0,0 +1,110 @@+{-# LANGUAGE RecordWildCards #-}++-- | A map from hashable keys to values.++module Data.DAWG.HashMap+( Hash (..)+, HashMap (..)+, empty+, lookup+, insertUnsafe+, lookupUnsafe+, deleteUnsafe+) where++import Prelude hiding (lookup)+import Control.Applicative ((<$>), (<*>))+import Data.Binary (Binary, Get, put, get)+import qualified Data.Map as M+import qualified Data.IntMap as I++fromJust :: Maybe a -> a+fromJust (Just x)   = x+fromJust Nothing    = error "fromJust: Nothing"+{-# INLINE fromJust #-}++-- | Class for types which provide hash values.+class Ord a => Hash a where+    hash    :: a -> Int++-- | Value in a HashMap.+data Value a b+    = Single !a !b+    | Multi  !(M.Map a b)+    deriving (Show, Eq, Ord)++instance (Ord a, Binary a, Binary b) => Binary (Value a b) where+    put (Single x y)    = put (1 :: Int) >> put x >> put y+    put (Multi m)       = put (2 :: Int) >> put m+    get = do+        x <- get :: Get Int+        case x of+            1   -> Single <$> get <*> get+            _   -> Multi <$> get++-- | Find element associated to a value key.+find :: Ord a => a -> Value a b -> Maybe b+find x (Single x' y) = if x == x'+    then Just y+    else Nothing+find x (Multi m) = M.lookup x m++-- | Assumption: element is a member of the 'Value'. +findUnsafe :: Ord a => a -> Value a b -> Maybe b+findUnsafe _ (Single _ y) = Just y	-- unsafe+findUnsafe x (Multi m) = M.lookup x m++-- | Convert map into a 'Single' form if possible.+trySingle :: Ord a => M.Map a b -> Value a b+trySingle m = if M.size m == 1+    then (uncurry Single) (M.findMin m)+    else Multi m++-- | Insert element into a value.+embed :: Ord a => a -> b -> Value a b -> Value a b+embed x y (Single x' y')    = Multi $ M.fromList [(x, y), (x', y')]+embed x y (Multi m)         = Multi $ M.insert x y m++-- | Delete element from a value.  Return 'Nothing' if the resultant+-- value is empty.+ejectUnsafe :: Ord a => a -> Value a b -> Maybe (Value a b)+ejectUnsafe _ (Single _ _)  = Nothing    -- unsafe+ejectUnsafe x (Multi m)     = (Just . trySingle) (M.delete x m)++-- | A map from /a/ keys to /b/ elements where keys instantiate the+-- 'Hash' type class.  Key/element pairs are kept in 'Value' objects+-- which takes care of potential hash collisions.+data HashMap a b = HashMap+    { size      :: {-# UNPACK #-} !Int+    , hashMap   :: !(I.IntMap (Value a b)) }+    deriving (Show, Eq, Ord)++instance (Ord a, Binary a, Binary b) => Binary (HashMap a b) where+    put HashMap{..} = put size >> put hashMap+    get = HashMap <$> get <*> get++-- | Empty map.+empty :: HashMap a b+empty = HashMap 0 I.empty++-- | Lookup element in the map.+lookup :: Hash a => a -> HashMap a b -> Maybe b+lookup x (HashMap _ m) = I.lookup (hash x) m >>= find x++-- | Assumption: element is present in the map.+lookupUnsafe :: Hash a => a -> HashMap a b -> b+lookupUnsafe x (HashMap _ m) = fromJust (I.lookup (hash x) m >>= findUnsafe x)++-- | Insert a new element.  The function doesn't check+-- if the element was already present in the map.+insertUnsafe :: Hash a => a -> b -> HashMap a b -> HashMap a b+insertUnsafe x y (HashMap n m) =+    let i = hash x+        f (Just v)  = embed x y v+        f Nothing   = Single x y+    in  HashMap (n + 1) $ I.alter (Just . f) i m++-- | Assumption: element is present in the map.+deleteUnsafe :: Hash a => a -> HashMap a b -> HashMap a b+deleteUnsafe x (HashMap n m) =+    HashMap (n - 1) $ I.update (ejectUnsafe x) (hash x) m

@@ -0,0 +1,274 @@+{-# LANGUAGE RecordWildCards #-}++-- | The module implements /directed acyclic word graphs/ (DAWGs) internaly+-- represented as /minimal acyclic deterministic finite-state automata/.+--+-- In comparison to "Data.DAWG.Dynamic" module the automaton implemented here:+--+--   * Keeps all nodes in one array and therefore uses less memory,+--+--   * When 'weigh'ed, it can be used to perform static hashing with+--     'hash' and 'unHash' functions,+--+--   * Doesn't provide insert/delete family of operations.++module Data.DAWG.Static+(+-- * DAWG type+  DAWG+-- * Query+, lookup+, numStates+, numEdges+-- * Index+, index+, byIndex+-- * Hash+, hash+, unHash+-- * Construction+, empty+, fromList+, fromListWith+, fromLang+, freeze+-- * Weight+, Weight+, weigh+-- * Conversion+, assocs+, keys+, elems+-- , thaw+) where++import Prelude hiding (lookup)+import Control.Applicative ((<$), (<$>), (<|>))+import Control.Arrow (first)+import Data.Binary (Binary, put, get)+import Data.Vector.Binary ()+import Data.Vector.Unboxed (Unbox)+import qualified Data.IntMap as M+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U++import Data.DAWG.Types+import qualified Data.DAWG.Util as Util+import qualified Data.DAWG.Trans as T+import qualified Data.DAWG.Static.Node as N+import qualified Data.DAWG.Graph as G+import qualified Data.DAWG.Dynamic as D+import qualified Data.DAWG.Dynamic.Internal as D++-- | @DAWG a b c@ constitutes an automaton with alphabet symbols of type /a/,+-- transition labels of type /b/ and node values of type /Maybe c/.+-- All nodes are stored in a 'V.Vector' with positions of nodes corresponding+-- to their 'ID's.+newtype DAWG a b c = DAWG { unDAWG :: V.Vector (N.Node b c) }+    deriving (Show, Eq, Ord)++instance (Binary b, Binary c, Unbox b) => Binary (DAWG a b c) where+    put = put . unDAWG+    get = DAWG <$> get++-- | Empty DAWG.+empty :: Unbox b => DAWG a b c+empty = DAWG $ V.fromList+    [ N.Branch 1 T.empty U.empty+    , N.Leaf Nothing ]++-- | Number of states in the automaton.+numStates :: DAWG a b c -> Int+numStates = V.length . unDAWG++-- | Number of edges in the automaton.+numEdges :: DAWG a b c -> Int+numEdges = sum . map (length . N.edges) . V.toList . unDAWG++-- | Node with the given identifier.+nodeBy :: ID -> DAWG a b c -> N.Node b c+nodeBy i d = unDAWG d V.! i++-- | Value in leaf node with a given ID.+leafValue :: N.Node b c -> DAWG a b c -> Maybe c+leafValue n = N.value . nodeBy (N.eps n)++-- | Find value associated with the key.+lookup :: (Enum a, Unbox b) => [a] -> DAWG a b c -> Maybe c+lookup xs' =+    let xs = map fromEnum xs'+    in  lookup'I xs 0+{-# SPECIALIZE lookup :: Unbox b => String -> DAWG Char b c -> Maybe c #-}++lookup'I :: Unbox b => [Sym] -> ID -> DAWG a b c -> Maybe c+lookup'I []     i d = leafValue (nodeBy i d) d+lookup'I (x:xs) i d = case N.onSym x (nodeBy i d) of+    Just j  -> lookup'I xs j d+    Nothing -> Nothing++-- | Return all key/value pairs in the DAWG in ascending key order.+assocs :: (Enum a, Unbox b) => DAWG a b c -> [([a], c)]+assocs d = map (first (map toEnum)) (assocs'I 0 d)+{-# SPECIALIZE assocs :: Unbox b => DAWG Char b c -> [(String, c)] #-}++assocs'I :: Unbox b => ID -> DAWG a b c -> [([Sym], c)]+assocs'I i d =+    here ++ concatMap there (N.edges n)+  where+    n = nodeBy i d+    here = case leafValue n d of+        Just x  -> [([], x)]+        Nothing -> []+    there (x, j) = map (first (x:)) (assocs'I j d)++-- | Return all keys of the DAWG in ascending order.+keys :: (Enum a, Unbox b) => DAWG a b c -> [[a]]+keys = map fst . assocs+{-# SPECIALIZE keys :: Unbox b => DAWG Char b c -> [String] #-}++-- | Return all elements of the DAWG in the ascending order of their keys.+elems :: Unbox b => DAWG a b c -> [c]+elems = map snd . assocs'I 0++-- | Construct 'DAWG' from the list of (word, value) pairs.+-- First a 'D.DAWG' is created and then it is frozen using+-- the 'freeze' function.+fromList :: (Enum a, Ord b) => [([a], b)] -> DAWG a () b+fromList = freeze . D.fromList+{-# SPECIALIZE fromList :: Ord b => [(String, b)] -> DAWG Char () b #-}++-- | Construct DAWG from the list of (word, value) pairs+-- with a combining function.  The combining function is+-- applied strictly. First a 'D.DAWG' is created and then+-- it is frozen using the 'freeze' function.+fromListWith :: (Enum a, Ord b) => (b -> b -> b) -> [([a], b)] -> DAWG a () b+fromListWith f = freeze . D.fromListWith f+{-# SPECIALIZE fromListWith+        :: Ord b => (b -> b -> b)+        -> [(String, b)] -> DAWG Char () b #-}++-- | Make DAWG from the list of words.  Annotate each word with+-- the @()@ value.  First a 'D.DAWG' is created and then it is frozen+-- using the 'freeze' function.+fromLang :: Enum a => [[a]] -> DAWG a () ()+fromLang = freeze . D.fromLang+{-# SPECIALIZE fromLang :: [String] -> DAWG Char () () #-}++-- | Weight of a node corresponds to the number of final states+-- reachable from the node.  Weight of an edge is a sum of weights+-- of preceding nodes outgoing from the same parent node.+type Weight = Int++-- | Compute node weights and store corresponding values in transition labels.+weigh :: DAWG a b c -> DAWG a Weight c+weigh d = (DAWG . V.fromList)+    [ branch n ws+    | i <- [0 .. numStates d - 1]+    , let n  = nodeBy i d+    , let ws = accum (N.children n) ]+  where+    -- Branch with new weights.+    branch N.Branch{..} ws  = N.Branch eps transMap ws+    branch N.Leaf{..} _     = N.Leaf value+    -- In nodeWeight node weights are memoized.+    nodeWeight = ((V.!) . V.fromList) (map detWeight [0 .. numStates d - 1])+    -- Determine weight of the node.+    detWeight i = case nodeBy i d of+        N.Leaf w    -> maybe 0 (const 1) w+        n           -> sum . map nodeWeight $ allChildren n+    -- Weights for subsequent edges.+    accum = U.fromList . init . scanl (+) 0 . map nodeWeight+    -- Plain children and epsilon child. +    allChildren n = N.eps n : N.children n++-- | Construct immutable version of the automaton.+freeze :: D.DAWG a b -> DAWG a () b+freeze d = DAWG . V.fromList $+    map (N.fromDyn newID . oldBy)+        (M.elems (inverse old2new))+  where+    -- Map from old to new identifiers.+    old2new = M.fromList $ (D.root d, 0) : zip (nodeIDs d) [1..]+    newID   = (M.!) old2new+    -- List of node IDs without the root ID.+    nodeIDs = filter (/= D.root d) . map fst . M.assocs . G.nodeMap . D.graph+    -- Non-frozen node by given identifier.+    oldBy i = G.nodeBy i (D.graph d)+        +-- | Inverse of the map.+inverse :: M.IntMap Int -> M.IntMap Int+inverse =+    let swap (x, y) = (y, x)+    in  M.fromList . map swap . M.toList++-- -- | Yield mutable version of the automaton.+-- thaw :: (Unbox b, Ord a) => DAWG a b c -> D.DAWG a b+-- thaw d =+--     D.fromNodes nodes 0+--   where+--     -- List of resulting nodes.+--     nodes = branchNodes ++ leafNodes+--     -- Branching nodes.+--     branchNodes =+--         [ +--     -- Number of states used to shift new value IDs.+--     n = numStates d+--     -- New identifiers for value nodes.+--     valIDs = foldl' updID GM.empty (values d)+--     -- Values in the automaton.+--     values = map value . V.toList . unDAWG+--     -- Update ID map.+--     updID m v = case GM.lookup v m of+--         Just i  -> m+--         Nothing -> +--             let j = GM.size m + n+--             in  j `seq` GM.insert v j++-- | Position in a set of all dictionary entries with respect+-- to the lexicographic order.+index :: Enum a => [a] -> DAWG a Weight c -> Maybe Int+index xs = index'I (map fromEnum xs) 0+{-# SPECIALIZE index :: String -> DAWG Char Weight c -> Maybe Int #-}++index'I :: [Sym] -> ID -> DAWG a Weight c -> Maybe Int+index'I []     i d = 0 <$ leafValue (nodeBy i d) d+index'I (x:xs) i d = do+    let n = nodeBy i d+        u = maybe 0 (const 1) (leafValue n d)+    (j, v) <- N.onSym' x n+    w <- index'I xs j d+    return (u + v + w)++-- | Perfect hashing function for dictionary entries.+-- A synonym for the 'index' function.+hash :: Enum a => [a] -> DAWG a Weight c -> Maybe Int+hash = index+{-# INLINE hash #-}++-- | Find dictionary entry given its index with respect to the+-- lexicographic order.+byIndex :: Enum a => Int -> DAWG a Weight c -> Maybe [a]+byIndex ix d = map toEnum <$> byIndex'I ix 0 d+{-# SPECIALIZE byIndex :: Int -> DAWG Char Weight c -> Maybe String #-}++byIndex'I :: Int -> ID -> DAWG a Weight c -> Maybe [Sym]+byIndex'I ix i d+    | ix < 0    = Nothing+    | otherwise = here <|> there+  where+    n = nodeBy i d+    u = maybe 0 (const 1) (leafValue n d)+    here+        | ix == 0   = [] <$ leafValue (nodeBy i d) d+        | otherwise = Nothing+    there = do+        (k, w) <- Util.findLastLE cmp (N.labelVect n)+        (x, j) <- T.byIndex k (N.transMap n)+        xs <- byIndex'I (ix - u - w) j d+        return (x:xs)+    cmp w = compare w (ix - u)++-- | Inverse of the 'hash' function and a synonym for the 'byIndex' function.+unHash :: Enum a => Int -> DAWG a Weight c -> Maybe [a]+unHash = byIndex+{-# INLINE unHash #-}

@@ -0,0 +1,98 @@+{-# LANGUAGE RecordWildCards #-}++-- | Internal representation of static automata nodes.++module Data.DAWG.Static.Node+( Node(..)+, onSym+, onSym'+, edges+, children+, insert+, fromDyn+) where++import Control.Arrow (second)+import Control.Applicative ((<$>), (<*>))+import Data.Binary (Binary, Get, put, get)+import Data.Vector.Binary ()+import qualified Data.Vector.Unboxed as U++import Data.DAWG.Types+import Data.DAWG.Trans.Vector (Trans)+import qualified Data.DAWG.Trans as T+import qualified Data.DAWG.Dynamic.Node as D++-- | Two nodes (states) belong to the same equivalence class (and,+-- consequently, they must be represented as one node in the graph)+-- iff they are equal with respect to their values and outgoing+-- edges.+--+-- Since 'Leaf' nodes are distinguished from 'Branch' nodes, two values+-- equal with respect to '==' function are always kept in one 'Leaf'+-- node in the graph.  It doesn't change the fact that to all 'Branch'+-- nodes one value is assigned through the epsilon transition.+--+-- Invariant: the 'eps' identifier always points to the 'Leaf' node.+-- Edges in the 'edgeMap', on the other hand, point to 'Branch' nodes.+data Node a b+    = Branch {+        -- | Epsilon transition.+          eps       :: {-# UNPACK #-} !ID+        -- | Transition map (outgoing edges).+        , transMap  :: !Trans+        -- | Labels corresponding to individual edges.+        , labelVect :: !(U.Vector a) }+    | Leaf { value  :: !(Maybe b) }+    deriving (Show, Eq, Ord)++instance (U.Unbox a, Binary a, Binary b) => Binary (Node a b) where+    put Branch{..} = put (1 :: Int) >> put eps >> put transMap >> put labelVect+    put Leaf{..}   = put (2 :: Int) >> put value+    get = do+        x <- get :: Get Int+        case x of+            1 -> Branch <$> get <*> get <*> get+            _ -> Leaf <$> get++-- | Transition function.+onSym :: Sym -> Node a b -> Maybe ID+onSym x (Branch _ t _)  = T.lookup x t+onSym _ (Leaf _)        = Nothing+{-# INLINE onSym #-}++-- | Transition function.+onSym' :: U.Unbox a => Sym -> Node a b -> Maybe (ID, a)+onSym' x (Branch _ t ls)   = do+    k <- T.index x t+    (,) <$> (snd <$> T.byIndex k t)+        <*> ls U.!? k+onSym' _ (Leaf _)           = Nothing+{-# INLINE onSym' #-}++-- | List of symbol/edge pairs outgoing from the node.+edges :: Node a b -> [(Sym, ID)]+edges (Branch _ t _)    = T.toList t+edges (Leaf _)          = []+{-# INLINE edges #-}++-- | List of children identifiers.+children :: Node a b -> [ID]+children = map snd . edges+{-# INLINE children #-}++-- | Substitue edge determined by a given symbol.+insert :: Sym -> ID -> Node a b -> Node a b+insert x i (Branch w t ls)  = Branch w (T.insert x i t) ls+insert _ _ l                = l+{-# INLINE insert #-}++-- | Make "static" node from a "dynamic" node.+fromDyn+    :: (ID -> ID)   -- ^ Assign new IDs +    -> D.Node b     -- ^ "Dynamic" node+    -> Node () b    -- ^ "Static" node+fromDyn _ (D.Leaf x)        = Leaf x+fromDyn f (D.Branch e t)    =+    let reTrans = T.fromList . map (second f) . T.toList+    in  Branch (f e) (reTrans t) U.empty

@@ -0,0 +1,26 @@+-- | The module provides an abstraction over transition maps from+-- alphabet symbols to node identifiers.++module Data.DAWG.Trans+( Trans (..)+) where++import Data.DAWG.Types++-- | Abstraction over transition maps from alphabet symbols to+-- node identifiers.+class Trans t where+    -- | Empty transition map.+    empty       :: t+    -- | Lookup sybol in the map.+    lookup      :: Sym -> t -> Maybe ID+    -- | Find index of the symbol.+    index       :: Sym -> t -> Maybe Int+    -- | Select a (symbol, ID) pair by index of its position in the map.+    byIndex     :: Int -> t -> Maybe (Sym, ID)+    -- | Insert element to the transition map.+    insert      :: Sym -> ID -> t -> t+    -- | Construct transition map from a list.+    fromList    :: [(Sym, ID)] -> t+    -- | Translate transition map into a list.+    toList      :: t -> [(Sym, ID)]

@@ -0,0 +1,63 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FlexibleInstances #-}++-- | Transition map with a hash.++module Data.DAWG.Trans.Hashed+( Hashed (..)+) where++import Prelude hiding (lookup)+import Control.Applicative ((<$>), (<*>))+import Data.DAWG.Util (combine)+import Data.Binary (Binary, put, get)+import Data.DAWG.Trans+import qualified Data.DAWG.Trans.Map as M+import qualified Data.DAWG.Trans.Vector as V++-- | Hash of a transition map is a sum of element-wise hashes.+-- Hash for a given element @(Sym, ID)@ is equal to @combine Sym ID@.+data Hashed t = Hashed+    { hash  :: {-# UNPACK #-} !Int+    , trans :: !t }+    deriving (Show)++instance Binary t => Binary (Hashed t) where+    put Hashed{..} = put hash >> put trans+    get = Hashed <$> get <*> get++instance Trans t => Trans (Hashed t) where+    empty       = Hashed 0 empty+    {-# INLINE empty #-} ++    lookup x    = lookup x . trans+    {-# INLINE lookup #-} ++    index x     = index x . trans+    {-# INLINE index #-} ++    byIndex i   = byIndex i . trans+    {-# INLINE byIndex #-} ++    insert x y (Hashed h t) = Hashed+        (h - h' + combine x y)+        (insert x y t)+      where+        h' = case lookup x t of+            Just y' -> combine x y'+            Nothing -> 0+    {-# INLINE insert #-}++    fromList xs = Hashed +        (sum $ map (uncurry combine) xs)+        (fromList xs)+    {-# INLINE fromList #-}++    toList  = toList . trans+    {-# INLINE toList #-}++deriving instance Eq  (Hashed M.Trans)+deriving instance Ord (Hashed M.Trans)+deriving instance Eq  (Hashed V.Trans)+deriving instance Ord (Hashed V.Trans)

@@ -0,0 +1,45 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- | Implementation of a transition map build on top of the "M.Map" container.++module Data.DAWG.Trans.Map+( Trans (unTrans)+) where++import Prelude hiding (lookup)+import Data.Binary (Binary)+import qualified Data.Map as M++import Data.DAWG.Types+import qualified Data.DAWG.Trans as C++-- | A vector of distinct key/value pairs strictly ascending with respect+-- to key values.+newtype Trans = Trans { unTrans :: M.Map Sym ID }+    deriving (Show, Eq, Ord, Binary)++instance C.Trans Trans where+    empty = Trans M.empty+    {-# INLINE empty #-}++    lookup x = M.lookup x . unTrans+    {-# INLINE lookup #-}++    index x = M.lookupIndex x . unTrans+    {-# INLINE index #-}++    byIndex i (Trans m) =+	let n = M.size m+        in  if i >= 0 && i < n+                then Just (M.elemAt i m)+                else Nothing+    {-# INLINE byIndex #-}++    insert x y (Trans m) = Trans (M.insert x y m)+    {-# INLINE insert #-}++    fromList = Trans . M.fromList+    {-# INLINE fromList #-}++    toList = M.toList . unTrans+    {-# INLINE toList #-}

@@ -0,0 +1,58 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- | A vector representation of a transition map.  Memory efficient, but the+-- insert operation is /O(n)/ with respect to the number of transitions.+-- In particular, complexity of the insert operation can make the construction+-- of a large-alphabet dictionary intractable.++module Data.DAWG.Trans.Vector+( Trans (unTrans)+) where++import Prelude hiding (lookup)+import Control.Applicative ((<$>))+import Data.Binary (Binary)+import Data.Vector.Binary ()+import qualified Data.IntMap as M+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as UM++import Data.DAWG.Types+import Data.DAWG.Util+import qualified Data.DAWG.Trans as C++-- | A vector of distinct key/value pairs strictly ascending with respect+-- to key values.+newtype Trans = Trans { unTrans :: U.Vector (Sym, ID) }+    deriving (Show, Eq, Ord, Binary)++instance C.Trans Trans where+    empty = Trans U.empty+    {-# INLINE empty #-}++    lookup x m = do+        k <- C.index x m+        snd <$> C.byIndex k m+    {-# INLINE lookup #-}++    index x (Trans v)+        = either Just (const Nothing) $+            binarySearch (flip compare x . fst) v+    {-# INLINE index #-}++    byIndex k (Trans v) = v U.!? k+    {-# INLINE byIndex #-}++    insert x y (Trans v) = Trans $+        case binarySearch (flip compare x . fst) v of+            Left k  -> U.modify (\w -> UM.write w k (x, y)) v+            Right k ->+                let (v'L, v'R) = U.splitAt k v+                in  U.concat [v'L, U.singleton (x, y), v'R]+    {-# INLINE insert #-}++    fromList = Trans . U.fromList . M.toAscList . M.fromList+    {-# INLINE fromList #-}++    toList = U.toList . unTrans+    {-# INLINE toList #-}

@@ -0,0 +1,12 @@+-- | Basic types used throughout the library.++module Data.DAWG.Types+( ID+, Sym+) where++-- | Node identifier.+type ID = Int++-- | Internal representation of an alphabet element.+type Sym = Int

@@ -0,0 +1,58 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TupleSections #-}++-- | Utility functions.++module Data.DAWG.Util+( binarySearch+, findLastLE+, combine+) where++import Control.Applicative ((<$>))+import Data.Bits (shiftR, xor)+import Data.Vector.Unboxed (Unbox)+import qualified Control.Monad.ST as ST+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as UM++-- | Given a vector of length @n@ strictly ascending with respect to a given+-- comparison function, find an index at which the given element could be+-- inserted while preserving sortedness.+-- The 'Left' result indicates, that the 'EQ' element has been found,+-- while the 'Right' result means otherwise.  Value of the 'Right'+-- result is in the [0,n] range.+binarySearch :: Unbox a => (a -> Ordering) -> U.Vector a -> Either Int Int+binarySearch cmp v = ST.runST $ do+    w <- U.unsafeThaw v+    search w+  where+    search w =+        loop 0 (UM.length w)+      where+        loop !l !u+            | u <= l    = return (Right l)+            | otherwise = do+                let k = (u + l) `shiftR` 1+                x <- UM.unsafeRead w k+                case cmp x of+                    LT -> loop (k+1) u+                    EQ -> return (Left k)+                    GT -> loop l     k+{-# INLINE binarySearch #-}++-- | Given a vector sorted with respect to some underlying comparison+-- function, find last element which is not 'GT' with respect to the+-- comparison function.+findLastLE :: Unbox a => (a -> Ordering) -> U.Vector a -> Maybe (Int, a)+findLastLE cmp v =+    let k' = binarySearch cmp v+    	k  = either id (\x -> x-1) k'+    in  (k,) <$> v U.!? k+{-# INLINE findLastLE #-}++-- | Combine two given hash values.  'combine' has zero as a left+-- identity.+combine :: Int -> Int -> Int+combine h1 h2 = (h1 * 16777619) `xor` h2+{-# INLINE combine #-}

@@ -1,54 +1,53 @@-cabal-version: 1.12+name:               dawg+version:            0.9+synopsis:           Directed acyclic word graphs+description:+    The library implements /directed acyclic word graphs/ (DAWGs) internaly+    represented as /minimal acyclic deterministic finite-state automata/.+    .+    The "Data.DAWG.Dynamic" module provides fast insert and delete operations+    which can be used to build the automaton on-the-fly.  The automaton from+    the "Data.DAWG.Static" module has lower memory footprint and provides+    static hashing functionality.+license:            BSD3+license-file:       LICENSE+cabal-version:      >= 1.6+copyright:          Copyright (c) 2012 IPI PAN+author:             Jakub Waszczuk+maintainer:         waszczuk.kuba@gmail.com+stability:          experimental+category:           Data, Data Structures+homepage:           https://github.com/kawu/dawg+build-type:         Simple --- This file has been generated from package.yaml by hpack version 0.31.1.------ see: https://github.com/sol/hpack------ hash: 5573d3f5ed5f3dad8d4c64b5f23df1efff78ab4e890fccbe657bd46c4cb550e8+library+    build-depends:+        base >= 4 && < 5+      , containers >= 0.4.1 && < 0.6+      , binary+      , vector+      , vector-binary+      , mtl -name:           dawg-version:        0.8.2-synopsis:       Directed acyclic word graphs-description:    Please see the README on GitHub at <https://github.com/kawu/dawg#readme>-category:       Data, Data Structures-homepage:       https://github.com/kawu/dawg#readme-bug-reports:    https://github.com/kawu/dawg/issues-author:         Jakub Waszczuk-maintainer:     waszczuk.kuba@gmail.com-copyright:      2012-2019 IPI PAN, Jakub Waszczuk-license:        BSD3-license-file:   LICENSE-build-type:     Simple-extra-source-files:-    README.md+    exposed-modules:+        Data.DAWG.Dynamic+      , Data.DAWG.Static -source-repository head-  type: git-  location: https://github.com/kawu/dawg+    other-modules:+        Data.DAWG.Types+      , Data.DAWG.Static.Node+      , Data.DAWG.Dynamic.Internal+      , Data.DAWG.Dynamic.Node+      , Data.DAWG.Graph+      , Data.DAWG.Trans+      , Data.DAWG.Trans.Vector+      , Data.DAWG.Trans.Map+      , Data.DAWG.Trans.Hashed+      , Data.DAWG.HashMap+      , Data.DAWG.Util -library-  exposed-modules:-      Data.DAWG-      Data.DAWG.Graph-      Data.DAWG.HashMap-      Data.DAWG.Internal-      Data.DAWG.Node-      Data.DAWG.Static-      Data.DAWG.Trans-      Data.DAWG.Trans.Hashed-      Data.DAWG.Trans.Map-      Data.DAWG.Trans.Vector-      Data.DAWG.Types-      Data.DAWG.Util-  other-modules:-      Paths_dawg-  hs-source-dirs:-      src-  build-depends:-      base >=4 && <5-    , binary-    , containers >=0.5 && <0.7-    , mtl-    , vector-    , vector-binary-instances-  default-language: Haskell2010+    ghc-options: -Wall -O2++source-repository head+    type: git+    location: https://github.com/kawu/dawg.git

@@ -1,41 +0,0 @@--- | The module implements /directed acyclic word graphs/ (DAWGs) internaly--- represented as /minimal acyclic deterministic finite-state automata/.--- The implementation provides fast insert and delete operations--- which can be used to build the DAWG structure incrementaly.------ Transition backend has to be specified by a type signature.  You can import--- the desired transition type and define your own dictionary construction--- function.------ > import Data.DAWG--- > import Data.DAWG.Trans.Map (Trans)--- >--- > mkDict :: (Enum a, Ord b) => [([a], b)] -> DAWG Trans a b--- > mkDict = fromList--module Data.DAWG-(--- * DAWG type-  DAWG-, MkNode--- * Query-, numStates-, lookup--- * Construction-, empty-, fromList-, fromListWith-, fromLang--- ** Insertion-, insert-, insertWith--- ** Deletion-, delete--- * Conversion-, assocs-, keys-, elems-) where--import Prelude hiding (lookup)-import Data.DAWG.Internal

@@ -1,208 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE DoAndIfThenElse #-}---- | Internal representation of the "Data.DAWG" automaton.  Names in this--- module correspond to a graphical representation of automaton: nodes refer--- to states and edges refer to transitions.--module Data.DAWG.Graph-( Graph (..)-, empty-, size-, nodeBy-, insert-, delete-) where--import Control.Applicative ((<$>), (<*>))-import Data.Binary (Binary, put, get)-import qualified Data.IntSet as S-import qualified Data.IntMap.Strict as M--import Data.DAWG.HashMap (Hash)-import qualified Data.DAWG.HashMap as H--type ID = Int---- | A set of nodes.  To every node a unique identifier is assigned.--- Invariants: ------   * freeIDs \\intersection occupiedIDs = \\emptySet,------   * freeIDs \\sum occupiedIDs =---     {0, 1, ..., |freeIDs \\sum occupiedIDs| - 1},------ where occupiedIDs = elemSet idMap.------ TODO: Is it possible to merge 'freeIDs' with 'ingoMap' to reduce--- the memory footprint?-data Graph n = Graph {-    -- | Map from nodes to IDs with hash values interpreted-    -- as keys and (node, ID) pairs interpreted as map elements.-      idMap     :: !(H.HashMap n ID)-    -- | Set of free IDs.-    , freeIDs   :: !S.IntSet-    -- | Map from IDs to nodes. -    , nodeMap   :: !(M.IntMap n)-    -- | Number of ingoing paths (different paths from the root-    -- to the given node) for each node ID in the graph.-    -- The number of ingoing paths can be also interpreted as-    -- a number of occurences of the node in a tree representation-    -- of the graph.-    , ingoMap   :: !(M.IntMap Int) }-    deriving (Show, Eq, Ord)--instance (Ord n, Binary n) => Binary (Graph n) where-    put Graph{..} = do-        put idMap-        put freeIDs-        put nodeMap-        put ingoMap-    get = Graph <$> get <*> get <*> get <*> get---- | Empty graph.-empty :: Graph n-empty = Graph H.empty S.empty M.empty M.empty---- | Size of the graph (number of nodes).-size :: Graph n -> Int-size = H.size . idMap---- | Node with the given identifier.-nodeBy :: ID -> Graph n -> n-nodeBy i g = nodeMap g M.! i---- | Retrieve identifier of a node assuming that the node--- is present in the graph.  If the assumption is not--- safisfied, the returned identifier may be incorrect.-nodeID'Unsafe :: Hash n => n -> Graph n -> ID-nodeID'Unsafe n g = H.lookupUnsafe n (idMap g)---- | Add new graph node (assuming that it is not already a member--- of the graph).-newNode :: Hash n => n -> Graph n -> (ID, Graph n)-newNode n Graph{..} =-    (i, Graph idMap' freeIDs' nodeMap' ingoMap')-  where-    idMap'      = H.insertUnsafe n i idMap-    nodeMap'    = M.insert i n nodeMap-    ingoMap'    = M.insert i 1 ingoMap-    (i, freeIDs') = if S.null freeIDs-        then (H.size idMap, freeIDs)-        else S.deleteFindMin freeIDs---- | Remove node from the graph (assuming that it is a member--- of the graph).-remNode :: Hash n => ID -> Graph n -> Graph n-remNode i Graph{..} =-    Graph idMap' freeIDs' nodeMap' ingoMap'-  where-    idMap'      = H.deleteUnsafe n idMap-    nodeMap'    = M.delete i nodeMap-    ingoMap'    = M.delete i ingoMap-    freeIDs'    = S.insert i freeIDs-    n           = nodeMap M.! i---- | Increment the number of ingoing paths.-incIngo :: ID -> Graph n -> Graph n-incIngo i g = g { ingoMap = M.insertWith (+) i 1 (ingoMap g) }---- | Decrement the number of ingoing paths and return--- the resulting number.-decIngo :: ID -> Graph n -> (Int, Graph n)-decIngo i g =-    let k = (ingoMap g M.! i) - 1-    in  (k, g { ingoMap = M.insert i k (ingoMap g) })---- | Insert node into the graph.  If the node was already a member--- of the graph, just increase the number of ingoing paths.--- NOTE: Number of ingoing paths will not be changed for any descendants--- of the node, so the operation alone will not ensure that properties--- of the graph are preserved.-insert :: Hash n => n -> Graph n -> (ID, Graph n)-insert n g = case H.lookup n (idMap g) of-    Just i  -> (i, incIngo i g)-    Nothing -> newNode n g---- | Delete node from the graph.  If the node was present in the graph--- at multiple positions, just decrease the number of ingoing paths.--- Function crashes if the node is not a member of the graph. --- NOTE: The function does not delete descendant nodes which may become--- inaccesible nor does it change the number of ingoing paths for any--- descendant of the node.-delete :: Hash n => n -> Graph n -> Graph n-delete n g = if num == 0-    then remNode i g'-    else g'-  where-    i = nodeID'Unsafe n g-    (num, g') = decIngo i g---- -- | Construct a graph from a list of node/ID pairs and a root ID.--- -- Identifiers must be consistent with edges outgoing from--- -- individual nodes.--- fromNodes :: Ord a => [(Node a, ID)] -> ID -> Graph a--- fromNodes xs rootID = graph---   where---     graph = Graph---         (M.fromList xs)---         IS.empty---         (IM.fromList $ map swap xs)---         ( foldl' updIngo (IM.singleton rootID 1)---             $ topSort graph rootID )---     swap (x, y) = (y, x)---     updIngo m i =---         let n = nodeBy i graph---             ingo = m IM.! i---         in  foldl' (push ingo) m (edges n)---     push x m j = IM.adjust (+x) j m--- --- postorder :: T.Tree a -> [a] -> [a]--- postorder (T.Node a ts) = postorderF ts . (a :)--- --- postorderF :: T.Forest a -> [a] -> [a]--- postorderF ts = foldr (.) id $ map postorder ts--- --- postOrd :: Graph a -> ID -> [ID]--- postOrd g i = postorder (dfs g i) []--- --- -- | Topological sort given a root ID.--- topSort :: Graph a -> ID -> [ID]--- topSort g = reverse . postOrd g--- --- -- | Depth first search starting with given ID.--- dfs :: Graph a -> ID -> T.Tree ID--- dfs g = prune . generate g--- --- generate :: Graph a -> ID -> T.Tree ID--- generate g i = T.Node i---     ( T.Node (eps n) []---     : map (generate g) (edges n) )---   where---     n = nodeBy i g--- --- type SetM a = S.State IS.IntSet a--- --- run :: SetM a -> a--- run act = S.evalState act IS.empty--- --- contains :: ID -> SetM Bool--- contains i = IS.member i <$> S.get--- --- include :: ID -> SetM ()--- include i = S.modify (IS.insert i)--- --- prune :: T.Tree ID -> T.Tree ID--- prune t = head $ run (chop [t])--- --- chop :: T.Forest ID -> SetM (T.Forest ID)--- chop [] = return []--- chop (T.Node v ts : us) = do---     visited <- contains v---     if visited then---         chop us---     else do---         include v---         as <- chop ts---         bs <- chop us---         return (T.Node v as : bs)

@@ -1,110 +0,0 @@-{-# LANGUAGE RecordWildCards #-}---- | A map from hashable keys to values.--module Data.DAWG.HashMap-( Hash (..)-, HashMap (..)-, empty-, lookup-, insertUnsafe-, lookupUnsafe-, deleteUnsafe-) where--import Prelude hiding (lookup)-import Control.Applicative ((<$>), (<*>))-import Data.Binary (Binary, Get, put, get)-import qualified Data.Map as M-import qualified Data.IntMap as I--fromJust :: Maybe a -> a-fromJust (Just x)   = x-fromJust Nothing    = error "fromJust: Nothing"-{-# INLINE fromJust #-}---- | Class for types which provide hash values.-class Ord a => Hash a where-    hash    :: a -> Int---- | Value in a HashMap.-data Value a b-    = Single !a !b-    | Multi  !(M.Map a b)-    deriving (Show, Eq, Ord)--instance (Ord a, Binary a, Binary b) => Binary (Value a b) where-    put (Single x y)    = put (1 :: Int) >> put x >> put y-    put (Multi m)       = put (2 :: Int) >> put m-    get = do-        x <- get :: Get Int-        case x of-            1   -> Single <$> get <*> get-            _   -> Multi <$> get---- | Find element associated to a value key.-find :: Ord a => a -> Value a b -> Maybe b-find x (Single x' y) = if x == x'-    then Just y-    else Nothing-find x (Multi m) = M.lookup x m---- | Assumption: element is a member of the 'Value'. -findUnsafe :: Ord a => a -> Value a b -> Maybe b-findUnsafe _ (Single _ y) = Just y     -- unsafe-findUnsafe x (Multi m) = M.lookup x m---- | Convert map into a 'Single' form if possible.-trySingle :: Ord a => M.Map a b -> Value a b-trySingle m = if M.size m == 1-    then (uncurry Single) (M.findMin m)-    else Multi m---- | Insert element into a value.-embed :: Ord a => a -> b -> Value a b -> Value a b-embed x y (Single x' y')    = Multi $ M.fromList [(x, y), (x', y')]-embed x y (Multi m)         = Multi $ M.insert x y m---- | Delete element from a value.  Return 'Nothing' if the resultant--- value is empty.-ejectUnsafe :: Ord a => a -> Value a b -> Maybe (Value a b)-ejectUnsafe _ (Single _ _)  = Nothing    -- unsafe-ejectUnsafe x (Multi m)     = (Just . trySingle) (M.delete x m)---- | A map from /a/ keys to /b/ elements where keys instantiate the--- 'Hash' type class.  Key/element pairs are kept in 'Value' objects--- which takes care of potential hash collisions.-data HashMap a b = HashMap-    { size      :: {-# UNPACK #-} !Int-    , hashMap   :: !(I.IntMap (Value a b)) }-    deriving (Show, Eq, Ord)--instance (Ord a, Binary a, Binary b) => Binary (HashMap a b) where-    put HashMap{..} = put size >> put hashMap-    get = HashMap <$> get <*> get---- | Empty map.-empty :: HashMap a b-empty = HashMap 0 I.empty---- | Lookup element in the map.-lookup :: Hash a => a -> HashMap a b -> Maybe b-lookup x (HashMap _ m) = I.lookup (hash x) m >>= find x---- | Assumption: element is present in the map.-lookupUnsafe :: Hash a => a -> HashMap a b -> b-lookupUnsafe x (HashMap _ m) = fromJust (I.lookup (hash x) m >>= findUnsafe x)---- | Insert a new element.  The function doesn't check--- if the element was already present in the map.-insertUnsafe :: Hash a => a -> b -> HashMap a b -> HashMap a b-insertUnsafe x y (HashMap n m) =-    let i = hash x-        f (Just v)  = embed x y v-        f Nothing   = Single x y-    in  HashMap (n + 1) $ I.alter (Just . f) i m---- | Assumption: element is present in the map.-deleteUnsafe :: Hash a => a -> HashMap a b -> HashMap a b-deleteUnsafe x (HashMap n m) =-    HashMap (n - 1) $ I.update (ejectUnsafe x) (hash x) m

@@ -1,269 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}---- | The module implements /directed acyclic word graphs/ (DAWGs) internaly--- represented as /minimal acyclic deterministic finite-state automata/.--- The implementation provides fast insert and delete operations--- which can be used to build the DAWG structure incrementaly.--module Data.DAWG.Internal-(--- * DAWG type-  DAWG (..)-, MkNode--- * Query-, numStates-, lookup--- * Construction-, empty-, fromList-, fromListWith-, fromLang--- ** Insertion-, insert-, insertWith--- ** Deletion-, delete--- * Conversion-, assocs-, keys-, elems-) where--import Prelude hiding (lookup)-import Control.Applicative ((<$>), (<*>))-import Control.Arrow (first)-import Data.List (foldl')-import Data.Binary (Binary, put, get)-import qualified Data.Vector.Unboxed as U-import qualified Control.Monad.State.Strict as S--import Data.DAWG.Types-import Data.DAWG.Graph (Graph)-import Data.DAWG.Trans (Trans)-import qualified Data.DAWG.Trans as T-import qualified Data.DAWG.Node as N-import qualified Data.DAWG.Graph as G--type Node t a = N.Node t () a---- | Is /t/ a valid transition map within the context of--- /a/-valued automata nodes?  All transition implementations--- provided by the library are instances of this class.-class (Ord (Node t a), Trans t) => MkNode t a where-instance (Ord (Node t a), Trans t) => MkNode t a where--type GraphM t a b = S.State (Graph (Node t a)) b--mkState :: (Graph a -> Graph a) -> Graph a -> ((), Graph a)-mkState f g = ((), f g)---- | Leaf node with no children and 'Nothing' value.-insertLeaf :: MkNode t a => GraphM t a ID-insertLeaf = do-    i <- insertNode (N.Leaf Nothing)-    insertNode (N.Branch i T.empty U.empty)---- | Return node with the given identifier.-nodeBy :: ID -> GraphM t a (Node t a)-nodeBy i = G.nodeBy i <$> S.get---- Evaluate the 'G.insert' function within the monad.-insertNode :: MkNode t a => Node t a -> GraphM t a ID-insertNode = S.state . G.insert---- Evaluate the 'G.delete' function within the monad.-deleteNode :: MkNode t a => Node t a -> GraphM t a ()-deleteNode = S.state . mkState . G.delete---- | Invariant: the identifier points to the 'Branch' node.-insertM :: MkNode t a => [Sym] -> a -> ID -> GraphM t a ID-insertM (x:xs) y i = do-    n <- nodeBy i-    j <- case N.onSym x n of-        Just j  -> return j-        Nothing -> insertLeaf-    k <- insertM xs y j-    deleteNode n-    insertNode (N.insert x k n)-insertM [] y i = do-    n <- nodeBy i-    w <- nodeBy (N.eps n)-    deleteNode w-    deleteNode n-    j <- insertNode (N.Leaf $ Just y)-    insertNode (n { N.eps = j })--insertWithM-    :: MkNode t a => (a -> a -> a)-    -> [Sym] -> a -> ID -> GraphM t a ID-insertWithM f (x:xs) y i = do-    n <- nodeBy i-    j <- case N.onSym x n of-        Just j  -> return j-        Nothing -> insertLeaf-    k <- insertWithM f xs y j-    deleteNode n-    insertNode (N.insert x k n)-insertWithM f [] y i = do-    n <- nodeBy i-    w <- nodeBy (N.eps n)-    deleteNode w-    deleteNode n-    let y'new = case N.value w of-            Just y' -> f y y'-            Nothing -> y-    j <- insertNode (N.Leaf $ Just y'new)-    insertNode (n { N.eps = j })--deleteM :: MkNode t a => [Sym] -> ID -> GraphM t a ID-deleteM (x:xs) i = do-    n <- nodeBy i-    case N.onSym x n of-        Nothing -> return i-        Just j  -> do-            k <- deleteM xs j-            deleteNode n-            insertNode (N.insert x k n)-deleteM [] i = do-    n <- nodeBy i-    w <- nodeBy (N.eps n)-    deleteNode w-    deleteNode n-    j <- insertLeaf-    insertNode (n { N.eps = j })-    -lookupM :: Trans t => [Sym] -> ID -> GraphM t a (Maybe a)-lookupM [] i = do-    j <- N.eps <$> nodeBy i-    N.value <$> nodeBy j-lookupM (x:xs) i = do-    n <- nodeBy i-    case N.onSym x n of-        Just j  -> lookupM xs j-        Nothing -> return Nothing--assocsAcc :: Trans t => Graph (Node t a) -> ID -> [([Sym], a)]-assocsAcc g i =-    here w ++ concatMap there (N.edges n)-  where-    n = G.nodeBy i g-    w = G.nodeBy (N.eps n) g-    here v = case N.value v of-        Just x  -> [([], x)]-        Nothing -> []-    there (sym, j) = map (first (sym:)) (assocsAcc g j)---- | A directed acyclic word graph with phantom type @a@ representing--- type of alphabet elements.-data DAWG t a b = DAWG-    { graph :: !(Graph (Node t b))-    , root  :: !ID }-    deriving (Show)--instance (MkNode t b, Binary t, Binary b) => Binary (DAWG t a b) where-    put d = do-        put (graph d)-        put (root d)-    get = DAWG <$> get <*> get---- | Empty DAWG.-empty :: (MkNode t b) => DAWG t a b-empty = -    let (i, g) = S.runState insertLeaf G.empty-    in  DAWG g i---- | Number of states in the underlying graph.-numStates :: DAWG t a b -> Int-numStates = G.size . graph---- | Insert the (key, value) pair into the DAWG.-insert :: (Enum a, MkNode t b) => [a] -> b -> DAWG t a b -> DAWG t a b-insert xs' y d =-    let xs = map fromEnum xs'-        (i, g) = S.runState (insertM xs y $ root d) (graph d)-    in  DAWG g i-{-# INLINE insert #-}-{-# SPECIALIZE insert-        :: (MkNode t b) => String -> b-        -> DAWG t Char b -> DAWG t Char b #-}---- | Insert with a function, combining new value and old value.--- 'insertWith' f key value d will insert the pair (key, value) into d if--- key does not exist in the DAWG. If the key does exist, the function--- will insert the pair (key, f new_value old_value).-insertWith-    :: (Enum a, MkNode t b) => (b -> b -> b)-    -> [a] -> b -> DAWG t a b -> DAWG t a b-insertWith f xs' y d =-    let xs = map fromEnum xs'-        (i, g) = S.runState (insertWithM f xs y $ root d) (graph d)-    in  DAWG g i-{-# SPECIALIZE insertWith-        :: MkNode t b => (b -> b -> b) -> String -> b-        -> DAWG t Char b -> DAWG t Char b #-}---- | Delete the key from the DAWG.-delete :: (Enum a, MkNode t b) => [a] -> DAWG t a b -> DAWG t a b-delete xs' d =-    let xs = map fromEnum xs'-        (i, g) = S.runState (deleteM xs $ root d) (graph d)-    in  DAWG g i-{-# SPECIALIZE delete-        :: MkNode t b => String-        -> DAWG t Char b -> DAWG t Char b #-}---- | Find value associated with the key.-lookup :: (Enum a, MkNode t b) => [a] -> DAWG t a b -> Maybe b-lookup xs' d =-    let xs = map fromEnum xs'-    in  S.evalState (lookupM xs $ root d) (graph d)-{-# SPECIALIZE lookup-        :: MkNode t b => String-        -> DAWG t Char b -> Maybe b #-}---- | Return all key/value pairs in the DAWG in ascending key order.-assocs :: (Enum a, MkNode t b) => DAWG t a b -> [([a], b)]-assocs-    = map (first (map toEnum))-    . (assocsAcc <$> graph <*> root)-{-# SPECIALIZE assocs :: MkNode t b => DAWG t Char b -> [(String, b)] #-}---- | Return all keys of the DAWG in ascending order.-keys :: (Enum a, MkNode t b) => DAWG t a b -> [[a]]-keys = map fst . assocs-{-# SPECIALIZE keys :: MkNode t b => DAWG t Char b -> [String] #-}---- | Return all elements of the DAWG in the ascending order of their keys.-elems :: MkNode t b => DAWG t a b -> [b]-elems = map snd . (assocsAcc <$> graph <*> root)---- | Construct DAWG from the list of (word, value) pairs.-fromList :: (Enum a, MkNode t b) => [([a], b)] -> DAWG t a b-fromList xs =-    let update t (x, v) = insert x v t-    in  foldl' update empty xs-{-# INLINE fromList #-}-{-# SPECIALIZE fromList-        :: MkNode t b => [(String, b)] -> DAWG t Char b #-}---- | Construct DAWG from the list of (word, value) pairs--- with a combining function.  The combining function is--- applied strictly.-fromListWith-    :: (Enum a, MkNode t b) => (b -> b -> b)-    -> [([a], b)] -> DAWG t a b-fromListWith f xs =-    let update t (x, v) = insertWith f x v t-    in  foldl' update empty xs-{-# SPECIALIZE fromListWith-        :: MkNode t b => (b -> b -> b)-        -> [(String, b)] -> DAWG t Char b #-}---- | Make DAWG from the list of words.  Annotate each word with--- the @()@ value.-fromLang :: (Enum a, MkNode t ()) => [[a]] -> DAWG t a ()-fromLang xs = fromList [(x, ()) | x <- xs]-{-# SPECIALIZE fromLang :: MkNode t () => [String] -> DAWG t Char () #-}

@@ -1,114 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE StandaloneDeriving #-}---- | Internal representation of automata nodes.--module Data.DAWG.Node-( Node (..)-, onSym-, onSym'-, edges-, children-, insert-, reID-) where--import Control.Applicative ((<$>), (<*>))-import Control.Arrow (second)-import Data.Binary (Binary, Get, put, get)-import Data.Vector.Binary ()-import qualified Data.Vector.Unboxed as U--import Data.DAWG.Types-import Data.DAWG.Util (combine)-import Data.DAWG.Trans (Trans)-import Data.DAWG.HashMap (Hash, hash)-import qualified Data.DAWG.Trans.Hashed as H-import qualified Data.DAWG.Trans as T-import qualified Data.DAWG.Trans.Vector as TV-import qualified Data.DAWG.Trans.Map as TM---- | Two nodes (states) belong to the same equivalence class (and,--- consequently, they must be represented as one node in the graph)--- iff they are equal with respect to their values and outgoing--- edges.------ Since 'Leaf' nodes are distinguished from 'Branch' nodes, two values--- equal with respect to '==' function are always kept in one 'Leaf'--- node in the graph.  It doesn't change the fact that to all 'Branch'--- nodes one value is assigned through the epsilon transition.------ Invariant: the 'eps' identifier always points to the 'Leaf' node.--- Edges in the 'edgeMap', on the other hand, point to 'Branch' nodes.-data Node t a b-    = Branch {-        -- | Epsilon transition.-          eps       :: {-# UNPACK #-} !ID-        -- | Transition map (outgoing edges).-        , transMap  :: !(H.Hashed t)-        -- | Labels corresponding to individual edges.-        , labelVect :: !(U.Vector a) }-    | Leaf { value  :: !(Maybe b) }-    deriving (Show)--deriving instance (Eq a, Eq b, U.Unbox a)   => Eq (Node TV.Trans a b)-deriving instance (Ord a, Ord b, U.Unbox a) => Ord (Node TV.Trans a b)-deriving instance (Eq a, Eq b, U.Unbox a)   => Eq (Node TM.Trans a b)-deriving instance (Ord a, Ord b, U.Unbox a) => Ord (Node TM.Trans a b)--instance (Trans t, Ord (Node t a b)) => Hash (Node t a b) where-    hash Branch{..} = combine eps (H.hash transMap)-    hash Leaf{..}   = case value of-    	Just _	-> (-1)-	Nothing	-> (-2)--instance (U.Unbox a, Binary t, Binary a, Binary b) => Binary (Node t a b) where-    put Branch{..} = put (1 :: Int) >> put eps >> put transMap >> put labelVect-    put Leaf{..}   = put (2 :: Int) >> put value-    get = do-        x <- get :: Get Int-        case x of-            1 -> Branch <$> get <*> get <*> get-            _ -> Leaf <$> get---- | Transition function.-onSym :: Trans t => Sym -> Node t a b -> Maybe ID-onSym x (Branch _ t _)  = T.lookup x t-onSym _ (Leaf _)        = Nothing-{-# INLINE onSym #-}---- | Transition function.-onSym' :: (Trans t, U.Unbox a) => Sym -> Node t a b -> Maybe (ID, a)-onSym' x (Branch _ t ls)   = do-    k <- T.index x t-    (,) <$> (snd <$> T.byIndex k t)-        <*> ls U.!? k-onSym' _ (Leaf _)           = Nothing-{-# INLINE onSym' #-}---- | List of symbol/edge pairs outgoing from the node.-edges :: Trans t => Node t a b -> [(Sym, ID)]-edges (Branch _ t _)    = T.toList t-edges (Leaf _)          = []-{-# INLINE edges #-}---- | List of children identifiers.-children :: Trans t => Node t a b -> [ID]-children = map snd . edges-{-# INLINE children #-}---- | Substitue edge determined by a given symbol.-insert :: Trans t => Sym -> ID -> Node t a b -> Node t a b-insert x i (Branch w t ls)  = Branch w (T.insert x i t) ls-insert _ _ l                = l-{-# INLINE insert #-}---- | Assign new identifiers.-reID :: Trans t => (ID -> ID) -> Node t a b -> Node t a b-reID _ (Leaf x)         = Leaf x-reID f (Branch e t ls)  =-    let reTrans = T.fromList . map (second f) . T.toList-    in  Branch (f e) (reTrans t) ls

@@ -1,302 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}---- | The module implements /directed acyclic word graphs/ (DAWGs) internaly--- represented as /minimal acyclic deterministic finite-state automata/.------ In comparison to "Data.DAWG" module the automaton implemented here:------   * Keeps all nodes in one array and therefore uses much less memory,------   * When 'weigh'ed, it can be used to perform static hashing with---     'hash' and 'unHash' functions,------   * Doesn't provide insert/delete family of operations.------ Transition backend has to be specified by a type signature.  You can import--- the desired transition type and define your own dictionary construction--- function.------ > import Data.DAWG.Static--- > import Data.DAWG.Trans.Map (Trans)--- >--- > mkDict :: (Enum a, Ord b) => [([a], b)] -> DAWG Trans a Weight b--- > mkDict = weigh . fromList--module Data.DAWG.Static-(--- * DAWG type-  DAWG--- * Query-, lookup-, numStates--- * Index-, index-, byIndex--- * Hash-, hash-, unHash--- * Construction-, empty-, fromList-, fromListWith-, fromLang-, freeze--- * Weight-, Weight-, weigh--- * Conversion-, assocs-, keys-, elems--- , thaw-) where--import Prelude hiding (lookup)-import Control.Applicative ((<$), (<$>), (<|>))-import Control.Arrow (first)-import Data.Binary (Binary, put, get)-import Data.Vector.Binary ()-import Data.Vector.Unboxed (Unbox)-import qualified Data.IntMap as M-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as U--import Data.DAWG.Types-import Data.DAWG.Trans (Trans)-import Data.DAWG.Node (Node)-import qualified Data.DAWG.Trans as T-import qualified Data.DAWG.Trans.Vector as VT-import qualified Data.DAWG.Node as N-import qualified Data.DAWG.Graph as G-import qualified Data.DAWG.Internal as D-import qualified Data.DAWG.Util as Util---- | @DAWG t a b c@ constitutes an automaton with alphabet symbols of type /a/,--- transition labels of type /b/ and node values of type /Maybe c/, implemented--- on top of the 'T.Trans' /t/ backend.  All nodes are stored in a 'V.Vector'--- with positions of nodes corresponding to their 'ID's.-newtype DAWG t a b c = DAWG { unDAWG :: V.Vector (Node t b c) }-    deriving (Show)--deriving instance (Eq b, Eq c, Unbox b)     => Eq  (DAWG VT.Trans a b c)-deriving instance (Ord b, Ord c, Unbox b)   => Ord (DAWG VT.Trans a b c)--instance (Binary t, Binary b, Binary c, Unbox b) => Binary (DAWG t a b c) where-    put = put . unDAWG-    get = DAWG <$> get---- | Empty DAWG.-empty :: (Trans t, Unbox b) => DAWG t a b c-empty = DAWG $ V.fromList-    [ N.Branch 1 T.empty U.empty-    , N.Leaf Nothing ]---- | Number of states in the automaton.-numStates :: DAWG t a b c -> Int-numStates = V.length . unDAWG---- | Node with the given identifier.-nodeBy :: ID -> DAWG t a b c -> Node t b c-nodeBy i d = unDAWG d V.! i---- | Value in leaf node with a given ID.-leafValue :: Node t b c -> DAWG t a b c -> Maybe c-leafValue n = N.value . nodeBy (N.eps n)---- | Find value associated with the key.-lookup :: (Enum a, Trans t, Unbox b) => [a] -> DAWG t a b c -> Maybe c-lookup xs' =-    let xs = map fromEnum xs'-    in  lookup'I xs 0-{-# SPECIALIZE lookup-        :: (Trans t, Unbox b) => String-        -> DAWG t Char b c -> Maybe c #-}--lookup'I :: (Trans t, Unbox b) => [Sym] -> ID -> DAWG t a b c -> Maybe c-lookup'I []     i d = leafValue (nodeBy i d) d-lookup'I (x:xs) i d = case N.onSym x (nodeBy i d) of-    Just j  -> lookup'I xs j d-    Nothing -> Nothing---- | Return all key/value pairs in the DAWG in ascending key order.-assocs :: (Enum a, Trans t, Unbox b) => DAWG t a b c -> [([a], c)]-assocs d = map (first (map toEnum)) (assocs'I 0 d)-{-# SPECIALIZE assocs-        :: (Trans t, Unbox b)-        => DAWG t Char b c -> [(String, c)] #-}--assocs'I :: (Trans t, Unbox b) => ID -> DAWG t a b c -> [([Sym], c)]-assocs'I i d =-    here ++ concatMap there (N.edges n)-  where-    n = nodeBy i d-    here = case leafValue n d of-        Just x  -> [([], x)]-        Nothing -> []-    there (x, j) = map (first (x:)) (assocs'I j d)---- | Return all keys of the DAWG in ascending order.-keys :: (Enum a, Trans t, Unbox b) => DAWG t a b c -> [[a]]-keys = map fst . assocs-{-# SPECIALIZE keys :: (Trans t, Unbox b) => DAWG t Char b c -> [String] #-}---- | Return all elements of the DAWG in the ascending order of their keys.-elems :: (Trans t, Unbox b) => DAWG t a b c -> [c]-elems = map snd . assocs'I 0---- | Construct 'DAWG' from the list of (word, value) pairs.--- First a 'D.DAWG' is created and then it is frozen using--- the 'freeze' function.-fromList-    :: (Enum a, D.MkNode t b)-    => [([a], b)] -> DAWG t a () b-fromList = freeze . D.fromList-{-# SPECIALIZE fromList-        :: D.MkNode t b => [(String, b)] -> DAWG t Char () b #-}---- | Construct DAWG from the list of (word, value) pairs--- with a combining function.  The combining function is--- applied strictly. First a 'D.DAWG' is created and then--- it is frozen using the 'freeze' function.-fromListWith-    :: (Enum a, D.MkNode t b)-    => (b -> b -> b) -> [([a], b)] -> DAWG t a () b-fromListWith f = freeze . D.fromListWith f-{-# SPECIALIZE fromListWith-        :: D.MkNode t b => (b -> b -> b)-        -> [(String, b)] -> DAWG t Char () b #-}---- | Make DAWG from the list of words.  Annotate each word with--- the @()@ value.  First a 'D.DAWG' is created and then it is frozen--- using the 'freeze' function.-fromLang -    :: (Enum a, D.MkNode t ())-    => [[a]] -> DAWG t a () ()-fromLang = freeze . D.fromLang-{-# SPECIALIZE fromLang :: D.MkNode t () => [String] -> DAWG t Char () () #-}---- | Weight of a node corresponds to the number of final states--- reachable from the node.  Weight of an edge is a sum of weights--- of preceding nodes outgoing from the same parent node.-type Weight = Int---- | Compute node weights and store corresponding values in transition labels.-weigh :: Trans t => DAWG t a b c -> DAWG t a Weight c-weigh d = (DAWG . V.fromList)-    [ branch n ws-    | i <- [0 .. numStates d - 1]-    , let n  = nodeBy i d-    , let ws = accum (N.children n) ]-  where-    -- Branch with new weights.-    branch N.Branch{..} ws  = N.Branch eps transMap ws-    branch N.Leaf{..} _     = N.Leaf value-    -- In nodeWeight node weights are memoized.-    nodeWeight = ((V.!) . V.fromList) (map detWeight [0 .. numStates d - 1])-    -- Determine weight of the node.-    detWeight i = case nodeBy i d of-        N.Leaf w    -> maybe 0 (const 1) w-        n           -> sum . map nodeWeight $ allChildren n-    -- Weights for subsequent edges.-    accum = U.fromList . init . scanl (+) 0 . map nodeWeight-    -- Plain children and epsilon child. -    allChildren n = N.eps n : N.children n---- | Construct immutable version of the automaton.-freeze :: Trans t => D.DAWG t a b -> DAWG t a () b-freeze d = DAWG . V.fromList $-    map (N.reID newID . oldBy)-        (M.elems (inverse old2new))-  where-    -- Map from old to new identifiers.-    old2new = M.fromList $ (D.root d, 0) : zip (nodeIDs d) [1..]-    newID   = (M.!) old2new-    -- List of node IDs without the root ID.-    nodeIDs = filter (/= D.root d) . map fst . M.assocs . G.nodeMap . D.graph-    -- Non-frozen node by given identifier.-    oldBy i = G.nodeBy i (D.graph d)-        --- | Inverse of the map.-inverse :: M.IntMap Int -> M.IntMap Int-inverse =-    let swap (x, y) = (y, x)-    in  M.fromList . map swap . M.toList---- -- | Yield mutable version of the automaton.--- thaw :: (Unbox b, Ord a) => DAWG a b c -> D.DAWG a b--- thaw d =---     D.fromNodes nodes 0---   where---     -- List of resulting nodes.---     nodes = branchNodes ++ leafNodes---     -- Branching nodes.---     branchNodes =---         [ ---     -- Number of states used to shift new value IDs.---     n = numStates d---     -- New identifiers for value nodes.---     valIDs = foldl' updID GM.empty (values d)---     -- Values in the automaton.---     values = map value . V.toList . unDAWG---     -- Update ID map.---     updID m v = case GM.lookup v m of---         Just i  -> m---         Nothing -> ---             let j = GM.size m + n---             in  j `seq` GM.insert v j---- | Position in a set of all dictionary entries with respect--- to the lexicographic order.-index :: (Enum a, Trans t) => [a] -> DAWG t a Weight c -> Maybe Int-index xs = index'I (map fromEnum xs) 0-{-# SPECIALIZE index-        :: Trans t => String -> DAWG t Char Weight c -> Maybe Int #-}--index'I :: Trans t => [Sym] -> ID -> DAWG t a Weight c -> Maybe Int-index'I []     i d = 0 <$ leafValue (nodeBy i d) d-index'I (x:xs) i d = do-    let n = nodeBy i d-        u = maybe 0 (const 1) (leafValue n d)-    (j, v) <- N.onSym' x n-    w <- index'I xs j d-    return (u + v + w)---- | Perfect hashing function for dictionary entries.--- A synonym for the 'index' function.-hash :: (Enum a, Trans t) => [a] -> DAWG t a Weight c -> Maybe Int-hash = index-{-# INLINE hash #-}---- | Find dictionary entry given its index with respect to the--- lexicographic order.-byIndex :: (Enum a, Trans t) => Int -> DAWG t a Weight c -> Maybe [a]-byIndex ix d = map toEnum <$> byIndex'I ix 0 d-{-# SPECIALIZE byIndex-        :: Trans t => Int -> DAWG t Char Weight c -> Maybe String #-}--byIndex'I :: Trans t => Int -> ID -> DAWG t a Weight c -> Maybe [Sym]-byIndex'I ix i d-    | ix < 0    = Nothing-    | otherwise = here <|> there-  where-    n = nodeBy i d-    u = maybe 0 (const 1) (leafValue n d)-    here-        | ix == 0   = [] <$ leafValue (nodeBy i d) d-        | otherwise = Nothing-    there = do-        (k, w) <- Util.findLastLE cmp (N.labelVect n)-        (x, j) <- T.byIndex k (N.transMap n)-        xs <- byIndex'I (ix - u - w) j d-        return (x:xs)-    cmp w = compare w (ix - u)---- | Inverse of the 'hash' function and a synonym for the 'byIndex' function.-unHash :: (Enum a, Trans t) => Int -> DAWG t a Weight c -> Maybe [a]-unHash = byIndex-{-# INLINE unHash #-}

@@ -1,26 +0,0 @@--- | The module provides an abstraction over transition maps from--- alphabet symbols to node identifiers.--module Data.DAWG.Trans-( Trans (..)-) where--import Data.DAWG.Types---- | Abstraction over transition maps from alphabet symbols to--- node identifiers.-class Trans t where-    -- | Empty transition map.-    empty       :: t-    -- | Lookup sybol in the map.-    lookup      :: Sym -> t -> Maybe ID-    -- | Find index of the symbol.-    index       :: Sym -> t -> Maybe Int-    -- | Select a (symbol, ID) pair by index of its position in the map.-    byIndex     :: Int -> t -> Maybe (Sym, ID)-    -- | Insert element to the transition map.-    insert      :: Sym -> ID -> t -> t-    -- | Construct transition map from a list.-    fromList    :: [(Sym, ID)] -> t-    -- | Translate transition map into a list.-    toList      :: t -> [(Sym, ID)]

@@ -1,63 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE FlexibleInstances #-}---- | Transition map with a hash.--module Data.DAWG.Trans.Hashed-( Hashed (..)-) where--import Prelude hiding (lookup)-import Control.Applicative ((<$>), (<*>))-import Data.DAWG.Util (combine)-import Data.Binary (Binary, put, get)-import Data.DAWG.Trans-import qualified Data.DAWG.Trans.Map as M-import qualified Data.DAWG.Trans.Vector as V---- | Hash of a transition map is a sum of element-wise hashes.--- Hash for a given element @(Sym, ID)@ is equal to @combine Sym ID@.-data Hashed t = Hashed-    { hash  :: {-# UNPACK #-} !Int-    , trans :: !t }-    deriving (Show)--instance Binary t => Binary (Hashed t) where-    put Hashed{..} = put hash >> put trans-    get = Hashed <$> get <*> get--instance Trans t => Trans (Hashed t) where-    empty       = Hashed 0 empty-    {-# INLINE empty #-} --    lookup x    = lookup x . trans-    {-# INLINE lookup #-} --    index x     = index x . trans-    {-# INLINE index #-} --    byIndex i   = byIndex i . trans-    {-# INLINE byIndex #-} --    insert x y (Hashed h t) = Hashed-        (h - h' + combine x y)-        (insert x y t)-      where-        h' = case lookup x t of-            Just y' -> combine x y'-            Nothing -> 0-    {-# INLINE insert #-}--    fromList xs = Hashed -        (sum $ map (uncurry combine) xs)-        (fromList xs)-    {-# INLINE fromList #-}--    toList  = toList . trans-    {-# INLINE toList #-}--deriving instance Eq  (Hashed M.Trans)-deriving instance Ord (Hashed M.Trans)-deriving instance Eq  (Hashed V.Trans)-deriving instance Ord (Hashed V.Trans)

@@ -1,45 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- | Implementation of a transition map build on top of the "M.Map" container.--module Data.DAWG.Trans.Map-( Trans (unTrans)-) where--import Prelude hiding (lookup)-import Data.Binary (Binary)-import qualified Data.Map as M--import Data.DAWG.Types-import qualified Data.DAWG.Trans as C---- | A vector of distinct key/value pairs strictly ascending with respect--- to key values.-newtype Trans = Trans { unTrans :: M.Map Sym ID }-    deriving (Show, Eq, Ord, Binary)--instance C.Trans Trans where-    empty = Trans M.empty-    {-# INLINE empty #-}--    lookup x = M.lookup x . unTrans-    {-# INLINE lookup #-}--    index x = M.lookupIndex x . unTrans-    {-# INLINE index #-}--    byIndex i (Trans m) =-	let n = M.size m-        in  if i >= 0 && i < n-                then Just (M.elemAt i m)-                else Nothing-    {-# INLINE byIndex #-}--    insert x y (Trans m) = Trans (M.insert x y m)-    {-# INLINE insert #-}--    fromList = Trans . M.fromList-    {-# INLINE fromList #-}--    toList = M.toList . unTrans-    {-# INLINE toList #-}

@@ -1,58 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- | A vector representation of a transition map.  Memory efficient, but the--- insert operation is /O(n)/ with respect to the number of transitions.--- In particular, complexity of the insert operation can make the construction--- of a large-alphabet dictionary intractable.--module Data.DAWG.Trans.Vector-( Trans (unTrans)-) where--import Prelude hiding (lookup)-import Control.Applicative ((<$>))-import Data.Binary (Binary)-import Data.Vector.Binary ()-import qualified Data.IntMap as M-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Unboxed.Mutable as UM--import Data.DAWG.Types-import Data.DAWG.Util-import qualified Data.DAWG.Trans as C---- | A vector of distinct key/value pairs strictly ascending with respect--- to key values.-newtype Trans = Trans { unTrans :: U.Vector (Sym, ID) }-    deriving (Show, Eq, Ord, Binary)--instance C.Trans Trans where-    empty = Trans U.empty-    {-# INLINE empty #-}--    lookup x m = do-        k <- C.index x m-        snd <$> C.byIndex k m-    {-# INLINE lookup #-}--    index x (Trans v)-        = either Just (const Nothing) $-            binarySearch (flip compare x . fst) v-    {-# INLINE index #-}--    byIndex k (Trans v) = v U.!? k-    {-# INLINE byIndex #-}--    insert x y (Trans v) = Trans $-        case binarySearch (flip compare x . fst) v of-            Left k  -> U.modify (\w -> UM.write w k (x, y)) v-            Right k ->-                let (v'L, v'R) = U.splitAt k v-                in  U.concat [v'L, U.singleton (x, y), v'R]-    {-# INLINE insert #-}--    fromList = Trans . U.fromList . M.toAscList . M.fromList-    {-# INLINE fromList #-}--    toList = U.toList . unTrans-    {-# INLINE toList #-}

@@ -1,12 +0,0 @@--- | Basic types used throughout the library.--module Data.DAWG.Types-( ID-, Sym-) where---- | Node identifier.-type ID = Int---- | Internal representation of an alphabet element.-type Sym = Int

@@ -1,58 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE TupleSections #-}---- | Utility functions.--module Data.DAWG.Util-( binarySearch-, findLastLE-, combine-) where--import Control.Applicative ((<$>))-import Data.Bits (shiftR, xor)-import Data.Vector.Unboxed (Unbox)-import qualified Control.Monad.ST as ST-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Unboxed.Mutable as UM---- | Given a vector of length @n@ strictly ascending with respect to a given--- comparison function, find an index at which the given element could be--- inserted while preserving sortedness.--- The 'Left' result indicates, that the 'EQ' element has been found,--- while the 'Right' result means otherwise.  Value of the 'Right'--- result is in the [0,n] range.-binarySearch :: Unbox a => (a -> Ordering) -> U.Vector a -> Either Int Int-binarySearch cmp v = ST.runST $ do-    w <- U.unsafeThaw v-    search w-  where-    search w =-        loop 0 (UM.length w)-      where-        loop !l !u-            | u <= l    = return (Right l)-            | otherwise = do-                let k = (u + l) `shiftR` 1-                x <- UM.unsafeRead w k-                case cmp x of-                    LT -> loop (k+1) u-                    EQ -> return (Left k)-                    GT -> loop l     k-{-# INLINE binarySearch #-}---- | Given a vector sorted with respect to some underlying comparison--- function, find last element which is not 'GT' with respect to the--- comparison function.-findLastLE :: Unbox a => (a -> Ordering) -> U.Vector a -> Maybe (Int, a)-findLastLE cmp v =-    let k' = binarySearch cmp v-    	k  = either id (\x -> x-1) k'-    in  (k,) <$> v U.!? k-{-# INLINE findLastLE #-}---- | Combine two given hash values.  'combine' has zero as a left--- identity.-combine :: Int -> Int -> Int-combine h1 h2 = (h1 * 16777619) `xor` h2-{-# INLINE combine #-}