[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