diff --git a/CG2.cabal b/CG2.cabal index 2bc5988..24b2005 100644 --- a/CG2.cabal +++ b/CG2.cabal @@ -140,3 +140,50 @@ executable Gif -- Base language which the package is written in. default-language: Haskell2010 + + +executable Test + -- .hs or .lhs file containing the Main module. + main-is: TestMain.hs + + -- Modules included in this executable, other than Main. + other-modules: Algebra.Vector + Algorithms.GrahamScan + Algorithms.PolygonIntersection + Algorithms.QuadTree + Algorithms.KDTree + Graphics.Diagram.AlgoDiags + Graphics.Diagram.Core + Graphics.Diagram.Gif + Graphics.Diagram.Plotter + MyPrelude + Parser.Meshparser + Parser.PathParser + QueueEx + Test.Vector + + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: attoparsec >= 0.12.1.1, + base >=4.6 && <4.8, + bytestring >= 0.10.4.0, + containers >= 0.5.0.0, + dequeue >= 0.1.5, + diagrams-lib >=1.2 && <1.3, + diagrams-cairo >=1.2 && <1.3, + diagrams-contrib >= 1.1.2.1, + gloss >= 1.2.0.1, + JuicyPixels >= 3.1.7.1, + multiset-comb >= 0.2.1, + QuickCheck >= 2.4.2, + transformers >=0.4 && <0.5, + safe >= 0.3.8 + + -- Directories containing source files. + -- hs-source-dirs: + + -- Base language which the package is written in. + default-language: Haskell2010 diff --git a/Test/Vector.hs b/Test/Vector.hs new file mode 100644 index 0000000..1db3a26 --- /dev/null +++ b/Test/Vector.hs @@ -0,0 +1,82 @@ +{-# OPTIONS_HADDOCK ignore-exports #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} + +module Test.Vector where + +import Algebra.Vector +import Control.Applicative +{- import Control.Monad -} +import Diagrams.TwoD.Types +import Test.QuickCheck + + +instance Arbitrary R2 where + arbitrary = curry r2 <$> arbitrary <*> arbitrary + + +instance Arbitrary P2 where + arbitrary = curry p2 <$> arbitrary <*> arbitrary + + +inRangeProp1 :: Square -> Bool +inRangeProp1 sq@((x1, y1), _) = + inRange sq (p2 (x1, y1)) + + +inRangeProp2 :: Square -> Bool +inRangeProp2 sq@(_, (x2, y2)) = + inRange sq (p2 (x2, y2)) + + +inRangeProp3 :: Square -> Bool +inRangeProp3 sq@((x1, _), (_, y2)) = + inRange sq (p2 (x1, y2)) + + +inRangeProp4 :: Square -> Bool +inRangeProp4 sq@((_, y1), (x2, _)) = + inRange sq (p2 (x2, y1)) + + +inRangeProp5 :: Square -> Bool +inRangeProp5 sq@((x1, y1), (x2, y2)) = + inRange sq (p2 (x1 + ((x2 - x1) / 2), y1 + ((y2 - y1) / 2))) + + +onPTProp1 :: PT -> Bool +onPTProp1 pt = onPT id pt == pt + + +onPTProp2 :: PT -> Positive R2 -> Bool +onPTProp2 pt (Positive (R2 rx ry)) + = onPT (\(x, y) -> (x + rx, y + ry)) pt /= pt + + +getAngleProp1 :: Positive Vec -> Positive Vec -> Bool +getAngleProp1 (Positive (R2 x1 _)) (Positive (R2 x2 _)) + = getAngle (R2 x1 0) (R2 x2 0) == 0 + + +getAngleProp2 :: Positive Vec -> Positive Vec -> Bool +getAngleProp2 (Positive (R2 _ y1)) (Positive (R2 _ y2)) + = getAngle (R2 0 y1) (R2 0 y2) == 0 + + +getAngleProp3 :: Positive Vec -> Positive Vec -> Bool +getAngleProp3 (Positive (R2 x1 _)) (Positive (R2 x2 _)) + = getAngle (R2 (negate x1) 0) (R2 x2 0) == pi + + +getAngleProp4 :: Positive Vec -> Positive Vec -> Bool +getAngleProp4 (Positive (R2 _ y1)) (Positive (R2 _ y2)) + = getAngle (R2 0 (negate y1)) (R2 0 y2) == pi + + +getAngleProp5 :: Positive Vec -> Positive Vec -> Bool +getAngleProp5 (Positive (R2 x1 _)) (Positive (R2 _ y2)) + = getAngle (R2 x1 0) (R2 0 y2) == pi / 2 + + +getAngleProp6 :: Positive Vec -> Positive Vec -> Bool +getAngleProp6 (Positive (R2 _ y1)) (Positive (R2 x2 _)) + = getAngle (R2 x2 0) (R2 0 y1) == pi / 2 diff --git a/TestMain.hs b/TestMain.hs new file mode 100644 index 0000000..8bd0930 --- /dev/null +++ b/TestMain.hs @@ -0,0 +1,29 @@ +{-# OPTIONS_HADDOCK ignore-exports #-} + + +import Test.QuickCheck +import Test.Vector + + +deepCheck :: Testable prop => prop -> IO () +deepCheck = quickCheckWith (stdArgs { maxSuccess = 1000}) + + +main :: IO () +main = do + putStrLn "testing inRange:" + deepCheck inRangeProp1 + deepCheck inRangeProp2 + deepCheck inRangeProp3 + deepCheck inRangeProp4 + deepCheck inRangeProp5 + putStrLn "testing onPT:" + deepCheck onPTProp1 + deepCheck onPTProp2 + putStrLn "testing getAngle:" + deepCheck getAngleProp1 + deepCheck getAngleProp2 + deepCheck getAngleProp3 + deepCheck getAngleProp4 + deepCheck getAngleProp5 + deepCheck getAngleProp6