Tema 22: Algoritmos sobre grafos

1 El TAD de los grafos

1.1 Definiciones y terminología sobre grafos

1.2 Signatura del TAD de los grafos

Signatura del TAD de los grafos

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

Descripción de la signatura del TAD de grafos

Ejemplo de creación de grafos.

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)]

crea el grafo

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

1.3 Implementación de los grafos como vectores de adyacencia

module 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
import Data.Array
data Orientacion = D | ND
                   deriving (Eq, Show)
data Grafo v p = G Orientacion (Array v [(v,p)])
                 deriving (Eq, Show)
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]))
       12
  1 -------- 2
  | \78     /|
  |  \   32/ |
  |   \   /  |
34|     5    |55
  |   /   \  |
  |  /44   \ |
  | /     93\|
  3 -------- 4
       61
ghci> 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)])])
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)]
ghci> 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,[])])
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)]
dirigido ejGrafoD   ==  True
dirigido ejGrafoND  ==  False
dirigido :: (Ix v,Num p) => (Grafo v p) -> Bool
dirigido (G o _) = o == D
adyacentes ejGrafoND 4  ==  [2,3,5]
adyacentes ejGrafoD  4  ==  [5]
adyacentes :: (Ix v,Num p) => (Grafo v p) -> v -> [v]
adyacentes (G _ g) v = map fst (g!v)
nodos ejGrafoND  ==  [1,2,3,4,5]
nodos ejGrafoD   ==  [1,2,3,4,5]
nodos :: (Ix v,Num p) => (Grafo v p) -> [v]
nodos (G _ g) = indices g
peso 1 5 ejGrafoND  ==  78
peso 1 5 ejGrafoD   ==  78
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 ejGrafoND (5,1)  ==  True
aristaEn ejGrafoND (4,1)  ==  False
aristaEn ejGrafoD  (5,1)  ==  False
aristaEn ejGrafoD  (1,5)  ==  True
aristaEn :: (Ix v,Num p) => (Grafo v p) -> (v,v) -> Bool
aristaEn g (x,y) = y `elem` adyacentes g x
ghci> 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)]
ghci> 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 :: (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] 

1.4 Implementación de los grafos como matrices de adyacencia

module 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
import Data.Array
data Orientacion = D | ND
                   deriving (Eq, Show)
data Grafo v p = G Orientacion (Array (v,v) (Maybe p))
                 deriving (Eq, Show)
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]
       12
  1 -------- 2
  | \78     /|
  |  \   32/ |
  |   \   /  |
34|     5    |55
  |   /   \  |
  |  /44   \ |
  | /     93\|
  3 -------- 4
       61
ghci> 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)]
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)]
ghci> 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)])
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)]
dirigido ejGrafoD   ==  True
dirigido ejGrafoND  ==  False
dirigido :: (Ix v,Num p) => (Grafo v p) -> Bool
dirigido (G o _) = o == D
adyacentes ejGrafoND 4  ==  [2,3,5]
adyacentes ejGrafoD  4  ==  [5]
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 ejGrafoND  ==  [1,2,3,4,5]
nodos ejGrafoD   ==  [1,2,3,4,5]
nodos :: (Ix v,Num p) => (Grafo v p) -> [v]
nodos (G _ g) = range (l,u) 
    where ((l,_),(u,_)) = bounds g
peso 1 5 ejGrafoND  ==  78
peso 1 5 ejGrafoD   ==  78
peso :: (Ix v,Num p) => v -> v -> (Grafo v p) -> p
peso x y (G _ g)  = w where (Just w) = g!(x,y)
aristaEn ejGrafoND (5,1)  ==  True
aristaEn ejGrafoND (4,1)  ==  False
aristaEn :: (Ix v,Num p) => (Grafo v p) -> (v,v) -> Bool
aristaEn (G _o g) (x,y)= (g!(x,y)) /= Nothing
ghci> 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)] 
ghci> 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 :: (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

2 Recorridos en profundidad y en anchura

2.1 Recorrido en profundidad

-- Nota: Elegir una implementación de los grafos.
import GrafoConVectorDeAdyacencia
-- import GrafoConMatrizDeAdyacencia
+---> 2 <---+
|           |
|           |
1 --> 3 --> 6 --> 5
|                 |
|                 |
+---> 4 <---------+
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)]

Procedimiento elemental de recorrido en profundidad

recorridoEnProfundidad 1 g  ==  [1,2,3,6,5,4]
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])
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]

Recorrido en profundidad con acumuladores

recorridoEnProfundidad' 1 g  ==  [1,2,3,6,5,4]
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)
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]

2.2 Recorrido en anchura

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

Procedimiento elemental de recorrido en anchura

recorridoEnAnchura 1 g  ==  [1,4,3,2,6,5]
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)
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]

3 Árboles de expansión mínimos

3.1 El algoritmo de Kruskal

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
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}
{1,2}, {2,3}, {4,5}, {6,7}, {1,4} y {4,7}.                                 
-- Nota: Seleccionar una implementación del TAD grafo.
import GrafoConVectorDeAdyacencia
-- import GrafoConMatrizDeAdyacencia

-- Nota: Seleccionar una implementación del TAD tabla.
-- import TablaConFunciones
import TablaConListasDeAsociacion
-- import TablaConMatrices

import Data.List
import Data.Ix
g1 :: Grafo Int Int    
g1 = 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)]

g2 :: Grafo Int Int    
g2 = creaGrafo D (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)]
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 :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]
kruskal g = kruskal' cola                           -- Cola de prioridad
                     (tabla [(x,x) | x <- nodos g]) -- Tabla de raices
                     []                             -- Árbol de expansión
                     ((length (nodos g)) - 1)       -- Aristas por
                                                    -- colocar
    where cola = sort [(p,x,y) | (x,y,p) <- aristas g]

kruskal' ((p,x,y):as) t ae n 
    | n==0        = ae
    | actualizado = kruskal' as t' ((p,x,y):ae) (n-1)
    | otherwise   = kruskal' as t  ae           n
    where (actualizado,t') = buscaActualiza (x,y) t
> raiz (crea [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 5  
1
> raiz (crea [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 2  
6
raiz:: Eq n => Tabla n n -> n -> n
raiz t x | v == x    = v
         | otherwise = raiz t v
         where v = valor t x
ghci> let t = crea [(1,1),(2,2),(3,1),(4,1)]
ghci> buscaActualiza (2,3) t
(True,Tbl [(1,1),(2,1),(3,1),(4,1)])
ghci> buscaActualiza (3,4) t
(False,Tbl [(1,1),(2,2),(3,1),(4,1)])
buscaActualiza :: (Eq n, Ord n) => (n,n) -> Tabla n n 
                                   -> (Bool,Tabla n n)
buscaActualiza (x,y) t 
    | x' == y'  = (False, t) 
    | y' <  x'  = (True, modifica (x,y') t)
    | otherwise = (True, modifica (y,x') t)
    where x' = raiz t x 
          y' = raiz t y

3.2 El algoritmo de Prim

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 :: (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' t [] ae as = ae
prim' t r  ae as = prim' (v':t) (delete v' r) (e:ae) as
    where e@(c,u', v') = minimum [(c,u,v)| (u,v,c) <- as,
                                           elem u t, 
                                           elem v r]

4 Bibliografía



Universidad de Sevilla

José A. Alonso Jiménez
Grupo de Lógica Computacional
Dpto. de Ciencias de la Computación e I.A.
Universidad de Sevilla