Related
I'm trying to make what I think is called an Ulam spiral using Haskell.
It needs to go outwards in a clockwise rotation:
6 - 7 - 8 - 9
| |
5 0 - 1 10
| | |
4 - 3 - 2 11
|
..15- 14- 13- 12
For each step I'm trying to create coordinates, the function would be given a number and return spiral coordinates to the length of input number eg:
mkSpiral 9
> [(0,0),(1,0),(1,-1),(0,-1),(-1,-1),(-1,0),(-1,1),(0,1),(1,1)]
(-1, 1) - (0, 1) - (1, 1)
|
(-1, 0) (0, 0) - (1, 0)
| |
(-1,-1) - (0,-1) - (1,-1)
I've seen Looping in a spiral solution, but this goes counter-clockwise and it's inputs need to the size of the matrix.
I also found this code which does what I need but it seems to go counterclock-wise, stepping up rather than stepping right then clockwise :(
type Spiral = Int
type Coordinate = (Int, Int)
-- number of squares on each side of the spiral
sideSquares :: Spiral -> Int
sideSquares sp = (sp * 2) - 1
-- the coordinates for all squares in the given spiral
coordinatesForSpiral :: Spiral -> [Coordinate]
coordinatesForSpiral 1 = [(0, 0)]
coordinatesForSpiral sp = [(0, 0)] ++ right ++ top ++ left ++ bottom
where fixed = sp - 1
sides = sideSquares sp - 1
right = [(x, y) | x <- [fixed], y <- take sides [-1*(fixed-1)..]]
top = [(x, y) | x <- reverse (take sides [-1*fixed..]), y <- [fixed]]
left = [(x, y) | x <- [-1*fixed], y <- reverse(take sides [-1*fixed..])]
bottom = [(x, y) | x <- take sides [-1*fixed+1..], y <- [-1*fixed]]
-- an endless list of coordinates (the complete spiral)
mkSpiral :: Int -> [Coordinate]
mkSpiral x = take x endlessSpiral
endlessSpiral :: [Coordinate]
endlessSpiral = endlessSpiral' 1
endlessSpiral' start = coordinatesForSpiral start ++ endlessSpiral' (start + 1)
After much experimentation I can't seem to change the rotation or starting step direction, could someone point me in the right way or a solution that doesn't use list comprehension as I find them tricky to decode?
Let us first take a look at how the directions of a spiral are looking:
R D L L U U R R R D D D L L L L U U U U ....
We can split this in sequences like:
n times n+1 times
_^_ __^__
/ \ / \
R … R D … D L L … L U U … U
\_ _/ \__ __/
v v
n times n+1 times
We can repeat that, each time incrementing n by two, like:
data Dir = R | D | L | U
spiralSeq :: Int -> [Dir]
spiralSeq n = rn R ++ rn D ++ rn1 L ++ rn1 U
where rn = replicate n
rn1 = replicate (n + 1)
spiral :: [Dir]
spiral = concatMap spiralSeq [1, 3..]
Now we can use Dir here to calculate the next coordinate, like:
move :: (Int, Int) -> Dir -> (Int, Int)
move (x, y) = go
where go R = (x+1, y)
go D = (x, y-1)
go L = (x-1, y)
go U = (x, y+1)
We can use scanl :: (a -> b -> a) -> a -> [b] -> [a] to generate the points, like:
spiralPos :: [(Int, Int)]
spiralPos = scanl move (0,0) spiral
This will yield an infinite list of coordinates for the clockwise spiral. We can use take :: Int -> [a] -> [a] to take the first k items:
Prelude> take 9 spiralPos
[(0,0),(1,0),(1,-1),(0,-1),(-1,-1),(-1,0),(-1,1),(0,1),(1,1)]
The idea with the following solution is that instead of trying to generate the coordinates directly, we’ll look at the directions from one point to the next. If you do that, you’ll notice that starting from the first point, we go 1× right, 1× down, 2× left, 2× up, 3× right, 3× down, 4× left… These can then be seperated into the direction and the number of times repeated:
direction: > v < ^ > v < …
# reps: 1 1 2 2 3 3 4 …
And this actually gives us two really straightforward patterns! The directions just rotate > to v to < to ^ to >, while the # of reps goes up by 1 every 2 times. Once we’ve made two infinite lists with these patterns, they can be combined together to get an overall list of directions >v<<^^>>>vvv<<<<…, which can then be iterated over to get the coordinate values.
Now, I’ve always thought that just giving someone a bunch of code as the solution is not the best way to learn, so I would highly encourage you to try implementing the above idea yourself before looking at my solution below.
Welcome back (if you did try to implement it yourself). Now: onto my own solution. First I define a Stream data type for an infinite stream:
data Stream a = Stream a (Stream a) deriving (Show)
Strictly speaking, I don’t need streams for this; Haskell’s predefined lists are perfectly adequate for this task. But I happen to like streams, and they make some of the pattern matching a bit easier (because I don’t have to deal with the empty list).
Next, I define a type for directions, as well as a function specifying how they interact with points:
-- Note: I can’t use plain Left and Right
-- since they conflict with constructors
-- of the ‘Either’ data type
data Dir = LeftDir | RightDir | Up | Down deriving (Show)
type Point = (Int, Int)
move :: Dir -> Point -> Point
move LeftDir (x,y) = (x-1,y)
move RightDir (x,y) = (x+1, y)
move Up (x,y) = (x,y+1)
move Down (x,y) = (x,y-1)
Now I go on to the problem itself. I’ll define two streams — one for the directions, and one for the number of repetitions of each direction:
dirStream :: Stream Dir
dirStream = Stream RightDir $ Stream Down $ Stream LeftDir $ Stream Up dirVals
numRepsStream :: Stream Int
numRepsStream = go 1
where
go n = Stream n $ Stream n $ go (n+1)
At this point we’ll need a function for replicating each element of a stream a specific number of times:
replicateS :: Stream Int -> Stream a -> Stream a
replicateS (Stream n ns) (Stream a as) = conss (replicate n a) $ replicateS ns as
where
-- add more than one element to the beginning of a stream
conss :: [a] -> Stream a -> Stream a
conss [] s = s
conss (x:xs) s = Stream x $ appends xs s
This gives replicateS dirStream numRepsStream for the stream of directions. Now we just need a function to convert those directions to coordinates, and we’ve solved the problem:
integrate :: Stream Dir -> Stream Point
integrate = go (0,0)
where
go p (Stream d ds) = Stream p (go (move d p) ds)
spiral :: Stream Point
spiral = integrate $ replicateS numRepsStream dirStream
Unfortunately, it’s somewhat inconvenient to print an infinite stream, so the following function is useful for debugging and printing purposes:
takeS :: Int -> Stream a -> [a]
takeS 0 _ = []; takeS n (Stream x xs) = x : (takeS (n-1) xs)
I have a class Movable and multiple data types that instance this class. I want to create a generic move function for all these classes as I did below, but apparently my record syntax is incorrect since I get the following error:
src\Controller.hs:24:13: error:
* `position' is not a record selector
* In the expression: o {position = (x', y')}
In an equation for `move':
move o
= o {position = (x', y')}
where
(x, y) = position o
(vx, vy) = velocity o
x' = x + vx
y' = y + vy
|
24 | move o = o {position = (x', y')}
| ^^^^^^^^
I tried applying this StackOverflow answer, but I didn't get it to work. How to fix this? Or are there other ways beside using record syntax to solve this problem?
Here you can see my code:
type Position = (Float, Float)
type Velocity = (Float, Float)
class Movable m where
position :: m -> Position
velocity :: m -> Velocity
data Player = Player {
playerBulletType :: Bullet,
playerHealth :: Health,
playerMaxVelocity :: MaxVelocity,
playerVelocity :: Velocity,
playerPosition :: Position,
playerSprite :: Sprite
}
instance Movable Player where
position = playerPosition
velocity = playerVelocity
move :: Movable o => o -> o
move o = o {position = (x', y')}
where (x, y) = position o
(vx, vy) = velocity o
x' = x + vx
y' = y + vy
First, as we already recommended in the other question, you should probably not use any class at all for this problem, but just a parameterised record.
A class is not like in OO that it actually defines a data structure. It just defines some operations that may use values of the instance type to give you something, but that's just a special case. Those values might as well be computed on the fly, and there's generally no way to set them to another value. If you need that, then such a “getter method” is not sufficient, you also need a “setter”. Idiomatically in modern Haskell, you'd do both in one go: the combination of getter an setter is called a lens.
import Control.Lens
class Movable m where
position :: Lens' m Position
velocity :: Lens' m Velocity
instance Movable Player where
position f plyr = fmap (\p -> plyr{playerPosition=p}) . f $ playerPosition plyr
velocity f plyr = fmap (\v -> plyr{playerVelocity=v}) . f $ playerVelocity plyr
Then you can write
move :: Movable o => o -> o
move o = o & position .~ (x', y')
where (x, y) = o ^. position
(vx, vy) = o ^. velocity
x' = x + vx
y' = y + vy
or, shorter with vector-space,
import Data.AffineSpace
move :: Movable o => o -> o
move o = o & position %~ (.+^ o^.velocity)
I'm not sure if our assignment was presented in the most functional-enabling of ways, but I have to work with it. I have a "map" that represents a pacman game state:
B B B B
B P _ B
B . . B
B B B B
where B is a border tile, P is pacman, _ is an empty space, and . is a food pellet. There are many rules when moving pacman, but consider one:
When pacman moves into a tile occupied by a food pellet, replace the pacman tile with an empty space and the food pellet with pacman. This function would have the definition:
move:: [[Char]] -> [[Char]]
Right now I've got functions that give me the (x,y) coordinate tuple of pacman and his new location, and I was planning to use the !! function to "overwrite" the tiles. However, I know a little of list operations such as :. Could I use : to accomplish this task?
Rather than modify the string, I would instead define a function of type:
type Position = (Int, Int)
type Board = [[Char]]
renderBoard :: Position -> Board
Then I would just modify pacman's position and re-render the board:
move :: Position -> Position
Edit: To answer your specific question, you can do this easily using the lens library:
import Control.Lens
move :: Position -> Position -> Board -> Board
move (oldX, oldY) (newX, newY) = (ix oldX.ix oldY .~ '_') . (ix newX.ix newY .~ 'P')
Below is a replace function that you can use to replace a particular position character in the 2d array [[Char]]
replace :: [[Char]] -> (Int,Int) -> Char -> [[Char]]
replace chars (x',y') c = do
(x,row) <- zip [0..] chars
return [if x == x' && y == y' then c else r | (y,r) <- zip [0..] row]
The second argument is the position which needs to be updated with the Char value in 3rd position.
Using this function you should be able to implement your move function.
Here's a simple approach that doesn't rely on libraries. First, we define a function .~ that allows you to set the index of a list -
set n x xs = take n xs ++ (x : drop (n+1) xs)
and give it a convenient alias so that we can use it in infix form.
n .~ x = \xs -> set n x xs
This allows you to do things like
>> let list = [1,2,3,4]
>> 1 .~ 10 $ list
[1,10,3,4]
Now it's a simple matter to extend that to a function that modifies two-dimensional lists
(n,m) .= x = \xs -> n .~ (m .~ x $ xs!!n) $ xs
so that you can do things like
>> let listOfList = [[1,2,3],[4,5,6],[7,8,9]]
>> (1,1) .= 100 $ listOfList
[[1,2,3],[4,100,6],[7,8,9]]
Now you can easily write a function move that takes an old position, a new position and the current board, and modifies the board in the way you want
type Pos = (Int,Int)
type Board = [[Char]]
move :: Pos -> Pos -> Board -> Board
move (x,y) (x',y') board = board''
where
board' = (x, y ) .= '_' $ board
board'' = (x',y') .= 'P' $ board'
That is, the first line in the where clause modifies the board to replace PacMan's old position with an empty space, and the second line modifies the board that's reutrned form that, to put PacMan in the new position.
So I have a Tic Tac Toe board, in the form of nested tuples, like so:
type Row = (Field, Field, Field)
type Board = (Row, Row, Row)
data Field = X | O | B
deriving (Eq, Ord)
Where B stands for empty. I need to take a player, a given board state, and then generate a list of all possible board states after the next move.
moves :: Player -> Board -> [Board]
However, I just can't figure it out. My initial thought is that I need to iterate through every field, to check whether or not it is empty, and then add a new Board to the list or do nothing. However, I see no way to iterate through all the fields. Even if I manually check every field with if statement or guards, how do I move onto the next field to check it, regardless of whether I end up with a possible move or not?
If I convert the board format into a list I could do it, but I feel like that defeats the purpose of this problem. There's got to be a better solution that doesn't require restructuring Board.
You're not going to be able to iterate through the fields of a tuple -- tuples aren't intended for that. A list of lists is probably a more natural representation for this problem.
That said, you can implement this function with the board representation you're using by following the types. A move on a Board is a move on either the first, second, or third row. A move on a row is the placement of the player on either the first, second, or third field. The difficulty with your representation is that there's no simple way to map over a tuple, since tuples are generally heterogeneous. So instead, one thing you can do is write yourself a generic way to apply a function to a location in a tuple. Here's one way to do that (if the Monad stuff confuses you, mentally substitute "list of foo" everywhere you see m foo and you'll be okay):
mReplace1 :: Monad m => (a -> m d) -> (a,b,c) -> m (d,b,c)
mReplace1 f (a,b,c) = f a >>= \d -> return (d,b,c)
mReplace2 :: Monad m => (b -> m d) -> (a,b,c) -> m (a,d,c)
mReplace2 f (a,b,c) = f b >>= \d -> return (a,d,c)
mReplace3 :: Monad m => (c -> m d) -> (a,b,c) -> m (a,b,d)
mReplace3 f (a,b,c) = f c >>= \d -> return (a,b,d)
These functions provide a way to apply a function to the first, second, and third slots in a tuple, respectively. They're wrapped in a monad so that we can have a function that returns a list of possibilities for the slot, and automatically convert that to a list of possibilities for the tuple as a whole.
With these, we can write the overall function just by stringing these calls together.
moves p board = mReplace1 rowMoves board ++
mReplace2 rowMoves board ++
mReplace3 rowMoves board
where rowMoves row = mReplace1 fieldMoves row ++
mReplace2 fieldMoves row ++
mReplace3 fieldMoves row
fieldMoves B = [p]
fieldMoves _ = []
That is: the moves for a board are all the possibilities for a move in row 1, plus all the possibilities for row 2, plust all the possibilities for row 3. For a given row, the possible moves are all the moves for slot 1, plus all the moves for slot 2, plus all the moves for slot 3. For a given slot, if there's already an X or an O there, then there are no possible moves; otherwise there's one possible move (placing the player in that slot).
Here's a simple solution that I've used before
import qualified Data.Map as Map
data Piece = O | X deriving (Eq,Ord)
type Position = (Int,Int)
type Board = Map.Map Position Piece
positions = [(i,j) | i <- [0,1,2], j <- [0,1,2]]
spaces board = map (\pos -> Map.notMember pos board) positions
moves player board = map (\pos -> Map.insert pos player board) (spaces board)
As other people have stated, tuples is not a very good idea for this approach, since there is no way to traverse them.
You said you needed tuples, so there you go, I'm almost sure it works, test it.
First your code how I would've done it
import Control.Monad (msum)
import Control.Applicative ((<*>), pure)
data Player = P1 | P2 deriving (Eq, Show)
data Field = X | O | B deriving (Eq, Show)
type Board = ((Field,Field,Field)
,(Field,Field,Field)
,(Field,Field,Field))
symbolToPlayer :: Field -> Player
symbolToPlayer X = P1
symbolToPlayer O = P2
checkThree :: (Field,Field,Field) -> Maybe Player
checkThree (a,b,c)
| a == b && a == c = Just $ symbolToPlayer a
| otherwise = Nothing
winHorizontal :: Board -> Maybe Player
winHorizontal (r1, r2, r3) = msum $ map checkThree [r1, r2, r3]
winVertical :: Board -> Maybe Player
winVertical ((a,b,c), (d,e,f), (g,h,i)) =
msum $ map checkThree [(a,d,g), (b,e,h), (c,f,i)]
winDiagonal :: Board -> Maybe Player
winDiagonal ((a,_,c), (_,e,_), (g,_,i)) =
msum $ map checkThree [(a,e,i), (c,e,g)]
hasWinner :: Board -> Maybe Player
hasWinner b = msum $ [winHorizontal, winVertical, winHorizontal] <*> pure b
This is the part of nextStates function
boardBlanks :: Board -> Int
boardBlanks (r1,r2,r3) = rowBlanks r1 + rowBlanks r2 + rowBlanks r3
rowBlanks :: (Field, Field, Field) -> Int
rowBlanks (a,b,c) = foldr hack 0 [a,b,c]
where hack B c = 1 + c
hack _ c = c
changeBoard :: Field -> Int -> Board -> Board
changeBoard f i (a,b,c)
| hack [a] > i = (changeRow f (i - hack []) a, b, c)
| hack [a,b] > i = (a, changeRow f (i - hack [a]) b, c)
| hack [a,b,c] > i= (a, b, changeRow f (i - hack [a,b]) c)
where
hack ls = sum $ map rowBlanks ls
changeRow f 0 row =
case row of
(B,a,b) -> (f,a,b)
(a,B,b) -> (a,f,b)
(a,b,B) -> (a,b,f)
otherwise -> row
changeRow f 1 row =
case row of
(B,B,a) -> (B,f,a)
(a,B,B) -> (a,B,f)
otherwise -> row
changeRow f 2 row =
case row of
(B,B,B) -> (B,B,f)
otherwise -> row
nextStates :: Board -> [Board]
nextStates b = os ++ xs
where
os = foldr (hack O) [] . zip [0..] $ replicate (boardBlanks b) b
xs = foldr (hack X) [] . zip [0..] $ replicate (boardBlanks b) b
hack f (i,a) ls = changeBoard f i a : ls
So I'm working on a minimax implementation for a checkers-like game to help myself learn Haskell better. The function I'm having trouble with takes a list for game states, and generates the list of immediate successor game states. Like checkers, if a jump is available, the player must take it. If there's more than one, the player can choose.
For the most part, this works nicely with the list monad: loop over all the input game states, loop over all marbles that could be jumped, loop over all jumps of that marble. This list monad nicely flattens all the lists out into a simple list of states at the end.
The trick is that, if no jumps are found for a given game state, I need to return the current game state, rather than the empty list. The code below is the best way I've come up with of doing that, but it seems really ugly to me. Any suggestions on how to clean it up?
eHex :: Coord -> Coord -- Returns the coordinates immediately to the east on the board
nwHex :: Coord -> Coord -- Returns the coordinates immediately to the northwest on the board
generateJumpsIter :: [ZertzState] -> [ZertzState]
generateJumpsIter states = do
ws <- states
case children ws of
[] -> return ws
n#_ -> n
where
children ws#(ZertzState s1 s2 b p) = do
(c, color) <- occupiedCoords ws
(start, end) <- [(eHex, wHex), (wHex, eHex), (swHex, neHex),
(neHex, swHex), (nwHex, seHex), (seHex, nwHex)]
if (hexOccupied b $ start c) && (hexOpen b $ end c)
then case p of
1 -> return $ ZertzState (scoreMarble s1 color) s2
(jumpMarble (start c) c (end c) b) p
(-1) -> return $ ZertzState s1 (scoreMarble s2 color)
(jumpMarble (start c) c (end c) b) p
else []
EDIT: Provide example type signatures for the *Hex functions.
The trick is that, if no jumps are found for a given game state, I need to return the current game state, rather than the empty list.
Why? I've written minimax several times, and I can't imagine a use for such a function. Wouldn't you be better off with a function of type
nextStates :: [ZertzState] -> [Maybe [ZertzState]]
or
nextStates :: [ZertzState] -> [[ZertzState]]
However if you really want to return "either the list of next states, or if that list is empty, the original state", then the type you want is
nextStates :: [ZertzState] -> [Either ZertzState [ZertzState]]
which you can then flatten easily enough.
As to how to implement, I recommend defining a helper function of type
[ZertzState] -> [(ZertzState, [ZertzState])]
and than you can map
(\(start, succs) -> if null succs then Left start else Right succs)
over the result, plus various other things.
As Fred Brooks said (paraphrasing), once you get the types right, the code practically writes itself.
Don't abuse monads notation for list, it's so heavy for nothing. Moreover you can use list comprehension in the same fashion :
do x <- [1..3]
y <- [2..5] <=> [ x + y | x <- [1..3], y <- [2..5] ]
return x + y
now for the 'simplification'
listOfHex :: [(Coord -> Coord,Coord -> Coord)]
listOfHex = [ (eHex, wHex), (wHex, eHex), (swHex, neHex)
, (neHex, swHex), (nwHex, seHex), (seHex, nwHex)]
generateJumpsIter :: [ZertzState] -> [ZertzState]
generateJumpsIter states =
[if null ws then ws else children ws | ws <- states]
where -- I named it foo because I don t know what it do....
foo True 1 = ZertzState (scoreMarble s1 color) s2
(jumpMarble (start c) c (end c) b) p
foo True (-1) = ZertzState s1 (scoreMarble s2 color)
(jumpMarble (start c) c (end c) b) p
foo False _ = []
foo _ _ = error "Bleh"
children ws#(ZertzState s1 s2 b p) =
[ foo (valid c hex) p | (c, _) <- occupiedCoords ws, hex <- listOfHex ]
where valid c (start, end) =
(hexOccupied b $ start c) && (hexOpen b $ end c)
The let in the let in list commprehension at the top bother me a little, but as I don't have all the code, I don't really know how to do it in an other way. If you can modify more in depth, I suggest you to use more combinators (map, foldr, foldl' etc) as they really reduce code size in my experience.
Note, the code is not tested, and may not compile.