summaryrefslogtreecommitdiff
path: root/80-89/80.hs
diff options
context:
space:
mode:
Diffstat (limited to '80-89/80.hs')
-rw-r--r--80-89/80.hs51
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