[Haskell-beginners] Graham Scan exercise from Chapter 3 RWH
-Spoilers. Don't read if you want to do this exercise.
Michael Litchard
michael at schmong.org
Thu Sep 2 20:21:45 EDT 2010
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
More information about the Beginners
mailing list