diff --git a/src/Dodge/Graph.hs b/src/Dodge/Graph.hs new file mode 100644 index 000000000..02ad7192e --- /dev/null +++ b/src/Dodge/Graph.hs @@ -0,0 +1,21 @@ +module Dodge.Graph + where +import Data.Function (on) +import Data.List + +import Data.Graph + +pairsToIncidence :: (Eq a,Ord a) => [(a,a)] -> [(a,[a])] +pairsToIncidence = map ((\(xs,ys) -> (head xs,ys)) . unzip) + . groupBy ( (==) `on` fst) + . sort + +incidenceToFunction :: Eq a => [(a,[a])] -> a -> [a] +incidenceToFunction xs a = case lookup a xs of Just ys -> ys + Nothing -> [] + +mkNode :: (a,[a]) -> (a,a,[a]) +mkNode (x,xs) = (x,x,xs) + +pairsToSCC :: (Eq a, Ord a) => [(a,a)] -> [SCC a] +pairsToSCC = stronglyConnComp . map mkNode . pairsToIncidence diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index e421ed7c5..202859817 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -8,7 +8,7 @@ import Dodge.Data import Dodge.LevelGen import Dodge.Base import Dodge.RandomHelp -import Dodge.Path +import Dodge.Graph import Dodge.Layout.Tree import Dodge.Room.Data import Dodge.Default diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index ae168e341..586cdb73f 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -1,6 +1,7 @@ module Dodge.Path where import Dodge.Data import Dodge.Base +import Dodge.Graph import Geometry @@ -160,12 +161,3 @@ maybeToEither :: a -> Maybe b -> Either a b maybeToEither _ (Just x) = Right x maybeToEither y Nothing = Left y -pairsToIncidence :: (Eq a,Ord a) => [(a,a)] -> [(a,[a])] -pairsToIncidence = map ((\(xs,ys) -> (head xs,ys)) . unzip) - . groupBy ( (==) `on` fst) - . sort - -incidenceToFunction :: Eq a => [(a,[a])] -> a -> [a] -incidenceToFunction xs a = case lookup a xs of Just ys -> ys - Nothing -> [] - diff --git a/test/Spec.hs b/test/Spec.hs index cd4753fc9..cf937348d 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,2 +1,4 @@ +import Test.QuickCheck + main :: IO () main = putStrLn "Test suite not yet implemented"