diff options
author | Determinant <ted.sybil@gmail.com> | 2017-05-31 17:11:14 -0400 |
---|---|---|
committer | Determinant <ted.sybil@gmail.com> | 2017-05-31 17:11:14 -0400 |
commit | 1a19a80d8c756559e108a46129fac9489ad43d28 (patch) | |
tree | a54021718cee864e30019d8d2af9079522b21e1c /80-89/80.hs | |
parent | 34d130005be780756b9c6915a7c188a756e03882 (diff) |
...
Diffstat (limited to '80-89/80.hs')
-rw-r--r-- | 80-89/80.hs | 51 |
1 files changed, 51 insertions, 0 deletions
diff --git a/80-89/80.hs b/80-89/80.hs new file mode 100644 index 0000000..4dc2956 --- /dev/null +++ b/80-89/80.hs @@ -0,0 +1,51 @@ +import Data.List (sort) + +data Graph a = Graph [a] [(a, a)] + deriving (Show, Eq) + +data Adjacency a = Adj [(a, [a])] + deriving (Show, Eq) + +data Friendly a = Edge [(a, a)] + deriving (Show, Eq) + +graphToAdj :: Eq a => Graph a -> Adjacency a + +graphToAdj (Graph [] _) = Adj [] +graphToAdj (Graph (v:vs) e) = Adj ((v, e >>= pick):l) + where pick (a, b) + | a == v = [b] + | b == v = [a] + | otherwise = [] + Adj l = graphToAdj $ Graph vs e + +adjToGraph :: Eq a => Adjacency a -> Graph a + +adjToGraph (Adj []) = Graph [] [] +adjToGraph (Adj ((u, e):ps)) = Graph (u:us) + ((map (\v -> (u, v)) e) ++ + (filter (\(a, b) -> a /= u && b /= u) es)) + where (Graph us es) = adjToGraph $ Adj ps + +graphToFri :: Eq a => Graph a -> Friendly a + +graphToFri (Graph vs e) = + Edge (e ++ let g = filter (\v -> all (\(a, b) -> v /= a && v /= b) e) vs in + zip g g) + +friToGraph :: Ord a => Friendly a -> Graph a + +friToGraph (Edge es) = Graph vs' (filter (\(a, b) -> a /= b) es') + where unique [] = [] + unique [x] = [x] + unique (x:l@(y:xs)) + | x == y = unique l + | otherwise = x:unique l + es' = unique . sort $ map (\(a, b) -> if a < b then (a, b) else (b, a)) es + vs' = unique . sort $ es' >>= (\(a, b) -> [a, b]) + +adjToFri :: Eq a => Adjacency a -> Friendly a +friToAdj :: Ord a => Friendly a -> Adjacency a + +adjToFri = graphToFri . adjToGraph +friToAdj = graphToAdj . friToGraph |