Graham scan

Real World Haskell の 3章末の練習問題 12 - Graham scan アルゴリズムの実装 - を解いてみた。

import List
import Data.Ord
-------- 問 9 --------
-- 方向
data Direction = LeftTurn | RightTurn | Straight
                 deriving (Eq, Show)

-------- 問 10 --------
-- 座標
data Point = Point {
      x :: Double
    , y :: Double
  } deriving (Eq, Show)
-- 2次元平面上の点の位置関係を計算し、
-- Direction を返す
ccw :: Point -> Point -> Point -> Direction
ccw a b c 
  | exterior > 0 = LeftTurn
  | exterior < 0 = RightTurn
  | otherwise    = Straight
  where exterior = (x b - x a) * (y c - y a) - (x c - x a) * (y b - y a)

-------- 問 11 --------
-- ccw のList版
ccws :: [Point] -> [Direction]
ccws (p1:p2:p3:ps) = ccw p1 p2 p3 : ccws (p2:p3:ps)
ccws _ = []

-------- 問 12 --------
-- 位置でソート
sortCoordinate :: [Point] -> [Point]
sortCoordinate ps = sortBy cmp ps
  where cmp a b | y a < y b = LT 
                | y a > y b = GT
                | x a < x b = LT
                | x a > x b = GT
                | otherwise = EQ
-- 角度でソート
sortAngle :: Point -> [Point] -> [Point]
sortAngle p ps = sortBy cmp ps
  where cmp a b = compare (cot b) (cot a)
                  where cot c = (x c - x p) / (y c- y p)
-- Graham scan の準備
gsort :: [Point] -> [Point]
gsort ps = let csort = sortCoordinate ps 
               lower = head csort
           in  lower : sortAngle lower (tail csort)
-- Direction の List の中に RightTurn があるか判定
turnRight :: [Direction] -> Bool
turnRight [] = False
turnRight (x:xs)
  | x == RightTurn = True
  | otherwise      = turnRight xs
-- Graham scan
grahamScan :: [Point] -> [Point]
grahamScan [] = []
grahamScan ps = scan [] (gsort ps) 
  where 
    scan [] (y1:y2:ys) = scan [y1, y2] ys
    scan xs [] = xs
    scan xs (y:ys)
      | turnRight (ccws (xs ++ [y])) = scan (init xs) (y:ys)
      | otherwise                    = scan (xs ++ [y]) ys

Point 型は余分だったかな。

追記 (2010/03/24)
turnRight はリストの中に RightTurn があるかを判定しているけど、リストの最後が RightTurn がどうかを判定するだけで大丈夫だと思う。