diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,10 @@ +0.10.0 +=== +* Moved operators back in. +* added doctests and properties +* added accsum & accproduct +* fixed Ratio Eq instance + 0.9.0 === * Removed bounded classes. diff --git a/numhask.cabal b/numhask.cabal --- a/numhask.cabal +++ b/numhask.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: numhask -version: 0.9.0.0 +version: 0.10.0.0 synopsis: A numeric class hierarchy. description: This package provides alternative numeric classes over Prelude. @@ -35,13 +35,14 @@ subdir: numhask library - hs-source-dirs: src + hs-source-dirs: src ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fwrite-ide-info -hiedir=.hie - build-depends: base >=4.7 && <5 + x-docspec-extra-packages: QuickCheck + build-depends: base >=4.7 && <5 exposed-modules: NumHask NumHask.Algebra.Additive @@ -59,4 +60,13 @@ NumHask.Prelude other-modules: + default-language: Haskell2010 + +test-suite doctests + type: exitcode-stdio-1.0 + main-is: doctests.hs + hs-source-dirs: test default-language: Haskell2010 + build-depends: + , base + , QuickCheck diff --git a/src/NumHask.hs b/src/NumHask.hs --- a/src/NumHask.hs +++ b/src/NumHask.hs @@ -20,28 +20,27 @@ -- * Additive Additive (..), sum, + accsum, Subtractive (..), - (-), -- * Multiplicative Multiplicative (..), product, + accproduct, Divisive (..), - (/), -- * Ring - module NumHask.Algebra.Ring, + Distributive, + Ring, + StarSemiring (..), + KleeneAlgebra, + InvolutiveRing (..), + two, -- * Field - ExpField (..), - logBase, - sqrt, Field, + ExpField (..), QuotientField (..), - round, - ceiling, - floor, - truncate, TrigField (..), infinity, negInfinity, @@ -49,49 +48,82 @@ half, -- * Lattice - module NumHask.Algebra.Lattice, + JoinSemiLattice (..), + joinLeq, + (<\), + MeetSemiLattice (..), + meetLeq, + (>> :set -XRebindableSyntax --- >>> :set -XFlexibleContexts -- >>> import NumHask.Prelude -- | or [Addition](https://en.wikipedia.org/wiki/Addition) -- -- For practical reasons, we begin the class tree with 'NumHask.Algebra.Additive.Additive'. Starting with 'NumHask.Algebra.Group.Associative' and 'NumHask.Algebra.Group.Unital', or using 'Data.Semigroup.Semigroup' and 'Data.Monoid.Monoid' from base tends to confuse the interface once you start having to disinguish between (say) monoidal addition and monoidal multiplication. -- --- > \a -> zero + a == a --- > \a -> a + zero == a --- > \a b c -> (a + b) + c == a + (b + c) --- > \a b -> a + b == b + a +-- prop> \a -> zero + a == a +-- prop> \a -> a + zero == a +-- prop> \a b c -> (a + b) + c == a + (b + c) +-- prop> \a b -> a + b == b + a -- -- By convention, (+) is regarded as commutative, but this is not universal, and the introduction of another symbol which means non-commutative addition seems a bit dogmatic. -- @@ -45,30 +47,39 @@ zero :: a -- | Compute the sum of a 'Data.Foldable.Foldable'. +-- +-- >>> sum [0..10] +-- 55 sum :: (Additive a, P.Foldable f) => f a -> a -sum = P.foldr (+) zero +sum = foldl' (+) zero +-- | Compute the accumulating sum of a 'Data.Traversable.Traversable'. +-- +-- >>> accsum [0..10] +-- [0,1,3,6,10,15,21,28,36,45,55] +accsum :: (Additive a, P.Traversable f) => f a -> f a +accsum = P.snd P.. mapAccumL (\a b -> (a + b, a + b)) zero + -- | or [Subtraction](https://en.wikipedia.org/wiki/Subtraction) -- --- > \a -> a - a == zero --- > \a -> negate a == zero - a --- > \a -> negate a + a == zero --- > \a -> a + negate a == zero +-- prop> \a -> a - a == zero +-- prop> \a -> negate a == zero - a +-- prop> \a -> negate a + a == zero +-- prop> \a -> a + negate a == zero -- -- -- >>> negate 1 -- -1 -class (Additive a) => Subtractive a where - negate :: a -> a - -infixl 6 - - --- | minus -- -- >>> 1 - 2 -- -1 -(-) :: (Subtractive a) => a -> a -> a -(-) a b = a + negate b +class (Additive a) => Subtractive a where + negate :: a -> a + negate a = zero - a + + infixl 6 - + (-) :: a -> a -> a + a - b = a + negate b instance Additive Double where (+) = (P.+) diff --git a/src/NumHask/Algebra/Field.hs b/src/NumHask/Algebra/Field.hs --- a/src/NumHask/Algebra/Field.hs +++ b/src/NumHask/Algebra/Field.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -9,13 +10,7 @@ module NumHask.Algebra.Field ( Field, ExpField (..), - logBase, - sqrt, QuotientField (..), - round, - ceiling, - floor, - truncate, infinity, negInfinity, nan, @@ -39,14 +34,13 @@ -- $setup -- -- >>> :set -XRebindableSyntax --- >>> :set -XFlexibleContexts -- >>> :set -XScopedTypeVariables -- >>> import NumHask.Prelude -- | A is a set -- on which addition, subtraction, multiplication, and division are defined. It is also assumed that multiplication is distributive over addition. -- --- A summary of the rules inherited from super-classes of Field. Floating point computation is a terrible, messy business and, in practice, only rough approximation can be achieve for association and distribution. +-- A summary of the rules inherited from super-classes of Field: -- -- > zero + a == a -- > a + zero == a @@ -79,9 +73,9 @@ -- | A hyperbolic field class -- --- > sqrt . (**2) == id --- > log . exp == id --- > for +ive b, a != 0,1: a ** logBase a b ≈ b +-- prop> \a -> a < zero || (sqrt . (**2)) a == a +-- prop> \a -> a < zero || (log . exp) a ~= a +-- prop> \a b -> (b < zero) || a <= zero || a == 1 || abs (a ** logBase a b - b) < 10 * epsilon class (Field a) => ExpField a @@ -91,19 +85,19 @@ (**) :: a -> a -> a (**) a b = exp (log a * b) --- | log to the base of --- --- >>> logBase 2 8 --- 2.9999999999999996 -logBase :: (ExpField a) => a -> a -> a -logBase a b = log b / log a + -- | log to the base of + -- + -- >>> logBase 2 8 + -- 2.9999999999999996 + logBase :: a -> a -> a + logBase a b = log b / log a --- | square root --- --- >>> sqrt 4 --- 2.0 -sqrt :: (ExpField a) => a -> a -sqrt a = a ** (one / (one + one)) + -- | square root + -- + -- >>> sqrt 4 + -- 2.0 + sqrt :: a -> a + sqrt a = a ** (one / (one + one)) instance ExpField P.Double where exp = P.exp @@ -123,60 +117,65 @@ -- -- See [Field of fractions](https://en.wikipedia.org/wiki/Field_of_fractions) -- --- > a - one < floor a <= a <= ceiling a < a + one --- > round a == floor (a + half) +-- > \a -> a - one < floor a <= a <= ceiling a < a + one +-- prop> (\a -> a - one < fromIntegral (floor a :: Int) && fromIntegral (floor a :: Int) <= a && a <= fromIntegral (ceiling a :: Int) && fromIntegral (ceiling a :: Int) <= a + one) :: Double -> Bool +-- prop> \a -> (round a :: Int) ~= (floor (a + half) :: Int) class (Field a, Multiplicative b, Additive b) => QuotientField a b where properFraction :: a -> (b, a) --- | round to the nearest integral --- --- Exact ties are managed by rounding down ties if the whole component is even. --- --- >>> round (1.5 :: Double) :: Int --- 2 --- --- >>> round (2.5 :: Double) :: Int --- 2 -round :: (P.Ord a, P.Ord b, QuotientField a b, Subtractive b, Integral b) => a -> b -round x = case properFraction x of - (n, r) -> - let m = bool (n + one) (n - one) (r P.< zero) - half_down = abs' r - (one / (one + one)) - abs' a - | a P.< zero = negate a - | P.otherwise = a - in case P.compare half_down zero of - P.LT -> n - P.EQ -> bool m n (even n) - P.GT -> m + -- | round to the nearest integral + -- + -- Exact ties are managed by rounding down ties if the whole component is even. + -- + -- >>> round (1.5 :: Double) :: Int + -- 2 + -- + -- >>> round (2.5 :: Double) :: Int + -- 2 + round :: a -> b + default round :: (P.Ord a, P.Ord b, Subtractive b, Integral b) => a -> b + round x = case properFraction x of + (n, r) -> + let m = bool (n + one) (n - one) (r P.< zero) + half_down = abs' r - (one / (one + one)) + abs' a + | a P.< zero = negate a + | P.otherwise = a + in case P.compare half_down zero of + P.LT -> n + P.EQ -> bool m n (even n) + P.GT -> m --- | supply the next upper whole component --- --- >>> ceiling (1.001 :: Double) :: Int --- 2 -ceiling :: (P.Ord a, QuotientField a b) => a -> b -ceiling x = bool n (n + one) (r P.>= zero) - where - (n, r) = properFraction x + -- | supply the next upper whole component + -- + -- >>> ceiling (1.001 :: Double) :: Int + -- 2 + ceiling :: a -> b + default ceiling :: (P.Ord a) => a -> b + ceiling x = bool n (n + one) (r P.>= zero) + where + (n, r) = properFraction x --- | supply the previous lower whole component --- --- >>> floor (1.001 :: Double) :: Int --- 1 -floor :: (P.Ord a, QuotientField a b, Subtractive b) => a -> b -floor x = bool n (n - one) (r P.< zero) - where - (n, r) = properFraction x + -- | supply the previous lower whole component + -- + -- >>> floor (1.001 :: Double) :: Int + -- 1 + floor :: a -> b + default floor :: (P.Ord a, Subtractive b) => a -> b + floor x = bool n (n - one) (r P.< zero) + where + (n, r) = properFraction x --- | supply the whole component closest to zero --- --- >>> floor (-1.001 :: Double) :: Int --- -2 --- --- >>> truncate (-1.001 :: Double) :: Int --- -1 -truncate :: (P.Ord a, QuotientField a b, Subtractive b) => a -> b -truncate x = bool (ceiling x) (floor x) (x P.> zero) + -- | supply the whole component closest to zero + -- + -- >>> floor (-1.001 :: Double) :: Int + -- -2 + -- + -- >>> truncate (-1.001 :: Double) :: Int + -- -1 + truncate :: a -> b + default truncate :: (P.Ord a) => a -> b + truncate x = bool (ceiling x) (floor x) (x P.> zero) instance QuotientField P.Float P.Integer where properFraction = P.properFraction @@ -194,29 +193,40 @@ properFraction f = (P.fst . frac, P.snd . frac) where frac a = properFraction @b @c (f a) + round f = round . f + ceiling f = ceiling . f + floor f = floor . f + truncate f = truncate . f --- | A field introduces the concept of infinity. +-- | infinity is defined for any 'Field'. -- --- > one / zero + infinity == infinity --- > infinity + a == infinity --- > zero / zero != nan +-- >>> one / zero + infinity +-- Infinity -- --- Note the tricky law that, although nan is assigned to zero/zero, they are never-the-less not equal. A committee decided this. +-- >>> infinity + 1 +-- Infinity infinity :: (Field a) => a infinity = one / zero --- | +-- | nan is defined as zero/zero -- --- Note the law: --- -- > zero / zero != nan +-- but note the (social) law: +-- +-- >>> nan == zero / zero +-- False nan :: (Field a) => a nan = zero / zero -- | negative infinity +-- +-- >>> negInfinity + infinity +-- NaN negInfinity :: (Field a) => a negInfinity = negate infinity -- | Trigonometric Field +-- +-- The list of laws is quite long: class (Field a) => TrigField a @@ -281,5 +291,8 @@ atanh f = atanh . f -- | A 'half' is a 'Field' because it requires addition, multiplication and division. +-- +-- >>> half :: Double +-- 0.5 half :: (Field a) => a half = one / two diff --git a/src/NumHask/Algebra/Lattice.hs b/src/NumHask/Algebra/Lattice.hs --- a/src/NumHask/Algebra/Lattice.hs +++ b/src/NumHask/Algebra/Lattice.hs @@ -8,8 +8,10 @@ module NumHask.Algebra.Lattice ( JoinSemiLattice (..), joinLeq, + (<\), MeetSemiLattice (..), meetLeq, + ( a -> a -> Bool joinLeq x y = (x \/ y) == y +infixr 6 <\ + +-- | The partial ordering induced by the join-semilattice structure +(<\) :: (JoinSemiLattice a) => a -> a -> Bool +(<\) = joinLeq + -- | A algebraic structure with element meets: See [Semilattice](http://en.wikipedia.org/wiki/Semilattice) -- -- > Associativity: x /\ (y /\ z) == (x /\ y) /\ z @@ -58,6 +66,12 @@ -- | The partial ordering induced by the meet-semilattice structure meetLeq :: (MeetSemiLattice a) => a -> a -> Bool meetLeq x y = (x /\ y) == x + +infixr 6 a -> a -> Bool +( abs a * sign a == a +-- prop> \a -> abs a * sign a ~= a -- -- abs zero == zero, so any value for sign zero is ok. We choose lawful neutral: -- --- > sign zero == zero +-- >>> sign zero == zero +-- True +-- +-- >>> abs (-1) +-- 1 +-- +-- >>> sign (-1) +-- -1 class (Additive a, Multiplicative a) => Signed a @@ -151,10 +156,16 @@ -- | Norm is a slight generalisation of Signed. The class has the same shape but allows the codomain to be different to the domain. -- --- > norm a >= zero --- > norm zero == zero --- > a == norm a .* basis a --- > norm (basis a) == one +-- > \a -> norm a >= zero +-- > \a -> norm zero == zero +-- > \a -> a == norm a .* basis a +-- > \a -> norm (basis a) == one +-- +-- >>> norm (-0.5 :: Double) :: Double +-- 0.5 +-- +-- >>> basis (-0.5 :: Double) :: Double +-- -1.0 class (Additive a, Multiplicative b, Additive b) => Norm a b | a -> b where -- | or length, or ||v|| norm :: a -> b @@ -250,22 +261,27 @@ -- | A small number, especially useful for approximate equality. class - (Eq a, Additive a, Subtractive a, MeetSemiLattice a) => + (Eq a, Additive a) => Epsilon a where epsilon :: a epsilon = zero --- | are we near zero? --- --- >>> nearZero (epsilon :: Double) --- True -nearZero :: (Epsilon a) => a -> Bool -nearZero a = epsilon `meetLeq` a && epsilon `meetLeq` negate a + -- | are we near enough? + -- + -- >>> nearZero (epsilon :: Double) + -- True + nearZero :: a -> Bool + default nearZero :: (Ord a, Subtractive a) => a -> Bool + nearZero a = epsilon >= a && epsilon >= negate a --- | Approximate equality -aboutEqual :: (Epsilon a) => a -> a -> Bool -aboutEqual a b = nearZero $ a - b + -- | Approximate equality + -- + -- >>> aboutEqual zero (epsilon :: Double) + -- True + aboutEqual :: a -> a -> Bool + default aboutEqual :: (Subtractive a) => a -> a -> Bool + aboutEqual a b = nearZero $ a - b infixl 4 ~= diff --git a/src/NumHask/Algebra/Multiplicative.hs b/src/NumHask/Algebra/Multiplicative.hs --- a/src/NumHask/Algebra/Multiplicative.hs +++ b/src/NumHask/Algebra/Multiplicative.hs @@ -5,12 +5,13 @@ module NumHask.Algebra.Multiplicative ( Multiplicative (..), product, + accproduct, Divisive (..), - (/), ) where import Data.Int (Int16, Int32, Int64, Int8) +import Data.Traversable (mapAccumL) import Data.Word (Word, Word16, Word32, Word64, Word8) import GHC.Natural (Natural (..)) import Prelude (Double, Float, Int, Integer, fromInteger, fromRational) @@ -19,8 +20,6 @@ -- $setup -- -- >>> :set -XRebindableSyntax --- >>> :set -XFlexibleContexts --- >>> :set -XScopedTypeVariables -- >>> import NumHask.Prelude -- | or [Multiplication](https://en.wikipedia.org/wiki/Multiplication) @@ -28,9 +27,9 @@ -- For practical reasons, we begin the class tree with 'NumHask.Algebra.Additive.Additive' and 'Multiplicative'. Starting with 'NumHask.Algebra.Group.Associative' and 'NumHask.Algebra.Group.Unital', or using 'Data.Semigroup.Semigroup' and 'Data.Monoid.Monoid' from base tends to confuse the interface once you start having to disinguish between (say) monoidal addition and monoidal multiplication. -- -- --- > \a -> one * a == a --- > \a -> a * one == a --- > \a b c -> (a * b) * c == a * (b * c) +-- prop> \a -> one * a == a +-- prop> \a -> a * one == a +-- prop> \a b c -> (a * b) * c == a * (b * c) -- -- By convention, (*) is regarded as not necessarily commutative, but this is not universal, and the introduction of another symbol which means commutative multiplication seems a bit dogmatic. -- @@ -46,31 +45,41 @@ one :: a -- | Compute the product of a 'Data.Foldable.Foldable'. +-- +-- >>> product [1..5] +-- 120 product :: (Multiplicative a, P.Foldable f) => f a -> a product = P.foldr (*) one +-- | Compute the accumulating product of a 'Data.Traversable.Traversable'. +-- +-- >>> accproduct [1..5] +-- [1,2,6,24,120] +accproduct :: (Multiplicative a, P.Traversable f) => f a -> f a +accproduct = P.snd P.. mapAccumL (\a b -> (a * b, a * b)) one + -- | or [Division](https://en.wikipedia.org/wiki/Division_(mathematics\)) -- -- Though unusual, the term Divisive usefully fits in with the grammer of other classes and avoids name clashes that occur with some popular libraries. -- --- > \(a :: Double) -> a / a ~= one || a == zero --- > \(a :: Double) -> recip a ~= one / a || a == zero --- > \(a :: Double) -> recip a * a ~= one || a == zero --- > \(a :: Double) -> a * recip a ~= one || a == zero +-- prop> \(a :: Double) -> a / a ~= one || a == zero +-- prop> \(a :: Double) -> recip a ~= one / a || a == zero +-- prop> \(a :: Double) -> recip a * a ~= one || a == zero +-- prop> \(a :: Double) -> a * recip a ~= one || a == zero -- -- >>> recip 2.0 -- 0.5 +-- +-- >>> 1 / 2 +-- 0.5 class (Multiplicative a) => Divisive a where recip :: a -> a + recip a = one / a -infixl 7 / + infixl 7 / --- | divide --- --- >>> 1 / 2 --- 0.5 -(/) :: (Divisive a) => a -> a -> a -(/) a b = a * recip b + (/) :: a -> a -> a + (/) a b = a * recip b instance Multiplicative Double where (*) = (P.*) diff --git a/src/NumHask/Algebra/Ring.hs b/src/NumHask/Algebra/Ring.hs --- a/src/NumHask/Algebra/Ring.hs +++ b/src/NumHask/Algebra/Ring.hs @@ -24,16 +24,14 @@ -- $setup -- -- >>> :set -XRebindableSyntax --- >>> :set -XFlexibleContexts --- >>> :set -XScopedTypeVariables -- >>> import NumHask.Prelude -- | -- --- > \a b c -> a * (b + c) == a * b + a * c --- > \a b c -> (a + b) * c == a * c + b * c --- > \a -> zero * a == zero --- > \a -> a * zero == zero +-- prop> \a b c -> a * (b + c) == a * b + a * c +-- prop> \a b c -> (a + b) * c == a * c + b * c +-- prop> \a -> zero * a == zero +-- prop> \a -> a * zero == zero -- -- The sneaking in of the laws here glosses over the possibility that the multiplicative zero element does not have to correspond with the additive unital zero. class @@ -99,7 +97,7 @@ -- | A is a semiring with an additional unary operator (star) satisfying: -- --- > \a -> star a = one + a * star a +-- > \a -> star a == one + a * star a class (Distributive a) => StarSemiring a where star :: a -> a star a = one + plus a diff --git a/src/NumHask/Data/Complex.hs b/src/NumHask/Data/Complex.hs --- a/src/NumHask/Data/Complex.hs +++ b/src/NumHask/Data/Complex.hs @@ -117,10 +117,12 @@ ray x = cos x :+ sin x instance - (Ord a, Signed a, Subtractive a, Epsilon a) => + (Ord a, Signed a, Epsilon a, Subtractive a) => Epsilon (Complex a) where epsilon = epsilon :+ epsilon + + nearZero (ar :+ ai) = ar <= epsilon && ai <= epsilon instance (Field a) => Field (Complex a) diff --git a/src/NumHask/Data/Integral.hs b/src/NumHask/Data/Integral.hs --- a/src/NumHask/Data/Integral.hs +++ b/src/NumHask/Data/Integral.hs @@ -30,9 +30,23 @@ import Prelude (Double, Float, Int, Integer, fst, snd, (.)) import qualified Prelude as P +-- $setup +-- +-- >>> :set -XRebindableSyntax +-- >>> import NumHask.Prelude + -- | An Integral is anything that satisfies the law: -- --- > b == zero || b * (a `div` b) + (a `mod` b) == a +-- prop> \a b -> b == zero || b * (a `div` b) + (a `mod` b) == a +-- +-- >>> 3 `divMod` 2 +-- (1,1) +-- +-- >>> (-3) `divMod` 2 +-- (-2,1) +-- +-- >>> (-3) `quotRem` 2 +-- (-1,-1) class (Distributive a) => Integral a @@ -414,6 +428,12 @@ infixr 8 ^^ -- | raise a number to an 'Integral' power +-- +-- >>> 2 ^^ 3 +-- 8.0 +-- +-- >>> 2 ^^ (-2) +-- 0.25 (^^) :: (P.Ord b, Divisive a, Subtractive b, Integral b) => a -> @@ -439,6 +459,12 @@ -- | raise a number to an 'Int' power -- -- Note: This differs from (^) found in prelude which is a partial function (it errors on negative integrals). This monomorphic version is provided to help reduce ambiguous type noise in common usages of this sign. +-- +-- >>> 2 ^ 3 +-- 8.0 +-- +-- >>> 2 ^ (-2) +-- 0.25 (^) :: (Divisive a) => a -> Int -> a (^) x n = x ^^ n diff --git a/src/NumHask/Data/Rational.hs b/src/NumHask/Data/Rational.hs --- a/src/NumHask/Data/Rational.hs +++ b/src/NumHask/Data/Rational.hs @@ -33,7 +33,7 @@ import NumHask.Algebra.Multiplicative import NumHask.Algebra.Ring import NumHask.Data.Integral -import Prelude (Int, Integer, Ord (..), Ordering (..), Rational, (.)) +import Prelude (Eq (..), Int, Integer, Ord (..), Ordering (..), Rational, (.)) import qualified Prelude as P -- $setup @@ -44,13 +44,14 @@ -- | A rational number data Ratio a = !a :% !a deriving (P.Show) -instance (P.Eq a, Additive a) => P.Eq (Ratio a) where - a == b +instance (P.Eq a, Subtractive a, Signed a, Integral a) => P.Eq (Ratio a) where + a@(xa :% ya) == b@(xb :% yb) | isRNaN a P.|| isRNaN b = P.False - | P.otherwise = (x P.== x') P.&& (y P.== y') - where - (x :% y) = a - (x' :% y') = b + | xa == zero P.&& xb == zero = P.True + | xa == zero P.|| xb == zero = P.False + | P.otherwise = + let (xa' :% ya', xb' :% yb') = (reduce xa ya, reduce xb yb) + in (xa' P.== xb') P.&& (ya' P.== yb') -- | Has a zero denominator isRNaN :: (P.Eq a, Additive a) => Ratio a -> P.Bool @@ -58,7 +59,7 @@ | x P.== zero P.&& y P.== zero = P.True | P.otherwise = P.False -instance (P.Ord a, Multiplicative a, Additive a) => P.Ord (Ratio a) where +instance (P.Ord a, Integral a, Signed a, Multiplicative a, Subtractive a) => P.Ord (Ratio a) where (x :% y) <= (x' :% y') = x * y' P.<= x' * y (x :% y) < (x' :% y') = x * y' P.< x' * y @@ -91,7 +92,7 @@ instance (P.Ord a, Signed a, Integral a, Ring a) => Field (Ratio a) -instance (P.Ord a, Signed a, Integral a, Ring a, Signed b, FromIntegral b a) => QuotientField (Ratio a) b where +instance (P.Ord a, P.Ord b, Signed a, Integral a, Ring a, Signed b, Subtractive b, Integral b, FromIntegral b a) => QuotientField (Ratio a) b where properFraction (n :% d) = let (w, r) = quotRem n d in (fromIntegral w, r :% d) instance (P.Ord a, Signed a, Integral a, Ring a) => Signed (Ratio a) where @@ -106,10 +107,10 @@ norm = abs basis = sign -instance (P.Ord a, Signed a) => JoinSemiLattice (Ratio a) where +instance (P.Ord a, Integral a, Signed a, Multiplicative a, Subtractive a) => JoinSemiLattice (Ratio a) where (\/) = P.min -instance (P.Ord a, Signed a) => MeetSemiLattice (Ratio a) where +instance (P.Ord a, Integral a, Signed a, Multiplicative a, Subtractive a) => MeetSemiLattice (Ratio a) where (/\) = P.max instance (P.Ord a, Signed a, Integral a, Ring a, MeetSemiLattice a) => Epsilon (Ratio a) @@ -119,7 +120,7 @@ -- | toRatio is equivalent to `GHC.Real.Real` in base, but is polymorphic in the Integral type. -- --- > toRatio (3.1415927 :: Float) :: Ratio Integer +-- >>> toRatio (3.1415927 :: Float) :: Ratio Integer -- 13176795 :% 4194304 class ToRatio a b where toRatio :: a -> Ratio b @@ -216,6 +217,11 @@ -- | 'reduce' normalises a ratio by dividing both numerator and denominator by -- their greatest common divisor. +-- +-- >>> reduce 72 60 +-- 6 :% 5 +-- +-- prop> \a b -> reduce a b == a :% b || b == zero reduce :: (P.Eq a, Subtractive a, Signed a, Integral a) => a -> a -> Ratio a reduce x y @@ -237,6 +243,9 @@ -- Note: Since for signed fixed-width integer types, @'abs' 'GHC.Enum.minBound' < 0@, -- the result may be negative if one of the arguments is @'GHC.Enum.minBound'@ (and -- necessarily is if the other is @0@ or @'GHC.Enum.minBound'@) for such types. +-- +-- >>> gcd 72 60 +-- 12 gcd :: (P.Eq a, Signed a, Integral a) => a -> a -> a gcd x y = gcd' (abs x) (abs y) where diff --git a/test/doctests.hs b/test/doctests.hs new file mode 100644 --- /dev/null +++ b/test/doctests.hs @@ -0,0 +1,8 @@ +module Main where + +main :: IO () +main = do + putStrLn "This test-suite exists only to add dependencies" + putStrLn "To run doctests: " + putStrLn " cabal build all --enable-tests" + putStrLn " cabal-docspec"