Difference between revisions of "Graham Scan Implementation"
From HaskellWiki
m (fixup Pt definition) 
(concise implementation) 

Line 2:  Line 2:  
<haskell> 
<haskell> 

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

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

−  +  type Point2D = (Double, Double) 

−  deriving (Show, Eq, Ord) 

−  +  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 

−   length pts >= 3 = scan [pt0] rests 

−   otherwise = pts 

−  where 

−   Find the most bottomleft 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 

+  sortOnPolar :: [Point2D] > [Point2D] 

−  rests = tail (sortBy (compare `on` compkey pt0) pts) where 

+  sortOnPolar [] = [] 

−  compkey (Pt (x0, y0)) (Pt (x, y)) = (atan2 (y  y0) (x  x0), 

+  sortOnPolar ps = origin : sortOn polar rest 

−  abs (x  x0)) 

+  where 

+  polar (x, y) = atan2 (y  y0) (x  x0) 

+  origin@(x0, y0) = bottomLeft ps 

+  rest = filter (/= origin) ps 

−   Scan the points to find out convex 

+  grahamScan :: [Point2D] > [Point2D] 

−    handle the case that all points are collinear 

+  grahamScan [] = [] 

−  scan [p0] (p1:ps) 

+  grahamScan (p : ps) = grahamScan' [p] ps 

−   isTurned pz p0 p1 == STRAIGHT = [pz, p0] 

+  where 

−  where pz = last ps 

+  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) 

−  scan (x:xs) (y:z:rsts) = case isTurned x y z of 

+  convex :: [Point2D] > [Point2D] 

−  RIGHT > scan xs (x:z:rsts) 

+  convex = grahamScan . sortOnPolar 

−  STRAIGHT > scan (x:xs) (z:rsts)  skip collinear points 

−  LEFT > scan (y:x:xs) (z:rsts) 

−  
−  scan xs [z] = z : xs 

</haskell> 
</haskell> 

Line 42:  Line 45:  
== 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)) 

−  convex' = map (\(Pt x) > x) . convex . map Pt 

+  main :: IO () 

−  
+  main = do 

−  prop_convex n = forAll (replicateM n arbitrary) (\xs > sort (convex' xs) == sort (convex' (convex' xs))) 

+  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) 

</haskell> 
</haskell> 

Line 56:  Line 71:  
<haskell> 
<haskell> 

−  > quickCheck (prop_convex 0) 

+  Running tests... 

−  +++ OK, passed 100 tests. 

+  size: 0 

−  > quickCheck (prop_convex 1) 

+++ OK, passed 100 tests. 
+++ OK, passed 100 tests. 

−  > quickCheck (prop_convex 2) 

+  size: 1 

+++ OK, passed 100 tests. 
+++ OK, passed 100 tests. 

−  > quickCheck (prop_convex 3) 

+  size: 2 

+++ OK, passed 100 tests. 
+++ OK, passed 100 tests. 

−  > quickCheck (prop_convex 4) 

+  size: 3 

+++ OK, passed 100 tests. 
+++ OK, passed 100 tests. 

−  > quickCheck (prop_convex 5) 

+  size: 4 

+++ OK, passed 100 tests. 
+++ OK, passed 100 tests. 

−  > quickCheck (prop_convex 10) 

+  size: 5 

+++ OK, passed 100 tests. 
+++ OK, passed 100 tests. 

−  > quickCheck (prop_convex 100) 

+  size: 10 

+++ OK, passed 100 tests. 
+++ OK, passed 100 tests. 

−  > quickCheck (prop_convex 1000) 

+  size: 100 

+++ OK, passed 100 tests. 
+++ OK, passed 100 tests. 

−  > quickCheck (prop_convex 10000) 

+  size: 1000 

+++ OK, passed 100 tests. 
+++ OK, passed 100 tests. 

+  done. 

</haskell> 
</haskell> 
Latest 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.