Initial data commit

Task/Floyd-Warshall-algorithm/Haskell/floyd-warshall-algorithm-1.hs

@@ -0,0 +1,6 @@
+import Control.Monad (join)
+import Data.List (union)
+import Data.Map hiding (foldr, union)
+import Data.Maybe (fromJust, isJust)
+import Data.Semigroup
+import Prelude hiding (lookup, filter)

Task/Floyd-Warshall-algorithm/Haskell/floyd-warshall-algorithm-2.hs

@@ -0,0 +1,2 @@
+data Shortest b a = Shortest { distance :: a, path :: [b] }
+                  deriving Show

Task/Floyd-Warshall-algorithm/Haskell/floyd-warshall-algorithm-3.hs

@@ -0,0 +1,5 @@
+instance (Ord a, Eq b) => Semigroup (Shortest b a) where
+  a <> b = case distance a `compare` distance b of
+    GT -> b
+    LT -> a
+    EQ -> a { path = path a `union` path b }

Task/Floyd-Warshall-algorithm/Haskell/floyd-warshall-algorithm-4.hs

@@ -0,0 +1,10 @@
+floydWarshall v dist = foldr innerCycle (Just <$> dist) v
+  where
+    innerCycle k dist = (newDist <$> v <*> v) `setTo` dist
+      where
+        newDist i j =
+          ((i,j), do a <- join $ lookup (i, k) dist
+                     b <- join $ lookup (k, j) dist
+                     return $ Shortest (distance a <> distance b) (path a))
+
+        setTo = unionWith (<>) . fromList

Task/Floyd-Warshall-algorithm/Haskell/floyd-warshall-algorithm-5.hs

@@ -0,0 +1,7 @@
+buildPaths d = mapWithKey (\pair s -> s { path = buildPath pair}) d
+  where
+    buildPath (i,j)
+      | i == j    = [[j]]
+      | otherwise = do k <- path $ fromJust $ lookup (i,j) d
+                       p <- buildPath (k,j)
+                       [i : p]

Task/Floyd-Warshall-algorithm/Haskell/floyd-warshall-algorithm-6.hs

@@ -0,0 +1,5 @@
+findMinDistances v g =
+  let weights = mapWithKey (\(_,j) w -> Shortest w [j]) g
+      trivial = fromList [ ((i,i), Shortest mempty []) | i <- v ]
+      clean d = fromJust <$> filter isJust (d \\ trivial)
+  in buildPaths $ clean $ floydWarshall v (weights <> trivial)

Task/Floyd-Warshall-algorithm/Haskell/floyd-warshall-algorithm-7.hs

@@ -0,0 +1,5 @@
+g = fromList [((2,1), 4)
+             ,((2,3), 3)
+             ,((1,3), -2)
+             ,((3,4), 2)
+             ,((4,2), -1)]

Task/Floyd-Warshall-algorithm/Haskell/floyd-warshall-algorithm-8.hs

@@ -0,0 +1 @@
+showShortestPaths v g = mapM_ print $ toList $ findMinDistances v g

Task/Floyd-Warshall-algorithm/Haskell/floyd-warshall-algorithm-9.hs

@@ -0,0 +1,4 @@
+g2 = fromList [(('A','S'), 1)
+             ,(('A','D'), -1)
+             ,(('S','E'), 2)
+             ,(('D','E'), 4)]