dijkstra.hs

import System.Environment
import Data.List


type Elemento = String
type Par = (Elemento, Elemento)
type Custo = Int
type Aresta = (Par, Custo)
type Grafo = [Aresta]


-- Entrada

readGrafo :: String -> Grafo
readGrafo texto = [readAresta (words linha) | linha <- lines texto]


readAresta :: [String] -> Aresta
readAresta p | length p >= 3 = ((p !! 0, p !! 1), read (p !! 2))
             | length p == 2 = ((p !! 0, p !! 1), 1)


-- Grafo

elementosDe :: Grafo -> [Elemento]
elementosDe grafo = (nub [x | ((x, y), v) <- grafo]) `union` [y | ((x, y), v) <- grafo]


complemento :: Grafo -> Grafo
complemento grafo = [((y, x), v) | ((x, y), v) <- grafo]


fazerSimetrico :: Grafo -> Grafo
fazerSimetrico grafo = grafo `union` (complemento grafo)


removerLacos :: Grafo -> Grafo
removerLacos grafo = [((x, y), v) | ((x, y), v) <- grafo, x /= y]


removerArestasDuplicadas :: Grafo -> Grafo
removerArestasDuplicadas [] = []
removerArestasDuplicadas grafo = (p, v2):removerArestasDuplicadas diferentes
    where
        ((p, v):xs) = grafo
        (iguais, diferentes) = partition (\n -> fst n == p) grafo
        v2 = minimum [snd i | i <- iguais]


-- BuscaLargura

buscaLargura :: Grafo -> Elemento -> Grafo
buscaLargura arestas d = buscaLargurahelper [] [(d, 1)]
    where
        grafo = nub [p | (p, v) <- arestas]
        buscaLargurahelper res [] = res
        buscaLargurahelper res ((a, s):as) = buscaLargurahelper (res ++ arestas) (as ++ fila)
            where
                eres = d:[x | ((x, y), _) <- res]
                filhos = [x | (x, y) <- grafo, y == a, not (elem x eres)]
                arestas = [((f, a), s) | f <- filhos]
                eas = [e | (e, _) <- as]
                fila = [(f, s + 1) | f <- filhos, not (elem f eas)]


-- Dijkstra

dijkstra :: Grafo -> Elemento -> Grafo
dijkstra grafo destino = concat (reverse [pegarAresta (e, p) | (e, _, _, p) <- dijkstrahelper nos, e /= destino])
    where
        grafosimples = removerArestasDuplicadas (removerLacos grafo)
        fazerNo e | e == destino = (e, True, 0, e)
                  | otherwise    = (e, True, 0, "")
        nos = [fazerNo e | e <- elementosDe grafosimples]
        comparaNos (_, aa, ac, ap) (_, ba, bc, bp) | not ba    = LT
                                                   | not aa    = GT
                                                   | bp == ""  = LT
                                                   | ap == ""  = GT
                                                   | otherwise = compare ac bc
        ordenaNos nos = sortBy comparaNos nos
        dijkstrahelper nos | a         = dijkstrahelper (fechaNo no xs)
                           | otherwise = nos
            where
                (no:xs) = ordenaNos nos
                (_, a, _, _) = no
                fechaNo (e, _, c, p) nos = ligaFilhos (e, False, c, p) nos
                ligaFilhos a nos = a:[liga n | n <- nos]
                    where
                        (ae, _, ac, _) = a
                        liga b | not ba                 = b
                               | length vs == 0         = b
                               | bp /= "" && custo > bc = b
                               | otherwise              = (be, ba, custo, ae)
                            where
                                (be, ba, bc, bp) = b
                                vs = [v | ((x, y), v) <- grafo, x == be, y == ae]
                                custo = ac + (head vs)
        pegarAresta par = [(p, v) | (p, v) <- grafosimples, p == par]


-- Programa

showArestaL :: Aresta -> String
showArestaL ((x, y), s) = "'" ++ x ++ "' -> '" ++ y ++ "'  Saltos: " ++ (show s)


showArestaD :: Aresta -> String
showArestaD ((x, y), v) = "'" ++ x ++ "' -> '" ++ y ++ "'  Custo:  " ++ (show v)


calculaArvores :: Grafo -> Elemento -> [String]
calculaArvores grafo d = ("Árvores de '" ++ d ++ "'"):(concat [saltos, custos]) ++ [""]
    where
        saltos = "Saltos:":["  " ++ showArestaL a | a <- buscaLargura grafo d]
        custos = "Dijkstra":["  " ++ showArestaD a | a <- dijkstra grafo d]


main = do
    destinos <- getArgs
    texto <- getContents
    let grafo = fazerSimetrico (readGrafo texto)
    putStr (unlines (concat[calculaArvores grafo d | d <- destinos]))