packages feed

dawg 0.8.2 → 0.11

raw patch · 12 files changed

Files

− README.md 
dawg.cabal view
@@ -1,54 +1,55 @@-cabal-version: 1.12+name:               dawg+version:            0.11+synopsis:           Directed acyclic word graphs+description:+    The library implements /directed acyclic word graphs/ (DAWGs) internally+    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+    hs-source-dirs: src+    build-depends:+        base >= 4 && < 5+      , containers >= 0.4.1 && < 0.6+      , binary+      , vector+      , vector-binary+      , mtl+      , transformers -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
− src/Data/DAWG.hs 
@@ -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
+ src/Data/DAWG/Dynamic.hs view
@@ -0,0 +1,275 @@+{-# LANGUAGE RecordWildCards #-}+++-- | 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+, lookup+, numStates+, numEdges++-- * 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           Control.Monad.Trans.Maybe+import           Control.Monad.Trans.Class++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 = S.State (Graph (N.Node a))++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 })++-- | Follow the path from the given identifier.+follow :: [Sym] -> ID -> MaybeT (GraphM a) ID+follow (x:xs) i = do+    n <- lift $ nodeBy i+    j <- liftMaybe $ N.onSym x n+    follow xs j+follow [] i = return i+    +lookupM :: [Sym] -> ID -> GraphM a (Maybe a)+lookupM xs i = runMaybeT $ do+    j <- follow xs i+    k <- lift $ N.eps <$> nodeBy j+    MaybeT $ N.value <$> nodeBy k++-- | Return all (key, value) pairs in ascending key order in the+-- sub-DAWG determined by the given node ID.+subPairs :: Graph (N.Node a) -> ID -> [([Sym], a)]+subPairs 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:)) (subPairs 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 #-}++-- | 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 #-}++-- -- | Find all (key, value) pairs such that key is prefixed+-- -- with the given string.+-- withPrefix :: (Enum a, Ord b) => [a] -> DAWG a b -> [([a], b)]+-- withPrefix xs DAWG{..}+--     = map (first $ (xs ++) . map toEnum)+--     $ maybe [] (subPairs graph)+--     $ flip S.evalState graph $ runMaybeT+--     $ follow (map fromEnum xs) root+-- {-# SPECIALIZE withPrefix+--     :: Ord b => String -> DAWG Char b+--     -> [(String, 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))+    . (subPairs <$> 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 . (subPairs <$> 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 #-}++-- | 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 () #-}+++----------------+-- Misc+----------------+++liftMaybe :: Monad m => Maybe a -> MaybeT m a+liftMaybe = MaybeT . return+{-# INLINE liftMaybe #-}
+ src/Data/DAWG/Dynamic/Internal.hs view
@@ -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
+ src/Data/DAWG/Dynamic/Node.hs view
@@ -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 #-}
src/Data/DAWG/Graph.hs view
@@ -9,6 +9,7 @@ ( Graph (..) , empty , size+, nodes , nodeBy , insert , delete@@ -17,7 +18,7 @@ import Control.Applicative ((<$>), (<*>)) import Data.Binary (Binary, put, get) import qualified Data.IntSet as S-import qualified Data.IntMap.Strict as M+import qualified Data.IntMap as M  import Data.DAWG.HashMap (Hash) import qualified Data.DAWG.HashMap as H@@ -68,6 +69,10 @@ 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@@ -105,7 +110,7 @@  -- | Increment the number of ingoing paths. incIngo :: ID -> Graph n -> Graph n-incIngo i g = g { ingoMap = M.insertWith (+) i 1 (ingoMap g) }+incIngo i g = g { ingoMap = M.insertWith' (+) i 1 (ingoMap g) }  -- | Decrement the number of ingoing paths and return -- the resulting number.
src/Data/DAWG/HashMap.hs view
@@ -51,7 +51,7 @@  -- | Assumption: element is a member of the 'Value'.  findUnsafe :: Ord a => a -> Value a b -> Maybe b-findUnsafe _ (Single _ y) = Just y     -- unsafe+findUnsafe _ (Single _ y) = Just y	-- unsafe findUnsafe x (Multi m) = M.lookup x m  -- | Convert map into a 'Single' form if possible.
− src/Data/DAWG/Internal.hs 
@@ -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 () #-}
− src/Data/DAWG/Node.hs 
@@ -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
src/Data/DAWG/Static.hs view
@@ -1,63 +1,60 @@-{-# 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:+-- In comparison to "Data.DAWG.Dynamic" module the automaton implemented here: -----   * Keeps all nodes in one array and therefore uses much less memory,+--   * 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,+--     'index' and 'byIndex' 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++-- * ID+, ID+, rootID+, byID+ -- * Query , lookup+, edges+, submap , numStates--- * Index+, numEdges++-- * Weight+, Weight+, weigh+, size , index , byIndex--- * Hash-, hash-, unHash+ -- * Construction , empty , fromList , fromListWith , fromLang-, freeze--- * Weight-, Weight-, weigh+ -- * Conversion , assocs , keys , elems+, freeze -- , thaw ) where + import Prelude hiding (lookup)-import Control.Applicative ((<$), (<$>), (<|>))+import Control.Applicative ((<$), (<$>), (<*>), (<|>)) import Control.Arrow (first) import Data.Binary (Binary, put, get) import Data.Vector.Binary ()@@ -67,127 +64,191 @@ 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.Util as Util 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.Static.Node as N import qualified Data.DAWG.Graph as G-import qualified Data.DAWG.Internal as D-import qualified Data.DAWG.Util as Util+import qualified Data.DAWG.Dynamic as D+import qualified Data.DAWG.Dynamic.Internal as D --- | @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)+-- | @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.+--+data DAWG a b c = DAWG+    { nodes  :: V.Vector (N.Node b c)+    -- | The actual DAWG root has the 0 ID.  Thanks to the 'rootID'+    -- attribute, we can represent a submap of a DAWG.+    , rootID :: ID+    } deriving (Show, Eq, Ord) -instance (Binary t, Binary b, Binary c, Unbox b) => Binary (DAWG t a b c) where-    put = put . unDAWG-    get = DAWG <$> get+instance (Binary b, Binary c, Unbox b) => Binary (DAWG a b c) where+    put DAWG{..} = put nodes >> put rootID+    get = DAWG <$> get <*> get ++-- | Retrieve sub-DAWG with a given ID (or `Nothing`, if there's+-- no such DAWG).  This function can be used, together with the+-- `root` function, to store IDs rather than entire DAWGs in a+-- data structure.+byID :: ID -> DAWG a b c -> Maybe (DAWG a b c)+byID i d = if i >= 0 && i < V.length (nodes d)+    then Just (d { rootID = i })+    else Nothing++ -- | Empty DAWG.-empty :: (Trans t, Unbox b) => DAWG t a b c-empty = DAWG $ V.fromList+empty :: Unbox b => DAWG a b c+empty = flip DAWG 0 $ V.fromList     [ N.Branch 1 T.empty U.empty     , N.Leaf Nothing ] ++-- | A list of outgoing edges.+edges :: Enum a => DAWG a b c -> [(a, DAWG a b c)]+edges d =+    [ (toEnum sym, d{ rootID = i })+    | (sym, i) <- N.edges n ]+  where+    n = nodeBy (rootID d) d+++-- | Return the sub-DAWG containing all keys beginning with a prefix.+-- The in-memory representation of the resultant DAWG is the same as of+-- the original one, only the pointer to the DAWG root will be different.+submap :: (Enum a, Unbox b) => [a] -> DAWG a b c -> DAWG a b c+submap xs d = case follow (map fromEnum xs) (rootID d) d of+    Just i  -> d { rootID = i }+    Nothing -> empty+{-# SPECIALIZE submap :: Unbox b => String -> DAWG Char b c -> DAWG Char b c #-}++ -- | Number of states in the automaton.-numStates :: DAWG t a b c -> Int-numStates = V.length . unDAWG+-- TODO: The function ignores the `rootID` value, it won't work properly+-- after using the `submap` function.+numStates :: DAWG a b c -> Int+numStates = V.length . nodes ++-- | Number of edges in the automaton.+-- TODO: The function ignores the `rootID` value, it won't work properly+-- after using the `submap` function.+numEdges :: DAWG a b c -> Int+numEdges = sum . map (length . N.edges) . V.toList . nodes++ -- | Node with the given identifier.-nodeBy :: ID -> DAWG t a b c -> Node t b c-nodeBy i d = unDAWG d V.! i+nodeBy :: ID -> DAWG a b c -> N.Node b c+nodeBy i d = nodes 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.Node b c -> DAWG a b c -> Maybe c leafValue n = N.value . nodeBy (N.eps n) ++-- | Follow the path from the given identifier.+follow :: Unbox b => [Sym] -> ID -> DAWG a b c -> Maybe ID+follow (x:xs) i d = do+    j <- N.onSym x (nodeBy i d)+    follow xs j d+follow [] i _ = Just i++ -- | 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 :: (Enum a, Unbox b) => [a] -> DAWG a b c -> Maybe c+lookup xs d = lookup'I (map fromEnum xs) (rootID d) d+{-# SPECIALIZE lookup :: Unbox b => String -> DAWG 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)] #-}+lookup'I :: Unbox b => [Sym] -> ID -> DAWG a b c -> Maybe c+lookup'I xs i d = do+    j <- follow xs i d+    leafValue (nodeBy j d) d -assocs'I :: (Trans t, Unbox b) => ID -> DAWG t a b c -> [([Sym], c)]-assocs'I i d =++-- -- | Find all (key, value) pairs such that key is prefixed+-- -- with the given string.+-- withPrefix :: (Enum a, Unbox b) => [a] -> DAWG a b c -> [([a], c)]+-- withPrefix xs d = maybe [] id $ do+--     i <- follow (map fromEnum xs) 0 d+--     let prepare = (xs ++) . map toEnum+--     return $ map (first prepare) (subPairs i d)+-- {-# SPECIALIZE withPrefix+--     :: Unbox b => String -> DAWG Char b c+--     -> [(String, c)] #-}+++-- | Return all (key, value) pairs in ascending key order in the+-- sub-DAWG determined by the given node ID.+subPairs :: Unbox b => ID -> DAWG a b c -> [([Sym], c)]+subPairs 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)+    there (x, j) = map (first (x:)) (subPairs j d) ++-- | 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)) (subPairs (rootID d) d)+{-# SPECIALIZE assocs :: Unbox b => DAWG Char b c -> [(String, c)] #-}++ -- | Return all keys of the DAWG in ascending order.-keys :: (Enum a, Trans t, Unbox b) => DAWG t a b c -> [[a]]+keys :: (Enum a, Unbox b) => DAWG a b c -> [[a]] keys = map fst . assocs-{-# SPECIALIZE keys :: (Trans t, Unbox b) => DAWG t Char b c -> [String] #-}+{-# SPECIALIZE keys :: Unbox b => DAWG 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+elems :: Unbox b => DAWG a b c -> [c]+elems d = map snd $ subPairs (rootID d) d + -- | 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 :: (Enum a, Ord b) => [([a], b)] -> DAWG a () b fromList = freeze . D.fromList-{-# SPECIALIZE fromList-        :: D.MkNode t b => [(String, b)] -> DAWG t Char () b #-}+{-# 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, D.MkNode t b)-    => (b -> b -> b) -> [([a], b)] -> DAWG t a () b+fromListWith :: (Enum a, Ord b) => (b -> b -> b) -> [([a], b)] -> DAWG a () b fromListWith f = freeze . D.fromListWith f {-# SPECIALIZE fromListWith-        :: D.MkNode t b => (b -> b -> b)-        -> [(String, b)] -> DAWG t Char () b #-}+        :: 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, D.MkNode t ())-    => [[a]] -> DAWG t a () ()+fromLang :: Enum a => [[a]] -> DAWG a () () fromLang = freeze . D.fromLang-{-# SPECIALIZE fromLang :: D.MkNode t () => [String] -> DAWG t Char () () #-}+{-# 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 :: Trans t => DAWG t a b c -> DAWG t a Weight c-weigh d = (DAWG . V.fromList)+-- Be aware, that the entire DAWG will be weighted, even when (because of the use of+-- the `submap` function) only a part of the DAWG is currently selected.+weigh :: DAWG a b c -> DAWG a Weight c+weigh d = flip DAWG (rootID d) $ V.fromList     [ branch n ws     | i <- [0 .. numStates d - 1]     , let n  = nodeBy i d@@ -207,13 +268,14 @@     -- 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)+freeze :: D.DAWG a b -> DAWG a () b+freeze d = flip DAWG 0 . V.fromList $+    map (N.fromDyn newID . oldBy)         (M.elems (inverse old2new))   where-    -- Map from old to new identifiers.+    -- Map from old to new identifiers.  The root identifier is mapped to 0.     old2new = M.fromList $ (D.root d, 0) : zip (nodeIDs d) [1..]     newID   = (M.!) old2new     -- List of node IDs without the root ID.@@ -221,12 +283,14 @@     -- 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 =@@ -242,7 +306,7 @@ --     -- New identifiers for value nodes. --     valIDs = foldl' updID GM.empty (values d) --     -- Values in the automaton.---     values = map value . V.toList . unDAWG+--     values = map value . V.toList . nodes --     -- Update ID map. --     updID m v = case GM.lookup v m of --         Just i  -> m@@ -250,14 +314,38 @@ --             let j = GM.size m + n --             in  j `seq` GM.insert v j ++-- | A number of distinct (key, value) pairs in the weighted DAWG.+size :: DAWG a Weight c -> Int+size d = size'I (rootID d) d+++size'I :: ID -> DAWG a Weight c -> Int+size'I i d = add $ do+    x <- case N.edges n of+        [] -> Nothing+        xs -> Just (fst $ last xs)+    (j, v) <- N.onSym' x n+    return $ v + size'I j d+  where+    n = nodeBy i d+    u = maybe 0 (const 1) (leafValue n d)+    add m = u + maybe 0 id m+++-----------------------------------------+-- Index+-----------------------------------------++ -- | 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 :: Enum a => [a] -> DAWG a Weight c -> Maybe Int+index xs d = index'I (map fromEnum xs) (rootID d) d+{-# SPECIALIZE index :: String -> DAWG Char Weight c -> Maybe Int #-} -index'I :: Trans t => [Sym] -> ID -> DAWG t a 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@@ -266,20 +354,15 @@     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 :: Enum a => Int -> DAWG a Weight c -> Maybe [a]+byIndex ix d = map toEnum <$> byIndex'I ix (rootID d) d+{-# SPECIALIZE byIndex :: Int -> DAWG Char Weight c -> Maybe String #-} -byIndex'I :: Trans t => Int -> ID -> DAWG t a Weight c -> Maybe [Sym]++byIndex'I :: Int -> ID -> DAWG a Weight c -> Maybe [Sym] byIndex'I ix i d     | ix < 0    = Nothing     | otherwise = here <|> there@@ -295,8 +378,3 @@         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 #-}
+ src/Data/DAWG/Static/Node.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE RecordWildCards #-}++-- | Internal representation of a static automata node.++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