Difference between revisions of "Graham Scan Implementation"

From HaskellWiki
Jump to navigation Jump to search
(Add test code)
(concise implementation)
(2 intermediate revisions by the same user not shown)
Line 2: Line 2:
   
 
<haskell>
  
<haskell>
−
import Data.List (sortBy)
 +
import Data.Function (on, (&))
−
import Data.Function (on)
 +
import Data.List (sortOn, tails)
  +
import Data.Tuple (swap)
   
−
-- define data `Direction`
 +
data Direction = TurnLeft | TurnRight | GoStraight
  +
deriving (Show, Eq)
−
data Direction = GoLeft | GoRight | GoStraight
  
−
deriving (Show, Eq)
  
   
  +
type Point2D = (Double, Double)
−
-- determine direction 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))
  
   
  +
turning :: Point2D -> Point2D -> Point2D -> Direction
−
-- implement Graham scan algorithm
  
  +
turning (x1, y1) (x2, y2) (x3, y3) = case compare area 0 of
  +
LT -> TurnRight
  +
EQ -> GoStraight
  +
GT -> TurnLeft
  +
where
  +
area = (x2 - x1) * (y3 - y1) - (y2 - y1) * (x3 - x1)
   
  +
bottomLeft :: [Point2D] -> Point2D
−
-- -- Helper functions
  
  +
bottomLeft = swap . foldr1 min . map swap
−
-- -- 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)
  
   
  +
sortOnPolar :: [Point2D] -> [Point2D]
−
-- -- Main
  
−
convex :: [Pt] -> [Pt]
 +
sortOnPolar [] = []
  +
sortOnPolar ps = origin : sortOn polar rest
−
convex [] = []
  
  +
where
−
convex [pt] = [pt]
  
  +
polar (x, y) = atan2 (y - y0) (x - x0)
−
convex [pt0, pt1] = [pt0, pt1]
  
  +
origin@(x0, y0) = bottomLeft ps
−
convex pts = scan [pt0] spts where
  
  +
rest = filter (/= origin) ps
−
-- Find the most buttonleft point pt0
  
−
pt0 = buttonLeft pts
  
   
  +
grahamScan :: [Point2D] -> [Point2D]
−
-- Sort other points `ptx` based on angle <pt0->ptx>
  
  +
grahamScan [] = []
−
spts = tail (sortBy (compare `on` compkey pt0) pts) where
  
  +
grahamScan (p : ps) = grahamScan' [p] ps
−
compkey (Pt (ax, ay)) (Pt (bx, by)) = (atan2 (by - ay) (bx - ax),
  
  +
where
−
{-the secondary key make sure collinear points in order-}
  
  +
grahamScan' xs [] = xs
−
abs (bx - ax))
  
  +
grahamScan' xs [y] = y : xs
  +
grahamScan' xs'@(x : xs) (y : z : ys)
  +
| turning x y z == TurnLeft = grahamScan' (y : xs') (z : ys)
  +
| otherwise = grahamScan' xs (x : z : ys)
   
  +
convex :: [Point2D] -> [Point2D]
−
-- Scan the points to find out convex
  
  +
convex = grahamScan . sortOnPolar
−
-- -- 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
  
−
 
−
 
−
-- Test data
  
−
pts1 = [Pt (0,0), Pt (1,0), Pt (2,1), Pt (3,1), Pt (2.5,1), Pt (2.5,0), Pt (2,0)]
  
−
-- (2,1)--(2.5,1)<>(3,1)
  
−
-- -> |
  
−
-- ---- v
  
−
-- (0,0)------->(1,0)-- (2,0)<-(2.5,0)
  
−
pts2 = [Pt (1,-2), Pt (-1, 2), Pt (-3, 6), Pt (-7, 3)]
  
−
-- -- This case demonstrate a collinear points across the button-left point
  
−
-- |-----(-3,6)
  
−
-- |----- ^__
  
−
-- <----- |---
  
−
-- (-7,3) |
  
−
-- |-- (-1,2)
  
−
-- |---- <--
  
−
-- |------------- |--|
  
−
-- |------------>(1,-2)
  
−
pts3 = [Pt (6,0), Pt (5.5,2), Pt (5,2), Pt (0,4), Pt (1,4), Pt (6,4), Pt (0,0)]
  
−
-- -- This case demonstrates a consecutive inner points
  
−
-- (0,4)<-(1,4)<--------------------(6,4)
  
−
-- | |-----------^
  
−
-- v (5,2)<(5.5,2)<-|
  
−
-- (0,0)--------------------------->(6,0)
  
−  
−
pts4 = [Pt (0,0), Pt (0,4), Pt (1,4), Pt (2,3), Pt (6,5), Pt (6,0)]
  
−
-- -- This case demonstrates a consecutive inner points
  
−  
−
-- collinear points
  
−
pts5 = [Pt (5,5), Pt (4,4), Pt (3,3), Pt (2,2), Pt (1,1)]
  
−
pts6 = reverse pts5
  
 
</haskell>
  
</haskell>
   
Line 96: Line 47:
 
== Test ==
  
== Test ==
 
<haskell>
  
<haskell>
  +
import Control.Monad
  +
import Convex (convex)
  +
import Data.Function ((&))
  +
import Data.List (sort)
 
import Test.QuickCheck
  
import Test.QuickCheck
−
import Control.Monad
  
−
import Data.List
  
   
  +
convexIsStable n =
  +
forAll
  +
(replicateM n arbitrary)
  +
(\xs -> (xs & convex & sort) == (xs & convex & convex & sort))
   
  +
main :: IO ()
−
convex' = map (\(Pt x) -> x) . convex . map Pt
  
  +
main = do
−  
  +
putStrLn "Running tests..."
−
prop_convex n = forAll (replicateM n arbitrary) (\xs -> sort (convex' xs) == sort (convex' (convex' xs)))
  
  +
mapM checkN [0, 1, 2, 3, 4, 5, 10, 100, 1000]
−  
  +
putStrLn "done."
  +
where
  +
checkN :: Int -> IO ()
  +
checkN n = do
  +
putStrLn $ "size: " ++ show n
  +
quickCheck (convexIsStable n)
 
</haskell>
  
</haskell>
   
Line 110: Line 73:
   
 
<haskell>
  
<haskell>
  +
Running tests...
−
> quickCheck (prop_convex 0)
  
  +
size: 0
−
+++ OK, passed 100 tests.
  
−
> quickCheck (prop_convex 1)
  
 
+++ OK, passed 100 tests.
  
+++ OK, passed 100 tests.
  +
size: 1
−
> quickCheck (prop_convex 2)
  
 
+++ OK, passed 100 tests.
  
+++ OK, passed 100 tests.
  +
size: 2
−
> quickCheck (prop_convex 3)
  
 
+++ OK, passed 100 tests.
  
+++ OK, passed 100 tests.
  +
size: 3
−
> quickCheck (prop_convex 4)
  
 
+++ OK, passed 100 tests.
  
+++ OK, passed 100 tests.
  +
size: 4
−
> quickCheck (prop_convex 5)
  
 
+++ OK, passed 100 tests.
  
+++ OK, passed 100 tests.
  +
size: 5
−
> quickCheck (prop_convex 10)
  
 
+++ OK, passed 100 tests.
  
+++ OK, passed 100 tests.
  +
size: 10
−
> quickCheck (prop_convex 100)
  
 
+++ OK, passed 100 tests.
  
+++ OK, passed 100 tests.
  +
size: 100
−
> quickCheck (prop_convex 1000)
  
 
+++ OK, passed 100 tests.
  
+++ OK, passed 100 tests.
  +
size: 1000
−
> quickCheck (prop_convex 10000)
  
 
+++ OK, passed 100 tests.
  
+++ OK, passed 100 tests.
  +
done.
 
</haskell>
  
</haskell>

Revision as of 22:44, 11 September 2020

Descriptions of this problem can be found in Real World Haskell, Chapter 3 

import Data.Function (on, (&))
import Data.List (sortOn, tails)
import Data.Tuple (swap)

data Direction = TurnLeft | TurnRight | GoStraight
  deriving (Show, Eq)

type Point2D = (Double, Double)

turning :: Point2D -> Point2D -> Point2D -> Direction
turning (x1, y1) (x2, y2) (x3, y3) = case compare area 0 of
  LT -> TurnRight
  EQ -> GoStraight
  GT -> TurnLeft
  where
    area = (x2 - x1) * (y3 - y1) - (y2 - y1) * (x3 - x1)

bottomLeft :: [Point2D] -> Point2D
bottomLeft = swap . foldr1 min . map swap

sortOnPolar :: [Point2D] -> [Point2D]
sortOnPolar [] = []
sortOnPolar ps = origin : sortOn polar rest
  where
    polar (x, y) = atan2 (y - y0) (x - x0)
    origin@(x0, y0) = bottomLeft ps
    rest = filter (/= origin) ps

grahamScan :: [Point2D] -> [Point2D]
grahamScan [] = []
grahamScan (p : ps) = grahamScan' [p] ps
  where
    grahamScan' xs [] = xs
    grahamScan' xs [y] = y : xs
    grahamScan' xs'@(x : xs) (y : z : ys)
      | turning x y z == TurnLeft = grahamScan' (y : xs') (z : ys)
      | otherwise = grahamScan' xs (x : z : ys)

convex :: [Point2D] -> [Point2D]
convex = grahamScan . sortOnPolar


Test

import Control.Monad
import Convex (convex)
import Data.Function ((&))
import Data.List (sort)
import Test.QuickCheck

convexIsStable n =
  forAll
    (replicateM n arbitrary)
    (\xs -> (xs & convex & sort) == (xs & convex & convex & sort))

main :: IO ()
main = do
  putStrLn "Running tests..."
  mapM checkN [0, 1, 2, 3, 4, 5, 10, 100, 1000]
  putStrLn "done."
  where
    checkN :: Int -> IO ()
    checkN n = do
      putStrLn $ "size: " ++ show n
      quickCheck (convexIsStable n)

The results are: 

Running tests...
size: 0
+++ OK, passed 100 tests.
size: 1
+++ OK, passed 100 tests.
size: 2
+++ OK, passed 100 tests.
size: 3
+++ OK, passed 100 tests.
size: 4
+++ OK, passed 100 tests.
size: 5
+++ OK, passed 100 tests.
size: 10
+++ OK, passed 100 tests.
size: 100
+++ OK, passed 100 tests.
size: 1000
+++ OK, passed 100 tests.
done.
Retrieved from "https://wiki.haskell.org/index.php?title=Graham_Scan_Implementation&oldid=63428"