packages feed

dawg 0.6.0 → 0.7.0

raw patch · 5 files changed

+389/−285 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Data.DAWG.Frozen: assocs :: Enum a => DAWG a b -> [([a], b)]
- Data.DAWG.Frozen: byIndex :: Enum a => Int -> DAWG a b -> Maybe [a]
- Data.DAWG.Frozen: elems :: DAWG a b -> [b]
- Data.DAWG.Frozen: empty :: DAWG a b
- Data.DAWG.Frozen: freeze :: DAWG a b -> DAWG a b
- Data.DAWG.Frozen: fromLang :: Enum a => [[a]] -> DAWG a ()
- Data.DAWG.Frozen: fromList :: (Enum a, Ord b) => [([a], b)] -> DAWG a b
- Data.DAWG.Frozen: fromListWith :: (Enum a, Ord b) => (b -> b -> b) -> [([a], b)] -> DAWG a b
- Data.DAWG.Frozen: hash :: Enum a => [a] -> DAWG a b -> Maybe Int
- Data.DAWG.Frozen: index :: Enum a => [a] -> DAWG a b -> Maybe Int
- Data.DAWG.Frozen: instance Binary a => Binary (Node a)
- Data.DAWG.Frozen: instance Eq a => Eq (Node a)
- Data.DAWG.Frozen: instance Ord a => Ord (Node a)
- Data.DAWG.Frozen: instance Show a => Show (Node a)
- Data.DAWG.Frozen: keys :: Enum a => DAWG a b -> [[a]]
- Data.DAWG.Frozen: lookup :: Enum a => [a] -> DAWG a b -> Maybe b
- Data.DAWG.Frozen: numStates :: DAWG a b -> Int
- Data.DAWG.Frozen: type DAWG a b = Vector (Node (Maybe b))
- Data.DAWG.Frozen: unHash :: Enum a => Int -> DAWG a b -> Maybe [a]
- Data.DAWG.VMap: instance Binary VMap
- Data.DAWG.VMap: instance Eq VMap
- Data.DAWG.VMap: instance Ord VMap
- Data.DAWG.VMap: instance Show VMap
+ Data.DAWG.Static: DAWG :: Vector (Node (Maybe b) c) -> DAWG a b c
+ Data.DAWG.Static: assocs :: (Enum a, Unbox c) => DAWG a b c -> [([a], b)]
+ Data.DAWG.Static: byIndex :: Enum a => Int -> DAWG a b Weight -> Maybe [a]
+ Data.DAWG.Static: elems :: Unbox c => DAWG a b c -> [b]
+ Data.DAWG.Static: empty :: Unbox c => DAWG a b c
+ Data.DAWG.Static: freeze :: DAWG a b -> DAWG a b ()
+ Data.DAWG.Static: fromLang :: Enum a => [[a]] -> DAWG a () ()
+ Data.DAWG.Static: fromList :: (Enum a, Ord b) => [([a], b)] -> DAWG a b ()
+ Data.DAWG.Static: fromListWith :: (Enum a, Ord b) => (b -> b -> b) -> [([a], b)] -> DAWG a b ()
+ Data.DAWG.Static: hash :: Enum a => [a] -> DAWG a b Weight -> Maybe Int
+ Data.DAWG.Static: index :: Enum a => [a] -> DAWG a b Weight -> Maybe Int
+ Data.DAWG.Static: instance (Eq a, Eq b, Unbox b) => Eq (Node a b)
+ Data.DAWG.Static: instance (Ord a, Ord b, Unbox b) => Ord (Node a b)
+ Data.DAWG.Static: instance (Show a, Show b, Unbox b) => Show (Node a b)
+ Data.DAWG.Static: instance (Unbox b, Binary a, Binary b) => Binary (Node a b)
+ Data.DAWG.Static: keys :: (Unbox c, Enum a) => DAWG a b c -> [[a]]
+ Data.DAWG.Static: lookup :: (Unbox c, Enum a) => [a] -> DAWG a b c -> Maybe b
+ Data.DAWG.Static: newtype DAWG a b c
+ Data.DAWG.Static: numStates :: DAWG a b c -> Int
+ Data.DAWG.Static: type Weight = Int
+ Data.DAWG.Static: unDAWG :: DAWG a b c -> Vector (Node (Maybe b) c)
+ Data.DAWG.Static: unHash :: Enum a => Int -> DAWG a b Weight -> Maybe [a]
+ Data.DAWG.Static: weigh :: Unbox c => DAWG a b c -> DAWG a b Weight
+ Data.DAWG.VMap: findLastLE :: Unbox a => (a -> Ordering) -> VMap a -> Maybe (Int, 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.Internal: Branch :: {-# UNPACK #-} !Id -> !VMap -> Node a
+ Data.DAWG.Internal: Branch :: {-# UNPACK #-} !Id -> !(VMap Id) -> Node a
- Data.DAWG.Internal: edgeMap :: Node a -> !VMap
+ Data.DAWG.Internal: edgeMap :: Node a -> !(VMap Id)
- Data.DAWG.VMap: data VMap
+ Data.DAWG.VMap: data VMap a
- Data.DAWG.VMap: empty :: VMap
+ Data.DAWG.VMap: empty :: Unbox a => VMap a
- Data.DAWG.VMap: fromList :: [(Int, Int)] -> VMap
+ Data.DAWG.VMap: fromList :: Unbox a => [(Int, a)] -> VMap a
- Data.DAWG.VMap: insert :: Int -> Int -> VMap -> VMap
+ Data.DAWG.VMap: insert :: Unbox a => Int -> a -> VMap a -> VMap a
- Data.DAWG.VMap: lookup :: Int -> VMap -> Maybe Int
+ Data.DAWG.VMap: lookup :: Unbox a => Int -> VMap a -> Maybe a
- Data.DAWG.VMap: toList :: VMap -> [(Int, Int)]
+ Data.DAWG.VMap: toList :: Unbox a => VMap a -> [(Int, a)]

Files

− Data/DAWG/Frozen.hs
@@ -1,267 +0,0 @@-{-# 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 #-}
Data/DAWG/Internal.hs view
@@ -50,7 +50,7 @@         -- | Epsilon transition.           eps       :: {-# UNPACK #-} !Id         -- | Map from alphabet symbols to 'Branch' node identifiers.-        , edgeMap   :: !V.VMap }+        , edgeMap   :: !(V.VMap Id) }     | Value         { unValue :: !a }     deriving (Show, Eq, Ord)
+ Data/DAWG/Static.hs view
@@ -0,0 +1,312 @@+{-# 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,+--+--   * When 'weigh'ed, it can be used to perform static hashing with+--     'hash' and 'unHash' functions,+--+--   * Doesn't provide insert/delete family of operations.++module Data.DAWG.Static+(+-- * DAWG type+  DAWG (..)+-- * Query+, lookup+, numStates+-- * Index+, index+, byIndex+-- * Hash+, hash+, unHash+-- * Construction+, empty+, fromList+, fromListWith+, fromLang+, freeze+-- * Weight+, Weight+, weigh+-- * Conversion+, assocs+, keys+, elems+) where++import Prelude hiding (lookup)+import Control.Applicative ((<$), (<$>), (<*>), (<|>))+import Control.Arrow (first, second)+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.DAWG.VMap as VM+import qualified Data.DAWG.Internal as I+import qualified Data.DAWG as D++-- | Node identifier.+type Id = Int++-- | Internal representation of the transition symbol.+type Sym = Int++-- | Edge with label.+type Edge a = (Id, a)++to :: Edge a -> Id+to = fst+{-# INLINE to #-}++label :: Edge a -> a+label = snd+{-# INLINE label #-}++annotate :: a -> Edge b -> Edge a+annotate x (i, _) = (i, x)+{-# INLINE annotate #-}++labeled :: a -> Id -> Edge a+labeled x i = (i, x)+{-# INLINE labeled #-}++-- | State (node) of the automaton.+data Node a b = Node {+    -- | Value kept in the node.+      value     :: !a+    -- | Labeled edges outgoing from the node.+    , edgeMap   :: !(VM.VMap (Edge b)) }+    deriving (Show, Eq, Ord)++instance (Unbox b, Binary a, Binary b) => Binary (Node a b) where+    put Node{..} = put value >> put edgeMap+    get = Node <$> get <*> get++-- | Transition function.+onSym :: Unbox b => Sym -> Node a b -> Maybe (Edge b)+onSym x (Node _ es) = VM.lookup x es+{-# INLINE onSym #-}++-- List of symbol/edge pairs outgoing from the node.+trans :: Unbox b => Node a b -> [(Sym, Edge b)]+trans = VM.toList . edgeMap+{-# INLINE trans #-}++-- | List of outgoing edges.+edges :: Unbox b => Node a b -> [Edge b]+edges = map snd . trans+{-# INLINE edges #-}++-- | List children identifiers.+children :: Unbox b => Node a b -> [Id]+children = map to . edges+{-# INLINE children #-}++-- | @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 (Maybe b) c) }++-- | Empty DAWG.+empty :: Unbox c => DAWG a b c+empty = DAWG $ V.singleton (Node Nothing VM.empty)++-- | Number of states in the automaton.+numStates :: DAWG a b c -> Int+numStates = V.length . unDAWG++-- | Node with the given identifier.+nodeBy :: Id -> DAWG a b c -> Node (Maybe b) c+nodeBy i d = unDAWG d V.! i++-- | Find value associated with the key.+lookup :: (Unbox c, Enum a) => [a] -> DAWG a b c -> Maybe b+lookup xs' =+    let xs = map fromEnum xs'+    in  lookup'I xs 0+{-# SPECIALIZE lookup :: Unbox c => String -> DAWG Char b c -> Maybe b #-}++lookup'I :: Unbox c => [Sym] -> Id -> DAWG a b c -> Maybe b+lookup'I []     i d = value (nodeBy i d)+lookup'I (x:xs) i d = case onSym x (nodeBy i d) of+    Just e  -> lookup'I xs (to e) 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 d = map (first (map toEnum)) (assocs'I 0 d)+{-# SPECIALIZE assocs :: Unbox c => DAWG Char b c -> [(String, b)] #-}++assocs'I :: Unbox c => Id -> DAWG a b c -> [([Sym], b)]+assocs'I i d =+    here ++ concatMap there (trans n)+  where+    n = nodeBy i d+    here = case value n of+        Just x  -> [([], x)]+        Nothing -> []+    there (x, e) = map (first (x:)) (assocs'I (to e) d)++-- | Return all keys of the DAWG in ascending order.+keys :: (Unbox c, Enum a) => DAWG a b c -> [[a]]+keys = map fst . assocs+{-# SPECIALIZE keys :: Unbox c => DAWG 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 = map snd . assocs'I 0++-- | Construct 'DAWG' from the list of (word, value) pairs.+-- First a 'D.DAWG' is created and then it is frozen using+-- the 'freeze' function.+fromList :: (Enum a, Ord b) => [([a], b)] -> DAWG a b ()+fromList = freeze . D.fromList+{-# SPECIALIZE fromList :: Ord b => [(String, b)] -> DAWG Char b () #-}++-- | Construct DAWG from the list of (word, value) pairs+-- with a combining function.  The combining function is+-- applied strictly. First a 'D.DAWG' is created and then+-- it is frozen using the 'freeze' function.+fromListWith :: (Enum a, Ord b) => (b -> b -> b) -> [([a], b)] -> DAWG a b ()+fromListWith f = freeze . D.fromListWith f+{-# SPECIALIZE fromListWith :: Ord b => (b -> b -> b)+        -> [(String, b)] -> DAWG Char b () #-}++-- | Make DAWG from the list of words.  Annotate each word with+-- the @()@ value.  First a 'D.DAWG' is created and then it is frozen+-- using the 'freeze' function.+fromLang :: Enum a => [[a]] -> DAWG a () ()+fromLang = freeze . D.fromLang+{-# SPECIALIZE fromLang :: [String] -> DAWG Char () () #-}++-- | Weight of a node corresponds to the number of final states+-- reachable from the node.  Weight of an edge is a sum of weights+-- of preceding nodes outgoing from the same parent node.+type Weight = Int++-- | Compute node weights and store corresponding values in transition labels.+weigh :: Unbox c => DAWG a b c -> DAWG a b Weight+weigh d = (DAWG . V.fromList)+    [ Node (value n) (apply ws (trans n))+    | i <- [0 .. numStates d - 1]+    , let n  = nodeBy i d+    , let ws = accum (children n) ]+  where+    -- In nodeWeight node weights are memoized.+    nodeWeight = ((V.!) . V.fromList) (map detWeight [0 .. numStates d - 1])+    -- Determine weight of the node.+    detWeight i =+        let n = nodeBy i d+            js = children n+        in  add (value n) (map nodeWeight js)+    add w x = maybe 0 (const 1) w + sum x+    -- 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 ]++-- | Construct immutable version of the automaton.+freeze :: D.DAWG a b -> DAWG a b ()+freeze d = DAWG . V.fromList $+    map (stop . oldBy) (M.elems (inverse old2new))+  where+    -- Map from old to new identifiers.+    old2new :: M.IntMap Int+    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 <*> 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 mkEdge) . VM.toList +    -- Make edge from old ID.+    mkEdge = labeled () . (old2new M.!)+    -- 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 Weight -> Maybe Int+index xs = index'I (map fromEnum xs) 0+{-# SPECIALIZE index :: String -> DAWG Char b Weight -> Maybe Int #-}++index'I :: [Sym] -> Id -> DAWG a b Weight -> Maybe Int+index'I []     i d = 0 <$ value (nodeBy i d)+index'I (x:xs) i d = do+    let n = nodeBy i d+        v = maybe 0 (const 1) (value n)+    e <- onSym x n+    w <- index'I xs (to e) d+    return (v + w + label e)++-- | Perfect hashing function for dictionary entries.+-- A synonym for the 'index' function.+hash :: Enum a => [a] -> DAWG a b Weight -> 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 ix d = map toEnum <$> byIndex'I ix 0 d+{-# SPECIALIZE byIndex :: Int -> DAWG Char b Weight -> Maybe String #-}++byIndex'I :: Int -> Id -> DAWG a b Weight -> Maybe [Sym]+byIndex'I ix i d+    | ix < 0    = Nothing+    | otherwise = here <|> there+  where+    n = nodeBy i d+    v = maybe 0 (const 1) (value n)+    here+        | ix == 0   = [] <$ value (nodeBy i d)+        | otherwise = Nothing+    there = do+        -- (x, e) <- VM.firstLL label (ix - v) (edgeMap n)+        (x, e) <- VM.findLastLE cmp (edgeMap n)+        xs <- byIndex'I (ix - v - label e) (to e) d+        return (x:xs)+    cmp e = compare (label e) (ix - v)++-- | Inverse of the 'hash' function and a synonym for the 'byIndex' function.+unHash :: Enum a => Int -> DAWG a b Weight -> Maybe [a]+unHash = byIndex+{-# INLINE unHash #-}
Data/DAWG/VMap.hs view
@@ -1,9 +1,12 @@+{-# LANGUAGE BangPatterns #-}+ -- | A vector representation of 'M.Map'.  module Data.DAWG.VMap ( VMap (unVMap) , empty , lookup+, findLastLE , insert , fromList , toList@@ -11,34 +14,90 @@  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 = VMap { unVMap :: U.Vector (Int, Int) }+newtype VMap a = VMap { unVMap :: U.Vector (Int, a) }     deriving (Show, Eq, Ord) -instance Binary VMap where+instance (Binary a, Unbox a) => Binary (VMap a) where     put v = put (unVMap v)     get = VMap <$> get  -- | Empty map.-empty :: VMap+empty :: Unbox a => VMap a empty = VMap U.empty {-# INLINE empty #-} --- | Lookup the character in the map.-lookup :: Int -> VMap -> Maybe Int-lookup x = fmap snd . U.find ((==x) . fst) . unVMap+-- | Lookup the symbol in the map.+lookup :: Unbox a => Int -> VMap a -> Maybe a+lookup x (VMap v)+    | U.null v  = Nothing+    | otherwise = ST.runST $ do+        w <- U.unsafeThaw v+        fmap snd <$> search w x+  where+    search vec e =+        loop 0 (UM.length vec - 1)+      where+        loop !l !u+            | u <= l    = do+                e' <- UM.unsafeRead vec k+                return $ if e == fst e'+                    then (Just e')+                    else Nothing+            | otherwise = do+                e' <- UM.unsafeRead vec k+                case compare (fst e') e of+                    LT -> loop (k+1) u+                    EQ -> return (Just e')+                    GT -> loop l (k-1)+          where+            k = (u + l) `shiftR` 1+-- 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+-- | Find last map element which is not GT with respect to the+-- given ordering function.+findLastLE :: Unbox a => (a -> Ordering) -> VMap a -> Maybe (Int, a)+findLastLE cmp (VMap v) = ST.runST $ do+    w <- U.unsafeThaw v+    k <- search w+    return (v U.!? (k - 1))+  where+    search vec =+        loop 0 (UM.length vec)+      where+        loop !l !u+            | u <= l    = return l+            | otherwise = do+                let k = (u + l) `shiftR` 1+                x <- UM.unsafeRead vec k+                case cmp (snd x) of+                    LT -> loop (k+1) u+                    EQ -> return (k+1)+                    GT -> loop l     k+-- firstLL f x vm = do+--     k <-  U.findIndex ((>x) . f . snd) v+--       <|> if n > 0 then Just n else Nothing+--     return (v U.! (k - 1))+--   where+--     v = unVMap vm+--     n = U.length v+{-# INLINE findLastLE #-}++-- | Insert the symbol/value pair into the map.+-- TODO: Optimize! Use the invariant, that VMap is -- kept in an ascending vector.-insert :: Int -> Int -> VMap -> VMap+insert :: Unbox a => Int -> a -> VMap a -> VMap a insert x y     = VMap . U.fromList . M.toAscList     . M.insert x y@@ -47,11 +106,11 @@  -- | Smart 'VMap' constructor which ensures that the underlying vector is -- strictly ascending with respect to 'fst' values.-fromList :: [(Int, Int)] -> VMap-fromList = VMap . U.fromList . M.toAscList  . M.fromList +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 character/value pairs.-toList :: VMap -> [(Int, Int)]+-- | 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.6.0+version:            0.7.0 synopsis:           Directed acyclic word graphs description:     The library implements /directed acyclic word graphs/ (DAWGs) internaly@@ -7,8 +7,8 @@     .     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.+    The automaton from the "Data.DAWG.Static" module has lower memory+    footprint and provides static hashing functionality. license:            BSD3 license-file:       LICENSE cabal-version:      >= 1.6@@ -31,7 +31,7 @@      exposed-modules:         Data.DAWG-      , Data.DAWG.Frozen+      , Data.DAWG.Static       , Data.DAWG.Internal       , Data.DAWG.VMap