I1M2014: Implementación en Haskell de los algoritmos de Kruskal y de Prim

En la clase de hoy de Informática de 1º del Grado en Matemáticashemos estudiado la implementación en Haskell de los algoritmos de Kruskal y de Prim para calcular los árboles de expansión mínimo.

Las transparencias usadas en la clase son las páginas 44-57 tema 22.

El código se muestra a continuación

-- ---------------------------------------------------------------------
-- Importaciones                                                      --
-- ---------------------------------------------------------------------

import Data.List
import Data.Ix
import I1M.Grafo -- Se instala con http://bit.ly/1AKmUQB 
import I1M.Tabla -- Se instala con http://bit.ly/1AKmUQB 

-- ---------------------------------------------------------------------
-- Ejemplos                                                           --
-- ---------------------------------------------------------------------

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

g3 = creaGrafo D (1,7) [(1,2,1),(1,4,4),
                        (2,3,2),(2,4,6),(2,5,4),
                        (3,5,5),(3,6,6),
                        (4,5,3),(4,7,4),
                        (5,6,8),(5,7,7),
                        (6,7,3)] 

-- ---------------------------------------------------------------------
-- Algoritmo de Kruskal                                               --
-- ---------------------------------------------------------------------

-- (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  ==  [(4,4,7),(4,1,4),(3,6,7),(3,4,5),(2,2,3),(1,1,2)]
kruskal :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]
kruskal g = kruskal' cola                      -- Cola de prioridad
                     (tabla [(x,x) | x <- ns]) -- Tabla de raices
                     []                        -- Árbol de expansión
                     (length ns - 1)           -- Aristas por colocar
    where ns   = nodos g
          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

-- (buscaActualiza a t) es el par formado por False y la tabla t, si los
-- dos vértices de la arista a tienen la misma raíz en t y el par
-- formado por True y la tabla obtenida añadiéndole a t 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. Por ejemplo,
--    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

-- (raiz t n) es la raíz de n en la tabla t. Por ejemplo,
--    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

-- ---------------------------------------------------------------------
-- § Ejemplos de Kruskal                                              --
-- ---------------------------------------------------------------------

-- cola = [(12,1,2),(32,2,5),(34,1,3),(44,3,5),(55,2,4),(61,3,4),(78,1,5),(93,4,5)]
-- t    = Tbl [(1,1),(2,2),(3,3),(4,4),(5,5)]
-- ae   = []
-- n    = 4
--
-- cola = [(32,2,5),(34,1,3),(44,3,5),(55,2,4),(61,3,4),(78,1,5),(93,4,5)]
-- t    = Tbl [(1,1),(2,1),(3,3),(4,4),(5,5)]
-- ae   = [(12,1,2)]
-- n    = 3
--
-- cola = [(34,1,3),(44,3,5),(55,2,4),(61,3,4),(78,1,5),(93,4,5)]
-- t    = Tbl [(1,1),(2,1),(3,3),(4,4),(5,1)]
-- ae   = [(32,2,5),(12,1,2)]
-- n    = 2
--
-- cola = [(44,3,5),(55,2,4),(61,3,4),(78,1,5),(93,4,5)]
-- t    = Tbl [(1,1),(2,1),(3,1),(4,4),(5,1)]
-- ae   = [(34,1,3),(32,2,5),(12,1,2)]
-- n    = 1
--
-- cola = [(55,2,4),(61,3,4),(78,1,5),(93,4,5)]
-- t    = Tbl [(1,1),(2,1),(3,1),(4,4),(5,1)]
-- ae   = [(34,1,3),(32,2,5),(12,1,2)]
-- n    = 1
--
-- cola = [(61,3,4),(78,1,5),(93,4,5)]
-- t    = Tbl [(1,1),(2,1),(3,1),(4,1),(5,1)]
-- ae   = [(55,2,4),(34,1,3),(32,2,5),(12,1,2)]
-- n    = 0

-- ---------------------------------------------------------------------
-- El algoritmo de Prim                                                  --
-- ---------------------------------------------------------------------

-- (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 :: (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]

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

-- ---------------------------------------------------------------------

-- Importaciones --

-- ---------------------------------------------------------------------

import Data.List

import Data.Ix

import I1M.Grafo -- Se instala con http://bit.ly/1AKmUQB

import I1M.Tabla -- Se instala con http://bit.ly/1AKmUQB

-- ---------------------------------------------------------------------

-- Ejemplos --

-- ---------------------------------------------------------------------

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

g3 = creaGrafo D (1,7) [(1,2,1),(1,4,4),

(2,3,2),(2,4,6),(2,5,4),

(3,5,5),(3,6,6),

(4,5,3),(4,7,4),

(5,6,8),(5,7,7),

(6,7,3)]

-- ---------------------------------------------------------------------

-- Algoritmo de Kruskal --

-- ---------------------------------------------------------------------

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

kruskal :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]

kruskal g = kruskal' cola -- Cola de prioridad

(tabla [(x,x) | x <- ns]) -- Tabla de raices

[] -- Árbol de expansión

(length ns - 1) -- Aristas por colocar

where ns = nodos g

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

-- (buscaActualiza a t) es el par formado por False y la tabla t, si los

-- dos vértices de la arista a tienen la misma raíz en t y el par

-- formado por True y la tabla obtenida añadiéndole a t 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. Por ejemplo,

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

-- (raiz t n) es la raíz de n en la tabla t. Por ejemplo,

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

-- ---------------------------------------------------------------------

-- § Ejemplos de Kruskal --

-- ---------------------------------------------------------------------

-- cola = [(12,1,2),(32,2,5),(34,1,3),(44,3,5),(55,2,4),(61,3,4),(78,1,5),(93,4,5)]

-- t = Tbl [(1,1),(2,2),(3,3),(4,4),(5,5)]

-- ae = []

-- n = 4

-- cola = [(32,2,5),(34,1,3),(44,3,5),(55,2,4),(61,3,4),(78,1,5),(93,4,5)]

-- t = Tbl [(1,1),(2,1),(3,3),(4,4),(5,5)]

-- ae = [(12,1,2)]

-- n = 3

-- cola = [(34,1,3),(44,3,5),(55,2,4),(61,3,4),(78,1,5),(93,4,5)]

-- t = Tbl [(1,1),(2,1),(3,3),(4,4),(5,1)]

-- ae = [(32,2,5),(12,1,2)]

-- n = 2

-- cola = [(44,3,5),(55,2,4),(61,3,4),(78,1,5),(93,4,5)]

-- t = Tbl [(1,1),(2,1),(3,1),(4,4),(5,1)]

-- ae = [(34,1,3),(32,2,5),(12,1,2)]

-- n = 1

-- cola = [(55,2,4),(61,3,4),(78,1,5),(93,4,5)]

-- t = Tbl [(1,1),(2,1),(3,1),(4,4),(5,1)]

-- ae = [(34,1,3),(32,2,5),(12,1,2)]

-- n = 1

-- cola = [(61,3,4),(78,1,5),(93,4,5)]

-- t = Tbl [(1,1),(2,1),(3,1),(4,1),(5,1)]

-- ae = [(55,2,4),(34,1,3),(32,2,5),(12,1,2)]

-- n = 0

-- ---------------------------------------------------------------------

-- El algoritmo de Prim --

-- ---------------------------------------------------------------------

-- (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 :: (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]

Se puede imprimir o compartir con