Board.hs 3.01 KB
Newer Older
1
{-# LANGUAGE BangPatterns #-}
2 3 4 5
module Board where

import Wins

6
import Data.List
7 8
import Control.Parallel
import Control.Parallel.Strategies
9

10 11
boardDim = 4

12 13
type Board = [Row] 
type Row = [Piece]
14
data Piece = X | O | Empty deriving (Eq,Show)
15

16 17
isEmpty Empty = True
isEmpty _     = False
18

19 20 21
showBoard :: Board -> String
showBoard board = intercalate "\n--------\n" (map showRow board) ++ "\n"
 where showRow r = intercalate "|" (map showPiece r)
22 23 24 25 26 27

showPiece :: Piece -> String
showPiece X = "X"
showPiece O = "O"
showPiece Empty = " "

28 29 30 31 32
placePiece :: Piece -> Board -> (Int,Int) -> Board
placePiece new board pos
  = [[ if (x,y) == pos then new else old
     | (x,old) <- zip [1..] row ]
     | (y,row) <- zip [1..] board ]
33 34

empty :: (Int,Int) -> Board -> Bool
35
empty (x,y) board = isEmpty ((board !! (y-1)) !! (x-1))
36

37
fullBoard b = all (not.isEmpty) (concat b)
38

39 40 41 42
newPositions :: Piece -> Board -> [Board]
newPositions piece board = 
--  [ placePiece piece board (x,y) | (x,y) <- empties board ]
    goRows piece id board
43

44 45 46
goRows p rowsL [] = []
goRows p rowsL (row:rowsR) 
  = goRow p rowsL id row rowsR ++ goRows p (rowsL . (row:)) rowsR
47

48 49 50 51 52 53 54
goRow p rowsL psL [] rowsR = []
goRow p rowsL psL (Empty:psR) rowsR
    = (rowsL $ (psL $ (p:psR)) : rowsR) : goRow p rowsL (psL . (Empty:)) psR rowsR
goRow p rowsL psL (p':psR) rowsR = goRow p rowsL (psL . (p':)) psR rowsR

empties board = [ (x,y) | (y,row)   <- zip [1..] board,
                          (x,Empty) <- zip [1..] row ]
55

56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82

initialBoard :: Board
initialBoard = replicate boardDim (replicate boardDim Empty)

data Evaluation = OWin | Score {-# UNPACK #-}!Int | XWin
  -- higher scores denote a board in X's favour
  deriving (Show,Eq)

maxE :: Evaluation -> Evaluation -> Evaluation
maxE XWin _ = XWin
maxE _ XWin = XWin
maxE b OWin = b
maxE OWin b = b
maxE a@(Score x) b@(Score y) 	| x>y = a
			 	| otherwise = b

minE :: Evaluation -> Evaluation -> Evaluation
minE OWin _ = OWin
minE _ OWin = OWin
minE b XWin = b
minE XWin b = b
minE a@(Score x) b@(Score y) 	| x<y = a
				| otherwise = b

eval n | n  == boardDim = XWin
       | -n == boardDim = OWin
       | otherwise      = Score n
83 84

static :: Board -> Evaluation
85
static board = interpret 0 (score board)
86 87 88 89 90 91 92

interpret :: Int -> [Evaluation] -> Evaluation
interpret x [] = (Score x)
interpret x (Score y:l) = interpret (x+y) l
interpret x (XWin:l) = XWin
interpret x (OWin:l) = OWin

93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
scorePiece X     = 1
scorePiece O     = -1
scorePiece Empty = 0

scoreString !n [] = n
scoreString !n (X:ps)     = scoreString (n+1) ps
scoreString !n (O:ps)     = scoreString (n-1) ps
scoreString !n (Empty:ps) = scoreString n ps

score :: Board -> [Evaluation]
score board = 
   [ eval (scoreString 0 row) | row <- board ] ++
   [ eval (scoreString 0 col) | col <- transpose board ] ++
   [ eval (scoreString 0 (zipWith (!!) board [0..])),
     eval (scoreString 0 (zipWith (!!) board [boardDim-1,boardDim-2 ..])) ]
108 109 110 111 112 113 114 115 116

{-
#if 0
-- This looks very much like a zipWith f to me
map2 :: (a -> b -> c) -> [a] -> [b] -> [c]
map2 f [] x = []
map2 f x [] = []
map2 f (x:xs) (y:ys) = f x y:map2 f xs ys
#endif
117
-}