Tema 22: Algoritmos sobre grafos

La signatura del TAD de los grafos es

creaGrafo   :: (Ix v,Num p) => Orientacion -> (v,v) -> [(v,v,p)] -> Grafo v p
dirigido    :: (Ix v,Num p) => (Grafo v p) -> Bool
adyacentes  :: (Ix v,Num p) => (Grafo v p) -> v -> [v]
nodos       :: (Ix v,Num p) => (Grafo v p) -> [v]
aristas     :: (Ix v,Num p) => (Grafo v p) -> [(v,v,p)]
aristaEn    :: (Ix v,Num p) => (Grafo v p) -> (v,v) -> Bool
peso        :: (Ix v,Num p) => v -> v -> (Grafo v p) -> p

• (creaGrafo o cs as) es un grafo (dirigido o no, según el valor de o), con el par de cotas cs y listas de aristas as (cada arista es un trío formado por los dos vértices y su peso). Ver un ejemplo en el siguiente apartado.
• (dirigido g) se verifica si g es dirigido.
• (nodos g) es la lista de todos los nodos del grafo g.
• (aristas g) es la lista de las aristas del grafo g.
• (adyacentes g v) es la lista de los vértices adyacentes al nodo v en el grafo g.
• (aristaEn g a) se verifica si a es una arista del grafo g.
• (peso v1 v2 g) es el peso de la arista que une los vértices v1 y v2 en el grafo g.

Ejemplo de creación de grafos: El grafo

       12
  1 -------- 2
  | \78     /|
  |  \   32/ |
  |   \   /  |
34|     5    |55
  |   /   \  |
  |  /44   \ |
  | /     93\|
  3 -------- 4
       61

se define por

creaGrafo ND (1,5) [(1,2,12),(1,3,34),(1,5,78),
                    (2,4,55),(2,5,32),
                    (3,4,61),(3,5,44),
                    (4,5,93)]

Cabecera del módulo:

module Tema_22.GrafoConVectorDeAdyacencia
  (Orientacion (..),
   Grafo,
   creaGrafo,  -- (Ix v,Num p) => Orientacion -> (v,v) -> [(v,v,p)] -> Grafo v p
   dirigido,   -- (Ix v,Num p) => (Grafo v p) -> Bool
   adyacentes, -- (Ix v,Num p) => (Grafo v p) -> v -> [v]
   nodos,      -- (Ix v,Num p) => (Grafo v p) -> [v]
   aristas,    -- (Ix v,Num p) => (Grafo v p) -> [(v,v,p)]
   aristaEn,   -- (Ix v,Num p) => (Grafo v p) -> (v,v) -> Bool
   peso        -- (Ix v,Num p) => v -> v -> (Grafo v p) -> p
  ) where

Librerías auxiliares.

import Data.Array

Orientacion es D (dirigida) ó ND (no dirigida).

data Orientacion = D | ND
  deriving (Eq, Show)

(Grafo v p) es un grafo con vértices de tipo v y pesos de tipo p.

data Grafo v p = G Orientacion (Array v [(v,p)])
  deriving (Eq, Show)

(creaGrafo o cs as) es un grafo (dirigido o no según el valor de o), con el par de cotas cs y listas de aristas as (cada arista es un trío formado por los dos vértices y su peso). Los ejemplo se muestran después de la definición

creaGrafo :: (Ix v, Num p) => Orientacion -> (v,v) -> [(v,v,p)] -> Grafo v p
creaGrafo o cs vs =
  G o (accumArray (\xs x -> xs++[x]) [] cs
                  ((if o == D then []
                    else [(x2,(x1,p))|(x1,x2,p) <- vs, x1 /= x2]) ++
                   [(x1,(x2,p)) | (x1,x2,p) <- vs]))

El grafo

       12
  1 -------- 2
  | \78     /|
  |  \   32/ |
  |   \   /  |
34|     5    |55
  |   /   \  |
  |  /44   \ |
  | /     93\|
  3 -------- 4
       61

se define por

ejGrafoND = creaGrafo ND (1,5) [(1,2,12),(1,3,34),(1,5,78),
                                (2,4,55),(2,5,32),
                                (3,4,61),(3,5,44),
                                (4,5,93)]

Su evaluación es

λ> ejGrafoND
G ND array (1,5) [(1,[(2,12),(3,34),(5,78)]),
                  (2,[(1,12),(4,55),(5,32)]),
                  (3,[(1,34),(4,61),(5,44)]),
                  (4,[(2,55),(3,61),(5,93)]),
                  (5,[(1,78),(2,32),(3,44),(4,93)])])

ejGrafoD es el mismo grafo que ejGrafoND pero orientando las aristas de menor a mayor. Su definición es

ejGrafoD = creaGrafo D (1,5) [(1,2,12),(1,3,34),(1,5,78),
                              (2,4,55),(2,5,32),
                              (3,4,61),(3,5,44),
                              (4,5,93)]

y su evaluación es

λ> ejGrafoD
G D array (1,5) [(1,[(2,12),(3,34),(5,78)]),
                 (2,[(4,55),(5,32)]),
                 (3,[(4,61),(5,44)]),
                 (4,[(5,93)]),
                 (5,[])])

(dirigido g) se verifica si g es dirigido. Por ejemplo,

dirigido ejGrafoD   ==  True
dirigido ejGrafoND  ==  False

Su definición es

dirigido :: (Ix v,Num p) => (Grafo v p) -> Bool
dirigido (G o _) = o == D

(adyacentes g v) es la lista de los vértices adyacentes al nodo v en el grafo g. Por ejemplo,

adyacentes ejGrafoND 4  ==  [2,3,5]
adyacentes ejGrafoD  4  ==  [5]

Su definición es

adyacentes :: (Ix v,Num p) => (Grafo v p) -> v -> [v]
adyacentes (G _ g) v = map fst (g!v)

(nodos g) es la lista de todos los nodos del grafo g. Por ejemplo,

nodos ejGrafoND  ==  [1,2,3,4,5]
nodos ejGrafoD   ==  [1,2,3,4,5]

Su definición es

nodos :: (Ix v,Num p) => (Grafo v p) -> [v]
nodos (G _ g) = indices g

(peso v1 v2 g) es el peso de la arista que une los vértices v1 y v2 en el grafo g. Por ejemplo,

peso 1 5 ejGrafoND  ==  78
peso 1 5 ejGrafoD   ==  78

Su definición es

peso :: (Ix v,Num p) => v -> v -> (Grafo v p) -> p
peso x y (G _ g) = head [c | (a,c) <- g!x , a == y]

(aristaEn g a) se verifica si a es una arista del grafo g. Por ejemplo,

aristaEn ejGrafoND (5,1)  ==  True
aristaEn ejGrafoND (4,1)  ==  False
aristaEn ejGrafoD  (5,1)  ==  False
aristaEn ejGrafoD  (1,5)  ==  True

Su definición es

aristaEn :: (Ix v,Num p) => (Grafo v p) -> (v,v) -> Bool
aristaEn g (x,y) = y `elem` adyacentes g x

(aristas g) es la lista de las aristas del grafo g. Por ejemplo,

λ> aristas ejGrafoND
[(1,2,12),(1,3,34),(1,5,78),(2,1,12),(2,4,55),(2,5,32),
 (3,1,34),(3,4,61),(3,5,44),(4,2,55),(4,3,61),(4,5,93),
 (5,1,78),(5,2,32),(5,3,44),(5,4,93)]
λ> aristas ejGrafoD
[(1,2,12),(1,3,34),(1,5,78),(2,4,55),(2,5,32),(3,4,61),
 (3,5,44),(4,5,93)]

Su definición es

aristas :: (Ix v,Num p) => (Grafo v p) -> [(v,v,p)]
aristas (G o g) =
  [(v1,v2,w) | v1 <- nodos (G o g) , (v2,w) <- g!v1]

Cabecera del módulo.

module Tema_22.GrafoConMatrizDeAdyacencia
  (Orientacion (..),
   Grafo,
   creaGrafo,  -- (Ix v,Num p) => Orientacion -> (v,v) -> [(v,v,p)] -> Grafo v p
   dirigido,   -- (Ix v,Num p) => (Grafo v p) -> Bool
   adyacentes, -- (Ix v,Num p) => (Grafo v p) -> v -> [v]
   nodos,      -- (Ix v,Num p) => (Grafo v p) -> [v]
   aristas,    -- (Ix v,Num p) => (Grafo v p) -> [(v,v,p)]
   aristaEn,   -- (Ix v,Num p) => (Grafo v p) -> (v,v) -> Bool
   peso        -- (Ix v,Num p) => v -> v -> (Grafo v p) -> p
  ) where

Librerías auxiliares

import Data.Array

Orientacion es D (dirigida) ó ND (no dirigida).

data Orientacion = D | ND
  deriving (Eq, Show)

(Grafo v p) es un grafo con vértices de tipo v y pesos de tipo p.

data Grafo v p = G Orientacion (Array (v,v) (Maybe p))
  deriving (Eq, Show)

(creaGrafo o cs as) es un grafo (dirigido o no, según el valor de o), con el par de cotas cs y listas de aristas as (cada arista es un trío formado por los dos vértices y su peso). Ver un ejemplo a continuación.

creaGrafo :: (Ix v, Num p) => Bool -> (v,v) -> [(v,v,p)]
                              -> Grafo v p
creaGrafo o cs@(l,u) as =
  G o (matrizVacia //
        ([((x1,x2),Just w) | (x1,x2,w) <- as] ++
         if o == D then []
         else [((x2,x1),Just w) | (x1,x2,w) <- as, x1 /= x2]))
  where
  matrizVacia = array ((l,l),(u,u))
                      [((x1,x2),Nothing) | x1 <- range cs,
                                           x2 <- range cs]

ejGrafoND es el grafo

       12
  1 -------- 2
  | \78     /|
  |  \   32/ |
  |   \   /  |
34|     5    |55
  |   /   \  |
  |  /44   \ |
  | /     93\|
  3 -------- 4
       61

Su definición es

ejGrafoND = creaGrafo ND (1,5) [(1,2,12),(1,3,34),(1,5,78),
                                (2,4,55),(2,5,32),
                                (3,4,61),(3,5,44),
                                (4,5,93)]

y su evaluación es

λ> ejGrafoND
G ND array ((1,1),(5,5))
           [((1,1),Nothing),((1,2),Just 12),((1,3),Just 34),
            ((1,4),Nothing),((1,5),Just 78),((2,1),Just 12),
            ((2,2),Nothing),((2,3),Nothing),((2,4),Just 55),
            ((2,5),Just 32),((3,1),Just 34),((3,2),Nothing),
            ((3,3),Nothing),((3,4),Just 61),((3,5),Just 44),
            ((4,1),Nothing),((4,2),Just 55),((4,3),Just 61),
            ((4,4),Nothing),((4,5),Just 93),((5,1),Just 78),
            ((5,2),Just 32),((5,3),Just 44),((5,4),Just 93),
            ((5,5),Nothing)]

ejGrafoD es el mismo grafo que ejGrafoND pero orientando las aristas de menor a mayor. Su definición es

ejGrafoD = creaGrafo D (1,5) [(1,2,12),(1,3,34),(1,5,78),
                              (2,4,55),(2,5,32),
                              (3,4,61),(3,5,44),
                              (4,5,93)]

y su evaluación es

λ> ejGrafoD
G D (array ((1,1),(5,5))
           [((1,1),Nothing),((1,2),Just 12),((1,3),Just 34),
            ((1,4),Nothing),((1,5),Just 78),((2,1),Nothing),
            ((2,2),Nothing),((2,3),Nothing),((2,4),Just 55),
            ((2,5),Just 32),((3,1),Nothing),((3,2),Nothing),
            ((3,3),Nothing),((3,4),Just 61),((3,5),Just 44),
            ((4,1),Nothing),((4,2),Nothing),((4,3),Nothing),
            ((4,4),Nothing),((4,5),Just 93),((5,1),Nothing),
            ((5,2),Nothing),((5,3),Nothing),((5,4),Nothing),
            ((5,5),Nothing)])

(dirigido g) se verifica si g es dirigido. Por ejemplo,

dirigido ejGrafoD   ==  True
dirigido ejGrafoND  ==  False

Su definición es

dirigido :: (Ix v,Num p) => (Grafo v p) -> Bool
dirigido (G o _) = o == D

(adyacentes g v) es la lista de los vértices adyacentes al nodo v en el grafo g. Por ejemplo,

adyacentes ejGrafoND 4  ==  [2,3,5]
adyacentes ejGrafoD  4  ==  [5]

Su definición es

adyacentes :: (Ix v,Num p) => (Grafo v p) -> v -> [v]
adyacentes (G o g) v =
  [v' | v' <- nodos (G o g), (g!(v,v')) /= Nothing]

(nodos g) es la lista de todos los nodos del grafo g. Por ejemplo,

nodos ejGrafoND  ==  [1,2,3,4,5]
nodos ejGrafoD   ==  [1,2,3,4,5]

Su definición es

nodos :: (Ix v,Num p) => (Grafo v p) -> [v]
nodos (G _ g) = range (l,u)
  where ((l,_),(u,_)) = bounds g

(peso v1 v2 g) es el peso de la arista que une los vértices v1 y v2 en el grafo g. Por ejemplo,

peso 1 5 ejGrafoND  ==  78
peso 1 5 ejGrafoD   ==  78

Su definición es

peso :: (Ix v,Num p) => v -> v -> (Grafo v p) -> p
peso x y (G _ g)  = w where (Just w) = g!(x,y)

(aristaEn g a) se verifica si a es una arista del grafo g. Por ejemplo,

aristaEn ejGrafoND (5,1)  ==  True
aristaEn ejGrafoND (4,1)  ==  False

Su definición es

aristaEn :: (Ix v,Num p) => (Grafo v p) -> (v,v) -> Bool
aristaEn (G _o g) (x,y)= (g!(x,y)) /= Nothing

(aristas g) es la lista de las aristas del grafo g. Por ejemplo,

λ> aristas ejGrafoD
[(1,2,12),(1,3,34),(1,5,78),(2,4,55),(2,5,32),(3,4,61),
 (3,5,44),(4,5,93)]
λ> aristas ejGrafoND
[(1,2,12),(1,3,34),(1,5,78),(2,1,12),(2,4,55),(2,5,32),
 (3,1,34),(3,4,61),(3,5,44),(4,2,55),(4,3,61),(4,5,93),
 (5,1,78),(5,2,32),(5,3,44),(5,4,93)]

Su definición es

aristas :: (Ix v,Num p) => (Grafo v p) -> [(v,v,p)]
aristas g@(G o e) = [(v1,v2,extrae(e!(v1,v2)))
                     | v1 <- nodos g,
                       v2 <- nodos g,
                       aristaEn g (v1,v2)]
  where extrae (Just w) = w

Importaciones de librerías auxiliares.

-- Nota: Elegir una implementación de los grafos.
import Tema_22.GrafoConVectorDeAdyacencia
-- import Tema_22.GrafoConMatrizDeAdyacencia
-- import I1M.Grafo

En los ejemplos se usará el grafo g

+---> 2 <---+
|           |
|           |
1 --> 3 --> 6 --> 5
|                 |
|                 |
+---> 4 <---------+

cuya definición es

g = creaGrafo D (1,6)
              [(1,2,0),(1,3,0),(1,4,0),(3,6,0),
               (5,4,0),(6,2,0),(6,5,0)]

(recorridoEnProfundidad i g) es el recorrido en profundidad del grafo g desde el vértice i. Por ejemplo,

recorridoEnProfundidad 1 g  ==  [1,2,3,6,5,4]

Su definición es

recorridoEnProfundidad :: (Num p, Eq p, Ix v) => v -> Grafo v p -> [v]
recorridoEnProfundidad i g = rp [i] []
  where
    rp [] vis    = vis
    rp (c:cs) vis
        | c `elem` vis = rp cs vis
        | otherwise    = rp ((adyacentes g c)++cs)
                            (vis++[c])

Traza del cálculo de (recorridoEnProfundidad 1 g)

recorridoEnProfundidad 1 g
= rp [1]     []
= rp [2,3,4] [1]
= rp [3,4]   [1,2]
= rp [6,4]   [1,2,3]
= rp [2,5,4] [1,2,3,6]
= rp [5,4]   [1,2,3,6]
= rp [4,4]   [1,2,3,6,5]
= rp [4]     [1,2,3,6,5,4]
= rp []      [1,2,3,6,5,4]
= [1,2,3,6,5,4]

(recorridoEnProfundidad' i g) es el recorrido en profundidad del grafo, usando la lista de los visitados como acumulador. Por ejemplo,

recorridoEnProfundidad' 1 g  ==  [1,2,3,6,5,4]

Su definición es

recorridoEnProfundidad' :: (Num p, Eq p, Ix v) => v -> Grafo v p -> [v]
recorridoEnProfundidad' i g = reverse (rp [i] [])
  where
    rp [] vis     = vis
    rp (c:cs) vis
        | c `elem` vis = rp cs vis
        | otherwise    = rp ((adyacentes g c)++cs)
                            (c:vis)

Traza del cálculo de (recorridoEnProfundidad' 1 g)

recorridoEnProfundidad' 1 g
= reverse (rp [1]     [])
= reverse (rp [2,3,4] [1])
= reverse (rp [3,4]   [2,1])
= reverse (rp [6,4]   [3,2,1])
= reverse (rp [2,5,4] [6,3,2,1])
= reverse (rp [5,4]   [6,3,2,1])
= reverse (rp [4,4]   [5,6,3,2,1])
= reverse (rp [4]     [4,5,6,3,2,1])
= reverse (rp []      [4,5,6,3,2,1])
= reverse [4,5,6,3,2,1]
= [1,2,3,6,5,4]

Importaciones de librerías auxiliares.

-- Nota: Elegir una implementación de los grafos.
import Tema_22.GrafoConVectorDeAdyacencia
-- import Tema_22.GrafoConMatrizDeAdyacencia
-- import I1M.Grafo

(recorridoEnAnchura i g) es el recorrido en anchura del grafo g desde el vértice i. Por ejemplo,

recorridoEnAnchura 1 g  ==  [1,2,3,4,6,5]

Su definición es

recorridoEnAnchura :: (Num p, Eq p, Ix v) => v -> Grafo v p -> [v]
recorridoEnAnchura i g = reverse (ra [i] [])
  where
    ra [] vis    = vis
    ra (c:cs) vis
        | c `elem` vis = ra cs vis
        | otherwise    = ra (cs ++ adyacentes g c)
                            (c:vis)

Traza del cálculo de (recorridoEnAnchura 1 g)

RecorridoEnAnchura 1 g
= ra [1]     []
= ra [2,3,4] [1]
= ra [3,4]   [2,1]
= ra [4,6]   [3,2,1]
= ra [6]     [4,3,2,1]
= ra [2,5]   [6,4,3,2,1]
= ra [5]     [6,4,3,2,1]
= ra [4]     [5,6,4,3,2,1]
= ra []      [5,6,4,3,2,1]
= [1,2,3,4,6,5]

Para los ejemplos se considera el siguiente grafo:

     1       2
 1 ----- 2 ----- 3
 |      /|      /|
 |     / |     / |
 |    /  |    /  |
4|   /6  |4  /5  |6
 |  /    |  /    |
 | /     | /     |
 |/      |/      |
 4 ----- 5 ----- 6
  \  3   |   8  /
   \     |     /
    \    |    /
    4\   |7  /3
      \  |  /
       \ | /
        \|/
         7

Aplicación del algoritmo de Kruskal al grafo anterior:

Etapa Arista Componentes conexas
0            {1} {2} {3} {4} {5} {6} {7}
1     {1,2}  {1,2} {3} {4} {5} {6} {7}
2     {2,3}  {1,2,3} {4} {5} {6} {7}
3     {4,5}  {1,2,3} {4,5} {6} {7}
4     {6,7}  {1,2,3} {4,5} {6,7}
5     {1,4}  {1,2,3,4,5} {6,7}
6     {2,5}  arista rechazada
7     {4,7}  {1,2,3,4,5,6,7}

El árbol de expansión mínimo contiene las aristas no rechazadas:

{1,2}, {2,3}, {4,5}, {6,7}, {1,4} y {4,7}.

Librerías auxiliares.

import Tema_22.GrafoConVectorDeAdyacencia
-- import Tema_22.GrafoConMatrizDeAdyacencia
-- import I1M.Grafo

-- Elegir la 1ª si se ha elegido una del Tema 22 y actualizarla para
-- usar la misma implementación.
import Tema_22.RecorridoEnAnchura
-- import I1M.RecorridoEnAnchura

import qualified Data.Map as M
import Data.List
import Data.Ix
import Test.QuickCheck

Grafos usados en los ejemplos.

g1, g2, g3, g4 :: Grafo Int Int
g1 = creaGrafo ND (1,5) [(1,2,12),(1,3,34),(1,5,78),
                         (2,4,55),(2,5,32),
                         (3,4,61),(3,5,44),
                         (4,5,93)]
g2 = creaGrafo ND (1,5) [(1,2,13),(1,3,11),(1,5,78),
                         (2,4,12),(2,5,32),
                         (3,4,14),(3,5,44),
                         (4,5,93)]
g3 = creaGrafo ND (1,7) [(1,2,5),(1,3,9),(1,5,15),(1,6,6),
                         (2,3,7),
                         (3,4,8),(3,5,7),
                         (4,5,5),
                         (5,6,3),(5,7,9),
                         (6,7,11)]
g4 = creaGrafo ND (1,7) [(1,2,5),(1,3,9),(1,5,15),(1,6,6),
                         (2,3,7),
                         (3,4,8),(3,5,1),
                         (4,5,5),
                         (5,6,3),(5,7,9),
                         (6,7,11)]

(kruskal g) es el árbol de expansión mínimo del grafo g calculado mediante el algoritmo de Kruskal. Por ejemplo,

kruskal g1  ==  [(55,2,4),(34,1,3),(32,2,5),(12,1,2)]
kruskal g2  ==  [(32,2,5),(13,1,2),(12,2,4),(11,1,3)]
kruskal g3  ==  [(9,5,7),(7,2,3),(6,1,6),(5,4,5),(5,1,2),(3,5,6)]
kruskal g4  ==  [(9,5,7),(6,1,6),(5,4,5),(5,1,2),(3,5,6),(1,3,5)]

kruskal :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]
kruskal g = aux (sort [(p,x,y) | (x,y,p) <- aristas g])
                (M.fromList [(x,x) | x <- nodos g])
                []
                (length (nodos g) - 1)
  where aux _  _ ae 0 = ae
        aux [] _ _  _ = error "Imposible"
        aux ((p,x,y):as) d ae n
          | actualizado = aux as d' ((p,x,y):ae) (n-1)
          | otherwise   = aux as d ae n
          where (actualizado,d') = buscaActualiza (x,y) d

(raiz t n) es la raíz de n en el diccionario d. Por ejemplo,

raiz (M.fromList [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 5  == 1
raiz (M.fromList [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 2  == 6

Su definición es

raiz :: (Eq n, Ord n) => M.Map n n -> n -> n
raiz d x | v == x    = v
         | otherwise = raiz d v
  where v = d M.! x

(buscaActualiza a d) es el par formado por False y el diccionario d, si los dos vértices de la arista a tienen la misma raíz en d y el par formado por True y el diccionario obtenido añadiéndole a d la arista formada por el vértice de a de mayor raíz y la raíz del vértice de a de menor raíz. Y actualizando las raices de todos los elementos afectados por la raíz añadida. Por ejemplo,

λ> d = M.fromList [(1,1),(2,1),(3,3),(4,4),(5,5),(6,5),(7,7)]
λ> buscaActualiza (5,4) d
(True,fromList [(1,1),(2,1),(3,3),(4,4),(5,4),(6,4),(7,7)])
λ> d' = snd it
λ> buscaActualiza (6,1) d'
(True,fromList [(1,1),(2,1),(3,3),(4,1),(5,1),(6,1),(7,7)])

Su definición es

buscaActualiza :: (Eq n, Ord n) => (n,n) -> M.Map n n -> (Bool,M.Map n n)
buscaActualiza (x,y) d
  | x' == y'  = (False, d)
  | y' <  x'  = (True, modificaR x (d M.! x) y' d)
  | otherwise = (True, modificaR y (d M.! y) x' d)
  where x' = raiz d x
        y' = raiz d y

(modificaR x y y' d) actualiza d como sigue:

• el valor de todas las claves z con valor y es y'
• el valor de todas las claves z con (z > x) con valor x es y'

Su definición es

modificaR :: (Eq n, Ord n) => n -> n -> n -> M.Map n n -> M.Map n n
modificaR x y y' d = aux2 ds (aux1 cs d)
  where cs = M.keys d
        ds = filter (>x) cs
        aux1 [] tb = tb
        aux1 (a:as) tb | tb M.! a == y = aux1 as (M.update (\_ -> Just y') a tb)
                       | otherwise     = aux1 as tb
        aux2 [] tb = tb
        aux2 (b:bs) tb | tb M.! b == x = aux2 bs (M.update (\_ -> Just y') b tb)
                       | otherwise     = aux2 bs tb

• Lista de aristas, ordenadas según su peso:

  [(3,5,6),(5,1,2),(5,4,5),(6,1,6),(7,2,3),(7,3,5),
   (8,3,4),(9,1,3),(9,5,7),(11,6,7),(15,1,5)]
  

• Inicial

  fromList [(1,1),(2,2),(3,3),(4,4),(5,5),(6,6),(7,7)]
  

• Después de añadir la arista (5,6) de peso 3

  fromList [(1,1),(2,2),(3,3),(4,4),(5,5),(6,5),(7,7)]
  

• Después de añadir la arista (1,2) de peso 5

  fromList [(1,1),(2,1),(3,3),(4,4),(5,5),(6,5),(7,7)]
  

• Después de añadir la arista (4,5) de peso 5

  fromList [(1,1),(2,1),(3,3),(4,4),(5,4),(6,4),(7,7)]
  

• Después de añadir la arista (1,6) de peso 6

  fromList [(1,1),(2,1),(3,3),(4,1),(5,1),(6,1),(7,7)]
  

• Después de añadir la arista (2,3) de peso 7

  fromList [(1,1),(2,1),(3,1),(4,1),(5,1),(6,1),(7,7)]
  

• Las posibles aristas a añadir son:
  • la (3,5) con peso 7, que no es posible pues la raíz de 3 coincide con la raíz de 5, por lo que formaría un ciclo
  • la (3,4) con peso 8, que no es posible pues la raíz de 3 coincide con la raíz de 4, por lo que formaría un ciclo
  • la (1,3) con peso 9, que no es posible pues la raíz de 3 coincide con la raíz de 1, por lo que formaría un ciclo
  • la (5,7) con peso 9, que no forma ciclo

• Después de añadir la arista (5,7) con peso 9

  fromList [(1,1),(2,1),(3,1),(4,1),(5,1),(6,1),(7,1)]
  

• No es posible añadir más aristas, pues formarían ciclos.

(prim g) es el árbol de expansión mínimo del grafo g calculado mediante el algoritmo de Prim. Por ejemplo,

prim g1  == [(55,2,4),(34,1,3),(32,2,5),(12,1,2)]
prim g2  == [(32,2,5),(12,2,4),(13,1,2),(11,1,3)]
prim g3  == [(9,5,7),(7,2,3),(5,5,4),(3,6,5),(6,1,6),(5,1,2)]

Su definición es

prim :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]
prim g = prim' [n]              -- Nodos colocados
               ns               -- Nodos por colocar
               []               -- Árbol de expansión
               (aristas g)      -- Aristas del grafo
  where
    (n:ns) = nodos g
    prim' _ _ _  []  = []
    prim' _ [] ae _  = ae
    prim' t r  ae as = prim' (v':t) (delete v' r) (e:ae) as
      where e@(_,_, v') = minimum [(c,u,v)| (u,v,c) <- as,
                                             u `elem` t,
                                             v `elem` r]

(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]
(ND,array (1,3) [(1,[(2,4),(3,2)]),
                 (2,[(1,4),(3,5)]),
                  3,[(1,2),(2,5)])])
λ> generaGND 3 [4,-2,5]
(ND,array (1,3) [(1,[(2,4)]),(2,[(1,4),(3,5)]),(3,[(2,5)])])

Su definición es

generaGND :: Int -> [Int] -> Grafo Int Int
generaGND n ps  = creaGrafo ND (1,n) l3
  where l1 = [(x,y) | x <- [1..n], y <- [1..n], x < y]
        l2 = zip l1 ps
        l3 = [(x,y,z) | ((x,y),z) <- l2, z > 0]

genGND es un generador de grafos no dirigidos. Por ejemplo,

λ> sample genGND
(ND,array (1,1) [(1,[])])
(ND,array (1,3) [(1,[(2,3),(3,13)]),(2,[(1,3)]),(3,[(1,13)])])
...

Su definición es

genGND :: Gen (Grafo Int Int)
genGND = do n <- choose (1,50)
            xs <- vectorOf (n*n) arbitrary
            return (generaGND n xs)

Los grafos está contenido en la clase de los objetos generables aleatoriamente.

instance Arbitrary (Grafo Int Int) where
  arbitrary = genGND

(conexo g) se verifica si el grafo no dirigido g es conexo. Por ejemplo,

conexo (creaGrafo False (1,3) [(1,2,0),(3,2,0)])  ==  True
conexo (creaGrafo False (1,4) [(1,2,0),(3,4,0)])  ==  False

Su definición es

conexo :: (Ix a, Num p, Eq p) => Grafo a p -> Bool
conexo g = length (recorridoEnAnchura i g) == n
    where xs = nodos g
          i  = head xs
          n  = length xs

Propiedad: Si g es un grafo no dirigido conexo y con aristas, entonces

• (kruskal g) tiene el mismo conjunto de nodos que g,
• (prim g) tiene el mismo conjunto de nodos que g y
• los pesos de (kruskal g) y (prim g) son iguales.

prop_AE :: Grafo Int Int -> Property
prop_AE g =
  not (null (aristas g)) && conexo g ==>
  nodosAE (kruskal g) == ns &&
  nodosAE (prim g) == ns &&
  pesoAE (kruskal g) == pesoAE (prim g)
  where ns = nodos g
        nodosAE ae = sort (nub (concat [[x,y] | (_,x,y) <- ae]))
        pesoAE xs = sum [p | (p,_,_) <- xs]

La comprobación es

λ> quickCheck prop_AE
+++ OK, passed 100 tests.