/tp-1/codigo/Damas.hs

  1module Damas where
  2
  3import Char
  4import Tablero
  5import Maybe
  6
  7data Juego = J Color Tablero
  8data Movimiento = M Posicion Direccion
  9  deriving Show
 10
 11data Arbol a = Nodo a [Arbol a] deriving Show
 12type ArbolJugadas = Arbol ([Movimiento], Juego)
 13
 14type Valuacion = Juego -> Double
 15
 16---- Funciones de regalo ----
 17
 18instance Show Juego where
 19  show (J turno tablero) = "\n--Juegan las " ++ show turno ++ "s--\n" ++ show tablero
 20
 21arbolDeJugadas :: Juego -> ArbolJugadas
 22arbolDeJugadas j = Nodo ([], j) $ zipWith agmov movs hijos
 23  where agmov m (Nodo (ms, r) hs) = Nodo ((m:ms), r) (map (agmov m) hs)
 24        movsJuegos = movimientosPosibles j
 25        movs = map fst movsJuegos
 26        hijos = map (arbolDeJugadas . snd) movsJuegos
 27
 28---- Ejercicios ----
 29color :: Ficha -> Color
 30color (Simple c) = c
 31color (Reina c) = c
 32
 33isSimple :: Ficha -> Bool
 34isSimple (Simple c) = True
 35isSimple (Reina c) = False
 36
 37destino :: Movimiento -> Posicion
 38destino (M (i,j) BR) = (chr ((ord i) + 1), j-1)
 39destino (M (i,j) BL) = (chr ((ord i) - 1), j-1)
 40destino (M (i,j) TR) = (chr ((ord i) + 1), j+1)
 41destino (M (i,j) TL) = (chr ((ord i) - 1), j+1)
 42
 43destinoSiCaptura :: Movimiento -> Posicion
 44destinoSiCaptura (M (i,j) BR) = (chr ((ord i) + 2), j-2)
 45destinoSiCaptura (M (i,j) BL) = (chr ((ord i) - 2), j-2)
 46destinoSiCaptura (M (i,j) TR) = (chr ((ord i) + 2), j+2)
 47destinoSiCaptura (M (i,j) TL) = (chr ((ord i) - 2), j+2)
 48
 49
 50-- Ejercicio 3
 51
 52dentroDelTablero :: Posicion -> Bool
 53dentroDelTablero (i, j) = i `elem` ['a'..'h'] && j `elem` [1..8]
 54
 55-- se fija si hay ficha que comer y que sea del color contrario, detalle...
 56esCaptura :: Movimiento -> Tablero -> Color -> Bool
 57esCaptura (M (i, j) d) t c = not (isNothing (contenido (destino (M (i, j) d)) t)) && (color (dameFicha (contenido (destino (M (i, j) d)) t)) == (invertirColor c)) 
 58
 59puedeMover :: Ficha -> Direccion -> Bool
 60-- las reinas pueden mover en cualquier direccion
 61puedeMover (Reina _) _ = True
 62-- las simples blancas no pueden ir para el bottom
 63puedeMover (Simple Blanca) TL = True
 64puedeMover (Simple Blanca) TR = True
 65puedeMover (Simple Blanca) _ = False
 66-- las simples negras no pueden ir para el top
 67puedeMover (Simple Negra) BL = True
 68puedeMover (Simple Negra) BR = True
 69puedeMover (Simple Negra) _ = False
 70
 71invertirColor :: Color -> Color
 72invertirColor Blanca = Negra
 73invertirColor Negra = Blanca
 74
 75-- renombro la funcion para aclarar!
 76fichaAComer :: Movimiento -> Posicion
 77fichaAComer = destino
 78
 79-- funcion parcial!!
 80dameFicha :: Maybe Ficha -> Ficha
 81dameFicha (Just f) = f
 82
 83-- corona si debe, segun su posicion destino
 84coronarSiSeDebe :: Ficha -> Posicion -> Ficha
 85coronarSiSeDebe (Simple Blanca) (x,y) = if y == 8 then (Reina Blanca) else (Simple Blanca)
 86coronarSiSeDebe (Simple Negra) (x,y) = if y == 1 then (Reina Negra) else (Simple Negra)
 87coronarSiSeDebe (Reina Blanca) _ = (Reina Blanca)
 88coronarSiSeDebe (Reina Negra) _ = (Reina Negra)
 89
 90mover :: Movimiento -> Juego -> Maybe Juego
 91mover (M p d) (J c t) 
 92                -- la pos orig esta en el tablero
 93              | not (dentroDelTablero p) = Nothing 
 94                -- la posicion dest esta en el tablero (no captura)
 95              | not (dentroDelTablero (destino (M p d))) = Nothing               
 96                -- el contenido de la pos original no es vacio
 97              | contenido p t == Nothing = Nothing
 98                -- la posicion dest esta en el tablero (capturo)
 99              | (esCaptura (M p d) t c) && not (dentroDelTablero (destinoSiCaptura (M p d))) = Nothing 
100                -- el color de la ficha tiene que ser el mismo del que le toca jugar
101              | not (color (dameFicha (contenido p t)) == c) = Nothing
102                -- chequea que pueda mover depende de que ficha es (Blanca, Negra, Simple o Reina)
103              | not (puedeMover (dameFicha (contenido p t)) d) = Nothing
104                -- el destino esta vacio (captura)
105              | (esCaptura (M p d) t c) && not ((contenido (destinoSiCaptura (M p d)) t) == Nothing) = Nothing
106                -- el destino esta vacio (no captura)
107              | not (esCaptura (M p d) t c) && not ((contenido (destino (M p d)) t) == Nothing) = Nothing
108                -- la ficha que capturo es la del color del rival
109              | (esCaptura (M p d) t c) && (not (isNothing (contenido (destinoSiCaptura (M p d)) t))) && (color (dameFicha (contenido (destinoSiCaptura (M p d)) t)) == c) = Nothing
110                -- sino, hago la movida
111              | otherwise = 
112                    (Just (J (invertirColor c) (if (esCaptura (M p d) t c) then
113                    (sacar (fichaAComer (M p d)) (sacar p (poner (destinoSiCaptura (M p d))  (coronarSiSeDebe (dameFicha (contenido p t)) (destinoSiCaptura (M p d))) t)))
114                    else
115                    (sacar p (poner (destino (M p d)) (coronarSiSeDebe (dameFicha (contenido p t)) (destino (M p d))) t)))))
116
117
118-- Ejercicio 4
119movimientosPosibles :: Juego -> [(Movimiento, Juego)]
120movimientosPosibles (J c t) = map (\(m, Just j) -> (m,j))  
121					(filter (\(m, j1) -> not(isNothing j1))
122					[(m, mover m (J c t) ) | 
123					--itero todas las fichas de un color
124					p<-(fichas t c),	
125					--construyo un movimiento
126					m<- [M p TL,  M p TR,  M p BL,  M p BR]
127					]
128					)
129
130-- Ejercicio 5
131foldArbol :: (a -> c -> b) -> ([b] -> c) -> Arbol a -> b
132foldArbol g h (Nodo a xs) = g a (h (map (foldArbol g h) xs))
133
134-- Ejercicio 6
135podar :: Int -> Arbol a -> Arbol a
136podar i a = podarP a i
137
138podarP :: Arbol a -> Int -> Arbol a
139podarP = foldArbol (\a xs n -> if (n == 0) then (Nodo a []) else (Nodo a (map (\x -> x (n-1)) xs))) (id)
140
141-- Ejercicio 7
142mejorMovimiento :: Valuacion -> ArbolJugadas -> Movimiento
143mejorMovimiento v a = (head.snd) (minimax v a)
144
145-- chooseF devuelve el x en la lista que decide el criterio f
146chooseF :: (a -> a -> Bool) -> [a] -> a
147chooseF f = foldr1 (\x y -> if f x y then x else y)
148
149--Minimax con recursion explicita
150--minimax2 v (Nodo a hs) = auxMinimax v (Nodo a hs) True
151--
152--auxMinimax :: Valuacion -> ArbolJugadas -> Bool -> (Double, [Movimiento])
153--auxMinimax v (Nodo a []) _ = (v (snd a), fst a)
154--auxMinimax v (Nodo _ hs) True = min0 (map (\x -> auxMinimax v x False) hs) 
155--    where min0 = chooseF (\x y -> (fst x) < (fst y)) 
156--auxMinimax v (Nodo _ hs) False = max0 (map (\x -> auxMinimax v x True) hs)
157--    where max0 = chooseF (\x y -> (fst x) > (fst y))
158
159
160minimax :: Valuacion -> ArbolJugadas -> (Double, [Movimiento])
161minimax v = foldArbol f g
162    where
163        chooseMin = chooseF (\x y -> (fst x) < (fst y))
164        chooseMax = chooseF (\x y -> (fst x) >= (fst y))
165        g = \xs -> if (null xs) then Nothing else Just ( (chooseMin xs, chooseMax xs) )
166        f = \j rec -> case rec of
167            -- si es una hoja, devuelvo la jugada evaluada
168            Nothing -> (v (snd j), fst j)
169            -- sino elijo segun tengo que minimizar o maximizar la mejor jugada
170            Just (minVal, maxVal) -> if (length (fst j) `mod` 2 == 0) then maxVal else minVal
171
172-- Ejercicio 8
173ganador :: Juego -> Maybe Color
174ganador (J c t) | (length (movimientosPosibles (J c t)) == 0) = Just (invertirColor c)
175		| (length (fichas t (invertirColor c)) == 0) = Just c
176		| otherwise = Nothing
177
178-- Ejercicio 9
179valuacionDamas :: Juego -> Double
180valuacionDamas (J c t)	| (ganador (J c t) == (Just c)) = 1
181			| (ganador (J c t) == (Just (invertirColor c))) = -1
182			| otherwise = fromIntegral (2 * (2 * r + s)) / fromIntegral ((2 * rtot + 2 * stot) - 1)
183 where 	r = length (reinas t c)
184	s = length (simples t c)
185	rtot = r + (length (reinas t (invertirColor c)) )
186	stot = s + (length (simples t (invertirColor c)) )
187
188
189-- esta funcion se llama asi por que es corto el nombre pero devuelve todas las pocisiones ocupadas por un color
190fichas :: Tablero -> Color -> [Posicion]
191fichas t c = [ (i,j) | i <- ['a'..'h'], j <- [1..8], (not (isNothing (contenido (i,j) t))) && (color (dameFicha (contenido (i,j) t)) == c) ]
192
193simples :: Tablero -> Color -> [Posicion]
194simples t c = [ x | x <- (fichas t c), isSimple (dameFicha (contenido x t))]
195
196reinas :: Tablero -> Color -> [Posicion]
197reinas t c = [ x | x <- (fichas t c), not (isSimple (dameFicha (contenido x t)))]
198