fork download
copy 
  1. import Data.Ratio
  2.  
  3. main :: IO ()
  4. main = mapM_ printIntersection ls
  5.   where
  6.     ls =
  7.       [
  8.         (((0, 8), (4, 0)), ((2, 4), (8, 12)))
  9.       , (((0, 0), (4, 6)), ((0, 0), (7, 15)))
  10.       , (((0, 0), (1, 2)), ((1, 1), (2, 3)))
  11.       , (((-9, -9), (9, 9)), ((5, 0), (5, 7)))
  12.       , (((3, 4), (6, 7)), ((3, 8), (9, -1)))
  13.       , (((-1, 0), (4, 18)), ((-2, -5), (1, 3)))
  14.       ]
  15.  
  16. printIntersection :: ((Point, Point), (Point, Point)) -> IO ()
  17. printIntersection (l, m) = putStrLn s
  18.   where
  19.     s =
  20.      if not (onSegment l && onSegment m) || any isNaN [x, y] then
  21.        "交点なし"
  22.      else
  23.        show (x, y)
  24.     (x, y) = intersection (uncurry line l) (uncurry line m)
  25.  
  26.     onSegment ((x1, y1), (x2, y2)) = checkX && checkY
  27.       where
  28.         checkX = cmp (if x1 <= x2 then (<=) else (>=)) [x1, x, x2]
  29.         checkY = cmp (if y1 <= y2 then (<=) else (>=)) [y1, y, y2]
  30.         cmp f = and . (flip (zipWith f) =<< tail)
  31.  
  32.  
  33. type Point = (Double, Double)
  34. type Line  = (Ratio Integer, Ratio Integer, Ratio Integer)
  35.  
  36. line :: Point -> Point -> Line
  37. line (x1, y1) (x2, y2)
  38.   | dx /= 0   = (toRational slope, -1, toRational $ slope * x1 - y1)
  39.   | dx == 0   = (1, 0, toRational x1)
  40.   | otherwise = (0, 0, 0)
  41.   where
  42.     slope = dy / dx
  43.     dx = x2 - x1
  44.     dy = y2 - y1
  45.  
  46. intersection :: Line -> Line -> Point
  47. intersection l@(a, b, p) m@(c, d, q)
  48.   | not $ parallel l m = (fromRational x, fromRational y)
  49.   | otherwise          = (nan, nan)
  50.   where
  51.     x = invd * p + invb * q
  52.     y
  53.       | 0 == a    = c * x + q
  54.       | 0 == c    = a * x + p
  55.       | otherwise = invc * p + inva * q
  56.     [inva, invb, invc, invd] = map (/ det l m) [a, -b, -c, d]
  57.     nan :: Double
  58.     nan = 0 / 0
  59.  
  60. parallel :: Line -> Line -> Bool
  61. parallel l m = det l m == (0 % 1)
  62.  
  63. det :: Line -> Line -> Ratio Integer
  64. det (a, b, _) (c, d, _) = a * d - b * c
  65.  
Success #stdin #stdout 0s 6284KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
(2.0,4.0)
(0.0,0.0)
交点なし
(5.0,5.0)
(4.6,5.6)
交点なし
https://ideone.com/UdUQlp
language:
Haskell (ghc 8.4.4)
created:
10 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!