{-# LANGUAGE MultiParamTypeClasses, Safe #-}
module Data.Chatty.Graph where
import Data.Chatty.BST
import Data.Chatty.AVL
import Data.Chatty.None
newtype NodeId = NodeId Int deriving (NodeId -> NodeId -> Bool
(NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool) -> Eq NodeId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeId -> NodeId -> Bool
$c/= :: NodeId -> NodeId -> Bool
== :: NodeId -> NodeId -> Bool
$c== :: NodeId -> NodeId -> Bool
Eq,Int -> NodeId -> ShowS
[NodeId] -> ShowS
NodeId -> String
(Int -> NodeId -> ShowS)
-> (NodeId -> String) -> ([NodeId] -> ShowS) -> Show NodeId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeId] -> ShowS
$cshowList :: [NodeId] -> ShowS
show :: NodeId -> String
$cshow :: NodeId -> String
showsPrec :: Int -> NodeId -> ShowS
$cshowsPrec :: Int -> NodeId -> ShowS
Show,Eq NodeId
Eq NodeId
-> (NodeId -> NodeId -> Ordering)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> NodeId)
-> (NodeId -> NodeId -> NodeId)
-> Ord NodeId
NodeId -> NodeId -> Bool
NodeId -> NodeId -> Ordering
NodeId -> NodeId -> NodeId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NodeId -> NodeId -> NodeId
$cmin :: NodeId -> NodeId -> NodeId
max :: NodeId -> NodeId -> NodeId
$cmax :: NodeId -> NodeId -> NodeId
>= :: NodeId -> NodeId -> Bool
$c>= :: NodeId -> NodeId -> Bool
> :: NodeId -> NodeId -> Bool
$c> :: NodeId -> NodeId -> Bool
<= :: NodeId -> NodeId -> Bool
$c<= :: NodeId -> NodeId -> Bool
< :: NodeId -> NodeId -> Bool
$c< :: NodeId -> NodeId -> Bool
compare :: NodeId -> NodeId -> Ordering
$ccompare :: NodeId -> NodeId -> Ordering
$cp1Ord :: Eq NodeId
Ord)
data Graph a b c = Graph { Graph a b c -> AVL (Node a)
nodes :: AVL (Node a), Graph a b c -> [Edge b c]
edges :: [Edge b c], Graph a b c -> NodeId
nextId :: NodeId }
data Node a = Node { Node a -> Bool
nodeMarked :: Bool, Node a -> a
nodeContent :: a, Node a -> NodeId
nodeId :: NodeId }
data Edge b c = Edge { Edge b c -> NodeId
fromNode :: NodeId, Edge b c -> NodeId
toNode :: NodeId, Edge b c -> Int
weight :: Int, Edge b c -> b
label :: b, Edge b c -> c
content :: c }
instance Indexable (Node a) NodeId (Node a) where
indexOf :: Node a -> NodeId
indexOf = Node a -> NodeId
forall a. Node a -> NodeId
nodeId
valueOf :: Node a -> Node a
valueOf = Node a -> Node a
forall a. a -> a
id
instance (Show a) => Show (Node a) where
show :: Node a -> String
show (Node Bool
_ a
c NodeId
i) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [NodeId -> String
forall a. Show a => a -> String
show NodeId
i, String
": ", a -> String
forall a. Show a => a -> String
show a
c]
instance (Show b) => Show (Edge b c) where
show :: Edge b c -> String
show (Edge NodeId
f NodeId
t Int
w b
l c
_) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [NodeId -> String
forall a. Show a => a -> String
show NodeId
f, String
" --", b -> String
forall a. Show a => a -> String
show b
l, String
"-> ", NodeId -> String
forall a. Show a => a -> String
show NodeId
t, String
" [", Int -> String
forall a. Show a => a -> String
show Int
w, String
"]"]
incId :: NodeId -> NodeId
incId :: NodeId -> NodeId
incId (NodeId Int
i) = Int -> NodeId
NodeId (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
emptyGraph :: Graph a b c
emptyGraph :: Graph a b c
emptyGraph = AVL (Node a) -> [Edge b c] -> NodeId -> Graph a b c
forall a b c. AVL (Node a) -> [Edge b c] -> NodeId -> Graph a b c
Graph AVL (Node a)
forall a. AVL a
EmptyAVL [] (Int -> NodeId
NodeId Int
0)
instance None (Graph a b c) where
none :: Graph a b c
none = Graph a b c
forall a b c. Graph a b c
emptyGraph
addNode :: a -> Graph a b c -> Graph a b c
addNode :: a -> Graph a b c -> Graph a b c
addNode a
x = (NodeId, Graph a b c) -> Graph a b c
forall a b. (a, b) -> b
snd ((NodeId, Graph a b c) -> Graph a b c)
-> (Graph a b c -> (NodeId, Graph a b c))
-> Graph a b c
-> Graph a b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Graph a b c -> (NodeId, Graph a b c)
forall a b c. a -> Graph a b c -> (NodeId, Graph a b c)
addNode' a
x
addNode' :: a -> Graph a b c -> (NodeId,Graph a b c)
addNode' :: a -> Graph a b c -> (NodeId, Graph a b c)
addNode' a
x (Graph AVL (Node a)
ns [Edge b c]
es NodeId
nid) = (NodeId
nid, AVL (Node a) -> [Edge b c] -> NodeId -> Graph a b c
forall a b c. AVL (Node a) -> [Edge b c] -> NodeId -> Graph a b c
Graph (Node a -> AVL (Node a) -> AVL (Node a)
forall i o v. Indexable i o v => i -> AVL i -> AVL i
avlInsert (Bool -> a -> NodeId -> Node a
forall a. Bool -> a -> NodeId -> Node a
Node Bool
False a
x NodeId
nid) AVL (Node a)
ns) [Edge b c]
es (NodeId -> NodeId
incId NodeId
nid))
addNodes :: [a] -> Graph a b c -> Graph a b c
addNodes :: [a] -> Graph a b c -> Graph a b c
addNodes [a]
xs = ([NodeId], Graph a b c) -> Graph a b c
forall a b. (a, b) -> b
snd (([NodeId], Graph a b c) -> Graph a b c)
-> (Graph a b c -> ([NodeId], Graph a b c))
-> Graph a b c
-> Graph a b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Graph a b c -> ([NodeId], Graph a b c)
forall a b c. [a] -> Graph a b c -> ([NodeId], Graph a b c)
addNodes' [a]
xs
addNodes' :: [a] -> Graph a b c -> ([NodeId],Graph a b c)
addNodes' :: [a] -> Graph a b c -> ([NodeId], Graph a b c)
addNodes' [] Graph a b c
g = ([],Graph a b c
g)
addNodes' (a
p:[a]
ps) Graph a b c
g = let ([NodeId]
ls, Graph a b c
g'') = [a] -> Graph a b c -> ([NodeId], Graph a b c)
forall a b c. [a] -> Graph a b c -> ([NodeId], Graph a b c)
addNodes' [a]
ps Graph a b c
g'
(NodeId
l, Graph a b c
g') = a -> Graph a b c -> (NodeId, Graph a b c)
forall a b c. a -> Graph a b c -> (NodeId, Graph a b c)
addNode' a
p Graph a b c
g
in (NodeId
lNodeId -> [NodeId] -> [NodeId]
forall a. a -> [a] -> [a]
:[NodeId]
ls, Graph a b c
g'')
allNodes :: Graph a b c -> [Node a]
allNodes :: Graph a b c -> [Node a]
allNodes = AVL (Node a) -> [Node a]
forall i. AVL i -> [i]
avlInorder (AVL (Node a) -> [Node a])
-> (Graph a b c -> AVL (Node a)) -> Graph a b c -> [Node a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a b c -> AVL (Node a)
forall a b c. Graph a b c -> AVL (Node a)
nodes
rootNode :: Graph a b c -> NodeId
rootNode :: Graph a b c -> NodeId
rootNode = Node a -> NodeId
forall a. Node a -> NodeId
nodeId (Node a -> NodeId)
-> (Graph a b c -> Node a) -> Graph a b c -> NodeId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AVL (Node a) -> Node a
forall i. AVL i -> i
avlRoot (AVL (Node a) -> Node a)
-> (Graph a b c -> AVL (Node a)) -> Graph a b c -> Node a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a b c -> AVL (Node a)
forall a b c. Graph a b c -> AVL (Node a)
nodes
addEdge :: NodeId -> NodeId -> Int -> b -> c -> Graph a b c -> Graph a b c
addEdge :: NodeId -> NodeId -> Int -> b -> c -> Graph a b c -> Graph a b c
addEdge NodeId
f NodeId
t Int
w b
l c
c = Edge b c -> Graph a b c -> Graph a b c
forall b c a. Edge b c -> Graph a b c -> Graph a b c
addEdge' (NodeId -> NodeId -> Int -> b -> c -> Edge b c
forall b c. NodeId -> NodeId -> Int -> b -> c -> Edge b c
Edge NodeId
f NodeId
t Int
w b
l c
c)
addEdge' :: Edge b c -> Graph a b c -> Graph a b c
addEdge' :: Edge b c -> Graph a b c -> Graph a b c
addEdge' Edge b c
e Graph a b c
g = Graph a b c
g{edges :: [Edge b c]
edges=Edge b c
eEdge b c -> [Edge b c] -> [Edge b c]
forall a. a -> [a] -> [a]
:Graph a b c -> [Edge b c]
forall a b c. Graph a b c -> [Edge b c]
edges Graph a b c
g}
addMutualEdge :: NodeId -> NodeId -> Int -> b -> c -> Graph a b c -> Graph a b c
addMutualEdge :: NodeId -> NodeId -> Int -> b -> c -> Graph a b c -> Graph a b c
addMutualEdge NodeId
f NodeId
t Int
w b
l c
c = NodeId -> NodeId -> Int -> b -> c -> Graph a b c -> Graph a b c
forall b c a.
NodeId -> NodeId -> Int -> b -> c -> Graph a b c -> Graph a b c
addEdge NodeId
f NodeId
t Int
w b
l c
c (Graph a b c -> Graph a b c)
-> (Graph a b c -> Graph a b c) -> Graph a b c -> Graph a b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeId -> NodeId -> Int -> b -> c -> Graph a b c -> Graph a b c
forall b c a.
NodeId -> NodeId -> Int -> b -> c -> Graph a b c -> Graph a b c
addEdge NodeId
t NodeId
f Int
w b
l c
c
addEdges :: [(NodeId,NodeId,Int,b,c)] -> Graph a b c -> Graph a b c
addEdges :: [(NodeId, NodeId, Int, b, c)] -> Graph a b c -> Graph a b c
addEdges [(NodeId, NodeId, Int, b, c)]
es Graph a b c
g = ((NodeId, NodeId, Int, b, c) -> Graph a b c -> Graph a b c)
-> Graph a b c -> [(NodeId, NodeId, Int, b, c)] -> Graph a b c
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Edge b c -> Graph a b c -> Graph a b c
forall b c a. Edge b c -> Graph a b c -> Graph a b c
addEdge' (Edge b c -> Graph a b c -> Graph a b c)
-> ((NodeId, NodeId, Int, b, c) -> Edge b c)
-> (NodeId, NodeId, Int, b, c)
-> Graph a b c
-> Graph a b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(NodeId
f,NodeId
t,Int
w,b
l,c
c) -> NodeId -> NodeId -> Int -> b -> c -> Edge b c
forall b c. NodeId -> NodeId -> Int -> b -> c -> Edge b c
Edge NodeId
f NodeId
t Int
w b
l c
c)) Graph a b c
g [(NodeId, NodeId, Int, b, c)]
es
addEdges' :: [Edge b c] -> Graph a b c -> Graph a b c
addEdges' :: [Edge b c] -> Graph a b c -> Graph a b c
addEdges' = (Graph a b c -> [Edge b c] -> Graph a b c)
-> [Edge b c] -> Graph a b c -> Graph a b c
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Graph a b c -> [Edge b c] -> Graph a b c)
-> [Edge b c] -> Graph a b c -> Graph a b c)
-> (Graph a b c -> [Edge b c] -> Graph a b c)
-> [Edge b c]
-> Graph a b c
-> Graph a b c
forall a b. (a -> b) -> a -> b
$ (Edge b c -> Graph a b c -> Graph a b c)
-> Graph a b c -> [Edge b c] -> Graph a b c
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Edge b c -> Graph a b c -> Graph a b c
forall b c a. Edge b c -> Graph a b c -> Graph a b c
addEdge'
addMutualEdges :: [(NodeId,NodeId,Int,b,c)] -> Graph a b c -> Graph a b c
addMutualEdges :: [(NodeId, NodeId, Int, b, c)] -> Graph a b c -> Graph a b c
addMutualEdges [(NodeId, NodeId, Int, b, c)]
es = [(NodeId, NodeId, Int, b, c)] -> Graph a b c -> Graph a b c
forall b c a.
[(NodeId, NodeId, Int, b, c)] -> Graph a b c -> Graph a b c
addEdges [(NodeId, NodeId, Int, b, c)]
es (Graph a b c -> Graph a b c)
-> (Graph a b c -> Graph a b c) -> Graph a b c -> Graph a b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(NodeId, NodeId, Int, b, c)] -> Graph a b c -> Graph a b c
forall b c a.
[(NodeId, NodeId, Int, b, c)] -> Graph a b c -> Graph a b c
addEdges (((NodeId, NodeId, Int, b, c) -> (NodeId, NodeId, Int, b, c))
-> [(NodeId, NodeId, Int, b, c)] -> [(NodeId, NodeId, Int, b, c)]
forall a b. (a -> b) -> [a] -> [b]
map (\(NodeId
f,NodeId
t,Int
w,b
l,c
c) -> (NodeId
t,NodeId
f,Int
w,b
l,c
c)) [(NodeId, NodeId, Int, b, c)]
es)
getNode :: NodeId -> Graph a b c -> a
getNode :: NodeId -> Graph a b c -> a
getNode NodeId
n = Node a -> a
forall a. Node a -> a
nodeContent (Node a -> a) -> (Graph a b c -> Node a) -> Graph a b c -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeId -> Graph a b c -> Node a
forall a b c. NodeId -> Graph a b c -> Node a
getNode' NodeId
n
getNode' :: NodeId -> Graph a b c -> Node a
getNode' :: NodeId -> Graph a b c -> Node a
getNode' NodeId
n = (\(Just Node a
x) -> Node a
x) (Maybe (Node a) -> Node a)
-> (Graph a b c -> Maybe (Node a)) -> Graph a b c -> Node a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeId -> AVL (Node a) -> Maybe (Node a)
forall i o v. Indexable i o v => o -> AVL i -> Maybe v
avlLookup NodeId
n (AVL (Node a) -> Maybe (Node a))
-> (Graph a b c -> AVL (Node a)) -> Graph a b c -> Maybe (Node a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a b c -> AVL (Node a)
forall a b c. Graph a b c -> AVL (Node a)
nodes
setNode :: NodeId -> a -> Graph a b c -> Graph a b c
setNode :: NodeId -> a -> Graph a b c -> Graph a b c
setNode NodeId
n a
a g :: Graph a b c
g@(Graph AVL (Node a)
ns [Edge b c]
_ NodeId
_) = Graph a b c
g{nodes :: AVL (Node a)
nodes=(Node a -> Node a) -> AVL (Node a) -> AVL (Node a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Node a -> Node a
setNode' AVL (Node a)
ns}
where setNode' :: Node a -> Node a
setNode' (Node Bool
m a
c NodeId
i) = if NodeId
i NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
== NodeId
n then Bool -> a -> NodeId -> Node a
forall a. Bool -> a -> NodeId -> Node a
Node Bool
m a
a NodeId
i else Bool -> a -> NodeId -> Node a
forall a. Bool -> a -> NodeId -> Node a
Node Bool
m a
c NodeId
i
markNode :: NodeId -> Graph a b c -> Graph a b c
markNode :: NodeId -> Graph a b c -> Graph a b c
markNode NodeId
n g :: Graph a b c
g@(Graph AVL (Node a)
ns [Edge b c]
_ NodeId
_) = Graph a b c
g{nodes :: AVL (Node a)
nodes=(Node a -> Node a) -> AVL (Node a) -> AVL (Node a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Node a -> Node a
forall a. Node a -> Node a
markNode' AVL (Node a)
ns}
where markNode' :: Node a -> Node a
markNode' (Node Bool
m a
c NodeId
i) = if NodeId
i NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
== NodeId
n then Bool -> a -> NodeId -> Node a
forall a. Bool -> a -> NodeId -> Node a
Node Bool
True a
c NodeId
i else Bool -> a -> NodeId -> Node a
forall a. Bool -> a -> NodeId -> Node a
Node Bool
m a
c NodeId
i
followEdge :: Eq b => NodeId -> b -> Graph a b c -> Maybe NodeId
followEdge :: NodeId -> b -> Graph a b c -> Maybe NodeId
followEdge NodeId
n b
l Graph a b c
g = case (Edge b c -> Bool) -> [Edge b c] -> [Edge b c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((b -> b -> Bool
forall a. Eq a => a -> a -> Bool
==b
l)(b -> Bool) -> (Edge b c -> b) -> Edge b c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Edge b c -> b
forall b c. Edge b c -> b
label) ([Edge b c] -> [Edge b c]) -> [Edge b c] -> [Edge b c]
forall a b. (a -> b) -> a -> b
$ (Edge b c -> Bool) -> [Edge b c] -> [Edge b c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
==NodeId
n)(NodeId -> Bool) -> (Edge b c -> NodeId) -> Edge b c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Edge b c -> NodeId
forall b c. Edge b c -> NodeId
fromNode) ([Edge b c] -> [Edge b c]) -> [Edge b c] -> [Edge b c]
forall a b. (a -> b) -> a -> b
$ Graph a b c -> [Edge b c]
forall a b c. Graph a b c -> [Edge b c]
edges Graph a b c
g of
[] -> Maybe NodeId
forall a. Maybe a
Nothing
(Edge b c
x:[Edge b c]
_) -> NodeId -> Maybe NodeId
forall a. a -> Maybe a
Just (Edge b c -> NodeId
forall b c. Edge b c -> NodeId
toNode Edge b c
x)
queryEdge :: Eq b => NodeId -> b -> Graph a b c -> Maybe c
queryEdge :: NodeId -> b -> Graph a b c -> Maybe c
queryEdge NodeId
n b
l Graph a b c
g = case (Edge b c -> Bool) -> [Edge b c] -> [Edge b c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((b -> b -> Bool
forall a. Eq a => a -> a -> Bool
==b
l)(b -> Bool) -> (Edge b c -> b) -> Edge b c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Edge b c -> b
forall b c. Edge b c -> b
label) ([Edge b c] -> [Edge b c]) -> [Edge b c] -> [Edge b c]
forall a b. (a -> b) -> a -> b
$ (Edge b c -> Bool) -> [Edge b c] -> [Edge b c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
==NodeId
n)(NodeId -> Bool) -> (Edge b c -> NodeId) -> Edge b c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Edge b c -> NodeId
forall b c. Edge b c -> NodeId
fromNode) ([Edge b c] -> [Edge b c]) -> [Edge b c] -> [Edge b c]
forall a b. (a -> b) -> a -> b
$ Graph a b c -> [Edge b c]
forall a b c. Graph a b c -> [Edge b c]
edges Graph a b c
g of
[] -> Maybe c
forall a. Maybe a
Nothing
(Edge b c
x:[Edge b c]
_) -> c -> Maybe c
forall a. a -> Maybe a
Just (Edge b c -> c
forall b c. Edge b c -> c
content Edge b c
x)
listEdges :: NodeId -> Graph a b c -> [(b,c,NodeId)]
listEdges :: NodeId -> Graph a b c -> [(b, c, NodeId)]
listEdges NodeId
n Graph a b c
g = (Edge b c -> (b, c, NodeId)) -> [Edge b c] -> [(b, c, NodeId)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Edge NodeId
_ NodeId
t Int
_ b
l c
c) -> (b
l,c
c,NodeId
t)) ([Edge b c] -> [(b, c, NodeId)]) -> [Edge b c] -> [(b, c, NodeId)]
forall a b. (a -> b) -> a -> b
$ (Edge b c -> Bool) -> [Edge b c] -> [Edge b c]
forall a. (a -> Bool) -> [a] -> [a]
filter ((NodeId -> NodeId -> Bool
forall a. Eq a => a -> a -> Bool
==NodeId
n)(NodeId -> Bool) -> (Edge b c -> NodeId) -> Edge b c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Edge b c -> NodeId
forall b c. Edge b c -> NodeId
fromNode) ([Edge b c] -> [Edge b c]) -> [Edge b c] -> [Edge b c]
forall a b. (a -> b) -> a -> b
$ Graph a b c -> [Edge b c]
forall a b c. Graph a b c -> [Edge b c]
edges Graph a b c
g