What's wrong with my Graham Scan function? - haskell

I almost finish the chapter 3 of Real World Haskell. The last exercise blocks me. My code will crash while running. Does anyone can tell me which part is wrong in my code? Thanks.
Question:
Using the code from the preceding three exercises, implement Graham's scan algorithm for the convex hull of a set of 2D points. You can find good description of what a convex hull is, and how the Graham scan algorithm should work, on Wikipedia.
Answer:
-- Graham Scan, get the convex hull.
-- Implement the algorithm on http://en.wikipedia.org/wiki/Graham_scan
import Data.List
import Data.Ord
data Direction = TurnLeft | TurnRight | GoStraight deriving (Eq, Show)
-- Determine if three points constitute a "left turn" or "right turn" or "go straight".
-- For three points (x1,y1), (x2,y2) and (x3,y3), simply compute the direction of the cross product of the two vectors defined by points (x1,y1), (x2,y2) and (x1,y1), (x3,y3), characterized by the sign of the expression (x2 − x1)(y3 − y1) − (y2 − y1)(x3 − x1). If the result is 0, the points are collinear; if it is positive, the three points constitute a "left turn", otherwise a "right turn".
direction a b c = case compare ((x2 - x1) * (y3 - y1)) ((y2 - y1) * (x3 - x1)) of
EQ -> GoStraight
GT -> TurnLeft
LT -> TurnRight
where x1 = fst a
y1 = snd a
x2 = fst b
y2 = snd b
x3 = fst c
y3 = snd c
grahamScan points = scan (sort points)
-- For each point, it is determined whether moving from the two previously considered points to this point is a "left turn" or a "right turn". If it is a "right turn", this means that the second-to-last point is not part of the convex hull and should be removed from consideration. This process is continued for as long as the set of the last three points is a "right turn". As soon as a "left turn" is encountered, the algorithm moves on to the next point in the sorted array. (If at any stage the three points are collinear, one may opt either to discard or to report it, since in some applications it is required to find all points on the boundary of the convex hull.)
where scan (a : (b : (c : points)))
| (direction a b c) == TurnRight = scan (a : (c : points))
| otherwise = a : (scan (b : (c : points)))
scan (a : (b : [])) = []
-- Put prime to the head.
sort points = prime : (reverse (sortBy (compareByCosine prime) rest))
-- Sort a list to compute. The first step is to find a point whose y-coordinate is lowest. If there are more than one points with lowest y-coordinate, take the one whose x-coordinate is lowest. I name it prime.
where compareByYAndX a b
| compareByY == EQ = comparing fst a b
| otherwise = compareByY
where compareByY = comparing snd a b
prime = minimumBy compareByYAndX points
-- Delete prime from the candidate points. Sort the rest part by the cosine value of the angle between each vector from prime to each point. Reverse it and put prime to the head.
rest = delete prime points
compareByCosine p a b = comparing cosine pa pb
where pa = (fst a - fst p, snd a - snd p)
pb = (fst b - fst p, snd b - snd p)
cosine v = x / sqrt (x ^ 2 + y ^ 2)
where x = fst v
y = snd v

When doing the scan on the sorted set of points, when you finish, you throw away points that are supposed to be in the hull. In this line
scan (a : (b : [])) = []
you are deleting the last two points in the hull. Really it should be
scan (a : (b : [])) = [a, b]
or even better,
scan ps = ps
which covers cases with only one point.

Related

Haskell :: Recursion in Recursion for Loop in Loop

How it goes: Based on the set of tuple (id, x, y), find the min max for x and y , then two dots (red points) created. Each element in tuple are grouped to two groups based on the distance towards the red dots.
Each group cant exceed 5 dots. If exceed, new group should be computed. I've managed to do recursion for the first phase. But I have no idea how to do it for second phase. The second phase should look like this:
Based on these two groups, again it need to find the min max for x and y (for each group), then four dots (red points) created. Each element in tuple are grouped to two groups based on the distance towards the red dots.
getDistance :: (Int, Double, Double) -> (Int, Double, Double) -> Double
getDistance (_,x1,y1) (_,x2,y2) = sqrt $ (x1-x2)^2 + (y1-y2)^2
getTheClusterID :: (Int, Double, Double) -> Int
getTheClusterID (id, _, _) = id
idxy = [(id, x, y)]
createCluster id cs = [(id, minX, minY),(id+1, maxX, minY), (id+2, minX, maxY), (id+3, maxX, maxY)]
where minX = minimum $ map (\(_,x,_,_) -> x) cs
maxX = maximum $ map (\(_,x,_,_) -> x) cs
minY = minimum $ map (\(_,_,y,_) -> y) cs
maxY = maximum $ map (\(_,_,y,_) -> y) cs
idCluster = [1]
cluster = createCluster (last idCluster) idxy
clusterThis (id,a,b) = case (a,b) of
j | getDistance (a,b) (cluster!!0) < getDistance (a,b) (cluster!!1) &&
-> (getTheClusterID (cluster!!0), a, b)
j | getDistance (a,b) (cluster!!1) < getDistance (a,b) (cluster!!0) &&
-> (getTheClusterID (cluster!!1), a, b)
_ -> (getTheClusterID (cluster!!0), a, b)
groupAll = map clusterThis idxy
I am moving from imperative to functional. Sorry if my way of thinking is still in imperative way. Still learning.
EDIT:
To clarify, this is the original data looks like.
The basic principle to follow in writing such an algorithm is to write small, compositional programs; each program is then easy to reason about and test in isolation, and the final program can be written in terms of the smaller ones.
The algorithm can be summarized as follows:
Compute the points which bound the set of points.
Split the rest of the points into two clusters, one containing points closer to the minimum point, the other containing all other points (equivalently, points closer to the maximum point).
If any cluster contains more than 5 points, repeat the process on that cluster.
The presence of a 'repeat the process' step indicates this to be a divide and conquer problem.
I see no need for an ID for each point, so I've dispensed with this.
To begin, define datatypes for each type of data you will be working with:
import Data.List (partition)
data Point = Point { ptX :: Double, ptY :: Double }
data Cluster = Cluster { clusterPts :: [Point] }
This may seem silly for such simple data, but it can potentially save you quite a bit of confusion during debugging. Also note the import of a function we will be using later.
The 1st step:
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
This is essentially the same as your createCluster function.
The 2nd step:
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 ]
This function should clear - it is a direct translation of the above statement of this step into code. The partition function takes a predicate and a list and produces two lists, the first containing all elements for which the predicate is true, and the second all elements for which it is false. pointDistance is essentially the same as your getDistance function.
The 3rd step:
cluster :: [Point] -> [Cluster]
cluster ps =
cluster1 ps >>= \cl#(Cluster c) ->
if length c > 5
then cluster c
else [cl]
This also implements the statement above very directly. Perhaps the only confusing part is the use of >>=, which (here) has type [a] -> (a -> [b]) -> [b]; it simply applies the given function to each element of the given list, and concatenates the result (equivalently, it is written flip concatMap).
Finally your test case (which I hope I've translated correctly from pictures to Haskell data):
testPts :: [Point]
testPts = map (uncurry Point)
[ (0,0), (1,0), (2,1), (0,2)
, (5,2), (5,4), (4,3), (4,4)
, (8,2), (9,3), (10,2)
, (11,4), (12,3), (13,3), (13,5) ]
main = mapM_ (print . map (\p -> (ptX p, ptY p)) . clusterPts) $ cluster testPts
Running this program produces
[(0.0,0.0),(0.0,2.0),(2.0,1.0),(1.0,0.0)]
[(4.0,4.0),(5.0,2.0),(5.0,4.0),(4.0,3.0)]
[(10.0,2.0),(9.0,3.0),(8.0,2.0)]
[(13.0,3.0),(12.0,3.0),(11.0,4.0),(13.0,5.0)]
Functional programmers love recursion, yet they go to great lengths to avoid writing it. Jeez, people, make up your minds!
I like to structure my code, to the extent possible, using common, well-understood combinators. I want to demonstrate a style of Haskell programming which leans heavily on standard tools to implement the boring parts of a program (mapping, zipping, looping) as tersely and generically as possible, freeing you up to focus on the problem at hand.
So don't worry if you don't understand everything here. I just want to show you what's possible! (And please ask if you have questions!)
Vectors
First things first: we're working with two-dimensional space, so we'll need two-dimensional vectors and some secondary school vector algebra to work with them.
I'm going to parameterise my vector by the scalar on which our vector space is built. This'll allow me to work with standard type classes like Functor, so I can delegate a lot of the work of building a vector algebra to the machine. I've turned on DeriveFunctor and DeriveFoldable, which allow me to utter the magic words deriving (Functor, Foldable).
data Pair a = Pair {
px :: a,
py :: a
} deriving (Show, Functor, Foldable)
Hereafter I'm going to avoid working explicitly with Pair, and program to an interface, not an implementation. This'll allow me to build a simple linear algebra library in a manner that's independent of the dimensionality of the vector space. I'll give example type signatures in terms of V2:
type V2 = Pair Double
Scalar multiplication: functors
A vector space is required to have two operations: scalar multiplication and vector addition. Scalar multiplication means multiplying each component of a vector by a constant scalar. If you view a vector as a container of components, it should be clear that this means "do the same thing to every element in a container" - that is, it's a mapping operation. That's what Functor is for.
-- mul :: Double -> V2 -> V2
mul :: (Functor f, Num n) => n -> f n -> f n
mul k f = fmap (k *) f
Vector addition: zippy applicatives
Vector addition involves adding up the components of a vector point-wise. Thinking of a vector as a container of components, addition is a zipping operation - match up each element of the two vectors and add them up.
Applicative functors are functors with an additional "apply" operation. Thinking of a functor f as a container, Applicative's <*> :: f (a -> b) -> f a -> f b gives you a way to take a container of functions and apply it to a container of values to get a new container of values. It should be clear that one way to make Pair into an Applicative is to use zipping to apply functions to values.
instance Applicative Pair where
pure x = Pair x x
Pair f g <*> Pair x y = Pair (f x) (g y)
(For another example of a zippy applicative, see this answer of mine.)
Now that we have a way to zip two pairs, we can leverage a bit of standard Applicative machinery to implement vector addition.
-- add :: V2 -> V2 -> V2
add :: (Applicative f, Num n) => f n -> f n -> f n
add = liftA2 (+)
Vector subtraction, which gives you a way to find the distance between two points, is defined in terms of multiplication and addition.
-- minus :: V2 -> V2 -> V2
minus :: (Applicative f, Num n) => f n -> f n -> f n
v `minus` u = v `add` mul (-1) u
Dot products: foldable containers
2D Euclidean space is actually a Hilbert space - a vector space equipped with a way to measure lengths and angles in the form of a dot product. To take the dot product of two vectors, you multiply the components together and then add up the results. Once more, we'll be using Applicative to multiply the components, but that just gives us another vector: how do we implement "adding up the results"?
Foldable is the class of containers which admit an "aggregation" operation foldr :: (a -> b -> b) -> b -> f a -> b. The standard prelude's sum is defined in terms of foldr, so:
-- dot :: V2 -> V2 -> Double
dot :: (Applicative f, Foldable f, Num n) => f n -> f n -> n
v `dot` u = sum $ liftA2 (*) v u
This gives us a way to find the absolute length of a vector: dot it with itself and take the square root.
-- modulus :: V2 -> Double
modulus :: (Applicative f, Foldable f, Floating n) => f n -> n
modulus v = sqrt $ v `dot` v
So the distance between two points is the modulus of the difference of the vectors.
dist :: (Applicative f, Foldable f, Floating n) => f n -> f n -> n
dist v u = modulus (v `minus` u)
N-ary zipping: traversable containers
An axis-aligned (hyper-)rectangle can be defined by just two points. We'll represent the bounding box of a set of points as a Pair of vectors pointing to opposite corners of the bounding box.
Given a collection of vectors of components, we can find the opposite corners of the bounding box by finding the maximum and minimum of each component across the collection. This requires us to zip up, or transpose, a collection of vectors of components into a vector of collections of components. For this I'll use Traversable's sequenceA.
-- boundingBox :: [V2] -> Pair V2
boundingBox :: (Traversable t, Applicative f, Ord n) => t (f n) -> Pair (f n)
boundingBox vs =
let components = sequenceA vs
in Pair (minimum <$> components) (maximum <$> components)
Clustering
Now that we have a library for working with vectors, we can get down to the meaty part of the algorithm: dividing sets of points into clusters.
Partitioning
Let me rephrase the specification of the inner loop of your algorithm. You want to partition a set of points based on whether they're closer to the bottom-left corner of the set's bounding box or to the top-right corner. That's what partition does.
We can write a function, whichCluster which uses minus and modulus to decide this for a single point, and then use partition to apply it to the whole set.
type Cluster = []
-- cluster :: Cluster V2 -> [Cluster V2]
cluster :: (Applicative f, Foldable f, Ord n, Floating n) => Cluster (f n) -> [Cluster (f n)]
cluster vs =
let Pair bottomLeft topRight = boundingBox vs
whichCluster v = dist v bottomLeft <= dist v topRight
(g1, g2) = partition whichCluster vs
in [g1, g2]
Repetition, repetition, repetition
Now we want to repeatedly cluster until we don't have any groups larger than 5. Here's the plan. We'll keep track of two sets of clusters, those which are small enough, and those which require further sub-clustering. I'll use partition to sort a list of clusters into those which are small enough and those which need subclustering. I'll use the list monad's >>= :: [a] -> (a -> [b]) -> [b] (here [Cluster V2] -> ([V2] -> [Cluster V2]) -> [Cluster V2]), which maps a function over a list and flattens the result, to implement the notion of subclustering. And I'll use until to repeatedly subcluster until the set of remaining too-large clusters is empty.
-- smallClusters :: Int -> Cluster V2 -> [Cluster V2]
smallClusters :: (Applicative f, Foldable f, Ord n, Floating n) => Int -> Cluster (f n) -> [Cluster (f n)]
smallClusters maxSize vs = fst $ until (null . snd) splitLarge ([], [vs])
where
smallEnough xs = length xs <= maxSize
splitLarge (small, remaining) =
let (newSmall, large) = partition smallEnough remaining
in (small ++ newSmall, large >>= cluster)
A quick test, cribbed from #user2407038's answer:
testPts :: [V2]
testPts = map (uncurry Pair)
[ (0,0), (1,0), (2,1), (0,2)
, (5,2), (5,4), (4,3), (4,4)
, (8,2), (9,3), (10,2)
, (11,4), (12,3), (13,3), (13,5) ]
ghci> smallClusters 5 testPts
[
[Pair {px = 0.0, py = 0.0},Pair {px = 1.0, py = 0.0},Pair {px = 2.0, py = 1.0},Pair {px = 0.0, py = 2.0}],
[Pair {px = 5.0, py = 2.0},Pair {px = 5.0, py = 4.0},Pair {px = 4.0, py = 3.0},Pair {px = 4.0, py = 4.0}],
[Pair {px = 8.0, py = 2.0},Pair {px = 9.0, py = 3.0},Pair {px = 10.0, py = 2.0}]
[Pair {px = 11.0, py = 4.0},Pair {px = 12.0, py = 3.0},Pair {px = 13.0, py = 3.0},Pair {px = 13.0, py = 5.0}]
]
There you go. Small clusters in n-dimensional space, all without a single recursive function.
Labelling
Part of the point of working with the Applicative and Foldable interfaces, rather than working with V2 directly, was so I could demonstrate the following little magic trick.
Your original code represented points as 3-tuples consisting of two Doubles for the location and an Int for the point's label, but my V2 has no label. Can we recover this? Well, since the code doesn't at any point mention any concrete types - just standard type classes - we can just build a new type for labelled vectors. As long as said type is a Foldable Applicative all of the above code will continue to work without modification!
data Labelled m f a = Labelled m (f a) deriving (Show, Functor, Foldable)
instance (Monoid m, Applicative f) => Applicative (Labelled m f) where
pure = Labelled mempty . pure
Labelled m ff <*> Labelled n fx = Labelled (m <> n) (ff <*> fx)
The Monoid constraint is there because when combining actions you also need a way to combine their labels. I'm just going to use First - left-biased choice - because I'm not expecting the points' labels to be relevant to the zipping operations like modulus and boundingBox.
type LabelledV2 = Labelled (First Int) Pair Double
testPts :: [LabelledV2]
testPts = zipWith (Labelled . First . Just) [0..] $ map (uncurry Pair)
[ (0,0), (1,0), (2,1), (0,2)
, (5,2), (5,4), (4,3), (4,4)
, (8,2), (9,3), (10,2)
, (11,4), (12,3), (13,3), (13,5) ]
ghci> traverse (traverse (getFirst . lbl)) $ smallClusters 5 testPts
Just [[0,1,2,3],[4,5,6,7],[8,9,10],[11,12,13,14]] -- try reordering testPts

Simplify haskell function

I'm really struggling with Haskell atm.
It took me almost 6 hours to write a function that does what I want. Unfortunately I'm not satisfied with the look of it.
Could someone please give me any hints how to rewrite it?
get_connected_area :: Eq generic_type => [[generic_type]] -> (Int, Int) -> [(Int,Int)] -> generic_type -> [(Int,Int)]
get_connected_area habitat point area nullValue
| elem point area = area
| not ((fst point) >= 0) = area
| not ((snd point) >= 0) = area
| not ((fst point) < (length habitat)) = area
| not ((snd point) < (length (habitat!!0))) = area
| (((habitat!!(fst point))!!(snd point))) == nullValue = area
| otherwise =
let new_area = point : area
in
get_connected_area habitat (fst point+1, snd point) (
get_connected_area habitat (fst point-1, snd point) (
get_connected_area habitat (fst point, snd point+1) (
get_connected_area habitat (fst point, snd point-1) new_area nullValue
) nullValue
) nullValue
) nullValue
The function get's a [[generic_type]] (representing a landscape-map) and searches the fully connected area around a point that isn't equal to the given nullValue.
Eg.:
If the function gets called like this:
get_connected_area [[0,1,0],[1,1,1],[0,1,0],[1,0,0]] (1,1) [] 0
That literally means
0 1 0
1 1 1
0 1 0
1 0 0
Represents a map (like google maps). Start from the point (coordinates) (1,1) I want to get all coordinates of the elements that form a connected area with the given point.
The result therefore should be:
0 1 0
1 1 1
0 1 0
1 0 0
And the corresponting return value (list of coordinates of bold 1s):
[(2,1),(0,1),(1,2),(1,0),(1,1)]
One small change is that you can use pattern matching for the variable point. This means you can use (x, y) instead of point in the function declaration:
get_connected_area habitat (x, y) area nullValue = ...
Now everywhere you have fst point, just put x, and everywhere you have snd point, put y.
Another modification is to use more variables for subexpressions. This can help with the nested recursive calls. For example, make a variable for the inner-most nested call:
....
where foo = get_connected_area habitat (x, y-1) new_area nullValue
Now just put foo instead of the call. This technique can now be repeated for the "new" inner-most call. (Note that you should pick a more descriptive name than foo. Maybe down?)
Note that not (x >= y) is the same as x < y. Use this to simplify all of the conditions. Since these conditions test if a point is inside a bounding rectangle, most of this logic can be factored to a function isIn :: (Int, Int) -> (Int, Int) -> (Int, Int) -> Bool which will make get_connected_area more readable.
This would be my first quick pass through the function, and sort of the minimum that might pass a code review (just in terms of style):
getConnectedArea :: Eq a => [[a]] -> a -> (Int, Int) -> [(Int,Int)] -> [(Int,Int)]
getConnectedArea habitat nullValue = go where
go point#(x,y) area
| elem point area = area
| x < 0 = area
| y < 0 = area
| x >= length habitat = area
| y >= length (habitat!!0) = area
| ((habitat!!x)!!y) == nullValue = area
| otherwise =
foldr go (point : area)
[ (x+1, y), (x-1, y), (x, y+1), (x, y-1) ]
We bind habitat and nullValue once at the top level (clarifying what the recursive work is doing), remove indirection in the predicates, use camel-case (underdashes obscure where function application is happening), replace generic_type with a (using a noisy variable here actually has the opposite effect from the one you intended; I end up trying to figure out what special semantics you're trying to call out when the interesting thing is that the type doesn't matter (so long as it can be compared for equality)).
At this point there are lots of things we can do:
pretend we're writing real code and worry about asymptotics of treating lists as arrays (!!, and length) and sets (elem), and use proper array and set data structures instead
move your bounds checking (and possible null value checking) into a new lookup function (the goal being to have only a single ... = area clause if possible
consider improvements to the algorithm: can we avoid recursively checking the cell we just came from algorithmically? can we avoid passing area entirely (making our search nicely lazy/"productive")?
Here is my take:
import qualified Data.Set as Set
type Point = (Int, Int)
getConnectedArea :: (Point -> Bool) -> Point -> Set.Set Point
getConnectedArea habitat = \p -> worker p Set.empty
-- \p is to the right of = to keep it out of the scope of the where clause
where
worker p seen
| p `Set.member` seen = seen
| habitat p = foldr worker (Set.insert p seen) (neighbors p)
| otherwise = seen
neighbors (x,y) = [(x-1,y), (x+1,y), (x,y-1), (x,y+1)]
What I've done
foldr over the neighbors, as some commenters suggested.
Since the order of points doesn't matter, I use a Set instead of a list, so it's semantically a better fit and faster to boot.
Named some helpful intermediate abstractions such as Point and neighbors.
A better data structure for the habitat would also be good, since lists are linear time to access, maybe a 2D Data.Array—but as far as this function cares, all you need is an indexing function Point -> Bool (out of bounds and null value are treated the same), so I've replaced the data structure parameter with the indexing function itself (this is a common transformation in FP).
We can see that it would also be possible to abstract away the neighbors function and then we would arrive at a very general graph traversal method
traverseGraph :: (Ord a) => (a -> [a]) -> a -> Set.Set a
in terms of which you could write getConnectedArea. I recommend doing this for educational purposes—left as an exercise.
EDIT
Here's an example of how to call the function in terms of (almost) your old function:
import Control.Monad ((<=<))
-- A couple helpers for indexing lists.
index :: Int -> [a] -> Maybe a
index _ [] = Nothing
index 0 (x:_) = x
index n (_:xs) = index (n-1) xs
index2 :: (Int,Int) -> [[a]] -> Maybe a
index2 (x,y) = index x <=< index y
-- index2 uses Maybe's monadic structure, and I think it's quite pretty.
-- But if you're not ready for that, you might prefer
index2' (x,y) xss
| Just xs <- index y xss = index x xs
| otherwise = Nothing
getConnectedArea' :: (Eq a) => [[a]] -> Point -> a -> [a]
getConnectedArea' habitat point nullValue = Set.toList $ getConnectedArea nonnull point
where
nonnull :: Point -> Bool
nonnull p = case index2 p habitat of
Nothing -> False
Just x -> x /= nullValue
OK i will try to simplify your code. However there are already good answers and that's why i will tackle this with a slightly more conceptual approach.
I believe you could chose better data types. For instance Data.Matrix seems to provide an ideal data type in the place of your [[generic_type]] type. Also for coordinates i wouldn't chose a tuple type since tuple type is there to pack different types. It's functor and monad instances are not very helpful when it is chosen as a coordinate system. Yet since it seems Data.Matrix is just happy with tuples as coordinates i will keep them.
OK your rephrased code is as follows;
import Data.Matrix
gca :: Matrix Int -> (Int, Int) -> Int -> [(Int,Int)]
gca fld crd nil = let nbs = [id, subtract 1, (+1)] >>= \f -> [id, subtract 1, (+1)]
>>= \g -> return (f,g)
>>= \(f,g) -> return ((f . fst) crd, (g . snd) crd)
in filter (\(x,y) -> fld ! (x,y) /= nil) nbs
*Main> gca (fromLists [[0,1,0],[1,1,1],[0,1,0],[1,0,0]]) (2,2) 0
[(2,2),(2,1),(2,3),(1,2),(3,2)]
The first thing to note is, the Matrix data type is index 1 based. So we have our center point at (2,2).
The second is... we have a three element list of functions defined as [id, subtract 1, (+1)]. The contained functions are all Num a => a -> a type and i need them to define the surrounding pixels of the given coordinate including the given coordinate. So we have a line just like if we did;
[1,2,3] >>= \x -> [1,2,3] >>= \y -> return [x,y] would result [[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]] which, in our case, would yield a 2 combinations of all functions in the place of the numbers 1,2 and 3.
Which then we apply to our given coordinate one by one with a cascading instruction
>>= \[f,g] -> return ((f . fst) crd, (g . snd) crd)
which yields all neighboring coordinates.
Then its nothing more than filtering the neighboring filters by checking if they are not equal to the nil value within out matrix.

Recursion and parallelism in Haskell

I'm trying to understand how paralleling in Haskell works and I've found following example in Control.Parallel docs.
import Control.Parallel
-- Equation for the upper hemisphere of the unit circle
circle :: Double -> Double
circle x = sqrt (abs(1 - x^2))
-- Calculate the area of a right-handed Riemann rectangle
area :: Double -> Double -> Double
area x1 x2 = (x2 - x1) * circle x2
-- Recursively add the areas of the Riemann rectangles
parEstimate :: [Double] -> Double
parEstimate (x:[]) = 0
parEstimate (x:y:[]) = area x y
parEstimate (x:y:xs) =
smaller `par` (larger `pseq` smaller + larger)
where smaller = area x y
larger = parEstimate (y:xs)
But I couldn't find an explanation of how this recursion works: parEstimate (x:y:xs), cause all examples I've found contains only two arguments.
That's why I cannot find out how to run this function. That's how I do:
main = print (parEstimate [1.0, 2.0])
but not sure, if it's correct.
Also I would like to implement function calculating definite integral based on this example.
The recursion, essentially, is a simple fold-like recursion scheme; if this were purely sequential, you might write it as
seqEstimate :: [Double] -> Double
seqEstimate (x:[]) = 0
seqEstimate (x:y:[]) = area x y
seqEstimate (x:y:xs) = smaller + larger
where smaller = area x y
larger = seqEstimate (y:xs)
(In fact, you would probably just use zipWith instead: seqEstimate xs = sum (zipWith area xs (tail xs)).)
The parallelized version is similar. This time, though, par is used to indicate that the left-hand side (smaller) can be evaluated in parallel with the right-hand side (pseq larger (smaller + larger)). Whether or not the compiler chooses to do so, and regardless of whether smaller completes before or after larger, the sum of smaller + larger will be correctly computed.

Haskell Store Data As Algorithm progresses

Say I had a Haskell algorithm which, through recursion, progressed through a Cartesian plane where each x/y coordinate had a specific value.
Position (0,0) is known, each other can be calculated by progressing back to the origin.
For example, to look at (0,3) I need to look at (-1,2), (0,2) and (1,2), which have to look in turn at (-2,1),(-1,1),(0,1) and (-1,1),(0,1),(1,1) and (0,1),(1,1),(2,1) respectively.
In order to avoid for (-1,1) and (0,1) to be calculated twice, is there any way I can create a data structure so that the algorithm can first look to see if a certain position ahs been calculated already and, if not, only then proceeds to calculating it?
Thanks :)
It sounds like memoization as m09 and cdk suggest might be what you're looking for. But if you want an algorithm that returns an array of positions, then simple boxed arrays (meaning they hold lazy values) and some knot tying can give you a nice declarative solution (sorry for the ugly code)
import Data.Array
-- for positive u
plane :: Int -> Array (Int,Int) Int
plane u = let knownOrigin = ((0,0) , 0)
l = negate u
otherCoords = [ (x,y) | let cs = [l .. u]
, x <- cs , y <- cs
, (x,y) /= (0,0)
]
a = array ((l,l),(u,u)) $
knownOrigin : map solution otherCoords
-- example recursive thing, referenceing lazy values in 'a':
solution c#(x,y) = let x' | x <0 = x+1
| x >0 = x-1
| x==0 = 0
y' | y <0 = y+1
| y >0 = y-1
| y==0 = 0
in (c , a ! (x',y') + 1)
in a
You could also use a Map or vector, or any other lazy structure that works best for your problem.

Graph representation in Haskell

I have chosen to represent a graph in Haskell by a list of nodes (ex. n=[1,2,3,4]) and a list of pairs representing the edges (example m=[(1,2), (2,3)]). Now I have to see if the graph is strongly connected.
My main issue is how to find if there is a way between 2 nodes in the graph. I wrote something like that:
-- sees if 2 nodes are adjacent
adjacent x y [] = False
adjacent x y (mu:m) =
if(x== (fst mu) && y==(snd mu)) then True
else adjacent x y m
-- the successor of a node, ex for the edge (1,2) the succ of 1 is 2
suc x [] = 0
suc x (l:list) =
if(x==(fst l)) then snd l
else suc x list
-- my main function
way 0 y list = False
way x y (mu:m)
| x==y = True
| (adjacent x y (mu:m)) == True = True
| otherwise =
if ((way (suc x (mu:m)) y (mu:m))==False) then way (suc x m) y m
else True
It works when I have nodes of degree 1, but for the nodes with a greater degree it doesn't always work. Can you give me a clue about it?
Here are some questions to ask yourself:
Should adjacent 3 2 [(1,2),(2,3)] be True?
How many successors to 1 are there in the graph [(1,2),(2,3),(1,4),(3,4)]
Why does, or doesn't, way need to have both a x==y case and an adjacent x y ... case?
In the recursion step of way does the == False test really tell you something that lets you recurse on the smaller graph of m?
In general, you haven't written type signatures for your top level functions. It is usually very instructive to do so, and will communicate your design more clearly:
type Vertex = Int
type Edge = (Vertex, Vertex)
type Graph = [Edge]
adjacent :: Vertex -> Vertex -> Graph -> Bool
suc :: Vertex -> Graph -> Vertex
way :: Vertex -> Vertex -> Graph -> Bool
Think about if those types make sense, and if they decompose your problem as you would expect, just thinking about graphs in general.
Is your aim really the way function, or is it to determine if the graph is connected? You might be presupposing too much about the way in which you can determine if the graph is connected.
Lastly, a small part about Haskell syntax: Like most other languages, function application binds very tightly, tighter than == and && operators. Unlike most other languages, function application doesn't use parenthesis. Hence, adjacent can be recoded as:
adjacent x y [] = False
adjacent x y (mu:m) =
if x == fst mu && y == snd mu then True
else adjacent x y m
Which in turn could be simplified to:
adjacent x y [] = False
adjacent x y (mu:m) = (x == fst mu && y == snd mu) || adjacent x y m
You have two errors of understanding:
m, your list of edges is static throughout the entire search. Don't eat it up as you recur in way.
Each vertex can have more than one edge leaving it. You want to know whether any of the neighbours of x has a way to y. To find the neighbours you first have to filter the list of edges to find only the edges leaving x.
You also need to build up a list of nodes you've already visited on your quest to find a connection. If you end up on a node you've already seen, then that particular path has failed.
Some hints to make your code a lot shorter: for adjacent, try elem.
For succ, try Data.Maybe.fromMaybe and lookup.

Resources