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