El tipo abstracto de datos de las colas de prioridad en Haskell

En este artículo continúo la serie dedicada a los tipos de datos abstractos (TAD) en Haskell presentando el TAD de las colas de prioridad.

Una cola de prioridad (en inglés, priority queue) es una cola en la que cada elemento tiene asociada una prioridad y la operación de extracción siempre elige el elemento de menor prioridad. Un ejemplo de cola de prioridad es el formado por una lista de ciudades ordenadas por su distancia a un destino final.

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

la signatura del TAD de las colas de prioridad;
las propiedades del TAD de las colas de prioridad;
la implementación, en Haskell, de las colas de prioridad mediante listas y
la comprobación con QuickCheck de sus propiedades.

Posteriormente, cuando se estudien los montículos, se presentará otra implementación de las colas de prioridad mediante montículos.

La signatura del TAD de las colas de prioridad

Las signatura de las operaciones del TAD de las colas prioridad son las siguientes:

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

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

con el siguiente significado

vacia es la cola de prioridad vacía.
(inserta x c) añade el elemento x a la cola de
prioridad c.
(primero c) es el primer elemento de la cola de prioridad
c.
(resto c) es el resto de la cola de prioridad c.
(esVacia c) se verifica si la cola de prioridad c
es vacía.
(valida c) se verifica si c es una cola de prioridad
válida.

Propiedades del TAD de las colas de prioridad

Las propiedades son las siguientes:

inserta x (inserta y c) = inserta y (inserta x c)
primero (inserta x vacia) = x
Si x <= y, entonces primero (inserta y (inserta x c)) = primero (inserta x c)
resto (inserta x vacia) = vacia
Si x <= y, entonces resto (inserta y (inserta x c)) = inserta y (resto (inserta x c))
esVacia vacia
not (esVacia (inserta x c))

Implementación de las colas de prioridad mediante listas

module ColaDePrioridadConListas
    (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

-- Colas de prioridad mediante listas.
newtype CPrioridad a = CP [a]
    deriving (Eq, Show)

-- Ejemplo de cola de prioridad
--    ghci> cp1
--    CP [1,2,3,7,9]
cp1 :: CPrioridad Int
cp1 = foldr inserta vacia [3,1,7,2,9]

-- (valida c) se verifica si c es una cola de prioridad válida. Por
-- ejemplo, 
--    valida (CP [1,3,5])  ==  True
--    valida (CP [1,5,3])  ==  False
valida :: Ord a => CPrioridad a -> Bool
valida (CP xs) = ordenada xs
    where ordenada (x:y:zs) = x <= y && ordenada (y:zs)
          ordenada _        = True

-- vacia es la cola de prioridad vacía. Por ejemplo,
--    vacia  ==  CP []
vacia :: Ord a => CPrioridad a 
vacia = CP []

-- (inserta x c) es la cola obtenida añadiendo el elemento x a la cola
-- de prioridad c. Por ejemplo,  
--    cp1            ==  CP [1,2,3,7,9]
--    inserta 5 cp1  ==  CP [1,2,3,5,7,9]
inserta :: Ord a => a -> CPrioridad a -> CPrioridad a 
inserta x (CP q) = CP (ins x q)
    where ins x []                   = [x]
          ins x r@(e:r') | x < e     = x:r
                         | otherwise = e:ins x r'

-- Nota. inserta usa O(n) pasos.

-- (primero c) es el primer elemento de la cola de prioridad c. Por
-- ejemplo, 
--    cp1          ==  CP [1,2,3,7,9]
--    primero cp1  ==  1
primero :: Ord a => CPrioridad a -> a
primero (CP(x:_)) = x
primero _         = error "primero: cola de prioridad vacia"

-- (resto c) es la cola de prioridad obtenida eliminando el primer
-- elemento de la cola de prioridad c. Por ejemplo,  
--    cp1        ==  CP [1,2,3,7,9]
--    resto cp1  ==  CP [2,3,7,9]
resto :: Ord a => CPrioridad a -> CPrioridad a
resto (CP (_:xs)) = CP xs
resto _           = error "resto: cola de prioridad vacia"

-- Nota. resto usa O(1) pasos.

-- (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 xs) = null xs

module ColaDePrioridadConListas

(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

-- Colas de prioridad mediante listas.

newtype CPrioridad a = CP [a]

deriving (Eq, Show)

-- Ejemplo de cola de prioridad

-- ghci> cp1

-- CP [1,2,3,7,9]

cp1 :: CPrioridad Int

cp1 = foldr inserta vacia [3,1,7,2,9]

-- (valida c) se verifica si c es una cola de prioridad válida. Por

-- ejemplo,

-- valida (CP [1,3,5]) == True

-- valida (CP [1,5,3]) == False

valida :: Ord a => CPrioridad a -> Bool

valida (CP xs) = ordenada xs

where ordenada (x:y:zs) = x <= y && ordenada (y:zs)

ordenada _ = True

-- vacia es la cola de prioridad vacía. Por ejemplo,

-- vacia == CP []

vacia :: Ord a => CPrioridad a

vacia = CP []

-- (inserta x c) es la cola obtenida añadiendo el elemento x a la cola

-- de prioridad c. Por ejemplo,

-- cp1 == CP [1,2,3,7,9]

-- inserta 5 cp1 == CP [1,2,3,5,7,9]

inserta :: Ord a => a -> CPrioridad a -> CPrioridad a

inserta x (CP q) = CP (ins x q)

where ins x [] = [x]

ins x r@(e:r') | x < e = x:r

| otherwise = e:ins x r'

-- Nota. inserta usa O(n) pasos.

-- (primero c) es el primer elemento de la cola de prioridad c. Por

-- ejemplo,

-- cp1 == CP [1,2,3,7,9]

-- primero cp1 == 1

primero :: Ord a => CPrioridad a -> a

primero (CP(x:_)) = x

primero _ = error "primero: cola de prioridad vacia"

-- (resto c) es la cola de prioridad obtenida eliminando el primer

-- elemento de la cola de prioridad c. Por ejemplo,

-- cp1 == CP [1,2,3,7,9]

-- resto cp1 == CP [2,3,7,9]

resto :: Ord a => CPrioridad a -> CPrioridad a

resto (CP (_:xs)) = CP xs

resto _ = error "resto: cola de prioridad vacia"

-- Nota. resto usa O(1) pasos.

-- (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 xs) = null xs

Propiedades de las colas de prioridad

module ColaDePrioridadPropiedades where

-- Nota: Hay que elegir una de las 2 implementaciones del TAD cola de
-- prioridad. 
import ColaDePrioridadConListas
-- import ColaDePrioridadConMonticulos

import Test.QuickCheck
import Test.Framework (defaultMain, testGroup)
import Test.Framework.Providers.QuickCheck2 (testProperty)

-- ---------------------------------------------------------------------
-- Generador de colas de prioridad
-- ---------------------------------------------------------------------

-- genCPrioridad es un generador de colas de prioridad. Por ejemplo,
--    ghci> sample genCPrioridad
--    CP []
--    CP []
--    CP [-4]
--    CP [-2,-1,-1,2,5]
--    CP [-8,-5,4,6,8]
--    CP [-4,-1,3,3,6,7,10,10,10,10]
--    CP [-12,-10,-9,-7,2,4,6,7,7,9]
--    CP [-14,-12,-12,-7,-7,-4,4,9,14]
--    CP [-10,-9,-5,14]
--    CP [18]
--    CP [-19,-17,-16,-15,-13,-13,-13,-12,-6,-5,-3,0,2,3,4,5,8,18]
genCPrioridad :: (Arbitrary a, Num a, Ord a) =>  Gen (CPrioridad a)
genCPrioridad = do xs <- listOf arbitrary
                   return (foldr inserta vacia xs)

-- La colas de prioridad son una concreción de la clase arbitraria. 
instance (Arbitrary a, Num a, Ord a) => Arbitrary (CPrioridad a) where
    arbitrary = genCPrioridad

-- Prop.: Las colas de prioridad producidas por genCPrioridad son
-- válidas. 
prop_genCPrioridad_correcto ::  CPrioridad Int -> Bool
prop_genCPrioridad_correcto c = valida c

-- Comprobación.
--    ghci> quickCheck prop_genCPrioridad_correcto
--    +++ OK, passed 100 tests.

-- ---------------------------------------------------------------------
-- Propiedades
-- ---------------------------------------------------------------------

-- Propiedad. Si se añade dos elementos a una cola de prioridad se
-- obtiene la misma cola de prioridad idependientemente del orden en
-- que se añadan los elementos.
prop_inserta_conmuta :: Int -> Int -> CPrioridad Int -> Bool
prop_inserta_conmuta x y c =
    inserta x (inserta y c) == inserta y (inserta x c)

-- Comprobación.
--    ghci> quickCheck prop_inserta_conmuta
--    +++ OK, passed 100 tests.

-- Propiedad. La cabeza de la cola de prioridad obtenida anadiendo un
-- elemento x a la cola de prioridad vacía es x.
prop_primero_inserta_vacia :: Int -> CPrioridad Int -> Bool
prop_primero_inserta_vacia x c =
    primero (inserta x vacia) == x

-- Comprobación.
--    ghci> quickCheck prop_primero_inserta_vacia
--    +++ OK, passed 100 tests.
 
-- Propiedad. El primer elemento de una cola de prioridad c no cambia
-- cuando se le añade un elemento mayor o igual que algún elemento de c. 
prop_primero_inserta :: Int -> Int -> CPrioridad Int -> Property
prop_primero_inserta x y c =
    x <= y ==> 
    primero (inserta y c') == primero c'
    where c' = inserta x c

-- Comprobación.
--    ghci> quickCheck prop_primero_inserta
--    +++ OK, passed 100 tests.

-- Propiedad. El resto de añadir un elemento a la cola de prioridad
-- vacía es la cola vacía. 
prop_resto_inserta_vacia :: Int -> Bool
prop_resto_inserta_vacia x =
    resto (inserta x vacia) == vacia

-- Comprobación.
--    ghci> quickCheck prop_resto_inserta_vacia
--    +++ OK, passed 100 tests.

-- Propiedad. El resto de la cola de prioridad obtenida añadiendo un
-- elemento y a una cola c' (que tiene algún elemento menor o igual que
-- y) es la cola que se obtiene añadiendo y al resto de c'.
prop_resto_inserta :: Int -> Int -> CPrioridad Int -> Property
prop_resto_inserta x y c =
    x <= y ==> 
    resto (inserta y c') == inserta y (resto c')
    where c' = inserta x c

-- Comprobación:
--    ghci> quickCheck prop_resto_inserta
--    +++ OK, passed 100 tests.

-- Propiedad. vacia es una cola vacía.
prop_vacia_es_vacia :: Bool
prop_vacia_es_vacia = esVacia (vacia :: CPrioridad Int)

-- Comprobación.
--    ghci> quickCheck prop_vacia_es_vacia
--    +++ OK, passed 100 tests.

-- Propiedad. Si se añade un elemento a una cola de prioridad se obtiene
-- una cola no vacía.
prop_inserta_no_es_vacia :: Int -> CPrioridad Int -> Bool
prop_inserta_no_es_vacia x c =
    not (esVacia (inserta x c))

-- Comprobación.
--    ghci> quickCheck prop_inserta_no_es_vacia
--    +++ OK, passed 100 tests.

-- compruebaPropiedades comprueba todas las propiedades con la
-- plataforma de verificación. Por ejemplo,
--    ghci> compruebaPropiedades
--    Corrección del generador:
--      P0: [OK, passed 100 tests]
--    Propiedades de colas de prioridad:
--      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]
--    
--             Properties  Total      
--     Passed  8           8          
--     Failed  0           0          
--     Total   8           8  
compruebaPropiedades = 
    defaultMain 
        [testGroup "Corrección del generador" 
          [testProperty "P0" prop_genCPrioridad_correcto],
         testGroup "Propiedades de colas de prioridad:"
          [testProperty "P1" prop_inserta_conmuta,
           testProperty "P2" prop_primero_inserta_vacia,
           testProperty "P3" prop_primero_inserta,
           testProperty "P4" prop_resto_inserta_vacia,
           testProperty "P5" prop_resto_inserta,
           testProperty "P6" prop_vacia_es_vacia,
           testProperty "P7" prop_inserta_no_es_vacia]]

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

module ColaDePrioridadPropiedades where

-- Nota: Hay que elegir una de las 2 implementaciones del TAD cola de

-- prioridad.

import ColaDePrioridadConListas

-- import ColaDePrioridadConMonticulos

import Test.QuickCheck

import Test.Framework (defaultMain, testGroup)

import Test.Framework.Providers.QuickCheck2 (testProperty)

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

-- Generador de colas de prioridad

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

-- genCPrioridad es un generador de colas de prioridad. Por ejemplo,

-- ghci> sample genCPrioridad

-- CP []

-- CP [-4]

-- CP [-2,-1,-1,2,5]

-- CP [-8,-5,4,6,8]

-- CP [-4,-1,3,3,6,7,10,10,10,10]

-- CP [-12,-10,-9,-7,2,4,6,7,7,9]

-- CP [-14,-12,-12,-7,-7,-4,4,9,14]

-- CP [-10,-9,-5,14]

-- CP [18]

-- CP [-19,-17,-16,-15,-13,-13,-13,-12,-6,-5,-3,0,2,3,4,5,8,18]

genCPrioridad :: (Arbitrary a, Num a, Ord a) => Gen (CPrioridad a)

genCPrioridad = do xs <- listOf arbitrary

return (foldr inserta vacia xs)

-- La colas de prioridad son una concreción de la clase arbitraria.

instance (Arbitrary a, Num a, Ord a) => Arbitrary (CPrioridad a) where

arbitrary = genCPrioridad

-- Prop.: Las colas de prioridad producidas por genCPrioridad son

-- válidas.

prop_genCPrioridad_correcto :: CPrioridad Int -> Bool

prop_genCPrioridad_correcto c = valida c

-- Comprobación.

-- ghci> quickCheck prop_genCPrioridad_correcto

-- +++ OK, passed 100 tests.

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

-- Propiedades

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

-- Propiedad. Si se añade dos elementos a una cola de prioridad se

-- obtiene la misma cola de prioridad idependientemente del orden en

-- que se añadan los elementos.

prop_inserta_conmuta :: Int -> Int -> CPrioridad Int -> Bool

prop_inserta_conmuta x y c =

inserta x (inserta y c) == inserta y (inserta x c)

-- Comprobación.

-- ghci> quickCheck prop_inserta_conmuta

-- +++ OK, passed 100 tests.

-- Propiedad. La cabeza de la cola de prioridad obtenida anadiendo un

-- elemento x a la cola de prioridad vacía es x.

prop_primero_inserta_vacia :: Int -> CPrioridad Int -> Bool

prop_primero_inserta_vacia x c =

primero (inserta x vacia) == x

-- Comprobación.

-- ghci> quickCheck prop_primero_inserta_vacia

-- +++ OK, passed 100 tests.

-- Propiedad. El primer elemento de una cola de prioridad c no cambia

-- cuando se le añade un elemento mayor o igual que algún elemento de c.

prop_primero_inserta :: Int -> Int -> CPrioridad Int -> Property

prop_primero_inserta x y c =

x <= y ==>

primero (inserta y c') == primero c'

where c' = inserta x c

-- Comprobación.

-- ghci> quickCheck prop_primero_inserta

-- +++ OK, passed 100 tests.

-- Propiedad. El resto de añadir un elemento a la cola de prioridad

-- vacía es la cola vacía.

prop_resto_inserta_vacia :: Int -> Bool

prop_resto_inserta_vacia x =

resto (inserta x vacia) == vacia

-- Comprobación.

-- ghci> quickCheck prop_resto_inserta_vacia

-- +++ OK, passed 100 tests.

-- Propiedad. El resto de la cola de prioridad obtenida añadiendo un

-- elemento y a una cola c' (que tiene algún elemento menor o igual que

-- y) es la cola que se obtiene añadiendo y al resto de c'.

prop_resto_inserta :: Int -> Int -> CPrioridad Int -> Property

prop_resto_inserta x y c =

x <= y ==>

resto (inserta y c') == inserta y (resto c')

where c' = inserta x c

-- Comprobación:

-- ghci> quickCheck prop_resto_inserta

-- +++ OK, passed 100 tests.

-- Propiedad. vacia es una cola vacía.

prop_vacia_es_vacia :: Bool

prop_vacia_es_vacia = esVacia (vacia :: CPrioridad Int)

-- Comprobación.

-- ghci> quickCheck prop_vacia_es_vacia

-- +++ OK, passed 100 tests.

-- Propiedad. Si se añade un elemento a una cola de prioridad se obtiene

-- una cola no vacía.

prop_inserta_no_es_vacia :: Int -> CPrioridad Int -> Bool

prop_inserta_no_es_vacia x c =

not (esVacia (inserta x c))

-- Comprobación.

-- ghci> quickCheck prop_inserta_no_es_vacia

-- +++ OK, passed 100 tests.

-- compruebaPropiedades comprueba todas las propiedades con la

-- plataforma de verificación. Por ejemplo,

-- ghci> compruebaPropiedades

-- Corrección del generador:

-- P0: [OK, passed 100 tests]

-- Propiedades de colas de prioridad:

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

-- Properties Total

-- Passed 8 8

-- Failed 0 0

-- Total 8 8

compruebaPropiedades =

defaultMain

[testGroup "Corrección del generador"

[testProperty "P0" prop_genCPrioridad_correcto],

testGroup "Propiedades de colas de prioridad:"

[testProperty "P1" prop_inserta_conmuta,

testProperty "P2" prop_primero_inserta_vacia,

testProperty "P3" prop_primero_inserta,

testProperty "P4" prop_resto_inserta_vacia,

testProperty "P5" prop_resto_inserta,

testProperty "P6" prop_vacia_es_vacia,

testProperty "P7" prop_inserta_no_es_vacia]]

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 las colas de prioridad

Propiedades del TAD de las colas de prioridad

Implementación de las colas de prioridad mediante listas

Propiedades de las colas de prioridad

Se puede imprimir o compartir con