Difference between revisions of "Graham Scan Implementation"
Jump to navigation
Jump to search
Eric Gesell (talk | contribs) |
m |
||
(12 intermediate revisions by 6 users not shown) | |||
Line 1: | Line 1: | ||
− | Descriptions of |
+ | Descriptions of this problem can be found in [http://book.realworldhaskell.org/read/defining-types-streamlining-functions.html Real World Haskell, Chapter 3] |
<haskell> |
<haskell> |
||
+ | import Data.Function (on, (&)) |
||
− | --Graham Scan exercise |
||
+ | import Data.List (sortOn, tails) |
||
+ | import Data.Tuple (swap) |
||
+ | data Direction = TurnLeft | TurnRight | GoStraight |
||
− | --Direction type |
||
+ | deriving (Show, Eq) |
||
− | data Direction = LeftTurn |
||
− | | RightTurn |
||
− | | Straight |
||
− | deriving (Show, Eq) |
||
+ | type Point2D = (Double, Double) |
||
− | --Point type |
||
− | data Point = Point (Double, Double) |
||
− | deriving (Show) |
||
+ | turning :: Point2D -> Point2D -> Point2D -> Direction |
||
− | --some points |
||
+ | turning (x1, y1) (x2, y2) (x3, y3) = case compare area 0 of |
||
− | p0 = Point (2.1,2.0) |
||
+ | LT -> TurnRight |
||
− | p1 = Point (4.2,2.0) |
||
+ | EQ -> GoStraight |
||
− | p2 = Point (0.5,2.5) |
||
+ | GT -> TurnLeft |
||
− | p3 = Point (3.2,3.5) |
||
+ | where |
||
− | p4 = Point (1.2,4.0) |
||
+ | area = (x2 - x1) * (y3 - y1) - (y2 - y1) * (x3 - x1) |
||
− | p5 = Point (0.7,4.7) |
||
− | p6 = Point (1.0,1.0) |
||
− | p7 = Point (3.0,5.2) |
||
− | p8 = Point (4.0,4.0) |
||
− | p9 = Point (3.5,1.5) |
||
− | pA = Point (0.5,1.0) |
||
− | points = [p0,p1,p2,p3,p4,p5,p6,p7,p8,p9,pA] |
||
+ | bottomLeft :: [Point2D] -> Point2D |
||
− | --Get direction of single set of line segments |
||
+ | bottomLeft = swap . foldr1 min . map swap |
||
− | dir :: Point -> Point -> Point -> Direction |
||
− | dir (Point (ax, ay)) (Point (bx, by)) (Point (cx, cy)) = case sign of |
||
− | EQ -> Straight |
||
− | GT -> LeftTurn |
||
− | LT -> RightTurn |
||
− | where sign = compare ((bx - ax) * (cy - ay) - (by - ay) * (cx - ax)) 0 |
||
+ | sortOnPolar :: [Point2D] -> [Point2D] |
||
− | --Get a list of Directions from a list of Points |
||
− | + | sortOnPolar [] = [] |
|
+ | sortOnPolar ps = origin : sortOn polar rest |
||
− | dirlist (x:y:z:xs) = dir x y z : dirlist (y:z:xs) |
||
+ | where |
||
− | dirlist _ = [] |
||
+ | polar (x, y) = atan2 (y - y0) (x - x0) |
||
+ | origin@(x0, y0) = bottomLeft ps |
||
+ | rest = filter (/= origin) ps |
||
+ | grahamScan :: [Point2D] -> [Point2D] |
||
− | --Compare Y axes |
||
− | + | grahamScan [] = [] |
|
+ | grahamScan (p : ps) = grahamScan' [p] ps |
||
− | sortByY xs = sortBy lowestY xs |
||
+ | where |
||
− | where lowestY (Point(x1,y1)) (Point (x2,y2)) = if y1 == y2 |
||
+ | grahamScan' xs [] = xs |
||
− | then compare x1 x2 |
||
+ | grahamScan' xs [y] = y : xs |
||
− | else compare y1 y2 |
||
+ | grahamScan' xs'@(x : xs) (y : z : ys) |
||
− | --get COT of line defined by two points and the x-axis |
||
+ | | turning x y z == TurnLeft = grahamScan' (y : xs') (z : ys) |
||
− | pointAngle :: Point -> Point -> Double |
||
+ | | otherwise = grahamScan' xs (x : z : ys) |
||
− | pointAngle (Point (x1, y1)) (Point (x2, y2)) = (x2 - x1) / (y2 - y1) |
||
+ | convex :: [Point2D] -> [Point2D] |
||
− | --compare based on point angle |
||
+ | convex = grahamScan . sortOnPolar |
||
− | pointOrdering :: Point -> Point -> Ordering |
||
+ | </haskell> |
||
− | pointOrdering a b = compare (pointAngle a b) 0.0 |
||
− | --Sort by angle |
||
− | sortByAngle :: [Point] -> [Point] |
||
− | sortByAngle ps = bottomLeft : sortBy (compareAngles bottomLeft) (tail (sortedPs)) |
||
− | where sortedPs = sortByY ps |
||
− | bottomLeft = head (sortedPs) |
||
+ | == Test == |
||
− | |||
+ | <haskell> |
||
+ | import Control.Monad |
||
+ | import Convex (convex) |
||
+ | import Data.Function ((&)) |
||
+ | import Data.List (sort) |
||
+ | import Test.QuickCheck |
||
+ | convexIsStable n = |
||
− | --Compare angles |
||
+ | forAll |
||
− | compareAngles :: Point -> Point -> Point -> Ordering |
||
+ | (replicateM n arbitrary) |
||
− | compareAngles base a b = compare (pointAngle base b) (pointAngle base a) |
||
+ | (\xs -> (xs & convex & sort) == (xs & convex & convex & sort)) |
||
+ | main :: IO () |
||
− | --Graham Scan |
||
+ | main = do |
||
− | gscan :: [Point] -> [Point] |
||
+ | putStrLn "Running tests..." |
||
− | gscan ps = scan (sortByAngle ps) |
||
+ | mapM checkN [0, 1, 2, 3, 4, 5, 10, 100, 1000] |
||
− | where scan (x:y:z:xs) = if dir x y z == RightTurn |
||
+ | putStrLn "done." |
||
− | then x: scan (z:xs) |
||
+ | where |
||
− | else x: scan (y:z:xs) |
||
+ | checkN :: Int -> IO () |
||
− | scan (x:y:[]) = (x:y:[]) |
||
− | + | checkN n = do |
|
+ | putStrLn $ "size: " ++ show n |
||
+ | quickCheck (convexIsStable n) |
||
</haskell> |
</haskell> |
||
+ | |||
+ | The results are: |
||
+ | |||
+ | <haskell> |
||
+ | 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. |
||
+ | </haskell> |
||
+ | |||
+ | [[Category:Code]] |
Latest revision as of 03:42, 14 August 2021
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.