geom2d-0.1.0.1: Test/Line.hs

{-# LANGUAGE TemplateHaskell #-}

import Geom2d.Line
import Geom2d.Point
import Geom2d.Translate
import Geom2d.Distance
import Geom2d.Intersect
import Test.QuickCheck.All
import Test.QuickCheck
import Data.AEq
import Data.Maybe
import Test.Utils

prop_infline_translate :: InfLine Point' Float
                       -> InfLine Point' Float
                       -> Point' Float
                       -> Bool
prop_infline_translate l1 l2 v =
  parallel l1 l2 == parallel l1 (translate v l2)

prop_line_function_vertical :: Float -> Bool
prop_line_function_vertical xarg =
  maybe False (not.isJust.lineF) $
    mkInfLine (fromCoords xarg 0 :: Point' Float) (fromCoords xarg 1)

prop_line_function_linear :: Float -> Bool
prop_line_function_linear xarg = maybe False (\f -> f xarg ~== xarg) $ do
  line <- mkInfLine (fromCoords 0 0) (fromCoords 1 1 :: Point' Float)
  lineF line

prop_parallel :: Float -> Bool
prop_parallel n = maybe True id $ do
  yAxis <- mkInfLine (fromCoords 0 0 :: Point' Float) (fromCoords 0 1)
  line <- mkInfLine (fromCoords 1 0) (fromCoords 1 n)
  return (parallel yAxis line)

prop_slope :: Float -> Float -> Bool
prop_slope ax ay = maybe True id $ do
  l <- mkInfLine
       (fromCoords 0 0 :: Point' Float)
       (fromCoords ax ay)
  s <- slope l
  return $ s == ay / ax

prop_root :: InfLine Point' Float -> Bool
prop_root l
  | slope l == Just 0 = isNothing (root l)
  | isNothing (slope l) = True
  | otherwise = maybe False id $ do
      x0 <- root l
      f <- lineF l
      return (f x0 ~== 0)

prop_line_equal :: Bool
prop_line_equal = maybe False (\l -> l == l) $
  mkInfLine (fromCoords 0 0 :: Point' Float) (fromCoords 1 0)

prop_intersection_equal :: Bool
prop_intersection_equal = maybe False id $ do
  xAxis <- mkInfLine (fromCoords 0 0 :: Point' Float) (fromCoords 1 0)
  return $ (not.isJust) (xAxis `intersection` xAxis)

prop_intersection_parallel :: Bool
prop_intersection_parallel = maybe False id $ do
  xAxis <- mkInfLine (fromCoords 0 0 :: Point' Float) (fromCoords 1 0)
  let line = translate (fromCoords 0 1 :: Point' Float) xAxis
  return $ (not.isJust) (xAxis `intersection` line)

prop_intersection_origin :: Bool
prop_intersection_origin = maybe False id $ do
  xAxis <- mkLine (fromCoords 0 0) (fromCoords 1 0)
  yAxis <- mkLine (fromCoords 0 0) (fromCoords 0 1)
  (~== origin) <$> (xAxis `intersection` yAxis)
  where mkLine :: Point' Float -> Point' Float -> Maybe (InfLine Point' Float)
        mkLine = mkInfLine
        origin = fromCoords 0 0

prop_intersection_onYAxis :: Float -> Float -> Bool
prop_intersection_onYAxis m1 m2 = maybe (m1 == m2) (== fromCoords 0 0) $ do
  l1 <- mkInfLine (fromCoords 0 0 :: Point' Float) (fromCoords 1 m1)
  l2 <- mkInfLine (fromCoords 0 0) (fromCoords 1 m2)
  intersection l1 l2

prop_intersection_yaxis :: Bool
prop_intersection_yaxis = fromMaybe False $ do
  l1 <- mkInfLine (fromCoords 0 0 :: Point' Float) (fromCoords 0 1)
  l2 <- mkInfLine (fromCoords 0 0 :: Point' Float) (fromCoords 1 0)
  (~== fromCoords 0 0) <$> intersection l1 l2

prop_finline_translate_constant_length :: FinLine Point' Float
                                       -> Point' Float
                                       -> Bool
prop_finline_translate_constant_length l v =
  lineLength l ~==
  lineLength (translate v l)

prop_finline_translate_notequal :: FinLine Point' Float
                                -> Point' Float
                                -> Bool
prop_finline_translate_notequal l v
  | not (magnitude v ~== 0) =
      not (l ~== (translate v l))
  | otherwise = (l ~== (translate v l))

prop_finline_distance_1 :: Bool
prop_finline_distance_1 = maybe False id $ do
  line <- mkFinLine (fromCoords 0 0 :: Point' Float)
                    (fromCoords 1 0)
  return (distance (fromCoords 1 1 :: Point' Float) line ~==
          1)

prop_finline_distance_2 :: Bool
prop_finline_distance_2 = maybe False id $ do
  line <- mkFinLine (fromCoords 0 0 :: Point' Float)
                    (fromCoords 1 0)
  return (distance (fromCoords 2 0 :: Point' Float) line ~==
          1)

prop_finline_distance_3 :: Bool
prop_finline_distance_3 = maybe False id $ do
  line <- mkFinLine (fromCoords (-10) 0 :: Point' Float)
                    (fromCoords 10 0)
  return (distance (fromCoords 0 1 :: Point' Float) line ~==
          1)

prop_finline_distance_4 :: Bool
prop_finline_distance_4 = maybe False id $ do
  line <- mkFinLine (fromCoords (-10) 0 :: Point' Float)
                    (fromCoords 10 0)
  return (distance (fromCoords 0 0 :: Point' Float) line ~==
          0)

prop_intersect_infline_infline_1 :: Bool
prop_intersect_infline_infline_1 =
  maybe False
  ( \(l1,l2) -> l1 `intersect` l2 )
  ( (,) <$>
    mkInfLine (fromCoords (-1) 0 :: Point' Float)
              (fromCoords 1 0) <*>
    mkInfLine (fromCoords 0 (-1) :: Point' Float)
              (fromCoords 0 1))

prop_intersect_finline_finline_1 :: Bool
prop_intersect_finline_finline_1 =
  maybe False
  ( \(l1,l2) -> l1 `intersect` l2 )
  ( (,) <$>
    mkFinLine (fromCoords (-1) 0 :: Point' Float)
              (fromCoords 1 0) <*>
    mkFinLine (fromCoords 0 (-1) :: Point' Float)
              (fromCoords 0 1))

prop_intersect_infline_finline_1 :: Bool
prop_intersect_infline_finline_1 =
  maybe False
  ( \(l1,l2) -> l1 `intersect` l2 )
  ( (,) <$>
    mkInfLine (fromCoords (-1) 0 :: Point' Float)
              (fromCoords 1 0) <*>
    mkFinLine (fromCoords 0 (-1) :: Point' Float)
              (fromCoords 0 1))

return []
runTests = $quickCheckAll

main = do
  putStrLn "Line.hs"
  runTests >>= doExit