fork download
copy 
  1. import Data.Ratio
  2.  
  3. main :: IO ()
  4. main = mapM_ printIntersection ls
  5.   where
  6.     ls =
  7.       [
  8.         (line (0, 8) (4, 0), line (2, 4) (8, 12))
  9.       , (line (0, 0) (1, 2), line (1, 1) (2, 3))
  10.       , (line (-9, -9) (1, 1), line (5, 0) (5, 3))
  11.       , (line (3, 4) (6, 7), line (3, 8) (9, -1))
  12.       ]
  13.  
  14. printIntersection :: (Line, Line) -> IO ()
  15. printIntersection (l, m) = putStrLn s
  16.   where
  17.     s | any isNaN [x, y] = "交点なし"
  18.       | otherwise        = show (x, y)
  19.     (x, y) = intersection l m
  20.  
  21. type Point = (Double, Double)
  22. type Line  = (Ratio Integer, Ratio Integer, Ratio Integer)
  23.  
  24. line :: Point -> Point -> Line
  25. line (x1, y1) (x2, y2)
  26.   | dx /= 0   = (toRational slope, - 1, toRational $ slope * x1 - y1)
  27.   | dx == 0   = (1, 0, toRational x1)
  28.   | otherwise = (0, 0, toRational x1)
  29.   where
  30.     slope = dy / dx
  31.     dx = x2 - x1
  32.     dy = y2 - y1
  33.  
  34. intersection :: Line -> Line -> Point
  35. intersection l@(a, b, p) m@(c, d, q)
  36.   | not $ parallel l m = (fromRational x, fromRational y)
  37.   | otherwise          = (nan, nan)
  38.   where
  39.     x = invd * p + invb * q
  40.     y
  41.       | 0 `elem` [a, b] = c * x + q
  42.       | 0 `elem` [c, d] = a * x + p
  43.       | otherwise       = invc * p + inva * q
  44.     [inva, invb, invc, invd] = map (/ det l m) [a, -b, -c, d]
  45.     nan :: Double
  46.     nan = 0 / 0
  47.  
  48. parallel :: Line -> Line -> Bool
  49. parallel l m = det l m == (0 % 1)
  50.  
  51. det :: Line -> Line -> Ratio Integer
  52. det (a, b, _) (c, d, _) = a * d - b * c
  53.  
Success #stdin #stdout 0s 6324KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(2.0,4.0)
交点なし
(5.0,5.0)
(4.6,5.6)
https://ideone.com/lREXQO
language:
Haskell (ghc 8.4.4)
created:
11 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!