{-# 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