Difference between revisions of "User talk:Mimoso"
Jump to navigation
Jump to search
(learning the wiki, i think) |
Geheimdienst (talk | contribs) |
||
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 12:27, 16 November 2011
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