-- -------------------------------------------------
-- SOLUCIONES PR. FUNCIONAL CONTROL 2 (15.05.07)
-- -------------------------------------------------

module Control_2 where

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

-- 1. Dado el programa Haskell:

miMap f g l = (map f l, map g l)

comp f g = \x -> f (g x)  -- predefinida como '.' ( f `comp` g = f . g )

listComp f = f : [f . g | g <- listComp f]

-- (a) Indicar los tipos de miMap, comp y listComp. Cuando se pueda deben ser 
--     polimórficos, pero no más generales de lo necesario.

miMap :: (a -> b) -> (a -> c) -> [a] -> ([b], [c])

comp :: (b -> c) -> (a -> b) -> (a -> c)

listComp :: (a -> a) -> [a -> a] 

-- (b) Corregir los posibles errores y dar el valor de la siguiente expresión,  
--     indicando los pasos de reescritura de miMap y de comp:  
--
--		miMap comp (1+) (2*) (>2) [1,4..9]

--  miMap (comp (1+) (2*)) (>2) [1,4..9]   
--  ---> (map (comp (1+) (2*)) [1,4..9], map (>2) [1,4..9])
--  ---> ([comp (1+) (2*) 1,comp (1+) (2*) 4,  comp (1+) (2*) 7], [1>2, 4>2, 7>2])
--  ---> ([(1+)(2*1),(1+)(2*4),  (1+)(2*7)], [1>2, 4>2, 7>2])
--  ---> ([3, 9, 15], [False, True, True])

-- (c) Usando listComp, hacer un programa que aplica una función f reiteradamente 
--     sobre x, sobre f x, sobre f (f x), …,etc., una cantidad de veces n 
--     (para f, x y n dados). Por ejemplo, al aplicar 4 veces (2*) sobre 1 se 
--     obtiene 2*(2*(2*(2*1))) = 16.


aplica :: (a -> a) -> a -> Int -> a
aplica f x n = ((listComp f) !! (n-1)) x

-- -----------------------------------------------------------------------------------
  
-- 2. Implementar en Haskell una función que obtiene la serie infinita de números 
--    de Fibonacci 1, 1, 2, 3, 5, 8, 13, 21, …, fn-1, fn, fn+1,…. Usando esta función, 
--    implementar otra que obtiene una aproximación del número áureo* F, sabiendo 
--    que el cociente fn+1/fn se aproxima a F cuando n tiende a infinito. El valor 
--    obtenido fn+1/fn debe diferenciarse del anterior fn/fn-1 en menos de un valor 
--    decimal dado d (Double).
--
--    (*) Número irracional definido como F = (1 + v5)/2  = 1.618033..., importante, 
--    entre otras cosas, por su frecuente aparición en formas geométricas naturales.
 
lfib :: [Double]                   
lfib = lf 1 1

lf :: Double -> Double -> [Double]
lf n m = n : lf m (n+m)         
    
aureo :: Double -> Double   
aureo d = aux d lfib

aux :: Double -> [Double] -> Double
aux d (x:y:z:t) = let u = y/x
                      v = z/y
                  in
                     if abs (u-v) <= d
                     then v
                     else aux d (y:z:t)

-- lista de todas las aproximaciones (no se pide):
aprox = ap lfib
ap (x:y:t) = (y/x) : ap (y:t)


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


-- 3. Implementar en Haskel el algoritmo de ordenación de listas mergesort*, pero de 
--    orden superior. Es decir, deberá servir para listas de cualquier tipo, en donde 
--    la forma de comparar elementos se indica en un parámetro.
--
--    (*) Breve descripción del algoritmo para ordenar, por ejemplo, una lista de 
--    enteros de menor a mayor:
--    a. Se parte la lista en dos mitades iguales (±1 para longitud impar)
--        Ejemplo: [3,1,6,3,5,1,4] --> [3,6,5,4] y [1,3,1]  (o de cualquier otra forma, 
--        como [3,1,6] y [3,5,1,4], …, etc.)
--    b. Se ordena (recursivamente) cada mitad
--        Ejemplo: [3,6,5,4], [1,3,1] --> [3,4,5,6], [1,1,3]
--    c. Se mezclan las dos mitades ordenadas:
--        Ejemplo: [3,4,5,6], [1,1,3] ' [1,1,3,4,5,6]

mergesort :: (a -> a -> Bool) -> [a] -> [a]
mergesort _ []  = []
mergesort _ [x] = [x]
mergesort m l   = let 
                    (s,t) = partir l
                  in 
                    mezclar m (mergesort m s) (mergesort m t)
                  
partir :: [a] -> ([a],[a])
partir []      = ([],[])
partir [x]     = ([x],[])
partir (x:y:t) = let 
                   (s,r) = partir t
                 in  
                   (x:s, y:r)
 
mezclar :: (a -> a -> Bool) -> [a] -> [a] -> [a]                                 
mezclar _ [] l = l
mezclar _ l [] = l 
mezclar m (x:s) (y:t) = if x `m` y
                        then x : mezclar m s (y:t)
                        else y : mezclar m (x:s) t