[Haskell-cafe] Seems a wrong implementation of Graham Scan in Haskell Wiki
Yang Leo
jeremyrobturtle at gmail.com
Fri Apr 11 05:19:27 UTC 2014
The implementation in the page:
http://www.haskell.org/haskellwiki/Graham_Scan_Implementation
seems to be wrong.
Given a Point list as follows:
pts5 = [Point (0,0), Point (0,4), Point (1,4), Point (2,3), Point (6,5), Point (6,0)]
The gscan will output a wrong answer which included a inner point Point (1,4). That is because the implemented algorithm
cannot handle the situation where multiple consecutive points need to be removed.
Here is my implementation:
```
module GrahamScan where
import Data.List (sortBy)
import Data.Function (on)
-- 9. define data `Direction`
data Direction = GoLeft | GoRight | GoStraight
deriving (Show, Eq)
-- 10. determine direct change via point a->b->c
-- -- define 2D point
data Pt = Pt (Double, Double) deriving (Show, Eq, Ord)
isTurned :: Pt -> Pt -> Pt -> Direction
isTurned (Pt (ax, ay)) (Pt (bx, by)) (Pt (cx, cy)) = case sign of
EQ -> GoStraight
LT -> GoRight
GT -> GoLeft
where sign = compare ((bx - ax) * (cy - ay))
((cx - ax) * (by - ay))
-- 12. implement Graham scan algorithm for convex
-- -- Helper functions
-- -- Find the most button left point
buttonLeft :: [Pt] -> Pt
buttonLeft [] = Pt (1/0, 1/0)
buttonLeft [pt] = pt
buttonLeft (pt:pts) = minY pt (buttonLeft pts) where
minY (Pt (ax, ay)) (Pt (bx, by))
| ay > by = Pt (bx, by)
| ay < by = Pt (ax, ay)
| ax < bx = Pt (ax, ay)
| otherwise = Pt (bx, by)
-- -- Main
convex :: [Pt] -> [Pt]
convex [] = []
convex [pt] = [pt]
convex [pt0, pt1] = [pt0, pt1]
convex pts = scan [pt0] spts where
-- Find the most buttonleft point pt0
pt0 = buttonLeft pts
-- Sort other points `ptx` based on angle <pt0->ptx>
spts = tail (sortBy (compare `on` compkey pt0) pts) where
compkey (Pt (ax, ay)) (Pt (bx, by)) = (atan2 (by - ay) (bx - ax),
{-the secondary key make sure collinear points in order-}
abs (bx - ax))
-- Scan the points to find out convex
-- -- handle the case that all points are collinear
scan [p0] (p1:ps)
| isTurned pz p0 p1 == GoStraight = [pz, p0]
where pz = last ps
scan (x:xs) (y:z:rsts) = case isTurned x y z of
GoRight -> scan xs (x:z:rsts)
GoStraight -> scan (x:xs) (z:rsts) -- I choose to skip the collinear points
GoLeft -> scan (y:x:xs) (z:rsts)
scan xs [z] = z : xs
```
The source file is at https://github.com/robturtle/Haskell/blob/master/ch03/GrahamScan.hs
Maybe not elegant for I just finished the first 3 chapters in Real World Haskell. However it at least correctly computes the example `pts5`
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20140411/2e0d9e71/attachment.html>
More information about the Haskell-Cafe
mailing list