ALP Práctica 5

-- EJERCICIO 1
data Pair a = P (a,a)

instance Functor Pair where
    fmap f (P (x,y)) = P (f x, f y)
{-
1- fmap id (P (x, y)) = P (id x, id y) = P (x, y)
2- fmap f (fmap g (P (x,y))) = fmap f (P (g x, gy)) = P (f (g x), f (g y)) = fmap (f o g) (P (x, y))
-}

data Tree a = Empty | Branch a (Tree a) (Tree a)

instance Functor Tree where
    fmap f Empty = Empty
    fmap f (Branch x l r) = Branch (f x) (fmap f l) (fmap f r)
{-
1- fmap id Empty = Empty
   fmap id (Branch x l r) = Branch (id x) (fmap id l) (fmap id r) = Branch x l r
2- fmap f (fmap g Empty) = fmap f Empty = Empty = fmap (f o g) Empty
   fmap f (fmap g (Branch x l r)) = fmap f (Branch (g x) (fmap g l) (fmap g r)) =
 = Branch (f (g x)) (fmap f (fmap g l)) (fmap f (fmap g r)) =
 = Branch ((f o g) x) (fmap (f o g) l) (fmap (f o g) r) = fmap (f o g) (Branch x l r)
-}

data GenTree a = Gen a [GenTree a]

instance Functor GenTree where
    fmap f (Gen x xs) = Gen (f x) (map (fmap f) xs)
{-
1- fmap id (Gen x xs) = Gen (id x) (map (fmap id) xs) = Gen x xs
2- fmap f (fmap g (Gen x xs)) = fmap f (Gen (g x) (map (fmap g) xs)) =
 = Gen (f (g x)) (map (fmap f) (map (fmap g) xs)) =
 = Gen ((f o g) x) (map (fmap f)) o (map (fmap g)) xs) =
 = Gen ((f o g) x) (map ((fmap f) o (fmap g)) xs) =
 = Gen ((f o g) x) (map (fmap (f o g)) xs) =
 = fmap (f o g) (Gen x xs)
-}

data Cont a = C ((a -> Int) -> Int)

instance Functor Cont where
    fmap f (C g) = C (\f1 -> g (\a -> f1 (f a)))

{-
1- fmap id (C g) = C (\f1 -> g (\a -> f1 (id a))) = C (\f1 -> g (\a -> f1 a)) =
 = C (\f1 -> g f1) = C g
2- fmap f (fmap g (C h)) = fmap f (C (\f1 -> h (\a -> f1 (g a)))) =
 = C (\f1 -> (\f1 -> h (\a -> f1 (g a))) (\a -> f1 (f a))) =
 = C (\f1 -> h (\a -> (\a -> f1 (f a)) (g a))) =
 = C (\f1 -> h (\a -> f1 (f (g a)))) = C (\f1 -> h (\a -> f1 ((f o g) a))) =
 = fmap (f o g) (C h)
-}


-- EJERCICIO 2
a) fmap id (Func f) = Func id
   Si f != id, functor.1 no se preserva

b) fmap id (B x (y, z)) = B x (id z, id y) = B x (z, y)
   Si z != y, functor.1 no se preserva


-- EJERCICIO 3
g :: String -> A Int
g "x" = Var 1
g "y" = Res (Var 3) (Var 1)
g "z" = Mul (Var 2) (Var 2)
g _ = Num n

-- Se puede reemplazar n con cualquier entero, por lo que hay infinitas soluciones.
-- La ecuación de h no tiene soluciones pues no existe forma de reemplazar (Mul _ _) por (Res _ _)
-- con ninguna función, según las reglas de bind.


-- EJERCICIO 4
t = IfBoton (\b -> if b then t2 else t)
t2 = IfBoton (\b -> if b then Beep (t) else t2)


-- EJERCICIO 5
t1 lee un caracter, lo imprime dos veces y se reproduce de nuevo.
t2 lee un caracter, lo imprime entre paréntesis y se reproduce de nuevo.
t3 imprime un paréntesis abierto, lee un caracter, lo imprime junto con un paréntesis cerrado y se reproduce de nuevo.
t4 lee, y lee, y lee, y sigue leyendo.


-- EJERCICIO 6
writeChar :: Char -> ES ()
writeChar = \c -> Write c (Var ())

readChar :: ES Char
readChar = Read (\c -> Var c)

writeStr :: String -> ES()
writeStr [] = Var ()
writeStr (x:xs) = (writeChar x) >>= (\_ -> writeStr xs)


-- EJERCICIO 7
f = readLine. Lee una secuencia de caracteres hasta que se apriete Enter y devuelve una Variable con una lista de los valores leídos.


-- EJERCICIO 8
instance Monad m => Functor m where
    fmap f a = a >>= (\x -> return (f x))

{-
1- fmap id a =
 = a >>= (\x -> return (id x)) =
 = a >>= (\x -> return x) =
 = a >>= return = a

2- fmap f (fmap g a) =
 = fmap f (a >>= (\x -> return (g x))) =
 = (a >>= (\x -> return (g x))) >>= (\x -> return (f x)) =
 = a >>= (\y -> (\x -> return (g x)) y >>= (\x -> return (f x))) =
 = a >>= (\y -> return (g y) >>= (\x -> return (f x))) =
 = a >>= (\y -> return (f (g y))) =
 = a >>= (\y -> return ((f o g) y)) =
 = fmap (f o g) a
-}

-- EJERCICIO 9
mapM :: Monad m => (a -> m b) -> [a] -> m [b]
mapM f [] = return []
mapM f (x:xs) = (f x) >>= (\hd -> (mapM f xs) >>= (\tl -> return (hd:tl)))

foldM :: Monad m => (a -> b -> m a) -> a -> [b] -> m a
foldM f base [] = return base
foldM f base (x:xs) = (f base x) >>= (\a -> foldM f a xs)


-- EJERCICIO 10
do z <- (do y <- (do x <- m
                     h x)
            f y)
   return (g z)


-- EJERCICIO 11
(y >>= \z -> f z >>= \w -> return (g w z)) >>=
   \x -> (h x 3) >>= \y -> if y then return 7
                                else (h x 2) >>= \z -> return (k z)


-- EJERCICIO 12
do y <- return x
   f y                =   f x

do y <- t
   return y           =   t

do y <- (do z <- t        do z <- t
            f t)             y <- f z
   g y                =      g y


-- EJERCICIO 13
main :: IO()
main = putStrLn "Hola mundo!"


-- EJERCICIO 14
import System.IO

secreto = 420

comparar :: Int -> IO()
comparar num
    | num < secreto  = do putStrLn "El numero ingresado es menor al secreto"
                          ingreso
    | num > secreto  = do putStrLn "El numero ingresado es mayor al secreto"
                          ingreso
    | num == secreto = putStrLn "Adivinaste!"

ingreso::IO()
ingreso = do putStr "Ingrese un número para adivinar: "
             xs <- getLine
             comparar (read xs)

main::IO()
main = do hSetBuffering stdout NoBuffering
          ingreso



-- EJERCICIO 15
-- Hasta ahora puedo imprimir un tablero #yay
import System.IO

type Tablero = ([Int], Int)

transform :: Int -> Int -> [Int]
transform base 0 = []
transform base n = base : (transform (2 * base) (n - base))

addup :: Int -> [(Int, Int)] -> [(Int, Int)]
addup n [] = [(n, 1)]
addup n ((a,b):xs) | n == a    = ((a, b + 1):xs)
                   | n < a     = ((n, 1):((a,b):xs))
                   | otherwise = ((a,b):(addup n xs))

tupleSum :: [(Int, Int)] -> Int
tupleSum [] = 0
tupleSum ((a,b):xs) = if (mod b 2) == 0 then tupleSum xs
                                        else a + tupleSum xs

boardNimsum :: [Int] -> Int
boardNimsum xs = tupleSum (foldr addup [] (concat (map (transform 1) xs)))

intToAsterisk :: Int -> String
intToAsterisk 0 = ""
intToAsterisk n = "* " ++ intToAsterisk (n - 1)

imprimirTablero :: Tablero -> IO()
imprimirTablero ([], _ )   = putStrLn ""
imprimirTablero ((x:xs),n) = do putStr (show n)
                                putStr ".\t"
                                putStrLn (intToAsterisk x)
                                imprimirTablero (xs, (n + 1))

main::IO()
main = do hSetBuffering stdout NoBuffering
          imprimirTablero ([5,4,7,9,0,0,1], 1)


-- EJERCICIO 16
import Data.Char
import System.Environment

main :: IO ()
main = do args <- getArgs
          case args of
               [inFile, outFile] -> do xs <- readFile inFile
                                       writeFile outFile (map toUpper xs)
               _ -> putStrLn "Cantidad errónea de argumentos. Se necesitan dos archivos."