Haskell - 型を定義し、関数を単純化する(Graham スキャンアルゴリズムの実装)

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

開発環境

• OS X Lion - Apple(OS)
• BBEdit - Bare Bones Software, Inc.(Text Editor)
• プログラミング言語: Haskell (純粋関数型)

Real World Haskell』(Bryan O'Sullivan、John Goerzen、Don Stewart(著)、山下 伸夫、伊東 勝利、株式会社タイムインターメディア(翻訳)、オライリー・ジャパン、2009年、ISBN978-4-87311-423-3)の3章(型を定義し、関数を単純化する)の3.13(ガード条件節の評価)の練習問題12.を解いてみる。

12.

コード(BBEdit)

Sample.hs

-- file: Sample.hs
data Point = Point Double Double
                   deriving (Eq, Show)
data Direction = DLeft |
                 DRight |
                 DStraight
                 deriving (Eq, Show)
crossProduct :: Point -> Point -> Double
crossProduct (Point x1 y1) (Point x2 y2) = x1 * y2 - x2 * y1
getDirection :: Point -> Point -> Point -> Direction
getDirection (Point x1 y1) (Point x2 y2) (Point x3 y3)
    | cp > 0 = DLeft
    | cp == 0 = DStraight
    | cp < 0 = DRight
        where cp = crossProduct a b
              a = Point (x2 - x1) (y2 - y1)
              b = Point (x3 - x2) (y3 - y2)
getDirections :: [Point] -> [Direction]
getDirections [] = []
getDirections (x:xs) | length xs <= 1 = []
                     | otherwise = (getDirection x y z):(getDirections xs)
                         where y = head l
                               z = last l
                               l = take 2 xs
sortByY :: [Point] -> [Point]
sortByY [] = []
sortByY (x:[]) = [x]
sortByY (x:xs) = (sortByY small) ++ [x] ++ (sortByY large)
    where small = smaller x xs
          large = larger x xs
          smaller (Point x y) [] = []
          smaller (Point x1 y1) ((Point x2 y2):xs)
              | y1 > y2 = (Point x2 y2):(smaller (Point x1 y1) xs)
              | y1 == y2 && x1 > x2 = (Point x2 y2):(smaller (Point x1 y1) xs)
              | otherwise = smaller (Point x1 y1) xs
          larger (Point x y) [] = []
          larger (Point x1 y1) ((Point x2 y2):xs)
              | y1 < y2 = (Point x2 y2):(larger (Point x1 y1) xs)
              | y1 == y2 && x1 <= x2 = (Point x2 y2):(larger (Point x1 y1) xs)
              | otherwise = larger (Point x1 y1) xs
angle :: Point -> Point -> Double
angle (Point x1 y1) (Point x2 y2) = (x2 - x1) / (y2 - y1)
sortByAngleSub :: Point -> [Point] -> [Point]
sortByAngleSub p [] = []
sortByAngleSub p (x:xs) = sortByAngleSub p small ++ [x] ++ sortByAngleSub p large
    where small = smaller x xs
          large = larger x xs
          smaller a [] = []
          smaller a (b:bs)
              | angle p a <= angle p b = b:(smaller a bs)
              | otherwise = smaller a bs
          larger a [] = []
          larger a (b:bs)
              | angle p a > angle p b = b:(larger a bs)
              | otherwise = larger a bs
sortByAngle :: [Point] -> [Point]
sortByAngle [] = []
sortByAngle (x:[]) = [x]
sortByAngle (x:xs)
    | length xs == 1 = (x:xs)
    | otherwise = x:sortByAngleSub x xs
grahamScan :: [Point] -> [Point]
grahamScan [] = []
grahamScan (x:xs)
    | length xs <= 1 = (x:xs)
    | otherwise = scan as
        where bs = sortByY (x:xs)
              p = take 1 bs
              as = (sortByAngle bs) ++ p
              scan [a, b] = [a]
              scan (a:b:c:as) 
                  | getDirection a b c == DLeft = a:(scan (b:c:as))
                  | getDirection a b c == DStraight = scan (a:c:as)
                  | getDirection a b c == DRight = scan (a:c:as)

a = Point (-10) 10
b = Point 10 10
c = Point (-10) (-10)
d = Point 10 (-10)
e = Point 0 0
f = Point 1 5
g = Point (-5) 1
h = Point (-2) (-4)
i = Point 4 (-2)
j = Point 0 (-5)
pointList = [a,b,c,d,e,f,g,h,i,j]

入出力結果(Terminal)

$ ghci
GHCi, version 7.4.2: 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 Sample.hs
[1 of 1] Compiling Main             ( Sample.hs, interpreted )
Ok, modules loaded: Main.
*Main> grahamScan pointList
[Point (-10.0) (-10.0),Point 10.0 (-10.0),Point 4.0 (-2.0),Point 10.0 10.0,Point 1.0 5.0,Point (-10.0) 10.0]
*Main> :quit
Leaving GHCi.
$

出力見ると、凸集合は4点((10,10), (-10, 10), (-10,-10), (10, -10))だし、どこか間違えてるみたい。(どこかというか、間違えてるとこいっぱいありそう。。凸集合の定義自体を勘違いしてるのかも><)