Re: [Haskell-beginners] Imperfect Graham Scan

10 Jan 2012

      I think I find what the problem is:

When calculating the distance in cosine function, a sqrt is missing.
There is no pivot append to the sorted list of points in sort'.
The algorithm which scan implement is incorrect. Read more details in my comments.

I appreciate you all.

=== prop_scan_idempotent on GrahamScan_qc.hs:8 ===
+++ OK, passed 100 tests.

=== Code ===
module GrahamScan (grahamScan, Point(..))
where

import Data.List
import Data.Ratio

data Point = Point {
    x :: Double,
    y :: Double
} deriving (Eq, Show)

instance Ord Point where
    compare (Point x1 y1) (Point x2 y2) = compare (y1, x1) (y2, x2)

data Vector = Vector {
    start   :: Point,
    end     :: Point
} deriving (Eq)

cosine :: Vector -> Double
cosine (Vector (Point x1 y1) (Point x2 y2)) = (x2 - x1) / distance where
    distance = sqrt $ (x2 - x1) ^ 2 + (y2 - y1) ^ 2

instance Ord Vector where
    compare a b = compare (f a) (f b) where
        f = negate . cosine

-- After sorting a pivot should be append to the sorted list impermanently.
-- Otherwise the last point could not be examine.
sort' :: [Point] -> [Point]
sort' xs = pivot : fmap end sortedVectors ++ [pivot] where
    sortedVectors   = sort . fmap (Vector pivot) . delete pivot $ xs
    pivot           = minimum xs

isCounterClockwise :: Point -> Point -> Point -> Bool
isCounterClockwise (Point x1 y1) (Point x2 y2) (Point x3 y3) = (x2 - x1) * (y3 - y1) > (y2 - y1) * (x3 - x1)

-- When a point is considered clockwise or collinear, just removing it
-- is not enough, the point before it has to be re-examined. Or else,
-- the function is not idempotent. This is not mentioned on Wikipedia.
scan' :: ([Point], [Point]) -> ([Point], [Point])
scan' (p1 : p2 : p3 : xs, ys)
    | isCounterClockwise p1 p2 p3   = scan' (p2 : p3 : xs, ys ++ [p1])
    | otherwise                     = scan' (last ys : p1 : p3 : xs, init ys)
scan' (xs, ys) = ([], ys ++ xs)

-- The last point is pivot, ignore it in result.
scan :: [Point] -> [Point]
scan xs = init . (\(_, ys) -> ys) . scan' $ (xs, [])

grahamScan :: [Point] -> [Point]
grahamScan xs@(_ : _ : _ : _) = scan . sort' . nub $ xs
=== Code ===

Best regards,
Zhi-Qiang Lei
zhiqiang.lei@gmail.com