-- ==================================================================
-- Informática (1º del Grado en Matemáticas), Grupo 2
-- 2º examen de evaluación continua (16 de febrero de 2021)
-- ------------------------------------------------------------------
-- Nombre:
--
-- Apellidos:
--
-- Usuario Virtual de la Universidad(UVUS):
-- ==================================================================
-- Nota 1: Es necesario que se pueda cargar el fichero. Es decir, que
-- no contenga errores sintácticos. Para ello, si alguna función no
-- está terminada de programar o bien tiene algún error sintáctico,
-- debe estar comentada.
-- Nota 2: Hay que documentar las funciones auxilares, es decir:
-- 1. Elegir un nombre para sugerir lo que hace
-- 2. Escribir, en lenguaje natural, qué hace la función y no cómo lo
-- hace.
--
-- Nota 3: En cada ejercicio se valorará la corrección, claridad y
-- eficiencia de la solución propuesta. Todos los ejercicios valen igual.
import Data.List
import Data.Char
-- ----------------------------------------------------------------------
-- Ejercicio 1
-- ----------------------------------------------------------------------
-- Un árbol de Huffman tiene la siguiente forma: los nodos no contienen
-- valores y las hojas almacenan caracteres. Para cada nodo, la rama
-- izquierda tiene asociado el 0, y la rama derecha el 1. Además, para
-- todo nodo, el subárbol izquierdo es siempre una hoja. Por ejemplo,
-- o
-- / \
-- 0 / \ 1
-- / \
-- A o
-- / \
-- 0 / \ 1
-- / \
-- R o
-- / \
-- 0 / \ 1
-- / \
-- B K
--
-- El tipo de dato que usaremos para representar un árbol de Huffman
-- es el siguiente:
data ArbolH = H Char | N (ArbolH) (ArbolH)
deriving Show
-- Por tanto, el ejemplo anterior se representa como:
ahEj :: ArbolH
ahEj = N (H 'a') (N (H 'r') (N (H 'b') (H 'k')))
-- Podemos usar un árbol de Huffman para codificar en binario los
-- caracteres que hay en él. La codificación de cada caracter es
-- simplemente el camino desde la raíz a la hoja de ese caracter.
-- Por ejemplo:
-- A 0
-- R 10
-- B 110
-- K 111
--
-- Define la función
-- codificaHuffman :: String -> ArbolH -> [Int]
-- tal que (codificaHuffman cs a) reciba una cadena de caracteres cs, un
-- árbol de Huffman a y devuelva una lista de enteros que represente la
-- secuencia de bits de la codificación final (0s y 1s). Para ello, hay que:
-- 1. limpiar la cadena cs para que solo contenga los caracteres que
-- existan en las hojas del árbol a, sin distinguir entre mayúsculas
-- y minúsculas
-- 2. codificar cada caracter resultante de lo anterior con su codificación
-- según el árbol.
--
-- Por ejemplo,
-- > codificaHuffman "ABRRKBAARAA" ahEj
-- [0,1,1,0,1,0,1,0,1,1,1,1,1,0,0,0,1,0,0,0]
-- > codificaHuffman "arbk" ahEj
-- [0,1,0,1,1,0,1,1,1]
-- > codificaHuffman "bcccc!" ahEj
-- [1,1,0]
-- > codificaHuffman "i1m" ahEj
-- []
codificaHuffman :: String -> ArbolH -> [Int]
codificaHuffman cs a = concatMap (huffaux a) cs'
where cs' = filter (enArbol a) (map toLower cs)
huffaux :: ArbolH -> Char -> [Int]
huffaux (N (H e) a) c
| e == c = [0]
| otherwise = 1:huffaux a c
huffaux _ _ = []
enArbol :: ArbolH -> Char -> Bool
enArbol (H c') c = toLower c == toLower c'
enArbol (N a1 a2) c = enArbol a1 c || enArbol a2 c
-- ----------------------------------------------------------------------
-- ----------------------------------------------------------------------
-- Ejercicio 2
-- ----------------------------------------------------------------------
-- Ejercicio 2.1. Define la función
-- frecuencias :: String -> [(Char,Int)]
-- tal que (frecuencias cs) reciba una cadena de caracteres cs y devuelva
-- una lista de pares (c,f), donde c es cada caracter en cs y f es el
-- número de veces que aparece c en cs (frecuencia). La lista devuelta
-- debe estar ordenada de mayor a menor según la frecuencia. No se deben
-- distinguir entre mayúsculas y minúsculas (es decir, 'a' y 'A' cuentan
-- igual). Por ejemplo,
-- > frecuencias "Mandalorian"
-- [('a',3),('n',2),('r',1),('o',1),('m',1),('l',1),('i',1),('d',1)]
-- > frecuencias "aaakdkaa"
-- [('a',5),('k',2),('d',1)]
-- > frecuencias "aaaAAaaAAAAa"
-- [('a',12)]
-- NOTA: recuerda, la función sort funciona también para pares.
frecuencias :: String -> [(Char,Int)]
frecuencias cs = reverse $
map swap $
sort [(length (filter (==c) cs'),c) | c <- nub cs']
where cs' = map toLower cs
swap (x,y) = (y,x)
-- Ejercicio 2.2. Define la función
-- arbolHuffman :: String -> ArbolH
-- tal que (arbolHuffman cs) reciba un String y devuelva un árbol de Huffman.
-- Los caracteres se ponen en el subárbol izquierdo de cada nodo como hojas,
-- y en orden de mayor a menor frecuencia. En concreto, el caracter con más
-- frecuencia se pone como subárbol izquierdo de la raíz, y el caracter con
-- menor frecuencia terminará en el subárbol derecho del nodo más profundo.
-- No se deben distinguir entre mayúsculas y minúsculas. Por simplicidad,
-- asume que al menos hay dos caracteres distintos.
-- > arbolHuffman "ABRRKBAARAA"
-- N (H 'a') (N (H 'r') (N (H 'b') (H 'k')))
-- > arbolHuffman "abBcCc"
-- N (H 'c') (N (H 'b') (H 'a'))
-- > arbolHuffman "Grogu"
-- N (H 'g') (N (H 'u') (N (H 'r') (H 'o')))
arbolHuffman :: String -> ArbolH
arbolHuffman cs = arbHuffAux fs
where fs = map fst $ frecuencias cs
arbHuffAux :: String -> ArbolH
arbHuffAux [] = error "no posible" -- este caso se descarta por el enunciado
arbHuffAux [c1,c2] = N (H c1) (H c2)
arbHuffAux (c:cs) = N (H c) (arbHuffAux cs)
-- ----------------------------------------------------------------------
-- ----------------------------------------------------------------------
-- Ejercicio 3
-- ----------------------------------------------------------------------
-- La raíz cuadrada de 2 es uno de los primeros números irracionales
-- en ser descubiertos. Su valor es aproximadamente 1.4142135624.
-- En concreto, sus primeros treinta dígitos (parte entera y decimal) son:
-- 1,4,1,4,2,1,3,5,6,2,3,7,3,0,9,5,0,4,8,8,0,1,6,8,8,7,2,4,2,0
-- La lista infinita de los dígitos de la raíz de dos se puede calcular
-- con un proceso que depende de tan solo dos parámetros, 'x' y 'r':
-- * Inicialmente, x=2 y r=0.
-- * Dados x y r, se genera el dígito d, siendo d el mayor número
-- natural de 0 a 9 tal que cumpla la condición: d(20r+d) < x
-- * Para generar el siguiene dígito, se actualizan los parámetros:
-- * x pasa a valer 100(x-d(20r+d))
-- * r pasa a valer (10r+d)
-- Por ejemplo,
-- * Para x=2 y r=0:
-- * d=1, ya que es el mayor natural tal que d(20*1+d) < 2
-- * El siguiente valor de x es 100(2-1(20*0+1))=100 y de r es
-- 10*0+1=1.
-- * Para x=100 y r=1:
-- * d=4, ya que 4(20*1+4) = 96 < 100
-- * El siguiente valor de x es 400 y de r es 14
-- * Para x=400 y r=14, d=1
-- * Para x=11900 y r=141, d=4
-- * Para x=60400 y r=1414, d=2
-- * ....
--
-- Ejercicio 3.1. Define la función
-- raizDeDos :: [Int]
-- tal que devuelva la lista de dígitos de la raíz cuadrada de 2.
-- Por ejemplo,
-- > take 31 raizDeDos
-- [1,4,1,4,2,1,3,5,6,2,3,7,3,0,9,5,0,4,8,8,0,1,6,8,8,7,2,4,2,0,9]
--
-- NOTA: Cuidado, los valores de d y r pueden ser muy altos, por lo
-- que necesitarás hacer uso de Integer. Recuerda que puedes usar
-- (fromIntegral n) para traducir un Integer a un Int.
-- 1ª Solución
raizDeDos :: [Int]
raizDeDos = proceso 2 0
proceso :: Integer -> Integer -> [Int]
proceso x r = (fromIntegral dig) : proceso sigx sigr
where dig = head (dropWhile cond [0..]) - 1
cond d = (20 * r + d) * d < x
sigx = 100 * (x - (20 * r + dig) * dig)
sigr = 10 * r + dig
-- 2ª Solución
raizDeDos' :: [Int]
raizDeDos' = tail $ map fst (iterate proc (0,(2,0)))
where proc :: (Int,(Integer,Integer)) -> (Int,(Integer,Integer))
proc (d,(x,r)) = (fromIntegral dig,(sigx,sigr))
where dig = last (takeWhile cond [0..])
cond d = (20 * r + d) * d < x
sigx = 100 * (x - (20 * r + dig) * dig)
sigr = 10 * r + dig
-- Ejercicio 3.2. Define la función
-- expande :: [Int] -> [Int]
-- tal que (expande xs) recibe una secuencia de enteros xs y la
-- expande de la siguiente manera: para cada par de enteros consecutivos
-- x e y de xs, se insertan los números enteros para ir de x a y. Por
-- ejemplo, si x=1 e y=4, entonces se inserta 2,3 entre x e y. Si
-- x=8 e y=4, entonces se inserta 7,6,5. Por ejemplo,
-- > expande [1,10,1]
-- [1,2,3,4,5,6,7,8,9,10,9,8,7,6,5,4,3,2,1]
-- > take 20 $ expande raizDeDos
-- [1,2,3,4,3,2,1,2,3,4,3,2,1,2,3,4,5,6,5,4]
-- 1ª Solución
expande :: [Int] -> [Int]
expande [] = []
expande [x] = [x]
expande (x:y:xs) = genera x y ++ expande (y:xs)
genera :: Int -> Int -> [Int]
genera x y | x==y = [x]
| x < y = init [x..y]
| otherwise = init [x,x-1..y]
-- 2ª Solución
expande' :: [Int] -> [Int]
expande' xs = concat $ zipWith genera xs (tail xs)
-- ----------------------------------------------------------------------
-- ----------------------------------------------------------------------
-- Ejercicio 4
-- ----------------------------------------------------------------------
-- Define la función
-- digitosHasta :: Int -> Int
-- tal que (digitosHasta n) devuelva el mínimo número de dígitos de la raíz
-- cuadrada de dos necesarios para que aparezcan todos los dígitos del 0
-- al 9 al menos n veces cada uno. Por ejemplo, para que cada dígito (0 al
-- 9) aparezca al menos 2 veces se necesitan un mínimo de 31 dígitos de raíz
-- de dos. Por ejemplo,
-- > digitosHasta 1
-- 19
-- > digitosHasta 2
-- 31
-- > digitosHasta 3
-- 38
-- > digitosHasta 4
-- 47
-- > digitosHasta 100
-- 1188
-- > digitosHasta 500
-- 5328
-- NOTA: si no has definido el ejercicio 3, usa la siguiente definición y
-- prueba con hasta n = 4
--raizDeDos :: [Int]
--raizDeDos = [1,4,1,4,2,1,3,5,6,2,3,7,3,0,9,5,0,4,8,8,0,1,6,8,8,7,2,4,2,0,9,6,9,8,0,7,8,5,6,9,6,7,1,8,7,5,3,7,6,9]
-- 1ª Solución (con recursión)
digitosHasta :: Int -> Int
digitosHasta n = recorre (replicate 10 0) 0 raizDeDos
where aumenta i xs = take i xs ++ [(xs!!i)+1] ++ drop (i+1) xs
recorre _ _ [] = error "imposible"
recorre ns k (x:xs)
| all (>=n) ns = k
| otherwise = recorre (aumenta x ns) (k+1) xs
-- 2ª Solución (con orden superior)
digitosHasta' :: Int -> Int
digitosHasta' n = (length.head) $ dropWhile p (inits raizDeDos)
where p = not . (\xss -> length xss == 10 && all (>=n) (map length xss)) . group . sort
-- > digitosHasta 500
-- 5328
-- (0.09 secs, 169,311,552 bytes)
-- > digitosHasta' 500
-- 5328
-- (5.22 secs, 13,704,382,352 bytes)
-- La primera solución es más eficiente en tiempo y memoria
-- ----------------------------------------------------------------------
![Informática de 1º de Matemáticas [Curso 2021-22, Grupo 2]](/WIKIS/I1M2021G2/resources/assets/logoUS.png)