Haskell - 型を定義し、関数を単純化する(Graham scan algorithm, 凸包)

Real World Haskell
実戦で学ぶ関数型言語プログラミング
(オライリージャパン)
Bryan O'Sullivan (著) John Goerzen (著)
Don Stewart (著)
山下 伸夫 (翻訳) 伊東 勝利 (翻訳)
株式会社タイムインターメディア (翻訳)

開発環境

• OS X Mavericks - Apple(OS)
• BBEdit - Bare Bones Software, Inc., Emacs (Text Editor)
• Haskell (純粋関数型プログラミング言語)
• GHC (The Glasgow Haskell Compiler) (処理系)
• The Haskell Platform (インストール方法、モジュール等)

Real World Haskell―実戦で学ぶ関数型言語プログラミング(Bryan O'Sullivan (著)、 John Goerzen (著)、 Don Stewart (著)、山下 伸夫 (翻訳)、伊東 勝利 (翻訳)、株式会社タイムインターメディア (翻訳)、オライリージャパン)の3章(型を定義し、関数を単純化する)、3.13(ガードの条件節の評価)、練習問題 12.を解いてみる。

その他参考書籍

• すごいHaskellたのしく学ぼう!(オーム社) Miran Lipovača(著)、田中 英行、村主 崇行(翻訳)
• プログラミングHaskell (オーム社) Graham Hutton(著) 山本 和彦(翻訳)

練習問題 12.

コード(BBEdit)

Sample.hs

{-# OPTIONS -Wall -Werror #-}
module GrahamScan where

import qualified Data.List as List

type Point = (Double, Double)
data Direction = LeftTurn | Collinear | RightTurn
                deriving (Show, Eq)

grahamScan :: [Point] -> [Point]
grahamScan ps = let p = findLowestPoint ps
                    ps' = sortPoints p ps
                in grahamScanRecursive p ps'

grahamScanRecursive :: Point -> [Point] -> [Point]
grahamScanRecursive p (a:b:[])
    | d == LeftTurn = [a, b]
    | d == Collinear = [b]
     where d = getDirection a b p
grahamScanRecursive p (a:b:c:ps)
    | a == b = grahamScanRecursive p (a:c:ps)
    | a == c = grahamScanRecursive p (a:ps)
    | b == c = grahamScanRecursive p (a:b:ps)
    | d == LeftTurn = a:grahamScanRecursive p (b:c:ps)
    | otherwise = grahamScanRecursive p (a:c:ps)
     where d = getDirection a b c

grahamScanRecursive _ _ = undefined


findLowestPoint :: [Point] -> Point
findLowestPoint = foldr1 lowerPoint

lowerPoint :: Point -> Point -> Point
lowerPoint (a, b) (c, d)
    | b < d = (a, b)
    | b > d = (c, d)
    | a < c = (a, b)
    | otherwise = (c, d)

sortPoints :: Point -> [Point] -> [Point]
sortPoints p = List.sortBy (comparePoint p)

comparePoint :: Point -> Point -> Point -> Ordering
comparePoint p a b
    | a == b = EQ
    | t > 0 = LT
    | t < 0 = GT
    | fst a < fst b = LT
    | otherwise = GT
      where t = cow p a b

getDirections :: [Point] -> [Direction]
getDirections (a:b:c:xs) = getDirection a b c:getDirections (b:c:xs)
getDirections _ = []

getDirection :: Point -> Point -> Point -> Direction
getDirection a b c
    | t > 0 = LeftTurn
    | t < 0 = RightTurn
    | otherwise = Collinear
      where t = cow a b c

cow :: Point -> Point -> Point -> Double
cow (x1, y1) (x2, y2) (x3, y3) = (x2 - x1) * (y3 - y1) - (y2 - y1) * (x3 - x1)

kernel :: Point
kernel = (0.0, 0.0)

test :: [Point]
test = [
    kernel, (1.0, 0.0), kernel, (1.0, 1.0), kernel, (0.0, 1.0), kernel,
    (-1.0, 1.0), kernel, (-1.0, 0), kernel, (-1.0, -1.0), kernel, (0.0, -1.0),
    kernel, (1.0, -1.0)]

入出力結果(Terminal, インタプリタghci)

$ ghci
GHCi, version 7.6.3: http://www.haskell.org/ghc/  :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.
Prelude> :load GrahamScan.hs 
[1 of 1] Compiling GrahamScan       ( GrahamScan.hs, interpreted )
Ok, modules loaded: GrahamScan.
*GrahamScan> let a = grahamScan test
*GrahamScan> a
[(-1.0,-1.0),(1.0,-1.0),(1.0,0.0),(1.0,1.0),(0.0,1.0),(-1.0,1.0)]
*GrahamScan> getDirections a
[LeftTurn,Collinear,LeftTurn,Collinear]
*GrahamScan> :quit 
Leaving GHCi.
$