-- |
-- Module      : Conjunto
-- Description : TAD de los conjuntos.
-- License     : Creative Commons
-- Maintainer  : José A. Alonso
-- 
-- TAD (tipo abstracto de datos) de los conjuntos.
--
-- Este módulo contiene el código del TAD de los conjuntos
-- estudiado en el <http://bit.ly/1WYZzmW tema 17> del curso.

module I1M.Conjunto
  (Conj,
   vacio,     -- Conj a                       
   esVacio,   -- Conj a -> Bool               
   pertenece, -- Ord a => a -> Conj a -> Bool  
   inserta,   -- Ord a => a -> Conj a -> Conj a
   elimina    -- Ord a => a -> Conj a -> Conj a
  ) where

-- | Tipo de dato de los conjuntos.
newtype Conj a = Cj [a]
  deriving Conj a -> Conj a -> Bool
(Conj a -> Conj a -> Bool)
-> (Conj a -> Conj a -> Bool) -> Eq (Conj a)
forall a. Eq a => Conj a -> Conj a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Conj a -> Conj a -> Bool
== :: Conj a -> Conj a -> Bool
$c/= :: forall a. Eq a => Conj a -> Conj a -> Bool
/= :: Conj a -> Conj a -> Bool
Eq

-- Procedimiento de escritura de los conjuntos.
instance (Show a) => Show (Conj a) where
  showsPrec :: Int -> Conj a -> ShowS
showsPrec Int
_ (Cj [a]
s) = [a] -> ShowS
forall a. Show a => [a] -> ShowS
showConj [a]
s 

showConj :: Show a => [a] -> String -> String
showConj :: forall a. Show a => [a] -> ShowS
showConj []     String
cad = String -> ShowS
showString String
"{}" String
cad
showConj (a
x:[a]
xs) String
cad = Char -> ShowS
showChar Char
'{' (a -> ShowS
forall a. Show a => a -> ShowS
shows a
x ([a] -> ShowS
forall a. Show a => [a] -> ShowS
showl [a]
xs String
cad))
  where showl :: [a] -> ShowS
showl []     String
cs = Char -> ShowS
showChar Char
'}' String
cs
        showl (a
y:[a]
ys) String
cs = Char -> ShowS
showChar Char
',' (a -> ShowS
forall a. Show a => a -> ShowS
shows a
y ([a] -> ShowS
showl [a]
ys String
cs))

-- En los ejemplos se usará el siguiente conjunto.
-- 
-- > ghci> c1
-- > {0,1,2,3,5,7,9}
-- c1 :: Conj Int
-- c1 = foldr inserta vacio [2,5,1,3,7,5,3,2,1,9,0]

-- | vacio es el conjunto vacío. Por ejemplo,
-- 
-- > ghci> vacio
-- > {}
vacio :: Conj a                         
vacio :: forall a. Conj a
vacio = [a] -> Conj a
forall a. [a] -> Conj a
Cj []

-- | (esVacio c) se verifica si c es el conjunto vacío. Por ejemplo, 
-- 
-- > λ> esVacio (foldr inserta vacio [2,5])
-- > False
-- > λ> esVacio vacio
-- > True
esVacio :: Conj a -> Bool                
esVacio :: forall a. Conj a -> Bool
esVacio (Cj [a]
xs) = [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs

-- | (pertenece x c) se verifica si x pertenece al conjunto c. Por ejemplo, 
-- 
-- > λ> let c1 = foldr inserta vacio [2,5,3,2]
-- > λ> pertenece 3 c1
-- > True
-- > λ> pertenece 4 c1
-- > False
pertenece :: Ord a => a -> Conj a -> Bool 
pertenece :: forall a. Ord a => a -> Conj a -> Bool
pertenece a
x (Cj [a]
s) = a
x a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x) [a]
s

-- | (inserta x c) es el conjunto obtenido añadiendo el elemento x al
-- conjunto c. Por ejemplo,
-- 
-- > λ> let c1 = foldr inserta vacio [2,5,3,2]
-- > λ> c1
-- > {2,3,5}
-- > λ> inserta 3 c1
-- > {2,3,5}
-- > λ> inserta 4 c1
-- > {2,3,4,5}
inserta :: Ord a => a -> Conj a -> Conj a
inserta :: forall a. Ord a => a -> Conj a -> Conj a
inserta a
x (Cj [a]
s) = [a] -> Conj a
forall a. [a] -> Conj a
Cj (a -> [a] -> [a]
forall {a}. Ord a => a -> [a] -> [a]
agrega a
x [a]
s)
  where agrega :: a -> [a] -> [a]
agrega a
x' []                    = [a
x']                
        agrega a
x' s' :: [a]
s'@(a
y:[a]
ys) | a
x' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y    = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a] -> [a]
agrega a
x' [a]
ys
                            | a
x' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y    = a
x' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
s'
                            | Bool
otherwise = [a]
s'

-- | (elimina x c) es el conjunto obtenido eliminando el elemento x
-- del conjunto c. Por ejemplo,
-- 
-- > λ> let c1 = foldr inserta vacio [2,5,3,2]
-- > λ> c1
-- > {2,3,5}
-- > λ> elimina 3 c1
-- > {2,5}
-- > λ> elimina 7 c1
-- > {2,3,5}
elimina :: Ord a => a -> Conj a -> Conj a
elimina :: forall a. Ord a => a -> Conj a -> Conj a
elimina a
x (Cj [a]
s) = [a] -> Conj a
forall a. [a] -> Conj a
Cj (a -> [a] -> [a]
forall {a}. Ord a => a -> [a] -> [a]
elimina' a
x [a]
s)
  where elimina' :: a -> [a] -> [a]
elimina' a
_ []                    = []
        elimina' a
x' s' :: [a]
s'@(a
y:[a]
ys') | a
x' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y    = a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a] -> [a]
elimina' a
x' [a]
ys'
                               | a
x' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y    = [a]
s'
                               | Bool
otherwise = [a]
ys'