# User talk:Mimoso

### From HaskellWiki

(Difference between revisions)

(→Othello (Reversi). Manuel Hernández, April 2011.) |
(→Othello (Reversi). Manuel Hernández, April 2011.) |
||

Line 277: | Line 277: | ||

<haskell> | <haskell> | ||

-- Something is wrong with this code... I'm sorry. | -- Something is wrong with this code... I'm sorry. | ||

− | -- I am trying to make a derivation from the specification | + | -- I am trying to make a direct derivation from the specification given by R.Bird and P.Wadler... |

bmx alpha beta (T4 (n,[mov],(numberOfxs,numberOfos,nm)) []) = | bmx alpha beta (T4 (n,[mov],(numberOfxs,numberOfos,nm)) []) = | ||

([mov],max alpha (min numberOfxs beta)) | ([mov],max alpha (min numberOfxs beta)) |

## Revision as of 22:52, 6 April 2011

## Othello (Reversi). Manuel Hernández, April 2011.

import Random import List data Element = O | X | E | L deriving (Eq,Show) data ArbolG = T Board [ArbolG] deriving Show type Board = [Element] data ArbolG1 = T1 (Element,Integer,Board,Int,Int) [ArbolG1] deriving Show --Bug? Hugs does not accept "vectors" from size > 5 to show -- T1 (Int,Int,Int,Int,Int) is not shown... data ArbolG3 = T3 (Element, -- Player Integer, -- Mov Board, -- Position (Int,Int,Int) -- (num Xs, num Os, num Movs) ) [ArbolG3] deriving Show data ArbolG4 = T4 (Element, -- Player [Integer], -- Mov (Int,Int,Int) -- (num Xs, num Os, num Movs) ) [ArbolG4] deriving Show data MvVal = MvVal {mov::Integer, xs :: Int, os :: Int} deriving Show lcoords = concat [[(x+1)..(x+8)]| x<-[10,20..80]] coords pos = zipWith (\x y -> (x,y)) lcoords pos expandx pos ((ini,X),(cand, O)) = let (delta,av) = (cand-ini,cand+delta) es = findCoords av (coords pos) in if null es then [] else let h = snd (head es) in case h of X -> [] E -> [(cand,O),(av,E)] O -> let rest = expandoX pos delta (av, O) in if null rest then [] else (cand, O):rest expandoX pos delta (av, O) = let av1 = av + delta es = findCoords av1 (coords pos) in if null es then [] else let h = snd (head es) in case h of X -> [] E -> [(av, O),(av1, E)] O -> let rest= expandoX pos delta (av1, O) in if null rest then [] else (av, O):rest expando pos ((ini,O),(cand, X)) = let (delta,av) = (cand-ini,cand+delta) es = findCoords av (coords pos) in if null es then [] else let h = snd (head es) in case h of O -> [] E -> [(cand, X),(av, E)] X -> let rest = expandxO pos delta (av, X) in if null rest then [] else (cand, X):rest expandxO pos delta (av, X) = let av1 = av + delta es = findCoords av1 (coords pos) in if null es then [] else let h = snd (head es) in case h of O -> [] E -> [(av, X),(av1, E)] X -> let rest= expandxO pos delta (av1, X) in if null rest then [] else (av, X):rest allNum player pos = (nub . sort) (map (fst) (validMoves player pos)) validMoves player pos = map last (allMoves player pos) allMoves player pos = filter (/=[]) (movs player pos) movs player pos = if player==X then map (expandx pos) (concat (onlyNBos X pos)) else map (expando pos) (concat (onlyNBos O pos)) candidates (init, ls) = zip (repeat init) ls findF e coors = (filter (\x -> (snd x)==e) coors) findCoords m coors = (filter (\x -> (fst x) == m) coors) neighbs e1 pos (n, e) = ((n, e),(only e1 (concat [findCoords x (coords pos)| x<-dirs n]))) -- To find the neighborhoods... onlyNBos player pos = map (candidates . (neighbs (change player) pos)) (findF player (coords pos)) only e ls = filter (\x -> (snd x)==e) ls dirs n | elem n ([22..27]++[32..37]++[42..47]++[52..57]++[62..67]++[72..77]) = map (+n) [-11,-10,-9,-1,1,9,10,11] | elem n [12..17] = map (+n) [-1,1,9,10,11] | elem n [82..87] = map (+n) [-1,1,-9,-10,-11] | elem n [21,31..71] = map (+n) [-10,-9,1,10,11] | elem n [28,38..78] = map (+n) [-11,-10,-1,9,10] | elem n [11] = [12,22,21] | elem n [88] = [87,77,78] | elem n [81] = [71,72,82] | elem n [18] = [17,27,28] numTTT::Int numTTT= 64 part8 [] = [] part8 (a:bs) = (take 8 (a:bs)):(part8 (drop 8 (a:bs))) posIni::[Element] posIni = (take 24 (repeat E))++[E,E,E,X,O,E,E,E, E,E,E,O,X,E,E,E]++(take 24 (repeat E)) to a = snd (head (filter (\x -> a==fst x) (zip lcoords [1..64]))) maxV (MvVal n1 a1 b1) (MvVal n2 a2 b2) | a1<=a2 = MvVal n2 a2 b2 | otherwise = MvVal n1 a1 b1 findMaxV ls = foldr (maxV) (MvVal 0 (-1000) 0) ls showB [] = "" showB (a:bs) = (show a)++"\n"++(showB bs) showBoard pos = putStr (" _ _ _ _ _ _ _ _ \n" ++[xchange x|x<-(showB (part8 pos))]) xchange x | x==',' = '|' | x=='E' = '_' | otherwise = x count player pos = length (filter (==player) pos) validCoord player pos = nub (strip (validMoves player pos)) strip [] = [] strip ((n, x):ls) = fst (n, x):strip ls ------------------------------begin wrt X--------------------- allVBasic player g pos = T1 (player,g,pos,count X pos,count O pos) ls where ls = [T1 (mMoveVirtual player k pos) [] | k <- (allNum player pos)] barrer player (T1 (p,m,pos,n1,n2) []) = allVBasic player m pos barrer player (T1 (p,m,pos,n1,n2) (c:cs)) = T1 (player,m,pos,count X pos,count O pos) (map (barrer (change player)) (c:cs)) genTree player pos n = take n (iterate (barrer player) (T1 (X,0,pos,2,2) [])) --Realmente sólo se utilizan jugador=X y posición=pos mMoveVirtual player n pos = let newpos = (applyMove (apply player (nub (concat (filter (\x->fst (head x)==n) (map reverse (allMoves player pos)))))) pos) in (player, n, newpos, count X newpos, count O newpos) --Dato: (player, movement, position, howmanyX, howmanyO) sortby [] = [] sortby ((a1,b1):bs) = sortby [x | x<- bs, snd x < b1]++[(a1,b1)]++ sortby [x | x<- bs, snd x >= b1] newPos player n pos = applyMove (apply player (nub (concat (filter (\x->fst (head x)==n) (map reverse (allMoves player pos)))))) pos mMvVirtual player n pos = let newpos = (applyMove (apply player (nub (concat (filter (\x->fst (head x)==n) (map reverse (allMoves player pos)))))) pos) in MvVal n (count X newpos) (count O newpos) transTree (T1 (n,mov,pos,xs,os) []) = T4 (n,[mov],(xs-os,os,nm)) [] where nm = length (allNum n pos) transTree (T1 (n,mov,pos,xs,os) (a:bs)) = T4 (n,[mov],(xs,os,nm)) ls where ls = (map transTree (a:bs)) nm = length (allNum n pos) --Simple minimax: alpha-beta pruning, see below... minimax (T4 (n,[mov],(numberOfxs,numberOfos,nm)) []) |nm==0 = ([mov],-70) -- -70 o 70? minimax (T4 (n,[mov],(numberOfxs,numberOfos,nm)) []) |nm>0 = ([mov],-numberOfxs) -- positive, it is "greedy" minimax (T4 (n,[mov],(numberOfxs,numberOfos,nm)) (a:bs)) = (ms,n) where ls = (negP (minList' (map minimax (a:bs)))) (mvT,val) = ls ms = (mov:mvT) -- ++[mov] n = val app ls (ms,t) = (ls++ms,t) negP (a,b) = (a,-b) bestMv player pos n = minimax (transTree (last (genTree player pos n))) minList ls = foldr (min) (1000) ls minP (a1,b1) (a2,b2) = if b1<b2 then (a1,b1) else (a2,b2) minList' ls = foldr (minP) ([],1000) ls mMove player n pos = showBoard (applyMove (apply player (nub (concat (filter (\x->fst (head x)==n) (map reverse (allMoves player pos)))))) pos) ---------------------------end wrt X----------------------------- apply player [] = [] apply player ((n,e):ls) = (n,player):apply player ls applyMove [] pos = pos applyMove ((n,player):ls) pos = applyMove ls (sustn player (to n) pos) sustn :: (Num a, Ord a) => b -> a -> [b] -> [b] sustn a 1 (c:cs) = (a:cs) sustn a n (c:cs) | n>1 = c:(sustn a (n-1) cs) change X = O change O = X -- The strength of playing depends on the eval function. calcMov :: Board -> IO() calcMov pos = do --Report winner..., missing let bm = head (tail (fst (bestMv X pos 3))) -- Empty list..., missing newpos1 = newPos X bm pos mMove X bm pos putStr $ show bm putStr $ "\n" putStrLn $ "Black: " ++ (show (count X newpos1)) putStrLn $ "White: " ++ (show (count O newpos1)) putStrLn $ (show (allNum O newpos1))++"\n" putStr "Your move: " input <- getLine let square = (read input) :: Integer -- putStr (show square) let newpos2 = newPos O square newpos1 mMove O square newpos1 putStrLn $ "Black: "++ (show (count X newpos2)) putStrLn $ "White: "++ (show (count O newpos2)) calcMov (newPos O square newpos2) main = calcMov posIni

--Variants:

- Three players (or more)
- Scattering pieces over the board
- Boards with obstacles (squares, or diamonds, for example)
- Boards with distinct geometrical forms.
- Boards with distinct square geometry.
- Random static token
- Factor number betrayed
- ¿Dimensions? I am thinking... 3D Othello.
- Special turns (like to put a token over an arbitrary square)
- Hexa "squares"

The alpha-beta pruning process is:

-- Something is wrong with this code... I'm sorry. -- I am trying to make a direct derivation from the specification given by R.Bird and P.Wadler... bmx alpha beta (T4 (n,[mov],(numberOfxs,numberOfos,nm)) []) = ([mov],max alpha (min numberOfxs beta)) bmx alpha beta (T4 (n,ls,(numberOfxs,numberOfos,nm)) (b:bs)) = (ls++mvT,val) where (mvT,val) = cmx alpha beta (b:bs) -- ...following Bird and Wadler... cmx alpha beta [] = ([],alpha) cmx alpha beta (b:bs) | alpha'== beta = ([],alpha') | otherwise = (ls++mvs,val) where (ls,val) = cmx alpha' beta bs (mvs,alpha') = negP (bmx (-beta) (-alpha) b) -- Use the following "best move" instead of bestMv bestMv' player pos level = bmx (-70) 70 (transTree (last (genTree player pos level)))

I suggest to use OpenGL to make an interface.

For future editing: Wikipedia