Consider the next piece of code:
data Tile = EmptyTile | X | O
data Player = Player1 | Player2
instance Show Tile where
show EmptyTile = " "
show X = "X"
show O = "O"
data Board = (Tile, Tile, Tile, Tile, Tile, Tile, Tile, Tile, Tile)
emptyBoard :: Board
emptyBoard = (EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile)
instance Monad Board where
return x = x
f >>= x = x
I'd like that Board will be a monad. But the problem is that i get the following error -
[1 of 1] Compiling Main ( Main.hs, Main.o )
Main.hs:17:14: error:
Illegal binding of built-in syntax: (,,,,,,,,)
What needs to be changed so that Board can be defined later on as a monad
Every data constructor must have an unambiguous name, such as you gave with EmptyTile, X, O, Player1 and Player2. With Board, there is no such name; Haskell desugars this as
data Board = (,,,,,,,,) Tile Tile Tile Tile Tile Tile Tile Tile Tile
so here, (,,,,,,,,) would be the “constructor name”, but that's not actually legal in Haskell, thus the error.
Just choose a custom name, like boring
data Board = Board Tile Tile Tile Tile Tile Tile Tile Tile Tile
Now, this cannot possibly be a monad: a monad is foremostly a functor, i.e. something that's parameterised on some type and covariant in that parameter. You can make it a monad though, by replacing those hard-coded Tile fields with something polymorphic:
data Board t = Board t t t t t t t t t
deriving (Functor)
But the Applicative and Monad instances will look a bit more involved than what you proposed.
You might consider an approach like this: instead of hand-rolling the Board data structure, you define an indexing type:
data BoardIndex = Edge0 | Middle | Edge1
type Board t = (BoardIndex, BoardIndex) -> t
Then this will be a monad without any further definitions, namely the function monad, which has the semantics you probably want here. It tends to be a bit inefficient since results aren't actually stored but always recomputed on the spot, but for something like Tic Tac Toe that will hardly matter. (You can easily make it more efficient later, by introducing memoisation.)
You write data but mean type or newtype:
data Tile = EmptyTile | X | O
data Player = Player1 | Player2
instance Show Tile where
show EmptyTile = " "
show X = "X"
show O = "O"
type Board = (Tile, Tile, Tile, Tile, Tile, Tile, Tile, Tile, Tile)
emptyBoard :: Board
emptyBoard = (EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile)
-- this won’t work
instance Monad Board where
return x = x
f >>= x = x
Or
data Tile = EmptyTile | X | O
data Player = Player1 | Player2
instance Show Tile where
show EmptyTile = " "
show X = "X"
show O = "O"
newtype Board = Board (Tile, Tile, Tile, Tile, Tile, Tile, Tile, Tile, Tile)
emptyBoard :: Board
emptyBoard = Board (EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile,EmptyTile)
-- this also won’t work
instance Monad Board where
return x = x
f >>= x = x
It’s also worth noting that a board in a game of tic tax toe isn’t going to be a Monad. For one thing it would need a type parameter and for another thing it will obviously never satisfy the laws.
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)
I have a record type in my Haskell code to which I want to define a lens that can be used as a getter and as a setter. The code looks like this:
data Players = Players { _white :: Player
, _black :: Player
} deriving (Show, Eq)
makeLenses ''Players
_byColor :: Color -> Players -> Player
_byColor White = _white
_byColor Black = _black
byColor col = to (_byColor col)
Players is a record holding the white and the black player. I want to be able to get a player by color in a lens fashion. E.g.
players ^. byColor White . hp -- Access health-points of player
However, I also want to be able to set a property of a player chosen by color. E.g. within a state-monad holding a Game record with a _players field.
let current = White
players . byColor current . hp %= (-1)
With my current definition of byColor however the code fails to compile with the following error message:
No instance for (Contravariant Identity)
arising from a use of `byColor'
Possible fix:
add an instance declaration for (Contravariant Identity)
What am I doing wrong?
The to combinator only makes a getter, you haven't defined a full lens. However, defining the full lens is pretty straightforward, you just need to return the correct lens based on the color passed in:
byColor :: Color -> Lens' Players Player
byColor White = white
byColor Black = black
I am attempting to create a game engine that is composed of a few different types:
data Camera = Camera ...
data Light = SpotLight ... | DirectionalLight ...
data Object = Monster ... | Player ... | NPC ...
However, I'm now trying to implement basic physics for all of these entities. This requires that they each contain a pos :: (Double, Double, Double) and a velocity :: (Double, Double, Double).
In object oriented languages, I would implement it as something like:
Camera implements PhysicalObject
where PhysicalObject contains the two properties pos and velocity.
My immediate reaction was to place them all in the same type:
data Object = Monster ... | Player ... | NPC ... | Camera ...
However, I fear that this might make it tough to implement camera-specific functions, light-specific functions, etc. In reality, they have very little else in common other than the fact that they all possess a physical position and velocity in the world.
Is there a simpler way to do this than defining the two properties inside each type constructor?
I can think of two approaches - type classes and lenses.
Type classes
class PhysicalObject m where
position :: m -> (Double, Double, Double)
velocity :: m -> (Double, Double, Double)
You would then make instances for the objects along the following lines
data Camera = Camera
{ cameraPosition :: (Double,Double,Double)
, cameraVelocity :: (Double,Double,Double)
}
instance PhysicalObject Camera where
position = cameraPosition
cameraVelocity = cameraVelocity
and similarly for your other types. Then any function which doesn't need to know the details of an object can just require its arguments to be instances of PhysicalObject, for example:
type TimeInterval = Double
newPosition :: PhysicalObject m => TimeInterval -> m -> (Double,Double,Double)
newPosition dt obj = (x + du * dt, y + dv * dt, z + dw * dt)
where
(x,y,z) = position obj
(u,v,w) = velocity obj
However, you will struggle to write functions which modify your objects using this code - the class tells Haskell how it can access the position and velocity of an object, but not how to modify them.
Lenses
The other option is to turn to the lens library. This is a bit of a beast to being with, but it allows you to write some very natural code. First, there's a bit of boilerplate
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens
Now define some position and velocity data types. Don't worry about the weird field names prefixed with underscores - we won't be using them.
data Pos = Pos { _posX, _posY, _posZ :: Double }
data Vel = Vel { _velX, _velY, _velZ :: Double }
instance Show Pos where show (Pos x y z) = show (x,y,z)
instance Show Vel where show (Vel x y z) = show (x,y,z)
Now you use a bit of Template Haskell to derive lenses for your data types. This will generate type classes HasPos and HasVel whose methods allow you to access and modify any value that is an instance of those classes.
makeClassy ''Pos
makeClassy ''Vel
Now define your camera class, which includes a position and a velocity.
data Camera = Camera
{ _cameraPos :: Pos
, _cameraVel :: Vel } deriving (Show)
Another bit of Template Haskell will automatically create functions cameraPos and cameraVel that allow you to access and modify the position and velocity of your camera.
makeLenses ''Camera
Finally, declare that your camera is an instance of both the HasPos and HasVel classes, with a default implementation of their methods.
instance HasPos Camera where pos = cameraPos
instance HasVel Camera where vel = cameraVel
Now we're ready to do some real work. Let's define an example camera
camera = Camera (Pos 0 0 0) (Vel 10 5 0)
A function to modify the camera, returning a new one with an updated position, is
move :: (HasPos a, HasVel a) => TimeInterval -> a -> a
move dt obj = obj
& posX +~ dt * obj^.velX
& posY +~ dt * obj^.velY
& posZ +~ dt * obj^.velZ
Note that this is a completely generic function for moving any object that has a position and velocity - it's not at all specific to the Camera type. It also has the advantage of looking a lot like imperative code!
If you now load all this into GHCI, you can see it in action
>> camera
Camera {_cameraPos = (0.0,0.0,0.0), _cameraVel = (10.0,5.0,0.0)}
>> move 0.1 camera
Camera {_cameraPos = (1.0,0.5,0.0), _cameraVel = (10.0,5.0,0.0)}
I would implement it similar to:
type Position = (Double, Double, Double)
type Velocity = (Double, Double, Double)
class PhysicalObject a where
pos :: a -> Position
velocity :: a -> Velocity
data Camera = Camera
{ camPos :: Position
, camVel :: Velocity
} deriving (Eq, Show)
instance PhysicalObject Camera where
pos = camPos
velocity = camVel
Then you can do similarly for each type you define that needs PhysicalObject.
You'll want to begin to depend on things like typeclasses and object encodings. The first method is to encode the common interface as a typeclass each type inherits from.
class PhysicalObject o where
pos :: o -> Vector3
velocity :: o -> Vector3
The second is to build a common object
data PhysicalObject = PhysicalObject { poPos :: Vector3, poVelocity :: Vector3 }
data Monster = Monster { monsterPO :: PhysicalObject
, ... monsterStuff ...
}
which could even be used to instantiate the first typeclass
instance PhysicalObject PhysicalObject where
pos = poPos
velocity = poVelocity
instance PhysicalObject Monster where
pos = pos . monsterPO
velocity = velocity . monsterPO
Be careful with typeclass encodings like this, though, as too great a use of them often causes ambiguity when reading code. It can be difficult to understand the types and know which instance is being used.
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.
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