-- |
-- Module      : Monticulo
-- Description : TAD de los montículos.
-- License     : Creative Commons
-- Maintainer  : José A. Alonso
-- 
-- TAD (tipo abstracto de datos) de los montículos.
--
-- Este módulo contiene el código del TAD de los montículos
-- estudiado en el <http://bit.ly/1F5Sl5B tema 20> del curso.
-- 
-- 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
--        / \
--       /   \
--      2     6
--     / \   / \
--    3   8 9   7
-- es un montículo, pero
--         1
--        / \
--       /   \
--      3     6
--     / \   / \
--    4   2 9   7
-- no lo es.

module I1M.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)

-- | El tipo de dato de los montículos.
data Monticulo a = Vacio
                 | M a Int (Monticulo a) (Monticulo a)
  deriving Int -> Monticulo a -> ShowS
[Monticulo a] -> ShowS
Monticulo a -> String
(Int -> Monticulo a -> ShowS)
-> (Monticulo a -> String)
-> ([Monticulo a] -> ShowS)
-> Show (Monticulo a)
forall a. Show a => Int -> Monticulo a -> ShowS
forall a. Show a => [Monticulo a] -> ShowS
forall a. Show a => Monticulo a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Monticulo a] -> ShowS
$cshowList :: forall a. Show a => [Monticulo a] -> ShowS
show :: Monticulo a -> String
$cshow :: forall a. Show a => Monticulo a -> String
showsPrec :: Int -> Monticulo a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Monticulo a -> ShowS
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 :: Monticulo a
vacio = Monticulo a
forall a. Monticulo a
Vacio

-- | (rango m) es el rango del montículo m; es decir, la menor distancia
-- a un montículo vacío. Por ejemplo,
-- 
-- > rango (foldr inserta vacio [6,1,4,8])  ==  2
-- > rango (foldr inserta vacio [7,5])      ==  1
rango :: Ord a => Monticulo a -> Int
rango :: Monticulo a -> Int
rango Monticulo a
Vacio       = Int
0
rango (M a
_ Int
r Monticulo a
_ Monticulo a
_) = Int
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> creaM 0 (foldr inserta vacio [6,1,4,8]) (foldr inserta vacio [7,5])
-- > 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 (foldr inserta vacio [7,5]) (foldr inserta vacio [6,1,4,8])
-- > 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 :: a -> Monticulo a -> Monticulo a -> Monticulo a
creaM a
x Monticulo a
a Monticulo a
b | Monticulo a -> Int
forall a. Ord a => Monticulo a -> Int
rango Monticulo a
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Monticulo a -> Int
forall a. Ord a => Monticulo a -> Int
rango Monticulo a
b = a -> Int -> Monticulo a -> Monticulo a -> Monticulo a
forall a. a -> Int -> Monticulo a -> Monticulo a -> Monticulo a
M a
x (Monticulo a -> Int
forall a. Ord a => Monticulo a -> Int
rango Monticulo a
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Monticulo a
a Monticulo a
b
            | Bool
otherwise          = a -> Int -> Monticulo a -> Monticulo a -> Monticulo a
forall a. a -> Int -> Monticulo a -> Monticulo a -> Monticulo a
M a
x (Monticulo a -> Int
forall a. Ord a => Monticulo a -> Int
rango Monticulo a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Monticulo a
b Monticulo a
a

-- | (mezcla m1 m2) es el montículo obtenido mezclando los montículos m1 y
-- m2. Por ejemplo,
--
-- > ghci> mezcla (foldr inserta vacio [6,1,4,8]) (foldr inserta vacio [7,5])
-- > 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 :: Monticulo a -> Monticulo a -> Monticulo a
mezcla Monticulo a
m Monticulo a
Vacio = Monticulo a
m
mezcla Monticulo a
Vacio Monticulo a
m = Monticulo a
m
mezcla m1 :: Monticulo a
m1@(M a
x Int
_ Monticulo a
a1 Monticulo a
b1) m2 :: Monticulo a
m2@(M a
y Int
_ Monticulo a
a2 Monticulo a
b2)
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y    = a -> Monticulo a -> Monticulo a -> Monticulo a
forall a. Ord a => a -> Monticulo a -> Monticulo a -> Monticulo a
creaM a
x Monticulo a
a1 (Monticulo a -> Monticulo a -> Monticulo a
forall a. Ord a => Monticulo a -> Monticulo a -> Monticulo a
mezcla Monticulo a
b1 Monticulo a
m2)
  | Bool
otherwise = a -> Monticulo a -> Monticulo a -> Monticulo a
forall a. Ord a => a -> Monticulo a -> Monticulo a -> Monticulo a
creaM a
y Monticulo a
a2 (Monticulo a -> Monticulo a -> Monticulo a
forall a. Ord a => Monticulo a -> Monticulo a -> Monticulo a
mezcla Monticulo a
m1 Monticulo a
b2)

-- | (inserta x m) es el montículo obtenido añadiendo el elemento x al
-- montículo m. Por ejemplo, 
-- 
-- > ghci> inserta 3 (foldr inserta vacio [6,1,4,8])
-- > 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 :: a -> Monticulo a -> Monticulo a
inserta a
x = Monticulo a -> Monticulo a -> Monticulo a
forall a. Ord a => Monticulo a -> Monticulo a -> Monticulo a
mezcla (a -> Int -> Monticulo a -> Monticulo a -> Monticulo a
forall a. a -> Int -> Monticulo a -> Monticulo a -> Monticulo a
M a
x Int
1 Monticulo a
forall a. Monticulo a
Vacio Monticulo a
forall a. Monticulo a
Vacio) 

-- | (menor m) es el menor elemento del montículo m. Por ejemplo, 
--
-- > menor (foldr inserta vacio [6,1,4,8])  ==  1
-- > menor (foldr inserta vacio [7,5])      ==  5
menor  :: Ord a => Monticulo a -> a
menor :: Monticulo a -> a
menor (M a
x Int
_ Monticulo a
_ Monticulo a
_) = a
x
menor Monticulo a
Vacio       = String -> a
forall a. HasCallStack => String -> a
error String
"menor: monticulo vacio"

-- | (resto m) es el montículo obtenido eliminando el menor elemento del
-- montículo m. Por ejemplo, 
--
-- > ghci> resto (foldr inserta vacio [6,1,4,8])
-- > M 4 2 (M 8 1 Vacio Vacio) (M 6 1 Vacio Vacio)
resto :: Ord a => Monticulo a -> Monticulo a
resto :: Monticulo a -> Monticulo a
resto Monticulo a
Vacio       = String -> Monticulo a
forall a. HasCallStack => String -> a
error String
"resto: monticulo vacio"
resto (M a
_ Int
_ Monticulo a
a Monticulo a
b) = Monticulo a -> Monticulo a -> Monticulo a
forall a. Ord a => Monticulo a -> Monticulo a -> Monticulo a
mezcla Monticulo a
a Monticulo a
b

-- | (esVacio m) se verifica si m es el montículo vacío.
esVacio :: Ord a => Monticulo a -> Bool
esVacio :: Monticulo a -> Bool
esVacio Monticulo a
Vacio = Bool
True
esVacio Monticulo a
_     = Bool
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 (foldr inserta vacio [6,1,4,8])    ==  True
-- > valido (foldr inserta vacio [7,5])        ==  True
-- > valido (M 3 5 (M 2 1 Vacio Vacio) Vacio)  ==  False
valido :: Ord a => Monticulo a -> Bool
valido :: Monticulo a -> Bool
valido Monticulo a
Vacio = Bool
True
valido (M a
_ Int
_ Monticulo a
Vacio Monticulo a
Vacio) = Bool
True
valido (M a
x Int
_ m1 :: Monticulo a
m1@(M a
x1 Int
_ Monticulo a
_ Monticulo a
_) Monticulo a
Vacio) = 
  a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x1 Bool -> Bool -> Bool
&& Monticulo a -> Bool
forall a. Ord a => Monticulo a -> Bool
valido Monticulo a
m1
valido (M a
x Int
_ Monticulo a
Vacio m2 :: Monticulo a
m2@(M a
x2 Int
_ Monticulo a
_ Monticulo a
_)) = 
  a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x2 Bool -> Bool -> Bool
&& Monticulo a -> Bool
forall a. Ord a => Monticulo a -> Bool
valido Monticulo a
m2
valido (M a
x Int
_ m1 :: Monticulo a
m1@(M a
x1 Int
_ Monticulo a
_ Monticulo a
_) m2 :: Monticulo a
m2@(M a
x2 Int
_ Monticulo a
_ Monticulo a
_)) = 
  a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x1 Bool -> Bool -> Bool
&& Monticulo a -> Bool
forall a. Ord a => Monticulo a -> Bool
valido Monticulo a
m1 Bool -> Bool -> Bool
&&
  a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x2 Bool -> Bool -> Bool
&& Monticulo a -> Bool
forall a. Ord a => Monticulo a -> Bool
valido Monticulo a
m2

-- | (elementos m) es la lista de los elementos del montículo m. Por
-- ejemplo, 
--
-- > elementos (foldr inserta vacio [6,1,4,8])  ==  [1,4,8,6]
elementos :: Ord a => Monticulo a -> [a]
elementos :: Monticulo a -> [a]
elementos Monticulo a
Vacio       = []
elementos (M a
x Int
_ Monticulo a
a Monticulo a
b) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Monticulo a -> [a]
forall a. Ord a => Monticulo a -> [a]
elementos Monticulo a
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Monticulo a -> [a]
forall a. Ord a => Monticulo a -> [a]
elementos Monticulo a
b

-- | (equivMonticulos m1 m2) se verifica si los montículos m1 y m2 tienen
-- los mismos elementos. Por ejemplo,
--
-- > ghci> equivMonticulos (foldr inserta vacio [6,1,4]) (foldr inserta vacio [6,4,1])
-- > True
equivMonticulos :: Ord a => Monticulo a -> Monticulo a -> Bool
equivMonticulos :: Monticulo a -> Monticulo a -> Bool
equivMonticulos Monticulo a
m1 Monticulo a
m2 = 
  [a] -> [a]
forall a. Ord a => [a] -> [a]
sort (Monticulo a -> [a]
forall a. Ord a => Monticulo a -> [a]
elementos Monticulo a
m1) [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> [a]
forall a. Ord a => [a] -> [a]
sort (Monticulo a -> [a]
forall a. Ord a => Monticulo a -> [a]
elementos Monticulo a
m2)

-- Los montículos son comparables por igualdad.
instance Ord a => Eq (Monticulo a) where
  == :: Monticulo a -> Monticulo a -> Bool
(==) = Monticulo a -> Monticulo a -> Bool
forall a. Ord a => Monticulo a -> Monticulo a -> Bool
equivMonticulos