diff --git "a/Retos/Reto #0 - EL FAMOSO FIZZ BUZZ [F\303\241cil]/haskell/Fran-cio.hs" "b/Retos/Reto #0 - EL FAMOSO FIZZ BUZZ [F\303\241cil]/haskell/Fran-cio.hs" new file mode 100644 index 0000000000..91541af5d4 --- /dev/null +++ "b/Retos/Reto #0 - EL FAMOSO FIZZ BUZZ [F\303\241cil]/haskell/Fran-cio.hs" @@ -0,0 +1,19 @@ +module Fran_cio where +-- /* +-- * Escribe un programa que muestre por consola (con un print) los +-- * números de 1 a 100 (ambos incluidos y con un salto de línea entre +-- * cada impresión), sustituyendo los siguientes: +-- * - Múltiplos de 3 por la palabra "fizz". +-- * - Múltiplos de 5 por la palabra "buzz". +-- * - Múltiplos de 3 y de 5 a la vez por la palabra "fizzbuzz". +-- */ +-- + +fizzBuzz num + | (mod num 3 == 0) && (mod num 5 == 0) = "fizzbuzz" + | mod num 3 == 0 = "fizz" + | mod num 5 == 0 = "buzz" + | otherwise = show num + +main = map fizzBuzz [1..100] + diff --git "a/Retos/Reto #1 - EL LENGUAJE HACKER [F\303\241cil]/haskell/Fran-cio.hs" "b/Retos/Reto #1 - EL LENGUAJE HACKER [F\303\241cil]/haskell/Fran-cio.hs" new file mode 100644 index 0000000000..6c1f337d61 --- /dev/null +++ "b/Retos/Reto #1 - EL LENGUAJE HACKER [F\303\241cil]/haskell/Fran-cio.hs" @@ -0,0 +1,69 @@ +module Fran_cio where +-- /* +-- * Escribe un programa que reciba un texto y transforme lenguaje natural a +-- * "lenguaje hacker" (conocido realmente como "leet" o "1337"). Este lenguaje +-- * se caracteriza por sustituir caracteres alfanuméricos. +-- * - Utiliza esta tabla (https://www.gamehouse.com/blog/leet-speak-cheat-sheet/) +-- * con el alfabeto y los números en "leet". +-- * (Usa la primera opción de cada transformación. Por ejemplo "4" para la "a") +-- */ + + + +toLeet :: Char -> String +toLeet 'a' = "4" +toLeet 'A' = "4" +toLeet 'b' = "I3" +toLeet 'B' = "I3" +toLeet 'c' = "[" +toLeet 'C' = "[" +toLeet 'd' = ")" +toLeet 'D' = ")" +toLeet 'e' = "3" +toLeet 'E' = "3" +toLeet 'f' = "|=" +toLeet 'F' = "|=" +toLeet 'g' = "&" +toLeet 'G' = "&" +toLeet 'h' = "#" +toLeet 'H' = "#" +toLeet 'i' = "1" +toLeet 'I' = "1" +toLeet 'j' = ",_|" +toLeet 'J' = ",_|" +toLeet 'k' = ">|" +toLeet 'K' = ">|" +toLeet 'l' = "1" +toLeet 'L' = "1" +toLeet 'm' = "/\\/\\" +toLeet 'M' = "/\\/\\" +toLeet 'n' = "^/" +toLeet 'N' = "^/" +toLeet 'o' = "0" +toLeet 'O' = "0" +toLeet 'p' = "|*" +toLeet 'P' = "|*" +toLeet 'q' = "(_,)" +toLeet 'Q' = "(_,)" +toLeet 'r' = "|2" +toLeet 'R' = "|2" +toLeet 's' = "5" +toLeet 'S' = "5" +toLeet 't' = "7" +toLeet 'T' = "7" +toLeet 'u' = "(_)" +toLeet 'U' = "(_)" +toLeet 'v' = "\\/" +toLeet 'V' = "\\/" +toLeet 'w' = "\\/\\/" +toLeet 'W' = "\\/\\/" +toLeet 'x' = "><" +toLeet 'X' = "><" +toLeet 'y' = "j" +toLeet 'Y' = "j" +toLeet 'z' = "2" +toLeet 'Z' = "2" +toLeet c = [c] + +main :: String +main = concatMap toLeet "/*\n * Escribe un programa que reciba un texto y transforme lenguaje natural a\n * \"lenguaje hacker\" (conocido realmente como \"leet\" o \"1337\"). Este lenguaje\n * se caracteriza por sustituir caracteres alfanuméricos.\n * - Utiliza esta tabla (https://www.gamehouse.com/blog/leet-speak-cheat-sheet/) \n * con el alfabeto y los números en \"leet\".\n * (Usa la primera opción de cada transformación. Por ejemplo \"4\" para la \"a\")\n *" diff --git a/Retos/Reto #2 - EL PARTIDO DE TENIS [Media]/haskell/Fran-cio.hs b/Retos/Reto #2 - EL PARTIDO DE TENIS [Media]/haskell/Fran-cio.hs new file mode 100644 index 0000000000..cec3554629 --- /dev/null +++ b/Retos/Reto #2 - EL PARTIDO DE TENIS [Media]/haskell/Fran-cio.hs @@ -0,0 +1,75 @@ +module Fran_cio where +-- /* +-- * Escribe un programa que muestre cómo transcurre un juego de tenis y quién lo ha ganado. +-- * El programa recibirá una secuencia formada por "P1" (Player 1) o "P2" (Player 2), según quien +-- * gane cada punto del juego. +-- * +-- * - Las puntuaciones de un juego son "Love" (cero), 15, 30, 40, "Deuce" (empate), ventaja. +-- * - Ante la secuencia [P1, P1, P2, P2, P1, P2, P1, P1], el programa mostraría lo siguiente: +-- * 15 - Love +-- * 30 - Love +-- * 30 - 15 +-- * 30 - 30 +-- * 40 - 30 +-- * Deuce +-- * Ventaja P1 +-- * Ha ganado el P1 +-- * - Si quieres, puedes controlar errores en la entrada de datos. +-- * - Consulta las reglas del juego si tienes dudas sobre el sistema de puntos. +-- */ +data Puntaje = Love | D15 | D30 | D40 | Ventaja | Win deriving (Eq) +data Player = P1 | P2 deriving (Eq, Show) +type State = (Puntaje, Puntaje) + +instance Show Puntaje where + show Love = "Love" + show D15 = "15" + show D30 = "30" + show D40 = "40" + show Ventaja = "Advantage" + show Win = "Win" + +nextPuntaje :: Puntaje -> Puntaje +nextPuntaje Love = D15 +nextPuntaje D15 = D30 +nextPuntaje D30 = D40 +nextPuntaje D40 = Win +nextPuntaje Ventaja = Win +nextPuntaje Win = Win + +nextState :: Player -> State -> State +nextState P1 (p1, p2) = case (p1, p2) of + (D40, D40) -> (Ventaja, D40) + (_, Ventaja) -> (D40, D40) + (Ventaja, _) -> (Win, p2) + (Win, _) -> (Win, p2) + _ -> (nextPuntaje p1, p2) +nextState P2 (p1, p2) = case (p1, p2) of + (D40, D40) -> (D40, Ventaja) + (Ventaja, _) -> (D40, D40) + (_, Ventaja) -> (D40, Win) + (_, Win) -> (p1, Win) + _ -> (p1, nextPuntaje p2) + +-- Estado inicial para iniciar un partido +estadoInicial :: State +estadoInicial = (Love, Love) + +printEstado :: State -> String +printEstado (Win,_) = "Gano P1" +printEstado (_,Win) = "Gano P2" +printEstado (Ventaja,_) = "Ventaja P1" +printEstado (_,Ventaja) = "Ventaja P2" +printEstado (D40,D40) = "Deuce" +printEstado (p1,p2) = show p1 ++ " - " ++ show p2 + +partido :: [Player] -> State -> IO() +partido _ (p1,Win) = do putStrLn (printEstado (p1,Win)) +partido _ (Win,p2) = do putStrLn (printEstado (Win,p2)) +partido [] state = do putStrLn (printEstado state) +partido (x:xs) state = do + putStrLn (printEstado state) + _ <- partido xs (nextState x state) + return () + +main = partido [P1, P1, P2, P2, P2, P1, P2, P1, P1,P1] estadoInicial diff --git "a/Retos/Reto #3 - EL GENERADOR DE CONTRASE\303\221AS [Media]/haskell/Fran-cio.hs" "b/Retos/Reto #3 - EL GENERADOR DE CONTRASE\303\221AS [Media]/haskell/Fran-cio.hs" new file mode 100644 index 0000000000..78d3bb7bcb --- /dev/null +++ "b/Retos/Reto #3 - EL GENERADOR DE CONTRASE\303\221AS [Media]/haskell/Fran-cio.hs" @@ -0,0 +1,68 @@ +module Fran_cio where +import System.Random (randomRIO) +import Text.Read (readMaybe) + +-- /* +-- * Escribe un programa que sea capaz de generar contraseñas de forma aleatoria. +-- * Podrás configurar generar contraseñas con los siguientes parámetros: +-- * - Longitud: Entre 8 y 16. +-- * - Con o sin letras mayúsculas. +-- * - Con o sin números. +-- * - Con o sin símbolos. +-- * (Pudiendo combinar todos estos parámetros entre ellos) +-- */ + +passwordLenght :: IO Int +passwordLenght = do + putStrLn "What is the password length? (Between 8 and 16 characters)" + length <- getLine + if readMaybe length >= Just 8 && readMaybe length <= Just 16 then return (read length :: Int) else passwordLenght + +yesOrNo :: IO Bool +yesOrNo = do + putStrLn "Yes or No" + decision <- getLine + if decision == "Yes" then return ( True :: Bool) + else if decision == "No" then return ( False :: Bool) + else yesOrNo + + +minus :: [Char] +minus = ['a'..'z'] +capitals :: [Char] +capitals = ['A'..'Z'] +numbers :: [Char] +numbers = ['1'..'9'] +symbols :: [Char] +symbols = ['!'..'/'] + +genPassword :: Int -> [Char] -> [Char] -> IO [Char] +genPassword len dic accum + | len == length accum = return accum + | otherwise = do + char <- randomRIO (0, length dic - 1) :: IO Int + genPassword len dic (accum <> [dic !! char] ) + +getDic :: Bool -> Bool -> Bool -> [Char] +getDic capitalsCond numbersCond symbolsCond = minus <> + (if capitalsCond then capitals else []) <> + (if numbersCond then numbers else []) <> + (if symbolsCond then symbols else []) + + +main :: IO String +main = do + putStrLn "Hello, welcome to mouredev random password generator made by FranCio" + putStrLn "Please tell me your preferences" + len <- passwordLenght + putStrLn "The passworld would have capital letters?" + capitalsCond <- yesOrNo + putStrLn "The passworld would have numbers?" + numbersCond <- yesOrNo + putStrLn "The passworld would have symbols?" + symbolsCond <- yesOrNo + let dic = getDic capitalsCond numbersCond symbolsCond + putStrLn dic + genPassword len dic [] + + diff --git a/Retos/Reto #4 - PRIMO, FIBONACCI Y PAR [Media]/haskell/Fran-cio.hs b/Retos/Reto #4 - PRIMO, FIBONACCI Y PAR [Media]/haskell/Fran-cio.hs new file mode 100644 index 0000000000..69037be128 --- /dev/null +++ b/Retos/Reto #4 - PRIMO, FIBONACCI Y PAR [Media]/haskell/Fran-cio.hs @@ -0,0 +1,40 @@ +module Fran_cio where +-- ``` +-- /* +-- * Escribe un programa que, dado un número, compruebe y muestre si es primo, fibonacci y par. +-- * Ejemplos: +-- * - Con el número 2, nos dirá: "2 es primo, fibonacci y es par" +-- * - Con el número 7, nos dirá: "7 es primo, no es fibonacci y es impar" +-- */ +-- ``` + +isPrimo :: Integral t => t -> t -> Bool +isPrimo num accum + | accum == num = True + | accum == 0 = isPrimo num 1 + | accum == 1 = isPrimo num 2 + | mod num accum == 0 = False + | otherwise = isPrimo num (accum+1) + +isFibo :: (Eq t, Num t, Num a, Ord a) => a -> t -> Bool +isFibo num accum + | accum==0 = isFibo num 1 + | accum==1 = isFibo num 2 + | fib accum == num = True + | fib accum > num = False + | otherwise = isFibo num (accum+1) + where + fib 1 = 1 + fib 0 = 0 + fib n = fib (n-2) + fib (n-1) + +message :: (Show a, Integral a) => a -> String +message num = show num + <> (if isPrimo num 0 then " " else " no ") <> "es primo," + <> (if isFibo num 0 then " " else " no ") <> "es fibonacci, y" + <> (if even num then " es par." else " es impar") + +main :: IO () +main =do + mapM_ (putStrLn . message ) [0..100] + diff --git "a/Retos/Reto #5 - HOLA MUNDO [F\303\241cil]/haskell/Fran-cio.hs" "b/Retos/Reto #5 - HOLA MUNDO [F\303\241cil]/haskell/Fran-cio.hs" new file mode 100644 index 0000000000..aba8056273 --- /dev/null +++ "b/Retos/Reto #5 - HOLA MUNDO [F\303\241cil]/haskell/Fran-cio.hs" @@ -0,0 +1,11 @@ +-- ``` +-- /* +-- * Escribe un !Hola Mundo! en todos los lenguajes de programación que puedas. +-- * Seguro que hay algún lenguaje que te llama la atención y nunca has utilizado, +-- * o quizás quieres dar tus primeros pasos... ¡Pues este es el momento! +-- * +-- * A ver quién se atreve con uno de esos lenguajes que no solemos ver por ahí... +-- */ +-- ``` +main :: IO () +main = putStrLn "Hello World" diff --git a/Retos/Reto #6 - PIEDRA, PAPEL, TIJERA, LAGARTO, SPOCK [Media]/haskell/Fran-cio.hs b/Retos/Reto #6 - PIEDRA, PAPEL, TIJERA, LAGARTO, SPOCK [Media]/haskell/Fran-cio.hs new file mode 100644 index 0000000000..5b81aaa5a5 --- /dev/null +++ b/Retos/Reto #6 - PIEDRA, PAPEL, TIJERA, LAGARTO, SPOCK [Media]/haskell/Fran-cio.hs @@ -0,0 +1,34 @@ +module Fran_cio where +-- ``` +-- /* +-- * Crea un programa que calcule quien gana más partidas al piedra, +-- * papel, tijera, lagarto, spock. +-- * - El resultado puede ser: "Player 1", "Player 2", "Tie" (empate) +-- * - La función recibe un listado que contiene pares, representando cada jugada. +-- * - El par puede contener combinaciones de "🗿" (piedra), "📄" (papel), +-- * "✂️" (tijera), "🦎" (lagarto) o "🖖" (spock). +-- * - Ejemplo. Entrada: [("🗿","✂️"), ("✂️","🗿"), ("📄","✂️")]. Resultado: "Player 2". +-- * - Debes buscar información sobre cómo se juega con estas 5 posibilidades. +-- */ +-- ``` + +data Jugadas = Piedra | Papel | Tijera | Lagarto | Spock deriving (Eq, Show) + +partida :: (Jugadas, Jugadas) -> [Char] +partida (p1 , p2) + | p1 == p2 = "Tie" + | otherwise = case (p1, p2) of + (Tijera, Papel) -> "Player 1" + (Tijera, Lagarto) -> "Player 1" + (Piedra, Tijera) -> "Player 1" + (Piedra, Lagarto) -> "Player 1" + (Lagarto, Spock) -> "Player 1" + (Lagarto, Papel) -> "Player 1" + (Spock, Tijera) -> "Player 1" + (Spock, Piedra) -> "Player 1" + (Papel, Spock) -> "Player 1" + (Papel, Piedra) -> "Player 1" + _ -> "Player 2" + +main :: [Char] +main = partida (Tijera, Tijera) diff --git a/Retos/Reto #7 - EL SOMBRERO SELECCIONADOR [Media]/haskell/Fran-cio.hs b/Retos/Reto #7 - EL SOMBRERO SELECCIONADOR [Media]/haskell/Fran-cio.hs new file mode 100644 index 0000000000..1f515cbb52 --- /dev/null +++ b/Retos/Reto #7 - EL SOMBRERO SELECCIONADOR [Media]/haskell/Fran-cio.hs @@ -0,0 +1,53 @@ +module Fran_cio where +-- ``` +-- /* +-- * Crea un programa que simule el comportamiento del sombrero seleccionador del +-- * universo mágico de Harry Potter. +-- * - De ser posible realizará 5 preguntas (como mínimo) a través de la terminal. +-- * - Cada pregunta tendrá 4 respuestas posibles (también a selecciona una a través de terminal). +-- * - En función de las respuestas a las 5 preguntas deberás diseñar un algoritmo que +-- * coloque al alumno en una de las 4 casas de Hogwarts (Gryffindor, Slytherin , Hufflepuff y Ravenclaw) +-- * - Ten en cuenta los rasgos de cada casa para hacer las preguntas y crear el algoritmo seleccionador. +-- * Por ejemplo, en Slytherin se premia la ambición y la astucia. +-- */ +-- ``` + +data Casa = Gryffindor | Ravenclaw | Hufflepuff | Slytherin deriving (Show, Eq) + +preguntas :: [String] +preguntas = + [ "¿Qué valoras más?\nA) Coraje\nB) Inteligencia\nC) Lealtad\nD) Ambición" + , "¿Qué actividad prefieres?\nA) Aventura al aire libre\nB) Estudiar en la biblioteca\nC) Pasar tiempo con amigos\nD) Planear tu futuro" + , "¿Cómo reaccionas ante un problema?\nA) Enfrentándolo de inmediato\nB) Pensando en una solución lógica\nC) Buscando ayuda de tus amigos\nD) Tratando de usarlo a tu favor" + , "¿Cuál es tu prioridad en la vida?\nA) Ser valiente y honesto\nB) Ser sabio y aprender\nC) Ser justo y leal\nD) Ser exitoso y reconocido" + , "¿Qué mascota preferirías tener?\nA) León\nB) Águila\nC) Tejón\nD) Serpiente" + ] + +puntuaciones :: Char -> (Int, Int, Int, Int) +puntuaciones 'A' = (1, 0, 0, 0) +puntuaciones 'B' = (0, 1, 0, 0) +puntuaciones 'C' = (0, 0, 1, 0) +puntuaciones 'D' = (0, 0, 0, 1) +puntuaciones _ = (0, 0, 0, 0) + +main :: IO () +main = do + respuestas <- mapM hacerPregunta preguntas + let casa = determinarCasa respuestas + putStrLn $ "¡Felicidades! Perteneces a " ++ show casa + +hacerPregunta :: String -> IO (Int, Int, Int, Int) +hacerPregunta pregunta = do + putStrLn pregunta + respuesta <- getLine + return $ puntuaciones (head respuesta) + +determinarCasa :: [(Int, Int, Int, Int)] -> Casa +determinarCasa respuestas = + let (gTotal, rTotal, hTotal, sTotal) = foldr (\(g, r, h, s) (gt, rt, ht, st) -> (gt + g, rt + r, ht + h, st + s)) (0, 0, 0, 0) respuestas + in case maximum [gTotal, rTotal, hTotal, sTotal] of + g | g == gTotal -> Gryffindor + r | r == rTotal -> Ravenclaw + h | h == hTotal -> Hufflepuff + s | s == sTotal -> Slytherin + diff --git a/Retos/Reto #8 - EL GENERADOR PSEUDOALEATORIO [Media]/haskell/Fran-cio.hs b/Retos/Reto #8 - EL GENERADOR PSEUDOALEATORIO [Media]/haskell/Fran-cio.hs new file mode 100644 index 0000000000..afa11977c7 --- /dev/null +++ b/Retos/Reto #8 - EL GENERADOR PSEUDOALEATORIO [Media]/haskell/Fran-cio.hs @@ -0,0 +1,49 @@ +module Fran_cio where +import qualified GHC.Base as Integral +-- ``` +-- /* +-- * Crea un generador de números pseudoaleatorios entre 0 y 100. +-- * - No puedes usar ninguna función "random" (o semejante) del lenguaje de programación seleccionado. +-- * +-- * Es más complicado de lo que parece... +-- */ +-- ``` + +-- https://es.wikipedia.org/wiki/Generador_lineal_congruencial +-- a=100 c=1 m=2^32 seed=200 + +randGenLinCongruencialCaped sec = randGenLinCongruencial sec `mod` maxVal + where + randGenLinCongruencial sec + | sec == 0 = (a* seed + c) `mod` m + | otherwise = (a*randGenLinCongruencial (sec-1) + c) `mod` m + seed = 6319288236150718131 + m = Integral.maxInt + a = 100 + c = 1 + maxVal=99 + + +main :: IO () +main = do + mapM_ (print . randGenLinCongruencialCaped) [0..9000] + +-- Histogram in ascci art +-- .... ................... ...................................................................... +-- :. .. +-- -. .: .. .. .. .. +-- -. .- .:. ..-. :. :: .-. :. .-. +-- .. .--:.:. .:: .-. :.-. .: -: .:: .-... . :. . :.-. .: :. .=: +-- :: -==-.=: .=: --. .-.-. .-. :. :=. .-..--: :. -.. :.:.:. .- .-. .=: +-- .:: ::..-==-.=:...:..=:....:--...:=.-. .--. .::.....:=:. -..==:.:-.---..:::.-...-....--...=:.. +-- ..:.:--.--==-.=:...-.:=:...--==-..:=:-...-=-.:-:.-=-.:=:.:-..==:.:=-=--..:--.-...-.::.-=-:.=:.. +-- .-==.--==---=: -.-=:.:.--==-:.-=--.-.--=----.-=- :=.:==:.==::-===--..--=.-...- :-:-=--:=-. +-- .--=:--===--=-..-.-=::=:--===-:==--:----===-=.-=-.-=.:==-.==::-===--::=-=.-.-.-.:====--===: +-- .--==--===--==.--:-=--=:--===-===--===--==--=.-=--==--==---=::-===----=-=.-.-----====--===: +-- .--==--===--==---===--=.--===--==--===--==--=:-=--==--===--=::-===--===-=.-:-===-====--===: +-- .--==--===--===--===--=:--===--==--===--==--====--==--===--=::-===--===-=-=--===-====--===: +-- ....--==--===--===--===--==--===--==--===--==--====--==--===--=---===--===-===--===-====--===: +-- .-:.-===--===-====--===-===--===-====-===--===-====-====-===--===-===--===-===--===-====--===:. +-- ...--==--===--===--===--==--===--==--===--==--====--==--===--==--===--===-===--===-====--===: +-- ...-====-===-====--===-====-===-====-===-====-====-====-===-====-===--===-===--===-====--===: +-- .:.:--------:-----------------------:--------:----:--------:----------------------:---------:. diff --git "a/Retos/Reto #9 - HETEROGRAMA, ISOGRAMA Y PANGRAMA [F\303\241cil]/haskell/Fran-cio.hs" "b/Retos/Reto #9 - HETEROGRAMA, ISOGRAMA Y PANGRAMA [F\303\241cil]/haskell/Fran-cio.hs" new file mode 100644 index 0000000000..058539b7c6 --- /dev/null +++ "b/Retos/Reto #9 - HETEROGRAMA, ISOGRAMA Y PANGRAMA [F\303\241cil]/haskell/Fran-cio.hs" @@ -0,0 +1,44 @@ +module Fran_cio where + +-- ``` +-- /* +-- * Crea 3 funciones, cada una encargada de detectar si una cadena de +-- * texto es un heterograma, un isograma o un pangrama. +-- * - Debes buscar la definición de cada uno de estos términos. +-- */ +-- ``` + +-- Un heterograma (del griego héteros, 'diferente' y gramma, 'letra') es una palabra o frase que no contiene ninguna letra repetida. +-- Un isograma (del griego isos, 'igual' y gramma, 'letra') es una palabra o frase en la que cada letra aparece el mismo número de veces. +-- Los pangramas son textos en los que debe aparecer todas las letras del abecedario +countElemWrap :: (Eq t1, Num t2) => t1 -> [t1] -> t2 +countElemWrap elem arr = + countElem elem arr 0 + where + countElem elem [] accum = accum + countElem elem (x:xs) accum = if elem == x + then countElem elem xs (accum+1) + else countElem elem xs accum + +isHeterograma palabra = all ((== 1) . (`countElemWrap` palabra)) palabra +isIsograma palabra = all ((==countElemWrap (head palabra) palabra) . (`countElemWrap` palabra)) palabra +isPanagrama palabra = all ((== True) . (`elem` palabra)) ['a' .. 'z'] + +message :: [Char] -> String +message palabra = show palabra + <> (if isHeterograma palabra then " " else " no ") <> "es Heterograma," + <> (if isIsograma palabra then " " else " no ") <> "es Isograma, y" + <> (if isPanagrama palabra then " " else " no ") <> "es Panagrama." + +palabras = ["flamenco", "backdrop", "crumpled", "discord", "jumps", + "dermatoglyphics", "subdermatoglyphic", "nonsecretory", + "uncopyrightable", "hydropneumatics", + "aaddbb","llyypp", + "the quick brown fox jumps over a lazy dog.", + "pack my box with five dozen liquor jugs.", + "jackdaws love my big sphinx of quartz.", + "the five boxing wizards jump quickly.", + "how vexingly quick daft zebras jump!"] + +main :: IO () +main = mapM_ (putStrLn . message ) palabras