Dijkstra's algorithm implemented in Haskell. Example input: 5 7 0 1 2 0 2 7 0 3 6 1 4 6 1 2 3 2 4 5 3 4 1

dijkstra.hs

import Data.List (insert)

fst3 (x,_,_) = x
snd3 (_,x,_) = x
trd3 (_,_,x) = x

toTuple2Int :: String -> (Int, Int)
toTuple2Int s = (read $ takeWhile (/=' ') s :: Int, read $ dropWhile (==' ') $ dropWhile (/=' ') s :: Int)

toTupleTuple2Int :: String -> (Int, (Int, Int))
toTupleTuple2Int s = (read $ takeWhile (/=' ') s :: Int, rest)
  where rest = toTuple2Int $ dropWhile (==' ') $ dropWhile(/=' ') s

replace :: [a] -> (Int, a) -> [a]
replace xs val = take pos xs ++ [snd val] ++ drop (pos + 1) xs
  where pos = fst val

replaceAll :: [a] -> [(Int, a)] -> [a]
replaceAll xs [] = xs
replaceAll xs (x:xss) = replaceAll (replace xs x) xss

insertAll :: (Ord a) => [a] -> [a] -> [a]
insertAll [] xs = xs
insertAll (x:xs) xss = insertAll xs $ insert x xss

addAll2D :: (Ord a) => [(Int, a)] -> [[a]] -> [[a]]
addAll2D [] xs = xs
addAll2D (x:xss) xs = addAll2D xss $ replace xs (fst x, snd x:(xs !! fst x))

swap :: (a, b) -> (b, a)
swap t = (snd t, fst t)

printPath :: (Integral a) => [(a, Int)] -> IO ()
printPath [] = return ()
printPath xs = printPath' xs (length xs - 1)
  where printPath' xs pos
         | pos == -1 = error "Invalid result!"
         | pos == (snd $ (xs !! pos)) = putStr $ show $ snd (xs !! pos)
         | otherwise = do
             printPath' xs $ snd (xs !! pos)
             putStr " -> "
             putStr $ show $ pos

------------------------------ to, dist --- dist -- ret --- dist, node -- dist, ret
dijkstra :: (Integral a) => [[(Int, a)]] -> [a] -> [Int] -> [(a, Int)] -> [(a, Int)]
dijkstra _ dist ret [] = zip dist ret
dijkstra adjList dist ret priorityQueue
 | d /= (dist !! u) = dijkstra adjList dist ret $ tail priorityQueue
 | otherwise = dijkstra adjList newDist newRet newQueue
 where
   front = head priorityQueue
   d = fst front
   u = snd front
   improvedNodes = map (\n -> (fst n, d + snd n)) $ filter (\n -> (d + snd n) < (dist !! fst n)) (adjList !! u)
   newDist = replaceAll dist improvedNodes
   newRet = replaceAll ret $ map (\n -> (fst n, u)) improvedNodes
   newQueue = insertAll (map swap improvedNodes) $ tail priorityQueue

main = do
    input <- getLine
    let nodeCount = read input :: Int
    let adjList = take nodeCount $ repeat [] :: [[(Int, Int)]]

    input <- getLine
    let edgeCount = read input :: Int
    edgeLines <- sequence $ take edgeCount $ repeat getLine
    let edges = map (toTupleTuple2Int) edgeLines

    let result = dijkstra (addAll2D edges adjList) (0:(take (nodeCount - 1) $ repeat 9999999999)) (0:(take (nodeCount - 1) $ repeat (-1))) [(0, 0)]
    putStrLn $ show result
    putStr "Distance to last: "
    putStrLn $ show $ fst $ last result
    printPath result
    putStrLn ""