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.
Related
I am fairly new to Haskell and trying to create a game board of the game Reversi (Othello). Thereafter, I want to use this to return a starting Player and the initial starting position of the board. So two issues.
Generate game plan
I have two data types for the different Players and possible moves to make.
data Player = Black | White
deriving (Eq,Show)
{- Game moves.
Pass represents a passing move. Move i represents a move to field i.
INVARIANT: 0 <= i <= 63 in Move i
-}
data Move = Pass | Move Int
deriving (Eq,Show)
My initial idea was to create an Associated list (dictionary) where each key value pair makes up a field on the board. So the key would be (0...63) and the values could be Black/White or empty. However, the Player data type cannot be modified to include e.g, Empty.
To play the game, I need to create a function that returns which player that starts and the initial board. The starting position should look like this:
So I was thinking I could use Haskell's built in Data.Map to create an empty board and then create the initial position and then union these two to obtain a complete game board with the starting position.
fields :: [Integer]
fields = [x | x <- [1 .. 63]]
type Field = Maybe Player
emptyBoard :: Data.Map.Map Integer (Maybe a)
emptyBoard = Data.Map.fromList (zip fields (repeat Nothing))
startBoard =
Data.Map.fromList
[ (27, White),
(36, White),
(28, Black),
(35, Black)
]
initialBoard = Data.Map.union startBoard emptyBoard
Following this way of thinking about the board:
However, when running this in the Prelude, I get:
<interactive>:42:45: error:
* Couldn't match type `Maybe a0' with `Player'
Expected type: Data.Map.Internal.Map k Player
Actual type: Data.Map.Internal.Map k (Maybe a0)
* In the second argument of `Data.Map.Internal.union', namely
`emptyBoard'
In the expression: Data.Map.Internal.union startBoard emptyBoard
In an equation for `initialBoard':
initialBoard = Data.Map.Internal.union startBoard emptyBoard
How can I go about creating an emptyBoard with the same type as in startBoard?
Initial position
My second issue is to create a state of the game. So, something like this.
-- Board consists of tuples with integers and Player or empty
data Board = Board [(Integer, Field)]
-- type State = () is required to be a type synonym
type State = (Player, Board)
So that when creating my function to generate the initial game, with something like this:
initial :: Player -> State
initial p = if p == Black then (Black, initialBoard) else (White, initialBoard)
The type declaration of initial cannot be changed. Nevertheless, I get a warning from the intellisense:
• Couldn't match expected type ‘Board’
with actual type ‘Data.Map.Map k0 Player’
• In the expression: initialBoard
So, in summary. 1) how can I generate a startBoard with only the middle fields populated and the rest empty and 2), the initial game plan with a player and the boards starting position.
how can I generate a startBoard with only the middle fields populated and the rest empty
The startBoard you wrote works perfectly for that. Don't overthink things. Throw away emptyBoard and initialBoard entirely. Representing empty squares by simply not having that key in the Map is going to be simpler than having an explicit key that maps to Nothing anyway.
how can I generate the initial game plan with a player and the boards starting position
Ya just tuple 'em up.
type State = (Player, Map Integer Player)
initial :: Player -> State
initial p = (p, startBoard)
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
How do I avoid space leaks while using foldM and mapM over a State monad?
Last year's Advent of Code day 20 has a puzzle of generating a map of a maze from instructions on how to walk across it. For instance, the instructions NN gives the maze
|
|
*
(a straight corridor two steps northwards), and the instructions NNN(EE|WW)S gives the maze
+-+-+
| | |
|
*
(go north a bit, then either go east then south or west then south).
The way I'm trying to solve this involves having a State monad, where the state is the Set of all the corridor sections (termed Doors below), and the value is the list of positions you could be working from.
If you're just following a corridor Path, I use foldM to walk along it, updating the current position. If you're at a junction, follow each branch of the junction and collect all the positions you end up.
This code produces the correct results on small test inputs, but there's a huge space leak when working on the full example.
Profiling indicates it's spending most of its time in includeDoor.
So, questions.
Is there a space leak? If so, where, and how can you tell.
How do I fix it?
(I think what's happening is that Haskell isn't strictly adding fully-evaluated Doors to the Set as soon as it can. In this case, I don't want any laziness anywhere.)
(I parse the input into a bunch of two-element vectors that indicate the step to take for each instruction. That code works fine, and quickly.)
import qualified Data.Set as S
import Linear (V2(..))
import Control.Monad.State.Strict
import Control.Monad.Extra (concatMapM)
type Coord = V2 Integer -- x, y, with north and east incresing values (origin a bottom left)
data Door = Door Coord Coord deriving (Show, Eq, Ord)
type Doors = S.Set Door
data MazeSection = Path [Coord] | Junction [Maze] deriving (Show, Eq)
type Maze = [MazeSection]
type Mapper = State Doors [Coord]
makeDoor :: Coord -> Coord -> Door
makeDoor !a !b
| a < b = Door a b
| otherwise = Door b a
emptyMap = S.empty
part1 maze =
do
let start = V2 0 0
let doors = execState (mapMaze [start] maze) emptyMap
print $ length doors
mapMaze :: [Coord] -> Maze -> Mapper
mapMaze !starts !sections =
foldM (\heres section -> mapMazeSection heres section) starts sections
mapMazeSection :: [Coord] -> MazeSection -> Mapper
mapMazeSection !starts (Junction mazes) =
concatMapM (\maze -> mapMaze starts maze) mazes
mapMazeSection !starts (Path steps) =
mapM mapPath starts
where mapPath start = foldM (\here step -> includeDoor here step) start steps
includeDoor :: Coord -> Coord -> State Doors Coord
includeDoor !here !step =
do let there = (here + step)
let door = there `seq` makeDoor here there
modify' (door `seq` S.insert door)
return there
Space leaks can be very hard to detect in Haskell. I am no expert, but I have heard there are many problems with the State monad and space leaks. I generally avoid State/StateT and use IORef, MVar or TVar instead, but that would change it to IO. The first thing you can try is adding ! in various let bindings and type definitions.
data Door = Door !Coord !Coord
data Maze = Path ![Coord] | Junction ![Maze]
If that doesn't resolve it, there are some tools that may help you pinpoint where it occurs in this article.
Other resources
Here are some other resources that might help.
ndmithcell on space leak detection
Space leak with nested strict StateT
Pinpointing space leaks in big programs
Turns out, it wasn't a space leak! It was me failing to deal with some pathological input. Once I sorted out how to handle that, it worked, and very quickly.
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.
I'm trying to create a function that recursively plays all possible games of tic-tac-toe using a genetic algorithm, and then returns a tuple of (wins,losses,ties). However, the function below always overflows the stack when called like this:
scoreOne :: UnscoredPlayer -> [String] -> ScoredPlayer
scoreOne player boards = ScoredPlayer (token player) (chromosome player) (evaluateG $! testPlayer player boards)
...
let results = map (\x->scoreOne x boards) players
print (maximum results)
where players is a list of chromosomes. The overflow doesn't occur with only 1 player, but with two it happens.
EDIT: If the function is called in the following way, it does not overflow the stack.
let results = map (\player -> evaluateG (testPlayer player boards)) players
print (maximum results)
However, the following way does overflow the stack.
let results = map (\player -> ScoredPlayer (token player) (chromosome player) (evaluateG $! testPlayer player boards)) players
For reference, ScoredPlayer is defined as (the string is the player token, [Int] is the chromosome, and Float is the score):
data ScoredPlayer = ScoredPlayer String ![Int] !Float deriving (Eq)
From what I know of Haskell, the playAll' function isn't tail-recursive because the foldl' call I'm using is performing further processing on the function results. However, I have no idea how to eliminate the foldl' call, since it's needed to ensure all possible games are played. Is there any way to restructure the function so that it is tail-recursive (or at least doesn't overflow the stack)?
Thanks in advance, and sorry for the massive code listing.
playAll' :: (Num a) => UnscoredPlayer -> Bool -> String -> [String] -> (a,a,a) -> (a,a,a)
playAll' player playerTurn board boards (w,ls,t)=
if won == self then (w+1,ls,t) -- I won this game
else
if won == enemy then (w,ls+1,t) -- My enemy won this game
else
if '_' `notElem` board then (w,ls,t+1) -- It's a tie
else
if playerTurn then --My turn; make a move and try all possible combinations for the enemy
playAll' player False (makeMove ...) boards (w,ls,t)
else --Try each possible move against myself
(foldl' (\(x,y,z) (s1,s2,s3) -> (x+s1,y+s2,z+s3)) (w,ls,t)
[playAll' player True newBoard boards (w,ls,t)| newBoard <- (permute enemy board)])
where
won = winning board --if someone has one, who is it?
enemy = (opposite.token) player --what player is my enemy?
self = token player --what player am I?
The foldl' function is tail-recursive, the problem is that it's not strict enough. This is the problem Don Stewart mentions in his comment.
Think of Haskell data structures as lazy boxes, where every new constructor makes a new box. When you have a fold like
foldl' (\(x,y,z) (s1,s2,s3) -> (x+s1,y+s2,z+s3))
the tuples are one box, and each element within them are another box. The strictness from foldl' only removes the outermost box. Each element within the tuple is still in a lazy box.
To get around this you need to apply deeper strictness to remove the extra boxes. Don's suggestion is to make
data R = R !Int !Int !Int
foldl' (\(R x y z) (s1,s2,s3) -> R (x+s1) (y+s2) (z+s3))
Now the strictness of foldl' is sufficient. The individual elements of R are strict, so when the outermost box (the R constructor) is removed, the three values inside are evaluated as well.
Without seeing more code that's about all I can provide. I wasn't able to run this listing so I don't know if this solves the problem or if there are other issues in the full program.
As a point of style, instead of nested if's you may prefer the following:
playAll' player playerTurn board boards (w,ls,t)=
case () of
_ | won == self -> (w+1,ls,t) -- I won this game
_ | won == enemy -> (w,ls+1,t) -- My enemy won this game
_ | '_' `notElem` board -> (w,ls,t+1) -- It's a tie
_ -> ... --code omitted