Saber y Ganar

SaberYGanar.hs

{-# LANGUAGE ScopedTypeVariables #-}
module SaberYGanar where
-- un programa presentado por Alejandro Serrano

import Control.Monad.Random
-- import Control.Monad.Random.Class

-- Posibles operaciones del juego
data Operacion = Mas Int
               | Menos Int
               | Por Int
               | Entre Int
               deriving Show

esMas :: Operacion -> Bool
esMas (Mas _) = True
esMas _       = False

esMenos :: Operacion -> Bool
esMenos (Menos _) = True
esMenos _         = False

esMasOMenos :: Operacion -> Bool
esMasOMenos o = esMas o || esMenos o

esPor :: Operacion -> Bool
esPor (Por _) = True
esPor _       = False

esEntre :: Operacion -> Bool
esEntre (Entre _) = True
esEntre _         = False

esPorOEntre :: Operacion -> Bool
esPorOEntre o = esPor o || esEntre o

aplicar :: Int -> Operacion -> Int
aplicar n (Mas m)   = n + m
aplicar n (Menos m) = n - m
aplicar n (Por m)   = n * m
aplicar n (Entre m) = n `div` m

data Prueba = Prueba Int          -- Numero inicial
                     [Operacion]  -- Lista de operaciones

instance Show Prueba where
  show (Prueba n [])       = show n
  show (Prueba n (op:ops)) = show n ++ "\n" ++ show op ++ " = " 
                             ++ show (Prueba (aplicar n op) ops)

-- Constantes para generacion aleatoria
data Rango = Rango { minimo :: Int
                   , maximo :: Int
                   }

estaEnRango :: Int -> Rango -> Bool
estaEnRango n r = n >= (minimo r) && n <= (maximo r)

todosLosNumeros :: Rango
todosLosNumeros = Rango 10 150

sumasYRestas :: Rango
sumasYRestas = Rango 15 60

multYDivisiones :: Rango
multYDivisiones = Rango 3 12

elementoInicial :: Rango
elementoInicial = Rango 20 70

-- Chequeos para comprobar que se puede
sePuedeAplicar :: Int -> [Operacion] -> Bool 
sePuedeAplicar n []             = n `estaEnRango` todosLosNumeros
sePuedeAplicar n ((Mas m):xs)   = n `estaEnRango` todosLosNumeros
                                  && m `rem` 10 /= 0
                                  && m `estaEnRango` sumasYRestas
                                  && sePuedeAplicar (n+m) xs
sePuedeAplicar n ((Menos m):xs) = n `estaEnRango` todosLosNumeros
                                  && m `rem` 10 /= 0
                                  && m `estaEnRango` sumasYRestas
                                  && sePuedeAplicar (n-m) xs
sePuedeAplicar n ((Por m):xs)   = n `estaEnRango` todosLosNumeros
                                  && n `rem` 10 /= 0
                                  && m `rem` 10 /= 0
                                  && m `estaEnRango` multYDivisiones
                                  && sePuedeAplicar (n*m) xs
sePuedeAplicar n ((Entre m):xs) = n `estaEnRango` todosLosNumeros
                                  && n `rem` 10 /= 0
                                  && m `estaEnRango` multYDivisiones
                                  && n `rem` m == 0
                                  && sePuedeAplicar (n `div` m) xs

-- Generacion aleatoria de operaciones
generarOperacionAleatoria :: MonadRandom m => m Operacion
generarOperacionAleatoria = do
  (op :: Int) <- getRandomR (1,4)
  case op of
    1 -> do m <- generarNumeroEnRango sumasYRestas
            return $ Mas m
    2 -> do m <- generarNumeroEnRango sumasYRestas
            return $ Menos m
    3 -> do m <- generarNumeroEnRango multYDivisiones
            return $ Por m
    4 -> do m <- generarNumeroEnRango multYDivisiones
            return $ Entre m
    _ -> error "Caso no posible"

generarNumeroEnRango :: MonadRandom m => Rango -> m Int
generarNumeroEnRango r = getRandomR (minimo r, maximo r)

-- Comprueba que no hay dos operaciones consecutivas que se cancelen
esParRepetido :: (Operacion, Operacion) -> Bool
esParRepetido (Mas n, Menos m) = n == m
esParRepetido (Menos n, Mas m) = n == m
esParRepetido (Por n, Entre m) = n == m
esParRepetido (Entre n, Por m) = n == m
esParRepetido _                = False

-- Comprueban que una prueba cumple los requisitos
esUnaPruebaCorrecta :: Prueba -> Bool
esUnaPruebaCorrecta (Prueba i ops) = 
  sePuedeAplicar i ops -- Estamos en rango
  && any esMas ops
  && any esMenos ops
  && any esPor ops
  && any esEntre ops   -- Hay una operacion de cada tipo
  && (length (filter esPorOEntre ops)) `elem` [3, 4]
                       -- Hay 3 o 4 mutiplicaciones o divisiones
  && not (any esParRepetido (zip ops (tail ops)))

generarPrueba :: MonadRandom m => m Prueba
generarPrueba = do inicial <- generarNumeroEnRango elementoInicial
                   ops <- sequence $ take 7 $ repeat generarOperacionAleatoria
                   let posiblePrueba = Prueba inicial ops
                   if esUnaPruebaCorrecta posiblePrueba
                      then return posiblePrueba
                      else generarPrueba