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