Difference between revisions of "Graham Scan Implementation"
Jump to navigation
Jump to search
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) |
⚫ | |||
− | 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 |
|
⚫ | |||
− | + | area = (x2 - x1) * (y3 - y1) - (y2 - y1) * (x3 - x1) |
|
− | + | bottomLeft :: [Point2D] -> Point2D |
|
+ | bottomLeft = swap . foldr1 min . map swap |
||
− | gScan pts |
||
− | | length pts >= 3 = scan [pt0] rests |
||
⚫ | |||
⚫ | |||
− | -- 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 |
||
+ | sortOnPolar :: [Point2D] -> [Point2D] |
||
− | -- Sort other points based on angle |
||
+ | sortOnPolar [] = [] |
||
− | rests = tail (sortBy (compare `on` compkey pt0) pts) where |
||
+ | sortOnPolar ps = origin : sortOn polar rest |
||
⚫ | |||
+ | where |
||
− | abs (x - x0)) |
||
⚫ | |||
+ | origin@(x0, y0) = bottomLeft ps |
||
+ | rest = filter (/= origin) ps |
||
+ | grahamScan :: [Point2D] -> [Point2D] |
||
− | -- Scan the points to find out convex |
||
+ | grahamScan [] = [] |
||
− | -- -- handle the case that all points are collinear |
||
− | + | grahamScan (p : ps) = grahamScan' [p] ps |
|
+ | where |
||
− | | isTurned pz p0 p1 == STRAIGHT = [pz, p0] |
||
− | + | grahamScan' xs [] = xs |
|
⚫ | |||
+ | grahamScan' xs'@(x : xs) (y : z : ys) |
||
+ | | turning x y z == TurnLeft = grahamScan' (y : xs') (z : ys) |
||
⚫ | |||
+ | convex :: [Point2D] -> [Point2D] |
||
− | scan (x:xs) (y:z:rsts) = case isTurned x y z of |
||
+ | convex = grahamScan . sortOnPolar |
||
− | RIGHT -> scan xs (x:z:rsts) |
||
− | STRAIGHT -> scan (x:xs) (z:rsts) -- skip collinear points |
||
− | LEFT -> scan (y:x:xs) (z:rsts) |
||
− | |||
⚫ | |||
</haskell> |
</haskell> |
||
Line 53: | Line 47: | ||
== Test == |
== Test == |
||
<haskell> |
<haskell> |
||
⚫ | |||
+ | import Convex (convex) |
||
+ | import Data.Function ((&)) |
||
+ | import Data.List (sort) |
||
import Test.QuickCheck |
import Test.QuickCheck |
||
⚫ | |||
⚫ | |||
+ | 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 |
||
⚫ | |||
</haskell> |
</haskell> |
||
Line 67: | Line 73: | ||
<haskell> |
<haskell> |
||
+ | Running tests... |
||
⚫ | |||
+ | 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.