During last three days I have been trying to solve Project Euler 15 in Haskell.
Here is my current state:
import Data.Map as Map
data Coord = Coord Int Int deriving (Show, Ord, Eq)
corner :: Coord -> Bool
corner (Coord x y) = (x == 0) && (y == 0)
side :: Coord -> Bool
side (Coord x y) = (x == 0) || (y == 0)
move_right :: Coord -> Coord
move_right (Coord x y) = Coord (x - 1) y
move_down :: Coord -> Coord
move_down (Coord x y) = Coord x (y - 1)
calculation :: Coord -> Integer
calculation coord
| corner coord = 0
| side coord = 1
| otherwise = (calculation (move_right coord)) + (calculation (move_down coord))
problem_15 :: Int -> Integer
problem_15 size =
calculation (Coord size size)
It works fine but it is very slow if the 'n' is getting bigger.
As I know I can use the dynamic programming and the hashtable (Data.Map, for example) to cache calculated values.
I was trying to use memoization, but don't have a success. I was trying to use Data.Map, but each next error was more scary then previous. So I ask your help: how to cache values which was already calculated ?
I know about mathematical solution of this problem (Pascal triangle), but I am interested in the algorithmic solution.
Instead of a Map, this problem is better suited for an two-dimensional array cache, since we have a bounded range for input values.
import Control.Applicative
import Data.Array
data Coord = Coord Int Int deriving (Show, Ord, Eq, Ix)
calculation :: Coord -> Integer
calculation coord#(Coord maxX maxY) = cache ! coord where
cache = listArray bounds $ map calculate coords
calculate coord
| corner coord = 0
| side coord = 1
| otherwise = cache ! move_right coord + cache ! move_down coord
zero = Coord 0 0
bounds = (zero, coord)
coords = Coord <$> [0..maxX] <*> [0..maxY]
We add deriving Ix to Coord so we can use it directly as an array index and in calculation, we initialize a two-dimensional array cache with the lower bound of Coord 0 0 and upper bound of coord. Then instead of recursively calling calculation we just refer to the values in the cache.
Now we can calculate even large values relatively quickly.
*Main> problem_15 1000
2048151626989489714335162502980825044396424887981397033820382637671748186202083755828932994182610206201464766319998023692415481798004524792018047549769261578563012896634320647148511523952516512277685886115395462561479073786684641544445336176137700738556738145896300713065104559595144798887462063687185145518285511731662762536637730846829322553890497438594814317550307837964443708100851637248274627914170166198837648408435414308177859470377465651884755146807496946749238030331018187232980096685674585602525499101181135253534658887941966653674904511306110096311906270342502293155911108976733963991149120
Since you already know the correct (efficient) solution, I'm not spoiling anything for you:
You can use an array (very appropriate here, since the domain is a rectangle)
import Data.Array
pathCounts :: Int -> Int -> Array (Int,Int) Integer
pathCounts height width = solution
where
solution =
array ((0,0),(height-1,width-1)) [((i,j), count i j) | i <- [0 .. height-1]
, j <- [0 .. width-1]]
count 0 j = 1 -- at the top, we can only come from the left
count i 0 = 1 -- on the left edge, we can only come from above
count i j = solution ! (i-1,j) + solution ! (i,j-1)
Or you can use the State monad (the previously calculated values are the state, stored in a Map):
import qualified Data.Map as Map
import Control.Monad.State.Strict
type Path = State (Map Coord Integer)
calculation :: Coord -> Path Integer
calculation coord = do
mb_count <- gets (Map.lookup coord)
case mb_count of
Just count -> return count
Nothing
| corner coord -> modify (Map.insert coord 0) >> return 0 -- should be 1, IMO
| side coord -> modify (Map.insert coord 1) >> return 1
| otherwise -> do
above <- calculation (move_down coord)
left <- calculation (move_right coord)
let count = above + left
modify (Map.insert coord count)
return count
and run that with
evalState (calculation target) Map.empty
Or you can use one of the memoisation packages on hackage, off the top of my head I remember data-memocombinators, but there are more, possibly some even better. (And there are still more possible ways of course.)
Related
I have defined a Point data type, with a single value constructor like so:
data Point = Point {
x :: Int,
y :: Int,
color :: Color
} deriving (Show, Eq)
data Color = None
| Black
| Red
| Green
| Blue
deriving (Show, Eq, Enum, Bounded)
I have found an example of making a Bounded Enum an instance of the Random class and have made Color an instance of it like so:
instance Random Color where
random g = case randomR (1, 4) g of
(r, g') -> (toEnum r, g')
randomR (a, b) g = case randomR (fromEnum a, fromEnum b) g of
(r, g') -> (toEnum r, g')
I was then able to find out how to make Point an instance of the Random class also:
instance Random Point where
randomR (Point xl yl cl, Point xr yr cr) g =
let (x, g1) = randomR (xl, xr) g
(y, g2) = randomR (yl, yr) g1
(c, g3) = randomR (cl, cr) g2
in (Point x y c, g3)
random g =
let (x, g1) = random g
(y, g2) = random g1
(c, g3) = random g2
in (Point x y c, g3)
So, this let's me make random point values. But, what I'd like to do is be able to create a list of random Point values, where the x and the y properties are bounded within some range whilst leaving the color property to be an unbounded random value. Is this possible with the way I am currently modelling the code, or do I need to rethink how I construct Point values? For instance, instead of making Point an instance of the Random class, should I just create a random list of Int in the IO monad and then have a pure function that creates n Points, using values from the random list to construct each Point value?
Edit, I think I have found out how to do it:
Without changing the above code, in the IO monad I can do the following:
solved :: IO ()
solved = do
randGen <- getStdGen
let x = 2
let randomPoints = take x $ randomRs (Point 0 0 None, Point 200 200 Blue) randGen
putStrLn $ "Random points: " ++ show randomPoints
This seems to work, randomRs appears to let me specify a range...
Presumably because my Point data type derives Eq?
Or
Is it because my x and y properties are Int (guessing here, but may be "bounded" by default) and I have Color derive bounded?
It works because of the properties of the Int and Color types, not because of the properties of Point. If one suppresses the Eq clause of Point, it still works.
Your code is overall quite good, however I would mention a few minor caveats.
In the Random instance for Point, you are chaining the generator states manually; this is a bit error prone, and monadic do notation is supposed to make it unnecessary. The Color instance could be simplified.
You are using IO where it is not really required. IO is just one instance of the MonadRandom class. If g is an instance of RandomGen, any Rand g is an instance of MonadRandom.
The random values you're getting are not reproducible from a program execution to the next one; this is because getStdGen implicitly uses the launch time as a random number generation seed. It may do that because it is IO-hosted. In many situations, this is a problem, as one might want to vary the choice of random sequence and the system parameters independently of each other.
Using monadic style, the basics of your code could be rewritten for example like this:
import System.Random
import System.Random.TF -- Threefish random number generator
import Control.Monad.Random
data Point = Point {
x :: Int,
y :: Int,
color :: Color
} deriving (Show, Eq)
data Color = None
| Black
| Red
| Green
| Blue
deriving (Show, Eq, Enum, Bounded)
instance Random Color where
randomR (a, b) g = let (r,g') = randomR (fromEnum a, fromEnum b) g
in (toEnum r, g')
random g = randomR (minBound::Color, maxBound::Color) g
singleRandomPoint :: -- monadic action for just one random point
MonadRandom mr => Int -> Int -> Color -> Int -> Int -> Color -> mr Point
singleRandomPoint xmin ymin cmin xmax ymax cmax =
do
-- avoid manual chaining of generator states:
x <- getRandomR (xmin, xmax)
y <- getRandomR (ymin, ymax)
c <- getRandomR (cmin, cmax)
return (Point x y c)
And then we can derive an expression returning an unlimited list of random points:
-- monadic action for an unlimited list of random points:
seqRandomPoints :: MonadRandom mr =>
Int -> Int -> Color -> Int -> Int -> Color -> mr [Point]
seqRandomPoints xmin ymin cmin xmax ymax cmax =
sequence (repeat (singleRandomPoint xmin ymin cmin xmax ymax cmax))
-- returns an unlimited list of random points:
randomPoints :: Int -> Int -> Int -> Color -> Int -> Int -> Color -> [Point]
randomPoints seed xmin ymin cmin xmax ymax cmax =
let
-- get random number generator:
-- using Threefish algorithm (TF) for better statistical properties
randGen = mkTFGen seed
action = seqRandomPoints xmin ymin cmin xmax ymax cmax
in
evalRand action randGen
Finally we can print the first few random points on stdout:
-- Small printing utility:
printListAsLines :: Show t => [t] -> IO()
printListAsLines xs = mapM_ (putStrLn . show) xs
solved01 :: IO ()
solved01 = do
let
seed = 42 -- for random number generator setup
-- unlimited list of random points:
allRandomPoints = randomPoints seed 0 0 None 200 200 Blue
count = 5
someRandomPoints = take count allRandomPoints
-- IO not used at all so far
putStrLn $ "Random points: "
printListAsLines someRandomPoints
main = solved01
Program execution (reproducible with constant seed):
$ randomPoints
Random points:
Point {x = 187, y = 56, color = Green}
Point {x = 131, y = 28, color = Black}
Point {x = 89, y = 135, color = Blue}
Point {x = 183, y = 190, color = Red}
Point {x = 27, y = 161, color = Green}
$
Should you prefer to just get a finite number of points and also get back the updated state of your random number generator, you would have to use replicate n instead of repeat, and runRand instead of evalRand.
Bit more details about the monadic approach here.
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 function
isValid :: CoOrd -> Bool
Where CoOrd is a tuple pair (x,y)
The boards size is ['a'..'h'] ['1'..'8'] so I want to check if the given CoOrds are valid for this board (CoOrds x < ['a'..'h'], CoOrds y ['1'..'8'])
I'm fine with the logic of this question, its just the syntax as I'm new to haskell, so I'm looking for something like this
if (CoOrd(x _) == ['a'..'h'])
if (CoOrd(_ y) == ['1'..'8'])
return True
else return False
The basic approach is to use direct comparisons:
isValid :: CoOrd -> Bool
isValid (x,y) = x >= 'a' && x <= 'h' && y >= '1' && y <= '8'
A more advanced alternative is to exploit Data.Ix.inRange:
import Data.Ix
isValid :: CoOrd -> Bool
isValid = inRange (('a','1'),('h','8'))
You can also use elem, as others pointed out, but elem will scan the whole list and perform pointwise comparisons (8+8 comparisons, in the worst case), while the methods above will only do four comparisons.
Finally, a few comments on your original code:
Don't use return in Haskell unless you are writing monadic code
Don't use if condition then True else False -- that's noise, and it is equivalent to conditions. Consider using boolean operators instead, which is often simpler.
Why not make some new types for your X and Y coordinates so the type checker gives you a static guarantee that any CoOrd value is correct?
For example, I think you have type CoOrd = (Char,Int). Instead try:
data XCo = A | B | C | D | E | F | G | H deriving (Eq,Ord,Show,Enum)
data YCo = Y1 | Y2 | Y3 | Y4 | Y5 | Y6 | Y7 | Y8 deriving (Eq,Ord,Enum)
instance Show YCo where
show y = show (fromEnum y + 1)
type CoOrd = (XCo,YCo)
And now anywhere you were using character literals like 'a', 'b' etc you use A, B etc. Same with the numbers and the Y axis - 1 becomes Y1 etc.
isValid (x,y) = x `elem` ['a'..'h'] && y `elem` ['1'..'8']
In addition to the other answers instead of using tuples you may define a new type, for example ChessBoard.
Since you are in need of checking the validity of the entered position it might be wise to make it Maybe ChessBoard type as well.
Accordingly you may come up with something like
module ChessBoard (ChessBoard, chessBoard) where
data ChessBoard = CB Char Int deriving (Eq, Ord, Show)
chessBoard :: Char -> Int -> Maybe ChessBoard
chessBoard c n | elem c ['a'..'h'] && elem n [1..8] = Just (CB c n)
| otherwise = Nothing
Here as you may notice we are not exporting the data constructor CB Char Int so the only way to create your chess board position data is through the chessBoard function and there will be no illegal board positions.
I mean;
*Main> chessBoard 'a' 3
Just (CB 'a' 3)
*Main> chessBoard 'h' 9
Nothing
*Main> let pos = Just (CB 'a' 11) -- trying to assign an illegal position directly
<interactive>:259:17: error:
Data constructor not in scope: CB :: Char -> Integer -> a
The output looks like this:
You should just see a flat, continuous red wall on one side, blue wall on another, green on another, yellow on another (see the definition of the map, testMapTiles, it's just a map with four walls). Yet there are these phantom wall faces of varying height, which are perpendicular to the real walls. Why?
Note that the white "gaps" aren't actually gaps: it's trying to draw a wall of height Infinity (distance 0). If you specifically account for it (this version of the code doesn't) and just cap it at screen height, then you just see a very high wall there.
The source code is below. It's plain Haskell, using Haste to compile to JavaScript and render to canvas. It is based on the C++ code from this tutorial, though note that I replaced mapX and mapY with tileX and tileY, and I don't have the ray prefix for pos and dir within the main loop. Any discrepancies from the C++ code are probably what's breaking everything, but I can't seem to find any after having pored over this code many times.
Any help?
import Data.Array.IArray
import Control.Arrow (first, second)
import Control.Monad (forM_)
import Haste
import Haste.Graphics.Canvas
data MapTile = Empty | RedWall | BlueWall | GreenWall | YellowWall deriving (Eq)
type TilemapArray = Array (Int, Int) MapTile
emptyTilemapArray :: (Int, Int) -> TilemapArray
emptyTilemapArray dim#(w, h) = listArray ((1, 1), dim) $ replicate (w * h) Empty
testMapTiles :: TilemapArray
testMapTiles =
let arr = emptyTilemapArray (16, 16)
myBounds#((xB, yB), (w, h)) = bounds arr
in listArray myBounds $ flip map (indices arr) (\(x, y) ->
if x == xB then RedWall
else if y == yB then BlueWall
else if x == w then GreenWall
else if y == h then YellowWall
else Empty)
type Vec2 a = (a, a)
type DblVec2 = Vec2 Double
type IntVec2 = Vec2 Int
add :: (Num a) => Vec2 a -> Vec2 a -> Vec2 a
add (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)
mul :: (Num a) => Vec2 a -> a -> Vec2 a
mul (x, y) factor = (x * factor, y * factor)
rot :: (Floating a) => Vec2 a -> a -> Vec2 a
rot (x, y) angle =
(x * (cos angle) - y * (sin angle), x * (sin angle) + y * (cos angle))
dbl :: Int -> Double
dbl = fromIntegral
-- fractional part of a float
-- `truncate` matches behaviour of C++'s int()
frac :: Double -> Double
frac d = d - dbl (truncate d)
-- get whole and fractional parts of a float
split :: Double -> (Int, Double)
split d = (truncate d, frac d)
-- stops 'Warning: Defaulting the following constraint(s) to type ‘Integer’'
square :: Double -> Double
square = (^ (2 :: Int))
-- raycasting algorithm based on code here:
-- http://lodev.org/cgtutor/raycasting.html#Untextured_Raycaster_
data HitSide = NorthSouth | EastWest deriving (Show)
-- direction, tile, distance
type HitInfo = (HitSide, IntVec2, Double)
-- pos: start position
-- dir: initial direction
-- plane: camera "plane" (a line, really, perpendicular to the direction)
traceRays :: TilemapArray -> Int -> DblVec2 -> DblVec2 -> DblVec2 -> [HitInfo]
traceRays arr numRays pos dir plane =
flip map [0..numRays] $ \x ->
let cameraX = 2 * ((dbl x) / (dbl numRays)) - 1
in traceRay arr pos $ dir `add` (plane `mul` cameraX)
traceRay :: TilemapArray -> DblVec2 -> DblVec2 -> HitInfo
traceRay arr pos#(posX, posY) dir#(dirX, dirY) =
-- map tile we're in (whole part of position)
-- position within map tile (fractional part of position)
let ((tileX, fracX), (tileY, fracY)) = (split posX, split posY)
tile = (tileX, tileY)
-- length of ray from one x or y-side to next x or y-side
deltaDistX = sqrt $ 1 + (square dirY / square dirX)
deltaDistY = sqrt $ 1 + (square dirX / square dirY)
deltaDist = (deltaDistX, deltaDistY)
-- direction of step
stepX = if dirX < 0 then -1 else 1
stepY = if dirY < 0 then -1 else 1
step = (stepX, stepY)
-- length of ray from current position to next x or y-side
sideDistX = deltaDistX * if dirX < 0 then fracX else 1 - fracX
sideDistY = deltaDistY * if dirY < 0 then fracY else 1 - fracY
sideDist = (sideDistX, sideDistY)
(hitSide, wallTile) = traceRayInner arr step deltaDist tile sideDist
in (hitSide, wallTile, calculateDistance hitSide pos dir wallTile step)
traceRayInner :: TilemapArray -> IntVec2 -> DblVec2 -> IntVec2 -> DblVec2 -> (HitSide, IntVec2)
traceRayInner arr step#(stepX, stepY) deltaDist#(deltaDistX, deltaDistY) tile sideDist#(sideDistX, sideDistY)
-- a wall has been hit, report hit direction and coördinates
| arr ! tile /= Empty = (hitSide, tile)
-- advance until a wall is hit
| otherwise = case hitSide of
EastWest ->
let newSideDist = first (deltaDistX+) sideDist
newTile = first (stepX+) tile
in
traceRayInner arr step deltaDist newTile newSideDist
NorthSouth ->
let newSideDist = second (deltaDistY+) sideDist
newTile = second (stepY+) tile
in
traceRayInner arr step deltaDist newTile newSideDist
where
hitSide = if sideDistX < sideDistY then EastWest else NorthSouth
-- calculate distance projected on camera direction
-- (an oblique distance would give a fisheye effect)
calculateDistance :: HitSide -> DblVec2 -> DblVec2 -> IntVec2 -> IntVec2 -> Double
calculateDistance EastWest (startX, _) (dirX, _) (tileX, _) (stepX, _) =
((dbl tileX) - startX + (1 - dbl stepX) / 2) / dirX
calculateDistance NorthSouth (_, startY) (_, dirY) (_, tileY) (_, stepY) =
((dbl tileY) - startY + (1 - dbl stepY) / 2) / dirY
-- calculate the height of the vertical line on-screen based on the distance
calculateHeight :: Double -> Double -> Double
calculateHeight screenHeight 0 = screenHeight
calculateHeight screenHeight perpWallDist = screenHeight / perpWallDist
width :: Double
height :: Double
(width, height) = (640, 480)
main :: IO ()
main = do
cvElem <- newElem "canvas" `with` [
attr "width" =: show width,
attr "height" =: show height
]
addChild cvElem documentBody
Just canvas <- getCanvas cvElem
let pos = (8, 8)
dir = (-1, 0)
plane = (0, 0.66)
renderGame canvas pos dir plane
renderGame :: Canvas -> DblVec2 -> DblVec2 -> DblVec2 -> IO ()
renderGame canvas pos dir plane = do
let rays = traceRays testMapTiles (floor width) pos dir plane
render canvas $ forM_ (zip [0..width - 1] rays) (\(x, (side, tile, dist)) ->
let lineHeight = calculateHeight height dist
wallColor = case testMapTiles ! tile of
RedWall -> RGB 255 0 0
BlueWall -> RGB 0 255 0
GreenWall -> RGB 0 0 255
YellowWall -> RGB 255 255 0
_ -> RGB 255 255 255
shadedWallColor = case side of
EastWest ->
let (RGB r g b) = wallColor
in RGB (r `div` 2) (g `div` 2) (b `div` 2)
NorthSouth -> wallColor
in color shadedWallColor $ do
translate (x, height / 2) $ stroke $ do
line (0, -lineHeight / 2) (0, lineHeight / 2))
-- 25fps
let fps = 25
timeout = (1000 `div` fps) :: Int
rots_per_min = 1
rots_per_sec = dbl rots_per_min / 60
rots_per_frame = rots_per_sec / dbl fps
tau = 2 * pi
increment = tau * rots_per_frame
setTimeout timeout $ do
renderGame canvas pos (rot dir $ -increment) (rot plane $ -increment)
HTML page:
<!doctype html>
<meta charset=utf-8>
<title>Raycaster</title>
<noscript>If you're seeing this message, either your browser doesn't support JavaScript, or it is disabled for some reason. This game requires JavaScript to play, so you'll need to make sure you're using a browser which supports it, and enable it, to play.</noscript>
<script src=raycast.js></script>
The "phantom faces" are occurring because an incorrect HitSide is being reported: you're saying the face was hit on a horizontal move (EastWest), but was actually hit on a vertical move (NorthSouth), or vice-versa.
Why is it reporting an incorrect value, then? if sideDistX < sideDistY then EastWest else NorthSouth seems pretty foolproof, right? And it is.
The problem isn't how we calculated that value. It's when we calculated that value. The distance calculation function needs to know the direction we moved in to get to the wall. However, what we've actually given is the direction we would move in if we were to keep going (that is, if that tile wasn't a wall, or we were to ignore it for some reason).
Look at the Haskell code:
traceRayInner arr step#(stepX, stepY) deltaDist#(deltaDistX, deltaDistY) tile sideDist#(sideDistX, sideDistY)
-- a wall has been hit, report hit direction and coördinates
| arr ! tile /= Empty = (hitSide, tile)
-- advance until a wall is hit
| otherwise = case hitSide of
EastWest ->
let newSideDist = first (deltaDistX+) sideDist
newTile = first (stepX+) tile
in
traceRayInner arr step deltaDist newTile newSideDist
NorthSouth ->
let newSideDist = second (deltaDistY+) sideDist
newTile = second (stepY+) tile
in
traceRayInner arr step deltaDist newTile newSideDist
where
hitSide = if sideDistX < sideDistY then EastWest else NorthSouth
Notice that we do things in this order:
calculate hitSide
check if a wall has been hit, and if so, report hitSide
move
Compare this to the original C++ code:
//perform DDA
while (hit == 0)
{
//jump to next map square, OR in x-direction, OR in y-direction
if (sideDistX < sideDistY)
{
sideDistX += deltaDistX;
mapX += stepX;
side = 0;
}
else
{
sideDistY += deltaDistY;
mapY += stepY;
side = 1;
}
//Check if ray has hit a wall
if (worldMap[mapX][mapY] > 0) hit = 1;
}
It does things in a different order:
check if a wall has been hit, and if so, report side (equivalent to hitSide)
move and calculate side
The C++ code only calculates side when it moves, and then it reports that value if it hits a wall. So, it reports the way it moved in order to hit the wall.
The Haskell code calculates side whether or not it moves: so it's correct for each move, but when it hits a wall, it reports the way it would have moved were it to keep going.
So, the Haskell code can be fixed by re-ordering it so that it checks for a hit after moving, and if so, reports the hitSide value from that move. This isn't pretty code, but it works:
traceRayInner arr step#(stepX, stepY) deltaDist#(deltaDistX, deltaDistY) tile sideDist#(sideDistX, sideDistY) =
let hitSide = if sideDistX < sideDistY then EastWest else NorthSouth
in case hitSide of
EastWest ->
let newSideDist = first (deltaDistX+) sideDist
newTile = first (stepX+) tile
in case arr ! newTile of
-- advance until a wall is hit
Empty -> traceRayInner arr step deltaDist newTile newSideDist
-- a wall has been hit, report hit direction and coördinates
_ -> (hitSide, newTile)
NorthSouth ->
let newSideDist = second (deltaDistY+) sideDist
newTile = second (stepY+) tile
in case arr ! newTile of
-- advance until a wall is hit
Empty -> traceRayInner arr step deltaDist newTile newSideDist
-- a wall has been hit, report hit direction and coördinates
_ -> (hitSide, newTile)
Problem solved!
Side note: I figured out what was wrong after carrying out the algorithm on paper. While in that particular case it just so happened the last two HitSide values matched, it became obvious that that they might not in every case. So, a big thanks to Madsy on Freenode's #algorithms for suggesting trying it out on paper. :)
I am attempting to implement the following algorithm, as detailed here.
Start with a flat terrain (initialize all height values to zero).
Pick a random point on or near the terrain, and a random radius
between some predetermined minimum and maximum. Carefully choosing
this min and max will make a terrain rough and rocky or smooth and
rolling.
Raise a hill on the terrain centered at the point, having the given
radius.
Go back to step 2, and repeat as many times as necessary. The number
of iterations chosen will affect the appearance of the terrain.
However, I start to struggle once I get to the point where I have to select a random point on the terrain. This random point is wrapped in an IO monad, which is then passed up my chain of functions.
Can I cut the IO off at a certain point and, if so, how do I find that point?
The following is my (broken) code. I would appreciate any suggestions on improving it / stopping the randomness from infecting everything.
type Point = (GLfloat, GLfloat, GLfloat)
type Terrain = [Point]
flatTerrain :: Double -> Double -> Double -> Double -> Terrain
flatTerrain width length height spacing =
[(realToFrac x, realToFrac y, realToFrac z)
| x <- [-width,-1+spacing..width], y <- [height], z <- [-length,-1+spacing..length]]
hill :: Terrain -> Terrain
hill terrain = hill' terrain 100
where hill' terrain 0 = terrain
hill' terrain iterations = do
raised <- raise terrain
hill' (raise terrain) (iterations - 1)
raise terrain = do
point <- pick terrain
map (raisePoint 0.1 point) terrain
raisePoint r (cx,cy,cz) (px,py,pz) =
(px, r^2 - ((cx - px)^2 + (cz - pz)^2), pz)
pick :: [a] -> IO a
pick xs = randomRIO (0, (length xs - 1)) >>= return . (xs !!)
The algorithm says that you need to iterate and in each iteration select a random number and update the terrain which can be viewed as generate a list of random points and use this list to update the terrain i.e iteration to generate random numbers == list of random numbers.
So you can do something like:
selectRandomPoints :: [Points] -> Int -> IO [Points] -- generate Int times random points
updateTerrain :: Terrain -> [Points] -> Terrain
-- somewhere in IO
do
pts <- selectRandomPoints allPts iterationCount
let newTerrain = updateTerrain t pts
One of the most useful features of haskell is to know a function is deterministic just based on its type - it makes testing much easier. For this reason, I would base my design on limiting randomness as much as possible, and wrapping the core non random functions with a random variant. This is easily done with the MonadRandom type class, which is the best way of writing code in haskell that requires random values.
For fun, I wrote a console version of that hill generator. It is pretty basic, with a lot of hard coded constants. However, it does provide a pretty cool ascii terrain generator :)
Note with my solution all of the calculations are isolated in pure, non random functions. This could then be tested easily, as the result is deterministic. As little as possible occurs in the IO monad.
import Control.Monad
import Control.Monad.Random
import Data.List
import Data.Function (on)
type Point = (Double, Double, Double)
type Terrain = [Point]
-- Non random code
flatTerrain :: Double -> Double -> Double -> Double -> Terrain
flatTerrain width length height spacing = [(realToFrac x, realToFrac y, realToFrac z)
| x <- [-width,-width+spacing..width], y <- [height], z <- [-length,-length+spacing..length]]
-- simple terrain displayer, uses ascii to render the area.
-- assumes the terrain points are all separated by the same amount
showTerrain :: Terrain -> String
showTerrain terrain = unlines $ map (concat . map showPoint) pointsByZ where
pointsByZ = groupBy ((==) `on` getZ) $ sortBy (compare `on` getZ) terrain
getZ (_, _, z) = z
getY (_, y, _) = y
largest = getY $ maximumBy (compare `on` getY) terrain
smallest = getY $ minimumBy (compare `on` getY) terrain
atPC percent = (largest - smallest) * percent + smallest
showPoint (_, y, _)
| y < atPC (1/5) = " "
| y < atPC (2/5) = "."
| y < atPC (3/5) = "*"
| y < atPC (4/5) = "^"
| otherwise = "#"
addHill :: Double -- Radius of hill
-> Point -- Position of hill
-> Terrain -> Terrain
addHill radius point = map (raisePoint radius point) where
raisePoint :: Double -> Point -> Point -> Point
-- I had to add max py here, otherwise new hills destroyed the
-- old hills with negative values.
raisePoint r (cx,cy,cz) (px,py,pz) = (px, max py (r^2 - ((cx - px)^2 + (cz - pz)^2)), pz)
-- Some random variants. IO is an instance of MonadRandom, so these function can be run in IO. They
-- can also be run in any other monad that has a MonadRandom instance, so they are pretty flexible.
-- creates a random point. Note that the ranges are hardcoded - an improvement would
-- be to be able to specify them, either through parameters, or through reading from a Reader
-- monad or similar
randomPoint :: (MonadRandom m) => m Point
randomPoint = do
x <- getRandomR (-30, 30)
y <- getRandomR (0,10)
z <- getRandomR (-30, 30)
return (x, y, z)
addRandomHill :: (MonadRandom m) => Terrain -> m Terrain
addRandomHill terrain = do
radius <- getRandomR (0, 8) -- hardcoded again
position <- randomPoint
return $ addHill radius position terrain
-- Add many random hills to the Terrain
addRandomHills :: (MonadRandom m) => Int -> Terrain -> m Terrain
addRandomHills count = foldr (>=>) return $ replicate count addRandomHill
-- testing code
test hillCount = do
let terrain = flatTerrain 30 30 0 2
withHills <- addRandomHills hillCount terrain
-- let oneHill = addHill 8 (0, 3, 0) terrain
-- putStrLn $ showTerrain oneHill
putStrLn $ showTerrain withHills
main = test 200
Example output:
... .. ..*. .***^^^***.
... ... .***. .***^^^*^^*.
... .. .*^**......*^*^^^^.
. .***.***. ..*^^^*.
....*^^***^*. .^##^*.
..*.*^^^*****. .^###^..*
.**^^^^.***... .*^#^*.**
.***^##^**..*^^*.*****..**
....***^^##^*.*^##^****. ..
.......*^###^.*###^****.
.*********^###^**^##^***....
*^^^*^##^^^^###^.^^^*. .****..
*^^^^####*^####^..**. .******.
*^^^*####**^###*. .. .*******
*^#^^^##^***^^*. ...........***
*^^^**^^*..*... ..*******...***
.***..*^^*... ..*^^#^^^*......
...*^##^**. .*^^#####*.
.*^##^**....**^^####*. .***
.. ..*^^^*...*...**^^###^* *^#^
..****^^*. .... ...**###^*.^###
..*******.**. ..**^^^#^^..^###
.*****..*^^* ..**^##^**...*^##
.^^^^....*^^*..*^^^##^* ..**^^^
*###^*. .*^**..^###^^^*...*****
^####*.*..*^^*.^###^**.....*..
*###^**^**^^^*.*###^. .. .
.^^^***^^^^#^*.**^^**.
.....***^##^**^^^*^^*.
.*^^##^*^##^^^^^.
.*^^^^*.^##^*^^*.
Nope, you can't escape IO. Perhaps you can do all your randomness up front and rewrite your functions to take that randomness as a parameter; if not, you can use MonadRandom or similar to track a random seed or just put everything in IO.