Tema 20: El TAD de los montículos

1 Especificación del TAD de los montículos

1.1 Signatura del TAD de los montículos

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,

        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

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:

1.2 Propiedades del TAD de los montículos

2 Implementación del TAD de los montículos

2.1 Los montículos como tipo de dato algebraico

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)
data Ord a => Monticulo a 
                = Vacio
                | M a Int (Monticulo a) (Monticulo a)
                deriving Show
m1, m2, m3 :: Monticulo Int
m1 = foldr inserta vacio [6,1,4,8]
m2 = foldr inserta vacio [7,5]
m3 = mezcla m1 m2
vacio :: Ord a => Monticulo a
vacio = Vacio
rango m1  ==  2
rango m2  ==  1
rango :: Ord a => Monticulo a -> Int
rango Vacio       = 0
rango (M _ r _ _) = r
ghci> m1
M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio Vacio)
ghci> m2
M 5 1 (M 7 1 Vacio Vacio) Vacio
ghci> creaM 0 m1 m2
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
ghci> mezcla m1 m2
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)
ghci> m1
M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) 
      (M 6 1 Vacio Vacio)
ghci> inserta 3 m1
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 m = mezcla (M x 1 Vacio Vacio) m
menor m1  ==  1
menor m2  ==  5
menor  :: Ord a => Monticulo a -> a
menor (M x _ _ _) = x
menor Vacio       = error "menor: monticulo vacio"
ghci> resto m1
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 x _ a b) = mezcla a b
esVacio :: Ord a => Monticulo a -> Bool
esVacio Vacio = True
esVacio _     = False
valido m1  ==  True
valido (M 3 5 (M 2 1 Vacio Vacio) Vacio)  ==  False
valido :: Ord a => Monticulo a -> Bool
valido Vacio = True
valido (M x _ Vacio Vacio) = True
valido (M x _ m1@(M x1 n1 a1 b1) Vacio) = 
    x <= x1 && valido m1
valido (M x _ Vacio m2@(M x2 n2 a2 b2)) = 
    x <= x2 && valido m2
valido (M x _ m1@(M x1 n1 a1 b1) m2@(M x2 n2 a2 b2)) = 
    x <= x1 && valido m1 &&
    x <= x2 && valido m2
elementos m1  ==  [1,4,8,6]
elementos :: Ord a => Monticulo a -> [a]
elementos Vacio       = []
elementos (M x _ a b) = x : elementos a ++ elementos b
ghci> m1
M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) 
      (M 6 1 Vacio Vacio)
ghci> let m1' = foldr inserta vacio [6,8,4,1]
M 1 2 (M 4 1 Vacio Vacio) 
      (M 6 1 (M 8 1 Vacio Vacio) Vacio)
ghci> equivMonticulos m1 m1'
True
equivMonticulos :: Ord a => Monticulo a -> Monticulo a 
                   -> Bool
equivMonticulos m1 m2 = 
    sort (elementos m1) == sort (elementos m2)
instance Ord a => Eq (Monticulo a) where
   (==) = equivMonticulos

3 Comprobación de la implementación con QuickCheck

3.1 Librerías auxiliares

import Monticulo
import Test.QuickCheck
import Test.Framework
import Test.Framework.Providers.QuickCheck2

3.2 Generador de montículos

ghci> creaMonticulo [6,1,4,8]
M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) 
      (M 6 1 Vacio Vacio)
ghci> creaMonticulo [6,8,4,1]
M 1 2 (M 4 1 Vacio Vacio) 
      (M 6 1 (M 8 1 Vacio Vacio) Vacio)
creaMonticulo :: [Int] -> Monticulo Int
creaMonticulo = foldr inserta vacio
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)

instance Arbitrary (Monticulo Int) where
    arbitrary = genMonticulo

Corrección del generador de montículos

prop_genMonticulo :: Monticulo Int -> Bool
prop_genMonticulo m = valido m
ghci> quickCheck prop_genMonticulo
+++ OK, passed 100 tests.

Generador de montículos no vacíos

ghci> sample monticuloNV
M 0 1 VacioM VacioM
M 1 1 (M 1 1 (M 1 1 VacioM VacioM) VacioM) VacioM
...
monticuloNV :: Gen (Monticulo Int)
monticuloNV = do xs <- listOf arbitrary
                 x <- arbitrary
                 return (creaMonticulo (x:xs))

Corrección del generador de montículos no vacíos

prop_monticuloNV :: Monticulo Int -> Property
prop_monticuloNV m =
    forAll monticuloNV 
           (\m -> (valido m) && not (esVacio m))
ghci> quickCheck prop_monticuloNV
+++ OK, passed 100 tests.

3.3 Especificación de las propiedades de los montículos

prop_vacio_es_monticulo :: Bool
prop_vacio_es_monticulo = 
    esVacio (vacio :: Monticulo Int)
prop_inserta_es_valida :: Int -> Monticulo Int -> Bool
prop_inserta_es_valida x m =
    valido (inserta x m)
prop_inserta_no_vacio :: Int -> Monticulo Int -> Bool
prop_inserta_no_vacio x m =
    not (esVacio (inserta x m))
prop_resto_es_valida :: Monticulo Int -> Property
prop_resto_es_valida m =
    forAll monticuloNV  (\m -> valido (resto m))
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)
prop_menor_es_minimo :: Monticulo Int -> Bool
prop_menor_es_minimo m =
    esVacio m || esVacio (resto m) ||
    menor m <= menor (resto m)

3.4 Comprobación de las propiedades

Definición del procedimiento de comprobación

compruebaPropiedades = 
    defaultMain 
        [testGroup "Propiedades del TAD monticulo"
         [testProperty "P1" prop_genMonticulo,
          testProperty "P2" prop_monticuloNV,
          testProperty "P3" prop_vacio_es_monticulo,
          testProperty "P4" prop_inserta_es_valida,
          testProperty "P5" prop_inserta_no_vacio,
          testProperty "P6" prop_resto_es_valida,
          testProperty "P7" prop_resto_inserta,
          testProperty "P8" prop_menor_es_minimo]]

Comprobación de las propiedades de los montículos

ghci> compruebaPropiedades 
Propiedades del TAD monticulo:
  P1: [OK, passed 100 tests]
  P2: [OK, passed 100 tests]
  P3: [OK, passed 100 tests]
  P4: [OK, passed 100 tests]
  P5: [OK, passed 100 tests]
  P6: [OK, passed 100 tests]
  P7: [OK, passed 100 tests]
  P8: [OK, passed 100 tests]

         Properties  Total      
 Passed  8           8          
 Failed  0           0          
 Total   8           8 

4 Implementación de las colas de prioridad mediante montículos

4.1 Las colas de prioridad como montículos

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
newtype CPrioridad a = CP (M.Monticulo a)
    deriving (Eq, Show)
cp1 :: CPrioridad Int
cp1 = foldr inserta vacia [3,1,7,2,9]
ghci> cp1
CP (M 1 2 
      (M 2 2 
         (M 9 1 VacioM VacioM) 
         (M 7 1 VacioM VacioM)) 
      (M 3 1 VacioM VacioM))
vacia  == CP Vacio
vacia :: Ord a => CPrioridad a 
vacia = CP M.vacio
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 cp1  ==  1
primero :: Ord a => CPrioridad a -> a
primero (CP c) = M.menor c
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 cp1    ==  False
esVacia vacia  ==  True
esVacia :: Ord a => CPrioridad a -> Bool 
esVacia (CP c) = M.esVacio c
valida :: Ord a => CPrioridad a -> Bool
valida _ = True

5 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