State Monad - Jogo da Velha 👵 - Gabarito
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217
-- 2024-09-09 - Emilio Francesquini <[email protected]>
-- Universidade Federal do ABC
-- CC-BY-SA 4.0
module Main (main) where
import Data.List (nub)
import Data.Maybe (fromJust)
import System.Random
-- A definição de State
newtype State s a = State (s -> (a, s))
-- Definições de Functor, Applicative e Monad para State
instance Functor (State s) where
-- fmap :: (a -> b) -> State s a -> State s b
fmap f (State g) = State (\s -> let (a, s') = g s
in (f a, s'))
instance Applicative (State s) where
pure x = State (\s -> (x, s))
-- (<*>) :: State s (a -> b) -> State s a -> State s b
sab <*> sa = State (\s -> let (f, s1) = runState sab s
(a, s2) = runState sa s1
in (f a, s2))
instance Monad (State s) where
-- (>>=) :: State s a -> (a -> State s b) -> State s b
sa >>= f = State (\s -> let (a, s1) = runState sa s
sb = f a
in runState sb s1)
-- Executa um State dado um contexto inicial
runState :: State s a -> s -> (a, s)
runState (State f) = f
-- State que, quando executado, devolve o seu estado interno
get :: State s s
get = State (\s -> (s, s))
-- State que, quando executado, aplica a função dada como parâmetro
-- ao estado interno e devolve o valor calculado.
gets :: (s -> a) -> State s a
gets f =
get >>= return . f
-- Dado um novo coontexto, coloca-o dentro do State
put :: s -> State s ()
put x = State (const ((), x))
-- Dada uma função, aplica-a ao contexto atual e coloca o resultaado
-- como novo contexto do State
modify :: (s -> s) -> State s ()
modify f = do
s <- get
put $ f s
return ()
-- Semelhante ao runState mas devolve apenas o contexto final
exec :: State s a -> s -> s
exec st = snd . runState st
-- Semelhante ao runState mas devolve apenas o valor final
eval :: State s a -> s -> a
eval st = fst . runState st
-- =============================================================================
-- =============================================================================
-- =============================================================================
-- Vamos agora usar a State Monad para fazer um jogo da velha bem
-- simples
-- Coordenada de uma casa do tabuleiro
type Coord = (Int, Int)
-- Dicionário simples de pares chave/valor
type Dict k v = [(k, v)]
-- Consulta e devolve, caso exista, a entrada do dicionário cuja chave
-- corresponde à chave fornecida
dictGet :: Eq k => k -> Dict k v -> Maybe v
dictGet _ [] = Nothing
dictGet k ((k0,v0) : kvs)
| k == k0 = Just v0
| otherwise = dictGet k kvs
-- Coloca um novo valor no dicionário substituindo o valor já existe
-- pelo novo caso a chave já esteja presente
dictPut :: Eq k => k -> v -> Dict k v -> Dict k v
dictPut k v [] = [(k, v)]
dictPut k v ((k0, v0) : kvs)
| k == k0 = (k, v) : kvs
| otherwise = (k0, v0) : dictPut k v kvs
-- Repreesenta o tabuleiro do jogo da velha
data Tabuleiro = Tabuleiro {
-- Armazena o dicionário com as casas do jogo
casas :: Dict Coord ConteudoCasa,
-- Armazena o jogador que tem a vez
vez :: Jogador,
-- Lista infinita de números aleatórios
aleatorios :: [Int]
}
-- Jogadodes podem usar o X ou o O para marcar as casas escolhidas
data Jogador = X | O deriving (Eq, Show)
-- Armazena cada casa que pode estar Vazia ou Preencida com a marca de
-- um Jogador
data ConteudoCasa = Vazia | Preenchida Jogador deriving Eq
-- Indica a situação atual do jogo.
data Situacao = EmJogo | Empate | Vitoria Jogador deriving Show
-- State sobre o Tabuleiro
type Jogo a = State Tabuleiro a
-- Dada uma lista de números aleatórios cria um tabuleiro com as casas
-- vazias e a vez do primeiro definida aleatóriamente
criaTabuleiro :: [Int] -> Tabuleiro
criaTabuleiro (r:rs) =
Tabuleiro cs v (abs <$> rs)
where
v = if even r then X else O
cs = [((x,y), Vazia)| x <- [0..2], y <- [0..2]]
-- Dado o jogador atual, devolve o próximo jogador
proximoJogador :: Jogador -> Jogador
proximoJogador X = O
proximoJogador O = X
-- Dentro da mônada Jogo, devolve um número aleatório obtido da lista
-- infinita fornecida na criação do tabuleiro. Atualiza o estado do
-- tabuleiro para marcar o consumo do número aleatório.
getAleatorio :: Jogo Int
getAleatorio = do
~(n:ns) <- gets aleatorios
modify (\tab -> tab{aleatorios = ns})
return n
-- Pega uma casa vazia aleatoriamente, caso exista.
getCasaVaziaAleatoria :: Jogo (Maybe Coord)
getCasaVaziaAleatoria = do
casasVazias <- filter (\c -> Vazia == snd c) <$> gets casas
if null casasVazias
then return Nothing
else do
n <- fmap (`rem` length casasVazias) getAleatorio
return . Just $ fst (casasVazias !! n)
-- Passa a vez para o próximo jogador
passaAVez :: Jogo ()
passaAVez = do
j <- gets vez
modify (\tab -> tab{vez = proximoJogador j})
-- Dada uma coordenada de uma casa vazia, faz uma jogada naquela
-- posição para o jogador atualmente com a vez
fazJogada :: Coord -> Jogo ()
fazJogada coord = do
jog <- gets vez
modify (\tab -> tab{casas = dictPut coord (Preenchida jog) (casas tab)})
passaAVez
-- Devolve a situação atual do jogo seja ela empate, em jogo ou
-- vitória de um dos jogadores. Neste último caso, indica o vencedor.
vencedor :: Jogo Situacao
vencedor = do
dic <- gets casas
let vencs =
ganha (linhas dic) <>
ganha (colunas dic) <>
ganha (diagonais dic)
return $ case vencs of
((Preenchida x:_):_) -> Vitoria x
_ -> EmJogo
where
cs xss dic = fmap (fmap (\c -> fromJust $ dictGet c dic)) xss
ganha = filter (\xs -> length (nub xs) == 1)
linhas = cs [[(i, j) | j <- [0..2]] | i <- [0..2]]
colunas = cs [[(i, j) | i <- [0..2]] | j <- [0..2]]
diagonais = cs [[(0,0), (1, 1), (2, 2)], [(0,2), (1, 1), (2, 0)]]
-- Efetua umaa única jogada aleatória, caso possÃvel.
jogaUmaVez :: Jogo Situacao
jogaUmaVez = do
mc <- getCasaVaziaAleatoria
case mc of
Nothing -> return Empate
Just c -> do
fazJogada c
vencedor
-- Joga o tabuleiro atual até o fim do jogo
jogaAteOFim :: Jogo Situacao
jogaAteOFim = do
sit <- jogaUmaVez
case sit of
EmJogo -> jogaAteOFim
_ -> return sit
main :: IO ()
main = do
-- Obtem uma lista infinita de números aleatórios
gen <- getStdGen
let rns = randoms gen
-- Usa essa lista para criar tabuleiro inicial, rodar o jogo e
-- imprimir o vencedor (ou se houve empate) ao final
let v = eval jogaAteOFim (criaTabuleiro rns)
print v
Haskell
INFO