dawg 0.5.0 → 0.6.0

raw patch · 6 files changed

+574/−273 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/DAWG.hs +98/−76
• Data/DAWG/Frozen.hs +267/−0
• Data/DAWG/Graph.hs +0/−186
• Data/DAWG/Internal.hs +192/−0
• Data/DAWG/VMap.hs +7/−7
• dawg.cabal +10/−4

@@ -1,5 +1,5 @@--- | The module provides implementation of /directed acyclic word graphs/--- (DAWGs) also known as /minimal acyclic finite-state automata/.+-- | 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. @@ -12,18 +12,18 @@ , lookup -- * Construction , empty+, fromList+, fromListWith+, fromLang -- ** Insertion , insert , insertWith -- ** Deletion , delete -- * Conversion-, elems-, keys , assocs-, fromList-, fromListWith-, fromLang+, keys+, elems ) where  import Prelude hiding (lookup)@@ -33,11 +33,11 @@ import Data.Binary (Binary, put, get) import qualified Control.Monad.State.Strict as S -import Data.DAWG.Graph (Id, Node, Graph)-import qualified Data.DAWG.Graph as G+import Data.DAWG.Internal (Id, Node, Graph)+import qualified Data.DAWG.Internal as I import qualified Data.DAWG.VMap as V -type GraphM a b = S.State  (Graph (Maybe a)) b+type GraphM a b = S.State (Graph (Maybe a)) b  mkState :: (Graph a -> Graph a) -> Graph a -> ((), Graph a) mkState f g = ((), f g)@@ -45,172 +45,194 @@ -- | Leaf node with no children and 'Nothing' value. insertLeaf :: Ord a => GraphM a Id  insertLeaf = do-    i <- insertNode (G.Value Nothing)-    insertNode (G.Branch i V.empty)+    i <- insertNode (I.Value Nothing)+    insertNode (I.Branch i V.empty)  -- | Return node with the given identifier. nodeBy :: Id -> GraphM a (Node (Maybe a))-nodeBy i = G.nodeBy i <$> S.get+nodeBy i = I.nodeBy i <$> S.get --- Evaluate the 'G.insert' function within the monad.+-- Evaluate the 'I.insert' function within the monad. insertNode :: Ord a => Node (Maybe a) -> GraphM a Id-insertNode = S.state . G.insert+insertNode = S.state . I.insert --- Evaluate the 'G.delete' function within the monad.+-- Evaluate the 'I.delete' function within the monad. deleteNode :: Ord a => Node (Maybe a) -> GraphM a ()-deleteNode = S.state . mkState . G.delete+deleteNode = S.state . mkState . I.delete  -- | Invariant: the identifier points to the 'Branch' node.-insertM :: Ord a => String -> a -> Id -> GraphM a Id+insertM :: Ord a => [Int] -> a -> Id -> GraphM a Id insertM (x:xs) y i = do     n <- nodeBy i-    j <- case G.onChar x n of+    j <- case I.onSym x n of         Just j  -> return j         Nothing -> insertLeaf     k <- insertM xs y j     deleteNode n-    insertNode (G.subst x k n)+    insertNode (I.subst x k n) insertM [] y i = do     n <- nodeBy i-    w <- nodeBy (G.eps n)+    w <- nodeBy (I.eps n)     deleteNode w     deleteNode n-    j <- insertNode (G.Value $ Just y)-    insertNode (n { G.eps = j })+    j <- insertNode (I.Value $ Just y)+    insertNode (n { I.eps = j }) -insertWithM :: Ord a => (a -> a -> a) -> String -> a -> Id -> GraphM a Id+insertWithM :: Ord a => (a -> a -> a) -> [Int] -> a -> Id -> GraphM a Id insertWithM f (x:xs) y i = do     n <- nodeBy i-    j <- case G.onChar x n of+    j <- case I.onSym x n of         Just j  -> return j         Nothing -> insertLeaf     k <- insertWithM f xs y j     deleteNode n-    insertNode (G.subst x k n)+    insertNode (I.subst x k n) insertWithM f [] y i = do     n <- nodeBy i-    w <- nodeBy (G.eps n)+    w <- nodeBy (I.eps n)     deleteNode w     deleteNode n-    let y'new = case G.unValue w of+    let y'new = case I.unValue w of             Just y' -> f y y'             Nothing -> y-    j <- insertNode (G.Value $ Just y'new)-    insertNode (n { G.eps = j })+    j <- insertNode (I.Value $ Just y'new)+    insertNode (n { I.eps = j }) -deleteM :: Ord a => String -> Id -> GraphM a Id+deleteM :: Ord a => [Int] -> Id -> GraphM a Id deleteM (x:xs) i = do     n <- nodeBy i-    case G.onChar x n of+    case I.onSym x n of         Nothing -> return i         Just j  -> do             k <- deleteM xs j             deleteNode n-            insertNode (G.subst x k n)+            insertNode (I.subst x k n) deleteM [] i = do     n <- nodeBy i-    w <- nodeBy (G.eps n)+    w <- nodeBy (I.eps n)     deleteNode w     deleteNode n     j <- insertLeaf-    insertNode (n { G.eps = j })+    insertNode (n { I.eps = j })     -lookupM :: String -> Id -> GraphM a (Maybe a)+lookupM :: [Int] -> Id -> GraphM a (Maybe a) lookupM [] i = do-    j <- G.eps <$> nodeBy i-    G.unValue <$> nodeBy j+    j <- I.eps <$> nodeBy i+    I.unValue <$> nodeBy j lookupM (x:xs) i = do     n <- nodeBy i-    case G.onChar x n of+    case I.onSym x n of         Just j  -> lookupM xs j         Nothing -> return Nothing -assocsAcc :: Graph (Maybe a) -> Id -> [(String, a)]+assocsAcc :: Graph (Maybe a) -> Id -> [([Int], a)] assocsAcc g i =-    here w ++ concatMap there (G.edges n)+    here w ++ concatMap there (I.edges n)   where-    n = G.nodeBy i g-    w = G.nodeBy (G.eps n) g-    here v = case G.unValue v of-        Just x  -> [("", x)]+    n = I.nodeBy i g+    w = I.nodeBy (I.eps n) g+    here v = case I.unValue v of+        Just x  -> [([], x)]         Nothing -> []-    there (char, j) = map (first (char:)) (assocsAcc g j)+    there (sym, j) = map (first (sym:)) (assocsAcc g j) --- | A 'G.Graph' with one root from which all other graph nodes should--- be accesible.-data DAWG a = DAWG-    { graph :: !(Graph (Maybe a))+-- | A 'I.Graph' with one root from which all other graph nodes should+-- be accesible.  Parameter @a@ is a phantom parameter which represents+-- symbol type.+data DAWG a b = DAWG+    { graph :: !(Graph (Maybe b))     , root  :: !Id }     deriving (Show, Eq, Ord) -instance (Ord a, Binary a) => Binary (DAWG a) where+instance (Ord b, Binary b) => Binary (DAWG a b) where     put d = do         put (graph d)         put (root d)     get = DAWG <$> get <*> get  -- | Empty DAWG.-empty :: Ord a => DAWG a+empty :: Ord b => DAWG a b empty = -    let (i, g) = S.runState insertLeaf G.empty+    let (i, g) = S.runState insertLeaf I.empty     in  DAWG g i  -- | Number of states in the underlying graph.-numStates :: DAWG a -> Int-numStates = G.size . graph+numStates :: DAWG a b -> Int+numStates = I.size . graph  -- | Insert the (key, value) pair into the DAWG.-insert :: Ord a => String -> a -> DAWG a -> DAWG a-insert xs y d =-    let (i, g) = S.runState (insertM xs y $ root d) (graph d)+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+{-# 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 :: Ord a => (a -> a -> a) -> String -> a -> DAWG a -> DAWG a-insertWith f xs y d =-    let (i, g) = S.runState (insertWithM f xs y $ root d) (graph d)+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 :: Ord a => String -> DAWG a -> DAWG a-delete xs d =-    let (i, g) = S.runState (deleteM xs $ root d) (graph d)+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 :: String -> DAWG a -> Maybe a-lookup xs d = S.evalState (lookupM xs $ root d) (graph d)+lookup :: Enum a => [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 :: String -> DAWG Char b -> Maybe b #-} +-- | Return all key/value pairs in the DAWG in ascending key order.+assocs :: Enum a => DAWG a b -> [([a], b)]+assocs+    = map (first (map toEnum))+    . (assocsAcc <$> graph <*> root)+{-# SPECIALIZE assocs :: DAWG Char b -> [(String, b)] #-}+ -- | Return all keys of the DAWG in ascending order.-keys :: DAWG a -> [String]+keys :: Enum a => DAWG a b -> [[a]] keys = map fst . assocs+{-# SPECIALIZE keys :: DAWG Char b -> [String] #-}  -- | Return all elements of the DAWG in the ascending order of their keys.-elems :: DAWG a -> [a]-elems = map snd . assocs---- | Return all key/value pairs in the DAWG in ascending key order.-assocs :: DAWG a -> [(String, a)]-assocs d = assocsAcc (graph d) (root d)+elems :: DAWG a b -> [b]+elems = map snd . (assocsAcc <$> graph <*> root)  -- | Construct DAWG from the list of (word, value) pairs.-fromList :: Ord a => [(String, a)] -> DAWG a+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+{-# 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 :: Ord a => (a -> a -> a) -> [(String, a)] -> DAWG a+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 :: [String] -> DAWG ()+fromLang :: Enum a => [[a]] -> DAWG a () fromLang xs = fromList [(x, ()) | x <- xs]+{-# SPECIALIZE fromLang :: [String] -> DAWG Char () #-}

@@ -0,0 +1,267 @@+{-# LANGUAGE RecordWildCards #-}++-- | 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,+--+--   * Constitutes a /perfect hash automaton/ with 'hash' and+--     'unHash' functions,+--+--   * Doesn't provide insert/delete family of operations.++module Data.DAWG.Frozen+(+-- * DAWG type+  DAWG+-- * Query+, lookup+, numStates+-- * Index+, index+, byIndex+-- ** Hashing+, hash+, unHash+-- * Construction+, empty+, fromList+, fromListWith+, fromLang+-- * Conversion+, assocs+, keys+, elems+, freeze+) where++import Prelude hiding (lookup)+import Control.Applicative (pure, (<$), (<$>), (<*>))+import Control.Arrow (first, second)+import Data.Binary (Binary, put, get)+import Data.Vector.Binary ()+import qualified Data.IntMap as M+import qualified Data.Vector as V++import qualified Data.DAWG.VMap as VM+import qualified Data.DAWG.Internal as I+import qualified Data.DAWG as D++-- | Node identifier.+type Id = Int++-- | State (node) of the automaton.+data Node a = Node {+    -- | Value kept in the node.+      value :: !a+    -- | Number of accepting states reachable from the node.+    , size  :: {-# UNPACK #-} !Int+    -- | Edges outgoing from the node.+    , edges :: !VM.VMap }+    deriving (Show, Eq, Ord)++instance Binary a => Binary (Node a) where+    put Node{..} = put value >> put size >> put edges+    get = Node <$> get <*> get <*> get++-- | Identifier of the child determined by the given symbol.+onSym :: Int -> Node a -> Maybe Id+onSym x (Node _ _ es) = VM.lookup x es++-- List of edges from the node.+edgeList :: Node a -> [(Int, Id)]+edgeList = VM.toList . edges++-- | List children identifiers.+children :: Node a -> [Id]+children = map snd . edgeList++-- | Root is stored on the first position of the array.+type DAWG a b = V.Vector (Node (Maybe b))++-- | Empty DAWG.+empty :: DAWG a b+empty = V.singleton (Node Nothing 0 VM.empty)++-- | Number of states in the automaton.+numStates :: DAWG a b -> Int+numStates = V.length++-- | Node with the given identifier.+nodeBy :: Id -> DAWG a b -> Node (Maybe b)+nodeBy i d = d V.! i++-- | Find value associated with the key.+lookup :: Enum a => [a] -> DAWG a b -> Maybe b+lookup xs' =+    let xs = map fromEnum xs'+    in  lookup'I xs 0+{-# SPECIALIZE lookup :: String -> DAWG Char b -> Maybe b #-}++lookup'I :: [Int] -> Id -> DAWG a b -> Maybe b+lookup'I []     i d = value (nodeBy i d)+lookup'I (x:xs) i d = case 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 => DAWG a b -> [([a], b)]+assocs d = map (first (map toEnum)) (assocs'I 0 d)+{-# SPECIALIZE assocs :: DAWG Char b -> [(String, b)] #-}++assocs'I :: Id -> DAWG a b -> [([Int], b)]+assocs'I i d =+    here ++ concatMap there (VM.toList (edges n))+  where+    n = nodeBy i d+    here = case value n of+        Just x  -> [([], x)]+        Nothing -> []+    there (sym, j) = map (first (sym:)) (assocs'I j d)++-- | Return all keys of the DAWG in ascending order.+keys :: Enum a => DAWG a b -> [[a]]+keys = map fst . assocs+{-# SPECIALIZE keys :: DAWG Char b -> [String] #-}++-- | Return all elements of the DAWG in the ascending order of their keys.+elems :: DAWG a b -> [b]+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 () #-}++-- | Recursively compute sizes of nodes. +detSize :: DAWG a b -> DAWG a b+detSize d = V.fromList+    [ (nodeBy i d) { size = mem i }+    | i <- [0 .. numStates d - 1] ]+  where+    add w x = maybe 0 (const 1) w + sum x+    mem     = ((V.!) . V.fromList) (map det [0 .. numStates d - 1])+    det i   =+        let n = nodeBy i d+            js = children n+        in  add (value n) (map mem js)++-- | Yield immutable version of the automaton.+freeze :: D.DAWG a b -> DAWG a b+freeze d = detSize . V.fromList $+    map (stop . oldBy) (M.elems (inverse old2new))+  where+    -- Map from old to new identifiers.+    old2new = M.fromList $ (D.root d, 0) : zip (nodeIDs d) [1..]+    -- List of non-frozen branches' IDs without the root ID.+    nodeIDs = filter (/= D.root d) . branchIDs+    -- Make frozen node with new IDs from non-frozen node.+    stop    = Node <$> onEps <*> pure 0 <*> mkEdges . I.edgeMap+    -- Extract value following the epsilon transition.+    onEps   = I.unValue . oldBy . I.eps+    -- List of edges with new IDs.+    mkEdges = VM.fromList . map (second (old2new M.!)) . VM.toList +    -- Non-frozen node by given identifier.+    oldBy i = I.nodeBy i (D.graph d)++-- | Branch IDs in the non-frozen DAWG.+branchIDs :: D.DAWG a b -> [I.Id]+branchIDs+    = map fst . filter (isBranch . snd)+    . M.assocs . I.nodeMap . D.graph+  where+    isBranch (I.Branch _ _) = True+    isBranch _              = False+        +-- | 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 a 'D.DAWG' version of the automaton.+-- thaw :: DAWG a b -> D.DAWG a b+-- thaw d =+--     D.DAWG graph 0+--   where+--     graph = I.Graph+--         (Map.fromList $ zip nodes [0..])+--         IS.empty+--         (M.fromList   $ zip [0..] nodes)+--         (++-- | Position in a set of all dictionary entries with respect+-- to the lexicographic order.+index :: Enum a => [a] -> DAWG a b -> Maybe Int+index xs = index'I (map fromEnum xs) 0+{-# SPECIALIZE index :: String -> DAWG Char b -> Maybe Int #-}++index'I :: [Int] -> Id -> DAWG a b -> Maybe Int+index'I []     i d = 0 <$ value (nodeBy i d)+index'I (x:xs) i d = case onSym x n of+    Just j  -> do+        x0 <- index'I xs j d+        let x1 = maybe 0 (const 1) (value n)+               + (sum . map sizeBy) (before (x, j))+        return $ x0 + x1+    Nothing -> Nothing+  where+    -- Current node.+    n = nodeBy i d+    -- Size of node by ID.+    sizeBy = size . flip nodeBy d+    -- All childresn IDs before the (x, j) edge.+    before e = map snd . fst $ span (/=e) (edgeList n)++-- | Perfect hashing function for dictionary entries.+-- A synonym for the 'index' function.+hash :: Enum a => [a] -> DAWG a b -> Maybe Int+hash = index+{-# INLINE hash #-}++-- | Find dictionary entry given its index with respect to the+-- lexicographic order.+byIndex :: Enum a => Int -> DAWG a b -> Maybe [a]+byIndex i d = map toEnum <$> byIndex'I i 0 d+{-# SPECIALIZE byIndex :: Int -> DAWG Char b -> Maybe String #-}++byIndex'I :: Int -> Id -> DAWG a b -> Maybe [Int]+byIndex'I ix i d = do+    (acc, x, j) <- findChild 0 (edgeList n)+    xs <- byIndex'I (ix - acc) j d+    return (x:xs)+  where+    -- Current node.+    n   = nodeBy i d+    -- Size of node by ID.+    sizeBy = size . flip nodeBy d+    -- Sum node size values and find the appropriate one.+    findChild acc ((x, j) : js)+        | acc < ix  = findChild (acc + sizeBy j) js+        | otherwise = Just (acc, x, j)+    findChild _ []  = Nothing++-- | Inverse of the 'hash' function and a synonym for the 'byIndex' function.+unHash :: Enum a => Int -> DAWG a b -> Maybe [a]+unHash = byIndex+{-# INLINE unHash #-}

@@ -1,186 +0,0 @@-{-# LANGUAGE RecordWildCards #-}---- | The module provides a representation of a tree where all equivalent nodes--- (i.e. trees equal with respect to the '==' function) are compressed to one--- /directed acyclic graph/ (DAG) node with unique identifier.  Alternatively,--- it can be thought of as a /minimal acyclic finite-state automata/.--module Data.DAWG.Graph-( --- * Node-  Node (..)-, Id-, edges-, onChar-, subst--- * Graph-, Graph (..)-, empty-, size-, nodeBy-, nodeID-, insert-, delete-) where--import Control.Applicative ((<$>), (<*>))-import Data.Binary (Binary, Get, put, get)-import qualified Data.Map as M-import qualified Data.IntSet as IS-import qualified Data.IntMap as IM--import qualified Data.DAWG.VMap as V---- | Node identifier.-type Id = Int---- | 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.------ Invariant: the 'value' identifier always points to the 'Value' node.--- Edges in the 'edgeMap', on the other hand, point to 'Branch' nodes.-data Node a-    = Branch-        { eps       :: {-# UNPACK #-} !Id-        , edgeMap   :: !(V.VMap Id) }-    | Value-        { unValue :: !a }-    deriving (Show, Eq, Ord)--instance Functor Node where-    fmap f (Value x) = Value (f x)-    fmap _ (Branch x y) = Branch x y--instance Binary a => Binary (Node a) where-    put Branch{..} = put (1 :: Int) >> put eps >> put edgeMap-    put Value{..}  = put (2 :: Int) >> put unValue-    get = do-        x <- get :: Get Int-        case x of-            1 -> Branch <$> get <*> get-            _ -> Value <$> get---- | List of non-epsilon edges outgoing from the 'Branch' node.-edges :: Node a -> [(Char, Id)]-edges (Branch _ es)     = V.toList es-edges (Value _)         = error "edges: value node"---- | Identifier of the child determined by the given character.-onChar :: Char -> Node a -> Maybe Id-onChar x (Branch _ es)  = V.lookup x es-onChar _ (Value _)      = error "onChar: value node"---- | Substitue the identifier of the child determined by the given--- character.-subst :: Char -> Id -> Node a -> Node a-subst x i (Branch w es) = Branch w (V.insert x i es)-subst _ _ (Value _)     = error "subst: value node"---- | 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 save some memory?-data Graph a = Graph {-    -- | Map from nodes to IDs.-      idMap     :: !(M.Map (Node a) Id)-    -- | Set of free IDs.-    , freeIDs   :: !IS.IntSet-    -- | Map from IDs to nodes. -    , nodeMap   :: !(IM.IntMap (Node a))-    -- | 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   :: !(IM.IntMap Int) }-    deriving (Show, Eq, Ord)--instance (Ord a, Binary a) => Binary (Graph a) where-    put Graph{..} = do-    	put idMap-	put freeIDs-	put nodeMap-	put ingoMap-    get = Graph <$> get <*> get <*> get <*> get---- | Empty graph.-empty :: Graph a-empty = Graph M.empty IS.empty IM.empty IM.empty---- | Size of the graph (number of nodes).-size :: Graph a -> Int-size = M.size . idMap---- | Node with the given identifier.-nodeBy :: Id -> Graph a -> Node a-nodeBy i g = nodeMap g IM.! i---- | Retrieve the node identifier.-nodeID :: Ord a => Node a -> Graph a -> Id-nodeID n g = idMap g M.! n---- | Add new graph node.-newNode :: Ord a => Node a -> Graph a -> (Id, Graph a)-newNode n Graph{..} =-    (i, Graph idMap' freeIDs' nodeMap' ingoMap')-  where-    idMap'      = M.insert  n i idMap-    nodeMap'    = IM.insert i n nodeMap-    ingoMap'    = IM.insert i 1 ingoMap-    (i, freeIDs') = if IS.null freeIDs-        then (M.size idMap, freeIDs)-        else IS.deleteFindMin freeIDs---- | Remove node from the graph.-remNode :: Ord a => Id -> Graph a -> Graph a-remNode i Graph{..} =-    Graph idMap' freeIDs' nodeMap' ingoMap'-  where-    idMap'      = M.delete  n idMap-    nodeMap'    = IM.delete i nodeMap-    ingoMap'    = IM.delete i ingoMap-    freeIDs'    = IS.insert i freeIDs-    n           = nodeMap IM.! i---- | Increment the number of ingoing paths.-incIngo :: Id -> Graph a -> Graph a-incIngo i g = g { ingoMap = IM.insertWith' (+) i 1 (ingoMap g) }---- | Descrement the number of ingoing paths and return--- the resulting number.-decIngo :: Id -> Graph a -> (Int, Graph a)-decIngo i g =-    let k = (ingoMap g IM.! i) - 1-    in  (k, g { ingoMap = IM.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--- ancestors of the node, so the operation alone will not ensure--- that properties of the graph are preserved.-insert :: Ord a => Node a -> Graph a -> (Id, Graph a)-insert n g = case M.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.--- NOTE: The function does not delete descendant nodes which may become--- inaccesible nor does it change the number of ingoing paths for any--- ancestor of the node.-delete :: Ord a => Node a -> Graph a -> Graph a-delete n g = if num == 0-    then remNode i g'-    else g'-  where-    i = nodeID n g-    (num, g') = decIngo i g

@@ -0,0 +1,192 @@+{-# LANGUAGE RecordWildCards #-}++-- | 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.Internal+( +-- * Node+  Node (..)+, Id+, edges+, onSym+, subst+-- * Graph+, Graph (..)+, empty+, size+, nodeBy+, nodeID+, insert+, delete+) where++import Control.Applicative ((<$>), (<*>))+import Data.Binary (Binary, Get, put, get)+import qualified Data.Map as M+import qualified Data.IntSet as IS+import qualified Data.IntMap as IM++import qualified Data.DAWG.VMap as V++-- | Node identifier.+type Id = Int++-- | 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 'Value' nodes are distinguished from 'Branch' nodes, two values+-- equal with respect to '==' function are always kept in one 'Value'+-- 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 'value' identifier always points to the 'Value' node.+-- Edges in the 'edgeMap', on the other hand, point to 'Branch' nodes.+data Node a+    = Branch {+        -- | Epsilon transition.+          eps       :: {-# UNPACK #-} !Id+        -- | Map from alphabet symbols to 'Branch' node identifiers.+        , edgeMap   :: !V.VMap }+    | Value+        { unValue :: !a }+    deriving (Show, Eq, Ord)++instance Functor Node where+    fmap f (Value x) = Value (f x)+    fmap _ (Branch x y) = Branch x y++instance Binary a => Binary (Node a) where+    put Branch{..} = put (1 :: Int) >> put eps >> put edgeMap+    put Value{..}  = put (2 :: Int) >> put unValue+    get = do+        x <- get :: Get Int+        case x of+            1 -> Branch <$> get <*> get+            _ -> Value <$> get++-- | List of non-epsilon edges outgoing from the 'Branch' node.+edges :: Node a -> [(Int, Id)]+edges (Branch _ es)     = V.toList es+edges (Value _)         = error "edges: value node"++-- | Identifier of the child determined by the given symbol.+onSym :: Int -> Node a -> Maybe Id+onSym x (Branch _ es) = V.lookup x es+onSym _ (Value _)     = error "onSym: value node"++-- | Substitue the identifier of the child determined by the given symbol.+subst :: Int -> Id -> Node a -> Node a+subst x i (Branch w es) = Branch w (V.insert x i es)+subst _ _ (Value _)     = error "subst: value node"++-- | 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 a = Graph {+    -- | Map from nodes to IDs.+      idMap     :: !(M.Map (Node a) Id)+    -- | Set of free IDs.+    , freeIDs   :: !IS.IntSet+    -- | Map from IDs to nodes. +    , nodeMap   :: !(IM.IntMap (Node a))+    -- | 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   :: !(IM.IntMap Int) }+    deriving (Show, Eq, Ord)++instance (Ord a, Binary a) => Binary (Graph a) where+    put Graph{..} = do+    	put idMap+	put freeIDs+	put nodeMap+	put ingoMap+    get = Graph <$> get <*> get <*> get <*> get++-- | Empty graph.+empty :: Graph a+empty = Graph M.empty IS.empty IM.empty IM.empty++-- | Size of the graph (number of nodes).+size :: Graph a -> Int+size = M.size . idMap++-- | Node with the given identifier.+nodeBy :: Id -> Graph a -> Node a+nodeBy i g = nodeMap g IM.! i++-- | Retrieve the node identifier.+nodeID :: Ord a => Node a -> Graph a -> Id+nodeID n g = idMap g M.! n++-- | Add new graph node.+newNode :: Ord a => Node a -> Graph a -> (Id, Graph a)+newNode n Graph{..} =+    (i, Graph idMap' freeIDs' nodeMap' ingoMap')+  where+    idMap'      = M.insert  n i idMap+    nodeMap'    = IM.insert i n nodeMap+    ingoMap'    = IM.insert i 1 ingoMap+    (i, freeIDs') = if IS.null freeIDs+        then (M.size idMap, freeIDs)+        else IS.deleteFindMin freeIDs++-- | Remove node from the graph.+remNode :: Ord a => Id -> Graph a -> Graph a+remNode i Graph{..} =+    Graph idMap' freeIDs' nodeMap' ingoMap'+  where+    idMap'      = M.delete  n idMap+    nodeMap'    = IM.delete i nodeMap+    ingoMap'    = IM.delete i ingoMap+    freeIDs'    = IS.insert i freeIDs+    n           = nodeMap IM.! i++-- | Increment the number of ingoing paths.+incIngo :: Id -> Graph a -> Graph a+incIngo i g = g { ingoMap = IM.insertWith' (+) i 1 (ingoMap g) }++-- | Decrement the number of ingoing paths and return+-- the resulting number.+decIngo :: Id -> Graph a -> (Int, Graph a)+decIngo i g =+    let k = (ingoMap g IM.! i) - 1+    in  (k, g { ingoMap = IM.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 :: Ord a => Node a -> Graph a -> (Id, Graph a)+insert n g = case M.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.+-- 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 :: Ord a => Node a -> Graph a -> Graph a+delete n g = if num == 0+    then remNode i g'+    else g'+  where+    i = nodeID n g+    (num, g') = decIngo i g

@@ -18,27 +18,27 @@  -- | A strictly ascending vector of distinct elements with respect -- to 'fst' values.-newtype VMap a = VMap { unVMap :: U.Vector (Char, a) }+newtype VMap = VMap { unVMap :: U.Vector (Int, Int) }     deriving (Show, Eq, Ord) -instance (Binary a, U.Unbox a) => Binary (VMap a) where+instance Binary VMap where     put v = put (unVMap v)     get = VMap <$> get  -- | Empty map.-empty :: U.Unbox a => VMap a+empty :: VMap empty = VMap U.empty {-# INLINE empty #-}  -- | Lookup the character in the map.-lookup :: U.Unbox a => Char -> VMap a -> Maybe a+lookup :: Int -> VMap -> Maybe Int lookup x = fmap snd . U.find ((==x) . fst) . unVMap {-# INLINE lookup #-}  -- | Insert the character/value pair into the map. -- TODO: Optimize!  Use the invariant, that VMap is -- kept in an ascending vector.-insert :: U.Unbox a => Char -> a -> VMap a -> VMap a+insert :: Int -> Int -> VMap -> VMap insert x y     = VMap . U.fromList . M.toAscList     . M.insert x y@@ -47,11 +47,11 @@  -- | Smart 'VMap' constructor which ensures that the underlying vector is -- strictly ascending with respect to 'fst' values.-fromList :: U.Unbox a => [(Char, a)] -> VMap a+fromList :: [(Int, Int)] -> VMap fromList = VMap . U.fromList . M.toAscList  . M.fromList  {-# INLINE fromList #-}  -- | Convert the 'VMap' to a list of ascending character/value pairs.-toList :: U.Unbox a => VMap a -> [(Char, a)]+toList :: VMap -> [(Int, Int)] toList = U.toList . unVMap {-# INLINE toList #-}

@@ -1,9 +1,14 @@ name:               dawg-version:            0.5.0+version:            0.6.0 synopsis:           Directed acyclic word graphs description:-    The library implements /directed acyclic word graphs/ (DAWGs), which can-    be also interpreted as /minimal acyclic finite-state automata/.+    The library implements /directed acyclic word graphs/ (DAWGs) internaly+    represented as /minimal acyclic deterministic finite-state automata/.+    .+    The "Data.DAWG" module provides fast insert and delete operations which+    can be used to build the automaton on-the-fly.+    Automaton from the "Data.DAWG.Frozen" module is ,,immutable'', but it+    has lower memory footprint and provides perfect hashing functionality. license:            BSD3 license-file:       LICENSE cabal-version:      >= 1.6@@ -26,7 +31,8 @@      exposed-modules:         Data.DAWG-      , Data.DAWG.Graph+      , Data.DAWG.Frozen+      , Data.DAWG.Internal       , Data.DAWG.VMap      ghc-options: -Wall -O2