開発環境
- OS X Mavericks - Apple(OS)
- BBEdit - Bare Bones Software, Inc., Emacs (Text Editor)
- Haskell (純粋関数型プログラミング言語)
- GHC (The Glasgow Haskell Compiler) (処理系)
- The Haskell Platform (インストール方法、モジュール等)
初めてのコンピュータサイエンス(Jennifer Campbell、Paul Gries、Jason Montojo、Greg Wilson(著)長尾 高弘(翻訳))の12章(各種ツール)、12.7(練習問題)、12-4、5.をHaskellで解いてみる。
その他参考書籍
- プログラミングHaskell (オーム社) Graham Hutton(著) 山本 和彦(翻訳)
- Real World Haskell―実戦で学ぶ関数型言語プログラミング (オライリージャパン) Bryan O'Sullivan John Goerzen Don Stewart(著) 山下 伸夫 伊東 勝利 株式会社タイムインターメディア(翻訳)
12.7(練習問題)、12-4、5.
コード(BBEdit)
Sample.hs
{-# OPTIONS -Wall -Werror #-} main :: IO () main = mapM_ print $ map (\(line1, line2) -> lineIntersect line1 line2) testLinePairs data Point = Point {getX :: Double, getY :: Double} deriving (Show, Eq) data Line = Line {getA :: Point, getB :: Point} deriving (Show, Eq) lineIntersect :: Line -> Line -> Either String (Either Line (Maybe Point)) lineIntersect line1 line2 = let new_line1@(Line (Point a1 b1) (Point c1 d1)) = newLine line1 new_line2@(Line (Point a2 b2) (Point c2 d2)) = newLine line2 slope1 = slope new_line1 slope2 = slope new_line2 y_intercept1 = yIntercept new_line1 y_intercept2 = yIntercept new_line2 infinity = 1.0 / 0 y1 = slope1 * a2 - y_intercept1 y2 = slope2 * a1 - y_intercept2 x = - (y_intercept1 - y_intercept2) / (slope1 - slope2) y = slope1 * x + y_intercept1 in if slope1 == slope2 then if new_line1 == new_line2 then Left "Geometry" else if y_intercept1 == y_intercept2 then if a1 > c2 || c1 < a2 then Right $ Right Nothing else if (a1 == c1 && b1 == c2) || (c1 == a2 && d1 == b2) then if a1 == c1 then Right $ Right $ Just $ Point a1 b1 else Right $ Right $ Just $ Point c1 d1 else Right $ Left line1 else Right $ Right Nothing else if slope1 == infinity then if a1 < a2 || a1 > c2 || y2 < b1 || y2 > d1 then Right $ Right Nothing else Right $ Right $ Just $ Point a1 y2 else if slope2 == infinity then if a2 < a1 || a2 > c1 || y1 < b2 || y1 > d2 then Right $ Right Nothing else Right $ Right $ Just $ Point a2 y1 else if a1 <= x && x <= c1 && a2 <= x && x <= c2 && min b1 d1 <= y && y <= max b1 d1 && min b2 d2 <= y && y <= max b2 d2 then Right $ Right $ Just $ Point x y else Right $ Right Nothing newLine :: Line -> Line newLine line@(Line (Point a b) (Point c d)) = if a > c || (a == c && b > d) then Line (Point c d) (Point a b) else line slope :: Line -> Double slope (Line (Point a b) (Point c d)) = (d - b) / (c - a) yIntercept :: Line -> Double yIntercept line@(Line (Point a b) _) = b - slope line * a testLinePairs :: [(Line, Line)] testLinePairs = [(Line (Point 0 0) (Point 1 1), Line (Point 1 0) (Point 2 1)), (Line (Point 0 0) (Point 1 1), Line (Point 0 1) (Point 1 0)), (Line (Point 0 0) (Point 1 1), Line (Point 1 1) (Point 2 2)), (Line (Point 0 0) (Point 1 1), Line (Point 0 0) (Point 1 1)), (Line (Point 0 0) (Point 2 2), Line (Point 1 1) (Point 3 3))]
入出力結果(Terminal, runghc)
$ runghc Sample.hs Right (Right Nothing) Right (Right (Just (Point {getX = 0.5, getY = 0.5}))) Right (Right (Just (Point {getX = 1.0, getY = 1.0}))) Left "Geometry" Right (Left (Line {getA = Point {getX = 0.0, getY = 0.0}, getB = Point {getX = 2.0, getY = 2.0}})) $
慣れるまでは{-# OPTIONS -Wall -Werror #-}の記述を消さずに細かく型を指定していくことに。
0 コメント:
コメントを投稿