module Game.Antisplice.Utils.Graph where
import Game.Antisplice.Utils.BST
import Game.Antisplice.Utils.AVL
newtype NodeId = NodeId Int deriving (Eq,Show,Ord)
data Graph a b = Graph { nodes :: AVL (Node a), edges :: [Edge b], nextId :: NodeId }
data Node a = Node { nodeMarked :: Bool, nodeContent :: a, nodeId :: NodeId }
data Edge b = Edge { fromNode :: NodeId, toNode :: NodeId, weight :: Int, label :: b }
instance Indexable (Node a) NodeId (Node a) where
type IndexOf (Node a) = NodeId
type ValueOf (Node a) = Node a
indexOf = nodeId
valueOf = id
instance (Show a) => Show (Node a) where
show (Node _ c i) = concat [show i, ": ", show c]
instance (Show b) => Show (Edge b) where
show (Edge f t w l) = concat [show f, " --", show l, "-> ", show t, " [", show w, "]"]
incId :: NodeId -> NodeId
incId (NodeId i) = NodeId (i+1)
emptyGraph :: Graph a b
emptyGraph = Graph EmptyAVL [] (NodeId 0)
addNode :: a -> Graph a b -> Graph a b
addNode x = snd . addNode' x
addNode' :: a -> Graph a b -> (NodeId,Graph a b)
addNode' x (Graph ns es nid) = (nid, Graph (avlInsert (Node False x nid) ns) es (incId nid))
addNodes :: [a] -> Graph a b -> Graph a b
addNodes xs = snd . addNodes' xs
addNodes' :: [a] -> Graph a b -> ([NodeId],Graph a b)
addNodes' [] g = ([],g)
addNodes' (p:ps) g = let (ls, g'') = addNodes' ps g'
(l, g') = addNode' p g
in (l:ls, g'')
allNodes :: Graph a b -> [Node a]
allNodes = avlInorder . nodes
rootNode :: Graph a b -> NodeId
rootNode = nodeId . avlRoot . nodes
addEdge :: NodeId -> NodeId -> Int -> b -> Graph a b -> Graph a b
addEdge f t w l = addEdge' (Edge f t w l)
addEdge' :: Edge b -> Graph a b -> Graph a b
addEdge' e g = g{edges=e:edges g}
addMutualEdge :: NodeId -> NodeId -> Int -> b -> Graph a b -> Graph a b
addMutualEdge f t w l = addEdge f t w l . addEdge t f w l
addEdges :: [(NodeId,NodeId,Int,b)] -> Graph a b -> Graph a b
addEdges es g = foldr (addEdge' . (\(f,t,w,l) -> Edge f t w l)) g es
addEdges' :: [Edge b] -> Graph a b -> Graph a b
addEdges' = flip $ foldr addEdge'
addMutualEdges :: [(NodeId,NodeId,Int,b)] -> Graph a b -> Graph a b
addMutualEdges es = addEdges es . addEdges (map (\(f,t,w,l) -> (t,f,w,l)) es)
getNode :: NodeId -> Graph a b -> a
getNode n = nodeContent . getNode' n
getNode' :: NodeId -> Graph a b -> Node a
getNode' n = (\(Just x) -> x) . avlLookup n . nodes
setNode :: NodeId -> a -> Graph a b -> Graph a b
setNode n a g@(Graph ns _ _) = g{nodes=fmap setNode' ns}
where setNode' (Node m c i) = if i == n then Node m a i else Node m c i
markNode :: NodeId -> Graph a b -> Graph a b
markNode n g@(Graph ns _ _) = g{nodes=fmap markNode' ns}
where markNode' (Node m c i) = if i == n then Node True c i else Node m c i
followEdge :: Eq b => NodeId -> b -> Graph a b -> Maybe NodeId
followEdge n l g = case filter ((==l).label) $ filter ((==n).fromNode) $ edges g of
[] -> Nothing
(x:_) -> Just (toNode x)
listEdges :: NodeId -> Graph a b -> [(b,NodeId)]
listEdges n g = fmap (\(Edge _ t _ l) -> (l,t)) $ filter ((==n).fromNode) $ edges g