packages feed

dawg 0.7.1 → 0.8

raw patch · 15 files changed

+1032/−748 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Data.DAWG: DAWG :: !(Graph (Maybe b)) -> !ID -> DAWG a b
- Data.DAWG: graph :: DAWG a b -> !(Graph (Maybe b))
- Data.DAWG: instance (Ord b, Binary b) => Binary (DAWG a b)
- Data.DAWG: instance Eq b => Eq (DAWG a b)
- Data.DAWG: instance Ord b => Ord (DAWG a b)
- Data.DAWG: instance Show b => Show (DAWG a b)
- Data.DAWG: root :: DAWG a b -> !ID
- Data.DAWG.Internal: Graph :: !(Map (Node a) ID) -> !IntSet -> !(IntMap (Node a)) -> !(IntMap Int) -> Graph a
- Data.DAWG.Internal: data Graph a
- Data.DAWG.Internal: delete :: Ord a => Node a -> Graph a -> Graph a
- Data.DAWG.Internal: empty :: Graph a
- Data.DAWG.Internal: freeIDs :: Graph a -> !IntSet
- Data.DAWG.Internal: idMap :: Graph a -> !(Map (Node a) ID)
- Data.DAWG.Internal: ingoMap :: Graph a -> !(IntMap Int)
- Data.DAWG.Internal: insert :: Ord a => Node a -> Graph a -> (ID, Graph a)
- Data.DAWG.Internal: instance (Ord a, Binary a) => Binary (Graph a)
- Data.DAWG.Internal: instance Eq a => Eq (Graph a)
- Data.DAWG.Internal: instance Ord a => Ord (Graph a)
- Data.DAWG.Internal: instance Show a => Show (Graph a)
- Data.DAWG.Internal: nodeBy :: ID -> Graph a -> Node a
- Data.DAWG.Internal: nodeID :: Ord a => Node a -> Graph a -> ID
- Data.DAWG.Internal: nodeMap :: Graph a -> !(IntMap (Node a))
- Data.DAWG.Internal: size :: Graph a -> Int
- Data.DAWG.Node: Branch :: {-# UNPACK #-} !ID -> !(VMap b) -> Node a b
- Data.DAWG.Node: Leaf :: !a -> Node a b
- Data.DAWG.Node: annotate :: a -> Edge b -> Edge a
- Data.DAWG.Node: data Node a b
- Data.DAWG.Node: edgeMap :: Node a b -> !(VMap b)
- Data.DAWG.Node: edges :: Unbox b => Node a b -> [b]
- Data.DAWG.Node: eps :: Node a b -> {-# UNPACK #-} !ID
- Data.DAWG.Node: instance (Eq a, Eq b, Unbox b) => Eq (Node a b)
- Data.DAWG.Node: instance (Ord a, Ord b, Unbox b) => Ord (Node a b)
- Data.DAWG.Node: instance (Show a, Show b, Unbox b) => Show (Node a b)
- Data.DAWG.Node: instance (Unbox b, Binary a, Binary b) => Binary (Node a b)
- Data.DAWG.Node: label :: Edge a -> a
- Data.DAWG.Node: labeled :: a -> ID -> Edge a
- Data.DAWG.Node: onSym :: Unbox b => Sym -> Node a b -> Maybe b
- Data.DAWG.Node: subst :: Unbox b => Sym -> b -> Node a b -> Node a b
- Data.DAWG.Node: to :: Edge a -> ID
- Data.DAWG.Node: toGeneric :: Node a -> Node a (Edge ())
- Data.DAWG.Node: trans :: Unbox b => Node a b -> [(Sym, b)]
- Data.DAWG.Node: type Edge a = (ID, a)
- Data.DAWG.Node: type ID = Int
- Data.DAWG.Node: type Sym = Int
- Data.DAWG.Node: value :: Node a b -> !a
- Data.DAWG.Node.Specialized: Branch :: {-# UNPACK #-} !ID -> !(VMap ID) -> Node a
- Data.DAWG.Node.Specialized: Leaf :: !a -> Node a
- Data.DAWG.Node.Specialized: data Node a
- Data.DAWG.Node.Specialized: edgeMap :: Node a -> !(VMap ID)
- Data.DAWG.Node.Specialized: edges :: Node a -> [ID]
- Data.DAWG.Node.Specialized: eps :: Node a -> {-# UNPACK #-} !ID
- Data.DAWG.Node.Specialized: instance Binary a => Binary (Node a)
- Data.DAWG.Node.Specialized: instance Eq a => Eq (Node a)
- Data.DAWG.Node.Specialized: instance Ord a => Ord (Node a)
- Data.DAWG.Node.Specialized: instance Show a => Show (Node a)
- Data.DAWG.Node.Specialized: onSym :: Sym -> Node a -> Maybe ID
- Data.DAWG.Node.Specialized: reIdent :: (ID -> ID) -> Node a -> Node a
- Data.DAWG.Node.Specialized: subst :: Sym -> ID -> Node a -> Node a
- Data.DAWG.Node.Specialized: trans :: Node a -> [(Sym, ID)]
- Data.DAWG.Node.Specialized: type ID = Int
- Data.DAWG.Node.Specialized: type Sym = Int
- Data.DAWG.Node.Specialized: value :: Node a -> !a
- Data.DAWG.Static: DAWG :: Vector (Node b c) -> DAWG a b c
- Data.DAWG.Static: instance (Binary b, Binary c, Unbox c) => Binary (DAWG a b c)
- Data.DAWG.Static: instance (Eq b, Eq c, Unbox c) => Eq (DAWG a b c)
- Data.DAWG.Static: instance (Ord b, Ord c, Unbox c) => Ord (DAWG a b c)
- Data.DAWG.Static: instance (Show b, Show c, Unbox c) => Show (DAWG a b c)
- Data.DAWG.Static: newtype DAWG a b c
- Data.DAWG.Static: unDAWG :: DAWG a b c -> Vector (Node b c)
- Data.DAWG.VMap: data VMap a
- Data.DAWG.VMap: empty :: Unbox a => VMap a
- Data.DAWG.VMap: findLastLE :: Unbox a => (a -> Ordering) -> VMap a -> Maybe (Int, a)
- Data.DAWG.VMap: fromList :: Unbox a => [(Int, a)] -> VMap a
- Data.DAWG.VMap: insert :: Unbox a => Int -> a -> VMap a -> VMap a
- Data.DAWG.VMap: instance (Binary a, Unbox a) => Binary (VMap a)
- Data.DAWG.VMap: instance (Eq a, Unbox a) => Eq (VMap a)
- Data.DAWG.VMap: instance (Ord a, Unbox a) => Ord (VMap a)
- Data.DAWG.VMap: instance (Show a, Unbox a) => Show (VMap a)
- Data.DAWG.VMap: lookup :: Unbox a => Int -> VMap a -> Maybe a
- Data.DAWG.VMap: toList :: Unbox a => VMap a -> [(Int, a)]
+ Data.DAWG: class (Ord (Node t a), Trans t) => MkNode t a
+ Data.DAWG.Static: data DAWG t a b c
+ Data.DAWG.Static: instance (Binary t, Binary b, Binary c, Unbox b) => Binary (DAWG t a b c)
+ Data.DAWG.Static: instance (Eq b, Eq c, Unbox b) => Eq (DAWG Trans a b c)
+ Data.DAWG.Static: instance (Ord b, Ord c, Unbox b) => Ord (DAWG Trans a b c)
+ Data.DAWG.Static: instance (Show t, Show b, Show c, Unbox b) => Show (DAWG t a b c)
+ Data.DAWG.Trans: byIndex :: Trans t => Int -> t -> Maybe (Sym, ID)
+ Data.DAWG.Trans: class Trans t
+ Data.DAWG.Trans: empty :: Trans t => t
+ Data.DAWG.Trans: fromList :: Trans t => [(Sym, ID)] -> t
+ Data.DAWG.Trans: index :: Trans t => Sym -> t -> Maybe Int
+ Data.DAWG.Trans: insert :: Trans t => Sym -> ID -> t -> t
+ Data.DAWG.Trans: lookup :: Trans t => Sym -> t -> Maybe ID
+ Data.DAWG.Trans: toList :: Trans t => t -> [(Sym, ID)]
+ Data.DAWG.Trans.Map: data Trans
+ Data.DAWG.Trans.Map: instance Binary Trans
+ Data.DAWG.Trans.Map: instance Eq Trans
+ Data.DAWG.Trans.Map: instance Ord Trans
+ Data.DAWG.Trans.Map: instance Show Trans
+ Data.DAWG.Trans.Map: instance Trans Trans
+ Data.DAWG.Trans.Vector: data Trans
+ Data.DAWG.Trans.Vector: instance Binary Trans
+ Data.DAWG.Trans.Vector: instance Eq Trans
+ Data.DAWG.Trans.Vector: instance Ord Trans
+ Data.DAWG.Trans.Vector: instance Show Trans
+ Data.DAWG.Trans.Vector: instance Trans Trans
+ Data.DAWG.Types: type ID = Int
+ Data.DAWG.Types: type Sym = Int
- Data.DAWG: assocs :: Enum a => DAWG a b -> [([a], b)]
+ Data.DAWG: assocs :: (Enum a, MkNode t b) => DAWG t a b -> [([a], b)]
- Data.DAWG: data DAWG a b
+ Data.DAWG: data DAWG t a b
- Data.DAWG: delete :: (Enum a, Ord b) => [a] -> DAWG a b -> DAWG a b
+ Data.DAWG: delete :: (Enum a, MkNode t b) => [a] -> DAWG t a b -> DAWG t a b
- Data.DAWG: elems :: DAWG a b -> [b]
+ Data.DAWG: elems :: MkNode t b => DAWG t a b -> [b]
- Data.DAWG: empty :: Ord b => DAWG a b
+ Data.DAWG: empty :: MkNode t b => DAWG t a b
- Data.DAWG: fromLang :: Enum a => [[a]] -> DAWG a ()
+ Data.DAWG: fromLang :: (Enum a, MkNode t ()) => [[a]] -> DAWG t a ()
- Data.DAWG: fromList :: (Enum a, Ord b) => [([a], b)] -> DAWG a b
+ Data.DAWG: fromList :: (Enum a, MkNode t b) => [([a], b)] -> DAWG t a b
- Data.DAWG: fromListWith :: (Enum a, Ord b) => (b -> b -> b) -> [([a], b)] -> DAWG a b
+ Data.DAWG: fromListWith :: (Enum a, MkNode t b) => (b -> b -> b) -> [([a], b)] -> DAWG t a b
- Data.DAWG: insert :: (Enum a, Ord b) => [a] -> b -> DAWG a b -> DAWG a b
+ Data.DAWG: insert :: (Enum a, MkNode t b) => [a] -> b -> DAWG t a b -> DAWG t a b
- Data.DAWG: insertWith :: (Enum a, Ord b) => (b -> b -> b) -> [a] -> b -> DAWG a b -> DAWG a b
+ Data.DAWG: insertWith :: (Enum a, MkNode t b) => (b -> b -> b) -> [a] -> b -> DAWG t a b -> DAWG t a b
- Data.DAWG: keys :: Enum a => DAWG a b -> [[a]]
+ Data.DAWG: keys :: (Enum a, MkNode t b) => DAWG t a b -> [[a]]
- Data.DAWG: lookup :: Enum a => [a] -> DAWG a b -> Maybe b
+ Data.DAWG: lookup :: (Enum a, MkNode t b) => [a] -> DAWG t a b -> Maybe b
- Data.DAWG: numStates :: DAWG a b -> Int
+ Data.DAWG: numStates :: DAWG t a b -> Int
- Data.DAWG.Static: assocs :: (Enum a, Unbox c) => DAWG a b c -> [([a], b)]
+ Data.DAWG.Static: assocs :: (Enum a, Trans t, Unbox b) => DAWG t a b c -> [([a], c)]
- Data.DAWG.Static: byIndex :: Enum a => Int -> DAWG a b Weight -> Maybe [a]
+ Data.DAWG.Static: byIndex :: (Enum a, Trans t) => Int -> DAWG t a Weight c -> Maybe [a]
- Data.DAWG.Static: elems :: Unbox c => DAWG a b c -> [b]
+ Data.DAWG.Static: elems :: (Trans t, Unbox b) => DAWG t a b c -> [c]
- Data.DAWG.Static: empty :: Unbox c => DAWG a b c
+ Data.DAWG.Static: empty :: (Trans t, Unbox b) => DAWG t a b c
- Data.DAWG.Static: freeze :: DAWG a b -> DAWG a b ()
+ Data.DAWG.Static: freeze :: Trans t => DAWG t a b -> DAWG t a () b
- Data.DAWG.Static: fromLang :: Enum a => [[a]] -> DAWG a () ()
+ Data.DAWG.Static: fromLang :: (Enum a, MkNode t ()) => [[a]] -> DAWG t a () ()
- Data.DAWG.Static: fromList :: (Enum a, Ord b) => [([a], b)] -> DAWG a b ()
+ Data.DAWG.Static: fromList :: (Enum a, MkNode t b) => [([a], b)] -> DAWG t a () b
- Data.DAWG.Static: fromListWith :: (Enum a, Ord b) => (b -> b -> b) -> [([a], b)] -> DAWG a b ()
+ Data.DAWG.Static: fromListWith :: (Enum a, MkNode t b) => (b -> b -> b) -> [([a], b)] -> DAWG t a () b
- Data.DAWG.Static: hash :: Enum a => [a] -> DAWG a b Weight -> Maybe Int
+ Data.DAWG.Static: hash :: (Enum a, Trans t) => [a] -> DAWG t a Weight c -> Maybe Int
- Data.DAWG.Static: index :: Enum a => [a] -> DAWG a b Weight -> Maybe Int
+ Data.DAWG.Static: index :: (Enum a, Trans t) => [a] -> DAWG t a Weight c -> Maybe Int
- Data.DAWG.Static: keys :: (Unbox c, Enum a) => DAWG a b c -> [[a]]
+ Data.DAWG.Static: keys :: (Enum a, Trans t, Unbox b) => DAWG t a b c -> [[a]]
- Data.DAWG.Static: lookup :: (Unbox c, Enum a) => [a] -> DAWG a b c -> Maybe b
+ Data.DAWG.Static: lookup :: (Enum a, Trans t, Unbox b) => [a] -> DAWG t a b c -> Maybe c
- Data.DAWG.Static: numStates :: DAWG a b c -> Int
+ Data.DAWG.Static: numStates :: DAWG t a b c -> Int
- Data.DAWG.Static: unHash :: Enum a => Int -> DAWG a b Weight -> Maybe [a]
+ Data.DAWG.Static: unHash :: (Enum a, Trans t) => Int -> DAWG t a Weight c -> Maybe [a]
- Data.DAWG.Static: weigh :: Unbox c => DAWG a b c -> DAWG a b Weight
+ Data.DAWG.Static: weigh :: Trans t => DAWG t a b c -> DAWG t a Weight c

Files

Data/DAWG.hs view
@@ -2,11 +2,22 @@ -- 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 (..)+  DAWG+, MkNode -- * Query , numStates , lookup@@ -27,219 +38,4 @@ ) where  import Prelude hiding (lookup)-import Control.Applicative ((<$>), (<*>))-import Control.Arrow (first)-import Data.List (foldl')-import Data.Binary (Binary, put, get)-import qualified Control.Monad.State.Strict as S--import Data.DAWG.Internal (Graph)-import qualified Data.DAWG.Internal as I-import qualified Data.DAWG.VMap as V--import Data.DAWG.Node.Specialized hiding (Node)-import qualified Data.DAWG.Node.Specialized as N--type Node a = N.Node (Maybe a)--type GraphM a b = S.State (Graph (Maybe 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 :: Ord a => GraphM a ID -insertLeaf = do-    i <- insertNode (N.Leaf Nothing)-    insertNode (N.Branch i V.empty)---- | Return node with the given identifier.-nodeBy :: ID -> GraphM a (Node a)-nodeBy i = I.nodeBy i <$> S.get---- Evaluate the 'I.insert' function within the monad.-insertNode :: Ord a => Node a -> GraphM a ID-insertNode = S.state . I.insert---- Evaluate the 'I.delete' function within the monad.-deleteNode :: Ord a => Node a -> GraphM a ()-deleteNode = S.state . mkState . I.delete---- | Invariant: the identifier points to the 'Branch' node.-insertM :: Ord a => [Int] -> a -> ID -> GraphM a ID-insertM (x:xs) y i = do-    n <- nodeBy i-    j <- case onSym x n of-        Just j  -> return j-        Nothing -> insertLeaf-    k <- insertM xs y j-    deleteNode n-    insertNode (subst 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) -> [Int] -> a -> ID -> GraphM a ID-insertWithM f (x:xs) y i = do-    n <- nodeBy i-    j <- case onSym x n of-        Just j  -> return j-        Nothing -> insertLeaf-    k <- insertWithM f xs y j-    deleteNode n-    insertNode (subst 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 => [Int] -> ID -> GraphM a ID-deleteM (x:xs) i = do-    n <- nodeBy i-    case onSym x n of-        Nothing -> return i-        Just j  -> do-            k <- deleteM xs j-            deleteNode n-            insertNode (subst 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 :: [Int] -> 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 onSym x n of-        Just j  -> lookupM xs j-        Nothing -> return Nothing--assocsAcc :: Graph (Maybe a) -> ID -> [([Int], a)]-assocsAcc g i =-    here w ++ concatMap there (trans n)-  where-    n = I.nodeBy i g-    w = I.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 '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 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 b => DAWG a b-empty = -    let (i, g) = S.runState insertLeaf I.empty-    in  DAWG g i---- | Number of states in the underlying graph.-numStates :: DAWG a b -> Int-numStates = I.size . 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 => [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 :: 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 . (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 () #-}+import Data.DAWG.Internal
+ Data/DAWG/Graph.hs view
@@ -0,0 +1,208 @@+{-# 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 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)
+ Data/DAWG/HashMap.hs view
@@ -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
Data/DAWG/Internal.hs view
@@ -1,207 +1,269 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE DoAndIfThenElse #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} --- | 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.+-- | 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-( Graph (..)+(+-- * DAWG type+  DAWG (..)+, MkNode+-- * Query+, numStates+, lookup+-- * Construction , empty-, size-, nodeBy-, nodeID+, fromList+, fromListWith+, fromLang+-- ** Insertion , insert+, insertWith+-- ** Deletion , delete+-- * Conversion+, assocs+, keys+, elems ) where +import Prelude hiding (lookup) import Control.Applicative ((<$>), (<*>))--- import Data.List (foldl')+import Control.Arrow (first)+import Data.List (foldl') import Data.Binary (Binary, put, get)-import qualified Data.Map as M--- import qualified Data.Tree as T-import qualified Data.IntSet as IS-import qualified Data.IntMap as IM--- import qualified Control.Monad.State.Strict as S+import qualified Data.Vector.Unboxed as U+import qualified Control.Monad.State.Strict as S -import Data.DAWG.Node.Specialized hiding (Node)-import qualified Data.DAWG.Node.Specialized as N+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 a = N.Node a+type Node t a = N.Node t () a --- | 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)+-- | 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 -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+type GraphM t a b = S.State (Graph (Node t a)) b --- | Empty graph.-empty :: Graph a-empty = Graph M.empty IS.empty IM.empty IM.empty+mkState :: (Graph a -> Graph a) -> Graph a -> ((), Graph a)+mkState f g = ((), f g) --- | Size of the graph (number of nodes).-size :: Graph a -> Int-size = M.size . idMap+-- | 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) --- | Node with the given identifier.-nodeBy :: ID -> Graph a -> Node a-nodeBy i g = nodeMap g IM.! i+-- | Return node with the given identifier.+nodeBy :: ID -> GraphM t a (Node t a)+nodeBy i = G.nodeBy i <$> S.get --- | Retrieve the node identifier.-nodeID :: Ord a => Node a -> Graph a -> ID-nodeID n g = idMap g M.! n+-- Evaluate the 'G.insert' function within the monad.+insertNode :: MkNode t a => Node t a -> GraphM t a ID+insertNode = S.state . G.insert --- | 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+-- Evaluate the 'G.delete' function within the monad.+deleteNode :: MkNode t a => Node t a -> GraphM t a ()+deleteNode = S.state . mkState . G.delete --- | Remove node from the graph.-remNode :: Ord a => ID -> Graph a -> Graph a-remNode i Graph{..} =-    Graph idMap' freeIDs' nodeMap' ingoMap'+-- | 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-    idMap'      = M.delete  n idMap-    nodeMap'    = IM.delete i nodeMap-    ingoMap'    = IM.delete i ingoMap-    freeIDs'    = IS.insert i freeIDs-    n           = nodeMap IM.! i+    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) --- | Increment the number of ingoing paths.-incIngo :: ID -> Graph a -> Graph a-incIngo i g = g { ingoMap = IM.insertWith' (+) i 1 (ingoMap g) }+-- | 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) --- | 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) })+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 --- | 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+-- | Empty DAWG.+empty :: (MkNode t b) => DAWG t a b+empty = +    let (i, g) = S.runState insertLeaf G.empty+    in  DAWG g i --- | 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+-- | Number of states in the underlying graph.+numStates :: DAWG t a b -> Int+numStates = G.size . graph --- -- | 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)+-- | 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 () #-}
Data/DAWG/Node.hs view
@@ -1,63 +1,35 @@ {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE StandaloneDeriving #-}  -- | Internal representation of automata nodes.  module Data.DAWG.Node-(--- * Basic types-  ID-, Sym--- * Node-, Node (..)+( Node (..) , onSym-, trans+, onSym' , edges-, subst-, toGeneric--- * Edge-, Edge-, to-, label-, annotate-, labeled+, children+, insert+, reID ) where  import Control.Applicative ((<$>), (<*>)) import Control.Arrow (second) import Data.Binary (Binary, Get, put, get)-import Data.Vector.Unboxed (Unbox)--import qualified Data.DAWG.VMap as M-import qualified Data.DAWG.Node.Specialized as N---- | Node identifier.-type ID = Int---- | Internal representation of the transition symbol.-type Sym = Int---- | Edge with label.-type Edge a = (ID, a)---- | Destination ID.-to :: Edge a -> ID-to = fst-{-# INLINE to #-}---- | Edge label.-label :: Edge a -> a-label = snd-{-# INLINE label #-}---- | Annotate edge wit a new label.-annotate :: a -> Edge b -> Edge a-annotate x (i, _) = (i, x)-{-# INLINE annotate #-}+import Data.Vector.Binary ()+import qualified Data.Vector.Unboxed as U --- | Construct edge annotated with a given label.-labeled :: a -> ID -> Edge a-labeled x i = (i, x)-{-# INLINE labeled #-}+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)@@ -71,50 +43,72 @@ -- -- 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 +data Node t a b     = Branch {         -- | Epsilon transition.           eps       :: {-# UNPACK #-} !ID-        -- | Labeled edges outgoing from the node.-        , edgeMap   :: !(M.VMap b) }-    | Leaf { value  :: !a }-    deriving (Show, Eq, Ord)+        -- | Transition map (outgoing edges).+        , transMap  :: !(H.Hashed t)+        -- | Labels corresponding to individual edges.+        , labelVect :: !(U.Vector a) }+    | Leaf { value  :: !(Maybe b) }+    deriving (Show) -instance (Unbox b, Binary a, Binary b) => Binary (Node a b) where-    put Branch{..} = put (1 :: Int) >> put eps >> put edgeMap+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+            1 -> Branch <$> get <*> get <*> get             _ -> Leaf <$> get  -- | Transition function.-onSym :: Unbox b => Sym -> Node a b -> Maybe b-onSym x (Branch _ es)   = M.lookup x es+onSym :: Trans t => Sym -> Node t a b -> Maybe ID+onSym x (Branch _ t _)  = T.lookup x t onSym _ (Leaf _)        = Nothing {-# INLINE onSym #-} --- | List of symbol/edge pairs outgoing from the node.-trans :: Unbox b => Node a b -> [(Sym, b)]-trans (Branch _ es)     = M.toList es-trans (Leaf _)          = []-{-# INLINE trans #-}+-- | 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 outgoing edges.-edges :: Unbox b => Node a b -> [b]-edges = map snd . trans+-- | 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.-subst :: Unbox b => Sym -> b -> Node a b -> Node a b-subst x e (Branch w es) = Branch w (M.insert x e es)-subst _ _ l             = l-{-# INLINE subst #-}+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 #-} --- | Yield generic version of a specialized node.-toGeneric :: N.Node a -> Node a (Edge ())-toGeneric N.Leaf{..}    = Leaf value-toGeneric N.Branch{..}  = Branch eps (annEdges edgeMap) where-    annEdges = M.fromList . map annEdge . M.toList-    annEdge = second (labeled ())+-- | 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
− Data/DAWG/Node/Specialized.hs
@@ -1,90 +0,0 @@-{-# LANGUAGE RecordWildCards #-}---- | Internal representation of automata nodes specialized to--- a version with unlabeled edges.--module Data.DAWG.Node.Specialized-(--- * Basic types-  ID-, Sym--- * Node-, Node (..)-, onSym-, trans-, edges-, subst-, reIdent-) where--import Control.Applicative ((<$>), (<*>))-import Control.Arrow (second)-import Data.Binary (Binary, Get, put, get)--import qualified Data.DAWG.VMap as M---- | Node identifier.-type ID = Int---- | Internal representation of the transition symbol.-type Sym = 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 '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-        -- | Labeled edges outgoing from the node.-        , edgeMap   :: !(M.VMap ID) }-    | Leaf { value  :: !a }-    deriving (Show, Eq, Ord)--instance (Binary a) => Binary (Node a) where-    put Branch{..} = put (1 :: Int) >> put eps >> put edgeMap-    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 _ es)   = M.lookup x es-onSym _ (Leaf _)        = Nothing-{-# INLINE onSym #-}---- | List of symbol/edge pairs outgoing from the node.-trans :: Node a -> [(Sym, ID)]-trans (Branch _ es)     = M.toList es-trans (Leaf _)          = []-{-# INLINE trans #-}---- | List of outgoing edges.-edges :: Node a -> [ID]-edges = map snd . trans-{-# INLINE edges #-}---- | Substitue edge determined by a given symbol.-subst :: Sym -> ID -> Node a -> Node a-subst x e (Branch w es) = Branch w (M.insert x e es)-subst _ _ l             = l-{-# INLINE subst #-}---- | Assign new identifiers.-reIdent :: (ID -> ID) -> Node a -> Node a-reIdent _ (Leaf x)      = Leaf x-reIdent f (Branch e es) =-    let reEdges = M.fromList . map (second f) . M.toList-    in  Branch (f e) (reEdges es)
Data/DAWG/Static.hs view
@@ -1,5 +1,9 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}  -- | The module implements /directed acyclic word graphs/ (DAWGs) internaly -- represented as /minimal acyclic deterministic finite-state automata/.@@ -12,11 +16,21 @@ --     '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 (..)+  DAWG -- * Query , lookup , numStates@@ -45,104 +59,126 @@ import Prelude hiding (lookup) import Control.Applicative ((<$), (<$>), (<|>)) import Control.Arrow (first)-import Data.Binary (Binary)+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.Node hiding (Node)+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.Node.Specialized as NS-import qualified Data.DAWG.VMap as VM-import qualified Data.DAWG.Internal as I-import qualified Data.DAWG as D+import qualified Data.DAWG.Graph as G+import qualified Data.DAWG.Internal as D+import qualified Data.DAWG.Util as Util -type Node a b = N.Node (Maybe a) (Edge b)+-- | @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) --- | @DAWG a b c@ constitutes an automaton with alphabet symbols of type /a/,--- node values of type /Maybe b/ and additional transition labels of type /c/.--- Root is stored on the first position of the array.-newtype DAWG a b c = DAWG { unDAWG :: V.Vector (Node b c) }-    deriving (Show, Eq, Ord, Binary)+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 :: Unbox c => DAWG a b c+empty :: (Trans t, Unbox b) => DAWG t a b c empty = DAWG $ V.fromList-    [ Branch 1 VM.empty-    , Leaf Nothing ]+    [ N.Branch 1 T.empty U.empty+    , N.Leaf Nothing ]  -- | Number of states in the automaton.-numStates :: DAWG a b c -> Int+numStates :: DAWG t a b c -> Int numStates = V.length . unDAWG  -- | Node with the given identifier.-nodeBy :: ID -> DAWG a b c -> Node b c+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 b c -> DAWG a b c -> Maybe b-leafValue n = value . nodeBy (eps n)+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 :: (Unbox c, Enum a) => [a] -> DAWG a b c -> Maybe b+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 :: Unbox c => String -> DAWG Char b c -> Maybe b #-}+{-# SPECIALIZE lookup+        :: (Trans t, Unbox b) => String+        -> DAWG t Char b c -> Maybe c #-} -lookup'I :: Unbox c => [Sym] -> ID -> DAWG a b c -> Maybe b+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 onSym x (nodeBy i d) of-    Just e  -> lookup'I xs (to e) 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 c) => DAWG a b c -> [([a], b)]+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 :: Unbox c => DAWG Char b c -> [(String, b)] #-}+{-# SPECIALIZE assocs+        :: (Trans t, Unbox b)+        => DAWG t Char b c -> [(String, c)] #-} -assocs'I :: Unbox c => ID -> DAWG a b c -> [([Sym], b)]+assocs'I :: (Trans t, Unbox b) => ID -> DAWG t a b c -> [([Sym], c)] assocs'I i d =-    here ++ concatMap there (trans n)+    here ++ concatMap there (N.edges n)   where     n = nodeBy i d     here = case leafValue n d of         Just x  -> [([], x)]         Nothing -> []-    there (x, e) = map (first (x:)) (assocs'I (to e) d)+    there (x, j) = map (first (x:)) (assocs'I j d)  -- | Return all keys of the DAWG in ascending order.-keys :: (Unbox c, Enum a) => DAWG a b c -> [[a]]+keys :: (Enum a, Trans t, Unbox b) => DAWG t a b c -> [[a]] keys = map fst . assocs-{-# SPECIALIZE keys :: Unbox c => DAWG Char b c -> [String] #-}+{-# 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 :: Unbox c => DAWG a b c -> [b]+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, Ord b) => [([a], b)] -> DAWG a b ()+fromList+    :: (Enum a, D.MkNode t b)+    => [([a], b)] -> DAWG t a () b fromList = freeze . D.fromList-{-# SPECIALIZE fromList :: Ord b => [(String, b)] -> DAWG Char b () #-}+{-# 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, Ord b) => (b -> b -> b) -> [([a], b)] -> DAWG a b ()+fromListWith+    :: (Enum a, D.MkNode t b)+    => (b -> b -> b) -> [([a], b)] -> DAWG t a () b fromListWith f = freeze . D.fromListWith f-{-# SPECIALIZE fromListWith :: Ord b => (b -> b -> b)-        -> [(String, b)] -> DAWG Char b () #-}+{-# 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 => [[a]] -> DAWG a () ()+fromLang +    :: (Enum a, D.MkNode t ())+    => [[a]] -> DAWG t a () () fromLang = freeze . D.fromLang-{-# SPECIALIZE fromLang :: [String] -> DAWG Char () () #-}+{-# 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@@ -150,46 +186,40 @@ type Weight = Int  -- | Compute node weights and store corresponding values in transition labels.-weigh :: Unbox c => DAWG a b c -> DAWG a b Weight+weigh :: Trans t => DAWG t a b c -> DAWG t a Weight c weigh d = (DAWG . V.fromList)-    [ branch n (apply ws (trans n))+    [ branch n ws     | i <- [0 .. numStates d - 1]     , let n  = nodeBy i d-    , let ws = accum (children n) ]+    , let ws = accum (N.children n) ]   where-    -- Branch with new edges.-    branch Branch{..} es    = Branch eps es-    branch Leaf{..}   _     = Leaf value+    -- 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-        Leaf w  -> maybe 0 (const 1) w-        n       -> sum . map nodeWeight $ allChildren n-    -- Weight for subsequent edges.-    accum = init . scanl (+) 0 . map nodeWeight-    -- Apply weight to edges. -    apply ws ts = VM.fromList-        [ (x, annotate w e)-        | (w, (x, e)) <- zip ws ts ]+        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 = eps n : children n-    -- IDs of plain children.-    children = map to . edges+    allChildren n = N.eps n : N.children n  -- | Construct immutable version of the automaton.-freeze :: D.DAWG a b -> DAWG a b ()+freeze :: Trans t => D.DAWG t a b -> DAWG t a () b freeze d = DAWG . V.fromList $-    map (N.toGeneric . NS.reIdent newID . oldBy)+    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 . I.nodeMap . D.graph+    nodeIDs = filter (/= D.root d) . map fst . M.assocs . G.nodeMap . D.graph     -- Non-frozen node by given identifier.-    oldBy i = I.nodeBy i (D.graph d)+    oldBy i = G.nodeBy i (D.graph d)          -- | Inverse of the map. inverse :: M.IntMap Int -> M.IntMap Int@@ -198,7 +228,7 @@     in  M.fromList . map swap . M.toList  -- -- | Yield mutable version of the automaton.--- thaw :: (Unbox c, Ord a) => DAWG a b c -> D.DAWG a b+-- thaw :: (Unbox b, Ord a) => DAWG a b c -> D.DAWG a b -- thaw d = --     D.fromNodes nodes 0 --   where@@ -222,48 +252,51 @@  -- | Position in a set of all dictionary entries with respect -- to the lexicographic order.-index :: Enum a => [a] -> DAWG a b Weight -> Maybe Int+index :: (Enum a, Trans t) => [a] -> DAWG t a Weight c -> Maybe Int index xs = index'I (map fromEnum xs) 0-{-# SPECIALIZE index :: String -> DAWG Char b Weight -> Maybe Int #-}+{-# SPECIALIZE index+        :: Trans t => String -> DAWG t Char Weight c -> Maybe Int #-} -index'I :: [Sym] -> ID -> DAWG a b Weight -> 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-        v = maybe 0 (const 1) (leafValue n d)-    e <- onSym x n-    w <- index'I xs (to e) d-    return (v + w + label e)+        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 b Weight -> Maybe Int+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 => Int -> DAWG a b Weight -> Maybe [a]+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 :: Int -> DAWG Char b Weight -> Maybe String #-}+{-# SPECIALIZE byIndex+        :: Trans t => Int -> DAWG t Char Weight c -> Maybe String #-} -byIndex'I :: Int -> ID -> DAWG a b Weight -> Maybe [Sym]+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-    v = maybe 0 (const 1) (leafValue n d)+    u = maybe 0 (const 1) (leafValue n d)     here         | ix == 0   = [] <$ leafValue (nodeBy i d) d         | otherwise = Nothing     there = do-        (x, e) <- VM.findLastLE cmp (edgeMap n)-        xs <- byIndex'I (ix - v - label e) (to e) d+        (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 e = compare (label e) (ix - v)+    cmp w = compare w (ix - u)  -- | Inverse of the 'hash' function and a synonym for the 'byIndex' function.-unHash :: Enum a => Int -> DAWG a b Weight -> Maybe [a]+unHash :: (Enum a, Trans t) => Int -> DAWG t a Weight c -> Maybe [a] unHash = byIndex {-# INLINE unHash #-}
+ Data/DAWG/Trans.hs view
@@ -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)]
+ Data/DAWG/Trans/Hashed.hs view
@@ -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)
+ Data/DAWG/Trans/Map.hs view
@@ -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 #-}
+ Data/DAWG/Trans/Vector.hs view
@@ -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 #-}
+ Data/DAWG/Types.hs view
@@ -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
+ Data/DAWG/Util.hs view
@@ -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 #-}
− Data/DAWG/VMap.hs
@@ -1,101 +0,0 @@-{-# LANGUAGE BangPatterns #-}---- | A vector representation of 'M.Map'.--module Data.DAWG.VMap-( VMap (unVMap)-, empty-, lookup-, insert-, findLastLE-, fromList-, toList-) where--import Prelude hiding (lookup)-import Control.Applicative ((<$>))-import Data.Bits (shiftR)-import Data.Binary (Binary, put, get)-import Data.Vector.Binary ()-import Data.Vector.Unboxed (Unbox)-import qualified Control.Monad.ST as ST-import qualified Data.Map as M-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Unboxed.Mutable as UM---- | A strictly ascending vector of distinct elements with respect--- to 'fst' values.-newtype VMap a = VMap { unVMap :: U.Vector (Int, a) }-    deriving (Show, Eq, Ord)--instance (Binary a, Unbox a) => Binary (VMap a) where-    put v = put (unVMap v)-    get = VMap <$> get---- | Empty map.-empty :: Unbox a => VMap a-empty = VMap U.empty-{-# INLINE empty #-}---- | Lookup the symbol in the map.-lookup :: Unbox a => Int -> VMap a -> Maybe a-lookup x (VMap v) =-    case binarySearch (flip compare x . fst) v of-        Left k  -> snd <$> v U.!? k-        Right _ -> Nothing-{-# INLINE lookup #-}---- | Insert the symbol/value pair into the map.-insert :: Unbox a => Int -> a -> VMap a -> VMap a-insert x y (VMap v) = VMap $-    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 #-}---- | 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) -> VMap a -> Maybe (Int, a)-findLastLE cmp (VMap v) =-    let k = binarySearch (cmp . snd) v-    in  v U.!? either id (\x -> x-1) k-{-# INLINE findLastLE #-}---- | 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 #-}---- | Smart 'VMap' constructor which ensures that the underlying vector is--- strictly ascending with respect to 'fst' values.-fromList :: Unbox a => [(Int, a)] -> VMap a-fromList = VMap . U.fromList . M.toAscList . M.fromList-{-# INLINE fromList #-}---- | Convert the 'VMap' to a list of ascending symbol/value pairs.-toList :: Unbox a => VMap a -> [(Int, a)]-toList = U.toList . unVMap-{-# INLINE toList #-}
dawg.cabal view
@@ -1,5 +1,5 @@ name:               dawg-version:            0.7.1+version:            0.8 synopsis:           Directed acyclic word graphs description:     The library implements /directed acyclic word graphs/ (DAWGs) internaly@@ -9,6 +9,8 @@     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.+    Both automata versions work in combination with different implementations+    of transition maps provided by the "Data.DAWG.Trans" modules' hierarchy. license:            BSD3 license-file:       LICENSE cabal-version:      >= 1.6@@ -31,13 +33,21 @@      exposed-modules:         Data.DAWG-      , Data.DAWG.Node-      , Data.DAWG.Node.Specialized+      , Data.DAWG.Types       , Data.DAWG.Static+      , Data.DAWG.Trans+      , Data.DAWG.Trans.Vector+      , Data.DAWG.Trans.Map++    other-modules:+        Data.DAWG.Node+      , Data.DAWG.Graph       , Data.DAWG.Internal-      , Data.DAWG.VMap+      , Data.DAWG.Util+      , Data.DAWG.HashMap+      , Data.DAWG.Trans.Hashed -    ghc-options: -Wall -O2+    ghc-options: -Wall -O2 -auto  source-repository head     type: git