José A. Alonso
Departamento de Ciencias de la Computación e I.A.
Universidad de Sevilla
Sevilla, 16 de agosto de 2019
Notas:
:opt no-lint
Descripción de los montículos
Un montículo es un árbol binario en el que los valores de cada nodo es menor o igual que los valores de sus hijos. Por ejemplo,
sesion
1 1
/ \ / \
/ \ / \
2 6 3 6
/ \ / \ / \ / \
3 8 9 7 4 2 9 7
el de la izquierda es un montículo, pero el de la derecha no lo es.
Signatura del TAD de los montículos
sesion
vacio :: Ord a => Monticulo a
inserta :: Ord a => a -> Monticulo a -> Monticulo a
menor :: Ord a => Monticulo a -> a
resto :: Ord a => Monticulo a -> Monticulo a
esVacio :: Ord a => Monticulo a -> Bool
valido :: Ord a => Monticulo a -> Bool
Descripción de las operaciones:
vacio
es el montículo vacío.
(inserta x m)
es el montículo obtenido añadiendo el elemento x
al
montículo m
.
(menor m)
es el menor elemento del montículo m
.
(resto m)
es el montículo obtenido eliminando el menor elemento del
montículo m
.
(esVacio m)
se verifica si m
es el montículo vacío.
(valido m)
se verifica si m
es un montículo; es decir, es un árbol
binario en el que los valores de cada nodo es menor o igual que los valores
de sus hijos.
esVacio vacio
valido (inserta x m)
not (esVacio (inserta x m))
not (esVacio m) ==> valido (resto m)
resto (inserta x vacio) == vacio
x <= menor m ==> resto (inserta x m) == m
Si m
es no vacío y x > menor m
, entonces
resto (inserta x m) == inserta x (resto m)
esVacio m || esVacio (resto m) || menor m <= menor (resto m)
module Monticulo
(Monticulo,
vacio, -- Ord a => Monticulo a
inserta, -- Ord a => a -> Monticulo a -> Monticulo a
menor, -- Ord a => Monticulo a -> a
resto, -- Ord a => Monticulo a -> Monticulo a
esVacio, -- Ord a => Monticulo a -> Bool
valido -- Ord a => Monticulo a -> Bool
) where
import Data.List (sort)
-- Implementación de montículos mediante árboles izquierdistas ("leftist
-- tree").
data Monticulo a = Vacio
| M a Int (Monticulo a) (Monticulo a)
deriving Show
-- Ejemplos de montículos
-- ghci> ejM1
-- M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio Vacio)
-- ghci> ejM2
-- M 5 1 (M 7 1 Vacio Vacio) Vacio
-- ghci> ejM3
-- M 1 2
-- (M 5 2
-- (M 7 1 Vacio Vacio)
-- (M 6 1 Vacio Vacio))
-- (M 4 1
-- (M 8 1 Vacio Vacio)
-- Vacio)
-- Gráficamente
-- ejM1 ejM2 ejM3
--
-- (1,2)
-- (1,2) (5,1) / \
-- / \ / / \
-- (4,1) (6,1) (7,1) (5,2) (4,1)
-- / / \ /
-- (8,1) (7,1) (6,1) (8,1)
ejM1, ejM1', ejM2, ejM3 :: Monticulo Int
ejM1 = foldr inserta vacio [6,1,4,8]
ejM1' = foldr inserta vacio [6,8,4,1]
ejM2 = foldr inserta vacio [7,5]
ejM3 = mezcla ejM1 ejM2
-- vacio es el montículo vacío.
vacio :: Ord a => Monticulo a
vacio = Vacio
-- (rango m) es el rango del montículo m; es decir, la menor distancia
-- a un montículo vacío. Por ejemplo,
-- rango ejM1 == 2
-- rango ejM2 == 1
rango :: Ord a => Monticulo a -> Int
rango Vacio = 0
rango (M _ r _ _) = r
-- (creaM x a b) es el montículo creado a partir del elemento x y los
-- montículos a y b. Se supone que x es menor o igual que el mínimo de
-- a y de b. Por ejemplo,
-- ghci> ejM1
-- M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio Vacio)
-- ghci> ejM2
-- M 5 1 (M 7 1 Vacio Vacio) Vacio
-- ghci> creaM 0 ejM1 ejM2
-- M 0 2 (M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio Vacio))
-- (M 5 1 (M 7 1 Vacio Vacio) Vacio)
-- ghci> creaM 0 ejM2 ejM1
-- M 0 2 (M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio Vacio))
-- (M 5 1 (M 7 1 Vacio Vacio) Vacio)
creaM :: Ord a => a -> Monticulo a -> Monticulo a -> Monticulo a
creaM x a b | rango a >= rango b = M x (rango b + 1) a b
| otherwise = M x (rango a + 1) b a
-- (mezcla m1 m2) es el montículo obtenido mezclando los montículos m1 y
-- m2. Por ejemplo,
-- ghci> mezcla ejM1 ejM2
-- M 1 2
-- (M 5 2
-- (M 7 1 Vacio Vacio)
-- (M 6 1 Vacio Vacio))
-- (M 4 1
-- (M 8 1 Vacio Vacio)
-- Vacio)
mezcla :: Ord a => Monticulo a -> Monticulo a -> Monticulo a
mezcla m Vacio = m
mezcla Vacio m = m
mezcla m1@(M x _ a1 b1) m2@(M y _ a2 b2)
| x <= y = creaM x a1 (mezcla b1 m2)
| otherwise = creaM y a2 (mezcla m1 b2)
-- (inserta x m) es el montículo obtenido añadiendo el elemento x al
-- montículo m. Por ejemplo,
-- ghci> ejM1
-- M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio Vacio)
-- ghci> inserta 3 ejM1
-- M 1 2
-- (M 4 1 (M 8 1 Vacio Vacio) Vacio)
-- (M 3 1 (M 6 1 Vacio Vacio) Vacio)
inserta :: Ord a => a -> Monticulo a -> Monticulo a
inserta x = mezcla (M x 1 Vacio Vacio)
-- (menor m) es el menor elemento del montículo m. Por ejemplo,
-- menor ejM1 == 1
-- menor ejM2 == 5
menor :: Ord a => Monticulo a -> a
menor (M x _ _ _) = x
menor Vacio = error "menor: monticulo vacio"
-- (resto m) es el montículo obtenido eliminando el menor elemento del
-- montículo m. Por ejemplo,
-- ghci> ejM1
-- M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio Vacio)
-- ghci> resto ejM1
-- M 4 2 (M 8 1 Vacio Vacio) (M 6 1 Vacio Vacio)
resto :: Ord a => Monticulo a -> Monticulo a
resto Vacio = error "resto: monticulo vacio"
resto (M _ _ a b) = mezcla a b
-- (esVacio m) se verifica si m es el montículo vacío.
esVacio :: Ord a => Monticulo a -> Bool
esVacio Vacio = True
esVacio _ = False
-- (valido m) se verifica si m es un montículo; es decir, es un árbol
-- binario en el que los valores de cada nodo es menor o igual que los
-- valores de sus hijos. Por ejemplo,
-- valido ejM1 == True
-- valido ejM2 == True
-- valido ejM3 == True
-- valido (M 3 5 (M 2 1 Vacio Vacio) Vacio) == False
valido :: Ord a => Monticulo a -> Bool
valido Vacio = True
valido (M _ _ Vacio Vacio) = True
valido (M x _ m1@(M x1 _ _ _) Vacio) =
x <= x1 && valido m1
valido (M x _ Vacio m2@(M x2 _ _ _)) =
x <= x2 && valido m2
valido (M x _ m1@(M x1 _ _ _) m2@(M x2 _ _ _)) =
x <= x1 && valido m1 &&
x <= x2 && valido m2
-- (elementos m) es la lista de los elementos del montículo m. Por
-- ejemplo,
-- elementos ejM1 == [1,4,8,6]
elementos :: Ord a => Monticulo a -> [a]
elementos Vacio = []
elementos (M x _ a b) = x : elementos a ++ elementos b
-- (equivMonticulos m1 m2) se verifica si los montículos m1 y m2 tienen
-- los mismos elementos. Por ejemplo,
-- ghci> ejM1
-- M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio Vacio)
-- ghci> ejM1'
-- M 1 2 (M 4 1 Vacio Vacio) (M 6 1 (M 8 1 Vacio Vacio) Vacio)
-- ghci> equivMonticulos ejM1 ejM1'
-- True
equivMonticulos :: Ord a => Monticulo a -> Monticulo a -> Bool
equivMonticulos m1 m2 =
sort (elementos m1) == sort (elementos m2)
-- Los montículos son comparables por igualdad.
instance Ord a => Eq (Monticulo a) where
(==) = equivMonticulos
-- ---------------------------------------------------------------------
-- Funciones auxiliares --
-- ---------------------------------------------------------------------
-- (menorTodos x m) comprueba si x es menor que todos los elementos de m
menorTodos :: Ord a => a -> Monticulo a -> Bool
menorTodos _ Vacio = True
menorTodos x (M y n a b) = x <= y && valido (M y n a b)
-- (enMonticulo x m) se verifica si x es un elemento del montículo
-- m. Por ejemplo,
-- enMonticulo 4 ejM1 == True
-- enMonticulo 5 ejM1 == False
enMonticulo :: Ord a => a -> Monticulo a -> Bool
enMonticulo _ Vacio = False
enMonticulo x (M y _ a b)
| x < y = False
| x == y = True
| otherwise = enMonticulo x a || enMonticulo x b
m1 :: Monticulo Int
m1 = foldr inserta vacio [6,1,4,8]
m1
M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio Vacio)
m2 :: Monticulo Int
m2 = foldr inserta vacio [7,5]
m2
M 5 1 (M 7 1 Vacio Vacio) Vacio
inserta 3 m1
M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 3 1 (M 6 1 Vacio Vacio) Vacio)
menor m1
1
menor m2
5
resto m1
M 4 2 (M 8 1 Vacio Vacio) (M 6 1 Vacio Vacio)
valido m1
True
:m - Monticulo
{-# LANGUAGE FlexibleInstances #-}
module MonticuloPropiedades where
import Monticulo
import Test.QuickCheck
-- ---------------------------------------------------------------------
-- Generador de montículos --
-- ---------------------------------------------------------------------
-- (creaMonticulo xs) es el montículo correspondiente a la lista xs. Por
-- ejemplo,
-- ghci> creaMonticulo [6,1,4,8]
-- M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio Vacio)
creaMonticulo :: [Int] -> Monticulo Int
creaMonticulo = foldr inserta vacio
-- genMonticulo es un generador de montículos. Por ejemplo,
-- ghci> sample genMonticulo
-- VacioM
-- M (-1) 1 (M 1 1 VacioM VacioM) VacioM
-- ...
genMonticulo :: Gen (Monticulo Int)
genMonticulo = do
xs <- listOf arbitrary
return (creaMonticulo xs)
-- Montículo es una instancia de la clase arbitraria.
instance Arbitrary (Monticulo Int) where
arbitrary = genMonticulo
-- genMonticulo genera montículos válidos.
prop_genMonticulo :: Monticulo Int -> Bool
prop_genMonticulo = valido
-- Comprobación.
-- ghci> quickCheck prop_genMonticulo
-- +++ OK, passed 100 tests.
-- monticuloNV es un generador de montículos no vacío. Por ejemplo,
-- ghci> sample monticuloNV
-- M 0 1 VacioM VacioM
-- M 1 1 (M 1 1 (M 1 1 VacioM VacioM) VacioM) VacioM
-- M 0 2 (M 1 1 VacioM VacioM) (M 2 1 VacioM VacioM)
-- M (-4) 2 (M (-3) 1 VacioM VacioM) (M 1 1 VacioM VacioM)
-- M 3 1 VacioM VacioM
-- M (-8) 1 (M (-5) 1 VacioM VacioM) VacioM
monticuloNV :: Gen (Monticulo Int)
monticuloNV = do
xs <- listOf arbitrary
x <- arbitrary
return (creaMonticulo (x:xs))
-- Prop. monticuloNV genera montículos no vacío.
prop_monticuloNV :: Monticulo Int -> Property
prop_monticuloNV _ =
forAll monticuloNV (\m -> valido m && not (esVacio m))
-- Comprobación.
-- *Main> quickCheck prop_monticuloNV
-- +++ OK, passed 100 tests.
-- ---------------------------------------------------------------------
-- Propiedades
-- ---------------------------------------------------------------------
-- Propiedades de vacio
-- --------------------
-- Propiedad. vacio es un montículo.
prop_vacio_es_monticulo :: Bool
prop_vacio_es_monticulo =
esVacio (vacio :: Monticulo Int)
-- Comprobación.
-- ghci> prop_vacio_es_monticulo
-- True
-- Propiedades de inserta
-- ----------------------
-- Propiedad. inserta produce montículos válidos.
prop_inserta_es_valida :: Int -> Monticulo Int -> Bool
prop_inserta_es_valida x m =
valido (inserta x m)
-- Comprobación.
-- ghci> quickCheck prop_inserta_es_valida
-- +++ OK, passed 100 tests.
-- Propiedad. Los montículos creados con inserta son no vacío.
prop_inserta_no_vacio :: Int -> Monticulo Int -> Bool
prop_inserta_no_vacio x m =
not (esVacio (inserta x m))
-- Comprobación.
-- ghci> quickCheck prop_inserta_no_vacio
-- +++ OK, passed 100 tests.
-- Propiedades de resto
-- --------------------
-- Propiedad. Al borrar el menor elemento de un montículo no vacío se
-- obtiene un montículo válido.
prop_resto_es_valida :: Monticulo Int -> Property
prop_resto_es_valida _ =
forAll monticuloNV (valido . resto)
-- Comprobación.
-- ghci> quickCheck prop_resto_es_valida
-- +++ OK, passed 100 tests.
-- Propiedad. El resto de (inserta x m) es m si m es el montículo vacío
-- o x es menor o igual que el menor elemento de m o (inserta x (resto m)),
-- en caso contrario.
prop_resto_inserta :: Int -> Monticulo Int -> Bool
prop_resto_inserta x m =
resto (inserta x m)
== if esVacio m || x <= menor m
then m
else inserta x (resto m)
-- Comprobación.
-- ghci> quickCheck prop_resto_inserta
-- +++ OK, passed 100 tests.
-- Propiedades de menor
-- --------------------
-- Propiedad. (menor m) es el menor elemento del montículo m.
prop_menor_es_minimo :: Monticulo Int -> Bool
prop_menor_es_minimo m =
esVacio m ||
esVacio (resto m) ||
menor m <= menor (resto m)
-- Comprobación.
-- ghci> quickCheck prop_menor_es_minimo
-- +++ OK, passed 100 tests.
import Test.QuickCheck
quickCheck prop_genMonticulo
quickCheck prop_monticuloNV
quickCheck prop_vacio_es_monticulo
quickCheck prop_inserta_es_valida
quickCheck prop_inserta_no_vacio
quickCheck prop_resto_es_valida
quickCheck prop_resto_inserta
quickCheck prop_menor_es_minimo
+++ OK, passed 100 tests.
+++ OK, passed 100 tests.
+++ OK, passed 1 test.
+++ OK, passed 100 tests.
+++ OK, passed 100 tests.
+++ OK, passed 100 tests.
+++ OK, passed 100 tests.
+++ OK, passed 100 tests.
module ColaDePrioridadConMonticulos
(CPrioridad,
vacia, -- Ord a => CPrioridad a
inserta, -- Ord a => a -> CPrioridad a -> CPrioridad a
primero, -- Ord a => CPrioridad a -> a
resto, -- Ord a => CPrioridad a -> CPrioridad a
esVacia, -- Ord a => CPrioridad a -> Bool
valida -- Ord a => CPrioridad a -> Bool
) where
import qualified Monticulo as M
-- Colas de prioridad mediante montículos.
newtype CPrioridad a = CP (M.Monticulo a)
deriving (Eq, Show)
-- Ejemplo de cola de prioridad
-- *Main> cp1
-- CP (M 1 2
-- (M 2 2
-- (M 9 1 VacioM VacioM)
-- (M 7 1 VacioM VacioM))
-- (M 3 1 VacioM VacioM))
cp1 :: CPrioridad Int
cp1 = foldr inserta vacia [3,1,7,2,9]
-- vacia es la cola de prioridad vacía. Por ejemplo,
-- vacia == CP Vacio
vacia :: Ord a => CPrioridad a
vacia = CP M.vacio
-- (inserta x c) añade el elemento x a la cola de prioridad c. Por ejemplo,
-- ghci> cp1
-- CP (M 1 2
-- (M 2 2
-- (M 9 1 VacioM VacioM)
-- (M 7 1 VacioM VacioM))
-- (M 3 1 VacioM VacioM))
-- ghci> inserta 5 cp1
-- CP (M 1 2
-- (M 2 2
-- (M 9 1 VacioM VacioM)
-- (M 7 1 VacioM VacioM))
-- (M 3 1
-- (M 5 1 VacioM VacioM) VacioM))
inserta :: Ord a => a -> CPrioridad a -> CPrioridad a
inserta v (CP c) = CP (M.inserta v c)
-- (primero c) es la cabeza de la cola de prioridad c. Por ejemplo,
-- primero cp1 == 1
primero :: Ord a => CPrioridad a -> a
primero (CP c) = M.menor c
-- (resto c) elimina la cabeza de la cola de prioridad c. Por ejemplo,
-- ghci> cp1
-- CP (M 1 2
-- (M 2 2
-- (M 9 1 VacioM VacioM)
-- (M 7 1 VacioM VacioM))
-- (M 3 1 VacioM VacioM))
-- ghci> resto cp1
-- CP (M 2 2
-- (M 9 1 VacioM VacioM)
-- (M 3 1
-- (M 7 1 VacioM VacioM) VacioM))
resto :: Ord a => CPrioridad a -> CPrioridad a
resto (CP c) = CP (M.resto c)
-- (esVacia c) se verifica si la cola de prioridad c es vacía. Por
-- ejemplo,
-- esVacia cp1 == False
-- esVacia vacia == True
esVacia :: Ord a => CPrioridad a -> Bool
esVacia (CP c) = M.esVacio c
-- (valida c) se verifica si c es una cola de prioridad válida. En la
-- representación mediante montículo todas las colas de prioridad son
-- válidas.
valida :: Ord a => CPrioridad a -> Bool
valida _ = True
cp1 :: CPrioridad Int
cp1 = foldr inserta vacia [3,1,7,2,9]
cp1
CP (M 1 2 (M 2 2 (M 9 1 Vacio Vacio) (M 7 1 Vacio Vacio)) (M 3 1 Vacio Vacio))
vacia
CP Vacio
inserta 5 cp1
CP (M 1 2 (M 2 2 (M 9 1 Vacio Vacio) (M 7 1 Vacio Vacio)) (M 3 1 (M 5 1 Vacio Vacio) Vacio))
primero cp1 == 1
True
resto cp1
CP (M 2 2 (M 9 1 Vacio Vacio) (M 3 1 (M 7 1 Vacio Vacio) Vacio))
esVacia cp1
False
esVacia vacia
True
Nota Se borran los ficheros de los módulos usados
:! rm -f *.hs *.hi *.o *.dyn_*