I am trying to program a cost function in Haskell, but it seems I overestimated the capabilities of patter matching. This is the code I have already defined:
-- Directions for the movement
data Direction = North | East | West | South deriving (Show, Eq)
-- An `Action` gets a Coord and returns another Coord if possible
type Action = Coord -> Maybe Coord
-- Move function; `move North` is an Action
move :: Direction -> Action
move d (x, y) = ...
My main problem is that now I have to define a Cost function such that:
type Cost = Coord -> Action -> Double
In case I wanted to have a simple cost function that only checks the direction to return a cost, the first idea that came to my mind was taking advantage of pattern matching, but this is invalid syntax (and to be honest, it seems quite fair):
mazeCost :: Cost
mazeCost (x, y) (move East) = 3
mazeCost (x, y) (move West) = 5
-- ... And on and on
My current solution involves computing the destination state and comparing that to the result of each action to check if that is the function that is being passed as an argument, but that seems hacky, not super brief and I think that maybe there is a much better way to do it in Haskell:
mazeCost :: Cost
mazeCost coord action
| destination == east = 1
| destination == west = 2
| destination == north = 3
| destination == south = 0
where destination = action coord
east = move East coord
west = move West coord
south = move South coord
north = move North coord
Is there a better way to associate a function (Coord -> Direction -> Maybe Coord) with a cost value (Double)? This is a minimal example I tried to write, if there are any inconsistencies in the example code or something is not clear, please ask.
You're almost there, you just need ViewPatterns
{-# LANGUAGE ViewPatterns ... #-}
...
move ((x,y), d) = ... Just (d,...) ...
moveCost = curry moveCost' where
moveCost' (move -> Just (East, (x,y))) = ...
moveCost' (move -> Just (West, (x,y))) = ...
Note that we changed the type of move here. View patterns only work with single argument functions that return a pattern we can actually match on, so it has to be passed ((x,y),d) as a tuple, which means moveCost' must accept a tuple, but we can just curry it with a wrapper function.
Cost takes a Coord and an Action. However, since actions need a coord and a direction and there's no direction in scope, you can't actually use the action. You need to apply the action to a coordinate and a direction in order to get a value. So the only implementations of mazeCost are ones that ignore the action entirely, which is not what you want.
However, if you had a direction in scope somehow then you could apply it (and the coord) to the action. One way to do this is through currying. A function Direction -> Costis a function that takes a direction and gives a cost function for that direction.
mazeCost :: Direction -> Cost
mazeCost dir coord act = case act coord dir of
Just (x', y') -> 0 -- or whatever the cost is
Nothing -> 0 -- or whatever the cost is
I think this is a nice illustration of the idea that partial application is similar to introducing a closure: mazeCost East is a function that closes over the Direction East and gives a Cost for that direction.
I should also note that I don't see how your proposed solution can typecheck. If type Action = Coord -> Direction -> Maybe Coord, which you did not specify, then the expression action coord is a function of type Direction -> Maybe Coord, and not a 'destination'. If I have misunderstood and it does typecheck then it is still a partial function that will cause a runtime error if the action is not equivalent to a simple move in one of the Directions, as luqui implied.
Related
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'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 come from an imperative background and am trying to implement a simple disjoint sets (“union-find”) data structure to get some practice with creating and modifying (persistent) data structures in Haskell. The goal is to have a simple implementation, but I am also concerned about efficiency, and my question is related to this.
First, I created a disjoint-set forest implementation with union by rank and started by defining a data type for a “point”:
data Point = Point
{ _value :: Int
, _parent :: Maybe Point
, _rank :: Int
} deriving Show
A disjointed set forest is an IntMap with Int → Point mappings:
type DSForest = IntMap Point
empty :: DSForest
empty = I.empty
A singleton set is simply a mapping from its value x to a Point with value x, no parent and a rank of 1:
makeSet :: DSForest -> Int -> DSForest
makeSet dsf x = I.insert x (Point x Nothing 0) dsf
Now, the interesting part – union. This operation will modify a point by setting the other point as its parent (and in some cases change its rank). In the case where the Points' rank are different, the Point is simply “updated” (a new Point is created) to have its parent point to the other. In the case where they are equal, a new Point is created with its rank increased by one:
union :: DSForest -> Int -> Int -> DSForest
union dsf x y | x == y = dsf
union dsf x y =
if _value x' == _value y'
then dsf
else case compare (_rank x') (_rank y') of
GT -> I.insert (_value y') y'{ _parent = Just x' } dsf
LT -> I.insert (_value x') x'{ _parent = Just y' } dsf
-- 1) increase x's rank by one:
EQ -> let x'' = x'{ _rank = _rank x' + 1 }
-- 2) update the value for x's rank to point to the new x:
dsf' = I.insert (_value x'') x'' dsf
-- 3) then update y to have the new x as its parent:
in I.insert (_value y') y'{ _parent = Just x'' } dsf'
where x' = dsf ! findSet dsf x
y' = dsf ! findSet dsf y
Now, to my real question, if in the EQ case I had instead done the following:
EQ -> let dsf' = I.insert (_value x') x'{ _rank = _rank x' + 1} dsf
in I.insert (_value y') y'{ _parent = Just x'{ _rank = _rank x' + 1 }} dsf'
I.e. first insert a new Point x with its rank increased, and then having y''s parent be a new Point x with its rank increased, would this mean that they no longer point to the same Point in memory? (Does this even matter? Should I worry about these things when using/creating persistent data structures?)
And just for completeness, here is findSet:
findSet :: DSForest -> Int -> Int
findSet dsf' x' = case _parent (dsf' ! x') of
Just (Point v _ _) -> findSet dsf' v
Nothing -> x'
(General comments about the efficiency and design of this code are also welcome.)
would this mean that they no longer point to the same Point in memory?
I don't think you should be concerned with this as this is just an implementation detail of the runtime system (aka RTS of Haskell) for immutable values.
As far as other suggestion is concerned, I would say make the function findSet return the Point itself rather than the key as that would eliminate the lookup in union.
findSet :: DSForest -> Int -> Point
findSet dsf' x' = case _parent pt of
Just (Point v _ _) -> findSet dsf' v
Nothing -> pt
where
pt = (dsf' ! x')
Make appropriate changes in the union function.
First comment: the disjoint-set union-find data structure is very, very difficult to do well in a purely functional way. If you are just trying to get practice with persistent data structures, I strongly recommend starting with simpler structures like binary search trees.
Now, to see one problem, consider your findSet function. It does not implement path compression! That is, it does not make all the nodes along the path to the root point directly to the root. To do that, you would want to update all those points in the DSForest, so your function would then return (Int, DSForest) or perhaps (Point, DSForest). Doing this in a monad to handle all the plumbing of passing the DSForest around be easier than passing that forest around manually.
But now a second issue. Suppose you modify findSet as just described. It still wouldn't do quite what you want. In particular, suppose you have a chain where 2 is a child of 1, 3 is a child of 2, and 4 is a child of 3. And now you you do a findSet on 3. This will update 3's point so that its parent is 1 instead 2. But 4's parent is still the old 3 point whose parent is 2. This may not matter too much, because it looks like you never really do anything with the parent Point except pull out its value (in findSet). But the very fact that you never do anything with the parent Point except pull out its value says to me that it should be a Maybe Int instead of a Maybe Point.
Let me repeat and expand on what I said at the beginning. Disjoint sets are a particularly hard data structure to handle in a functional/persistent way, so I strongly recommend starting with an easier tree structure like binary search trees or leftist heaps or even abstract syntax trees. Those structures have the property that all access goes through the root--that is, you always start at the root and work your way down through the tree to get to the right place. This property makes the kind of sharing that is the hallmark of persistent data structures MUCH easier.
The disjoint set data structure does not have that property. Instead of always starting at the root and working down to the nodes of interest, you start at arbitrary nodes and work your way back up to the root. When you have unrestricted entry points like this, often the easiest way to handle it is to mediate all the sharing through a separate map (DSForest in your case), but that means passing that map back and forth everywhere.
Sharing is a compiler thing. When it recognizes common sub-expressions, a compiler may chose to represent them both by the same object in memory. But even if you use such a compiler switch (like -fno-cse), it is under no obligation to do so, and the two might be (and usually are, in the absence of the switch) represented by two different, though of equal value, objects in memory. Re: referential transparency.
OTOH when we name something and use that name twice, we (reasonably) expect it to represent the same object in memory. But compiler might choose to duplicate it and use two separate copies in two different use sites, although it is not known to do so. But it might. Re: referential transparency.
See also:
How is this fibonacci-function memoized?
double stream feed to prevent unneeded memoization?
Here's few examples with list-producing functions, drawing from the last link above. They rely on the compiler not duplicating anything, i.e. indeed sharing any named object as expected from call by need lambda calculus operational semantics (as explained by nponeccop in the comments), and not introducing any extra sharing on its own to eliminate common subexpressions:
Sharing fixpoint combinator, creating a loop:
fix f = x where x = f x
Non-sharing fixpoint combinator, creating telescoping multistage chain (i.e. regular recursion chain)
_Y f = f (_Y f)
Two-stages combination - a loop and a feed
_2 f = f (fix f)
I'm trying to implement turtle graphics in Haskell. The goal is to be able to write a function like this:
draw_something = do
forward 100
right 90
forward 100
...
and then have it produce a list of points (maybe with additional properties):
> draw_something (0,0) 0 -- start at (0,0) facing east (0 degrees)
[(0,0), (0,100), (-100,100), ...]
I have all this working in a 'normal' way, but I've failed to implement it as a Haskell Monad and use the do-notation. The basic code:
data State a = State (a, a) a -- (x,y), angle
deriving (Show, Eq)
initstate :: State Float
initstate = State (0.0,0.0) 0.0
-- constrain angles to 0 to 2*pi
fmod :: Float -> Float
fmod a
| a >= 2*pi = fmod (a-2*pi)
| a < 0 = fmod (a+2*pi)
| otherwise = a
forward :: Float -> State Float -> [State Float]
forward d (State (x,y) angle) = [State (x + d * (sin angle), y + d * (cos angle)) angle]
right :: Float -> State Float -> [State Float]
right d (State pos angle) = [State pos (fmod (angle+d))]
bind :: [State a] -> (State a -> [State a]) -> [State a]
bind xs f = xs ++ (f (head $ reverse xs))
ret :: State a -> [State a]
ret x = [x]
With this I can now write
> [initstate] `bind` (forward 100) `bind` (right (pi/2)) `bind` (forward 100)
[State (0.0,0.0) 0.0,State (0.0,100.0) 0.0,State (0.0,100.0) 1.5707964,State (100.0,99.99999) 1.5707964]
And get the expected result. However I can't make this an instance of Monad.
instance Monad [State] where
...
results in
`State' is not applied to enough type arguments
Expected kind `*', but `State' has kind `* -> *'
In the instance declaration for `Monad [State]'
And if I wrap the list in a new object
data StateList a = StateList [State a]
instance Monad StateList where
return x = StateList [x]
I get
Couldn't match type `a' with `State a'
`a' is a rigid type variable bound by
the type signature for return :: a -> StateList a
at logo.hs:38:9
In the expression: x
In the first argument of `StateList', namely `[x]'
In the expression: StateList [x]
I tried various other versions but I never got it to run as I'd like to. What am I doing wrong? What do I understand incorrectly?
The monad you're devising needs to have two type parameters. One for the saved trail (which will be fixed for a particular do sequence) and other for the results of computations.
You also need to think about how to compose two turtle-monadic values so that the binding operation is associative. For example,
right 90 >> (right 90 >> forward 100)
must be equal to
(right 90 >> right 90) >> forward 100
(and of course similarly for >>= etc.). This means that if you represent the turtle's history by a list of points, the binding operation most likely just cannot append the lists of points together; forward 100 alone will result in something like [(0,0),(100,0)] but when it's prepended with rotation, the saved points need to be rotated too.
I'd say that the simplest approach would be to use the Writer monad. But I wouldn't save the points, I'd save just the actions the turtle performs (so that we don't need to rotate the points when combining the values). Something like
data Action = Rotate Double | Forward Double
type TurtleMonad a = Writer [Action] a
(This also means that we don't need to track the current direction, it's contained in the actions.) Then each of your functions just writes its argument into the Writer. And at the end, you can extract the final list from it and make a simple function that converts all the actions into a list of points:
track :: [Action] -> [(Double,Double)]
Update: Instead of using [Action] it would be better to use Seq from Data.Sequence. It's also a monoid and concatenating two sequences is very fast, it's amortized complexity is O(log(min(n1,n2))), compared to O(n1) of (++). So the improved type would be
type TurtleMonad a = Writer (Seq Action) a