module Data.Graph.Analysis.Internal where
import Data.Graph.Inductive.Graph
import Data.Either(partitionEithers)
import qualified Data.Map as M
import Data.Map(Map)
import qualified Data.Set as S
import Data.Set(Set)
import Data.Maybe(fromJust)
import Control.Arrow((***))
import Control.Monad(ap)
sq :: (Num a) => a -> a
sq x = x * x
fI :: (Num a) => Int -> a
fI = fromIntegral
swap :: (a,b) -> (b,a)
swap (a,b) = (b,a)
applyBoth :: (a -> b) -> (a,a) -> (b,b)
applyBoth f = f *** f
mkNodeMap :: (Ord a) => [LNode a] -> Map a Node
mkNodeMap = M.fromList . map swap
spreadOut :: [([a], b)] -> [(a,b)]
spreadOut = concatMap spread
where
spread (as, b) = map (flip (,) b) as
node :: LNode a -> Node
node = fst
label :: LNode a -> a
label = snd
filterNodes :: (Graph g) => (g a b -> LNode a -> Bool) -> g a b -> [LNode a]
filterNodes p g = filter (p g) (labNodes g)
filterNodes' :: (Graph g) => (g a b -> Node -> Bool) -> g a b -> [Node]
filterNodes' p g = filter (p g) (nodes g)
addLabels :: (Graph g) => g a b -> [Node] -> [LNode a]
addLabels gr = map (ap (,) (fromJust . lab gr))
addLabels' :: (Ord a, Graph g) => g a b -> Set Node -> Set (LNode a)
addLabels' gr = S.map (ap (,) (fromJust . lab gr))
getLabels :: (Graph g) => g a b -> [Node] -> [a]
getLabels gr = map label . addLabels gr
getLabels' :: (Ord a, Graph g) => g a b -> Set Node -> Set a
getLabels' gr = S.fromList
. getLabels gr
. S.toList
type Rel n e = (n, n, e)
applyNodes :: (a -> b) -> Rel a e -> Rel b e
applyNodes f (n1, n2, e) = (f n1, f n2, e)
fromNode :: Rel n e -> n
fromNode (n1, _, _) = n1
toNode :: Rel n e -> n
toNode (_, n2, _) = n2
relLabel :: Rel n e -> e
relLabel (_, _, e) = e
relsToEs :: (Ord a) => Bool -> [LNode a] -> [Rel a e]
-> ([Rel a e], [LEdge e])
relsToEs isDir lns rs = (unRs, graphEdges)
where
nodeMap = mkNodeMap lns
findNode v = M.lookup v nodeMap
validEdge e = case applyNodes findNode e of
(Just x, Just y, l) -> Right (x,y,l)
_ -> Left e
(unRs, gEdges) = partitionEithers $ map validEdge rs
dupSwap' = if isDir
then id
else concatMap dupSwap
dupSwap e@(x,y,l) | x == y = [e]
| otherwise = [e, (y,x,l)]
graphEdges = dupSwap' gEdges