module Data.DAWG.Internal
(
DAWG (..)
, MkNode
, numStates
, lookup
, empty
, fromList
, fromListWith
, fromLang
, insert
, insertWith
, delete
, assocs
, keys
, elems
) where
import Prelude hiding (lookup)
import Control.Applicative ((<$>), (<*>))
import Control.Arrow (first)
import Data.List (foldl')
import Data.Binary (Binary, put, get)
import qualified Data.Vector.Unboxed as U
import qualified Control.Monad.State.Strict as S
import Data.DAWG.Types
import Data.DAWG.Graph (Graph)
import Data.DAWG.Trans (Trans)
import qualified Data.DAWG.Trans as T
import qualified Data.DAWG.Node as N
import qualified Data.DAWG.Graph as G
type Node t a = N.Node t () a
class (Ord (Node t a), Trans t) => MkNode t a where
instance (Ord (Node t a), Trans t) => MkNode t a where
type GraphM t a b = S.State (Graph (Node t a)) b
mkState :: (Graph a -> Graph a) -> Graph a -> ((), Graph a)
mkState f g = ((), f g)
insertLeaf :: MkNode t a => GraphM t a ID
insertLeaf = do
i <- insertNode (N.Leaf Nothing)
insertNode (N.Branch i T.empty U.empty)
nodeBy :: ID -> GraphM t a (Node t a)
nodeBy i = G.nodeBy i <$> S.get
insertNode :: MkNode t a => Node t a -> GraphM t a ID
insertNode = S.state . G.insert
deleteNode :: MkNode t a => Node t a -> GraphM t a ()
deleteNode = S.state . mkState . G.delete
insertM :: MkNode t a => [Sym] -> a -> ID -> GraphM t a ID
insertM (x:xs) y i = do
n <- nodeBy i
j <- case N.onSym x n of
Just j -> return j
Nothing -> insertLeaf
k <- insertM xs y j
deleteNode n
insertNode (N.insert x k n)
insertM [] y i = do
n <- nodeBy i
w <- nodeBy (N.eps n)
deleteNode w
deleteNode n
j <- insertNode (N.Leaf $ Just y)
insertNode (n { N.eps = j })
insertWithM
:: MkNode t a => (a -> a -> a)
-> [Sym] -> a -> ID -> GraphM t a ID
insertWithM f (x:xs) y i = do
n <- nodeBy i
j <- case N.onSym x n of
Just j -> return j
Nothing -> insertLeaf
k <- insertWithM f xs y j
deleteNode n
insertNode (N.insert x k n)
insertWithM f [] y i = do
n <- nodeBy i
w <- nodeBy (N.eps n)
deleteNode w
deleteNode n
let y'new = case N.value w of
Just y' -> f y y'
Nothing -> y
j <- insertNode (N.Leaf $ Just y'new)
insertNode (n { N.eps = j })
deleteM :: MkNode t a => [Sym] -> ID -> GraphM t a ID
deleteM (x:xs) i = do
n <- nodeBy i
case N.onSym x n of
Nothing -> return i
Just j -> do
k <- deleteM xs j
deleteNode n
insertNode (N.insert x k n)
deleteM [] i = do
n <- nodeBy i
w <- nodeBy (N.eps n)
deleteNode w
deleteNode n
j <- insertLeaf
insertNode (n { N.eps = j })
lookupM :: Trans t => [Sym] -> ID -> GraphM t a (Maybe a)
lookupM [] i = do
j <- N.eps <$> nodeBy i
N.value <$> nodeBy j
lookupM (x:xs) i = do
n <- nodeBy i
case N.onSym x n of
Just j -> lookupM xs j
Nothing -> return Nothing
assocsAcc :: Trans t => Graph (Node t a) -> ID -> [([Sym], a)]
assocsAcc g i =
here w ++ concatMap there (N.edges n)
where
n = G.nodeBy i g
w = G.nodeBy (N.eps n) g
here v = case N.value v of
Just x -> [([], x)]
Nothing -> []
there (sym, j) = map (first (sym:)) (assocsAcc g j)
data DAWG t a b = DAWG
{ graph :: !(Graph (Node t b))
, root :: !ID }
deriving (Show)
instance (MkNode t b, Binary t, Binary b) => Binary (DAWG t a b) where
put d = do
put (graph d)
put (root d)
get = DAWG <$> get <*> get
empty :: (MkNode t b) => DAWG t a b
empty =
let (i, g) = S.runState insertLeaf G.empty
in DAWG g i
numStates :: DAWG t a b -> Int
numStates = G.size . graph
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
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
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
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)
assocs :: (Enum a, MkNode t b) => DAWG t a b -> [([a], b)]
assocs
= map (first (map toEnum))
. (assocsAcc <$> graph <*> root)
keys :: (Enum a, MkNode t b) => DAWG t a b -> [[a]]
keys = map fst . assocs
elems :: MkNode t b => DAWG t a b -> [b]
elems = map snd . (assocsAcc <$> graph <*> root)
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
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
fromLang :: (Enum a, MkNode t ()) => [[a]] -> DAWG t a ()
fromLang xs = fromList [(x, ()) | x <- xs]