I1M2013: 4º examen de programación con Haskell

En la clase de hoy del curso Informática (de 1º de Grado en Matemáticas) se ha realizado el 4º examen del curso. Además, durante esta semana se han realizado los exámenes de los otros grupos. A continuación se muestran las soluciones de dichos exámenes.

Las soluciones del examen del grupo 3 son

-- ---------------------------------------------------------------------
-- Ejercicio 1. [2.5 puntos] Definir la función
--    interpretaciones :: [a] -> [[(a,Int)]]
-- tal que (interpretaciones xs) es la lista de las interpretaciones
-- sobre la lista de las variables proposicionales xs sobre los valores
-- de verdad 0 y 1. Por ejemplo,
--    ghci> interpretaciones "A"
--    [[('A',0)],[('A',1)]]
--    ghci> interpretaciones "AB"
--    [[('A',0),('B',0)],[('A',0),('B',1)],
--     [('A',1),('B',0)],[('A',1),('B',1)]]
--    ghci> interpretaciones "ABC"
--    [[('A',0),('B',0),('C',0)],[('A',0),('B',0),('C',1)],
--     [('A',0),('B',1),('C',0)],[('A',0),('B',1),('C',1)],
--     [('A',1),('B',0),('C',0)],[('A',1),('B',0),('C',1)],
--     [('A',1),('B',1),('C',0)],[('A',1),('B',1),('C',1)]]
-- ---------------------------------------------------------------------

interpretaciones :: [a] -> [[(a,Int)]]
interpretaciones [] = [[]]
interpretaciones (x:xs) = 
    [(x,0):i | i <-is] ++ [(x,1):i | i <- is]
    where is = interpretaciones xs

-- ---------------------------------------------------------------------
-- Ejercicio 2. [2.5 puntos] Los números de Hamming forman una sucesión
-- estrictamente creciente de números que cumplen las siguientes
-- condiciones:  
--    * El número 1 está en la sucesión.
--    * Si x está en la sucesión, entonces 2x, 3x y 5x también están.
--    * Ningún otro número está en la sucesión. 
-- Los primeros términos de la sucesión de Hamming son
--    1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15, 16, ...
--
-- Definir la función
--    siguienteHamming :: Int -> Int
-- tal que (siguienteHamming x) es el menor término de la sucesión de
-- Hamming mayor que x. Por ejemplo,
--    siguienteHamming 10  ==  12
--    siguienteHamming 12  ==  15
--    siguienteHamming 15  ==  16
-- ---------------------------------------------------------------------

siguienteHamming :: Int -> Int
siguienteHamming x = head (dropWhile (<=x) hamming)

-- hamming es la sucesión de Hamming. Por ejemplo,
--    take 12 hamming == [1,2,3,4,5,6,8,9,10,12,15,16]
hamming :: [Int]
hamming = 1 : mezcla3 [2*i | i <- hamming]  
                      [3*i | i <- hamming]  
                      [5*i | i <- hamming]  

-- (mezcla3 xs ys zs) es la lista obtenida mezclando las listas
-- ordenadas xs, ys y zs y eliminando los elementos duplicados. Por
-- ejemplo, 
--    ghci> mezcla3 [2,4,6,8,10] [3,6,9,12] [5,10]
--    [2,3,4,5,6,8,9,10,12]
mezcla3 :: [Int] -> [Int] -> [Int] -> [Int]
mezcla3 xs ys zs = mezcla2 xs (mezcla2 ys zs)  

-- (mezcla2 xs ys zs) es la lista obtenida mezclando las listas
-- ordenadas xs e ys y eliminando los elementos duplicados. Por ejemplo,
--    ghci> mezcla2 [2,4,6,8,10,12] [3,6,9,12]
--    [2,3,4,6,8,9,10,12]
mezcla2 :: [Int] -> [Int] -> [Int]
mezcla2 p@(x:xs) q@(y:ys) | x < y     = x:mezcla2 xs q
                          | x > y     = y:mezcla2 p  ys  
                          | otherwise = x:mezcla2 xs ys
mezcla2 []       ys                   = ys
mezcla2 xs       []                   = xs

-- ---------------------------------------------------------------------
-- Ejercicio 3. [2.5 puntos] Las operaciones de suma, resta y
-- multiplicación se pueden representar mediante el siguiente tipo de
-- datos 
--    data Op = S | R | M
-- La expresiones aritméticas con dichas operaciones se pueden
-- representar mediante el siguiente tipo de dato algebraico
--    data Expr = N Int | A Op Expr Expr
-- Por ejemplo, la expresión
--    (7-3)+(2*5)
-- se representa por
--    A S (A R (N 7) (N 3)) (A M (N 2) (N 5))
--
-- Definir la función
--    valor :: Expr -> Int
-- tal que (valor e) es el valor de la expresión e. Por ejemplo,
--    valor (A S (A R (N 7) (N 3)) (A M (N 2) (N 5)))  ==  14
--    valor (A M (A R (N 7) (N 3)) (A S (N 2) (N 5)))  ==  28
-- ---------------------------------------------------------------------

data Op = S | R | M

data Expr = N Int | A Op Expr Expr

valor :: Expr -> Int
valor (N x) = x
valor (A o e1 e2) = aplica o (valor e1) (valor e2)

aplica :: Op -> Int -> Int -> Int
aplica S x y = x+y
aplica R x y = x-y
aplica M x y = x*y

-- ---------------------------------------------------------------------
-- Ejercicio 4. [2.5 puntos] Los polinomios con coeficientes naturales
-- se pueden representar mediante el siguiente tipo algebraico
--    data Polinomio = O | C Int Int Polinomio
-- Por ejemplo, el polinomio 2x^5 + 4x^3 + 2x se representa por
--    C 2 5 (C 4 3 (C 2 1 O))
-- También se pueden representar mediante listas no crecientes de
-- naturales. Por ejemplo, el polinomio 2x^5 + 4x^3 + 2x se representa
-- por 
--    [5,5,3,3,3,3,1,1]
-- en la lista anterior, el número de veces que aparece cada número n es
-- igual al coeficiente de x^n en el polinomio.
-- 
-- Definir la función
--    transformaPol :: Polinomio -> [Int]
-- tal que (transformaPol p) es el polinomio obtenido transformado el
-- polinomio p de la primera representación a la segunda. Por ejemplo, 
--    transformaPol (C 2 5 (C 4 3 (C 2 1 O)))  ==  [5,5,3,3,3,3,1,1]
--    transformaPol (C 2 100 (C 3 1 O))        ==  [100,100,1,1,1]
-- ---------------------------------------------------------------------

data Polinomio = O | C Int Int Polinomio

transformaPol :: Polinomio -> [Int]
transformaPol O         = []
transformaPol (C a n p) = replicate a n ++ transformaPol p

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

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

-- Ejercicio 1. [2.5 puntos] Definir la función

-- interpretaciones :: [a] -> [[(a,Int)]]

-- tal que (interpretaciones xs) es la lista de las interpretaciones

-- sobre la lista de las variables proposicionales xs sobre los valores

-- de verdad 0 y 1. Por ejemplo,

-- ghci> interpretaciones "A"

-- [[('A',0)],[('A',1)]]

-- ghci> interpretaciones "AB"

-- [[('A',0),('B',0)],[('A',0),('B',1)],

-- [('A',1),('B',0)],[('A',1),('B',1)]]

-- ghci> interpretaciones "ABC"

-- [[('A',0),('B',0),('C',0)],[('A',0),('B',0),('C',1)],

-- [('A',0),('B',1),('C',0)],[('A',0),('B',1),('C',1)],

-- [('A',1),('B',0),('C',0)],[('A',1),('B',0),('C',1)],

-- [('A',1),('B',1),('C',0)],[('A',1),('B',1),('C',1)]]

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

interpretaciones :: [a] -> [[(a,Int)]]

interpretaciones [] = [[]]

interpretaciones (x:xs) =

[(x,0):i | i <-is] ++ [(x,1):i | i <- is]

where is = interpretaciones xs

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

-- Ejercicio 2. [2.5 puntos] Los números de Hamming forman una sucesión

-- estrictamente creciente de números que cumplen las siguientes

-- condiciones:

-- * El número 1 está en la sucesión.

-- * Si x está en la sucesión, entonces 2x, 3x y 5x también están.

-- * Ningún otro número está en la sucesión.

-- Los primeros términos de la sucesión de Hamming son

-- 1, 2, 3, 4, 5, 6, 8, 9, 10, 12, 15, 16, ...

-- Definir la función

-- siguienteHamming :: Int -> Int

-- tal que (siguienteHamming x) es el menor término de la sucesión de

-- Hamming mayor que x. Por ejemplo,

-- siguienteHamming 10 == 12

-- siguienteHamming 12 == 15

-- siguienteHamming 15 == 16

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

siguienteHamming :: Int -> Int

siguienteHamming x = head (dropWhile (<=x) hamming)

-- hamming es la sucesión de Hamming. Por ejemplo,

-- take 12 hamming == [1,2,3,4,5,6,8,9,10,12,15,16]

hamming :: [Int]

hamming = 1 : mezcla3 [2*i | i <- hamming]

[3*i | i <- hamming]

[5*i | i <- hamming]

-- (mezcla3 xs ys zs) es la lista obtenida mezclando las listas

-- ordenadas xs, ys y zs y eliminando los elementos duplicados. Por

-- ejemplo,

-- ghci> mezcla3 [2,4,6,8,10] [3,6,9,12] [5,10]

-- [2,3,4,5,6,8,9,10,12]

mezcla3 :: [Int] -> [Int] -> [Int] -> [Int]

mezcla3 xs ys zs = mezcla2 xs (mezcla2 ys zs)

-- (mezcla2 xs ys zs) es la lista obtenida mezclando las listas

-- ordenadas xs e ys y eliminando los elementos duplicados. Por ejemplo,

-- ghci> mezcla2 [2,4,6,8,10,12] [3,6,9,12]

-- [2,3,4,6,8,9,10,12]

mezcla2 :: [Int] -> [Int] -> [Int]

mezcla2 p@(x:xs) q@(y:ys) | x < y = x:mezcla2 xs q

| x > y = y:mezcla2 p ys

| otherwise = x:mezcla2 xs ys

mezcla2 [] ys = ys

mezcla2 xs [] = xs

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

-- Ejercicio 3. [2.5 puntos] Las operaciones de suma, resta y

-- multiplicación se pueden representar mediante el siguiente tipo de

-- datos

-- data Op = S | R | M

-- La expresiones aritméticas con dichas operaciones se pueden

-- representar mediante el siguiente tipo de dato algebraico

-- data Expr = N Int | A Op Expr Expr

-- Por ejemplo, la expresión

-- (7-3)+(2*5)

-- se representa por

-- A S (A R (N 7) (N 3)) (A M (N 2) (N 5))

-- Definir la función

-- valor :: Expr -> Int

-- tal que (valor e) es el valor de la expresión e. Por ejemplo,

-- valor (A S (A R (N 7) (N 3)) (A M (N 2) (N 5))) == 14

-- valor (A M (A R (N 7) (N 3)) (A S (N 2) (N 5))) == 28

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

data Op = S | R | M

data Expr = N Int | A Op Expr Expr

valor :: Expr -> Int

valor (N x) = x

valor (A o e1 e2) = aplica o (valor e1) (valor e2)

aplica :: Op -> Int -> Int -> Int

aplica S x y = x+y

aplica R x y = x-y

aplica M x y = x*y

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

-- Ejercicio 4. [2.5 puntos] Los polinomios con coeficientes naturales

-- se pueden representar mediante el siguiente tipo algebraico

-- data Polinomio = O | C Int Int Polinomio

-- Por ejemplo, el polinomio 2x^5 + 4x^3 + 2x se representa por

-- C 2 5 (C 4 3 (C 2 1 O))

-- También se pueden representar mediante listas no crecientes de

-- naturales. Por ejemplo, el polinomio 2x^5 + 4x^3 + 2x se representa

-- por

-- [5,5,3,3,3,3,1,1]

-- en la lista anterior, el número de veces que aparece cada número n es

-- igual al coeficiente de x^n en el polinomio.

-- Definir la función

-- transformaPol :: Polinomio -> [Int]

-- tal que (transformaPol p) es el polinomio obtenido transformado el

-- polinomio p de la primera representación a la segunda. Por ejemplo,

-- transformaPol (C 2 5 (C 4 3 (C 2 1 O))) == [5,5,3,3,3,3,1,1]

-- transformaPol (C 2 100 (C 3 1 O)) == [100,100,1,1,1]

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

data Polinomio = O | C Int Int Polinomio

transformaPol :: Polinomio -> [Int]

transformaPol O = []

transformaPol (C a n p) = replicate a n ++ transformaPol p

Las soluciones del examen del grupo 1 (impartido por María J. Hidalgo) son

-- ---------------------------------------------------------------------
-- § Librerías auxiliares                                             --
-- ---------------------------------------------------------------------

import Test.QuickCheck
import Data.Ratio
import Data.List
import PolOperaciones

-- ---------------------------------------------------------------------
-- Ejercicio 1.1. Consideremos la sucesión siguiente
--     a0 = 1
--     a1 = 1
--     an = 7*a(n-1) - a(n-2) - 2
-- 
-- Definir, por recursión, la función
--     suc :: Integer -> Integer  
-- tal que (suc n) es el n-ésimo término de la sucesión anterior. Por
-- ejemplo, 
--     suc 1 == 1
--     suc 4 == 169
--     suc 8 == 372100
-- Por ejemplo,
--    ghci> [suc n | n <-[0..10]]
--    [1,1,4,25,169,1156,7921,54289,372100,2550409,17480761]
-- ---------------------------------------------------------------------

suc :: Integer -> Integer  
suc 0 = 1
suc 1 = 1
suc n = 7*(suc (n-1)) - (suc (n-2)) - 2

-- ---------------------------------------------------------------------
-- Ejercicio 1.2. Definir, usando evaluación perezosa. la función
--     suc' :: Integer -> Integer  
-- tal que (suc n) es el n-ésimo término de la sucesión anterior. Por
-- ejemplo, 
--     suc 1 == 1
--     suc 4 == 169
--     suc 8 == 372100
-- Por ejemplo,
--    ghci> [suc n | n <-[0..10]]
--    [1,1,4,25,169,1156,7921,54289,372100,2550409,17480761]
--    ghci> suc' 30
--    915317035111995882133681
-- ---------------------------------------------------------------------

-- La sucesión es
sucesion:: [Integer]
sucesion = 1:1:zipWith f (tail sucesion) sucesion 
    where f x y = 7*x-y-2

-- Por ejemplo, el cálculo de los 4 primeros términos es
--    take 4 sucesion
--    = take 4 (1:1:zipWith f (tail sucesion) sucesion)
--    = 1:take 3 (1:zipWith f (tail sucesion) sucesion)
--    = 1:1:take 2 (zipWith f (tail sucesion) sucesion)
--    = 1:1:take 2 (zipWith f (1:R2) (1:1:R2))
--    = 1:1:take 2 (4:zipWith f R2 (1:R2))
--    = 1:1:4:take 1 (zipWith f (4:R3) (1:4:R3))
--    = 1:1:4:take 1 (25:zipWith f R3 (4:R3))
--    = 1:1:4:25:take 0 (25:zipWith f R3 (4:R3))
--    = 1:1:4:25:[]
--    = [1,1,4,25]
        
suc' :: Integer -> Integer        
suc' n = sucesion `genericIndex` n        

-- ---------------------------------------------------------------------
-- Ejercicio 1.3. Calcular el término 100 de la sucesión anterior.
-- ---------------------------------------------------------------------

-- El cálculo es
--    ghci> suc' 100
--    30068434349082593880211806294947596752920546625789181082505523070321286807046578601

-- ---------------------------------------------------------------------
-- Ejercicio 1.4. Comprobar que los primeros 30 términos de la sucesión
-- son cuadrados perfectos.
-- ---------------------------------------------------------------------

esCuadrado :: (Integral a) => a -> Bool
esCuadrado n = y*y == n
    where y = floor (sqrt (fromIntegral n))

-- La comprobación es        
--    ghci> and [esCuadrado (suc' n) | n <-[0..30]]
--    True

-- ---------------------------------------------------------------------
-- Ejercicio 2. Consideremos los árboles binarios definidos por el tipo
-- siguiente: 
--    data Arbol t = Hoja t 
--               | Nodo (Arbol t) t (Arbol t)
--               deriving (Show, Eq)
-- y el siguiente ejemplo de árbol   
--    ejArbol :: Arbol Int
--    ejArbol = Nodo (Nodo (Hoja 1) 3 (Hoja 4)) 
--                   5 
--                   (Nodo (Hoja 6) 7 (Hoja 9))
-- 
-- Definir la función 
--    transforma :: (t -> Bool) -> Arbol t -> Arbol (Maybe t)
-- tal que (transforma p a) es el árbol con la misma estructura que a,
-- en el que cada elemento x que verifica el predicado p se sustituye por
-- (Just x) y los que no lo verifican se sustituyen por Nothing. Por
-- ejemplo,
--    ghci> transforma even ejArbol
--    Nodo (Nodo (Hoja Nothing) Nothing (Hoja (Just 4))) 
--         Nothing 
--         (Nodo (Hoja (Just 6)) Nothing (Hoja Nothing))
-- ---------------------------------------------------------------------

data Arbol t = Hoja t 
           | Nodo (Arbol t) t (Arbol t)
           deriving (Show, Eq)

ejArbol :: Arbol Int
ejArbol = Nodo (Nodo (Hoja 1) 3 (Hoja 4)) 
               5 
               (Nodo (Hoja 6) 7 (Hoja 9))

transforma :: (t -> Bool) -> Arbol t -> Arbol (Maybe t)
transforma p (Hoja r) | p r       = Hoja (Just r)
                      | otherwise = Hoja Nothing
transforma p (Nodo i r d) 
    | p r       = Nodo (transforma p i) (Just r) (transforma p d)                                    
    | otherwise = Nodo (transforma p i) Nothing (transforma p d)                                    

-- ---------------------------------------------------------------------
-- Ejercicio 3. El método de la bisección para calcular un cero de una
-- función en el intervalo [a,b] se basa en el Teorema de Bolzano: "Si
-- f(x) es una función continua en el intervalo [a, b], y si, además, en
-- los  extremos del intervalo la función f(x) toma valores de signo
-- opuesto (f(a) * f(b) < 0), entonces existe al menos un valor c en (a,
-- b) para el que f(c) = 0".
-- 
-- La idea es tomar el punto medio del intervalo c = (a+b)/2 y
-- considerar los siguientes casos:
-- (*) Si f(c) ~= 0, hemos encontrado una aproximación del punto que
--     anula f en el intervalo con un error aceptable.
-- (*) Si f(c) tiene signo distinto de f(a), repetir el proceso en el
--     intervalo [a,c].
-- (*) Si no, repetir el proceso en el intervalo [c,b].
-- 
-- Definir la función
--    ceroBiseccionE :: (Double -> Double) ->
--                      Double -> Double -> Double -> Double
-- tal que (ceroBiseccionE f a b e) calcule una aproximación del punto 
-- del intervalo [a,b] en el que se anula la función f, con un error
-- menor que e, aplicando el método de la bisección. Por ejemplo,
-- si f1 y f2 son las funciones definidas por
--    f1 x = 2 - x
--    f2 x = x^2 - 3 
-- entonces
--    ceroBiseccionE f1 0 3 0.0001     == 2.00006103515625
--    ceroBiseccionE f2 0 2 0.0001     == 1.7320556640625
--    ceroBiseccionE f2 (-2) 2 0.00001 == -1.732048
--    ceroBiseccionE cos 0 2 0.0001    == -1.7320480346679688
-- ---------------------------------------------------------------------

f1 x = 2 - x
f2 x = x^2 - 3 

ceroBiseccionE :: (Double -> Double) -> 
                  Double -> Double -> Double -> Double
ceroBiseccionE f a b e = aux a b
    where aux c d | aceptable m     = m
                  | (f c)*(f m) < 0 = aux c m
                  | otherwise       = aux m d
              where m = (c+d)/2
                    aceptable x = abs (f x) < e 

-- ---------------------------------------------------------------------
-- Ejercicio 4.1. Los polinomios de Fibonacci se definen como sigue
--    P_0 = 0                    
--    P_1 = 1                    
--    P_n = x*P_(n-1) + P_(n-2)                    
--                    
-- Definir la función 
--    polFibonnaci :: Integer -> Polinomio Rational
-- tal que (polFibonnaci n) es el n-ésimo polinomio de Fibonacci. Por
-- ejemplo, 
--    polFibonnaci 2 == 1 % 1*x
--    polFibonnaci 3 == x^2 + 1 % 1
--    polFibonnaci 4 == x^3 + 2 % 1*x
--    polFibonnaci 5 == x^4 + 3 % 1*x^2 + 1 % 1
-- ---------------------------------------------------------------------   
                    
-- 1ª solución (por recursión)
polFibonnaci :: Integer -> Polinomio Rational
polFibonnaci 0 = polCero
polFibonnaci 1 = polUnidad
polFibonnaci n = 
    sumaPol (multPol (creaPolDispersa [1,0]) (polFibonnaci (n-1)))
            (polFibonnaci (n-2))

-- 2ª solución (evaluación perezosa)
polFibonnaciP :: Integer -> Polinomio Rational
polFibonnaciP n = sucPolinomiosFibonacci `genericIndex` n

sucPolinomiosFibonacci :: [Polinomio Rational]
sucPolinomiosFibonacci =
    polCero:polUnidad:zipWith f (tail sucPolinomiosFibonacci)
                                sucPolinomiosFibonacci
        where f p q = sumaPol (multPol (creaPolDispersa [1,0]) p) q
    
-- ---------------------------------------------------------------------
-- Ejercicio 4.2. Comprobar que P_2 divide a los polinomios de Fibonacci
-- de índice par hasta n = 20.
-- ---------------------------------------------------------------------

divide :: (Fractional a, Eq a) => Polinomio a -> Polinomio a -> Bool
divide p q = esPolCero (resto q p)

-- La comprobación es
-- ghci> and [divide (polFibonnaciP 2) (polFibonnaciP (2*k)) | k <- [2..20]]
-- True

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

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

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

-- § Librerías auxiliares --

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

import Test.QuickCheck

import Data.Ratio

import Data.List

import PolOperaciones

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

-- Ejercicio 1.1. Consideremos la sucesión siguiente

-- a0 = 1

-- a1 = 1

-- an = 7*a(n-1) - a(n-2) - 2

-- Definir, por recursión, la función

-- suc :: Integer -> Integer

-- tal que (suc n) es el n-ésimo término de la sucesión anterior. Por

-- ejemplo,

-- suc 1 == 1

-- suc 4 == 169

-- suc 8 == 372100

-- Por ejemplo,

-- ghci> [suc n | n <-[0..10]]

-- [1,1,4,25,169,1156,7921,54289,372100,2550409,17480761]

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

suc :: Integer -> Integer

suc 0 = 1

suc 1 = 1

suc n = 7*(suc (n-1)) - (suc (n-2)) - 2

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

-- Ejercicio 1.2. Definir, usando evaluación perezosa. la función

-- suc' :: Integer -> Integer

-- tal que (suc n) es el n-ésimo término de la sucesión anterior. Por

-- ejemplo,

-- suc 1 == 1

-- suc 4 == 169

-- suc 8 == 372100

-- Por ejemplo,

-- ghci> [suc n | n <-[0..10]]

-- [1,1,4,25,169,1156,7921,54289,372100,2550409,17480761]

-- ghci> suc' 30

-- 915317035111995882133681

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

-- La sucesión es

sucesion:: [Integer]

sucesion = 1:1:zipWith f (tail sucesion) sucesion

where f x y = 7*x-y-2

-- Por ejemplo, el cálculo de los 4 primeros términos es

-- take 4 sucesion

-- = take 4 (1:1:zipWith f (tail sucesion) sucesion)

-- = 1:take 3 (1:zipWith f (tail sucesion) sucesion)

-- = 1:1:take 2 (zipWith f (tail sucesion) sucesion)

-- = 1:1:take 2 (zipWith f (1:R2) (1:1:R2))

-- = 1:1:take 2 (4:zipWith f R2 (1:R2))

-- = 1:1:4:take 1 (zipWith f (4:R3) (1:4:R3))

-- = 1:1:4:take 1 (25:zipWith f R3 (4:R3))

-- = 1:1:4:25:take 0 (25:zipWith f R3 (4:R3))

-- = 1:1:4:25:[]

-- = [1,1,4,25]

suc' :: Integer -> Integer

suc' n = sucesion `genericIndex` n

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

-- Ejercicio 1.3. Calcular el término 100 de la sucesión anterior.

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

-- El cálculo es

-- ghci> suc' 100

-- 30068434349082593880211806294947596752920546625789181082505523070321286807046578601

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

-- Ejercicio 1.4. Comprobar que los primeros 30 términos de la sucesión

-- son cuadrados perfectos.

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

esCuadrado :: (Integral a) => a -> Bool

esCuadrado n = y*y == n

where y = floor (sqrt (fromIntegral n))

-- La comprobación es

-- ghci> and [esCuadrado (suc' n) | n <-[0..30]]

-- True

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

-- Ejercicio 2. Consideremos los árboles binarios definidos por el tipo

-- siguiente:

-- data Arbol t = Hoja t

-- | Nodo (Arbol t) t (Arbol t)

-- deriving (Show, Eq)

-- y el siguiente ejemplo de árbol

-- ejArbol :: Arbol Int

-- ejArbol = Nodo (Nodo (Hoja 1) 3 (Hoja 4))

-- 5

-- (Nodo (Hoja 6) 7 (Hoja 9))

-- Definir la función

-- transforma :: (t -> Bool) -> Arbol t -> Arbol (Maybe t)

-- tal que (transforma p a) es el árbol con la misma estructura que a,

-- en el que cada elemento x que verifica el predicado p se sustituye por

-- (Just x) y los que no lo verifican se sustituyen por Nothing. Por

-- ejemplo,

-- ghci> transforma even ejArbol

-- Nodo (Nodo (Hoja Nothing) Nothing (Hoja (Just 4)))

-- Nothing

-- (Nodo (Hoja (Just 6)) Nothing (Hoja Nothing))

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

data Arbol t = Hoja t

| Nodo (Arbol t) t (Arbol t)

deriving (Show, Eq)

ejArbol :: Arbol Int

ejArbol = Nodo (Nodo (Hoja 1) 3 (Hoja 4))

(Nodo (Hoja 6) 7 (Hoja 9))

transforma :: (t -> Bool) -> Arbol t -> Arbol (Maybe t)

transforma p (Hoja r) | p r = Hoja (Just r)

| otherwise = Hoja Nothing

transforma p (Nodo i r d)

| p r = Nodo (transforma p i) (Just r) (transforma p d)

| otherwise = Nodo (transforma p i) Nothing (transforma p d)

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

-- Ejercicio 3. El método de la bisección para calcular un cero de una

-- función en el intervalo [a,b] se basa en el Teorema de Bolzano: "Si

-- f(x) es una función continua en el intervalo [a, b], y si, además, en

-- los extremos del intervalo la función f(x) toma valores de signo

-- opuesto (f(a) * f(b) < 0), entonces existe al menos un valor c en (a,

-- b) para el que f(c) = 0".

-- La idea es tomar el punto medio del intervalo c = (a+b)/2 y

-- considerar los siguientes casos:

-- (*) Si f(c) ~= 0, hemos encontrado una aproximación del punto que

-- anula f en el intervalo con un error aceptable.

-- (*) Si f(c) tiene signo distinto de f(a), repetir el proceso en el

-- intervalo [a,c].

-- (*) Si no, repetir el proceso en el intervalo [c,b].

-- Definir la función

-- ceroBiseccionE :: (Double -> Double) ->

-- Double -> Double -> Double -> Double

-- tal que (ceroBiseccionE f a b e) calcule una aproximación del punto

-- del intervalo [a,b] en el que se anula la función f, con un error

-- menor que e, aplicando el método de la bisección. Por ejemplo,

-- si f1 y f2 son las funciones definidas por

-- f1 x = 2 - x

-- f2 x = x^2 - 3

-- entonces

-- ceroBiseccionE f1 0 3 0.0001 == 2.00006103515625

-- ceroBiseccionE f2 0 2 0.0001 == 1.7320556640625

-- ceroBiseccionE f2 (-2) 2 0.00001 == -1.732048

-- ceroBiseccionE cos 0 2 0.0001 == -1.7320480346679688

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

f1 x = 2 - x

f2 x = x^2 - 3

ceroBiseccionE :: (Double -> Double) ->

Double -> Double -> Double -> Double

ceroBiseccionE f a b e = aux a b

where aux c d | aceptable m = m

| (f c)*(f m) < 0 = aux c m

| otherwise = aux m d

where m = (c+d)/2

aceptable x = abs (f x) < e

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

-- Ejercicio 4.1. Los polinomios de Fibonacci se definen como sigue

-- P_0 = 0

-- P_1 = 1

-- P_n = x*P_(n-1) + P_(n-2)

-- Definir la función

-- polFibonnaci :: Integer -> Polinomio Rational

-- tal que (polFibonnaci n) es el n-ésimo polinomio de Fibonacci. Por

-- ejemplo,

-- polFibonnaci 2 == 1 % 1*x

-- polFibonnaci 3 == x^2 + 1 % 1

-- polFibonnaci 4 == x^3 + 2 % 1*x

-- polFibonnaci 5 == x^4 + 3 % 1*x^2 + 1 % 1

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

-- 1ª solución (por recursión)

polFibonnaci :: Integer -> Polinomio Rational

polFibonnaci 0 = polCero

polFibonnaci 1 = polUnidad

polFibonnaci n =

sumaPol (multPol (creaPolDispersa [1,0]) (polFibonnaci (n-1)))

(polFibonnaci (n-2))

-- 2ª solución (evaluación perezosa)

polFibonnaciP :: Integer -> Polinomio Rational

polFibonnaciP n = sucPolinomiosFibonacci `genericIndex` n

sucPolinomiosFibonacci :: [Polinomio Rational]

sucPolinomiosFibonacci =

polCero:polUnidad:zipWith f (tail sucPolinomiosFibonacci)

sucPolinomiosFibonacci

where f p q = sumaPol (multPol (creaPolDispersa [1,0]) p) q

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

-- Ejercicio 4.2. Comprobar que P_2 divide a los polinomios de Fibonacci

-- de índice par hasta n = 20.

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

divide :: (Fractional a, Eq a) => Polinomio a -> Polinomio a -> Bool

divide p q = esPolCero (resto q p)

-- La comprobación es

-- ghci> and [divide (polFibonnaciP 2) (polFibonnaciP (2*k)) | k <- [2..20]]

-- True

Para el cuarto ejercicio se usan la librería del tipo abstracto de polinomios (PolRepTDA.hs)

module PolRepTDA
  ( Polinomio,
    polCero,   -- Polinomio a                                         
    esPolCero, -- Polinomio a -> Bool                       
    consPol,   -- (Num a, Eq a)) => Int -> a -> Polinomio a -> Polinomio a   
    grado,     -- Polinomio a -> Int                                  
    coefLider, -- Num t => Polinomio t -> t                           
    restoPol   -- Polinomio t -> Polinomio t                          
  ) where

-- ---------------------------------------------------------------------
-- TAD de los polinomios mediante un tipo de dato algebraico.         --
-- ---------------------------------------------------------------------

-- Representamos un polinomio mediante los constructores ConsPol y
-- PolCero. Por ejemplo, el polinomio 
--    6x^4 -5x^2 + 4x -7 
-- se representa por 
--    ConsPol 4 6 (ConsPol 2 (-5) (ConsPol 1 4 (ConsPol 0 (-7) PolCero)))

data Polinomio a = PolCero 
                 | ConsPol Int a (Polinomio a)
                 deriving Eq
             
-- ---------------------------------------------------------------------
-- Escritura de los polinomios                                        --
-- ---------------------------------------------------------------------

instance (Num a, Show a, Eq a) => Show (Polinomio a) where
    show PolCero               = "0"
    show (ConsPol 0 b PolCero) = show b
    show (ConsPol 0 b p)       = concat [show b, " + ", show p] 
    show (ConsPol 1 b PolCero) = concat [show b, "*x"]
    show (ConsPol 1 b p)       = concat [show b, "*x + ", show p] 
    show (ConsPol n 1 PolCero) = concat ["x^", show n] 
    show (ConsPol n b PolCero) = concat [show b, "*x^", show n] 
    show (ConsPol n 1 p)       = concat ["x^", show n, " + ", show p] 
    show (ConsPol n b p)       = concat [show b, "*x^", show n, " + ", show p] 

-- ---------------------------------------------------------------------
-- Ejemplos de polinomios                                             --
-- ---------------------------------------------------------------------

-- Ejemplos de polinomios con coeficientes enteros:
ejPol1, ejPol2, ejPol3:: Polinomio Int
ejPol1 = consPol 4 3 (consPol 2 (-5) (consPol 0 3 polCero))
ejPol2 = consPol 5 1 (consPol 2 5 (consPol 1 4 polCero))
ejPol3 = consPol 4 6 (consPol 1 2 polCero)

-- Comprobación de escritura:
--    > ejPol1
--    3*x^4 + -5*x^2 + 3
--    > ejPol2
--    x^5 + 5*x^2 + 4*x
--    > ejPol3
--    6*x^4 + 2*x

-- Ejemplos de polinomios con coeficientes reales:
ejPol5, ejPol6, ejPol7:: Polinomio Float
ejPol5 = consPol 4 3 (consPol 2 (-5) (consPol 0 3 polCero))
ejPol6 = consPol 5 1 (consPol 2 5 (consPol 1 4 polCero))
ejPol7 = consPol 1 2 (consPol 4 6 polCero)

-- Comprobación de escritura:
--    > ejPol5
--    3.0*x^4 + -5.0*x^2 + 3.0
--    > ejPol6
--    x^5 + 5.0*x^2 + 4.0*x
--    > ejPol7
--    6.0*x^4 + 2.0*x

-- ---------------------------------------------------------------------
-- Implementación de la especificación                                --
-- ---------------------------------------------------------------------

-- polCero es el polinomio cero. Por ejemplo,
--    > polCero
--    0
polCero :: Polinomio a
polCero = PolCero

-- (esPolCero p) se verifica si p es el polinomio cero. Por ejemplo,
--    esPolCero polCero  ==  True
--    esPolCero ejPol1   ==  False
esPolCero :: Polinomio a -> Bool
esPolCero PolCero = True
esPolCero _       = False

-- (consPol n b p) es el polinomio bx^n+p. Por ejemplo,
--    ejPol2               ==  x^5 + 5*x^2 + 4*x
--    consPol 3 0 ejPol2   ==  x^5 + 5*x^2 + 4*x
--    consPol 3 2 polCero  ==  2*x^3
--    consPol 6 7 ejPol2   ==  7*x^6 + x^5 + 5*x^2 + 4*x
--    consPol 4 7 ejPol2   ==  x^5 + 7*x^4 + 5*x^2 + 4*x
--    consPol 5 7 ejPol2   ==  8*x^5 + 5*x^2 + 4*x
consPol :: (Num a, Eq a) => Int -> a -> Polinomio a -> Polinomio a  
consPol _ 0 p = p
consPol n b PolCero = ConsPol n b PolCero
consPol n b (ConsPol m c p) 
    | n > m      = ConsPol n b (ConsPol m c p)
    | n < m      = ConsPol m c (consPol n b p)
    | b+c == 0   = p
    | otherwise  = ConsPol n (b+c) p

-- (grado p) es el grado del polinomio p. Por ejemplo,
--    ejPol3        ==  6*x^4 + 2*x
--    grado ejPol3  ==  4
grado:: Polinomio a -> Int
grado PolCero         = 0
grado (ConsPol n _ _) = n

-- (coefLider p) es el coeficiente líder del polinomio p. Por ejemplo,
--    ejPol3            ==  6*x^4 + 2*x
--    coefLider ejPol3  ==  6
coefLider:: Num t => Polinomio t -> t
coefLider PolCero         = 0
coefLider (ConsPol _ b _) = b

-- (restoPol p) es el resto del polinomio p. Por ejemplo,
--    ejPol3           ==  6*x^4 + 2*x
--    restoPol ejPol3  ==  2*x
--    ejPol2           ==  x^5 + 5*x^2 + 4*x
--    restoPol ejPol2  ==  5*x^2 + 4*x
restoPol :: Polinomio t -> Polinomio t
restoPol PolCero         = PolCero
restoPol (ConsPol _ _ p) = p

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

module PolRepTDA

( Polinomio,

polCero, -- Polinomio a

esPolCero, -- Polinomio a -> Bool

consPol, -- (Num a, Eq a)) => Int -> a -> Polinomio a -> Polinomio a

grado, -- Polinomio a -> Int

coefLider, -- Num t => Polinomio t -> t

restoPol -- Polinomio t -> Polinomio t

) where

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

-- TAD de los polinomios mediante un tipo de dato algebraico. --

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

-- Representamos un polinomio mediante los constructores ConsPol y

-- PolCero. Por ejemplo, el polinomio

-- 6x^4 -5x^2 + 4x -7

-- se representa por

-- ConsPol 4 6 (ConsPol 2 (-5) (ConsPol 1 4 (ConsPol 0 (-7) PolCero)))

data Polinomio a = PolCero

| ConsPol Int a (Polinomio a)

deriving Eq

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

-- Escritura de los polinomios --

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

instance (Num a, Show a, Eq a) => Show (Polinomio a) where

show PolCero = "0"

show (ConsPol 0 b PolCero) = show b

show (ConsPol 0 b p) = concat [show b, " + ", show p]

show (ConsPol 1 b PolCero) = concat [show b, "*x"]

show (ConsPol 1 b p) = concat [show b, "*x + ", show p]

show (ConsPol n 1 PolCero) = concat ["x^", show n]

show (ConsPol n b PolCero) = concat [show b, "*x^", show n]

show (ConsPol n 1 p) = concat ["x^", show n, " + ", show p]

show (ConsPol n b p) = concat [show b, "*x^", show n, " + ", show p]

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

-- Ejemplos de polinomios --

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

-- Ejemplos de polinomios con coeficientes enteros:

ejPol1, ejPol2, ejPol3:: Polinomio Int

ejPol1 = consPol 4 3 (consPol 2 (-5) (consPol 0 3 polCero))

ejPol2 = consPol 5 1 (consPol 2 5 (consPol 1 4 polCero))

ejPol3 = consPol 4 6 (consPol 1 2 polCero)

-- Comprobación de escritura:

-- > ejPol1

-- 3*x^4 + -5*x^2 + 3

-- > ejPol2

-- x^5 + 5*x^2 + 4*x

-- > ejPol3

-- 6*x^4 + 2*x

-- Ejemplos de polinomios con coeficientes reales:

ejPol5, ejPol6, ejPol7:: Polinomio Float

ejPol5 = consPol 4 3 (consPol 2 (-5) (consPol 0 3 polCero))

ejPol6 = consPol 5 1 (consPol 2 5 (consPol 1 4 polCero))

ejPol7 = consPol 1 2 (consPol 4 6 polCero)

-- Comprobación de escritura:

-- > ejPol5

-- 3.0*x^4 + -5.0*x^2 + 3.0

-- > ejPol6

-- x^5 + 5.0*x^2 + 4.0*x

-- > ejPol7

-- 6.0*x^4 + 2.0*x

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

-- Implementación de la especificación --

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

-- polCero es el polinomio cero. Por ejemplo,

-- > polCero

-- 0

polCero :: Polinomio a

polCero = PolCero

-- (esPolCero p) se verifica si p es el polinomio cero. Por ejemplo,

-- esPolCero polCero == True

-- esPolCero ejPol1 == False

esPolCero :: Polinomio a -> Bool

esPolCero PolCero = True

esPolCero _ = False

-- (consPol n b p) es el polinomio bx^n+p. Por ejemplo,

-- ejPol2 == x^5 + 5*x^2 + 4*x

-- consPol 3 0 ejPol2 == x^5 + 5*x^2 + 4*x

-- consPol 3 2 polCero == 2*x^3

-- consPol 6 7 ejPol2 == 7*x^6 + x^5 + 5*x^2 + 4*x

-- consPol 4 7 ejPol2 == x^5 + 7*x^4 + 5*x^2 + 4*x

-- consPol 5 7 ejPol2 == 8*x^5 + 5*x^2 + 4*x

consPol :: (Num a, Eq a) => Int -> a -> Polinomio a -> Polinomio a

consPol _ 0 p = p

consPol n b PolCero = ConsPol n b PolCero

consPol n b (ConsPol m c p)

| n > m = ConsPol n b (ConsPol m c p)

| n < m = ConsPol m c (consPol n b p)

| b+c == 0 = p

| otherwise = ConsPol n (b+c) p

-- (grado p) es el grado del polinomio p. Por ejemplo,

-- ejPol3 == 6*x^4 + 2*x

-- grado ejPol3 == 4

grado:: Polinomio a -> Int

grado PolCero = 0

grado (ConsPol n _ _) = n

-- (coefLider p) es el coeficiente líder del polinomio p. Por ejemplo,

-- ejPol3 == 6*x^4 + 2*x

-- coefLider ejPol3 == 6

coefLider:: Num t => Polinomio t -> t

coefLider PolCero = 0

coefLider (ConsPol _ b _) = b

-- (restoPol p) es el resto del polinomio p. Por ejemplo,

-- ejPol3 == 6*x^4 + 2*x

-- restoPol ejPol3 == 2*x

-- ejPol2 == x^5 + 5*x^2 + 4*x

-- restoPol ejPol2 == 5*x^2 + 4*x

restoPol :: Polinomio t -> Polinomio t

restoPol PolCero = PolCero

restoPol (ConsPol _ _ p) = p

y la de operaciones con polinomios (PolOperaciones.hs)

module PolOperaciones (module Pol, module PolOperaciones) where

-- ---------------------------------------------------------------------
-- Importación de librerías                                           --
-- ---------------------------------------------------------------------

-- Nota: Hay que elegir una implementación del TAD de los polinomios.
import PolRepTDA as Pol
-- import PolRepDispersa as Pol
-- import PolRepDensa as Pol

import Test.QuickCheck

-- ---------------------------------------------------------------------
-- Ejemplos                                                           --
-- ---------------------------------------------------------------------

-- Ejemplos de polinomios con coeficientes enteros:
ejPol1, ejPol2, ejPol3, ejTerm:: Polinomio Int
ejPol1 = consPol 4 3 (consPol 2 (-5) (consPol 0 3 polCero))
ejPol2 = consPol 5 1 (consPol 2 5 (consPol 1 4 polCero))
ejPol3 = consPol 4 6 (consPol 1 2 polCero)
ejTerm = consPol 1 4 polCero

-- ---------------------------------------------------------------------
-- Generador de polinomios                                            --
-- ---------------------------------------------------------------------

-- (genPol n) es un generador de polinomios. Por ejemplo,
--    ghci> sample (genPol 1)
--    7*x^9 + 9*x^8 + 10*x^7 + -14*x^5 + -15*x^2 + -10
--    -4*x^8 + 2*x
--    -8*x^9 + 4*x^8 + 2*x^6 + 4*x^5 + -6*x^4 + 5*x^2 + -8*x
--    -9*x^9 + x^5 + -7
--    8*x^10 + -9*x^7 + 7*x^6 + 9*x^5 + 10*x^3 + -1*x^2
--    7*x^10 + 5*x^9 + -5
--    -8*x^10 + -7
--    -5*x
--    5*x^10 + 4*x^4 + -3
--    3*x^3 + -4
--    10*x
genPol :: (Arbitrary a, Num a, Eq a) => Int -> Gen (Polinomio a)
genPol 0 = return polCero
genPol n = do n <- choose (0,10)
              b <- arbitrary
              p <- genPol (div n 2)
              return (consPol n b p) 

instance (Arbitrary a, Num a, Eq a) => Arbitrary (Polinomio a) where
    arbitrary = sized genPol

-- ---------------------------------------------------------------------
-- Funciones sobre términos                                           --
-- ---------------------------------------------------------------------

-- (creaTermino n a) es el término a*x^n. Por ejemplo, 
--    creaTermino 2 5  ==  5*x^2
creaTermino:: (Num t, Eq t) => Int -> t -> Polinomio t
creaTermino n a = consPol n a polCero

-- (termLider p) es el término líder del polinomio p. Por ejemplo,
--    ejPol2            ==  x^5 + 5*x^2 + 4*x
--    termLider ejPol2  ==  x^5
termLider:: (Num t, Eq t) => Polinomio t -> Polinomio t
termLider p = creaTermino (grado p) (coefLider p)

-- ---------------------------------------------------------------------
-- Suma de polinomios                                                 --
-- ---------------------------------------------------------------------

-- (sumaPol p q) es la suma de los polinomios p y q. Por ejemplo, 
--    ejPol1                 ==  3*x^4 + -5*x^2 + 3
--    ejPol2                 ==  x^5 + 5*x^2 + 4*x
--    sumaPol ejPol1 ejPol2  ==  x^5 + 3*x^4 + 4*x + 3
sumaPol:: (Num a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a
sumaPol p q 
    | esPolCero p = q
    | esPolCero q = p
    | n1 > n2      = consPol n1 a1 (sumaPol r1 q)
    | n1 < n2      = consPol n2 a2 (sumaPol p r2)
    | otherwise    = consPol n1 (a1+a2) (sumaPol r1 r2)
    where n1 = grado p
          a1 = coefLider p
          r1 = restoPol p
          n2 = grado q
          a2 = coefLider q
          r2 = restoPol q

-- Propiedad. El polinomio cero es el elemento neutro de la suma.
prop_neutroSumaPol :: Polinomio Int -> Bool
prop_neutroSumaPol p = 
    sumaPol polCero p == p

-- Comprobación con QuickCheck.
--    ghci> quickCheck prop_neutroSumaPol
--    OK, passed 100 tests.

-- Propiedad. La suma es conmutativa.
prop_conmutativaSuma :: Polinomio Int -> Polinomio Int -> Bool
prop_conmutativaSuma p q = 
    sumaPol p q == sumaPol q p

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

-- ---------------------------------------------------------------------
-- Producto de polinomios                                             --
-- ---------------------------------------------------------------------

-- (multPorTerm t p) es el producto del término t por el polinomio
-- p. Por ejemplo,
--    ejTerm                     ==  4*x
--    ejPol2                     ==  x^5 + 5*x^2 + 4*x
--    multPorTerm ejTerm ejPol2  ==  4*x^6 + 20*x^3 + 16*x^2
multPorTerm :: (Num t, Eq t) => Polinomio t -> Polinomio t -> Polinomio t
multPorTerm term pol 
    | esPolCero pol = polCero
    | otherwise     = consPol (n+m) (a*b) (multPorTerm term r)
    where n = grado term
          a = coefLider term
          m = grado pol
          b = coefLider pol
          r = restoPol pol    

-- (multPol p q) es el producto de los polinomios p y q. Por
-- ejemplo,
--    ghci> ejPol1
--    3*x^4 + -5*x^2 + 3
--    ghci> ejPol2
--    x^5 + 5*x^2 + 4*x
--    ghci> multPol ejPol1 ejPol2
--    3*x^9 + -5*x^7 + 15*x^6 + 15*x^5 + -25*x^4 + -20*x^3 + 15*x^2 + 12*x
multPol :: (Num a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a
multPol p q
    | esPolCero p = polCero
    | otherwise    = sumaPol (multPorTerm (termLider p) q)
                             (multPol (restoPol p) q)

-- Propiedad. El producto de polinomios es conmutativo.
prop_conmutativaProducto :: Polinomio Int -> Polinomio Int -> Bool
prop_conmutativaProducto p q = 
    multPol p q == multPol q p

-- La comprobación es
--    ghci> quickCheck prop_conmutativaProducto
--    OK, passed 100 tests.

-- El producto es distributivo respecto de la suma.
prop_distributivaProductoSuma :: Polinomio Int -> Polinomio Int 
                                 -> Polinomio Int -> Bool
prop_distributivaProductoSuma p q r =
    multPol p (sumaPol q r) == sumaPol (multPol p q) (multPol p r)

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

-- polUnidad es el polinomio unidad. Por ejemplo, 
--    ghci> polUnidad
--    1
polUnidad:: (Num t, Eq t) => Polinomio t
polUnidad = consPol 0 1 polCero

-- Propiedad. El polinomio unidad es el elemento neutro del producto.
prop_polUnidad :: Polinomio Int -> Bool
prop_polUnidad p = 
    multPol p polUnidad == p

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

-- ---------------------------------------------------------------------
-- Valor de un polinomio en un punto                                  --
-- ---------------------------------------------------------------------

-- (valor p c) es el valor del polinomio p al sustituir su variable por
-- c. Por ejemplo, 
--    ejPol1             ==  3*x^4 + -5*x^2 + 3
--    valor ejPol1 0     ==  3
--    valor ejPol1 1     ==  1
--    valor ejPol1 (-2)  ==  31
valor:: (Num a, Eq a) => Polinomio a -> a -> a
valor p c 
    | esPolCero p = 0
    | otherwise   =  b*c^n + valor r c
    where n = grado p
          b = coefLider p
          r = restoPol p

-- ---------------------------------------------------------------------
-- Verificación de raices de polinomios                               --
-- ---------------------------------------------------------------------

-- (esRaiz c p) se verifica si c es una raiz del polinomio p. por
-- ejemplo, 
--    ejPol3           ==  6*x^4 + 2*x
--    esRaiz 1 ejPol3  ==  False
--    esRaiz 0 ejPol3  ==  True
esRaiz:: (Num a, Eq a) => a -> Polinomio a -> Bool
esRaiz c p = valor p c == 0

-- ---------------------------------------------------------------------
-- Derivación de polinomios                                           --
-- ---------------------------------------------------------------------

-- (derivada p) es la derivada del polinomio p. Por ejemplo, 
--    ejPol2           ==  x^5 + 5*x^2 + 4*x
--    derivada ejPol2  ==  5*x^4 + 10*x + 4
derivada :: Polinomio Int -> Polinomio Int
derivada p 
    | n == 0     = polCero
    | otherwise  = consPol (n-1) (n*b) (derivada r)
    where n = grado p
          b = coefLider p
          r = restoPol p

-- Propiedad. La derivada de la suma es la suma de las derivadas.
prop_derivada :: Polinomio Int -> Polinomio Int -> Bool
prop_derivada p q =
    derivada (sumaPol p q) == sumaPol (derivada p) (derivada q)

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

-- ---------------------------------------------------------------------
-- Resta de polinomios                                                --
-- ---------------------------------------------------------------------

-- (resta p q) es la el polinomio obtenido restándole a p el q. Por
-- ejemplo, 
--    ejPol1                  ==  3*x^4 + -5*x^2 + 3
--    ejPol2                  ==  x^5 + 5*x^2 + 4*x
--    restaPol ejPol1 ejPol2  ==  -1*x^5 + 3*x^4 + -10*x^2 + -4*x + 3
restaPol :: (Num a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a
restaPol p q  = 
    sumaPol p (multPorTerm (creaTermino 0 (-1)) q)

-- ---------------------------------------------------------------------
-- Ejercicio 1. Definir la función
--    creaPolDispersa :: (Num a, Eq a) => [a] -> Polinomio a
-- tal que (creaPolDispersa xs) es el polinomio cuya representación
-- dispersa es xs. Por ejemplo,
--    creaPolDispersa [7,0,0,4,0,3]  ==  7*x^5 + 4*x^2 + 3
-- ---------------------------------------------------------------------

creaPolDispersa :: (Num a, Eq a) => [a] -> Polinomio a
creaPolDispersa []     = polCero
creaPolDispersa (x:xs) = consPol (length xs) x (creaPolDispersa xs)

-- ---------------------------------------------------------------------
-- Ejercicio 12. Definir la función
--    multEscalar :: (Num a, Eq a) => a -> Polinomio a -> Polinomio a
-- tal que (multEscalar c p) es el polinomio obtenido multiplicando el
-- número c por el polinomio p. Por ejemplo, 
--    pol2                    ==  2*x + 3
--    multEscalar 4 pol2      ==  8*x + 12
--    multEscalar (1%4) pol2  ==  1 % 2*x + 3 % 4
-- ---------------------------------------------------------------------

multEscalar :: (Num a, Eq a) => a -> Polinomio a -> Polinomio a
multEscalar c p 
  | esPolCero p = polCero
  | otherwise   = consPol n (c*b) (multEscalar c r)
  where n = grado p
        b = coefLider p
        r = restoPol p

-- ---------------------------------------------------------------------
-- Ejercicio 13. Definir la función
--    cociente:: (Fractional a, Eq a) => 
--               Polinomio a -> Polinomio a -> Polinomio a
-- tal que (cociente p q) es el cociente de la división de p entre
-- q. Por ejemplo, 
--    pol4  ==  3 % 1*x^4 + 5 % 1*x^2 + 3 % 1
--    pol5  ==  6 % 1*x^2 + 2 % 1*x
--    cociente pol4 pol5  ==  1 % 2*x^2 + (-1) % 6*x + 8 % 9
-- ---------------------------------------------------------------------

cociente:: (Fractional a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a
cociente p q
    | n2 == 0   = multEscalar (1/a2) p
    | n1 < n2   = polCero
    | otherwise =  consPol n' a' (cociente p' q)
    where n1 = grado p
          a1 = coefLider p
          n2 = grado q
          a2 = coefLider q
          n' = n1-n2
          a' = a1/a2
          p' = restaPol p (multPorTerm (creaTermino n' a') q)

-- ---------------------------------------------------------------------
-- Ejercicio 14. Definir la función
--    resto:: (Fractional a, Eq a) => 
--            Polinomio a -> Polinomio a -> Polinomio a
-- tal que (resto p q) es el resto de la división de p entre q. Por
-- ejemplo,  
--    pol4  ==  3 % 1*x^4 + 5 % 1*x^2 + 3 % 1
--    pol5  ==  6 % 1*x^2 + 2 % 1*x
--    resto pol4 pol5  ==  (-16) % 9*x + 3 % 1
-- ---------------------------------------------------------------------

resto :: (Fractional a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a
resto p q = restaPol p (multPol (cociente p q) q)

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

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

271

272

273

274

275

276

277

278

279

280

281

282

283

284

285

286

287

288

289

290

291

292

293

294

295

296

297

298

299

300

301

302

303

304

305

306

307

module PolOperaciones (module Pol, module PolOperaciones) where

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

-- Importación de librerías --

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

-- Nota: Hay que elegir una implementación del TAD de los polinomios.

import PolRepTDA as Pol

-- import PolRepDispersa as Pol

-- import PolRepDensa as Pol

import Test.QuickCheck

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

-- Ejemplos --

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

-- Ejemplos de polinomios con coeficientes enteros:

ejPol1, ejPol2, ejPol3, ejTerm:: Polinomio Int

ejPol1 = consPol 4 3 (consPol 2 (-5) (consPol 0 3 polCero))

ejPol2 = consPol 5 1 (consPol 2 5 (consPol 1 4 polCero))

ejPol3 = consPol 4 6 (consPol 1 2 polCero)

ejTerm = consPol 1 4 polCero

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

-- Generador de polinomios --

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

-- (genPol n) es un generador de polinomios. Por ejemplo,

-- ghci> sample (genPol 1)

-- 7*x^9 + 9*x^8 + 10*x^7 + -14*x^5 + -15*x^2 + -10

-- -4*x^8 + 2*x

-- -8*x^9 + 4*x^8 + 2*x^6 + 4*x^5 + -6*x^4 + 5*x^2 + -8*x

-- -9*x^9 + x^5 + -7

-- 8*x^10 + -9*x^7 + 7*x^6 + 9*x^5 + 10*x^3 + -1*x^2

-- 7*x^10 + 5*x^9 + -5

-- -8*x^10 + -7

-- -5*x

-- 5*x^10 + 4*x^4 + -3

-- 3*x^3 + -4

-- 10*x

genPol :: (Arbitrary a, Num a, Eq a) => Int -> Gen (Polinomio a)

genPol 0 = return polCero

genPol n = do n <- choose (0,10)

b <- arbitrary

p <- genPol (div n 2)

return (consPol n b p)

instance (Arbitrary a, Num a, Eq a) => Arbitrary (Polinomio a) where

arbitrary = sized genPol

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

-- Funciones sobre términos --

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

-- (creaTermino n a) es el término a*x^n. Por ejemplo,

-- creaTermino 2 5 == 5*x^2

creaTermino:: (Num t, Eq t) => Int -> t -> Polinomio t

creaTermino n a = consPol n a polCero

-- (termLider p) es el término líder del polinomio p. Por ejemplo,

-- ejPol2 == x^5 + 5*x^2 + 4*x

-- termLider ejPol2 == x^5

termLider:: (Num t, Eq t) => Polinomio t -> Polinomio t

termLider p = creaTermino (grado p) (coefLider p)

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

-- Suma de polinomios --

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

-- (sumaPol p q) es la suma de los polinomios p y q. Por ejemplo,

-- ejPol1 == 3*x^4 + -5*x^2 + 3

-- ejPol2 == x^5 + 5*x^2 + 4*x

-- sumaPol ejPol1 ejPol2 == x^5 + 3*x^4 + 4*x + 3

sumaPol:: (Num a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a

sumaPol p q

| esPolCero p = q

| esPolCero q = p

| n1 > n2 = consPol n1 a1 (sumaPol r1 q)

| n1 < n2 = consPol n2 a2 (sumaPol p r2)

| otherwise = consPol n1 (a1+a2) (sumaPol r1 r2)

where n1 = grado p

a1 = coefLider p

r1 = restoPol p

n2 = grado q

a2 = coefLider q

r2 = restoPol q

-- Propiedad. El polinomio cero es el elemento neutro de la suma.

prop_neutroSumaPol :: Polinomio Int -> Bool

prop_neutroSumaPol p =

sumaPol polCero p == p

-- Comprobación con QuickCheck.

-- ghci> quickCheck prop_neutroSumaPol

-- OK, passed 100 tests.

-- Propiedad. La suma es conmutativa.

prop_conmutativaSuma :: Polinomio Int -> Polinomio Int -> Bool

prop_conmutativaSuma p q =

sumaPol p q == sumaPol q p

-- Comprobación:

-- ghci> quickCheck prop_conmutativaSuma

-- OK, passed 100 tests.

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

-- Producto de polinomios --

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

-- (multPorTerm t p) es el producto del término t por el polinomio

-- p. Por ejemplo,

-- ejTerm == 4*x

-- ejPol2 == x^5 + 5*x^2 + 4*x

-- multPorTerm ejTerm ejPol2 == 4*x^6 + 20*x^3 + 16*x^2

multPorTerm :: (Num t, Eq t) => Polinomio t -> Polinomio t -> Polinomio t

multPorTerm term pol

| esPolCero pol = polCero

| otherwise = consPol (n+m) (a*b) (multPorTerm term r)

where n = grado term

a = coefLider term

m = grado pol

b = coefLider pol

r = restoPol pol

-- (multPol p q) es el producto de los polinomios p y q. Por

-- ejemplo,

-- ghci> ejPol1

-- 3*x^4 + -5*x^2 + 3

-- ghci> ejPol2

-- x^5 + 5*x^2 + 4*x

-- ghci> multPol ejPol1 ejPol2

-- 3*x^9 + -5*x^7 + 15*x^6 + 15*x^5 + -25*x^4 + -20*x^3 + 15*x^2 + 12*x

multPol :: (Num a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a

multPol p q

| esPolCero p = polCero

| otherwise = sumaPol (multPorTerm (termLider p) q)

(multPol (restoPol p) q)

-- Propiedad. El producto de polinomios es conmutativo.

prop_conmutativaProducto :: Polinomio Int -> Polinomio Int -> Bool

prop_conmutativaProducto p q =

multPol p q == multPol q p

-- La comprobación es

-- ghci> quickCheck prop_conmutativaProducto

-- OK, passed 100 tests.

-- El producto es distributivo respecto de la suma.

prop_distributivaProductoSuma :: Polinomio Int -> Polinomio Int

-> Polinomio Int -> Bool

prop_distributivaProductoSuma p q r =

multPol p (sumaPol q r) == sumaPol (multPol p q) (multPol p r)

-- Comprobación:

-- ghci> quickCheck prop_distributivaProductoSuma

-- OK, passed 100 tests.

-- polUnidad es el polinomio unidad. Por ejemplo,

-- ghci> polUnidad

-- 1

polUnidad:: (Num t, Eq t) => Polinomio t

polUnidad = consPol 0 1 polCero

-- Propiedad. El polinomio unidad es el elemento neutro del producto.

prop_polUnidad :: Polinomio Int -> Bool

prop_polUnidad p =

multPol p polUnidad == p

-- Comprobación:

-- ghci> quickCheck prop_polUnidad

-- OK, passed 100 tests.

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

-- Valor de un polinomio en un punto --

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

-- (valor p c) es el valor del polinomio p al sustituir su variable por

-- c. Por ejemplo,

-- ejPol1 == 3*x^4 + -5*x^2 + 3

-- valor ejPol1 0 == 3

-- valor ejPol1 1 == 1

-- valor ejPol1 (-2) == 31

valor:: (Num a, Eq a) => Polinomio a -> a -> a

valor p c

| esPolCero p = 0

| otherwise = b*c^n + valor r c

where n = grado p

b = coefLider p

r = restoPol p

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

-- Verificación de raices de polinomios --

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

-- (esRaiz c p) se verifica si c es una raiz del polinomio p. por

-- ejemplo,

-- ejPol3 == 6*x^4 + 2*x

-- esRaiz 1 ejPol3 == False

-- esRaiz 0 ejPol3 == True

esRaiz:: (Num a, Eq a) => a -> Polinomio a -> Bool

esRaiz c p = valor p c == 0

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

-- Derivación de polinomios --

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

-- (derivada p) es la derivada del polinomio p. Por ejemplo,

-- ejPol2 == x^5 + 5*x^2 + 4*x

-- derivada ejPol2 == 5*x^4 + 10*x + 4

derivada :: Polinomio Int -> Polinomio Int

derivada p

| n == 0 = polCero

| otherwise = consPol (n-1) (n*b) (derivada r)

where n = grado p

b = coefLider p

r = restoPol p

-- Propiedad. La derivada de la suma es la suma de las derivadas.

prop_derivada :: Polinomio Int -> Polinomio Int -> Bool

prop_derivada p q =

derivada (sumaPol p q) == sumaPol (derivada p) (derivada q)

-- Comprobación

-- ghci> quickCheck prop_derivada

-- OK, passed 100 tests.

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

-- Resta de polinomios --

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

-- (resta p q) es la el polinomio obtenido restándole a p el q. Por

-- ejemplo,

-- ejPol1 == 3*x^4 + -5*x^2 + 3

-- ejPol2 == x^5 + 5*x^2 + 4*x

-- restaPol ejPol1 ejPol2 == -1*x^5 + 3*x^4 + -10*x^2 + -4*x + 3

restaPol :: (Num a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a

restaPol p q =

sumaPol p (multPorTerm (creaTermino 0 (-1)) q)

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

-- Ejercicio 1. Definir la función

-- creaPolDispersa :: (Num a, Eq a) => [a] -> Polinomio a

-- tal que (creaPolDispersa xs) es el polinomio cuya representación

-- dispersa es xs. Por ejemplo,

-- creaPolDispersa [7,0,0,4,0,3] == 7*x^5 + 4*x^2 + 3

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

creaPolDispersa :: (Num a, Eq a) => [a] -> Polinomio a

creaPolDispersa [] = polCero

creaPolDispersa (x:xs) = consPol (length xs) x (creaPolDispersa xs)

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

-- Ejercicio 12. Definir la función

-- multEscalar :: (Num a, Eq a) => a -> Polinomio a -> Polinomio a

-- tal que (multEscalar c p) es el polinomio obtenido multiplicando el

-- número c por el polinomio p. Por ejemplo,

-- pol2 == 2*x + 3

-- multEscalar 4 pol2 == 8*x + 12

-- multEscalar (1%4) pol2 == 1 % 2*x + 3 % 4

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

multEscalar :: (Num a, Eq a) => a -> Polinomio a -> Polinomio a

multEscalar c p

| esPolCero p = polCero

| otherwise = consPol n (c*b) (multEscalar c r)

where n = grado p

b = coefLider p

r = restoPol p

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

-- Ejercicio 13. Definir la función

-- cociente:: (Fractional a, Eq a) =>

-- Polinomio a -> Polinomio a -> Polinomio a

-- tal que (cociente p q) es el cociente de la división de p entre

-- q. Por ejemplo,

-- pol4 == 3 % 1*x^4 + 5 % 1*x^2 + 3 % 1

-- pol5 == 6 % 1*x^2 + 2 % 1*x

-- cociente pol4 pol5 == 1 % 2*x^2 + (-1) % 6*x + 8 % 9

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

cociente:: (Fractional a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a

cociente p q

| n2 == 0 = multEscalar (1/a2) p

| n1 < n2 = polCero

| otherwise = consPol n' a' (cociente p' q)

where n1 = grado p

a1 = coefLider p

n2 = grado q

a2 = coefLider q

n' = n1-n2

a' = a1/a2

p' = restaPol p (multPorTerm (creaTermino n' a') q)

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

-- Ejercicio 14. Definir la función

-- resto:: (Fractional a, Eq a) =>

-- Polinomio a -> Polinomio a -> Polinomio a

-- tal que (resto p q) es el resto de la división de p entre q. Por

-- ejemplo,

-- pol4 == 3 % 1*x^4 + 5 % 1*x^2 + 3 % 1

-- pol5 == 6 % 1*x^2 + 2 % 1*x

-- resto pol4 pol5 == (-16) % 9*x + 3 % 1

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

resto :: (Fractional a, Eq a) => Polinomio a -> Polinomio a -> Polinomio a

resto p q = restaPol p (multPol (cociente p q) q)

Las soluciones del examen del grupo 4 (impartido por Francisco J. Martín) son

-- ---------------------------------------------------------------------
-- Ejercicio 1. Se consideran los árboles binarios representados
-- mediante el tipo Arbol definido por 
--    data Arbol = Hoja Int
--               | Nodo Int  Arbol Arbol
-- Por ejemplo, el árbol
--         1
--        / \
--       /   \
--      3     2
--     / \   / \
--    5   4 6   7
-- se puede representar por
--    Nodo 1 (Nodo 3 (Hoja 5) (Hoja 4)) (Nodo 2 (Hoja 6) (Hoja 7))
-- En los ejemplos se usarán los árboles definidos por
--    ej1 = Nodo 1 (Nodo 3 (Hoja 5) (Hoja 4)) (Nodo 2 (Hoja 6) (Hoja 7))
--    ej2 = Nodo 3 (Hoja 1) (Hoja 4)
--    ej3 = Nodo 2 (Hoja 3) (Hoja 5)
--    ej4 = Nodo 1 (Hoja 2) (Nodo 2 (Hoja 3) (Hoja 3))
--    ej5 = Nodo 1 (Nodo 2 (Hoja 3) (Hoja 5)) (Hoja 2)
-- 
-- Las capas de un árbol binario son las listas de elementos que están a
-- la misma profundidad. Por ejemplo, las capas del árbol 
--         1
--        / \
--       /   \
--      3     2
--     / \   / \
--    5   4 6   7
-- son: [1], [3,2] y [5,4,6,7]
--
-- Definir la función 
--    capas :: Arbol -> [[Int]]
-- tal que (capas a) es la lista de las capas de dicho árbol ordenadas
-- según la profunidad. Por ejemplo, 
--    capas ej1  ==  [[1],[3,2],[5,4,6,7]]
--    capas ej2  ==  [[3],[1,4]]
--    capas ej3  ==  [[2],[3,5]]
--    capas ej4  ==  [[1],[2,2],[3,3]]
--    capas ej5  ==  [[1],[2,2],[3,5]]
-- ---------------------------------------------------------------------

data Arbol = Hoja Int
           | Nodo Int Arbol Arbol
             deriving Show

ej1 = Nodo 1 (Nodo 3 (Hoja 5) (Hoja 4)) (Nodo 2 (Hoja 6) (Hoja 7))
ej2 = Nodo 3 (Hoja 1) (Hoja 4)
ej3 = Nodo 2 (Hoja 3) (Hoja 5)
ej4 = Nodo 1 (Hoja 2) (Nodo 2 (Hoja 3) (Hoja 3))
ej5 = Nodo 1 (Nodo 2 (Hoja 3) (Hoja 5)) (Hoja 2)

capas :: Arbol -> [[Int]]
capas (Hoja n) = [[n]]
capas (Nodo n i d) = [n] : union (capas i) (capas d)

-- (union xss yss) es la lista obtenida concatenando los
-- correspondientes elementos de xss e yss. Por ejemplo,
--    union [[3,4],[2]] [[5],[7,6,8]]  ==  [[3,4,5],[2,7,6,8]]
--    union [[3,4]]     [[5],[7,6,8]]  ==  [[3,4,5],[7,6,8]]
--    union [[3,4],[2]] [[5]]          ==  [[3,4,5],[2]]
union :: [[a]] -> [[a]] -> [[a]]
union [] yss = yss
union xss [] = xss
union (xs:xss) (ys:yss) = (xs ++ ys) : union xss yss

-- ---------------------------------------------------------------------
-- Ejercicio 2. Un árbol es subárbol de otro si se puede establecer una
-- correspondencia de los nodos del primero con otros mayores o iguales
-- en el segundo, de forma que se respeten las relaciones de
-- descendencia. Este concepto se resume en varias situaciones posibles: 
-- * El primer árbol es subárbol del hijo izquierdo del segundo
--   árbol. De esta forma ej2 es subárbol de ej1.
-- * El primer árbol es subárbol del hijo derecho del segundo árbol. De
--   esta forma ej3 es subárbol de ej1.
-- * La raíz del primer árbol es menor o igual que la del segundo, el
--   hijo izquierdo del primer árbol es subárbol del hijo izquierdo del
--   segundo y el hijo derecho del primer árbol es subárbol del hijo
--   derecho del segundo. De esta forma ej4 es subárbol de ej1.
--
-- Definir la función 
--    subarbol :: Arbol -> Arbol -> Bool
-- tal que (subarbol a1 a2) se verifica si a1 es subárbol de a2. Por
-- ejemplo, 
--    subarbol ej2 ej1  ==  True
--    subarbol ej3 ej1  ==  True
--    subarbol ej4 ej1  ==  True
--    subarbol ej5 ej1  ==  False
-- ---------------------------------------------------------------------

subarbol :: Arbol -> Arbol -> Bool
subarbol (Hoja n) (Hoja m) =
    n <= m
subarbol (Hoja n) (Nodo m i d) =
    n <= m || subarbol (Hoja n) i || subarbol (Hoja n) d
subarbol (Nodo _ _ _) (Hoja _) =
    False
subarbol (Nodo n i1 d1) (Nodo m i2 d2) =
    subarbol (Nodo n i1 d1) i2 ||
    subarbol (Nodo n i1 d1) d2 ||
    n <= m && (subarbol i1 i2) && (subarbol d1 d2)

-- ---------------------------------------------------------------------
-- Ejercicio 3.1 (1.2 puntos): Definir la función 
--    intercalaRep :: Eq a => a -> [a] -> [[a]]
-- tal que (intercalaRep x ys), es la lista de las listas obtenidas
-- intercalando x entre los elementos de ys, hasta la primera ocurrencia
-- del elemento x en ys. Por ejemplo,
--    intercalaRep 1 []       ==  [[1]]
--    intercalaRep 1 [1]      ==  [[1,1]]
--    intercalaRep 1 [2]      ==  [[1,2],[2,1]]
--    intercalaRep 1 [1,1]    ==  [[1,1,1]]
--    intercalaRep 1 [1,2]    ==  [[1,1,2]]
--    intercalaRep 1 [2,1]    ==  [[1,2,1],[2,1,1]]
--    intercalaRep 1 [1,2,1]  ==  [[1,1,2,1]]
--    intercalaRep 1 [2,1,1]  ==  [[1,2,1,1],[2,1,1,1]]
--    intercalaRep 1 [1,1,2]  ==  [[1,1,1,2]]
--    intercalaRep 1 [1,2,2]  ==  [[1,1,2,2]]
--    intercalaRep 1 [2,1,2]  ==  [[1,2,1,2],[2,1,1,2]]
--    intercalaRep 1 [2,2,1]  ==  [[1,2,2,1],[2,1,2,1],[2,2,1,1]]
-- ---------------------------------------------------------------------

-- 1ª definición (con map):
intercalaRep :: Eq a => a -> [a] -> [[a]]
intercalaRep x [] = [[x]]
intercalaRep x (y:ys)
    | x == y    = [x:y:ys]
    | otherwise = (x:y:ys) : (map (y:) (intercalaRep x ys))

-- 2ª definición (sin map):
intercalaRep2 :: Eq a => a -> [a] -> [[a]]
intercalaRep2 x [] = [[x]]
intercalaRep2 x (y:ys)
    | x == y    = [x:y:ys]
    | otherwise = (x:y:ys) : [y:zs | zs <- intercalaRep2 x ys]

-- ---------------------------------------------------------------------
-- Ejercicio 3.2.Definir la función
--    permutacionesRep :: Eq a => [a] -> [[a]]
-- tal que (permutacionesRep xs) es la lista (sin elementos repetidos)
-- de todas las permutaciones con repetición de la lista xs. Por
-- ejemplo, 
--    permutacionesRep []         ==  [[]]
--    permutacionesRep [1]        ==  [[1]]
--    permutacionesRep [1,1]      ==  [[1,1]]
--    permutacionesRep [1,2]      ==  [[1,2],[2,1]]
--    permutacionesRep [1,2,1]    ==  [[1,2,1],[2,1,1],[1,1,2]]
--    permutacionesRep [1,1,2]    ==  [[1,1,2],[1,2,1],[2,1,1]]
--    permutacionesRep [2,1,1]    ==  [[2,1,1],[1,2,1],[1,1,2]]
--    permutacionesRep [1,1,1]    ==  [[1,1,1]]
--    permutacionesRep [1,1,2,2]  ==  [[1,1,2,2],[1,2,1,2],[2,1,1,2],
--                                     [1,2,2,1],[2,1,2,1],[2,2,1,1]]
-- ---------------------------------------------------------------------

permutacionesRep :: Eq a => [a] -> [[a]]
permutacionesRep []     = [[]]
permutacionesRep [x]    = [[x]]
permutacionesRep (x:xs) =
    concat (map (intercalaRep x) (permutacionesRep xs))

-- ---------------------------------------------------------------------
-- Ejercicio 4. Un montón de barriles se construye apilando unos encima
-- de otros por capas, de forma que en cada capa todos los barriles
-- están apoyados sobre dos de la capa inferior y todos los barriles de
-- una misma capa están pegados unos a otros. Por ejemplo, los
-- siguientes montones son válidos:
--             _          _   _                   _
--            / \        / \ / \                 / \
--           _\_/_      _\_/_\_/_   _       _   _\_/_   _
--          / \ / \    / \ / \ / \ / \     / \ / \ / \ / \
--          \_/ \_/    \_/ \_/ \_/ \_/     \_/ \_/ \_/ \_/
--
-- y los siguientes no son válidos:
--         _   _          _       _               _   _
--        / \ / \        / \     / \             / \ / \
--        \_/_\_/_      _\_/_   _\_/_       _   _\_/_\_/
--          / \ / \    / \ / \ / \ / \     / \ / \ / \
--          \_/ \_/    \_/ \_/ \_/ \_/     \_/ \_/ \_/
--
-- Se puede comprobar que el número de formas distintas de construir
-- montones con n barriles en la base M_n viene dado por la siguiente
-- fórmula: 
--
--              (n-1)
--             -------
--              \
--               \
--   M_n = 1 +    )    (n-j) * M_j
--               /
--              /
--             -------
--              j = 1
--
-- Definir la función 
--    montones :: Integer -> Integer
-- tal que (montones n) es el número de formas distintas de construir
-- montones con n barriles en la base. Por ejemplo,
--    montones 1   ==  1
--    montones 10  ==  4181
--    montones 20  ==  63245986
--    montones 30  ==  956722026041
--
-- Calcular el número de formas distintas de construir montones con 50
-- barriles en la base.
-- ---------------------------------------------------------------------

montones :: Integer -> Integer
montones 1 = 1
montones n = 1 + sum [(n-j)*(montones j) | j <- [1..n-1]]

-- 2ª definición, a partir de la siguiente observación
--    M(1) = 1                          = 1
--    M(2) = 1 + M(1)                   = M(1) + M(1)   
--    M(3) = 1 + 2*M(1) + M(2)          = M(2) + (M(1) + M(2))
--    M(4) = 1 + 3*M(1) + 2*M(2) + M(3) = M(3) + (M(1) + M(2) + M(3))
montones2 :: Int -> Integer
montones2 n = montonesSuc !! (n-1)

montonesSuc :: [Integer]
montonesSuc = 1 : zipWith (+) montonesSuc (scanl1 (+) montonesSuc)

-- 3ª definición
montones3 :: Integer -> Integer
montones3 0 = 0
montones3 n = head (montonesAcc [] n)

montonesAcc :: [Integer] -> Integer -> [Integer]
montonesAcc ms 0 = ms
montonesAcc ms n =
    montonesAcc ((1 + sum (zipWith (*) ms [1..])):ms) (n-1)

-- El cálculo es
--    ghci> montones2 50
--    218922995834555169026

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

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

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

-- Ejercicio 1. Se consideran los árboles binarios representados

-- mediante el tipo Arbol definido por

-- data Arbol = Hoja Int

-- | Nodo Int Arbol Arbol

-- Por ejemplo, el árbol

-- 1

-- / \

-- 3 2

-- / \ / \

-- 5 4 6 7

-- se puede representar por

-- Nodo 1 (Nodo 3 (Hoja 5) (Hoja 4)) (Nodo 2 (Hoja 6) (Hoja 7))

-- En los ejemplos se usarán los árboles definidos por

-- ej1 = Nodo 1 (Nodo 3 (Hoja 5) (Hoja 4)) (Nodo 2 (Hoja 6) (Hoja 7))

-- ej2 = Nodo 3 (Hoja 1) (Hoja 4)

-- ej3 = Nodo 2 (Hoja 3) (Hoja 5)

-- ej4 = Nodo 1 (Hoja 2) (Nodo 2 (Hoja 3) (Hoja 3))

-- ej5 = Nodo 1 (Nodo 2 (Hoja 3) (Hoja 5)) (Hoja 2)

-- Las capas de un árbol binario son las listas de elementos que están a

-- la misma profundidad. Por ejemplo, las capas del árbol

-- 1

-- / \

-- 3 2

-- / \ / \

-- 5 4 6 7

-- son: [1], [3,2] y [5,4,6,7]

-- Definir la función

-- capas :: Arbol -> [[Int]]

-- tal que (capas a) es la lista de las capas de dicho árbol ordenadas

-- según la profunidad. Por ejemplo,

-- capas ej1 == [[1],[3,2],[5,4,6,7]]

-- capas ej2 == [[3],[1,4]]

-- capas ej3 == [[2],[3,5]]

-- capas ej4 == [[1],[2,2],[3,3]]

-- capas ej5 == [[1],[2,2],[3,5]]

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

data Arbol = Hoja Int

| Nodo Int Arbol Arbol

deriving Show

ej1 = Nodo 1 (Nodo 3 (Hoja 5) (Hoja 4)) (Nodo 2 (Hoja 6) (Hoja 7))

ej2 = Nodo 3 (Hoja 1) (Hoja 4)

ej3 = Nodo 2 (Hoja 3) (Hoja 5)

ej4 = Nodo 1 (Hoja 2) (Nodo 2 (Hoja 3) (Hoja 3))

ej5 = Nodo 1 (Nodo 2 (Hoja 3) (Hoja 5)) (Hoja 2)

capas :: Arbol -> [[Int]]

capas (Hoja n) = [[n]]

capas (Nodo n i d) = [n] : union (capas i) (capas d)

-- (union xss yss) es la lista obtenida concatenando los

-- correspondientes elementos de xss e yss. Por ejemplo,

-- union [[3,4],[2]] [[5],[7,6,8]] == [[3,4,5],[2,7,6,8]]

-- union [[3,4]] [[5],[7,6,8]] == [[3,4,5],[7,6,8]]

-- union [[3,4],[2]] [[5]] == [[3,4,5],[2]]

union :: [[a]] -> [[a]] -> [[a]]

union [] yss = yss

union xss [] = xss

union (xs:xss) (ys:yss) = (xs ++ ys) : union xss yss

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

-- Ejercicio 2. Un árbol es subárbol de otro si se puede establecer una

-- correspondencia de los nodos del primero con otros mayores o iguales

-- en el segundo, de forma que se respeten las relaciones de

-- descendencia. Este concepto se resume en varias situaciones posibles:

-- * El primer árbol es subárbol del hijo izquierdo del segundo

-- árbol. De esta forma ej2 es subárbol de ej1.

-- * El primer árbol es subárbol del hijo derecho del segundo árbol. De

-- esta forma ej3 es subárbol de ej1.

-- * La raíz del primer árbol es menor o igual que la del segundo, el

-- hijo izquierdo del primer árbol es subárbol del hijo izquierdo del

-- segundo y el hijo derecho del primer árbol es subárbol del hijo

-- derecho del segundo. De esta forma ej4 es subárbol de ej1.

-- Definir la función

-- subarbol :: Arbol -> Arbol -> Bool

-- tal que (subarbol a1 a2) se verifica si a1 es subárbol de a2. Por

-- ejemplo,

-- subarbol ej2 ej1 == True

-- subarbol ej3 ej1 == True

-- subarbol ej4 ej1 == True

-- subarbol ej5 ej1 == False

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

subarbol :: Arbol -> Arbol -> Bool

subarbol (Hoja n) (Hoja m) =

n <= m

subarbol (Hoja n) (Nodo m i d) =

n <= m || subarbol (Hoja n) i || subarbol (Hoja n) d

subarbol (Nodo _ _ _) (Hoja _) =

False

subarbol (Nodo n i1 d1) (Nodo m i2 d2) =

subarbol (Nodo n i1 d1) i2 ||

subarbol (Nodo n i1 d1) d2 ||

n <= m && (subarbol i1 i2) && (subarbol d1 d2)

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

-- Ejercicio 3.1 (1.2 puntos): Definir la función

-- intercalaRep :: Eq a => a -> [a] -> [[a]]

-- tal que (intercalaRep x ys), es la lista de las listas obtenidas

-- intercalando x entre los elementos de ys, hasta la primera ocurrencia

-- del elemento x en ys. Por ejemplo,

-- intercalaRep 1 [] == [[1]]

-- intercalaRep 1 [1] == [[1,1]]

-- intercalaRep 1 [2] == [[1,2],[2,1]]

-- intercalaRep 1 [1,1] == [[1,1,1]]

-- intercalaRep 1 [1,2] == [[1,1,2]]

-- intercalaRep 1 [2,1] == [[1,2,1],[2,1,1]]

-- intercalaRep 1 [1,2,1] == [[1,1,2,1]]

-- intercalaRep 1 [2,1,1] == [[1,2,1,1],[2,1,1,1]]

-- intercalaRep 1 [1,1,2] == [[1,1,1,2]]

-- intercalaRep 1 [1,2,2] == [[1,1,2,2]]

-- intercalaRep 1 [2,1,2] == [[1,2,1,2],[2,1,1,2]]

-- intercalaRep 1 [2,2,1] == [[1,2,2,1],[2,1,2,1],[2,2,1,1]]

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

-- 1ª definición (con map):

intercalaRep :: Eq a => a -> [a] -> [[a]]

intercalaRep x [] = [[x]]

intercalaRep x (y:ys)

| x == y = [x:y:ys]

| otherwise = (x:y:ys) : (map (y:) (intercalaRep x ys))

-- 2ª definición (sin map):

intercalaRep2 :: Eq a => a -> [a] -> [[a]]

intercalaRep2 x [] = [[x]]

intercalaRep2 x (y:ys)

| x == y = [x:y:ys]

| otherwise = (x:y:ys) : [y:zs | zs <- intercalaRep2 x ys]

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

-- Ejercicio 3.2.Definir la función

-- permutacionesRep :: Eq a => [a] -> [[a]]

-- tal que (permutacionesRep xs) es la lista (sin elementos repetidos)

-- de todas las permutaciones con repetición de la lista xs. Por

-- ejemplo,

-- permutacionesRep [] == [[]]

-- permutacionesRep [1] == [[1]]

-- permutacionesRep [1,1] == [[1,1]]

-- permutacionesRep [1,2] == [[1,2],[2,1]]

-- permutacionesRep [1,2,1] == [[1,2,1],[2,1,1],[1,1,2]]

-- permutacionesRep [1,1,2] == [[1,1,2],[1,2,1],[2,1,1]]

-- permutacionesRep [2,1,1] == [[2,1,1],[1,2,1],[1,1,2]]

-- permutacionesRep [1,1,1] == [[1,1,1]]

-- permutacionesRep [1,1,2,2] == [[1,1,2,2],[1,2,1,2],[2,1,1,2],

-- [1,2,2,1],[2,1,2,1],[2,2,1,1]]

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

permutacionesRep :: Eq a => [a] -> [[a]]

permutacionesRep [] = [[]]

permutacionesRep [x] = [[x]]

permutacionesRep (x:xs) =

concat (map (intercalaRep x) (permutacionesRep xs))

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

-- Ejercicio 4. Un montón de barriles se construye apilando unos encima

-- de otros por capas, de forma que en cada capa todos los barriles

-- están apoyados sobre dos de la capa inferior y todos los barriles de

-- una misma capa están pegados unos a otros. Por ejemplo, los

-- siguientes montones son válidos:

-- _ _ _ _

-- / \ / \ / \ / \

-- _\_/_ _\_/_\_/_ _ _ _\_/_ _

-- / \ / \ / \ / \ / \ / \ / \ / \ / \ / \

-- \_/ \_/ \_/ \_/ \_/ \_/ \_/ \_/ \_/ \_/

-- y los siguientes no son válidos:

-- _ _ _ _ _ _

-- / \ / \ / \ / \ / \ / \

-- \_/_\_/_ _\_/_ _\_/_ _ _\_/_\_/

-- / \ / \ / \ / \ / \ / \ / \ / \ / \

-- \_/ \_/ \_/ \_/ \_/ \_/ \_/ \_/ \_/

-- Se puede comprobar que el número de formas distintas de construir

-- montones con n barriles en la base M_n viene dado por la siguiente

-- fórmula:

-- (n-1)

-- -------

-- \

-- M_n = 1 + ) (n-j) * M_j

-- /

-- -------

-- j = 1

-- Definir la función

-- montones :: Integer -> Integer

-- tal que (montones n) es el número de formas distintas de construir

-- montones con n barriles en la base. Por ejemplo,

-- montones 1 == 1

-- montones 10 == 4181

-- montones 20 == 63245986

-- montones 30 == 956722026041

-- Calcular el número de formas distintas de construir montones con 50

-- barriles en la base.

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

montones :: Integer -> Integer

montones 1 = 1

montones n = 1 + sum [(n-j)*(montones j) | j <- [1..n-1]]

-- 2ª definición, a partir de la siguiente observación

-- M(1) = 1 = 1

-- M(2) = 1 + M(1) = M(1) + M(1)

-- M(3) = 1 + 2*M(1) + M(2) = M(2) + (M(1) + M(2))

-- M(4) = 1 + 3*M(1) + 2*M(2) + M(3) = M(3) + (M(1) + M(2) + M(3))

montones2 :: Int -> Integer

montones2 n = montonesSuc !! (n-1)

montonesSuc :: [Integer]

montonesSuc = 1 : zipWith (+) montonesSuc (scanl1 (+) montonesSuc)

-- 3ª definición

montones3 :: Integer -> Integer

montones3 0 = 0

montones3 n = head (montonesAcc [] n)

montonesAcc :: [Integer] -> Integer -> [Integer]

montonesAcc ms 0 = ms

montonesAcc ms n =

montonesAcc ((1 + sum (zipWith (*) ms [1..])):ms) (n-1)

-- El cálculo es

-- ghci> montones2 50

-- 218922995834555169026

Las soluciones del examen del grupo 5 (impartido por Andrés Cordón y Miguel A. Martínez) son

-- ---------------------------------------------------------------------
-- § Librerías auxiliares                                             --
-- ---------------------------------------------------------------------

import Data.List

-- ----------------------------------------------------------------------
-- Ejercicio 1.1. Un número se dirá ordenado si sus cifras están en orden 
-- creciente. Por ejemplo, 11257 es ordenado pero 2423 no lo es.
--
-- Definir la lista 
--    ordenados :: [Integer]
-- formada  por todos los enteros ordenados. Por ejemplo,
--    ghci> take 20 (dropWhile (<30) ordenados)
--    [33,34,35,36,37,38,39,44,45,46,47,48,49,55,56,57,58,59,66,67]
-- ---------------------------------------------------------------------

ordenados :: [Integer]
ordenados = [n | n <- [1..], esOrdenado n]

-- (esOrdenado x) se verifica si el número x es ordenado. Por ejemplo,
--    esOrdenado 359  ==  True
--    esOrdenado 395  ==  False
esOrdenado :: Integer -> Bool
esOrdenado = esOrdenada . show

-- (esOrdenada xs) se verifica si la lista xs está ordenada. Por
-- ejemplo, 
--    esOrdenada [3,5,9]  ==  True
--    esOrdenada [3,9,5]  ==  False
--    esOrdenada "359"  ==  True
--    esOrdenada "395"  ==  False
esOrdenada :: Ord a => [a] -> Bool
esOrdenada (x:y:xs) = x <= y && esOrdenada (y:xs)
esOrdenada _        = True

-- ---------------------------------------------------------------------
-- Ejercicio 1.2. Calcular en qué posición de la lista aparece el número
-- 13333. 
-- ---------------------------------------------------------------------

-- El cálculo es
--    ghci> length (takeWhile (<=13333) ordenados)
--    1000

-- ---------------------------------------------------------------------
-- Ejercicio 2.1. Una lista se dirá comprimida si sus elementos
-- consecutivos han sido agrupados. Por ejemplo, la comprimida de
-- "aaabcccc" es [(3,'a'),(1,'b'),(4,'c')].
-- 
-- Definir la función    
--    comprimida :: Eq a => [a] -> [(a,Int)] 
-- tal que (comprimida xs) es la comprimida de la lista xs. Por ejemplo,
--    comprimida "aaabcccc"  ==  [(3,'a'),(1,'b'),(4,'c')]
-- ---------------------------------------------------------------------

-- 2ª definición (por recursión usando takeWhile):
comprimida :: Eq a => [a] -> [(Int,a)]
comprimida [] = []
comprimida (x:xs) = 
    (1 + length (takeWhile (==x) xs),x) : comprimida (dropWhile (==x) xs)

-- 2ª definición (por recursión sin takeWhile)
comprimida2 :: Eq a => [a] -> [(Int,a)]
comprimida2 xs = aux xs 1
    where aux (x:y:zs) n | x == y    = aux (y:zs) (n+1)
                         | otherwise = (n,x) : aux (y:zs) 1
          aux [x]      n             = [(n,x)]

-- ---------------------------------------------------------------------
-- Ejercicio 2.2. Definir la función
--    expandida :: [(Int,a)] -> [a]
-- tal que (expandida ps) es la lista expandida correspondiente a ps (es
-- decir, es la lista xs tal que la comprimida de xs es ps). Por
-- ejemplo, 
--    expandida [(2,1),(3,7),(2,5),(4,7)]  ==  [1,1,7,7,7,5,5,7,7,7,7]
-- ---------------------------------------------------------------------

-- 1ª definición (por comprensión)
expandida :: [(Int,a)] -> [a]
expandida ps = concat [replicate k x | (k,x) <- ps]

-- 2ª definición (por recursión)
expandida2 :: [(Int,a)] -> [a]
expandida2 [] = []
expandida2 ((n,x):ps) = replicate n x ++ expandida2 ps

-- ---------------------------------------------------------------------
-- Ejercicio 3.1. Los árboles binarios pueden representarse mediante el
-- tipo de dato 
--    data Arbol a = Hoja a | Nodo a (Arbol a) (Arbol a)
-- Un ejemplo de árbol es
--    ejArbol = Nodo 7 (Nodo 2 (Hoja 5) (Hoja 4)) (Hoja 9) 
-- 
-- Un elemento de un árbol se dirá de nivel k si aparece en el árbol a
-- distancia k  de la raíz. 
-- 
-- Definir la función
--    nivel :: Int -> Arbol a -> [a]
-- tal que (nivel k a) es la lista de los elementos de nivel k del árbol
-- a. Por ejemplo,
--    nivel 0 ejArbol  ==  [7]
--    nivel 1 ejArbol  ==  [2,9]
--    nivel 2 ejArbol  ==  [5,4]
--    nivel 3 ejArbol  ==  []
-- ---------------------------------------------------------------------

data Arbol a = Hoja a | Nodo a (Arbol a) (Arbol a)

ejArbol = Nodo 7 (Nodo 2 (Hoja 5) (Hoja 4)) (Hoja 9) 

nivel :: Int -> Arbol a -> [a]
nivel 0 (Hoja x)     = [x]
nivel 0 (Nodo x _ _) = [x]
nivel k (Hoja _ )    = []
nivel k (Nodo _ i d) = nivel (k-1) i ++ nivel (k-1) d

-- ---------------------------------------------------------------------
-- Ejercicio 3.2. Definir la función
--    todosDistintos :: Eq a => Arbol a -> Bool
-- tal que (todosDistintos a) se verifica si todos los elementos del
-- árbol a son distintos entre sí. Por ejemplo, 
--    todosDistintos ejArbol                                       == True
--    todosDistintos (Nodo 7 (Hoja 3) (Nodo 4 (Hoja 7) (Hoja 2)))  ==  False
-- ---------------------------------------------------------------------

todosDistintos :: Eq a => Arbol a -> Bool
todosDistintos a = xs == nub xs
    where xs = preorden a

preorden :: Arbol a -> [a]
preorden (Hoja x)     = [x]
preorden (Nodo x i d) = x : (preorden i ++ preorden d)

-- ---------------------------------------------------------------------
-- Ejercicio 4.1. En un colisionador de partículas se disponen m placas,
-- con n celdillas cada una. Cada celdilla detecta si alguna partícula 
-- ha pasado por ella (1 si ha detectado una partícula, 0 en caso
-- contrario). El siguiente ejemplo muestra 5 placas con 9 celdillas
-- cada una: 
--    experimento:: [[Int]]
--    experimento = [[0, 0, 1, 1, 0, 1, 0, 0, 1],
--                   [0, 1, 0, 1, 0, 1, 0, 1, 0],
--                   [1, 0, 1, 0, 0, 0, 1, 0, 0],
--                   [0, 1, 0, 0, 0, 1, 0, 1, 0],
--                   [1, 0, 0, 0, 1, 0, 0, 0, 1]]
-- Se quiere reconstruir las trayectorias que han realizado las
-- partículas que  atraviesan dichas placas.
-- 
-- Una trayectoria de una partícula vendrá dada por un par, donde la
-- primera componente indica la celdilla por la que pasó en la primera
-- placa y la segunda componente será una lista que indica el camino
-- seguido en las sucesivas placas. Es decir, cada elemento de la lista
-- indicará si de una placa a la siguiente, la partícula se desvió una
-- celdilla hacia la derecha (+1), hacia la izquierda (-1) o pasó por la
-- misma celdilla (0). Por ejemplo, una trayectoria en el ejemplo
-- anterior sería: 
--        [(2,[-1,1,-1,-1])]
-- Se puede observar que es posible crear más de una trayectoria para la 
-- misma  partícula. 
-- 
-- Definir la función
--    calculaTrayectorias :: [[Int]] -> [(Int,[Int])] 
-- que devuelva una lista con todas las trayectorias posibles para un
-- experimento. Por ejemplo,
--    ghci> calculaTrayectorias experimento  
--    [(2,[-1,-1,1,-1]),  (2,[-1,1,-1,-1]), (2,[1,-1,-1,-1]), 
--     (3,[0,-1,-1,-1]), 
--     (5,[0,1,-1,-1]),   (5,[0,1,1,1]),
--     (8,[-1,-1,-1,-1]), (8,[-1,-1,1,1])]
-- ---------------------------------------------------------------------

experimento:: [[Int]]
experimento = [[0, 0, 1, 1, 0, 1, 0, 0, 1],
               [0, 1, 0, 1, 0, 1, 0, 1, 0],
               [1, 0, 1, 0, 0, 0, 1, 0, 0],
               [0, 1, 0, 0, 0, 1, 0, 1, 0],
               [1, 0, 0, 0, 1, 0, 0, 0, 1]]

calculaTrayectorias :: [[Int]] -> [(Int,[Int])]
calculaTrayectorias [] = []
calculaTrayectorias (xs:xss) = 
    [(i,ys) | (i,e) <- zip [0..] xs, e==1, ys <- posiblesTrayectorias i xss]

-- 1ª definición (por recursión)
posiblesTrayectorias :: Int -> [[Int]] -> [[Int]]
posiblesTrayectorias i [] = [[]]
posiblesTrayectorias i (xs:xss) = 
    [desp:ys | desp <- [-1,0,1], 
               i+desp >= 0 && i+desp < length xs, 
               xs!!(i+desp) == 1,
               ys <- posiblesTrayectorias (i+desp) xss]

-- 2ª definición (por recursión con acumulador)
posiblesTrayectorias' i xss = posiblesTrayectoriasRecAcum i [[]] xss

posiblesTrayectoriasRecAcum i yss [] = yss
posiblesTrayectoriasRecAcum i yss (xs:xss) = 
  concat[posiblesTrayectoriasRecAcum idx [ys++[idx-i] | ys <- yss] xss
        | idx <- [i-1..i+1], idx >= 0 && idx < length xs, xs!!idx == 1]

-- ---------------------------------------------------------------------
-- Ejercicio 4.2. Consideraremos una trayectoria válida si no cambia de
-- dirección. Esto es, si una partícula tiene una trayectoria hacia la
-- izquierda, no podrá desviarse a la derecha posteriormenete y vice versa. 
-- 
-- Definir la función
--    trayectoriasValidas :: [(Int,[Int])] -> [(Int,[Int])]
-- tal que (trayectoriasValidas xs) es la lista de las trayectorias de
-- xs que son válidas. Por ejemplo,
--    ghci> trayectoriasValidas (calculaTrayectorias experimento) 
--    [(3,[0,-1,-1,-1]),(5,[0,1,1,1]),(8,[-1,-1,-1,-1])]
-- ---------------------------------------------------------------------

trayectoriasValidas :: [(Int,[Int])] -> [(Int,[Int])]
trayectoriasValidas xss = [(i,xs) | (i,xs) <- xss, trayectoriaValida xs]

trayectoriaValida :: [Int] -> Bool
trayectoriaValida xs = not (1 `elem` xs && (-1) `elem` xs)

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

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

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

-- § Librerías auxiliares --

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

import Data.List

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

-- Ejercicio 1.1. Un número se dirá ordenado si sus cifras están en orden

-- creciente. Por ejemplo, 11257 es ordenado pero 2423 no lo es.

-- Definir la lista

-- ordenados :: [Integer]

-- formada por todos los enteros ordenados. Por ejemplo,

-- ghci> take 20 (dropWhile (<30) ordenados)

-- [33,34,35,36,37,38,39,44,45,46,47,48,49,55,56,57,58,59,66,67]

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

ordenados :: [Integer]

ordenados = [n | n <- [1..], esOrdenado n]

-- (esOrdenado x) se verifica si el número x es ordenado. Por ejemplo,

-- esOrdenado 359 == True

-- esOrdenado 395 == False

esOrdenado :: Integer -> Bool

esOrdenado = esOrdenada . show

-- (esOrdenada xs) se verifica si la lista xs está ordenada. Por

-- ejemplo,

-- esOrdenada [3,5,9] == True

-- esOrdenada [3,9,5] == False

-- esOrdenada "359" == True

-- esOrdenada "395" == False

esOrdenada :: Ord a => [a] -> Bool

esOrdenada (x:y:xs) = x <= y && esOrdenada (y:xs)

esOrdenada _ = True

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

-- Ejercicio 1.2. Calcular en qué posición de la lista aparece el número

-- 13333.

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

-- El cálculo es

-- ghci> length (takeWhile (<=13333) ordenados)

-- 1000

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

-- Ejercicio 2.1. Una lista se dirá comprimida si sus elementos

-- consecutivos han sido agrupados. Por ejemplo, la comprimida de

-- "aaabcccc" es [(3,'a'),(1,'b'),(4,'c')].

-- Definir la función

-- comprimida :: Eq a => [a] -> [(a,Int)]

-- tal que (comprimida xs) es la comprimida de la lista xs. Por ejemplo,

-- comprimida "aaabcccc" == [(3,'a'),(1,'b'),(4,'c')]

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

-- 2ª definición (por recursión usando takeWhile):

comprimida :: Eq a => [a] -> [(Int,a)]

comprimida [] = []

comprimida (x:xs) =

(1 + length (takeWhile (==x) xs),x) : comprimida (dropWhile (==x) xs)

-- 2ª definición (por recursión sin takeWhile)

comprimida2 :: Eq a => [a] -> [(Int,a)]

comprimida2 xs = aux xs 1

where aux (x:y:zs) n | x == y = aux (y:zs) (n+1)

| otherwise = (n,x) : aux (y:zs) 1

aux [x] n = [(n,x)]

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

-- Ejercicio 2.2. Definir la función

-- expandida :: [(Int,a)] -> [a]

-- tal que (expandida ps) es la lista expandida correspondiente a ps (es

-- decir, es la lista xs tal que la comprimida de xs es ps). Por

-- ejemplo,

-- expandida [(2,1),(3,7),(2,5),(4,7)] == [1,1,7,7,7,5,5,7,7,7,7]

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

-- 1ª definición (por comprensión)

expandida :: [(Int,a)] -> [a]

expandida ps = concat [replicate k x | (k,x) <- ps]

-- 2ª definición (por recursión)

expandida2 :: [(Int,a)] -> [a]

expandida2 [] = []

expandida2 ((n,x):ps) = replicate n x ++ expandida2 ps

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

-- Ejercicio 3.1. Los árboles binarios pueden representarse mediante el

-- tipo de dato

-- data Arbol a = Hoja a | Nodo a (Arbol a) (Arbol a)

-- Un ejemplo de árbol es

-- ejArbol = Nodo 7 (Nodo 2 (Hoja 5) (Hoja 4)) (Hoja 9)

-- Un elemento de un árbol se dirá de nivel k si aparece en el árbol a

-- distancia k de la raíz.

-- Definir la función

-- nivel :: Int -> Arbol a -> [a]

-- tal que (nivel k a) es la lista de los elementos de nivel k del árbol

-- a. Por ejemplo,

-- nivel 0 ejArbol == [7]

-- nivel 1 ejArbol == [2,9]

-- nivel 2 ejArbol == [5,4]

-- nivel 3 ejArbol == []

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

data Arbol a = Hoja a | Nodo a (Arbol a) (Arbol a)

ejArbol = Nodo 7 (Nodo 2 (Hoja 5) (Hoja 4)) (Hoja 9)

nivel :: Int -> Arbol a -> [a]

nivel 0 (Hoja x) = [x]

nivel 0 (Nodo x _ _) = [x]

nivel k (Hoja _ ) = []

nivel k (Nodo _ i d) = nivel (k-1) i ++ nivel (k-1) d

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

-- Ejercicio 3.2. Definir la función

-- todosDistintos :: Eq a => Arbol a -> Bool

-- tal que (todosDistintos a) se verifica si todos los elementos del

-- árbol a son distintos entre sí. Por ejemplo,

-- todosDistintos ejArbol == True

-- todosDistintos (Nodo 7 (Hoja 3) (Nodo 4 (Hoja 7) (Hoja 2))) == False

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

todosDistintos :: Eq a => Arbol a -> Bool

todosDistintos a = xs == nub xs

where xs = preorden a

preorden :: Arbol a -> [a]

preorden (Hoja x) = [x]

preorden (Nodo x i d) = x : (preorden i ++ preorden d)

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

-- Ejercicio 4.1. En un colisionador de partículas se disponen m placas,

-- con n celdillas cada una. Cada celdilla detecta si alguna partícula

-- ha pasado por ella (1 si ha detectado una partícula, 0 en caso

-- contrario). El siguiente ejemplo muestra 5 placas con 9 celdillas

-- cada una:

-- experimento:: [[Int]]

-- experimento = [[0, 0, 1, 1, 0, 1, 0, 0, 1],

-- [0, 1, 0, 1, 0, 1, 0, 1, 0],

-- [1, 0, 1, 0, 0, 0, 1, 0, 0],

-- [0, 1, 0, 0, 0, 1, 0, 1, 0],

-- [1, 0, 0, 0, 1, 0, 0, 0, 1]]

-- Se quiere reconstruir las trayectorias que han realizado las

-- partículas que atraviesan dichas placas.

-- Una trayectoria de una partícula vendrá dada por un par, donde la

-- primera componente indica la celdilla por la que pasó en la primera

-- placa y la segunda componente será una lista que indica el camino

-- seguido en las sucesivas placas. Es decir, cada elemento de la lista

-- indicará si de una placa a la siguiente, la partícula se desvió una

-- celdilla hacia la derecha (+1), hacia la izquierda (-1) o pasó por la

-- misma celdilla (0). Por ejemplo, una trayectoria en el ejemplo

-- anterior sería:

-- [(2,[-1,1,-1,-1])]

-- Se puede observar que es posible crear más de una trayectoria para la

-- misma partícula.

-- Definir la función

-- calculaTrayectorias :: [[Int]] -> [(Int,[Int])]

-- que devuelva una lista con todas las trayectorias posibles para un

-- experimento. Por ejemplo,

-- ghci> calculaTrayectorias experimento

-- [(2,[-1,-1,1,-1]), (2,[-1,1,-1,-1]), (2,[1,-1,-1,-1]),

-- (3,[0,-1,-1,-1]),

-- (5,[0,1,-1,-1]), (5,[0,1,1,1]),

-- (8,[-1,-1,-1,-1]), (8,[-1,-1,1,1])]

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

experimento:: [[Int]]

experimento = [[0, 0, 1, 1, 0, 1, 0, 0, 1],

[0, 1, 0, 1, 0, 1, 0, 1, 0],

[1, 0, 1, 0, 0, 0, 1, 0, 0],

[0, 1, 0, 0, 0, 1, 0, 1, 0],

[1, 0, 0, 0, 1, 0, 0, 0, 1]]

calculaTrayectorias :: [[Int]] -> [(Int,[Int])]

calculaTrayectorias [] = []

calculaTrayectorias (xs:xss) =

[(i,ys) | (i,e) <- zip [0..] xs, e==1, ys <- posiblesTrayectorias i xss]

-- 1ª definición (por recursión)

posiblesTrayectorias :: Int -> [[Int]] -> [[Int]]

posiblesTrayectorias i [] = [[]]

posiblesTrayectorias i (xs:xss) =

[desp:ys | desp <- [-1,0,1],

i+desp >= 0 && i+desp < length xs,

xs!!(i+desp) == 1,

ys <- posiblesTrayectorias (i+desp) xss]

-- 2ª definición (por recursión con acumulador)

posiblesTrayectorias' i xss = posiblesTrayectoriasRecAcum i [[]] xss

posiblesTrayectoriasRecAcum i yss [] = yss

posiblesTrayectoriasRecAcum i yss (xs:xss) =

concat[posiblesTrayectoriasRecAcum idx [ys++[idx-i] | ys <- yss] xss

| idx <- [i-1..i+1], idx >= 0 && idx < length xs, xs!!idx == 1]

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

-- Ejercicio 4.2. Consideraremos una trayectoria válida si no cambia de

-- dirección. Esto es, si una partícula tiene una trayectoria hacia la

-- izquierda, no podrá desviarse a la derecha posteriormenete y vice versa.

-- Definir la función

-- trayectoriasValidas :: [(Int,[Int])] -> [(Int,[Int])]

-- tal que (trayectoriasValidas xs) es la lista de las trayectorias de

-- xs que son válidas. Por ejemplo,

-- ghci> trayectoriasValidas (calculaTrayectorias experimento)

-- [(3,[0,-1,-1,-1]),(5,[0,1,1,1]),(8,[-1,-1,-1,-1])]

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

trayectoriasValidas :: [(Int,[Int])] -> [(Int,[Int])]

trayectoriasValidas xss = [(i,xs) | (i,xs) <- xss, trayectoriaValida xs]

trayectoriaValida :: [Int] -> Bool

trayectoriaValida xs = not (1 `elem` xs && (-1) `elem` xs)

Se puede imprimir o compartir con