Difference between revisions of "Graham Scan Implementation"
Jump to navigation
Jump to search
(make the implementation neat) |
m (fixup Pt definition) |
||
Line 9: | Line 9: | ||
data Pt = Pt (Double, Double) |
data Pt = Pt (Double, Double) |
||
+ | deriving (Show, Eq, Ord) |
||
isTurned :: Pt -> Pt -> Pt -> Direction |
isTurned :: Pt -> Pt -> Pt -> Direction |
Revision as of 14:36, 5 January 2015
Descriptions of this problem can be found in Real World Haskell, Chapter 3
import Data.List (sortBy)
import Data.Function (on)
data Direction = LEFT | RIGHT | STRAIGHT
deriving (Show, Eq)
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 -> STRAIGHT
LT -> RIGHT
GT -> LEFT
where sign = compare ((bx - ax) * (cy - ay)) ((cx - ax) * (by - ay))
gScan :: [Pt] -> [Pt]
gScan pts
| length pts >= 3 = scan [pt0] rests
| otherwise = pts
where
-- Find the most bottom-left point pt0
pt0 = foldr bottomLeft (Pt (1/0, 1/0)) pts where
bottomLeft pa pb = case ord of
LT -> pa
GT -> pb
EQ -> pa
where ord = (compare `on` (\ (Pt (x, y)) -> (y, x))) pa pb
-- Sort other points based on angle
rests = tail (sortBy (compare `on` compkey pt0) pts) where
compkey (Pt (x0, y0)) (Pt (x, y)) = (atan2 (y - y0) (x - x0),
abs (x - x0))
-- Scan the points to find out convex
-- -- handle the case that all points are collinear
scan [p0] (p1:ps)
| isTurned pz p0 p1 == STRAIGHT = [pz, p0]
where pz = last ps
scan (x:xs) (y:z:rsts) = case isTurned x y z of
RIGHT -> scan xs (x:z:rsts)
STRAIGHT -> scan (x:xs) (z:rsts) -- skip collinear points
LEFT -> scan (y:x:xs) (z:rsts)
scan xs [z] = z : xs
Test
import Test.QuickCheck
import Control.Monad
import Data.List
convex' = map (\(Pt x) -> x) . convex . map Pt
prop_convex n = forAll (replicateM n arbitrary) (\xs -> sort (convex' xs) == sort (convex' (convex' xs)))
The results are:
> quickCheck (prop_convex 0)
+++ OK, passed 100 tests.
> quickCheck (prop_convex 1)
+++ OK, passed 100 tests.
> quickCheck (prop_convex 2)
+++ OK, passed 100 tests.
> quickCheck (prop_convex 3)
+++ OK, passed 100 tests.
> quickCheck (prop_convex 4)
+++ OK, passed 100 tests.
> quickCheck (prop_convex 5)
+++ OK, passed 100 tests.
> quickCheck (prop_convex 10)
+++ OK, passed 100 tests.
> quickCheck (prop_convex 100)
+++ OK, passed 100 tests.
> quickCheck (prop_convex 1000)
+++ OK, passed 100 tests.
> quickCheck (prop_convex 10000)
+++ OK, passed 100 tests.