Personal tools

User talk:Mimoso

From HaskellWiki

(Difference between revisions)
Jump to: navigation, search
(Othello (Reversi), by Mimoso. April 2011.)
(learning the wiki, i think)
Line 1: Line 1:
== Othello (Reversi), by Mimoso. April 2011. ==
+
testing testing
 
 
<haskell>
 
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
 
</haskell>
 
 
--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: [http://www.wikipedia.org Wikipedia]
 
[[Category:Programming]]
 
[[Category:Games]]
 
[[Category:Artificial Intelligence]]
 

Revision as of 22:12, 15 November 2011

testing testing