module Graphene.Graph(
Graph(..),
emptyGraph,
insertVertex,
removeVertex,
removeVertices,
removeEdge,
insertEdge,
insertVertices,
insertEdges,
modifyVertex,
modifyEdge,
connections,
neighbors,
fromLists,
degree,
subgraph,
moveFromTo,
moveFromThrough,
module Graphene.Class
) where
import Data.Hashable
import Data.List
import Data.Function
import Data.Maybe(catMaybes)
import Lens.Family2
import Data.Bifunctor
import Graphene.Class
import Graphene.Instances
insertVertex :: (Eq v) => v -> Graph e v -> Graph e v
insertVertex !v g@(Graph vs es)
| v `elem` vs = g
| otherwise = Graph (v:vs) es
removeVertex :: Eq v => v -> Graph e v -> Graph e v
removeVertex !v g = vertices %~ (delete v)
$ edges %~ (filter (\(_, (v1, v2)) -> not $ any (==v) [v1, v2])) $ g
removeVertices :: Eq v => [v] -> Graph e v -> Graph e v
removeVertices vs g = foldl' (flip removeVertex) g vs
insertEdge :: Eq v => e -> (v, v) -> Graph e v -> Graph e v
insertEdge !e !(v, v') (Graph vs es) =
foldr insertVertex (Graph vs ((e, (v, v')):es)) [v, v']
removeEdge :: Eq e => e -> Graph e v -> Graph e v
removeEdge !e = edges %~ (deleteBy ((==) `on` fst) (e, undefined))
modifyVertex :: Eq v => (v -> v) -> v -> Graph e v -> Graph e v
modifyVertex f !v = second (\w -> if v == w then f v else v)
modifyEdge :: Eq e => (e -> e) -> e -> Graph e v -> Graph e v
modifyEdge f !e = first (\e' -> if e == e' then f e' else e')
insertVertices :: Eq b => [b] -> Graph e b -> Graph e b
insertVertices vs g = foldl' (flip insertVertex) g vs
insertEdges :: Eq v => [(e, v, v)] -> Graph e v -> Graph e v
insertEdges es g = foldl' (\g (e, v1, v2) -> insertEdge e (v1, v2) g) g es
connections :: (Eq v) => v -> Graph e v -> [(e, v)]
connections !v (Graph _ es) = catMaybes $
map (\(e, (v1, v2)) ->
if v == v1 then Just (e, v2)
else if v == v2 then Just (e, v1)
else Nothing) es
neighbors :: Eq v => v -> Graph e v -> [v]
neighbors !v (Graph _ es) = foldl' f [] es
where f acc (e, (v1, v2)) = if v == v2 then (v1:acc) else if v == v1 then (v2:acc) else acc
fromLists :: (Eq v) => [v] -> [(e, v, v)] -> Graph e v
fromLists vs es = insertEdges es $ insertVertices vs emptyGraph
degree :: Eq v => v -> Graph e v -> Int
degree !v = length . connections v
subgraph :: Eq v => [v] -> Graph e v -> Graph e v
subgraph ws (Graph vs es) = Graph vs' es'
where vs' = filter (`elem` ws) vs
es' = filter (\(e, (v1, v2)) -> all (`elem` ws) [v1, v2]) es
moveFromTo :: Eq v => v -> v -> Graph e v -> Maybe v
moveFromTo v w g = if w `elem` ns then Just w else Nothing
where ns = neighbors v g
moveFromThrough :: (Eq v, Eq e) => v -> e -> Graph e v -> Maybe v
moveFromThrough v e g = lookup e $ connections v g