44 lines
1.2 KiB
Haskell
44 lines
1.2 KiB
Haskell
{-# LANGUAGE RankNTypes #-}
|
|
module Dodge.Graph
|
|
( pairsToSCC
|
|
, incidenceToFunction
|
|
, pairsToIncidence
|
|
, graphToEdges
|
|
, graphToIncidence
|
|
) where
|
|
-- this deserves tests
|
|
import Data.List.Extra
|
|
|
|
--import Data.Bifunctor (first)
|
|
import Data.Graph
|
|
import Data.Maybe
|
|
import qualified Data.Graph.Inductive.Graph as F
|
|
import qualified Data.Graph.Inductive.PatriciaTree as F
|
|
import qualified Data.Set as S
|
|
import Data.Bifunctor
|
|
|
|
pairsToIncidence :: Ord a => S.Set (a,a) -> [(a,[a])]
|
|
pairsToIncidence
|
|
= map (first head . unzip)
|
|
. groupOn fst
|
|
. S.toAscList -- TODO check that the lexicographic sorting is correct for groupOn fst
|
|
|
|
incidenceToFunction :: Eq a => [(a,[a])] -> a -> [a]
|
|
incidenceToFunction xs a = fromMaybe [] $ lookup a xs
|
|
|
|
mkNode :: (a,[a]) -> (a,a,[a])
|
|
mkNode (x,xs) = (x,x,xs)
|
|
|
|
pairsToSCC :: Ord a => S.Set (a,a) -> [SCC a]
|
|
pairsToSCC = stronglyConnComp . map mkNode . pairsToIncidence
|
|
|
|
graphToEdges :: forall a b . F.Gr a b -> [(a,a)]
|
|
graphToEdges g = map (bimap f f) $ F.edges g
|
|
where
|
|
f n = fromJust . lookup n $ F.labNodes g
|
|
|
|
graphToIncidence :: forall a b . F.Gr a b -> [(a,Int)]
|
|
graphToIncidence g = map f $ F.labNodes g
|
|
where
|
|
f (n,p) = (p,length $ F.neighbors g n)
|