El tipo abstracto de datos de los montículos en Haskell

Continuando la serie dedicada a los tipos de datos abstractos (TAD) en Haskell, hoy le toca el turno a los montículos

Un montículo (heap en inglés) 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

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.

El contenido del resto del artículo es el siguiente:

la signatura del TAD de los montículos;
las propiedades del TAD de los montículos;
la implementación, en Haskell, de los montículos mediante tipos de datos algebraicos;
la comprobación con QuickCheck de sus propiedades y
la implementación de las colas de prioridad mediante montículos.

La signatura del TAD de los montículos

Las signatura de las operaciones del TAD de los montículos son las siguientes:

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

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

con el siguiente significado

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.

Propiedades del TAD de los montículos

Las propiedades son las siguientes:

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)

Implementación de los montículos mediante tipos de datos algebraicos

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 Ord a => Monticulo a = Vacio
                          | M a Int (Monticulo a) (Monticulo a)
                            deriving Show

-- Ejemplos de montículos
--    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> m3
--    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
--            m1             m2                m3
--        
--                                             (1,2) 
--            (1,2)          (5,1)            /     \
--           /     \        /                /       \
--        (4,1)   (6,1)  (7,1)           (5,2)        (4,1)
--       /                              /     \       /
--    (8,1)                          (7,1)   (6,1)  (8,1)
m1, m1', m2, m3 :: Monticulo Int
m1  = foldr inserta vacio [6,1,4,8]
m1' = foldr inserta vacio [6,8,4,1]
m2  = foldr inserta vacio [7,5]
m3 = mezcla m1 m2

-- 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 m1  ==  2
--    rango m2  ==  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> 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)
--    ghci> creaM 0 m2 m1
--    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 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)

-- (inserta x m) es el montículo obtenido añadiendo el elemento x al
-- montículo m. Por ejemplo, 
--    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 m) es el menor elemento del montículo m. Por ejemplo, 
--   menor m1  ==  1
--   menor m2  ==  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> m1
--    M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio 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 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 m1  ==  True
--    valido m2  ==  True
--    valido m3  ==  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 m) es la lista de los elementos del montículo m. Por
-- ejemplo, 
--    elementos m1  ==  [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> m1
--    M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio Vacio)
--    ghci> m1'
--    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)

-- 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 x 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 m1  ==  True
--    enMonticulo 5 m1  ==  False
enMonticulo x Vacio      = False
enMonticulo x (M y _ a b) 
    | x < y     = False
    | x == y    = True
    | otherwise = enMonticulo x a || enMonticulo x b

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

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

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 Ord a => Monticulo a = Vacio

| M a Int (Monticulo a) (Monticulo a)

deriving Show

-- Ejemplos de montículos

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

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

-- m1 m2 m3

-- (1,2)

-- (1,2) (5,1) / \

-- / \ / / \

-- (4,1) (6,1) (7,1) (5,2) (4,1)

-- / / \ /

-- (8,1) (7,1) (6,1) (8,1)

m1, m1', m2, m3 :: Monticulo Int

m1 = foldr inserta vacio [6,1,4,8]

m1' = foldr inserta vacio [6,8,4,1]

m2 = foldr inserta vacio [7,5]

m3 = mezcla m1 m2

-- 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 m1 == 2

-- rango m2 == 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> 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)

-- ghci> creaM 0 m2 m1

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

-- (inserta x m) es el montículo obtenido añadiendo el elemento x al

-- montículo m. Por ejemplo,

-- 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 m) es el menor elemento del montículo m. Por ejemplo,

-- menor m1 == 1

-- menor m2 == 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> m1

-- M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio 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 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 m1 == True

-- valido m2 == True

-- valido m3 == 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 m) es la lista de los elementos del montículo m. Por

-- ejemplo,

-- elementos m1 == [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> m1

-- M 1 2 (M 4 1 (M 8 1 Vacio Vacio) Vacio) (M 6 1 Vacio Vacio)

-- ghci> m1'

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

-- 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 x 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 m1 == True

-- enMonticulo 5 m1 == False

enMonticulo x Vacio = False

enMonticulo x (M y _ a b)

| x < y = False

| x == y = True

| otherwise = enMonticulo x a || enMonticulo x b

Propiedades de los montículos

{-# LANGUAGE FlexibleInstances #-}

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 m = valido m

-- 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 m =
    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 m =
    forAll monticuloNV  (\m -> valido (resto m))

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

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

136

137

{-# LANGUAGE FlexibleInstances #-}

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 m = valido m

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

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

forAll monticuloNV (\m -> valido (resto m))

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

Implementación de las colas de prioridad mediante 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

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

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

El objetivo de la serie es la elaboración de los temas de TAD del curso de Informática del Grado en Matemáticas.

La signatura del TAD de los montículos

Propiedades del TAD de los montículos

Implementación de los montículos mediante tipos de datos algebraicos

Propiedades de los montículos

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

Se puede imprimir o compartir con