module NLP.Adict.DAWG.Internal
( DAWG (..)
, DAWGM
, fromTrie
, fromDAWG
, size
, nodeBy
, Node (..)
, entry
, charOn
, valueBy
, edges
, edgeOn
) where
import Control.Applicative ((<$>))
import Data.Maybe (listToMaybe)
import Data.Binary (Binary, get, put)
import qualified Data.Vector as V
import qualified NLP.Adict.Node as N
import qualified NLP.Adict.Trie.Internal as Trie
type DAWGM a b = DAWG a (Maybe b)
data DAWG a b = DAWG
{ root :: Int
, nodes :: V.Vector (Node a b)
}
fromTrie :: (Ord a, Ord b) => Trie.Trie a b -> DAWG a b
fromTrie = deserialize . Trie.serialize
fromDAWG :: Ord a => DAWG a b -> Trie.Trie a b
fromDAWG = Trie.deserialize . serialize
size :: DAWG a b -> Int
size = V.length . nodes
nodeBy :: DAWG a b -> Int -> Node a b
nodeBy dag k = nodes dag V.! k
data Node a b = Node {
valueIn :: b,
subNodes :: V.Vector (a, Int)
}
valueBy :: DAWG a b -> Int -> b
valueBy dag k = valueIn (nodes dag V.! k)
edges :: DAWG a b -> Int -> [(a, Int)]
edges dag k = V.toList . subNodes $ nodeBy dag k
edgeOn :: Eq a => DAWG a b -> Int -> a -> Maybe Int
edgeOn DAWG{..} k x =
let r = nodes V.! k
in snd <$> V.find ((x==).fst) (subNodes r)
entry :: DAWG a (Maybe b) -> [Int] -> Maybe ([a], b)
entry dag xs = do
x <- mapM (charOn dag) (zip (root dag:xs) xs)
r <- maybeLast xs >>= valueBy dag
return (x, r)
where
maybeLast [] = Nothing
maybeLast ys = Just $ last ys
charOn :: DAWG a b -> (Int, Int) -> Maybe a
charOn dag (root, x) = listToMaybe
[c | (c, y) <- edges dag root, x == y]
serialize :: Ord a => DAWG a b -> [N.Node a b]
serialize = map unNode . V.toList . nodes
deserialize :: Ord a => [N.Node a b] -> DAWG a b
deserialize xs =
let arr = V.fromList $ map mkNode xs
in DAWG (V.length arr 1) arr
unNode :: Ord a => Node a b -> N.Node a b
unNode Node{..} = N.mkNode valueIn (V.toList subNodes)
mkNode :: Ord a => N.Node a b -> Node a b
mkNode n = Node (N.nodeValue n) (V.fromList $ N.nodeEdges n)
instance (Ord a, Binary a, Binary b) => Binary (DAWG a b) where
put = put . serialize
get = deserialize <$> get