Modularise graph functions
This commit is contained in:
@@ -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
|
||||||
+1
-1
@@ -8,7 +8,7 @@ import Dodge.Data
|
|||||||
import Dodge.LevelGen
|
import Dodge.LevelGen
|
||||||
import Dodge.Base
|
import Dodge.Base
|
||||||
import Dodge.RandomHelp
|
import Dodge.RandomHelp
|
||||||
import Dodge.Path
|
import Dodge.Graph
|
||||||
import Dodge.Layout.Tree
|
import Dodge.Layout.Tree
|
||||||
import Dodge.Room.Data
|
import Dodge.Room.Data
|
||||||
import Dodge.Default
|
import Dodge.Default
|
||||||
|
|||||||
+1
-9
@@ -1,6 +1,7 @@
|
|||||||
module Dodge.Path where
|
module Dodge.Path where
|
||||||
import Dodge.Data
|
import Dodge.Data
|
||||||
import Dodge.Base
|
import Dodge.Base
|
||||||
|
import Dodge.Graph
|
||||||
|
|
||||||
import Geometry
|
import Geometry
|
||||||
|
|
||||||
@@ -160,12 +161,3 @@ maybeToEither :: a -> Maybe b -> Either a b
|
|||||||
maybeToEither _ (Just x) = Right x
|
maybeToEither _ (Just x) = Right x
|
||||||
maybeToEither y Nothing = Left y
|
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 -> []
|
|
||||||
|
|
||||||
|
|||||||
@@ -1,2 +1,4 @@
|
|||||||
|
import Test.QuickCheck
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = putStrLn "Test suite not yet implemented"
|
main = putStrLn "Test suite not yet implemented"
|
||||||
|
|||||||
Reference in New Issue
Block a user