Programação Funcional

50 Questões Fichas Testes/Exames

Ficha 9: Input / Output

Voltar

1) A classe Random da biblioteca System.Random agrupa os tipos para os quais é possível gerar valores aleatórios. Algumas das funções declaradas nesta classe são:

Usando estas funções implemente os seguintes programas:

a) bingo :: IO () que sorteia os números para o jogo do bingo. Sempre que uma tecla é pressionada é apresentado um número aleatório entre 1 e 90. Obviamente, não podem ser apresentados números repetidos e o programa termina depois de gerados os 90 números diferentes.

bingo :: IO ()
bingo = bingoAux [1..90]

bingoAux :: [Int] -> IO ()
bingoAux [] = return ()
bingoAux prev_ns = do
    putStr "Prime ENTER para gerar um novo número."
    getChar
    random_index <- uniformRM (1, length prev_ns) globalStdGen
    let n = prev_ns !! (random_index - 1)
    print n
    bingoAux (delete n prev_ns)

b) mastermind :: IO () que implementa uma variante do jogo de descodificação de padrões Mastermind. O programa deve começar por gerar uma sequência secreta de 4 dígitos aleatórios que o jogador vai tentar descodificar. Sempre que o jogador introduz uma sequência de 4 dígitos, o programa responde com o número de dígitos com o valor correcto na posição correcta e com o número de dígitos com o valor correcto na posição errada. O jogo termina quando o jogador acertar na sequência de dígitos secreta.

mastermind :: IO ()
mastermind = sequence (replicate 4 $ uniformRM (0,9) globalStdGen)
    >>= playMastermind

playMastermind :: [Int] -> IO ()
playMastermind numbers = do
    guess <- map read . words <$> getLine :: IO [Int]
    if length guess /= 4 then
        putStrLn "Sequencia invalida!"
        >> playMastermind numbers
    else
        let (right_loc, wrong_loc) = 
                foldr (\i (right_loc, wrong_loc) -> 
                    if guess !! i == numbers !! i then
                        (right_loc + 1, wrong_loc)
                    else if guess !! i `elem` numbers then
                        (right_loc, wrong_loc + 1)
                    else
                        (right_loc, wrong_loc)
                ) (0,0) [0..3] in
        if right_loc == 4 then
            putStrLn "Parabens! Acertaste na sequencia!"
        else
            putStrLn (unlines [
                "Valores corretos: " ++ show right_loc,
                "Valores no local errado: " ++ show wrong_loc
            ])
            >> playMastermind numbers

2) Uma aposta do EuroMilhões corresponde à escolha de 5 Números e 2 Estrelas. Os Números são inteiros entre 1 e 50. As Estrelas são inteiros entre 1 e 9. Para modelar uma aposta destas definiu-se o seguinte tipo de dados:

data Aposta = Ap [Int] (Int,Int)

a) Defina a função valida :: Aposta -> Bool que testa se uma dada aposta é válida (i.e. tem os 5 números e 2 estrelas, dentro dos valores aceites e não tem repetições).

valida :: Aposta -> Bool
valida (Ap nums@[n1,n2,n3,n4,n5] (e1,e2)) = 
    all (`elem` [1..50]) nums
    && nub nums == nums
    && e1 /= e2
    && e1 `elem` [1..12] && e2 `elem` [1..12]    
valida _ = False

b) Defina a função comuns :: Aposta -> Aposta -> (Int,Int) que dada uma aposta e uma chave, calcula quantos números e quantas estrelas existem em comum nas duas apostas.

comuns :: Aposta -> Aposta -> (Int, Int)
comuns (Ap nums (e1,e2)) (Ap nums_chave (e1_c, e2_c)) = 
    (length (nums `intersect` nums_chave),
     length (filter (`elem` [e1_c, e2_c]) [e1, e2]))

c) Use a função da alínea anterior para:

i. Definir Aposta como instância da classe Eq.

instance Eq Aposta where
    (==) a b = comuns a b == (5,2)

ii. Definir a função premio :: Aposta -> Aposta -> Maybe Int que dada uma aposta e a chave do concurso, indica qual o prémio que a aposta tem.

Os prémios do EuroMilhões são:

Números Estrelas Prémio
5 2 1
5 1 2
5 0 3
4 2 4
4 1 5
4 0 6
3 2 7
2 2 8
3 1 9
3 0 10
1 2 11
2 1 12
2 0 13
premio :: Aposta -> Aposta -> Maybe Int
premio ap chave =
    case comuns ap chave of 
        (5,e) -> Just (3 - e)
        (4,e) -> Just (6 - e)
        (3,2) -> Just 7
        (3,e) -> Just (10 - e)
        (2,2) -> Just 8
        (2,e) -> Just (13 - e)
        (1,2) -> Just 11
        _ -> Nothing

d) Para permitir que um apostador possa jogar de forma interactiva:

i. Defina a função leAposta :: IO Aposta que lê do teclado uma aposta. Esta função deve garantir que a aposta produzida é válida.

leAposta :: IO Aposta
leAposta = do
    putStrLn "Introduz 5 números separados por um espaço:"
    nums <- map read . words <$> getLine :: IO [Int]
    putStrLn "Introduz as 2 estrelas separadas por um espaço:"
    estrelas <- map read . words <$> getLine :: IO [Int]
    if length estrelas /= 2 then
        putStrLn "Aposta invalida!"
        >> leAposta    
    else
        let ap = Ap nums ((\(a:b:_) -> (a,b)) estrelas) in
        if valida ap then
            return ap
        else
            putStrLn "Aposta invalida!"
            >> leAposta

ii. Defina a função joga :: Aposta -> IO () que recebe a chave do concurso, lê uma aposta do teclado e imprime o prémio no ecrã.

joga :: Aposta -> IO ()
joga chave = do
    ap <- leAposta
    putStrLn $ "Premio: " ++ maybe "sem premio" show (premio ap chave)

e) Defina a função geraChave :: IO Aposta que gera uma chave válida de forma aleatória.

geraChave :: IO Aposta
geraChave = do
    nums <- foldr (\_ acc -> do
            prev_nums <- acc
            num <- geraNum (1,50) prev_nums
            return $ num : prev_nums
        ) (return []) [1..5]
    estrela1 <- geraNum (1,12) []
    estrela2 <- geraNum (1,12) [estrela1]
    return $ Ap nums (estrela1, estrela2)

geraNum :: (Int, Int) -> [Int] -> IO Int
geraNum range prev_nums = do
    n <- uniformRM range globalStdGen
    if n `elem` prev_nums then
        geraNum range prev_nums
    else
        return n

f) Pretende-se agora que o programa main permita jogar várias vezes e dê a possiblidade de simular um novo concurso (gerando uma nova chave). Complete o programa definindo a função ciclo :: Aposta -> IO ().

main :: IO ()
main = do
    ch <- geraChave
    ciclo ch

menu :: IO String
menu = do
    putStrLn menutxt
    putStr "Opcao: "
    getLine
    where menutxt = unlines ["",
            "Apostar ........... 1",
            "Gerar nova chave .. 2",
            "",
            "Sair .............. 0"
            ]
ciclo :: Aposta -> IO ()
ciclo chave = do
    opcao <- menu
    case opcao of 
        "1" -> joga chave >> ciclo chave
        "2" -> geraChave >>= (\ch -> putStrLn "Nova chave gerada." >> ciclo ch)
        "0" -> return ()