User talk:Mimoso
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
Othello (Reversi), by Mimoso. April 2011.
import Random
import List
data Element = O | X | E | L deriving (Eq,Show)
data TreeG = T Board [TreeG] deriving Show
type Board = [Element]
data TreeG1 = T1 (Element,Integer,Board,Int,Int) [TreeG1] deriving Show
data TreeG3 = T3 (Element, -- Player
Integer, -- Mov
Board, -- Position
(Int,Int,Int) -- (num Xs, num Os, num Movs)
) [TreeG3] deriving Show
data TreeG4 = T4 (Element, -- Player
[Integer], -- Mov
(Int,Int,Int) -- (num Xs, num Os, num Movs)
) [TreeG4] deriving Show
data MvVal = MvVal {mov::Integer, xs :: Int, os :: Int} deriving Show
--A board:
-- 11 12 13 14 15 16 17 18
-- 21 22 23 24 25 26 27 28
-- ... xy-10
-- ... xy-1<-xy ->xy+1
-- ... xy+10
-- 81 82 83 84 85 86 87 88
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]
numBoard::Int
numBoard= 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)]
sweep player (T1 (p,m,pos,n1,n2) []) = allVBasic player m pos
sweep player (T1 (p,m,pos,n1,n2) (c:cs)) =
T1 (player,m,pos,count X pos,count O pos)
(map (sweep (change player)) (c:cs))
genTree player pos n = take n (iterate (sweep player) (T1 (X,0,pos,2,2) []))
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:
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)))
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 functio as well as the search depth
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"
I suggest to use the OpenGL library to make an interface.
For future editing: Wikipedia