Real World Haskell 3章 練習問題: GrahamScanアルゴリズムによる凸包の導出

Haskell

割とHaskellっぽく書けたと思う。

import Data.List

data (Num a) => Point a = Point { x :: a, y :: a } deriving (Eq, Show)

(.+) :: (Num a, Ord a) => Point a -> Point a -> Point a
a .+ b = Point (x a + x b) (y a + y b)

(.-) :: (Num a, Ord a) => Point a -> Point a -> Point a
a .- b = Point (x a - x b) (y a - y b)

data Direction = Clockwise | Counterclockwise | Straight
               deriving (Show)

ccw :: (Num a, Ord a) => Point a -> Point a -> Point a -> Direction
ccw a b c
  | prod == 0 = Straight
  | prod >  0 = Counterclockwise
  | otherwise = Clockwise
    where
      (p, q) = (b.- a, c .- b)
      prod   = (y p) * (x q) - (x p) * (y q)

ccwMap :: (Num a, Ord a) => [Point a] -> [Direction]
ccwMap (x1:x2:x3:xs) = ccw x1 x2 x3 : ccwMap (x2:x3:xs)
ccwMap _             = []

compareCart :: (Num a, Ord a) => Point a -> Point a -> Ordering
compareCart a b =
  if y a /= y b then y a `compare` y b else x a `compare` x b

compareArg :: (Num a, Ord a) => Point a -> Point a -> Point a -> Ordering
compareArg p0 p1 p2 = case ccw p0 p1 p2 of
  Counterclockwise -> GT
  Clockwise        -> LT
  otherwise        -> EQ

grahamScan :: (Num a, Ord a) => [Point a] -> [Point a]
grahamScan pts
  | length pts < 3 = error "grahamScan: list length must be greater than 2"
  | otherwise       = scan (p1:p0:[]) p2s
    where
      p0     = minimumBy compareCart pts
      p1:p2s = sortBy (compareArg p0) (delete p0 pts)
      scan result []          = result
      scan result (next:rest) = case head $ ccwMap (next:result) of
        Clockwise -> scan (tail result) (next:rest)
        otherwise -> scan (next:result) rest

適当に拾ってきたテストデータを食べさせてみる

 *Main> grahamScan $ map (uncurry Point) [(1,1), (1,2), (1,5), (3,5), (4,9), (5,4), (6, 7), (7, 8), (7, 2), (9, 7), (9, 3)]
[Point {x = 1, y = 5},Point {x = 4, y = 9},Point {x = 7, y = 8},Point {x = 9, y = 7},Point {x = 9, y = 3},Point {x = 7, y = 2},Point {x = 1, y = 1}]

出力結果が読みにくいｗ