-- I1M: Relación 29
-- Algoritmos sobre grafos
-- Departamento de Ciencias de la Computación e Inteligencia Artificial
-- Universidad de Sevilla
-- ============================================================================
-- ============================================================================
-- Observación
-- ============================================================================
-- Para realizar los ejercicios hay que descargar, en el mismo directorio que
-- el enunciado, el código de los TAD
-- GrafoConVectorDeAdyacencia.hs
-- GrafoConMatrizDeAdyacencia.hs
-- ============================================================================
-- Librerías
-- ============================================================================
import Data.Array
import Data.List
-- Hay que seleccionar una implementación del TAD de los grafos
-- import GrafoConVectorDeAdyacencia
import GrafoConMatrizDeAdyacencia
-- ----------------------------------------------------------------------------
-- Ejemplos de grafos
-- ----------------------------------------------------------------------------
g1,g2 :: Grafo Int Int
g1 = creaGrafo ND (1,6) [(1,2),(1,3),(1,4),(3,6),(5,4),(6,2),(6,5)]
g2 = asignaPesos (creaGrafo D (1,6) [(1,3),(1,5),(3,5),(5,1),(5,5),
(2,4),(2,6),(4,6),(4,4),(6,4)])
[((1,3),2),((1,5),4),((3,5),6),((5,1),8),((5,5),10),
((2,4),1),((2,6),3),((4,6),5),((4,4),7),((6,4),9)]
-- ----------------------------------------------------------------------------
-- Ejercicio 1. En un grafo, la anchura de un nodo es el número de nodos
-- adyacentes; y la anchura del grafo es la máxima anchura de sus nodos.
-- Definir la función
-- anchuraGrafo :: (Ix v,Num p) => Grafo v p -> Int
-- tal que '(anchuraGrafo g)' es la anchura del grafo g. Por ejemplo,
-- anchuraGrafo g1 == 3
-- anchuraGrafo g2 == 2
-- ----------------------------------------------------------------------------
anchuraGrafo :: (Ix v,Num p) => Grafo v p -> Int
anchuraGrafo g = maximum (map (length . (adyacentes g)) (nodos g))
-- ----------------------------------------------------------------------------
-- Ejercicio 2. Definir la función
-- recorridoAnchura :: (Ix v,Num p) => Grafo v p -> v -> [v]
-- tal que '(recorridoAnchura g v)' es el recorrido en anchura del grafo 'g' a
-- partir del nodo 'v'. Por ejemplo,
-- recorridoAnchura g1 1 == [1,2,3,4,6,5]
-- ----------------------------------------------------------------------------
recorridoAnchura :: (Ix v,Num p) => Grafo v p -> v -> [v]
recorridoAnchura g inicial = recorridoAnchuraAux [inicial] []
where recorridoAnchuraAux [] visitados = visitados
recorridoAnchuraAux (p:ps) visitados | elem p visitados = recorridoAnchuraAux ps visitados
| otherwise = recorridoAnchuraAux (ps ++ (adyacentes g p)) (visitados ++ [p])
-- ----------------------------------------------------------------------------
-- Ejercicio 3. Definir la función
-- recorridoProfundidad :: (Ix v,Num p) => Grafo v p -> v -> [v]
-- tal que '(recorridoProfundidad g v)' es el recorrido en profundidad del
-- grafo 'g' a partir del nodo 'v'. Por ejemplo,
-- recorridoProfundidad g1 1 == [1,2,6,3,5,4]
-- ----------------------------------------------------------------------------
recorridoProfundidad :: (Ix v,Num p) => Grafo v p -> v -> [v]
recorridoProfundidad g inicial = recorridoProfundidadAux [inicial] []
where recorridoProfundidadAux [] visitados = visitados
recorridoProfundidadAux (p:ps) visitados | elem p visitados = recorridoProfundidadAux ps visitados
| otherwise = recorridoProfundidadAux ((adyacentes g p) ++ ps) (visitados ++ [p])
-- ----------------------------------------------------------------------------
-- Ejercicio 4. Un camino en un grafo G es una secuencia de nodos [v1,...,vn]
-- tal que entre cada dos de ellos consecutivos hay una arista en G, es decir,
-- (v1,v2), (v2,v3), ..., (vn-1,vn) son aristas. En este caso decimos que el
-- camino pasa por las aristas (v1,v2), (v2,v3), ..., (vn-1,vn).
--
-- Definir la función
-- camino :: (Ix v,Num p) => Grafo v p -> [v] -> Bool
-- tal que '(camino g vs)' se verifica si la lista de nodos 'vs' es un camino
-- en el grafo 'g'. Por ejemplo,
-- camino g1 [1,2,6] == True
-- camino g2 [1,2,6] == False
-- ----------------------------------------------------------------------------
camino :: (Ix v,Num p) => Grafo v p -> [v] -> Bool
camino g vs = all (aristaEn g) (zip vs (tail vs))
-- ----------------------------------------------------------------------------
-- Ejercicio 5. Definir la función
-- caminos :: (Ix v,Num p) => Grafo v p -> v -> v -> [[v]]
-- tal que '(caminos g a b)' es la lista de los caminos en el grafo 'g' desde el
-- nodo 'a' hasta el nodo 'b' sin pasar dos veces por el mismo nodo. Por
-- ejemplo,
-- caminos g1 1 5 ==
-- [[1,2,6,5],[1,3,6,5],[1,4,5]]
-- caminos g2 1 5 ==
-- [[1,3,5],[1,5]]
-- ----------------------------------------------------------------------------
caminos :: (Ix v,Num p) => Grafo v p -> v -> v -> [[v]]
caminos g vi vf = caminosAux [vi] []
where caminosAux camino ac | last camino == vf = camino:ac
| otherwise = concat [caminosAux (camino ++ [x]) ac | x <- adyacentes g (last camino),
not (elem x camino)]
-- ----------------------------------------------------------------------------
-- Ejercicio 6. Un ciclo en un grafo G, es un camino [v1,v2,...,vn] en G,
-- tal que v1 = vn y no hay ninguna otra repetición.
--
-- Definir la función
-- esCiclo :: (Ix v,Num p) => Grafo v p -> [v] -> Bool
-- tal que '(esCiclo g vs)' se verifica si la lista de nodos 'vs' es un ciclo
-- en el grafo 'g'. Por ejemplo,
-- esCiclo g1 [1,2,1] == True
-- esCiclo g1 [1,2,3] == False
-- esCiclo g1 [1,2,4,1] == False
-- esCiclo g2 [1,3,5,1] == True
-- ----------------------------------------------------------------------------
esCiclo :: (Ix v,Num p) => Grafo v p -> [v] -> Bool
esCiclo g vs = (camino g (init vs)) && ((head vs) == (last vs)) && ((nub (tail vs)) == (tail vs))
-- ----------------------------------------------------------------------------
-- Ejercicio 7. Definir la función
-- ciclos :: (Ix v,Num p) => Grafo v p -> v -> [[v]]
-- tal que '(ciclos g v)' es la lista de los ciclos en el grafo 'g' que
-- empiezan y terminan en el nodo 'v'. Por ejemplo,
-- ciclos g1 1 ==
-- [[1,2,1],[1,2,6,3,1],[1,2,6,5,4,1],[1,3,1],[1,3,6,5,4,1],[1,4,1]]
-- ciclos g1 2 == [[2,1,2],[2,1,3,6,2],[2,1,4,5,6,2],[2,6,2]]
-- ciclos g2 1 == [[1,3,5,1],[1,5,1]]
-- ciclos g2 2 == []
-- ----------------------------------------------------------------------------
ciclos :: (Ix v,Num p) => Grafo v p -> v -> [[v]]
ciclos g v = ciclosAux [v] []
where ciclosAux camino ac | (last camino == v) && (length camino > 1) = camino:ac
| otherwise = concat [ciclosAux (camino ++ [x]) ac | x <- adyacentes g (last camino),
not (elem x (tail camino))]
-- ----------------------------------------------------------------------------
-- Ejercicio 8. Definir la función
-- contieneCiclo :: (Ix v,Num p) => Grafo v p -> Int -> Bool
-- tal que '(contieneCiclo g n)' se verifica si el grafo 'g' contiene algún
-- ciclo de orden 'n'. Por ejemplo,
-- contieneCiclo g1 3 == False
-- contieneCiclo g1 4 == True
-- ----------------------------------------------------------------------------
contieneCiclo :: (Ix v,Num p) => Grafo v p -> Int -> Bool
contieneCiclo g n = any ((==(n+1)) . length) (concat (map (ciclos g) (nodos g)))
-- ----------------------------------------------------------------------------
-- Ejercicio 9. Definir la función
-- conectados :: (Ix v,Num p) => Grafo v p -> v -> v -> Bool
-- tal que '(conectados g v1 v2)' se verifica si existe un camino en 'g' que va
-- de 'v1' a 'v2'. Por ejemplo,
-- conectados g1 1 3 == True
-- conectados g1 1 4 == True
-- conectados g2 2 5 == False
-- conectados g2 2 6 == True
-- conectados g2 6 2 == False
-- ----------------------------------------------------------------------------
conectados :: (Ix v,Num p) => Grafo v p -> v -> v -> Bool
conectados g v1 v2 = not (null (caminos g v1 v2))
-- ----------------------------------------------------------------------------
-- Ejercicio 10. Dado un grafo G, diremos que un nodo está aislado si no está
-- en ninguna de sus aristas.
--
-- Definir la función
-- aislados :: (Ix v, Num p) => Grafo v p -> [v]
-- tal que '(aislados g)' es la lista de nodos aislados del grafo 'g'. Por
-- ejemplo,
-- aislados (creaGrafo D (1,5) [(1,3),(3,5)]) == [2,4]
-- aislados (creaGrafo D (1,4) [(1,2),(3,2)]) == [4]
-- ----------------------------------------------------------------------------
aislados :: (Ix v, Num p) => Grafo v p -> [v]
aislados g = filter (\ x -> not (any (\ (v1,v2) -> v1 == x || v2 == x) (aristas g))) (nodos g)
-- ----------------------------------------------------------------------------
-- Ejercicio 11. Un grafo G se dice conexo, si todo par de vértices de G están
-- conectados por un camino.
--
-- Definir la función
-- conexo :: (Ix v, Num p) => Grafo v p -> Bool
-- tal que '(conexo g)' se verifica si el grafo 'g' es conexo. Por ejemplo,
-- conexo (creaGrafo ND (1,3) [(1,2),(3,2)]) == True
-- conexo (creaGrafo ND (1,4) [(1,2),(3,4)]) == False
-- ----------------------------------------------------------------------------
conexo :: (Ix v, Num p) => Grafo v p -> Bool
conexo g = all (\ (v1,v2) -> conectados g v1 v2) [(v1,v2) | v1 <- nodos g, v2 <- nodos g]
-- ----------------------------------------------------------------------------
-- Ejercicio 12. Un camino euleriano en un grafo G es un camino en G que pasa
-- por todas las aristas una única vez.
--
-- Definir la función
-- caminoEuleriano :: (Ix v, Num p) => Grafo v p -> [v] -> Bool
-- tal que '(caminoEuleriano g vs)' se verifica si la lista de nodos 'vs' es un
-- camino euleriano en el grafo 'g'. Por ejemplo,
-- caminoEuleriano (creaGrafo ND (1,3) [(1,2),(2,3),(1,3)]) [1,2,3,1] ==
-- True
-- caminoEuleriano (creaGrafo ND (1,3) [(1,2),(2,3),(1,3)]) [1,2,3,2] ==
-- False
-- caminoEuleriano (creaGrafo ND (1,3) [(1,2),(2,3),(1,3)]) [1,2,3] ==
-- False
-- caminoEuleriano (creaGrafo ND (1,3) [(1,2),(2,3),(1,3)]) [1,2,3,1,2] ==
-- False
-- caminoEuleriano (creaGrafo D (1,3) [(1,2),(2,3),(1,3)]) [1,2,3,1] ==
-- False
-- caminoEuleriano (creaGrafo D (1,3) [(1,2),(2,3),(3,1)]) [1,2,3,1] ==
-- True
-- caminoEuleriano (creaGrafo D (1,3) [(1,2),(2,3),(3,1)]) [1,2,3] ==
-- False
-- caminoEuleriano (creaGrafo D (1,3) [(1,2),(2,3),(3,1)]) [1,2,3,1,2] ==
-- False
-- ----------------------------------------------------------------------------
caminoEuleriano :: (Ix v, Num p) => Grafo v p -> [v] -> Bool
caminoEuleriano g vs | dirigido g = (nub aristasCamino == aristasCamino) &&
(all (aristaEn g) aristasCamino) &&
length (aristas g) == length (aristasCamino)
| otherwise = compruebaDuplicadas aristasCamino &&
(all (aristaEn g) aristasCamino) &&
length (aristas g) == (length (aristasCamino)) * 2
where aristasCamino = zip vs (tail vs)
compruebaDuplicadas [] = True
compruebaDuplicadas ((v1,v2):as) = notElem (v1,v2) as &&
notElem (v2,v1) as &&
compruebaDuplicadas as
-- ----------------------------------------------------------------------------
-- Ejercicio 13. Un camino hamiltoniano en un grafo G es un camino en G que
-- pasa por todos los vértices una única vez.
--
-- Definir la función
-- caminoHamiltoniano :: (Ix v, Num p) => Grafo v p -> [v] -> Bool
-- tal que '(caminoHamiltoniano g vs)' se verifica si la lista de nodos 'vs' es
-- un camino hamiltoniano en el grafo 'g'. Por ejemplo,
-- caminoHamiltoniano (creaGrafo ND (1,3) [(1,2),(2,3),(1,3)]) [1,2,3] ==
-- True
-- caminoHamiltoniano (creaGrafo ND (1,3) [(1,2),(2,3),(1,3)]) [1,2] ==
-- False
-- caminoHamiltoniano (creaGrafo ND (1,3) [(1,2),(2,3),(1,3)]) [1,2,3,1] ==
-- False
-- caminoHamiltoniano (creaGrafo D (1,3) [(1,2),(2,3),(1,3)]) [1,2,3] ==
-- True
-- caminoHamiltoniano (creaGrafo D (1,3) [(1,2),(2,3),(1,3)]) [1,3,2] ==
-- False
-- ----------------------------------------------------------------------------
caminoHamiltoniano :: (Ix v, Num p) => Grafo v p -> [v] -> Bool
caminoHamiltoniano g vs = (nub vs == vs) &&
length vs == length (nodos g) &&
all (\ v -> elem v vs) (nodos g) &&
(all (aristaEn g) aristasCamino)
where aristasCamino = zip vs (tail vs)
-- ----------------------------------------------------------------------------
-- Ejercicio 14. Definir la función
-- costeCamino :: (Ix v,Num p) => Grafo v p -> [v] -> p
-- tal que '(costeCamino g vs)' es la suma de los pesos de las aristas del
-- camino 'vs' en el grafo 'g'. Por ejemplo,
-- costeCamino g2 [1,3,5,1] == 16
-- ----------------------------------------------------------------------------
costeCamino :: (Ix v,Num p) => Grafo v p -> [v] -> p
costeCamino g vs = sum (map (peso g) (zip vs (tail vs)))
-- ----------------------------------------------------------------------------
-- Ejercicio 15. La matriz de adyacencia de un grafo G es una matriz cuadrada
-- cuyos índices de fila y columna se corresponden con los índices de los nodos
-- de G y que en cada entrada tiene almacenado el peso de la arista
-- correspondiente en G (si es que existe).
--
-- Definir la función
-- matrizAdyacencia :: (Ix v, Num p) => Grafo v p -> Array (v,v) (Maybe p)
-- tal que '(matrizAdyacencia g)' es la matriz de adyacencia del grafo 'g', de
-- forma que para cada arista de 'g' con peso 'p', el valor de la entrada
-- correspondiente en la matriz de adyacencia es 'Just p' y las entradas de la
-- matriz de adyacencia que no se correspondan con aristas de 'g' toman el
-- valor 'Nothing'. Por ejemplo,
-- matrizAdyacencia (asignaPesos (creaGrafo D (1,3) [(1,2),(1,3)])
-- [((1,2),4),((1,3),5)]) ==
-- array ((1,1),(3,3)) [((1,1),Nothing), ((1,2),Just 4), ((1,3),Just 5),
-- ((2,1),Nothing),((2,2),Nothing),((2,3),Nothing),
-- ((3,1),Nothing),((3,2),Nothing),((3,3),Nothing)]
-- ----------------------------------------------------------------------------
matrizAdyacencia :: (Ix v, Num p) => Grafo v p -> Array (v,v) (Maybe p)
matrizAdyacencia g = listArray ((v1,v1),(v2,v2)) [ponPeso i j | i <- nodos g, j <- nodos g]
where v1 = minimum (nodos g)
v2 = maximum (nodos g)
ponPeso i j | aristaEn g (i,j) = Just (peso g (i,j))
| otherwise = Nothing
-- ============================================================================
-- Problema: Arbol de expansión mínimo de un grafo
-- ============================================================================
-- ----------------------------------------------------------------------------
-- Dado G = (V,A) un grafo no dirigido y ponderado con pesos no negativos, un
-- árbol de expansión mínima de G es un subgrafo de G, G' = (V,A'), que conecta
-- todos los vértices de G de forma que la suma total del peso de las aristas
-- de A' es mínima.
--
-- Consideremos el grafo:
--
-- +-+ +-+ +-+
-- |1|--1--|2|--2--|3|
-- +-+ +-+ +-+
-- | / | / |
-- | / | / |
-- 4 6 4 5 6
-- | / | / |
-- | / | / |
-- +-+ +-+ +-+
-- |4|--3--|5|--8--|6|
-- +-+ +-+ +-+
-- | / | / |
-- | / | / |
-- 4 7 3 2 5
-- | / | / |
-- | / | / |
-- +-+ +-+ +-+
-- |7|--1--|8|--6--|9|
-- +-+ +-+ +-+
--
-- Un árbol de expansión mínima de este grafo es:
--
-- +-+ +-+ +-+
-- |1|--1--|2|--2--|3|
-- +-+ +-+ +-+
-- |
-- |
-- 4
-- |
-- |
-- +-+ +-+ +-+
-- |4|--3--|5| |6|
-- +-+ +-+ +-+
-- | / |
-- | / |
-- 3 2 5
-- | / |
-- | / |
-- +-+ +-+ +-+
-- |7|--1--|8| |9|
-- +-+ +-+ +-+
g = asignaPesos (creaGrafo ND (1,9) [(1,2),(2,3),(1,4),(2,4),
(2,5),(3,5),(3,6),(4,5),
(5,6),(4,7),(5,7),(5,8),
(6,8),(6,9),(7,8),(8,9)])
[((1,2),1),((2,3),2),((1,4),4),((2,4),6),
((2,5),4),((3,5),5),((3,6),6),((4,5),3),
((5,6),8),((4,7),4),((5,7),7),((5,8),3),
((6,8),2),((6,9),5),((7,8),1),((8,9),6)]
-- ----------------------------------------------------------------------------
-- Algoritmo de Kruskal
-- ----------------------------------------------------------------------------
--
-- El algoritmo de Kruskal es un algoritmo para determinar el árbol de
-- expansión mínima de un grafo G. Funciona de la siguiente manera:
-- - Sea C el conjunto de los conjuntos unitarios de vértices sin conectar
-- - Sea A el conjunto de las aristas de G ordenadas por peso
-- - Mientras que C no sea unitario o A tenga elementos
-- - Sea ((v1,v2),p) la primera arista de A
-- - Si v1 y v2 están en el mismo elemento de C (ya están conectados), se
-- descarta la arista y se continúa
-- - Si v1 y v2 no están en el mismo elemento de C (no están conectados), se
-- escoge la arista; se unen los elementos de C que contienen a v1 y a v2;
-- y se continúa
--
-- En el grafo que se ha proporcionado como ejemplo el algoritmo funciona de la
-- siguiente forma:
-- - C = {{1},{2},{3},{4},{5},{6},{7},{8},{9}}
-- A = {((1,2),1),((7,8),1),((2,3),2),((6,8),2),((4,5),3),((5,8),3),
-- ((1,4),4),((2,5),4),((4,7),4),((3,5),5),((6,9),5),((2,4),6),
-- ((3,6),6),((8,9),6),((5,7),7),((5,6),8)}
-- - Se considera la arista ((1,2),1), 1 y 2 no están en el mismo elemento de C
-- C = {{1,2},{3},{4},{5},{6},{7},{8},{9}}
-- A = {((7,8),1),((2,3),2),((6,8),2),((4,5),3),((5,8),3),((1,4),4),
-- ((2,5),4),((4,7),4),((3,5),5),((6,9),5),((2,4),6),((3,6),6),
-- ((8,9),6),((5,7),7),((5,6),8)}
-- La arista ((1,2),1) se escoge
-- - Se considera la arista ((7,8),1), 7 y 8 no están en el mismo elemento de C
-- C = {{1,2},{3},{4},{5},{6},{7,8},{9}}
-- A = {((2,3),2),((6,8),2),((4,5),3),((5,8),3),((1,4),4),((2,5),4),
-- ((4,7),4),((3,5),5),((6,9),5),((2,4),6),((3,6),6),((8,9),6),
-- ((5,7),7),((5,6),8)}
-- La arista ((7,8),1) se escoge
-- - Se considera la arista ((2,3),2), 2 y 3 no están en el mismo elemento de C
-- C = {{1,2,3},{4},{5},{6},{7,8},{9}}
-- A = {((6,8),2),((4,5),3),((5,8),3),((1,4),4),((2,5),4),((4,7),4),
-- ((3,5),5),((6,9),5),((2,4),6),((3,6),6),((8,9),6),((5,7),7),
-- ((5,6),8)}
-- La arista ((2,3),2) se escoge
-- - Se considera la arista ((6,8),2), 6 y 8 no están en el mismo elemento de C
-- C = {{1,2,3},{4},{5},{6,7,8},{9}}
-- A = {((4,5),3),((5,8),3),((1,4),4),((2,5),4),((4,7),4),((3,5),5),
-- ((6,9),5),((2,4),6),((3,6),6),((8,9),6),((5,7),7),((5,6),8)}
-- La arista ((6,8),2) se escoge
-- - Se considera la arista ((4,5),3), 4 y 5 no están en el mismo elemento de C
-- C = {{1,2,3},{4,5},{6,7,8},{9}}
-- A = {((5,8),3),((1,4),4),((2,5),4),((4,7),4),((3,5),5),((6,9),5),
-- ((2,4),6),((3,6),6),((8,9),6),((5,7),7),((5,6),8)}
-- La arista ((4,5),3) se escoge
-- - Se considera la arista ((5,8),3), 5 y 8 no están en el mismo elemento de C
-- C = {{1,2,3},{4,5,6,7,8},{9}}
-- A = {((1,4),4),((2,5),4),((4,7),4),((3,5),5),((6,9),5),((2,4),6),
-- ((3,6),6),((8,9),6),((5,7),7),((5,6),8)}
-- La arista ((5,8),3) se escoge
-- - Se considera la arista ((1,4),4), 1 y 4 no están en el mismo elemento de C
-- C = {{1,2,3,4,5,6,7,8},{9}}
-- A = {((2,5),4),((4,7),4),((3,5),5),((6,9),5),((2,4),6),((3,6),6),
-- ((8,9),6),((5,7),7),((5,6),8)}
-- La arista ((1,4),4) se escoge
-- - Se considera la arista ((2,5),4), 2 y 5 están en el mismo elemento de C
-- C = {{1,2,3,4,5,6,7,8},{9}}
-- A = {((4,7),4),((3,5),5),((6,9),5),((2,4),6),((3,6),6),((8,9),6),
-- ((5,7),7),((5,6),8)}
-- La arista ((2,5),4) se descarta
-- - Se considera la arista ((4,7),4), 4 y 7 están en el mismo elemento de C
-- C = {{1,2,3,4,5,6,7,8},{9}}
-- A = {((3,5),5),((6,9),5),((2,4),6),((3,6),6),((8,9),6),((5,7),7),
-- ((5,6),8)}
-- La arista ((4,7),4) se descarta
-- - Se considera la arista ((3,5),5), 3 y 5 están en el mismo elemento de C
-- C = {{1,2,3,4,5,6,7,8},{9}}
-- A = {((6,9),5),((2,4),6),((3,6),6),((8,9),6),((5,7),7),((5,6),8)}
-- La arista ((3,5),5) se descarta
-- - Se considera la arista ((6,9),5), 6 y 9 no están en el mismo elemento de C
-- C = {{1,2,3,4,5,6,7,8,9}}
-- A = {((2,4),6),((3,6),6),((8,9),6),((5,7),7),((5,6),8)}
-- La arista ((6,9),5) se escoge
-- - El conjunto C es unitario y el algoritmo termina
--
-- El árbol de expansión mínima es el formado por las aristas:
-- {((1,2),1),((7,8),1),((2,3),2),((6,8),2),
-- ((4,5),3),((5,8),3),((1,4),4),((6,9),5)}
-- ----------------------------------------------------------------------------
-- ----------------------------------------------------------------------------
-- Problema: Definir la función
-- arbolExpansionMinimaKruskal :: (Ix v,Num p,Ord p) =>
-- Grafo v p -> Grafo v p
-- tal que '(arbolExpansionMinimaKruskal g)' es el árbol de expansión mínima
-- del grafo 'g' (no dirigido y ponderado con pesos no negativos) obtenido con
-- el algoritmo de Kruskal. Por ejemplo,
-- arbolExpansionMinimaKruskal g ==
-- G[ND] N:{1,2,3,4,5,6,7,8,9}
-- A:{(1,2)[1],(1,4)[4],(2,1)[1],(2,3)[2],(3,2)[2],(4,1)[4],
-- (4,5)[3],(5,4)[3],(5,8)[3],(6,8)[2],(6,9)[5],(7,8)[1],
-- (8,5)[3],(8,6)[2],(8,7)[1],(9,6)[5]}
-- ----------------------------------------------------------------------------
arbolExpansionMinimaKruskal :: (Ix v,Num p,Ord p) => Grafo v p -> Grafo v p
arbolExpansionMinimaKruskal g = asignaPesos
(creaGrafo ND (v1,v2)
(kruskal
(map (:[]) (nodos g))
(sort (map (\ (v,w) -> (peso g (v,w),(v,w))) (aristas g)))))
[((v,w),peso g (v,w)) | (v,w) <- aristas g]
where v1 = minimum (nodos g)
v2 = maximum (nodos g)
kruskal :: (Ix v,Num p,Ord p) => [[v]] -> [(p,(v,v))] -> [(v,v)]
kruskal c a | length c == 1 = []
| uneDistintasComponentes c (head a) = (snd (head a)):(kruskal (uneComponentes c (head a)) (tail a))
| otherwise = kruskal c (tail a)
uneComponentes :: (Ix v,Num p,Ord p) => [[v]] -> (p,(v,v)) -> [[v]]
uneComponentes c (_,(v,w)) | i < j = (c1 ++ c2):(elimina (elimina c j) i)
| otherwise = (c1 ++ c2):(elimina (elimina c i) j)
where i = buscaComponente c v
j = buscaComponente c w
c1 = c !! i
c2 = c !! j
uneDistintasComponentes :: (Ix v,Num p,Ord p) => [[v]] -> (p,(v,v)) -> Bool
uneDistintasComponentes c (_,(v,w)) = i /= j
where i = buscaComponente c v
j = buscaComponente c w
buscaComponente :: (Ix v) => [[v]] -> v -> Int
buscaComponente [] v = 0
buscaComponente (c:cs) v | elem v c = 0
| otherwise = 1 + (buscaComponente cs v)
elimina :: (Ix v) => [[v]] -> Int -> [[v]]
elimina [] _ = []
elimina (c:cs) 0 = cs
elimina (c:cs) i = c:(elimina cs (i-1))
-- ----------------------------------------------------------------------------
-- Algoritmo de Prim
-- ----------------------------------------------------------------------------
--
-- El algoritmo de Prim es un algoritmo para determinar el árbol de expansión
-- mínima de un grafo G. Funciona de la siguiente manera:
-- - Sea C el conjunto unitario formado por un vértice de G
-- - Sea A el conjunto de las aristas de G
-- - Mientras que A tenga aristas con un único extremo en C
-- - Sea ((v1,v2),p) la arista de A de menor peso con un único extremo (v1)
-- en el conjunto C
-- - Añadimos el vértice v2 a C
-- - Eliminamos de A todas las aristas que tengan los dos extremos en el
-- nuevo C
--
-- En el grafo que se ha proporcionado como ejemplo el algoritmo funciona de la
-- siguiente forma:
--
-- - C = {1}
-- A = {((1,2),1),((7,8),1),((2,3),2),((6,8),2),((4,5),3),((5,8),3),
-- ((1,4),4),((2,5),4),((4,7),4),((3,5),5),((6,9),5),((2,4),6),
-- ((3,6),6),((8,9),6),((5,7),7),((5,6),8)}
-- - Se considera la arista ((1,2),1), 1 está en C pero 2 no
-- C = {1,2}
-- A = {((7,8),1),((2,3),2),((6,8),2),((4,5),3),((5,8),3),((1,4),4),
-- ((2,5),4),((4,7),4),((3,5),5),((6,9),5),((2,4),6),((3,6),6),
-- ((8,9),6),((5,7),7),((5,6),8)}
-- - Se considera la arista ((2,3),2), 2 está en C pero 3 no
-- C = {1,2,3}
-- A = {((7,8),1),((6,8),2),((4,5),3),((5,8),3),((1,4),4),((2,5),4),
-- ((4,7),4),((3,5),5),((6,9),5),((2,4),6),((3,6),6),((8,9),6),
-- ((5,7),7),((5,6),8)}
-- - Se considera la arista ((1,4),4), 1 está en C pero 4 no
-- C = {1,2,3,4}
-- A = {((7,8),1),((6,8),2),((4,5),3),((5,8),3),((2,5),4),((4,7),4),
-- ((3,5),5),((6,9),5),((3,6),6),((8,9),6),((5,7),7),((5,6),8)}
-- - Se considera la arista ((4,5),3), 4 está en C pero 5 no
-- C = {1,2,3,4,5}
-- A = {((7,8),1),((6,8),2),((5,8),3),((4,7),4),((6,9),5),((3,6),6),
-- ((8,9),6),((5,7),7),((5,6),8)}
-- - Se considera la arista ((5,8),3), 5 está en C pero 8 no
-- C = {1,2,3,4,5,8}
-- A = {((7,8),1),((6,8),2),((4,7),4),((6,9),5),((3,6),6),((8,9),6),
-- ((5,7),7),((5,6),8)}
-- - Se considera la arista ((7,8),1), 8 está en C pero 7 no
-- C = {1,2,3,4,5,8,7}
-- A = {((6,8),2),((6,9),5),((3,6),6),((8,9),6),((5,6),8)}
-- - Se considera la arista ((6,8),2), 8 está en C pero 6 no
-- C = {1,2,3,4,5,8,7,6}
-- A = {((6,9),5),((8,9),6)}
-- - Se considera la arista ((6,9),5), 6 está en C pero 9 no
-- C = {1,2,3,4,5,8,7,6,9}
-- A = {}
--
-- El árbol de expansión mínima es el formado por las aristas:
-- {((1,2),1),((2,3),2),((1,4),4),((4,5),3),
-- ((5,8),3),((7,8),1),((6,8),2),((6,9),5)}
-- ----------------------------------------------------------------------------
-- ----------------------------------------------------------------------------
-- Problema: Definir la función
-- arbolExpansionMinimaPrim :: (Ix v,Num p,Ord p) =>
-- Grafo v p -> Grafo v p
-- tal que '(arbolExpansionMinimaPrim g)' es el árbol de expansión mínima
-- del grafo 'g' (no dirigido y ponderado con pesos no negativos) obtenido con
-- el algoritmo de Prim. Por ejemplo,
-- arbolExpansionMinimaPrim g ==
-- G[ND] N:{1,2,3,4,5,6,7,8,9}
-- A:{(1,2)[1],(1,4)[4],(2,1)[1],(2,3)[2],(3,2)[2],(4,1)[4],
-- (4,5)[3],(5,4)[3],(5,8)[3],(6,8)[2],(6,9)[5],(7,8)[1],
-- (8,5)[3],(8,6)[2],(8,7)[1],(9,6)[5]}
-- ----------------------------------------------------------------------------
arbolExpansionMinimaPrim :: (Ix v,Num p,Ord p) => Grafo v p -> Grafo v p
arbolExpansionMinimaPrim g = asignaPesos
(creaGrafo ND (v1,v2)
(prim
(length (nodos g))
[head (nodos g)]
(sort (map (\ (v,w) -> (peso g (v,w),(v,w))) (aristas g)))))
[((v,w),peso g (v,w)) | (v,w) <- aristas g]
where v1 = minimum (nodos g)
v2 = maximum (nodos g)
prim :: (Ix v,Num p,Ord p) => Int -> [v] -> [(p,(v,v))] -> [(v,v)]
prim total vertices aristas | length vertices == total = []
| otherwise = aristaCandidata:(prim total (nuevoVertice:vertices) aristas)
where aristaCandidata = (snd (head (filter condicionPrim aristas)))
nuevoVertice = snd aristaCandidata
condicionPrim (_,(v,w)) = elem v vertices && notElem w vertices
-- ============================================================================
-- Problema: Búsqueda del camino de menor coste
-- ============================================================================
-- ----------------------------------------------------------------------------
-- Algoritmo de Dijkstra
-- ----------------------------------------------------------------------------
--
-- El algoritmo de Dijkstra es un algoritmo para calcular en un grafo ponderado
-- el camino de menor coste de un nodo dado al resto de los nodos. Es un
-- algoritmo que se aplica sobre grafos, tanto dirigidos como no dirigidos,
-- ponderados con pesos positivos, aunque nosotros lo desarrollaremos para
-- grafos dirigidos.
--
-- La idea consiste en ir explorando todos los caminos que parten del nodo dado
-- y que llevan a todos los demás nodos; cuando se obtiene el camino de menor
-- coste desde el nodo dado al resto de nodos que componen el grafo, el
-- algoritmo se detiene.
--
-- Teniendo un grafo dirigido ponderado G con N nodos no aislados, sea 'a' el
-- nodo dado, una lista D de tamaño N guardará al final del algoritmo los
-- costes mínimos de los caminos que van desde el nodo 'a' al resto de los
-- nodos. El algoritmo funciona de la siguiente manera:
-- - Inicializar todos los costes en D con un valor infinito relativo, ya
-- que son desconocidos al principio, exceptuando la de 'a' que debe ser 0,
-- debido a que éste es el coste del camino de 'a' a 'a' (camino vacío).
-- - Sea C el conjunto de los nodos de G.
-- - Mientras que C tenga elementos
-- - Escogemos el elemento v de C con menor coste mínimo almacendado en D.
-- - Eliminamos el nodo v de C.
-- - Recorremos todos los nodos adyacentes a v que todavía estén en C
-- - Para cada uno de estos nodos w, actualizamos el coste mínimo del nodo
-- inicial a w almacenado en D de la siguiente forma: Si la suma entre el
-- coste mínimo almacenado en D para el nodo v, más el peso de la arista
-- que une v con w es menor que el coste mínimo almacenado en D para el
-- nodo w, entonces cambiamos el valor del coste mínimo almacenado en D
-- para el nodo w por dicha suma. En caso contrario el coste mínimo
-- almacenado en D para el nodo w no cambia.
--
-- Una vez terminado al algoritmo, D contendrá los costes mínimos de los
-- caminos para llegar desde el nodo dado hasta el resto de los nodos.
--
-- En el grafo que se ha proporcionado como ejemplo el algoritmo funciona de la
-- siguiente forma:
--
-- - D = {(1,0),(2,inf),(3,inf),(4,inf),(5,inf),
-- (6,inf),(7,inf),(8,inf),(9,inf)}
-- C = {1,2,3,4,5,6,7,8,9}
-- v = 1
-- Nodos adyacentes a v: {2,4}
-- D(1) + p(1,2) = 0 + 1 < inf = D(2)
-- D(1) + p(1,4) = 0 + 4 < inf = D(4)
-- - D = {(1,0),(2,1),(3,inf),(4,4),(5,inf),(6,inf),(7,inf),(8,inf),(9,inf)}
-- C = {2,3,4,5,6,7,8,9}
-- v = 2
-- Nodos adyacentes a v: {1,3,4,5}
-- D(2) + p(2,3) = 1 + 2 < inf = D(3)
-- D(2) + p(2,4) = 1 + 6 > 4 = D(4)
-- D(2) + p(2,5) = 1 + 4 < inf = D(5)
-- - D = {(1,0),(2,1),(3,3),(4,4),(5,5),(6,inf),(7,inf),(8,inf),(9,inf)}
-- C = {3,4,5,6,7,8,9}
-- v = 3
-- Nodos adyacentes a v: {2,5,6}
-- D(3) + p(3,5) = 3 + 5 > 5 = D(5)
-- D(3) + p(3,6) = 3 + 6 < inf = D(6)
-- - D = {(1,0),(2,1),(3,3),(4,4),(5,5),(6,9),(7,inf),(8,inf),(9,inf)}
-- C = {4,5,6,7,8,9}
-- v = 4
-- Nodos adyacentes a v: {1,2,5,7}
-- D(4) + p(4,5) = 4 + 3 > 5 = D(5)
-- D(4) + p(4,7) = 4 + 4 < inf = D(7)
-- - D = {(1,0),(2,1),(3,3),(4,4),(5,5),(6,9),(7,8),(8,inf),(9,inf)}
-- C = {5,6,7,8,9}
-- v = 5
-- Nodos adyacentes a v: {2,3,4,6,7,8}
-- D(5) + p(5,6) = 5 + 8 > 9 = D(6)
-- D(5) + p(5,7) = 5 + 7 > 8 = D(7)
-- D(5) + p(5,8) = 5 + 3 < inf = D(8)
-- - D = {(1,0),(2,1),(3,3),(4,4),(5,5),(6,9),(7,8),(8,8),(9,inf)}
-- C = {6,7,8,9}
-- v = 7
-- Nodos adyacentes a v: {4,5,8}
-- D(7) + p(7,8) = 8 + 1 < 8 = D(8)
-- - D = {(1,0),(2,1),(3,3),(4,4),(5,5),(6,9),(7,8),(8,8),(9,inf)}
-- C = {6,8,9}
-- v = 8
-- Nodos adyacentes a v: {5,6,7,9}
-- D(8) + p(8,6) = 8 + 2 > 9 = D(6)
-- D(8) + p(8,9) = 8 + 6 < inf = D(9)
-- - D = {(1,0),(2,1),(3,3),(4,4),(5,5),(6,9),(7,8),(8,8),(9,14)}
-- C = {6,9}
-- v = 6
-- Nodos adyacentes a v: {3,5,8,9}
-- D(6) + p(6,9) = 9 + 5 = 14 = D(9)
-- - D = {(1,0),(2,1),(3,3),(4,4),(5,5),(6,9),(7,8),(8,8),(9,14)}
-- C = {9}
-- v = 9
-- Nodos adyacentes a v: {6,8}
--
-- Los costes de los caminos más cortos para llegar desde el nodo 1 hasta todos
-- los demás son:
-- {(1,0),(2,1),(3,3),(4,4),(5,5),(6,9),(7,8),(8,8),(9,14)}
-- ----------------------------------------------------------------------------
-- ----------------------------------------------------------------------------
-- Problema: Definir la función
-- costesCaminosMinimosDijkstra :: (Ix v,Num p,Ord p) =>
-- Grafo v p -> v -> [(v,p)]
-- tal que '(costesCaminosMinimosDijkstra g v)' es una lista con los costes de
-- los caminos mínimos en el grafo 'g' para ir desde el nodo 'v' hasta todos
-- los demás. Por ejemplo,
-- costesCaminosMinimosDijkstra g 1 ==
-- [(1,0),(2,1),(3,3),(4,4),(5,5),(6,9),(7,8),(8,8),(9,14)]
-- ----------------------------------------------------------------------------
costesCaminosMinimosDijkstra :: (Ix v,Num p,Ord p) => Grafo v p -> v -> [(v,p)]
costesCaminosMinimosDijkstra g inicial = dijkstra g d (nodos g)
where m = sum [peso g (v,w) | (v,w) <- aristas g]
d = [(v,if v == inicial then 0 else m) | v <- nodos g]
dijkstra :: (Ix v,Num p,Ord p) => Grafo v p -> [(v,p)] -> [v] -> [(v,p)]
dijkstra g d c | null c = d
| otherwise = dijkstra g (actualizaDistancias g d actual) (eliminaVertice c actual)
where actual = minimoVertice d c
actualizaDistancias :: (Ix v,Num p,Ord p) => Grafo v p -> [(v,p)] -> v -> [(v,p)]
actualizaDistancias g d actual = map (actualizaDistancia g d actual) d
actualizaDistancia :: (Ix v,Num p,Ord p) => Grafo v p -> [(v,p)] -> v -> (v,p) -> (v,p)
actualizaDistancia g d actual (v,p) | notElem v (adyacentes g actual) = (v,p)
| not (aristaEn g (actual,v)) = (v,p)
| otherwise = (v,min (distancia d actual + peso g (actual,v)) (distancia d v))
eliminaVertice :: (Ix v) => [v] -> v -> [v]
eliminaVertice c v = filter (/=v) c
minimoVertice :: (Ix v,Num p,Ord p) => [(v,p)] -> [v] -> v
minimoVertice d c = snd (minimum [(distancia d v,v) | v <- c])
distancia :: (Ix v,Num p,Ord p) => [(v,p)] -> v -> p
distancia [] v = 0
distancia ((w,d):ds) v | w == v = d
| otherwise = distancia ds v
-- ============================================================================
![Informática de 1º de Matemáticas [Curso 2021-22, Grupo 3]](/WIKIS/I1M2021G3/resources/assets/logoUS.png)