Graham Scan exercise from Chapter 3 RWH -Spoilers. Don't read if you want to do this exercise.
Below is my solution for the Graham Scan Algorithm. I tried to limit myself to information in the first three chapters while completing this problem. Now, I want to remove the explicit recursion and use more idiomatic Haskell. I'd like to get some advice on which functions/modules would be helpful in this. <code> data Direction = DStraight | DLeft | DRight deriving (Eq,Show) type PointXY = (Double,Double) calcTurn :: PointXY -> PointXY -> PointXY -> Direction calcTurn a b c | crossProduct == 0 = DStraight | crossProduct > 0 = DLeft | otherwise = DRight where crossProduct = ((fst b - fst a) * (snd c - snd a)) - ((snd b - snd a) * (fst c - fst a)) calcDirectionList :: [PointXY] -> [Direction] calcDirectionList (x:y:z:zs) = (calcTurn x y z) : (calcDirectionList (y:z:zs)) calcDirectionList _ = [] sortListByY :: [PointXY] -> [PointXY] sortListByY [] = [] sortListByY [a] = [a] sortListByY (a:as) = insert (sortListByY as) where insert [] = [a] insert (b:bs) | snd a <= snd b = a : b : bs | otherwise = b : insert bs sortListByCoTangent :: [PointXY] -> [PointXY] sortListByCoTangent [] = [] sortListByCoTangent [a] = [a] sortListByCoTangent (a:as) = a : insert (sortListByCoTangent as) where insert :: [PointXY] -> [PointXY] insert [b] = [b] insert (b:c:cs) | (myCoTan a b) >= (myCoTan a c) = b : insert (c:cs) | otherwise = c : insert (b:cs) where myCoTan :: PointXY -> PointXY -> Double myCoTan p1 p2 = (fst p2 - fst p1) / (snd p2 - snd p1) createHull :: [PointXY] -> [PointXY] createHull (a:b:c:cs) = a : filterPoint (createHull (b:c:cs)) where filterPoint :: [PointXY] -> [PointXY] filterPoint (x:y:z:zs) | calcTurn x y z == (DLeft) = [x] ++ [y] ++ [z] ++ filterPoint (zs) | otherwise = [x] ++ [z] ++ filterPoint (zs) filterPoint [x] = a:[x] filterPoint _ = [] createHull _ = [] main :: IO () main = do let points = [(5.0,0.0),(5.0,6.0),(3.0,-4.2),(0.0,6.0)] print $ createHull points
El jue, 02-09-2010 a las 17:21 -0700, Michael Litchard escribió:
Below is my solution for the Graham Scan Algorithm. I tried to limit myself to information in the first three chapters while completing this problem. Now, I want to remove the explicit recursion and use more idiomatic Haskell. I'd like to get some advice on which functions/modules would be helpful in this.
<code> data Direction = DStraight | DLeft | DRight deriving (Eq,Show)
type PointXY = (Double,Double)
calcTurn :: PointXY -> PointXY -> PointXY -> Direction calcTurn a b c | crossProduct == 0 = DStraight | crossProduct > 0 = DLeft | otherwise = DRight where crossProduct = ((fst b - fst a) * (snd c - snd a)) - ((snd b - snd a) * (fst c - fst a))
Instead of using fst, snd, I usually use pattern matching: calcTurn (x1,y1) (x2,y2) (x3,y3) = ... where crossProduct = (x2-x1)*(y3-y1)-...
calcDirectionList :: [PointXY] -> [Direction] calcDirectionList (x:y:z:zs) = (calcTurn x y z) : (calcDirectionList (y:z:zs)) calcDirectionList _ = []
It is tempting to use some kind of map or foldr for this. Unfortunately, there isn't a really nice way. Such a "sliding window" map is occasionally useful, but there is no pre-defined function for it in the libraries. One way to avoid the explicit recursion is to first create a list of all the triples, and then map calcTurn over it: calcDirectionList points = map (\(x,y,z) -> calcTurn x y z) (zip3 points (tail points) (tail (tail points))) Unless one has seen this idiom before, I don't think this is any clearer than the explicit recursion. Not having a curry3 doesn't help either.
sortListByY :: [PointXY] -> [PointXY] sortListByY [] = [] sortListByY [a] = [a] sortListByY (a:as) = insert (sortListByY as) where insert [] = [a] insert (b:bs) | snd a <= snd b = a : b : bs | otherwise = b : insert bs
You can use Data.List.sortBy and Data.Ord.comparing for this.
sortListByCoTangent :: [PointXY] -> [PointXY] sortListByCoTangent [] = [] sortListByCoTangent [a] = [a] sortListByCoTangent (a:as) = a : insert (sortListByCoTangent as) where insert :: [PointXY] -> [PointXY] insert [b] = [b] insert (b:c:cs) | (myCoTan a b) >= (myCoTan a c) = b : insert (c:cs) | otherwise = c : insert (b:cs) where myCoTan :: PointXY -> PointXY -> Double myCoTan p1 p2 = (fst p2 - fst p1) / (snd p2 - snd p1)
This doesn't look like a straightforward sort, because of the special handling of the first element. After that, it seems to be a sort where the comparing function takes the first element as an argument. So you can again use sortBy and comparing. Next, I try to avoid nesting where to save on horizontal space. And again, I would use pattern matching instead of fst and snd.
createHull :: [PointXY] -> [PointXY] createHull (a:b:c:cs) = a : filterPoint (createHull (b:c:cs)) where filterPoint :: [PointXY] -> [PointXY] filterPoint (x:y:z:zs) | calcTurn x y z == (DLeft) = [x] ++ [y] ++ [z] ++ filterPoint (zs) | otherwise = [x] ++ [z] ++ filterPoint (zs) filterPoint [x] = a:[x] filterPoint _ = [] createHull _ = []
You pattern match on b,c, but never use them. why not: createHull (a:as) = a : filterPoint (createHull as) and handle the case of not enough points in filterPoint itself. then: [x]++[y]++[z]++ ... = [x,y,z]++ ... a:[x] = [a,x] Again, there is no really nice way to avoid the explicit recursion here. Are you sure this is the right way to do it, though? There seem to be a lot of redundant calls to filterPoint. Jürgen
On 3 September 2010 11:57, Jürgen Doser
It is tempting to use some kind of map or foldr for this. Unfortunately, there isn't a really nice way. Such a "sliding window" map is occasionally useful, but there is no pre-defined function for it in the libraries.
Though not in Data.List, paramorphism is the standard 'sliding window' fold. -- paramorphism (generalizes catamorphism i.e. foldr) -- para :: (a -> ([a], b) -> b) -> b -> [a] -> b para phi b = step where step [] = b step (x:xs) = phi x (xs, step xs) With a paramorphism the 'lookahead' is left-to-right, but the list itself is processed from the right (as per a right-fold). This can sometimes make it a little tricky to use.
Hi Michael, On 03/09/10 01:21, Michael Litchard wrote:
Below is my solution for the Graham Scan Algorithm. I tried to limit myself to information in the first three chapters while completing this problem. Now, I want to remove the explicit recursion and use more idiomatic Haskell. I'd like to get some advice on which functions/modules would be helpful in this.
This is not really what you ask for, but I thought I would point out that you code seems to have either a bug or it doesn't implement the Graham Scan algorithm correctly. For example, when we change the points to [(10,0), (10,1),(-10,1),(-10,0),(-7,0),(-10,2),(-10,3),(-4,1),(-2,2),(-12,1)] your code gives as the solution: *Main> main [(10.0,0.0),(10.0,1.0),(-10.0,1.0),(-10.0,0.0),(-7.0,0.0),(10.0,1.0),(-4.0,1.0)] while the correct solution has only 5 points [(-10,0),(10,0),(10,1),(-10,3),(-12,1)] Yo can see my solution to this exercise at http://angel-de-vicente.blogspot.com/2010/06/graham-scan-in-haskell.html Cheers, Ángel de Vicente
<code> data Direction = DStraight | DLeft | DRight deriving (Eq,Show)
type PointXY = (Double,Double)
calcTurn :: PointXY -> PointXY -> PointXY -> Direction calcTurn a b c | crossProduct == 0 = DStraight | crossProduct> 0 = DLeft | otherwise = DRight where crossProduct = ((fst b - fst a) * (snd c - snd a)) - ((snd b - snd a) * (fst c - fst a))
calcDirectionList :: [PointXY] -> [Direction] calcDirectionList (x:y:z:zs) = (calcTurn x y z) : (calcDirectionList (y:z:zs)) calcDirectionList _ = []
sortListByY :: [PointXY] -> [PointXY] sortListByY [] = [] sortListByY [a] = [a] sortListByY (a:as) = insert (sortListByY as) where insert [] = [a] insert (b:bs) | snd a<= snd b = a : b : bs | otherwise = b : insert bs
sortListByCoTangent :: [PointXY] -> [PointXY] sortListByCoTangent [] = [] sortListByCoTangent [a] = [a] sortListByCoTangent (a:as) = a : insert (sortListByCoTangent as) where insert :: [PointXY] -> [PointXY] insert [b] = [b] insert (b:c:cs) | (myCoTan a b)>= (myCoTan a c) = b : insert (c:cs) | otherwise = c : insert (b:cs) where myCoTan :: PointXY -> PointXY -> Double myCoTan p1 p2 = (fst p2 - fst p1) / (snd p2 - snd p1)
createHull :: [PointXY] -> [PointXY] createHull (a:b:c:cs) = a : filterPoint (createHull (b:c:cs)) where filterPoint :: [PointXY] -> [PointXY] filterPoint (x:y:z:zs) | calcTurn x y z == (DLeft) = [x] ++ [y] ++ [z] ++ filterPoint (zs) | otherwise = [x] ++ [z] ++ filterPoint (zs) filterPoint [x] = a:[x] filterPoint _ = [] createHull _ = []
main :: IO () main = do let points = [(5.0,0.0),(5.0,6.0),(3.0,-4.2),(0.0,6.0)] print $ createHull points _______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners
-- http://www.iac.es/galeria/angelv/ High Performance Computing Support PostDoc Instituto de Astrofísica de Canarias --------------------------------------------------------------------------------------------- ADVERTENCIA: Sobre la privacidad y cumplimiento de la Ley de Protección de Datos, acceda a http://www.iac.es/disclaimer.php WARNING: For more information on privacy and fulfilment of the Law concerning the Protection of Data, consult http://www.iac.es/disclaimer.php?lang=en
participants (4)
-
Angel de Vicente -
Jürgen Doser -
Michael Litchard -
Stephen Tetley