-- I1M: Relación 28
-- El TAD de los 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
--
-- El objetivo es hacer los ejercicios con la primera implementación y
-- comprobar que las definiciones también son válidas con las restantes.
-- ============================================================================
-- Librerías
-- ============================================================================
import Data.Array
import Data.List
import Test.QuickCheck
-- Hay que seleccionar una implementación del TAD de los grafos
-- import GrafoConVectorDeAdyacencia
import GrafoConMatrizDeAdyacencia
-- ----------------------------------------------------------------------------
-- Ejemplos de grafos
-- ----------------------------------------------------------------------------
g1, g2, g3, g4, g5 :: Grafo Int Int
g1 = creaGrafo ND (1,5) [(1,2),(1,3),(1,5),(2,4),(2,5),(3,4),(3,5),(4,5)]
g2 = creaGrafo D (1,5) [(1,2),(1,3),(1,5),(2,4),(2,5),(4,3),(4,5)]
g3 = creaGrafo D (1,3) [(1,2),(2,2),(3,1),(3,2)]
g4 = creaGrafo ND (1,3) [(1,2),(1,3),(2,3),(3,3)]
g5 = creaGrafo D (1,3) [(1,2),(1,3),(2,3),(3,3)]
-- ----------------------------------------------------------------------------
-- Ejercicio 1. El grafo completo de orden n, K(n), es un grafo no dirigido
-- cuyo conjunto de nodos es {1,...,n} y tiene una arista entre cada par de
-- nodos distintos.
--
-- Definir la función
-- completo :: Int -> Grafo Int Int
-- tal que '(completo n)' es el grafo completo de orden 'n'. Por ejemplo,
-- completo 4 => G[ND] N:{1,2,3,4}
-- A:{(1,2)[0],(1,3)[0],(1,4)[0],
-- (2,1)[0],(2,3)[0],(2,4)[0],
-- (3,1)[0],(3,2)[0],(3,4)[0],
-- (4,1)[0],(4,2)[0],(4,3)[0]}
-- ----------------------------------------------------------------------------
completo :: Int -> Grafo Int Int
completo n = creaGrafo ND (1,n) [(v1,v2) | v1 <- [1..n], v2 <- [1..n], v1 < v2]
-- ----------------------------------------------------------------------------
-- Ejercicio 2. El ciclo de orden n, C(n), es un grafo no dirigido cuyo
-- conjunto de nodos es {1,...,n} y las aristas son (1,2), (2,3), ..., (n-1,n),
-- (n,1).
--
-- Definir la función
-- grafoCiclo :: Int -> Grafo Int Int
-- tal que '(grafoCiclo n)' es el ciclo de orden 'n'. Por ejemplo,
-- grafoCiclo 3 => G[ND] N:{1,2,3}
-- A:{(1,3)[0],(1,2)[0],
-- (2,1)[0],(2,3)[0],
-- (3,2)[0],(3,1)[0]}
-- ----------------------------------------------------------------------------
grafoCiclo :: Int -> Grafo Int Int
grafoCiclo n = creaGrafo ND (1,n) ((n,1):[(v,v+1) | v <- [1..n-1]])
-- ----------------------------------------------------------------------------
-- Ejercicio 3. El grafo rueda de orden n, R(n), es un grafo no dirigido
-- formado por un ciclo con n nodos {1,2,..,n}, y un nodo central unido con
-- cada uno de los n nodos del ciclo.
--
-- Definir la función
-- grafoRueda :: Int -> Grafo Int Int
-- tal que '(rueda n)' es el grafo rueda de orden 'n'. Por ejemplo,
-- grafoRueda 3 => G[ND] N:{1,2,3,4}
-- A:{(1,3)[0],(1,2)[0],(1,4)[0],
-- (2,1)[0],(2,3)[0],(2,4)[0],
-- (3,2)[0],(3,1)[0],(3,4)[0],
-- (4,1)[0],(4,2)[0],(4,3)[0]}
-- ----------------------------------------------------------------------------
grafoRueda :: Int -> Grafo Int Int
grafoRueda n = creaGrafo ND (1,n+1) ((aristas (grafoCiclo n)) ++ [(v,n+1) | v <- [1..n]])
-- ----------------------------------------------------------------------------
-- Ejercicio 4. Definir la función
-- nNodos :: (Ix v,Num p) => Grafo v p -> Int
-- tal que '(nNodos g)' es el número de nodos del grafo 'g'. Por ejemplo,
-- nNodos (completo 4) == 4
-- nNodos (completo 5) == 5
-- ----------------------------------------------------------------------------
nNodos :: (Ix v,Num p) => Grafo v p -> Int
nNodos g = length (nodos g)
-- ----------------------------------------------------------------------------
-- Ejercicio 5. En un grafo G, un nodo w es incidente en otro nodo v si hay un
-- arco (o una arista) de w a v; es decir, si v es adyacente a w.
--
-- Definir la función
-- incidentes :: (Ix v,Num p) => Grafo v p -> v -> [v]
-- tal que '(incidentes g v)' es el conjunto de los nodos del grafo 'g'
-- incidentes en el nodo 'v'. Por ejemplo,
-- incidentes g2 5 == [1,2,4]
-- adyacentes g2 5 == []
-- incidentes g1 5 == [1,2,3,4]
-- adyacentes g1 5 == [1,2,3,4]
-- ----------------------------------------------------------------------------
incidentes :: (Ix v,Num p) => Grafo v p -> v -> [v]
incidentes g v = filter (\ w -> elem v (adyacentes g w)) (nodos g)
-- ----------------------------------------------------------------------------
-- Ejercicio 6. En un grafo G, los nodos contiguos a un nodo v son aquellos
-- nodos w de g tales que w es adyacente o incidente en v.
--
-- Definir la función
-- contiguos :: (Ix v,Num p) => Grafo v p -> v -> [v]
-- tal que '(contiguos g v)' es el conjunto de los nodos del grafo 'g'
-- contiguos con el nodo 'v'. Por ejemplo,
-- contiguos g2 5 == [1,2,4]
-- contiguos g1 5 == [1,2,3,4]
-- ----------------------------------------------------------------------------
contiguos :: (Ix v,Num p) => Grafo v p -> v -> [v]
contiguos g v = nub (adyacentes g v ++ incidentes g v)
-- ----------------------------------------------------------------------------
-- Ejercicio 7. Definir la función
-- lazos :: (Ix v,Num p) => Grafo v p -> [(v,v)]
-- tal que '(lazos g)' es el conjunto de los lazos (es decir, aristas cuyos
-- extremos son iguales) del grafo 'g'. Por ejemplo,
-- lazos g3 == [(2,2)]
-- lazos g2 == []
-- ----------------------------------------------------------------------------
lazos :: (Ix v,Num p) => Grafo v p -> [(v,v)]
lazos g = filter (\ (v1,v2) -> v1 == v2) (aristas g)
-- ----------------------------------------------------------------------------
-- Ejercicio 8. Definir la función
-- nLazos :: (Ix v,Num p) => Grafo v p -> Int
-- tal que '(nLazos g)' es el número de lazos del grafo 'g'. Por ejemplo,
-- nLazos g3 == 1
-- nLazos g2 == 0
-- ----------------------------------------------------------------------------
nLazos :: (Ix v,Num p) => Grafo v p -> Int
nLazos g = length (lazos g)
-- ----------------------------------------------------------------------------
-- Ejercicio 9. Definir la función
-- nAristas :: (Ix v,Num p) => Grafo v p -> Int
-- tal que '(nAristas g)' es el número de aristas del grafo 'g'. Si 'g' es no
-- dirigido, las aristas de 'v1' a 'v2' y de 'v2' a 'v1' sólo se cuentan una
-- vez. Por ejemplo,
-- nAristas g1 == 8
-- nAristas g2 == 7
-- nAristas g4 == 4
-- nAristas (completo 4) == 6
-- nAristas (completo 5) == 10
-- ----------------------------------------------------------------------------
nAristas :: (Ix v,Num p) => Grafo v p -> Int
nAristas g | dirigido g = length (aristas g)
| otherwise = (length (aristas g) `div` 2) + nLazos g
-- ----------------------------------------------------------------------------
-- Ejercicio 10. Definir la función
-- prop_nAristasCompleto :: Int -> Bool
-- tal que '(prop_nAristasCompleto n)' se verifica si el número de aristas del
-- grafo completo de orden 'n' es 'n*(n-1)/2' y, usando esta función, comprobar
-- que la propiedad se cumple para 'n' de 1 a 20.
-- ----------------------------------------------------------------------------
prop_nAristasCompleto :: Int -> Bool
prop_nAristasCompleto n = nAristas (completo m) == m * (m-1) `div` 2
where m = ((abs n) `mod` 20) + 1
-- La comprobación es
-- λ> quickCheck prop_nAristasCompleto
-- +++ OK, passed 100 tests.
-- ----------------------------------------------------------------------------
-- Ejercicio 11. El grado positivo de un nodo v en un grafo dirigido G, es el
-- número de nodos de G adyacentes con v.
--
-- Definir la función
-- gradoPos :: (Ix v,Num p) => Grafo v p -> v -> Int
-- tal que '(gradoPos g v)' es el grado positivo del nodo 'v' en el grafo 'g'.
-- Por ejemplo,
-- gradoPos g1 5 == 4
-- gradoPos g2 5 == 0
-- gradoPos g2 1 == 3
-- ----------------------------------------------------------------------------
gradoPos :: (Ix v,Num p) => Grafo v p -> v -> Int
gradoPos g v = length (adyacentes g v)
-- ----------------------------------------------------------------------------
-- Ejercicio 12. El grado negativo de un nodo v de un grafo dirigido G, es el
-- número de nodos de G incidentes con v.
--
-- Definir la función
-- gradoNeg :: (Ix v,Num p) => Grafo v p -> v -> Int
-- tal que '(gradoNeg g v)' es el grado negativo del nodo 'v' en el grafo 'g'.
-- Por ejemplo,
-- gradoNeg g1 5 == 4
-- gradoNeg g2 5 == 3
-- gradoNeg g2 1 == 0
-- ----------------------------------------------------------------------------
gradoNeg :: (Ix v,Num p) => Grafo v p -> v -> Int
gradoNeg g v = length (incidentes g v)
-- ----------------------------------------------------------------------------
-- Ejercicio 13. El grado de un nodo v de un grafo dirigido G, es el número de
-- aristas de G que contienen a v. Si G es no dirigido, el grado de un nodo v
-- es el número de aristas en las que participa v, teniendo en cuenta que los
-- lazos se cuentan dos veces.
--
-- Definir la función
-- grado :: (Ix v,Num p) => Grafo v p -> v -> Int
-- tal que '(grado g v)' es el grado del nodo 'v' en el grafo 'g'. Por ejemplo,
-- grado g1 5 == 4
-- grado g2 5 == 3
-- grado g2 1 == 3
-- grado g3 2 == 4
-- grado g3 1 == 2
-- grado g3 3 == 2
-- grado g4 3 == 4
-- grado g5 3 == 4
-- ----------------------------------------------------------------------------
grado :: (Ix v,Num p) => Grafo v p -> v -> Int
grado g v | dirigido g = gradoPos g v + gradoNeg g v
| otherwise = gradoPos g v - nLazos g
-- ----------------------------------------------------------------------------
-- Ejercicio 14. Comprobar con QuickCheck que para cualquier grafo G, la suma
-- de los grados positivos de los nodos de G es igual que la suma de los
-- grados negativos de los nodos de G.
-- ----------------------------------------------------------------------------
-- La propiedad es
prop_sumaGrados :: Grafo Int Int -> Bool
prop_sumaGrados g = sum (map (\ v -> gradoPos g v) (nodos g)) ==
sum (map (\ v -> gradoNeg g v) (nodos g))
-- La comprobación es
-- > quickCheck prop_sumaGrados
-- ----------------------------------------------------------------------------
-- Ejercicio 15. En la teoría de grafos, se conoce como "Lema del apretón de
-- manos" la siguiente propiedad: la suma de los grados de los nodos de G es
-- el doble del número de aristas de G. Utilizar QuickCheck para comprobar esta
-- propiedad.
-- ----------------------------------------------------------------------------
-- La propiedad es
prop_apretonManos :: Grafo Int Int -> Bool
prop_apretonManos g = sum (map (\ v -> grado g v) (nodos g)) == 2 * (nAristas g)
-- La comprobación es
-- > quickCheck prop_apretonManos
-- ----------------------------------------------------------------------------
-- Ejercicio 16. Comprobar con QuickCheck que en todo grafo el número de nodos
-- de grado impar es par.
-- ----------------------------------------------------------------------------
-- La propiedad es
prop_numNodosGradoImpar :: Grafo Int Int -> Bool
prop_numNodosGradoImpar g = even (length (filter (\ v -> odd (grado g v)) (nodos g)))
-- La comprobación es
-- > quickCheck prop_numNodosGradoImpar
-- ----------------------------------------------------------------------------
-- Ejercicio 17. Definir la propiedad
-- prop_gradoCompleto :: Int -> Bool
-- tal que '(prop_gradoCompleto n)' se verifica si todos los nodos del grafo
-- completo de orden 'n' tienen grado 'n-1'. Usarla para comprobar que dicha
-- propiedad se verifica para los grafos completos desde el de orden 1 hasta el
-- de orden 30.
-- ----------------------------------------------------------------------------
prop_gradoCompleto :: Int -> Bool
prop_gradoCompleto n = all (==(m-1)) (map (\ v -> grado g v) (nodos g))
where m = ((abs n) `mod` 30) + 1
g = completo m
-- La comprobación es
-- λ> quickCheck prop_gradoCompleto
-- +++ OK, passed 100 tests.
-- ----------------------------------------------------------------------------
-- Ejercicio 18. Un grafo es regular si todos sus nodos tienen el mismo grado.
--
-- Definir la función
-- regular :: (Ix v,Num p) => Grafo v p -> Bool
-- tal que '(regular g)' se verifica si el grafo 'g' es regular.
-- regular g1 == False
-- regular g2 == False
-- regular (completo 4) == True
-- ----------------------------------------------------------------------------
regular :: (Ix v,Num p) => Grafo v p -> Bool
regular g = all (==(head lg)) lg
where lg = map (\ v -> grado g v) (nodos g)
-- ----------------------------------------------------------------------------
-- Ejercicio 19. Definir la propiedad
-- prop_completoRegular :: Int -> Bool
-- tal que '(prop_completoRegular n)' se verifica si los grafos
-- completos de orden 'n' son regulares y usarla
-- para comprobar que todos los grafos completo desde el de orden 1 hasta el de
-- orden 30 son regulares.
-- ----------------------------------------------------------------------------
prop_completoRegular :: Int -> Bool
prop_completoRegular n = regular g
where m = ((abs n) `mod` 30) + 1
g = completo m
-- La comprobación es
-- λ> quickCheck prop_completoRegular
-- +++ OK, passed 100 tests.
-- ----------------------------------------------------------------------------
-- Ejercicio 20. Si un grafo G es regular, entonces su regularidad es el grado
-- de cualquiera de sus nodos.
--
-- Definir la función
-- regularidad :: (Ix v,Num p) => Grafo v p -> Maybe Int
-- tal que '(regularidad g)' es 'Just k', donde 'k' es la regularidad de 'g' en
-- caso de que 'g' sea regular y 'Nothing' si no lo es. Por ejemplo,
-- regularidad g1 == Nothing
-- regularidad (completo 4) == Just 3
-- regularidad (completo 5) == Just 4
-- regularidad (grafoCiclo 4) == Just 2
-- regularidad (grafoCiclo 5) == Just 2
-- regularidad (grafoRueda 3) == Just 3
-- regularidad (grafoRueda 4) == Nothing
-- ----------------------------------------------------------------------------
regularidad :: (Ix v,Num p) => Grafo v p -> Maybe Int
regularidad g | regular g = Just (grado g (head (nodos g)))
| otherwise = Nothing
-- ----------------------------------------------------------------------------
-- Ejercicio 21. Definir la propiedad
-- prop_regularidadCompleto :: Int -> Bool
-- tal que '(prop_regularidadCompleto n)' se verifica si la regularidad del
-- grafo completo de orden 'n' es 'n-1', y usarla para comprobar que la cumplen
-- todos los grafos completos desde el de orden 1 hasta el de orden 20.
-- ----------------------------------------------------------------------------
prop_regularidadCompleto :: Int -> Bool
prop_regularidadCompleto n = extrae (regularidad g) == m - 1
where m = ((abs n) `mod` 20) + 1
g = completo m
extrae (Just i) = i
-- La comprobación es
-- λ> quickCheck prop_regularidadCompleto
-- +++ OK, passed 100 tests.
-- ----------------------------------------------------------------------------
-- Ejercicio 22. Definir la propiedad
-- prop_regularidadCiclo :: Int -> Bool
-- tal que '(prop_regularidadCiclo n)' se verifica si la regularidad del grafo
-- ciclo de orden 'n' es 2, y usarla para comprobar que la cumplen todos los
-- grafos ciclos desde el de orden 3 hasta el de orden 20.
-- ----------------------------------------------------------------------------
prop_regularidadCiclo :: Int -> Bool
prop_regularidadCiclo n = extrae (regularidad g) == 2
where m = ((abs n) `mod` 18) + 3
g = grafoCiclo m
extrae (Just i) = i
-- La comprobación es
-- λ> quickCheck prop_regularidadCiclo
-- +++ OK, passed 100 tests.
-- ----------------------------------------------------------------------------
-- Ejercicio 23. Un mapa se puede representar mediante un grafo donde los
-- vértices son las regiones del mapa y hay una arista entre dos vértices si
-- las correspondientes regiones son vecinas. Por ejemplo, el mapa siguiente
--
-- +----------+----------+
-- | 1 | 2 |
-- +----+-----+-----+----+
-- | | | |
-- | 3 | 4 | 5 |
-- | | | |
-- +----+-----+-----+----+
-- | 6 | 7 |
-- +----------+----------+
--
-- se pueden representar por
-- mapa :: Grafo Int Int
-- mapa = creaGrafo ND (1,7)
-- [(1,2),(1,3),(1,4),(2,4),(2,5),(3,4),
-- (3,6),(4,5),(4,6),(4,7),(5,7),(6,7)]
-- Para colorear el mapa se dispone de 4 colores representados por números
-- naturales del 1 al 4.
--
-- Definir la función
-- coloracion :: (Ix v, Num p) => Grafo v p -> [(v,Color)] -> Bool
-- tal que '(coloracion m cs)' se verifica si 'cs' es una coloración del mapa
-- 'm' tal que todos las regiones vecinas tienen colores distintos. Por
-- ejemplo,
-- coloracion mapa [(1,1),(2,2),(3,2),(4,3),(5,1),(6,1),(7,2)] == True
-- coloracion mapa [(1,1),(2,2),(3,1),(4,3),(5,1),(6,1),(7,2)] == False
-- ----------------------------------------------------------------------------
mapa :: Grafo Int Int
mapa = creaGrafo ND (1,7) [(1,2),(1,3),(1,4),(2,4),(2,5),(3,4),
(3,6),(4,5),(4,6),(4,7),(5,7),(6,7)]
coloracion :: (Ix v, Num p) => Grafo v p -> [(v,Int)] -> Bool
coloracion g lc = all colorValido (nodos g)
where colorValido v = all (\ w -> color w /= color v) (adyacentes g v)
color v = snd (head (filter (\ par -> fst par == v) lc))
-- ----------------------------------------------------------------------------
-- Ejercicio 24. Dados dos grafos G1 y G2, se dice que G1 es subgrafo de G2 si
-- ambos son del mismo tipo (dirigido o no dirigido); el conjunto de nodos de
-- G1 está contenido en el conjunto de nodos de G2; y todas las aristas de G1
-- están presentes en G2.
--
-- Definir la función
-- subgrafo :: (Ix v, Num p, Eq p) => Grafo v p -> Grafo v p -> Bool
-- tal que '(subgrafo g1 g2)' se verifica si el grafo 'g1' es subgrafo del
-- grafo 'g2'. Por ejemplo,
-- subgrafo (creaGrafo ND (1,5) [(1,2),(1,3)]) g1 == True
-- subgrafo (creaGrafo ND (1,5) [(1,2),(1,4)]) g1 == False
-- ----------------------------------------------------------------------------
subgrafo :: (Ix v, Num p, Eq p) => Grafo v p -> Grafo v p -> Bool
subgrafo g1 g2 | (dirigido g1) && not (dirigido g2) = False
| not (dirigido g1) && (dirigido g2) = False
| otherwise = subconjunto (nodos g1) (nodos g2) &&
subconjunto (aristas g1) (aristas g2)
subconjunto :: (Eq a) => [a] -> [a] -> Bool
subconjunto [] ys = True
subconjunto (x:xs) ys = elem x ys && subconjunto xs ys
-- ----------------------------------------------------------------------------
-- Ejercicio 25. Dado un grafo G y un subconjunto de sus nodos V, el subgrafo
-- de G generado por V es un grafo del mismo tipo que G (dirigido o no
-- dirigido) cuyo conjunto de nodos es igual al de G y cuyas aristas son todas
-- las aristas de G cuyos extremos estén en V.
--
-- Definir la función
-- subgrafoGenerado :: (Ix v, Num p) => Grafo v p -> [v] -> Grafo v p
-- tal que '(subgrafoGenerado g vs)' es el subgrafo de 'g' generado por el
-- conjunto de vértices 'vs'. Por ejemplo,
-- subgrafoGenerado g1 [1,3,5] =>
-- G[ND] N:{1,2,3,4,5}
-- A:{(1,3)[0],(1,5)[0],(3,1)[0],(3,5)[0],(5,1)[0],(5,3)[0]}
-- ----------------------------------------------------------------------------
subgrafoGenerado :: (Ix v, Num p) => Grafo v p -> [v] -> Grafo v p
subgrafoGenerado g vs | dirigido g = creaGrafo D (v1,v2) (filter (\ (v,w) -> elem v vs && elem w vs) (aristas g))
| otherwise = creaGrafo ND (v1,v2) (filter (\ (v,w) -> elem v vs && elem w vs) (aristas g))
where v1 = minimum (nodos g)
v2 = maximum (nodos g)
-- ----------------------------------------------------------------------------
-- Ejercicio 26. Dados dos grafos del mismo tipo G1 y G2 definidos sobre el
-- mismo conjunto de nodos V, su intersección es un grafo del mismo tipo
-- (dirigido o no dirigido) cuyo conjunto de nodos es V y cuyas aristas son
-- todas las aristas que están en G1 y G2 al mismo tiempo.
--
-- Definir la función
-- interseccionGrafos :: (Ix v, Num p) => Grafo v p -> Grafo v p -> Grafo v p
-- tal que '(interseccionGrafos g1 g2)' es la intersección de los grafos 'g1' y
-- 'g2'. Por ejemplo,
-- interseccionGrafos g1 g2 =>
-- *** Exception: Los grafos no son compatibles
-- interseccionGrafos g3 g5 =>
-- G[D] N:{1,2,3} A:{(1,2)[0]}
-- ----------------------------------------------------------------------------
interseccionGrafos :: (Ix v, Num p) => Grafo v p -> Grafo v p -> Grafo v p
interseccionGrafos g1 g2 | dirigido g1 && not (dirigido g2) = error "Los grafos son incompatibles"
| not (dirigido g1) && dirigido g2 = error "Los grafos son incompatibles"
| nodos g1 /= nodos g2 = error "Los grafos son incompatibles"
| dirigido g1 = creaGrafo D (v1,v2) (interseccion (aristas g1) (aristas g2))
| otherwise = creaGrafo ND (v1,v2) (interseccion (aristas g1) (aristas g2))
where v1 = minimum (nodos g1)
v2 = maximum (nodos g1)
interseccion :: (Eq a) => [a] -> [a] -> [a]
interseccion [] _ = []
interseccion _ [] = []
interseccion (x:xs) ys | elem x ys = x:(interseccion xs ys)
| otherwise = (interseccion xs ys)
-- ----------------------------------------------------------------------------
-- Ejercicio 27. Dados dos grafos del mismo tipo G1 y G2 definidos sobre el
-- mismo conjunto de nodos V, su unión es un grafo del mismo tipo (dirigido o
-- no dirigido) cuyo conjunto de nodos es V y cuyas aristas son todas las
-- aristas que están en G1 o en G2.
--
-- Definir la función
-- unionGrafos :: (Ix v, Num p) => Grafo v p -> Grafo v p -> Grafo v p
-- tal que '(unionGrafos g1 g2)' es la union de los grafos 'g1' y 'g2'. Por
-- ejemplo,
-- unionGrafos g2 g3 =>
-- *** Exception: Los grafos no son compatibles
-- unionGrafos g3 g5 =>
-- G[D] N:{1,2,3}
-- A:{(1,2)[0],(1,3)[0],(2,2)[0],(2,3)[0],(3,1)[0],(3,2)[0],(3,3)[0]}
-- ----------------------------------------------------------------------------
unionGrafos :: (Ix v, Num p) => Grafo v p -> Grafo v p -> Grafo v p
unionGrafos g1 g2 | dirigido g1 && not (dirigido g2) = error "Los grafos son incompatibles"
| not (dirigido g1) && dirigido g2 = error "Los grafos son incompatibles"
| nodos g1 /= nodos g2 = error "Los grafos son incompatibles"
| dirigido g1 = creaGrafo D (v1,v2) ((aristas g1) ++ (aristas g2))
| otherwise = creaGrafo ND (v1,v2) ((aristas g1) ++ (aristas g2))
where v1 = minimum (nodos g1)
v2 = maximum (nodos g1)
-- ----------------------------------------------------------------------------
-- Ejercicio 28. Dados dos grafos del mismo tipo G1 y G2 definidos sobre el
-- mismo conjunto de nodos V, su diferencia es un grafo del mismo tipo
-- (dirigido o no dirigido) cuyo conjunto de nodos es V y cuyas aristas son
-- todas las aristas que están en G1 pero no están en G2.
--
-- Definir la función
-- diferenciaGrafos :: (Ix v, Num p) => Grafo v p -> Grafo v p -> Grafo v p
-- tal que '(diferenciaGrafos g1 g2)' es la diferencia de los grafos 'g1' y
-- 'g2'. Por ejemplo,
-- diferenciaGrafos g3 g5 =>
-- G[D] N:{1,2,3} A:{(2,2)[0],(3,1)[0],(3,2)[0]}
-- diferenciaGrafos g5 g3 =>
-- G[D] N:{1,2,3} A:{(1,3)[0],(2,3)[0],(3,3)[0]}
-- ----------------------------------------------------------------------------
diferenciaGrafos :: (Ix v, Num p) => Grafo v p -> Grafo v p -> Grafo v p
diferenciaGrafos g1 g2 | dirigido g1 && not (dirigido g2) = error "Los grafos son incompatibles"
| not (dirigido g1) && dirigido g2 = error "Los grafos son incompatibles"
| nodos g1 /= nodos g2 = error "Los grafos son incompatibles"
| dirigido g1 = creaGrafo D (v1,v2) (diferencia (aristas g1) (aristas g2))
| otherwise = creaGrafo ND (v1,v2) (diferencia (aristas g1) (aristas g2))
where v1 = minimum (nodos g1)
v2 = maximum (nodos g1)
diferencia :: (Eq a) => [a] -> [a] -> [a]
diferencia [] ys = []
diferencia (x:xs) ys | elem x ys = (diferencia xs ys)
| otherwise = x:(diferencia xs ys)
-- ----------------------------------------------------------------------------
-- Ejercicio 29. El complementario del grafo G es otro grafo G' del mismo tipo
-- que G (dirigido o no dirigido), con el mismo conjunto de nodos y tal que dos
-- nodos de G' son adyacentes si y sólo si no son adyacentes en G. Los pesos de
-- todas las aristas del grafo complementario son iguales a 0. Definir la
-- función
-- grafoComplementario :: (Ix v,Num p) => Grafo v p -> Grafo v p
-- tal que '(grafoComplementario g)' es el grafo complementario del grafo 'g'
-- construido según la definición anterior. Por ejemplo,
-- grafoComplementario g1 =>
-- G[ND] N:{1,2,3,4,5}
-- A:{(1,4)[0],(1,1)[0],
-- (2,3)[0],(2,2)[0],
-- (3,2)[0],(3,3)[0],
-- (4,1)[0],(4,4)[0],
-- (5,5)[0]}
-- grafoComplementario g2 =>
-- G[D] N:{1,2,3,4,5}
-- A:{(1,1)[0],(1,4)[0],
-- (2,1)[0],(2,2)[0],(2,3)[0],
-- (3,1)[0],(3,2)[0],(3,3)[0],(3,4)[0],(3,5)[0],
-- (4,1)[0],(4,2)[0],(4,4)[0],
-- (5,1)[0],(5,2)[0],(5,3)[0],(5,4)[0],(5,5)[0]}
-- ----------------------------------------------------------------------------
grafoComplementario :: (Ix v,Num p) => Grafo v p -> Grafo v p
grafoComplementario g | dirigido g = creaGrafo D (v1,v2) (diferencia (todasAristas g) (aristas g))
| otherwise = creaGrafo ND (v1,v2) (diferencia (todasAristas g) (aristas g))
where v1 = minimum (nodos g)
v2 = maximum (nodos g)
todasAristas g = [(v,w) | v <- nodos g, w <- nodos g]
-- ----------------------------------------------------------------------------
-- Ejercicio 30. Dado un grafo no dirigido G, su grafo dual se define como el
-- grafo no dirigido cuyos nodos se corresponden con las aristas de G y para
-- todo par de aristas en G, hay una arista entre los nodos correspondientes en
-- el dual de G si y sólo si dichas aristas tienen un extremo común.
--
-- Definir la función
-- grafoDual :: (Ix v,Num p) => Grafo v p -> Grafo Int Int
-- tal que '(grafoDual g)' es el grafo dual de 'g' tal y como se ha definido
-- antes. Por ejemplo,
-- grafoDual g3 =>
-- "Error: el grafo es incompatible"
-- grafoDual g4 =>
-- G[ND] N:{1,2,3,4}
-- A:{(1,2)[0],(1,3)[0],
-- (2,1)[0],(2,3)[0],(2,4)[0],
-- (3,1)[0],(3,2)[0],(3,4)[0],
-- (4,2)[0],(4,3)[0]}
-- ----------------------------------------------------------------------------
grafoDual :: (Ix v,Num p) => Grafo v p -> Grafo Int Int
grafoDual g = creaGrafo ND (1,nAristas g) [(i,j) | ((a,b),i) <- cs,
((c,d),j) <- cs,
(c,d) /= (a,b),
c == a || c == b || d == a || d == b]
where cs = zip (filter (\ (x,y) -> x <= y) (aristas g)) [1..]
-- ============================================================================
-- Generador de grafos
-- ============================================================================
-- (generaGND n ps) es el grafo completo de orden n tal que los pesos
-- están determinados por ps. Por ejemplo,
-- generaGND 3 [4,2,5] =>
-- G[ND] N:{1,2,3}
-- A:{(1,2)[4],(1,3)[2],(2,1)[4],(2,3)[5],(3,1)[2],(3,2)[5]}
-- generaGND 3 [4,-2,5] =>
-- G[ND] N:{1,2,3}
-- A:{(1,2)[4],(1,3)[-2],(2,1)[4],(2,3)[5],(3,1)[-2],(3,2)[5]}
generaGND :: (Num a, Enum a, Ix a, Num b) => a -> [b] -> Grafo a b
generaGND n ps =
asignaPesos (creaGrafo ND (1,n) l1) (zip l1 ps)
where l1 = take (length ps) [(x,y) | x <- [1..n], y <- [1..n], x < y]
-- (generaGD n ps) es el grafo completo de orden n tal que los pesos
-- están determinados por ps. Por ejemplo,
-- generaGD 3 [4,2,5] =>
-- G[D] N:{1,2,3}
-- A:{(1,1)[4],(1,2)[2],(1,3)[5]}
-- generaGD 3 [4,2,5,3,7,9,8,6] =>
-- G[D] N:{1,2,3}
-- A:{(1,1)[4],(1,2)[2],(1,3)[5],
-- (2,1)[3],(2,2)[7],(2,3)[9],
-- (3,1)[8],(3,2)[6]}
generaGD :: (Num a, Enum a, Ix a, Num b) => a -> [b] -> Grafo a b
generaGD n ps =
asignaPesos (creaGrafo D (1,n) l1) (zip l1 ps)
where l1 = take (length ps) [(x,y) | x <- [1..n], y <- [1..n]]
-- genGD es un generador de grafos dirigidos. Por ejemplo,
-- sample genGD =>
-- G[D] N:{1,2} A:{(1,1)[0],(1,2)[0],(2,1)[0],(2,2)[0]}
-- G[D] N:{1,2} A:{(1,1)[13],(1,2)[-4],(2,1)[4],(2,2)[3]}
-- ...
genGD :: (Arbitrary a, Num a, Enum a, Ix a,
Arbitrary b, Num b) => Gen (Grafo a b)
genGD = do
n <- choose (1,10)
xs <- vectorOf (n*n) arbitrary
return (generaGD (fromIntegral n) xs)
-- genGND es un generador de grafos no dirigidos. Por ejemplo,
-- sample genGND
-- G[ND] N:{1,2} A:{(1,2)[7],(2,1)[7]}
-- G[ND] N:{1} A:{}
-- ...
genGND :: (Arbitrary a, Num a, Enum a, Ix a,
Arbitrary b, Num b) => Gen (Grafo a b)
genGND = do
n <- choose (1,10)
xs <- vectorOf (n*n) arbitrary
return (generaGND (fromIntegral n) xs)
-- genG es un generador de grafos. Por ejemplo,
-- sample genG
-- G[D] N:{1,2} A:{(1,1)[2],(1,2)[1],(2,1)[0],(2,2)[-1]}
-- G[ND] N:{1,2} A:{(1,2)[-12],(2,1)[-12]}
-- ..
genG :: (Arbitrary a, Num a, Enum a, Ix a,
Arbitrary b, Num b) => Gen (Grafo a b)
genG = do
d <- choose (True,False)
n <- choose (1,10)
xs <- vectorOf (n*n) arbitrary
if d then return (generaGD (fromIntegral n) xs)
else return (generaGND (fromIntegral n) xs)
-- Los grafos está contenido en la clase de los objetos generables
-- aleatoriamente.
instance (Arbitrary a, Num a, Enum a, Ix a,
Arbitrary b, Num b) => Arbitrary (Grafo a b) where
arbitrary = genG
-- ============================================================================
![Informática de 1º de Matemáticas [Curso 2021-22, Grupo 3]](/WIKIS/I1M2021G3/resources/assets/logoUS.png)