Running out of memory with recusion in Haskell - haskell

Yesterday I finally decided to start learning Haskell. I started scanning through tutorials, but quickly decided practical exercises would be more beneficial. Therefore I proceeded to port a python script of mine which supposedly simulates gravity into Haskell. To my surprise it actually worked and the generated values match those of python.
I realize the implementation is probably absolutely terrible. The horrible lack of performance does not bother me so much, but what bothers me is that I keep running out of memory when attempting to run the simulation for a longer period of time. Is this because the implementation is inherently flawed or can it be made to work?
I have tried to construct the main loop with three different approaches: "iterate", a recursive function (I read about tail recursion, but didn't manage to make it work) and with a more experimental recursive do function. The functions in question are named simulation, test and test2. I compiled the program with option "-O2".
Why does the program run out of memory, and what can I do to prevent that?
Not so relevant parts of the code:
import System.Environment
import Data.List (tails)
import System.CPUTime
import Text.Printf
import Control.Exception
gConst = 6.674e-11
data Vector = Vector2D Double Double | Vector3D Double Double Double deriving (Show)
deltaVector :: Vector -> Vector -> Vector
deltaVector (Vector2D x1 y1) (Vector2D x2 y2) = Vector2D (x2 - x1) (y2 - y1)
deltaVector (Vector3D x1 y1 z1) (Vector3D x2 y2 z2) = Vector3D (x2 - x1) (y2 - y1) (z2 - z1)
data Position = Position Vector deriving (Show)
data Velocity = Velocity Vector deriving (Show)
distance2DSquared (Vector2D deltaX deltaY) = deltaX ** 2 + deltaY ** 2
distance3DSquared (Vector3D deltaX deltaY deltaZ) = (distance2DSquared $ Vector2D deltaX deltaY) + deltaZ ** 2
distance vector = sqrt (distance3DSquared $ vector)
force vector mass1 mass2 = gConst * (mass1 * mass2) / (distance3DSquared vector)
acceleration force mass = force / mass
vectorComponentDivide (Vector2D x y) c = Vector2D (x/c) (y/c)
vectorComponentDivide (Vector3D x y z) c = Vector3D (x/c) (y/c) (z/c)
vectorComponentMultiply (Vector2D x y) c = Vector2D (x*c) (y*c)
vectorComponentMultiply (Vector3D x y z) c = Vector3D (x*c) (y*c) (z*c)
vectorComponentAdd (Vector2D x1 y1) (Vector2D x2 y2) = Vector2D (x1+x2) (y1+y2)
vectorComponentAdd (Vector3D x1 y1 z1) (Vector3D x2 y2 z2) = Vector3D (x1+x2) (y1+y2) (z1+z2)
invertedVector (Vector2D x1 y1) = Vector2D (-x1) (-y1)
invertedVector (Vector3D x1 y1 z1) = Vector3D (-x1) (-y1) (-z1)
normalizedVector :: Vector -> Vector
normalizedVector vector = vectorComponentDivide vector $ distance vector
velocity vel0 mass1 mass2 vector deltaT =
vectorComponentMultiply (vectorComponentAdd vel0 (vectorComponentMultiply (normalizedVector vector) (acceleration (force vector mass1 mass2) mass1))) deltaT
data Actor = Actor String Vector Vector Double deriving (Show)
earth = Actor "Object1" (Vector3D 0 0 0) (Vector3D 0 0 0) 10
moon = Actor "Object2" (Vector3D 10 0 0) (Vector3D 0 0 0) 10
actors = [earth, moon]
combinations :: Int -> [a] -> [[a]]
combinations 0 _ = [ [] ]
combinations n xs = [ y:ys | y:xs' <- tails xs
, ys <- combinations (n-1) xs']
updateVelocity [(Actor name1 position1 velocity1 mass1),(Actor name2 position2 velocity2 mass2)] =
[(Actor name1 position1 a mass1),(Actor name2 position2 b mass2)]
where a = velocity velocity1 mass1 mass2 vector deltaT
b = velocity velocity2 mass2 mass1 (invertedVector vector) deltaT
vector = deltaVector position1 position2
deltaT = 1
updatePosition [(Actor name1 position1 velocity1 mass1),(Actor name2 position2 velocity2 mass2)] =
[Actor name1 (vectorComponentAdd position1 velocity1) velocity1 mass1, Actor name2 (vectorComponentAdd position2 velocity2) velocity2 mass2]
Relevant parts:
update list = map updatePosition (map updateVelocity list)
simulation state n = do
if n == 0
then do
print state
return ()
else do
let newState = update state
simulation newState $! (n-1)
test list n = iterate update list !! n
test2 list 0 = list
test2 list n = (test2 (update list) (n-1))
time :: IO t -> IO t
time a = do
start <- getCPUTime
v <- a
end <- getCPUTime
let diff = (fromIntegral (end - start)) / (10^12)
printf "Computation time: %0.3f sec\n" (diff :: Double)
return v
main :: IO ()
main = do
let combo = combinations 2 actors
putStrLn "Hello World!"
let n = 1000000
print n
--time $ print (test combo n)
time $ simulation combo n
_ <- getLine
putStrLn "BAI"

I believe laziness harms your code: your code builds large thunks (unevaluated expressions) which lead to OOM.
For instance, iterate is (in)famous for leading to large thunks, when you access the resulting list in the middle without forcing the previous list elements. More precisely
iterate f x !! n
is bad, since it will build the expression f (f (f ...(f x))) before really performing any work. We want to evaluate every list element before accessing the next one. This could be dome by a custom !! function:
(!!!) :: [a] -> Int -> a
[] !!! _ = error "!!!: out of range"
(x:_ ) !!! 0 = x
(x:xs) !!! n = seq x (xs !!! pred n)
Now we can use iterate f a !!! n without large thunks building up.
This has the same problem:
simulation state n = do
if n == 0
then do
print state
return ()
else do
let newState = update state
simulation newState $! (n-1)
It will build large update (update (update ...)) thunks without evaluating them. A possible fix could be
...
(simulation $! newState) $! (n-1)
However, keep in mind that in your case newState is a list (of lists!). In such case, seq or $! will only demand the list to be evaluated as far as its first cell constructor -- just enough to check whether the list is empty or not. This "forcing" might be enough or not for your purposes.
There is a library function named deepSeq which will force the full list, if really needed (use Hoogle to find the docs).
Summing up: lazy evaluation has its benefits and its downsides. It usually allows for more efficiency, e.g. sometimes providing constant space list processing without the need of writing carefully crafted functions. It also allows infinite lists tricks which are handy. However, it can also cause unwanted thunks to stick around for too long, wasting memory. So, in those cases, programmers have some burden put on them. Especially when one is used to strict semantics, these issues can be scary at first (we've been there!).

Related

Bad performance for parallel N-Body in Haskell

I wrote an N-body implementation in Haskell and tried to parallelize the updating of position of the particles (outer loop) using parList. However, the performance improvement from 1 to 3 cores is small, and it actually becomes worse for 4 cores. Here is the code, using 5 particles:
import Numeric.LinearAlgebra
import Data.List (zipWith4)
import Data.List.Split
import Control.DeepSeq
import System.Environment
import Control.Parallel.Strategies
type Vec = Vector Double
data Particle = Particle
{ tag :: Int
, position :: !Vec
, velocity :: !Vec
, mass :: Double
}
instance Eq Particle where
p1 == p2 = (tag p1) == (tag p2)
instance Show Particle where
show p = show $ position p
instance NFData Particle where
rnf p = t `seq` ps `seq` vel `seq` m `seq` ()
where
t = tag p
ps = position p
vel = velocity p
m = mass p
data System = System
{ number :: Int
, particles :: [Particle]
}
instance Show System where
show sys = show (particles sys)
instance NFData System where
rnf sys = rnf $ particles sys
g :: Double
g = 6.674e-11
-- | Construct a vector from a list of elements
mkVector :: [Double] -> Vec
mkVector = vector
-- | Construct a system from a given list of
-- position vectors, velocity vectors, and masses
mkSystem :: [(Vec, Vec, Double)] -> System
mkSystem xs = System
{ number = length xs
, particles = map (apply Particle) $ zipWith cons [0..] xs
}
where
cons y (a, b, c) = (y, a, b, c)
apply f (y, a, b, c) = f y a b c
-- | Calculate the gravitational force vector acted on p1 by p2
getForce :: Particle -> Particle -> Vec
getForce p1 p2
| p1 == p2 = scalar 0.0
| otherwise = scalar (g * (m1 * m2 / r^2)) * unit
where
m1 = mass p1
m2 = mass p2
r1 = position p1
r2 = position p2
dr = r2 - r1
r = norm_2 dr
unit = normalize dr
-- | Calculate the net gravitational force acted on the particle by
-- all the other particles
netForce :: Particle -> [Particle] -> Vec
netForce p ps = sum (map (getForce p) ps)
-- | Update the position and velocity of a particle in the system
-- through a given timestep
move :: Double -> System -> Particle -> Particle
move h sys p = let
(pos, vel) = (position p, velocity p)
acc = (netForce p $ particles sys) / (scalar $ mass p)
in
p { position = pos + scalar h * vel
, velocity = vel + scalar h * acc
}
stepSize = 1000
-- | Update the system through one timestep
evolve :: System -> System
evolve sys = sys { particles = ps' }
where
ps' = map (move stepSize sys) (particles sys) `using` parList rdeepseq
-- | Stream of system at different timesteps
evolution :: System -> [System]
evolution = iterate evolve
sys1 :: System
sys1 = mkSystem
[ (mkVector [1.496e11, 0], mkVector [0, 2.98e4], 5.974e24)
, (mkVector [2.279e11, 0], mkVector [0, 2.41e4], 6.42e23)
, (mkVector [5.79e10, 0], mkVector [0, 4.8e4], 3.3e23)
, (mkVector [0, 0], mkVector [0, 0], 1.98e30)
, (mkVector [ 1.08e11, 0], mkVector [0, 3.5e4], 4.87e24)
]
main :: IO ()
main = do
[n] <- fmap (map read) getArgs :: IO [Int]
let states = evolution sys1
finalState = states !! n
finalState `deepseq` (return ())
What is limiting the parallelism?
Two thoughts:
I don't recommend HMatrix. It's a “Matlab in a box” library, which not only goes strongly against Haskell's grain in terms of semantics (dynamical dimension checking† etc.) but also subverts Haskell's better sides in performance. The idea of HMatrix/Matlab is to work with large, monolithic, heap-allocated arrays and do as much as possible with linear algebra primitives (which are implemented in C). This approach makes sense in a slow language like Matlab or Python (you delegate the inner loops to another, faster language), but not really in Haskell: the external calls can't properly be inlined, unlike native Haskell functions, and they add some overhead which though it may be negligible when crunching large vectors, can definitely add up for small ones. Pointer indirection harms cache performance.
The most popular static, native LA library is linear, which takes a much more Haskell-oriented approach (functors everywhere), and has proper tight memory layout. (I'm actually not such a fan of the interface itself, but the data types can also be used with the very nice vector-space operators.)
Switching to the types from linear improves the performance (single-threaded) by a factor 10 for me.
import Data.VectorSpace
import Data.VectorSpace.Free
import Linear.V2
import Data.List (zipWith4)
import Data.List.Split
import Control.DeepSeq
import System.Environment
import Control.Parallel.Strategies
type Vec = V2 Double -- In case you're wondering: you don't need to
-- hard-code the dimension, you can also make your
-- functions _polymorphic_ on the vector space.
data Particle = Particle
{ tag :: !Int
, position :: !Vec
, velocity :: !Vec
, mass :: !Double
}
instance Eq Particle where
p1 == p2 = (tag p1) == (tag p2)
instance Show Particle where
show p = show $ position p
instance NFData Particle where
rnf p = t `seq` ps `seq` vel `seq` m `seq` ()
where
t = tag p
ps = position p
vel = velocity p
m = mass p
data System = System
{ number :: Int
, particles :: [Particle]
}
instance Show System where
show sys = show (particles sys)
instance NFData System where
rnf sys = rnf $ particles sys
g :: Double
g = 6.674e-11
-- | Construct a vector from a list of elements
mkVector :: [Double] -> Vec
mkVector [x,y] = V2 x y
-- | Construct a system from a given list of
-- position vectors, velocity vectors, and masses
mkSystem :: [(Vec, Vec, Double)] -> System
mkSystem xs = System
{ number = length xs
, particles = map (apply Particle) $ zipWith cons [0..] xs
}
where
cons y (a, b, c) = (y, a, b, c)
apply f (y, a, b, c) = f y a b c
-- | Calculate the gravitational force vector acted on p1 by p2
getForce :: Particle -> Particle -> Vec
getForce p1 p2
| p1 == p2 = zeroV
| otherwise = (g * (m1 * m2 / r^2)) *^ unit
where
m1 = mass p1
m2 = mass p2
r1 = position p1
r2 = position p2
dr = r2 - r1
r = magnitude dr
unit = dr ^/ r
-- | Calculate the net gravitational force acted on the particle by
-- all the other particles
netForce :: Particle -> [Particle] -> Vec
netForce p ps = sum (map (getForce p) ps)
-- | Update the position and velocity of a particle in the system
-- through a given timestep
move :: Double -> System -> Particle -> Particle
move h sys p = let
(pos, vel) = (position p, velocity p)
acc = (netForce p $ particles sys) ^/ mass p
in
p { position = pos ^+^ h *^ vel
, velocity = vel ^+^ h *^ acc
}
stepSize = 1000
-- | Update the system through one timestep
evolve :: System -> System
evolve sys = sys { particles = ps' }
where
ps' = map (move stepSize sys) (particles sys) `using` parList rdeepseq
-- | Stream of system at different timesteps
evolution :: System -> [System]
evolution = iterate evolve
sys1 :: System
sys1 = mkSystem
[ (mkVector [1.496e11, 0], mkVector [0, 2.98e4], 5.974e24)
, (mkVector [2.279e11, 0], mkVector [0, 2.41e4], 6.42e23)
, (mkVector [5.79e10, 0], mkVector [0, 4.8e4], 3.3e23)
, (mkVector [0, 0], mkVector [0, 0], 1.98e30)
, (mkVector [ 1.08e11, 0], mkVector [0, 3.5e4], 4.87e24)
]
main :: IO ()
main = do
[n] <- fmap (map read) getArgs :: IO [Int]
let states = evolution sys1
finalState = states !! n
finalState `deepseq` (return ())
I wouldn't expect too gain much from parallelisation for only five particles anyhow. Each thread has very little it can do before giving back control, and everything interacts. You therefore quickly notice the overhead even of Haskell's light green threads.
To benefit properly from parallelisation, you'll need to either set up the threads as a thread pool (like you would in traditional number-crunching languages) and thus avoid the sparking overhead, or make sure each thread has a lot to do. This works best if you mostly decouple the threads' domains; in really-many body applications this is done with something like a Barnes-Hut simulation.
Another thing: you're right now using a simple Euler solver for solving the equations of motion. That's a very bad scheme. Switching to a higher-order Runge Kutta solver, ideally with adaptive step size, would allow you to save so much in terms of number of steps that the parallelisation aspect largely pales in impact by comparison.
†Actually, HMatrix also has had a statically checked module for quite some time now.

Haskell :: Recursion in Recursion for Loop in Loop (Part 2)

This question derived from previous question and answer. You can found the link here: Haskell :: Recursion in Recursion for Loop in Loop (Part 1)
The question were answered, I can say super amazing with nice explanation for future reference. Credit to #user2407038 for his amazing skills. However, something interesting to ponder with recursion with more than two partition. To make it clear I've changed the data a little bit for simplicity. Here how it looks:
Previously, the 2 red dots were generated by finding (min x, min y) and (max x, max y). To generate 4 red dots (min x, min y) (max x, min y) (min x, max y) (max x, max y) partition4 should take into consideration. Visually it looks like this:
Considering the max members for each group is 3, group 1 and group 4 exceed the number. A new group should be created based on these group. However, the trickier part is that this group will not compute the distance with previous red dots:
The edited code for previous question:
data Point = Point { ptX :: Double, ptY :: Double }
data Cluster = Cluster { clusterPts :: [Point] }
minMaxPoints :: [Point] -> (Point, Point)
minMaxPoints ps =
(Point minX minY
,Point maxX maxY)
where minX = minimum $ map ptX ps
maxX = maximum $ map ptX ps
minY = minimum $ map ptY ps
maxY = maximum $ map ptY ps
main = do
let pointDistance :: Point -> Point -> Double
pointDistance (Point x1 y1) (Point x2 y2) = sqrt $ (x1-x2)^2 + (y1-y2)^2
cluster1 :: [Point] -> [Cluster]
cluster1 ps =
let (mn, mx) = minMaxPoints ps
(psmn, psmx) = partition (\p -> pointDistance mn p < pointDistance mx p) ps
in [ Cluster psmn, Cluster psmx ]
cluster :: [Point] -> [Cluster]
cluster ps =
cluster1 ps >>= \cl#(Cluster c) ->
if length c > 5
then cluster c
else [cl]
testPts :: [Point]
testPts = map (uncurry Point)
[ (1,0), (2,1), (0,2)
, (5,2), (4,3), (4,4)
, (8,2), (9,3), (10,2)
, (11,4), (12,3), (13,3) ]
main = mapM (map (\p -> (ptX p, ptY p)) . clusterPts) $ cluster testPts
print main
I've found it when the length c changed the answer as not as expected it should be. Perhaps I've edited it wrongly (Sigh).
Still figuring how to fit in PartitionN code for partitioning into N groups as suggested.

Partial application memory management in Haskell

I have a function ascArr :: String -> BigData for parsing some big strict data from a string and another one, altitude :: BigData -> Pt -> Maybe Double, for getting something useful from the parsed data. I want to parse the big data once and then use the altitude function with the first argument fixed and the second one varying. Here's the code (TupleSections are enabled):
exampleParseAsc :: IO ()
exampleParseAsc = do
asc <- readFile "foo.asc"
let arr = ascArr asc
print $ map (altitude arr . (, 45)) [15, 15.01 .. 16]
This is all ok. Then I want to connect the two functions together and to use partial application for caching the big data. I use three versions of the same function:
parseAsc3 :: String -> Pt -> Maybe Double
parseAsc3 str = altitude d
where d = ascArr str
parseAsc4 :: String -> Pt -> Maybe Double
parseAsc4 str pt = altitude d pt
where d = ascArr str
parseAsc5 :: String -> Pt -> Maybe Double
parseAsc5 = curry (uncurry altitude . first ascArr)
And I call them like this:
exampleParseAsc2 :: IO ()
exampleParseAsc2 = do
asc <- readFile "foo.asc"
let alt = parseAsc5 asc
print $ map (alt . (, 45)) [15, 15.01 .. 16]
Only the parseAsc3 works like in the exampleParseAsc: Memory usage rises at the beginning (when allocating memory for the UArray in the BigData), then it is constant while parsing, then altitude quickly evaluates the result and then everything is done and the memory is freed. The other two versions are different: The memory usage rises multiple times until all the memory is consumed, I think that the parsed big data is not cached inside the alt closure. Could someone explain the behaviour? Why are the versions 3 and 4 not equivalent? In fact I started with something like parseAsc2 function and just after hours of trial I found out the parseAsc3 solution. And I am not satisfied without knowing the reason...
Here you can see all my effort (only the parseAsc3 does not consume whole the memory; parseAsc is a bit different from the others - it uses parsec and it was really greedy for memory, I'd be glad if some one explained me why, but I think that the reason is different than the main point of this question, you may just skip it):
type Pt = (Double, Double)
type BigData = (UArray (Int, Int) Double, Double, Double, Double)
parseAsc :: String -> Pt -> Maybe Double
parseAsc str (x, y) =
case parse ascParse "" str of
Left err -> error "no parse"
Right (x1, y1, coef, m) ->
let bnds = bounds m
i = (round $ (x - x1) / coef, round $ (y - y1) / coef)
in if inRange bnds i then Just $ m ! i else Nothing
where
ascParse :: Parsec String () (Double, Double, Double, UArray (Int, Int) Double)
ascParse = do
[w, h] <- mapM ((read <$>) . keyValParse digit) ["ncols", "nrows"]
[x1, y1, coef] <- mapM ((read <$>) . keyValParse (digit <|> char '.'))
["xllcorner", "yllcorner", "cellsize"]
keyValParse anyChar "NODATA_value"
replicateM 6 $ manyTill anyChar newline
rows <- replicateM h . replicateM w
$ read <$> (spaces *> many1 digit)
return (x1, y1, coef, listArray ((0, 0), (w - 1, h - 1)) (concat rows))
keyValParse :: Parsec String () Char -> String -> Parsec String () String
keyValParse format key = string key *> spaces *> manyTill format newline
parseAsc2 :: String -> Pt -> Maybe Double
parseAsc2 str (x, y) = if all (inRange bnds) (is :: [(Int, Int)])
then Just $ (ff * (1 - px) + cf * px) * (1 - py)
+ (fc * (1 - px) + cc * px) * py
else Nothing
where (header, elevs) = splitAt 6 $ lines str
header' = map ((!! 1) . words) header
[w, h] = map read $ take 2 header'
[x1, y1, coef, _] = map read $ drop 2 header'
bnds = ((0, 0), (w - 1, h - 1))
arr :: UArray (Int, Int) Double
arr = listArray bnds (concatMap (map read . words) elevs)
i = [(x - x1) / coef, (y - y1) / coef]
[ixf, iyf, ixc, iyc] = [floor, ceiling] >>= (<$> i)
is = [(ix, iy) | ix <- [ixf, ixc], iy <- [iyf, iyc]]
[px, py] = map (snd . properFraction) i
[ff, cf, fc, cc] = map (arr !) is
ascArr :: String -> BigData
ascArr str = (listArray bnds (concatMap (map read . words) elevs), x1, y1, coef)
where (header, elevs) = splitAt 6 $ lines str
header' = map ((!! 1) . words) header
[w, h] = map read $ take 2 header'
[x1, y1, coef, _] = map read $ drop 2 header'
bnds = ((0, 0), (w - 1, h - 1))
altitude :: BigData -> Pt -> Maybe Double
altitude d (x, y) = if all (inRange bnds) (is :: [(Int, Int)])
then Just $ (ff * (1 - px) + cf * px) * (1 - py)
+ (fc * (1 - px) + cc * px) * py
else Nothing
where (arr, x1, y1, coef) = d
bnds = bounds arr
i = [(x - x1) / coef, (y - y1) / coef]
[ixf, iyf, ixc, iyc] = [floor, ceiling] >>= (<$> i)
is = [(ix, iy) | ix <- [ixf, ixc], iy <- [iyf, iyc]]
[px, py] = map (snd . properFraction) i
[ff, cf, fc, cc] = map (arr !) is
parseAsc3 :: String -> Pt -> Maybe Double
parseAsc3 str = altitude d
where d = ascArr str
parseAsc4 :: String -> Pt -> Maybe Double
parseAsc4 str pt = altitude d pt
where d = ascArr str
parseAsc5 :: String -> Pt -> Maybe Double
parseAsc5 = curry (uncurry altitude . first ascArr)
Compiled with GHC 7.10.3, with -O optimization.
Thank you.
You can figure out what's happening by looking at the generated core from GHC. The evaluation semantics of optimized core are very predictable (unlike Haskell itself) so it is often a useful tool for performance analysis.
I compiled your code with ghc -fforce-recomp -O2 -ddump-simpl file.hs with GHC 7.10.3. You can look at the full output yoursefl but I've extracted the relevant bits:
$wparseAsc2
$wparseAsc2 =
\ w_s8e1 ww_s8e5 ww1_s8e6 ->
let { ...
parseAsc2 =
\ w_s8e1 w1_s8e2 ->
case w1_s8e2 of _ { (ww1_s8e5, ww2_s8e6) ->
$wparseAsc2 w_s8e1 ww1_s8e5 ww2_s8e6
}
The code above looks a little funny but is essentially Haskell. Note that the first thing parseAsc2 does is force its second argument to be evaluated (the case statement evaluates the tuple, which corresponds to the pattern match) - but not the string. The string won't be touched until deep inside $wParseAsc2 (definition omitted). But the part of the function that computes the "parse" is inside the lambda - it will be recomputed for every invocation of the function. You don't even have to look at what it is - the rules for evaluating core expressions are very prescriptive.
$wparseAsc
$wparseAsc =
\ w_s8g9 ww_s8gg ww1_s8gi -> ...
parseAsc
parseAsc =
\ w_s8g9 w1_s8ga ->
case w1_s8ga of _ { (ww1_s8gd, ww2_s8gi) ->
case ww1_s8gd of _ { D# ww4_s8gg ->
$wparseAsc w_s8g9 ww4_s8gg ww2_s8gi
}
}
The situation with parseAsc has little to do with Parsec*. This is much like version two - now both arguments are evaluated, however. This has little effect, however, on the performance, because the same problem is there - $wparseAsc is just a lambda, meaning all the work it does is done at every invocation of the function. There can be no sharing.
parseAsc3 =
\ str_a228 ->
let {
w_s8c1
w_s8c1 =
case $wascArr str_a228
of _ { (# ww1_s8gm, ww2_s8gn, ww3_s8go, ww4_s8gp #) ->
(ww1_s8gm, ww2_s8gn, ww3_s8go, ww4_s8gp)
} } in
\ w1_s8c2 ->
case w1_s8c2 of _ { (ww1_s8c5, ww2_s8c6) ->
$waltitude w_s8c1 ww1_s8c5 ww2_s8c6
}
Here is the "good" version. It takes a string, applies $wascArr to it, and then the string is never used again. This is crucial - if this function is partially applied to a string, you are left with let w_s = .. in \w1 -> ... - none of this mentions the string, so it can be garbage collected. The long lived reference is to w_s which is your "big data". And note: even if a reference to the string was maintained, and it could not be garbage collected, this version would still be substantially better - simply because it does not recompute the "parse" at each invocation of the function. This is the critical flaw - the fact that the string can be garbage collected immediately is extra.
parseAsc4 =
\ str_a22a pt_a22b ->
case pt_a22b of _ { (ww1_s8c5, ww2_s8c6) ->
$waltitude (ascArr str_a22a) ww1_s8c5 ww2_s8c6
}
Same issue as version two. Unlike version three, if you partially apply this, you get \w1 -> altitude (ascArr ...) ..., so ascArr is recomputed for every invocation of the function. It doesn't matter how you use this function - it simply won't work the way you want.
parseAsc5 = parseAsc4
Amazingly (to me), GHC figures out that parseAsc5 is precisely the same as parseAsc4! Well this one should be obvious then.
As for why GHC generates this particular core for this code, it really isn't easy to tell. In many cases the only way to guarantee sharing is to have explicit sharing in your original code. GHC does not do common subexpression elimination - parseAsc3 implements manual sharing.
*Maybe the parser itself has some performance issues too, but that isn't the focus here. If you have question about your Parsec parser (performance wise, or otherwise) I encourage you to ask a separate question.

Are the parentheses necessary in this Haskell code

data Point = Point Float Float deriving (Show)
data Line = Line Point Point deriving (Show)
onLine :: Line -> Point -> Bool
onLine (Line (Point x1 y1) (Point x2 y2)) (Point x y) = True
Is there a way not to use so many brackets ?
I recommend a tool called hlint for identifying places where you can simplify your code.
In your code /as written/, you're not using the values x1, y1, x2, y2, x or y, so you could just write:
onLine _ _ = True
However, I assume that's just a stub, and in reality you will do something with the variables. In general, if you really need to reference all those variables, then you need to write it the way you have done. However, maybe you're using a helper function that only needs the entire line value. Then you could write something like:
onLine l p = blah blah blah
-- use slope l and yIntercept l to figure out if p is on the line
slope :: Line -> Float
slope (Line (Point x1 y1) (Point x2 y2)) = (y2 - y1) / (x2 - x1)
yIntercept :: Line -> Float
yIntercept (Line (Point x1 y1) (Point x2 y2)) = blah blah blah
Alternatively, you can just use accessor functions to extract the x and y co-ordinates from points and lines, but in this case it will probably make your code messier.
Also, in Haskell I believe it's generally more efficient to use Double rather than Float.
You can sometimes avoid brackets with record notation, sometimes with $, sometimes with infix functions, and sometimes they're OK if not excessive.
Let's use record notation for points, which get heavy access for the coordinates, but we'll leave Line alone.
data Point = Point {x::Double,y::Double} deriving (Show)
data Line = Line Point Point deriving (Show)
This defines x :: Point -> Double and y :: Point -> Double.
There's no such thing as equality for floating points, but I'll go for roughly right:
accuracy = 0.000000000001
is :: Double -> Double -> Bool
is x y = abs (x - y) < accuracy
I can use this as x point1 `is` x point2 neatly avoiding the bracketed is (x point1) (x point2)
When your data structure is not so heavily nested with pattern matching, a few brackets are easy to read:
gradient :: Line -> Double
gradient (Line one two) = (y two - y one) / (x two - x one)
But we can go one level deeper without using excessive brackets because of the functions x and y.
asFunction :: Line -> (Double -> Double) -- ( ) for clarity, not necessity
asFunction l#(Line point _) = \xx -> gradient l * (xx - x point) + y point
Notice I've used l# to introduce an alias for (Line point _) to save typing on the right.
Now we can use the infix function trick to get rid of a few more brackets:
onLine :: Line -> Point -> Bool
onLine l p = l `asFunction` x p `is` y p
On the right hand side, you can use $ to get rid of brackets, but you can't use it on the left in pattern matching because it's a function f $ x = f x. For example
this (that (the other thing (something other)))
= this $ that $ the other thing $ something other
= this . that . the other thing $ something other
You can take the line and point apart within the function by defining accessors, but there is no way to do the pattern matching without the parentheses.
Another way of getting rid of the parentheses is to do the pattern matching in a number of case expressions:
onLine l p = case l of
Line p1 p2 -> case p1 of
Point x1 y1 -> case p2 of
Point x2 y2 -> case p of
Point x y -> True -- you can use x1,y1,x2,y2,x and y here
This is close to what the compiler 'translates' the patternmatches to, but of course this is not much of an improvement!
However, there are a number of ways of writing this expression that also translate to the same cascaded pattern matching; here's one:
onLine l p = let
Line (Point x1 y1) (Point x2 y2) = l
Point x y = p
in True
and here's another:
onLine l p = True where
Line (Point x1 y1) (Point x2 y2) = l
Point x y = p
The last one is pretty nice and readable, in my opinion, but the other suggestions are much better, since they'll lead to a better structured program!
(There's some stuff about irrefutable patterns that I'm glossing over, and this only works for single-constructor datatypes)

How can duplication be eliminated from the following Haskell snippet?

The following function clearly has duplication between the two list comprehensions, but how can it be eliminated without increasing the total length of the code? I've got a sneaky feeling there's a nice abstraction lurking here but I just can't see it...
letterAt :: [Word] -> Int -> Int -> Maybe Char
letterAt wrds x y = listToMaybe $
[wtext !! (x - wx) |
Word wx wy wtext Across <- wrds,
wy == y && x >= wx && x < wx + length wtext] ++
[wtext !! (y - wy) |
Word wx wy wtext Down <- wrds,
wx == x && y >= wy && y < wy + length wtext]
Some background:
The function is taken from a crossword program. The crossword is represented as [Word], where
data Word = Word { startX :: Int,
startY :: Int,
text :: String,
sense :: Sense }
data Sense = Across | Down
The words where sense == Across start at position (startX, startY) and continue in the positive x direction, and those where sense == Down continue in the positive y direction. The aim of the function is to get the character at location (x, y) in a Just, or Nothing if there isn't a character there.
Feel free to point out any other sins against Haskell I've committed here, I've just started with the language and still trying to get to grips with it!
Here are some points about your code:
It is better to use filter when want to select certain elements of a list based on the predicate.
Since you just want the first element satisfying certain predicate you can use Data.List.find
Your conditions looks symmetric so you can define a transform function as
transform f x y (Word wx wy wtext Across) = f wtext wy wx y x
transform f x y (Word wx wy wtext Down) = f wtext wx wy x y
Now writing the code will require writing conditions only once
letterAt :: [Word] -> Int -> Int -> Maybe Char
letterAt wrds x y = (transform charValue x y) <$> find (transform condition x y) wrds
where
condition wtext wx wy x y = wx == x && y >= wy && y < wy + length wtext
charValue wtext wx wy x y = wtext !! (y-wy)
Satvik, thanks for your answer which got me thinking along the right lines. I separated out the condition and transformation functions as you suggested, then realized that it would be simpler to transform the data rather than the functions and put everything back into a list comprehension for readability:
letterAt :: [Word] -> Int -> Int -> Maybe Char
letterAt wrds x y = listToMaybe
[wtext !! x' | Word wx wy wtext sens <- wrds,
let (x', y') = case sens of
Across -> (x - wx, y - wy)
Down -> (y - wy, x - wx),
y' == 0, x' >= 0, x' < length wtext ]
You pointed out that it's better to use Data.find in this case.. is this for readability or efficiency? I'm guessing that because lists are lazy in Haskell, the above code would stop after the first item in the list comprehension was evaluated, is this right?

Resources