{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE UndecidableInstances #-}
module Main where
import Prelude hiding (Num (..), Ord (..))
import qualified Prelude
import Algebra
import Control.Applicative
import Data.Interval
import Data.Maybe (isJust)
import Data.Ratio
import Data.Semigroup (Product, Sum)
import Relation.Binary.Comparison as A
import Test.SmallCheck
import Test.SmallCheck.Series
import Test.Tasty
import Test.Tasty.SmallCheck
main :: IO ()
main = defaultMain $
testGroup ""
[testProperty "≤-reflexive" $ \ (a :: Interval Rational) -> a ≤ a,
testProperty "≤-antisymmetric" $ \ (a :: Interval Rational) b -> (a ≤ b && b ≤ a) ≡ (a ≡ b),
testProperty "≤-transitive" $ \ (a :: Interval Rational) b c -> not (a ≤ b && b ≤ c) || a ≤ c,
testProperty "≤-overlap" $ \ (a :: Interval Rational) b -> (a ≤ b) ≡ (overlap a b ≡ Just a),
testProperty "overlap-commutative" $ \ (a :: Interval Rational) b -> overlap a b ≡ overlap b a,
testProperty "hull-commutative" $ \ (a :: Interval Rational) b -> overlap a b ≡ overlap b a]
instance (Serial m a, PartialOrd a) => Serial m (Interval a) where
series = decDepth [a :–: b | a <- series, b <- series, a ≤ b]
instance (PartialOrd a, Semigroup (Product a)) => Preord (Ratio a) where
(liftA2 (,) numerator denominator -> (an, ad)) ≤ (liftA2 (,) numerator denominator -> (bn, bd)) =
an * bd ≤ bn * ad
instance (A.PartialOrd a, A.Eq a, Semigroup (Product a)) => A.Eq (Ratio a)
instance (PartialOrd a, Semigroup (Product a)) => PartialOrd (Ratio a) where
tryCompare (liftA2 (,) numerator denominator -> (an, ad)) (liftA2 (,) numerator denominator -> (bn, bd)) =
tryCompare (an * bd) (bn * ad)
instance (Ord a, Semigroup (Product a)) => Ord (Ratio a) where
compare (liftA2 (,) numerator denominator -> (an, ad)) (liftA2 (,) numerator denominator -> (bn, bd)) =
compare (an * bd) (bn * ad)
instance Group (Sum (Ratio Integer)) where
invert = Prelude.negate