Implementing a simple greedy ai for reversi/othello - haskell

Quick disclaimer that this is for a homework task so rather than me placing any code I wanted to get conceptual help from you guys, maybe examples to help me understand. Essentially we have to implement an ai for reversi/othello and while minmax is the final goal, I wanted to start with a greedy algorithm.
Ok so the relevant definitions/functions:
GameState - this variable holds the boundaries of the board, who's turn it is, and the board (with a list of Maybe Player where Nothing means the tile is empty and Maybe Player1 or Player2 which means a piece is present for a player.
legalMoves - returns a list of all possible legal moves when given a GameState. Here a move is defined as a position (x,y)
applyMove - finally we have applyMove which takes a GameState and a move and returns a new Maybe GameState based on the new board after that move was played.
The final goal here is to create a function that when given a GameState, returns the best move
What I've done:
Firstly, I've created an evaluation function which returns the eval of any GameState
(eval :: GameState -> Int). So a heuristic.
From here I've had trouble. What I've tried to do is map the applyMove func to legalMoves to return a list of all possible future GameStates given a GameState. Then I mapped my eval func to the list of GameStates to get a list of Int's then I finally took the maximum of this list to get the best evaluation.
The problem is I'm not sure how to go back to the actual move from legalMoves that gave me that evaluation.

Your current pipeline looks like this:
GameState -> (GameState, [Move]) -> [GameState] -> [Int] -> Int
Make it look like this instead:
GameState -> (GameState, [Move]) -> [(Move, GameState)] -> [(Move, Int)] -> (Move, Int)
In other words: track the association between moves and function return values through the whole pipeline. Then it is easy to extract the Move at the end.

May I suggest a 10-liners with a MiniMax strategy: https://github.com/haskell-game/tiny-games-hs/blob/main/prelude/mini-othello/mini-othello.hs
The key is to use the trial play function:
-- | Trial play
(%) :: GameState -> Coordinate -> (GameState, Int)
(%) inGameState -> cor -> (outGameState, nFlips)
To create different game strategy function e:
-- | Strategy function!
e :: GameState -> GameState
This generates a sequence of [(nFlips, (x,y)), ...]
((,)=<<snd.(a%))&k r
-- | Naive strategy
e a=q a.snd.head.f((>0).fst).m((,)=<<snd.(a%)$k r
-------------------------------------------------
-- | Greedy strategy
e a=q a.snd.f(\c#(w,_)e#(d,_)->d>w?e$c)(0,(0,0)).m((,)=<<snd.(a%))$k r
-----------------------------------------------------------------------
-- | MiniMax strategy
i=fst;j=snd;
g h a=f(\c e->i e>i c?e$c)(-65*h,(0,0))$
(\((b,p),d)->(h*(h*p==0?j a`c`i b$i$g(div h(-2))b),d))&
(((,)=<<(a%))&k r);
e a=q a.j$g 4a
Because is a code golfing exercise, many symbols are involved here:
? a b c -- if' operator
& = map

Related

Implementing minimax by recursively folding

I'm writing a checkers AI for a standard 8*8 drafts version of the game.
The state is represented as a lens with lists of Coords representing the pieces on the board. What I am trying to do is follow this pseudo code for a Min-Max search.
function minimax(position, depth, maximizingPlayer)
if depth == 0 or game over in position
return static evaluation of position
if maximizingPlayer
maxEval = -infinity
for each child of position
eval = minimax(child, depth-1, False)
maxEval = max(maxEval, eval)
return maxEval
else
minEval = +infinity
for each child of position
eval = minimax(child, depth-1, true)
minEval = min(minEval, eval)
return minEval
By my understanding, in my case, position would be the GameState. So in my program, I would want to call minimax again on all children of the GameState, which would each just be a GameState with a move applied to it. Eventually I would hit depth 0 in which I would return a heuristic I have made a function to calculate. Where I am stuck is how to iterate through each possible GameState after a move. I have a function that calculates all possible moves that can be made from a specific GameState, but I'm stuck on how to iterate through all those moves, calling minimax with the new GameState resulting from the application of every one of the moves.
Going back to the pseudocode, I know that child will be a function call applyMove which takes in a Move and the current GameState, and returns a GameState with the new placement of pieces. Each "child" will be a different GameState resulting from different moves. I'm pretty new to Haskell and I know I'll probably need to use a fold for this. But I'm just stuck on how to write it, and I can't find many examples that I can easily relate to my situation. Any advice/tips are greatly appreciated.
The moves list would look something like this: [[(1,2),(2,3)],[(3,6),(2,7)]] and the child of a GameState would be a GameState after the application of a move, e.g
applyMove [(1,2),(2,3)] gameState.
You have a few functions already:
legalMoves :: Position -> [Move]
applyMove :: Position -> Move -> Position
I think your minimax would be cleaner with a different signature: instead of taking a Bool to decide whether to maximize or minimize, with different cases for each, it's simpler to always try to maximize, and vary the evaluation function instead, by flipping its sign at each step.
Once you have that, you don't really need to write a fold manually: just map recursive calls over each legal move, and glue them together with maximum to find the best move for the current player.
minimax :: (Position -> Int) -> Int -> Position -> Int
minimax eval 0 pos = eval pos
minimax eval n pos = case legalMoves pos of
[] -> eval pos
moves -> maximum . map negate
. map (minimax (negate . eval) (n - 1) . applyMove pos)
$ moves
Note that your specification makes it impossible to decide what move is the best, only what score you could get by making the best move. To find the best move, you'll want to make minimax return a tuple containing both the score and the move made to get there, or something of that sort.

Check and see if all elements of a list match a parameter

I want to make a function that checks to see if each row of the board for the Bert Bos puzzle is red one row at a time, but conceptually I'm having a hard time with this. Initially I make the board with all blue squares, but once the squares have been flipped with a flip function, the allRed function should be able to tell if the row is all red or not. Each row is represented by a list of colors, either Blue or Red
I know I should be using the all function, but I'm having some problems actually writing it out for my situation
Here is what I have so far:
generateboard :: Int -> [[Color]]
generateboard n = replicate n (replicate n Blue)
allRed :: [[Color]] -> Bool
let board = generateboard
allRed board = []
allRed board = all ([x:_ | x <- board, x == Red])
allRed board
There are many mistakes and misunderstandings here. I recommend reading any of the introductory Haskell materials to strengthen your basic understanding of the language. I will answer the question directly nonetheless.
generateboard looks great.
You are right to think all :: Foldable t => (a -> Bool) -> t a -> Bool will help us define allRed. If the type is confusing you can instead think of it as (a -> Bool) -> [a] -> Bool. The documentation says:
Determines whether all elements of the [list] satisfy the predicate.
To use all we need a predicate (a function) with type a -> Bool and a list of type [a]. We know what the predicate needs to be:
\x -> x == Red
Another way to write this is:
(==) Red
The predicate has type Color -> Bool and so our list must then have type [Color]. However, we have a list of type [[Color]]. There are two ways I can see to go about this.
The simpler idea is to observe that the board structure is irrelevant if all we care about is the cells. Therefore, we can flatten the structure with concat :: [[a]] -> [a]. Then our solution is thus:
allRed xs = all ((==) Red) (concat xs)
Which is also written:
allRed = all ((==) Red) . concat
Another solution is to observe that if all rows are red then the whole board must be red. This solution is:
allRed xs = all (all ((==) Red)) xs
Which is also written:
allRed = all (all ((==) Red))
First, the all function:
all :: (a -> Bool) -> [a] -> Bool
all p xs = ...
takes a function p representing a property and a list xs and tests if p x is true (i.e., if x has property p) for every element x of xs. (For example, all even [2,4,7] checks if all elements of the given list are even, and it returns False because even 7 equals False.) So, to use all, you need two arguments -- a list of items to check, and a function that checks one item.
Second, when faced with the problem of processing a data structure in Haskell (in this case [[Color]]), an excellent rule of thumb is to the deconstruct the structure from the outside in, using one function for each level of structure. You have an (outer) list of (inner) lists of colors, so start with the outer list, the list of rows.
How would you write a function that checks if all the rows in the outer list satisfy the property that they "contain only red colors"? Or, to put it more simply, how would you write this function using all if you already had a helper function redRow that expressed the property of a row having only red colors?
redRow :: [Color] -> Bool
redRow row = ...
If you can write allRed board using all, board, and redRow, you'll have reduced the problem to writing the definition of redRow, which operates on a simpler data structure, an (inner) list of colors.
To write redRow, you should likewise be able to use all again with a function expressing the property of a color being red:
isRed :: Color -> Bool
isRed col = ...
(or using an equivalent lambda or "section" directly).
In this case, another approach is possible, too -- you could use concat to "flatten" the outer and inner list together and then tackle the easier problem of checking if all colors in a big long list are red.

Moving piece across a board in Haskell

I'm working on a chess game in Haskell and I'm struggling with moving my pieces.
I understand that in functional programming, everything should be immutable, but I think I really need to have an updated list of pieces. I looked at monad.state but I'm having a hard time understanding it.
This is my list of pieces :
piecesList::[Piece]
piecesList = [Piece _type _color _coords, ..., ... Piece _type _color _coords]
And my approach for moving a piece from (old_x,old_y) to (new_x,new_y):
find the piece with (old_x,old_y) as coordinates in my list:
piece = getPiece (index_of (old_x old_y))
with
getPiece::Int->Piece
getPiece a = piecesList!!a
and
index_of :: (Int,Int)->Int
index_of (old_x, old_y) = fromJust $ findIndex piece piecesList
where
piece (Piece _ _ pos) = pos == (old_x, old_y)
update the coordinates of this particular piece:
moved = move (piece (new_x,new_y))
with
move::Piece->(Int,Int)->Piece
move piece (new_x,new_y) = piece { _position = (new_x,new_y) }
update the list of pieces with:
piecesList = updateBoard (index_of a b ) moved
with
updateBoard :: Int -> Piece -> Maybe [Piece]
updateBoard index newPiece = return board
where
(x,_:ys) = splitAt index piecesList
board = x ++ newPiece : ys
But still, it looks like my list of pieces is not updated.
Am I close to it? If so, what am I missing? Or is my approach completely wrong?
Thanks!
Edit
I'm using the following types:
data Piece = Piece {
_type :: PieceType,
_color :: PieceColor,
_position :: Position
} deriving Eq
data PieceColor = Black | White deriving Eq
data PieceType = Rook | Knight | Bishop | King | Queen | Pawn deriving Eq
type Position = (Int, Int)
it looks like my list of pieces is not updated.
Of course not: like everything in Haskell, the list of pieces is immutable, so it will never change under any circumstances.
With
piecesList = updateBoard (index_of a b ) moved
you merely define a new list of pieces, which also happens to be called pieces. GHCi and IHaskell allow this kind of shadowing (Haskell itself does not!), but it simply means that anything you define afterwards which refers to piecesList will use the new version. But getPiece and index_of already have already been defined before this “update”, and are completely oblivious to any new definitions you choose to come up with later on.
The most directly way to accomplish a task like this is to explicitly pass a modified version of the game state around. In fact updateBoard already goes that direction by giving an entire [Piece] list as the result. But you also need to use that updated state in the next step, rather than again the start state piecesList. Basically, if you just pass pieces as an argument to getPiece, index_of and updateBoard, you'll get the task done.
updateBoard :: Int -> Piece -> [Piece] -> [Piece] -- You don't seem to need `Maybe`
Note that this signature is parsed as
updateBoard :: Int -> Piece -> ([Piece] -> [Piece])
Now, it's a bit awkward, having to explicitly give the same old value to all kinds of helper functions. You already mention the state monad, which is indeed the standard thing to use here. Essentially, the state monad does the exact same thing: passing a value around as an argument to sub-functions. The only difference is that, if not told otherwise, it automatically uses always the same value.
You change the signature to
import Control.Monad.State
updateBoard :: Int -> Piece -> State [Piece] ()
Here, State [Piece] () is just a newtype wrapper for [Piece] -> ([Piece], ()). The () says that you don't give any interesting result information apart from the updated state. You could give other information too, and indeed need to in getPieces and indexOf:
getPiece :: Int -> State [Piece] Piece
indexOf :: (Int,Int) -> State [Piece] Int
Now as to how everything is actually written: do notation helps. Simply put the result in a return at the end, and obtain the old state with get. For example,
getPiece :: Int -> State [Piece] Piece
getPiece a = do
piecesList <- get
return $ piecesList!!a
The new state can simply be “put into the monad”:
updateBoard :: Int -> Piece -> State [Piece] ()
updateBoard index newPiece = do
piecesList <- get
let (x,_:ys) = splitAt index piecesList
put $ x ++ newPiece : ys

What structure should I use to express a turn in a board game?

I've got a working implementation of a Kalah solver, an application that calculates the optimal succession of moves on the first turn of the game.
I'm in the process of reimplementing this application, although this time with a test suite and (hopefully) prettier code that makes use of the more interesting structures like monoids or monads.
As you can see in the original code (or not, it's very convoluted and that's why I'm rewriting it) I've defined one "move" as follows:
I'm passing in a list of Pot as my board, along with a starting position on my side of the board.
I pick up and drop marbles until I get to the end of the list of Pot.
At the end of a "lap" I return the altered board ([Pot]), how many marbles I might be holding in my hand and an ADT expressing whether I should go for another lap or not (LapResult).
The thing is that I suspect that I wouldn't need to separate a move into laps if I expressed the board state with some clever data structure that I could both pass in as an input argument to a function and have that same data structure come out as a return value. At least that's my guess, my thought was that board state reminds me of what I've read about monoids.
So if I define one "move" as all the pick-up-and-drop-marbles until you land in an empty pot or in the store, is there some obvious way of rewriting the code for how a "move" works?
Current state of reimplementation can be found here.
Note: I have not tested any of this. Its probably buggy.
I think your problem is that you need to consider the board from two points of view, call them "White" and "Black".
data Player = White | Black
otherPlayer :: Player -> Player
otherPlayer White = Black
otherPlayer Black = White
The Mancala board is a circular structure, which suggests modular arithmentic. I'd suggest something like:
import Data.Vector -- More efficient version of Array
type PotNum = Int -- Use Int for simple index of pot position.
type Pot = Int -- Just record number of marbles in the pot.
You might get a more compact data structure by using Data.Word8 instead of Int, but I'm not sure. Keep it simple for the moment.
type Board = Vector Pot
Then have isStore be a simple function of PotNum and the player
isStore :: Player -> PotNum -> Bool
isStore White 0 = True
isStore Black 7 = True
isStore _ _ = False
You also want to move forwards around the board, skipping the other player's stores..
nextPot :: Player -> PotNum -> PotNum
nextPot White 6 = 8 -- Skip Black's store
nextPot White 13 = 0
nextPot Black 12 = 0 -- Skip White's store
nextPot _ n = n + 1
A list of the controlled pots for each player
playerPots :: Player -> [PotNum] -- Implementation omitted.
The number of marbles in a given pot
marblesIn :: PotNum -> Board -> Int -- Implementation omitted.
Now you can write a move function. We'll have it return Nothing for an illegal move.
move :: Player -> PotNum -> Board -> Maybe Board -- Implementation omitted.
Using the List monad you can make this produce all the potential moves and resulting board states
allMoves :: Player -> Board -> [(PotNum, Board)]
allMoves p b1 = do
n <- playerPots p
case move p n b1 of
Nothing -> fail "" -- List monad has this as []
Just b2 -> return (n, b2)
So now you can get the complete game tree from any starting position using Data.Tree.unfold, which takes a variant of the move function. This is slightly inelegant; we want to know the move that resulted in the position, but the initial position has no move leading to it. Hence the Maybe.
The unfoldTree function takes a function (f in the code below) which takes the current state and returns the current node and the list of child node values. The current state and the current node are both a triple of the player who just moved, the move they made, and the resulting board. Hence the first bit of "f". The second bit of "f" calls the "opponentMoves" function, which transforms the value returned by "allMoves" to add the right data.
unfoldGame :: Player -> Board -> Tree (Player, Maybe PotNum, Board)
unfoldGame p b = unfoldTree f (p, Nothing, b)
where
f (p1, n1, b1) = ((p1, n1, b1), opponentMoves (otherPlayer p1), b1
opponentMoves p2 b2 = map (\(n3, b3) -> (p2, Just n3, b3)) $ allMoves p2 b2
Now you just need to walk the tree. Each leaf is an end of the game because there are no legal moves left. The unfoldGame function is lazy so you only need the memory to hold the game states you are currently considering.

How can iterative deepening search implemented efficient in haskell?

I have an optimization problem I want to solve. You have some kind of data-structure:
data Foo =
{ fooA :: Int
, fooB :: Int
, fooC :: Int
, fooD :: Int
, fooE :: Int
}
and a rating function:
rateFoo :: myFoo -> Int
I have to optimize the result of rateFoo by changing the values in the struct. In this specific case, I decided to use iterative deepening search to solve the problem. The (infinite) search tree for the best optimization is created by another function, which simply applies all possible changes recursivly to the tree:
fooTree :: Foo -> Tree
My searching function looks something like this:
optimize :: Int -> Foo -> Foo
optimize threshold foo = undefined
The question I had, before I start is this:
As the tree can be generated by the data at each point, is it possible to have only the parts of the tree generated, which are currently needed by the algorithm? Is it possible to have the memory freed and the tree regenerated if needed in order to save memory (A leave at level n can be generated in O(n) and n remains small, but not small enough to have the whole tree in memory over time)?
Is this something I can excpect from the runtime? Can the runtime unevaluate expressions (turn an evaluated expression into an unevaluated one)? Or what is the dirty hack I have to do for this?
The runtime does not unevaluate expressions.
There's a straightforward way to get what you want however.
Consider a zipper-like structure for your tree. Each node holds a value and a thunk representing down, up, etc. When you move to the next node, you can either move normally (placing the previous node value in the corresponding slot) or forgetfully (placing an expression which evaluates to the previous node in the right slot). Then you have control over how much "history" you hang on to.
Here's my advice:
Just implement your algorithm in the
most straightforward way possible.
Profile.
Optimize for speed or memory use if necessary.
I very quickly learned that I'm not smart and/or experienced enough to reason about what GHC will do or how garbage collection will work. Sometimes things that I'm sure will be disastrously memory-inefficient work smoothly the first time around, and–less often–things that seem simple require lots of fussing with strictness annotations, etc.
The Real World Haskell chapter on profiling and optimization is incredibly helpful once you get to steps 2 and 3.
For example, here's a very simple implementation of IDDFS, where f expands children, p is the search predicate, and x is the starting point.
search :: (a -> [a]) -> (a -> Bool) -> a -> Bool
search f p x = any (\d -> searchTo f p d x) [1..]
where
searchTo f p d x
| d == 0 = False
| p x = True
| otherwise = any (searchTo f p $ d - 1) (f x)
I tested by searching for "abbaaaaaacccaaaaabbaaccc" with children x = [x ++ "a", x ++ "bb", x ++ "ccc"] as f. It seems reasonably fast and requires very little memory (linear with the depth, I think). Why not try something like this first and then move to a more complicated data structure if it isn't good enough?

Resources