module Data.DAWG.Internal
(
Node (..)
, Id
, edges
, onSym
, subst
, Graph (..)
, empty
, size
, nodeBy
, nodeID
, insert
, delete
) where
import Control.Applicative ((<$>), (<*>))
import Data.Binary (Binary, Get, put, get)
import qualified Data.Map as M
import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.DAWG.VMap as V
type Id = Int
data Node a
= Branch {
eps :: !Id
, edgeMap :: !(V.VMap Id) }
| Value
{ unValue :: !a }
deriving (Show, Eq, Ord)
instance Functor Node where
fmap f (Value x) = Value (f x)
fmap _ (Branch x y) = Branch x y
instance Binary a => Binary (Node a) where
put Branch{..} = put (1 :: Int) >> put eps >> put edgeMap
put Value{..} = put (2 :: Int) >> put unValue
get = do
x <- get :: Get Int
case x of
1 -> Branch <$> get <*> get
_ -> Value <$> get
edges :: Node a -> [(Int, Id)]
edges (Branch _ es) = V.toList es
edges (Value _) = error "edges: value node"
onSym :: Int -> Node a -> Maybe Id
onSym x (Branch _ es) = V.lookup x es
onSym _ (Value _) = error "onSym: value node"
subst :: Int -> Id -> Node a -> Node a
subst x i (Branch w es) = Branch w (V.insert x i es)
subst _ _ (Value _) = error "subst: value node"
data Graph a = Graph {
idMap :: !(M.Map (Node a) Id)
, freeIDs :: !IS.IntSet
, nodeMap :: !(IM.IntMap (Node a))
, ingoMap :: !(IM.IntMap Int) }
deriving (Show, Eq, Ord)
instance (Ord a, Binary a) => Binary (Graph a) where
put Graph{..} = do
put idMap
put freeIDs
put nodeMap
put ingoMap
get = Graph <$> get <*> get <*> get <*> get
empty :: Graph a
empty = Graph M.empty IS.empty IM.empty IM.empty
size :: Graph a -> Int
size = M.size . idMap
nodeBy :: Id -> Graph a -> Node a
nodeBy i g = nodeMap g IM.! i
nodeID :: Ord a => Node a -> Graph a -> Id
nodeID n g = idMap g M.! n
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
remNode :: Ord a => Id -> Graph a -> Graph a
remNode i Graph{..} =
Graph idMap' freeIDs' nodeMap' ingoMap'
where
idMap' = M.delete n idMap
nodeMap' = IM.delete i nodeMap
ingoMap' = IM.delete i ingoMap
freeIDs' = IS.insert i freeIDs
n = nodeMap IM.! i
incIngo :: Id -> Graph a -> Graph a
incIngo i g = g { ingoMap = IM.insertWith' (+) i 1 (ingoMap g) }
decIngo :: Id -> Graph a -> (Int, Graph a)
decIngo i g =
let k = (ingoMap g IM.! i) 1
in (k, g { ingoMap = IM.insert i k (ingoMap g) })
insert :: Ord a => Node a -> Graph a -> (Id, Graph a)
insert n g = case M.lookup n (idMap g) of
Just i -> (i, incIngo i g)
Nothing -> newNode n g
delete :: 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