intervals-0.9.2/0000755000000000000000000000000007346545000011722 5ustar0000000000000000intervals-0.9.2/.hlint.yaml0000644000000000000000000000043307346545000014002 0ustar0000000000000000- arguments: [--cpp-define=HLINT, --cpp-ansi] # not viable - ignore: {name: Reduce duplication} # don't want to! - ignore: {name: Use infix} # these don't consider the corner cases when using doubles - ignore: {name: "Use >"} - ignore: {name: "Use <="} - ignore: {name: "Use >="} intervals-0.9.2/CHANGELOG.markdown0000644000000000000000000000444107346545000014760 0ustar00000000000000000.9.2 [2021.02.17] ------------------ * Export `(/=!)` and `(/=?)` operators. * The build-type has been changed from `Custom` to `Simple`. To achieve this, the `doctests` test suite has been removed in favor of using [`cabal-docspec`](https://github.com/phadej/cabal-extras/tree/master/cabal-docspec) to run the doctests. 0.9.1 [2020.01.29] ------------------ * Add `Semigroup` instances for the `Interval` types in `Numeric.Interval`, `Numeric.Interval.Kaucher`, and `Numeric.Interval.NonEmpty`. Add a `Monoid` instance for the `Interval` type in `Numeric.Interval`. 0.9 [2019.05.10] ---------------- * Remove the `Foldable` instances for the `Interval` types from `Numeric.Interval` and `Numeric.Interval.NonEmpty`. 0.8.1 ----- * Support `doctest-0.12` 0.8 --- * `Eq` and `Ord` instances are now structural * Deprecate `elem` and `notElem` in favor of `member` and `nonMember` * Add `iquot`, `irem`, `idiv`, and `imod` functions * Relax `Fractional` constraint in `deflate` to `Num` * Revamp `Setup.hs` to use `cabal-doctest`. This makes it build with `Cabal-2.0`, and makes the `doctest`s work with `cabal new-build` and sandboxes. 0.7.2 ----- * Redundant constraint cleanup * GHC 8 support * Added a flag for building with 'herbie' 0.7.1.1 ------- * Redundant import cleanup 0.7.1 ----- * Now compatible with GHC 7.10.1-rc1 * Fixed a number of broken `#if` pragmas, fixing previously missing instances. 0.7.0.1 ------- * Removed a couple of unnecessary `Fractional` constraints. 0.7 --- * Corrected the definition of `mignitude`. * Added a notion of `distance` between intervals 0.6 --- * Added `Numeric.Interval.Exception`. For consistency, we tend to throw exceptions now instead of rely on `NaN` when working with empty intervals. 0.5.1.1 ------- * Misc `doctest` fixes. 0.5.1 ----- * Added `interval` to facilitate the construction of known non-empty intervals. 0.5 --- * The default `Numeric.Interval` now deals more conventionally with empty intervals. * The old "Kaucher directed interval" behavior is available as `Numeric.Interval.Kaucher`. * Strictly Non-Empty intervals are now contained in `Numeric.Interval.NonEmpty` * Renamed `bisection` to `bisect`. * Added `bisectIntegral`. 0.4.2 ----- * Added `clamp` 0.4 --- * Distributive Interval 0.3 --- * Removed dependency on `numeric-extras` intervals-0.9.2/LICENSE0000644000000000000000000000245607346545000012736 0ustar0000000000000000Copyright (c) 2010-2013, Edward Kmett All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. intervals-0.9.2/README.markdown0000644000000000000000000000100307346545000014415 0ustar0000000000000000intervals ========== [![Hackage](https://img.shields.io/hackage/v/intervals.svg)](https://hackage.haskell.org/package/intervals) [![Build Status](https://github.com/ekmett/intervals/workflows/Haskell-CI/badge.svg)](https://github.com/ekmett/intervals/actions?query=workflow%3AHaskell-CI) Basic interval arithmetic Contact Information ------------------- Contributions and bug reports are welcome! Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net. -Edward Kmett intervals-0.9.2/Setup.lhs0000644000000000000000000000016507346545000013534 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain intervals-0.9.2/intervals.cabal0000644000000000000000000000446007346545000014721 0ustar0000000000000000name: intervals version: 0.9.2 synopsis: Interval Arithmetic description: A 'Numeric.Interval.Interval' is a closed, convex set of floating point values. . We do not control the rounding mode of the end points of the interval when using floating point arithmetic, so be aware that in order to get precise containment of the result, you will need to use an underlying type with both lower and upper bounds like 'CReal' homepage: http://github.com/ekmett/intervals bug-reports: http://github.com/ekmett/intervals/issues license: BSD3 license-file: LICENSE author: Edward Kmett maintainer: ekmett@gmail.com category: Math build-type: Simple cabal-version: >=1.10 tested-with: GHC == 7.0.4 , GHC == 7.2.2 , GHC == 7.4.2 , GHC == 7.6.3 , GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.3 , GHC == 8.10.1 extra-source-files: .hlint.yaml CHANGELOG.markdown README.markdown source-repository head type: git location: git://github.com/ekmett/intervals.git flag herbie default: False manual: True library hs-source-dirs: src exposed-modules: Numeric.Interval Numeric.Interval.Exception Numeric.Interval.Internal Numeric.Interval.Kaucher Numeric.Interval.NonEmpty Numeric.Interval.NonEmpty.Internal build-depends: array >= 0.3 && < 0.6, base >= 4 && < 5, distributive >= 0.2 && < 1 if impl(ghc >=7.4) build-depends: ghc-prim if !impl(ghc >=8.0) build-depends: semigroups >=0.11 && <1 ghc-options: -Wall -O2 if flag(herbie) build-depends: HerbiePlugin >= 0.1 && < 0.2 cpp-options: -DHERBIE ghc-options: -fplugin=Herbie default-language: Haskell2010 x-docspec-options: --check-properties x-docspec-property-variables: i x y xs ys test-suite doctests type: exitcode-stdio-1.0 main-is: doctests.hs ghc-options: -Wall -threaded hs-source-dirs: tests build-depends: base, QuickCheck >=2.14.2 default-language: Haskell2010 intervals-0.9.2/src/Numeric/0000755000000000000000000000000007346545000014113 5ustar0000000000000000intervals-0.9.2/src/Numeric/Interval.hs0000644000000000000000000000175007346545000016236 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Numeric.Interval -- Copyright : (c) Edward Kmett 2010-2014 -- License : BSD3 -- Maintainer : ekmett@gmail.com -- Stability : experimental -- Portability : DeriveDataTypeable -- -- Interval arithmetic ----------------------------------------------------------------------------- module Numeric.Interval ( Interval , (...) , (+/-) , interval , whole , empty , null , singleton , member , notMember , elem , notElem , inf , sup , singular , width , midpoint , intersection , hull , bisect , bisectIntegral , magnitude , mignitude , distance , inflate, deflate , scale, symmetric , contains , isSubsetOf , certainly, (=!), (>!) , possibly, (=?), (>?) , idouble , ifloat , iquot , irem , idiv , imod ) where import Numeric.Interval.Internal import Prelude () intervals-0.9.2/src/Numeric/Interval/0000755000000000000000000000000007346545000015677 5ustar0000000000000000intervals-0.9.2/src/Numeric/Interval/Exception.hs0000644000000000000000000000106707346545000020175 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Numeric.Interval.Exception ( EmptyInterval(..) , AmbiguousComparison(..) ) where import Control.Exception import Data.Data data EmptyInterval = EmptyInterval deriving (Eq,Ord,Typeable,Data) instance Show EmptyInterval where show EmptyInterval = "empty interval" instance Exception EmptyInterval data AmbiguousComparison = AmbiguousComparison deriving (Eq,Ord,Typeable,Data) instance Show AmbiguousComparison where show AmbiguousComparison = "ambiguous comparison" instance Exception AmbiguousComparison intervals-0.9.2/src/Numeric/Interval/Internal.hs0000644000000000000000000006042207346545000020013 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE DeriveDataTypeable #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE DeriveGeneric #-} #endif {-# OPTIONS_HADDOCK not-home #-} ----------------------------------------------------------------------------- -- | -- Module : Numeric.Interval.Internal -- Copyright : (c) Edward Kmett 2010-2013 -- License : BSD3 -- Maintainer : ekmett@gmail.com -- Stability : experimental -- Portability : DeriveDataTypeable -- -- Interval arithmetic -- ----------------------------------------------------------------------------- module Numeric.Interval.Internal ( Interval(..) , (...) , (+/-) , interval , whole , empty , null , singleton , member , notMember , elem , notElem , inf , sup , singular , width , midpoint , intersection , hull , bisect , bisectIntegral , magnitude , mignitude , distance , inflate, deflate , scale, symmetric , contains , isSubsetOf , certainly, (=!), (>!) , possibly, (=?), (>?) , idouble , ifloat , iquot , irem , idiv , imod ) where import Control.Exception as Exception import Data.Data import Data.Function (on) #if __GLASGOW_HASKELL__ >= 704 import GHC.Generics #endif import Numeric.Interval.Exception import Prelude hiding (null, elem, notElem) import qualified Data.Semigroup import qualified Data.Monoid -- $setup -- -- Eta expansion needed for GHC-7.6 -- >>> :set -fno-warn-deprecations -- >>> let null xs = Numeric.Interval.Internal.null xs -- >>> let elem x xs = Numeric.Interval.Internal.elem x xs -- >>> let notElem x xs = Numeric.Interval.Internal.notElem x xs data Interval a = I !a !a | Empty deriving ( Eq, Ord , Data , Typeable #if __GLASGOW_HASKELL__ >= 704 , Generic #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif #endif ) -- | 'Data.Semigroup.<>' is 'hull' instance Ord a => Data.Semigroup.Semigroup (Interval a) where (<>) = hull instance Ord a => Data.Monoid.Monoid (Interval a) where mempty = empty mappend = (Data.Semigroup.<>) infix 3 ... infixl 6 +/- (+/-) :: (Num a, Ord a) => a -> a -> Interval a a +/- b = a - b ... a + b negInfinity :: Fractional a => a negInfinity = (-1)/0 {-# INLINE negInfinity #-} posInfinity :: Fractional a => a posInfinity = 1/0 {-# INLINE posInfinity #-} interval :: Ord a => a -> a -> Maybe (Interval a) interval a b | a <= b = Just $ I a b | otherwise = Nothing {-# INLINE interval #-} fmod :: RealFrac a => a -> a -> a fmod a b = a - q*b where q = realToFrac (truncate $ a / b :: Integer) {-# INLINE fmod #-} (...) :: Ord a => a -> a -> Interval a a ... b | a <= b = I a b | otherwise = Empty {-# INLINE (...) #-} -- | The whole real number line -- -- >>> whole -- -Infinity ... Infinity whole :: Fractional a => Interval a whole = I negInfinity posInfinity {-# INLINE whole #-} -- | An empty interval -- -- >>> empty -- Empty empty :: Interval a empty = Empty {-# INLINE empty #-} -- | Check if an interval is empty -- -- >>> null (1 ... 5) -- False -- -- >>> null (1 ... 1) -- False -- -- >>> null empty -- True null :: Interval a -> Bool null Empty = True null _ = False {-# INLINE null #-} -- | A singleton point -- -- >>> singleton 1 -- 1 ... 1 singleton :: a -> Interval a singleton a = I a a {-# INLINE singleton #-} -- | The infimum (lower bound) of an interval -- -- >>> inf (1.0 ... 20.0) -- 1.0 -- -- >>> inf empty -- *** Exception: empty interval inf :: Interval a -> a inf (I a _) = a inf Empty = Exception.throw EmptyInterval {-# INLINE inf #-} -- | The supremum (upper bound) of an interval -- -- >>> sup (1.0 ... 20.0) -- 20.0 -- -- >>> sup empty -- *** Exception: empty interval sup :: Interval a -> a sup (I _ b) = b sup Empty = Exception.throw EmptyInterval {-# INLINE sup #-} -- | Is the interval a singleton point? -- N.B. This is fairly fragile and likely will not hold after -- even a few operations that only involve singletons -- -- >>> singular (singleton 1) -- True -- -- >>> singular (1.0 ... 20.0) -- False singular :: Ord a => Interval a -> Bool singular Empty = False singular (I a b) = a == b {-# INLINE singular #-} instance Show a => Show (Interval a) where showsPrec _ Empty = showString "Empty" showsPrec n (I a b) = showParen (n > 3) $ showsPrec 3 a . showString " ... " . showsPrec 3 b -- | Calculate the width of an interval. -- -- >>> width (1 ... 20) -- 19 -- -- >>> width (singleton 1) -- 0 -- -- >>> width empty -- 0 width :: Num a => Interval a -> a width (I a b) = b - a width Empty = 0 {-# INLINE width #-} -- | Magnitude -- -- >>> magnitude (1 ... 20) -- 20 -- -- >>> magnitude (-20 ... 10) -- 20 -- -- >>> magnitude (singleton 5) -- 5 -- -- throws 'EmptyInterval' if the interval is empty. -- -- >>> magnitude empty -- *** Exception: empty interval magnitude :: (Num a, Ord a) => Interval a -> a magnitude = sup . abs {-# INLINE magnitude #-} -- | \"mignitude\" -- -- >>> mignitude (1 ... 20) -- 1 -- -- >>> mignitude (-20 ... 10) -- 0 -- -- >>> mignitude (singleton 5) -- 5 -- -- throws 'EmptyInterval' if the interval is empty. -- -- >>> mignitude empty -- *** Exception: empty interval mignitude :: (Num a, Ord a) => Interval a -> a mignitude = inf . abs {-# INLINE mignitude #-} -- | Hausdorff distance between intervals. -- -- >>> distance (1 ... 7) (6 ... 10) -- 0 -- -- >>> distance (1 ... 7) (15 ... 24) -- 8 -- -- >>> distance (1 ... 7) (-10 ... -2) -- 3 -- -- >>> distance Empty (1 ... 1) -- *** Exception: empty interval distance :: (Num a, Ord a) => Interval a -> Interval a -> a distance i1 i2 = mignitude (i1 - i2) -- | Inflate an interval by enlarging it at both ends. -- -- >>> inflate 3 (-1 ... 7) -- -4 ... 10 -- -- >>> inflate (-2) (0 ... 4) -- -2 ... 6 -- -- >>> inflate 1 empty -- Empty inflate :: (Num a, Ord a) => a -> Interval a -> Interval a inflate x y = symmetric x + y -- | Deflate an interval by shrinking it from both ends. -- -- >>> deflate 3.0 (-4.0 ... 10.0) -- -1.0 ... 7.0 -- -- >>> deflate 2.0 (-1.0 ... 1.0) -- Empty -- -- >>> deflate 1.0 empty -- Empty deflate :: (Num a, Ord a) => a -> Interval a -> Interval a deflate _ Empty = Empty deflate x (I a b) | a' <= b' = I a' b' | otherwise = Empty where a' = a + x b' = b - x -- | Scale an interval about its midpoint. -- -- >>> scale 1.1 (-6.0 ... 4.0) -- -6.5 ... 4.5 -- -- >>> scale (-2.0) (-1.0 ... 1.0) -- Empty -- -- >>> scale 3.0 empty -- Empty scale :: (Fractional a, Ord a) => a -> Interval a -> Interval a scale _ Empty = Empty scale x i = a ... b where h = x * width i / 2 mid = midpoint i a = mid - h b = mid + h -- | Construct a symmetric interval. -- -- >>> symmetric 3 -- -3 ... 3 -- -- >>> symmetric (-2) -- -2 ... 2 symmetric :: (Num a, Ord a) => a -> Interval a symmetric x | a <= b = I a b | otherwise = I b a where a = negate x b = x instance (Num a, Ord a) => Num (Interval a) where I a b + I a' b' = (a + a') ... (b + b') _ + _ = Empty {-# INLINE (+) #-} I a b - I a' b' = (a - b') ... (b - a') _ - _ = Empty {-# INLINE (-) #-} I a b * I a' b' = minimum [a * a', a * b', b * a', b * b'] ... maximum [a * a', a * b', b * a', b * b'] _ * _ = Empty {-# INLINE (*) #-} abs x@(I a b) | a >= 0 = x | b <= 0 = negate x | otherwise = 0 ... max (- a) b abs Empty = Empty {-# INLINE abs #-} signum = increasing signum {-# INLINE signum #-} fromInteger i = singleton (fromInteger i) {-# INLINE fromInteger #-} -- | Bisect an interval at its midpoint. -- -- >>> bisect (10.0 ... 20.0) -- (10.0 ... 15.0,15.0 ... 20.0) -- -- >>> bisect (singleton 5.0) -- (5.0 ... 5.0,5.0 ... 5.0) -- -- >>> bisect Empty -- (Empty,Empty) bisect :: Fractional a => Interval a -> (Interval a, Interval a) bisect Empty = (Empty,Empty) bisect (I a b) = (I a m, I m b) where m = a + (b - a) / 2 {-# INLINE bisect #-} bisectIntegral :: Integral a => Interval a -> (Interval a, Interval a) bisectIntegral Empty = (Empty, Empty) bisectIntegral (I a b) | a == m || b == m = (I a a, I b b) | otherwise = (I a m, I m b) where m = a + (b - a) `div` 2 -- | Nearest point to the midpoint of the interval. -- -- >>> midpoint (10.0 ... 20.0) -- 15.0 -- -- >>> midpoint (singleton 5.0) -- 5.0 -- -- >>> midpoint empty -- *** Exception: empty interval midpoint :: Fractional a => Interval a -> a midpoint (I a b) = a + (b - a) / 2 midpoint Empty = Exception.throw EmptyInterval {-# INLINE midpoint #-} -- | Determine if a point is in the interval. -- -- >>> member 3.2 (1.0 ... 5.0) -- True -- -- >>> member 5 (1.0 ... 5.0) -- True -- -- >>> member 1 (1.0 ... 5.0) -- True -- -- >>> member 8 (1.0 ... 5.0) -- False -- -- >>> member 5 empty -- False -- member :: Ord a => a -> Interval a -> Bool member x (I a b) = x >= a && x <= b member _ Empty = False {-# INLINE member #-} -- | Determine if a point is not included in the interval -- -- >>> notMember 8 (1.0 ... 5.0) -- True -- -- >>> notMember 1.4 (1.0 ... 5.0) -- False -- -- And of course, nothing is a member of the empty interval. -- -- >>> notMember 5 empty -- True notMember :: Ord a => a -> Interval a -> Bool notMember x xs = not (member x xs) {-# INLINE notMember #-} -- | Determine if a point is in the interval. -- -- >>> elem 3.2 (1.0 ... 5.0) -- True -- -- >>> elem 5 (1.0 ... 5.0) -- True -- -- >>> elem 1 (1.0 ... 5.0) -- True -- -- >>> elem 8 (1.0 ... 5.0) -- False -- -- >>> elem 5 empty -- False -- elem :: Ord a => a -> Interval a -> Bool elem = member {-# INLINE elem #-} {-# DEPRECATED elem "Use `member` instead." #-} -- | Determine if a point is not included in the interval -- -- >>> notElem 8 (1.0 ... 5.0) -- True -- -- >>> notElem 1.4 (1.0 ... 5.0) -- False -- -- And of course, nothing is a member of the empty interval. -- -- >>> notElem 5 empty -- True notElem :: Ord a => a -> Interval a -> Bool notElem = notMember {-# INLINE notElem #-} {-# DEPRECATED notElem "Use `notMember` instead." #-} -- | 'realToFrac' will use the midpoint instance Real a => Real (Interval a) where toRational Empty = Exception.throw EmptyInterval toRational (I ra rb) = a + (b - a) / 2 where a = toRational ra b = toRational rb {-# INLINE toRational #-} -- @'divNonZero' X Y@ assumes @0 `'notElem'` Y@ divNonZero :: (Fractional a, Ord a) => Interval a -> Interval a -> Interval a divNonZero (I a b) (I a' b') = minimum [a / a', a / b', b / a', b / b'] ... maximum [a / a', a / b', b / a', b / b'] divNonZero _ _ = Empty -- @'divPositive' X y@ assumes y > 0, and divides @X@ by [0 ... y] divPositive :: (Fractional a, Ord a) => Interval a -> a -> Interval a divPositive Empty _ = Empty divPositive x@(I a b) y | a == 0 && b == 0 = x -- b < 0 || isNegativeZero b = negInfinity ... ( b / y) | b < 0 = negInfinity ... (b / y) | a < 0 = whole | otherwise = (a / y) ... posInfinity {-# INLINE divPositive #-} -- divNegative assumes y < 0 and divides the interval @X@ by [y ... 0] divNegative :: (Fractional a, Ord a) => Interval a -> a -> Interval a divNegative Empty _ = Empty divNegative x@(I a b) y | a == 0 && b == 0 = - x -- flip negative zeros -- b < 0 || isNegativeZero b = (b / y) ... posInfinity | b < 0 = (b / y) ... posInfinity | a < 0 = whole | otherwise = negInfinity ... (a / y) {-# INLINE divNegative #-} divZero :: (Fractional a, Ord a) => Interval a -> Interval a divZero x@(I a b) | a == 0 && b == 0 = x | otherwise = whole divZero Empty = Empty {-# INLINE divZero #-} instance (Fractional a, Ord a) => Fractional (Interval a) where -- TODO: check isNegativeZero properly _ / Empty = Empty x / y@(I a b) | 0 `notElem` y = divNonZero x y | iz && sz = Exception.throw DivideByZero | iz = divPositive x a | sz = divNegative x b | otherwise = divZero x where iz = a == 0 sz = b == 0 recip Empty = Empty recip (I a b) = on min recip a b ... on max recip a b {-# INLINE recip #-} fromRational r = let r' = fromRational r in I r' r' {-# INLINE fromRational #-} instance RealFrac a => RealFrac (Interval a) where properFraction x = (b, x - fromIntegral b) where b = truncate (midpoint x) {-# INLINE properFraction #-} ceiling x = ceiling (sup x) {-# INLINE ceiling #-} floor x = floor (inf x) {-# INLINE floor #-} round x = round (midpoint x) {-# INLINE round #-} truncate x = truncate (midpoint x) {-# INLINE truncate #-} instance (RealFloat a, Ord a) => Floating (Interval a) where pi = singleton pi {-# INLINE pi #-} exp = increasing exp {-# INLINE exp #-} log (I a b) = (if a > 0 then log a else negInfinity) ... log b log Empty = Empty {-# INLINE log #-} cos Empty = Empty cos x | width t >= pi = (-1) ... 1 | inf t >= pi = - cos (t - pi) | sup t <= pi = decreasing cos t | sup t <= 2 * pi = (-1) ... cos ((pi * 2 - sup t) `min` inf t) | otherwise = (-1) ... 1 where t = fmod x (pi * 2) {-# INLINE cos #-} sin Empty = Empty sin x = cos (x - pi / 2) {-# INLINE sin #-} tan Empty = Empty tan x | inf t' <= - pi / 2 || sup t' >= pi / 2 = whole | otherwise = increasing tan x where t = x `fmod` pi t' | t >= pi / 2 = t - pi | otherwise = t {-# INLINE tan #-} asin Empty = Empty asin (I a b) | b < -1 || a > 1 = Empty | otherwise = (if a <= -1 then -halfPi else asin a) ... (if b >= 1 then halfPi else asin b) where halfPi = pi / 2 {-# INLINE asin #-} acos Empty = Empty acos (I a b) | b < -1 || a > 1 = Empty | otherwise = (if b >= 1 then 0 else acos b) ... (if a < -1 then pi else acos a) {-# INLINE acos #-} atan = increasing atan {-# INLINE atan #-} sinh = increasing sinh {-# INLINE sinh #-} cosh Empty = Empty cosh x@(I a b) | b < 0 = decreasing cosh x | a >= 0 = increasing cosh x | otherwise = I 0 $ cosh $ if - a > b then a else b {-# INLINE cosh #-} tanh = increasing tanh {-# INLINE tanh #-} asinh = increasing asinh {-# INLINE asinh #-} acosh Empty = Empty acosh (I a b) | b < 1 = Empty | otherwise = I lo $ acosh b where lo | a <= 1 = 0 | otherwise = acosh a {-# INLINE acosh #-} atanh Empty = Empty atanh (I a b) | b < -1 || a > 1 = Empty | otherwise = (if a <= - 1 then negInfinity else atanh a) ... (if b >= 1 then posInfinity else atanh b) {-# INLINE atanh #-} -- | lift a monotone increasing function over a given interval increasing :: (a -> b) -> Interval a -> Interval b increasing f (I a b) = I (f a) (f b) increasing _ Empty = Empty -- | lift a monotone decreasing function over a given interval decreasing :: (a -> b) -> Interval a -> Interval b decreasing f (I a b) = I (f b) (f a) decreasing _ Empty = Empty -- | We have to play some semantic games to make these methods make sense. -- Most compute with the midpoint of the interval. instance RealFloat a => RealFloat (Interval a) where floatRadix = floatRadix . midpoint floatDigits = floatDigits . midpoint floatRange = floatRange . midpoint decodeFloat = decodeFloat . midpoint encodeFloat m e = singleton (encodeFloat m e) exponent = exponent . midpoint significand x = min a b ... max a b where (_ ,em) = decodeFloat (midpoint x) (mi,ei) = decodeFloat (inf x) (ms,es) = decodeFloat (sup x) a = encodeFloat mi (ei - em - floatDigits x) b = encodeFloat ms (es - em - floatDigits x) scaleFloat _ Empty = Empty scaleFloat n (I a b) = I (scaleFloat n a) (scaleFloat n b) isNaN (I a b) = isNaN a || isNaN b isNaN Empty = True isInfinite (I a b) = isInfinite a || isInfinite b isInfinite Empty = False isDenormalized (I a b) = isDenormalized a || isDenormalized b isDenormalized Empty = False -- contains negative zero isNegativeZero (I a b) = not (a > 0) && not (b < 0) && ( (b == 0 && (a < 0 || isNegativeZero a)) || (a == 0 && isNegativeZero a) || (a < 0 && b >= 0)) isNegativeZero Empty = False isIEEE _ = False atan2 = error "unimplemented" -- TODO: (^), (^^) to give tighter bounds -- | Calculate the intersection of two intervals. -- -- >>> intersection (1 ... 10 :: Interval Double) (5 ... 15 :: Interval Double) -- 5.0 ... 10.0 intersection :: Ord a => Interval a -> Interval a -> Interval a intersection x@(I a b) y@(I a' b') | x /=! y = Empty | otherwise = I (max a a') (min b b') intersection _ _ = Empty {-# INLINE intersection #-} -- | Calculate the convex hull of two intervals -- -- >>> hull (0 ... 10 :: Interval Double) (5 ... 15 :: Interval Double) -- 0.0 ... 15.0 -- -- >>> hull (15 ... 85 :: Interval Double) (0 ... 10 :: Interval Double) -- 0.0 ... 85.0 hull :: Ord a => Interval a -> Interval a -> Interval a hull (I a b) (I a' b') = I (min a a') (max b b') hull Empty x = x hull x Empty = x {-# INLINE hull #-} -- | For all @x@ in @X@, @y@ in @Y@. @x '<' y@ -- -- >>> (5 ... 10 :: Interval Double) >> (5 ... 10 :: Interval Double) >> (20 ... 30 :: Interval Double) Interval a -> Interval a -> Bool Empty >> (5 ... 10 :: Interval Double) <=! (20 ... 30 :: Interval Double) -- True -- -- >>> (5 ... 10 :: Interval Double) <=! (10 ... 30 :: Interval Double) -- True -- -- >>> (20 ... 30 :: Interval Double) <=! (5 ... 10 :: Interval Double) -- False (<=!) :: Ord a => Interval a -> Interval a -> Bool Empty <=! _ = True _ <=! Empty = True I _ bx <=! I ay _ = bx <= ay {-# INLINE (<=!) #-} -- | For all @x@ in @X@, @y@ in @Y@. @x '==' y@ -- -- Only singleton intervals or empty intervals can return true -- -- >>> (singleton 5 :: Interval Double) ==! (singleton 5 :: Interval Double) -- True -- -- >>> (5 ... 10 :: Interval Double) ==! (5 ... 10 :: Interval Double) -- False (==!) :: Eq a => Interval a -> Interval a -> Bool Empty ==! _ = True _ ==! Empty = True I ax bx ==! I ay by = bx == ay && ax == by {-# INLINE (==!) #-} -- | For all @x@ in @X@, @y@ in @Y@. @x '/=' y@ -- -- >>> (5 ... 15 :: Interval Double) /=! (20 ... 40 :: Interval Double) -- True -- -- >>> (5 ... 15 :: Interval Double) /=! (15 ... 40 :: Interval Double) -- False (/=!) :: Ord a => Interval a -> Interval a -> Bool Empty /=! _ = True _ /=! Empty = True I ax bx /=! I ay by = bx < ay || ax > by {-# INLINE (/=!) #-} -- | For all @x@ in @X@, @y@ in @Y@. @x '>' y@ -- -- >>> (20 ... 40 :: Interval Double) >! (10 ... 19 :: Interval Double) -- True -- -- >>> (5 ... 20 :: Interval Double) >! (15 ... 40 :: Interval Double) -- False (>!) :: Ord a => Interval a -> Interval a -> Bool Empty >! _ = True _ >! Empty = True I ax _ >! I _ by = ax > by {-# INLINE (>!) #-} -- | For all @x@ in @X@, @y@ in @Y@. @x '>=' y@ -- -- >>> (20 ... 40 :: Interval Double) >=! (10 ... 20 :: Interval Double) -- True -- -- >>> (5 ... 20 :: Interval Double) >=! (15 ... 40 :: Interval Double) -- False (>=!) :: Ord a => Interval a -> Interval a -> Bool Empty >=! _ = True _ >=! Empty = True I ax _ >=! I _ by = ax >= by {-# INLINE (>=!) #-} -- | For all @x@ in @X@, @y@ in @Y@. @x `op` y@ certainly :: Ord a => (forall b. Ord b => b -> b -> Bool) -> Interval a -> Interval a -> Bool certainly cmp l r | lt && eq && gt = True | lt && eq = l <=! r | lt && gt = l /=! r | lt = l =! r | eq = l ==! r | gt = l >! r | otherwise = False where lt = cmp False True eq = cmp True True gt = cmp True False {-# INLINE certainly #-} -- | Check if interval @X@ totally contains interval @Y@ -- -- >>> (20 ... 40 :: Interval Double) `contains` (25 ... 35 :: Interval Double) -- True -- -- >>> (20 ... 40 :: Interval Double) `contains` (15 ... 35 :: Interval Double) -- False contains :: Ord a => Interval a -> Interval a -> Bool contains _ Empty = True contains (I ax bx) (I ay by) = ax <= ay && by <= bx contains Empty I{} = False {-# INLINE contains #-} -- | Flipped version of `contains`. Check if interval @X@ a subset of interval @Y@ -- -- >>> (25 ... 35 :: Interval Double) `isSubsetOf` (20 ... 40 :: Interval Double) -- True -- -- >>> (20 ... 40 :: Interval Double) `isSubsetOf` (15 ... 35 :: Interval Double) -- False isSubsetOf :: Ord a => Interval a -> Interval a -> Bool isSubsetOf = flip contains {-# INLINE isSubsetOf #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<' y@? ( Interval a -> Interval a -> Bool Empty Interval a -> Interval a -> Bool Empty <=? _ = False _ <=? Empty = False I ax _ <=? I _ by = ax <= by {-# INLINE (<=?) #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '==' y@? (==?) :: Ord a => Interval a -> Interval a -> Bool I ax bx ==? I ay by = ax <= by && bx >= ay _ ==? _ = False {-# INLINE (==?) #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '/=' y@? (/=?) :: Eq a => Interval a -> Interval a -> Bool I ax bx /=? I ay by = ax /= by || bx /= ay _ /=? _ = False {-# INLINE (/=?) #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>' y@? (>?) :: Ord a => Interval a -> Interval a -> Bool I _ bx >? I ay _ = bx > ay _ >? _ = False {-# INLINE (>?) #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>=' y@? (>=?) :: Ord a => Interval a -> Interval a -> Bool I _ bx >=? I ay _ = bx >= ay _ >=? _ = False {-# INLINE (>=?) #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x `op` y@? possibly :: Ord a => (forall b. Ord b => b -> b -> Bool) -> Interval a -> Interval a -> Bool possibly cmp l r | lt && eq && gt = True | lt && eq = l <=? r | lt && gt = l /=? r | lt = l =? r | eq = l ==? r | gt = l >? r | otherwise = False where lt = cmp LT EQ eq = cmp EQ EQ gt = cmp GT EQ {-# INLINE possibly #-} -- | id function. Useful for type specification -- -- >>> :t idouble (1 ... 3) -- idouble (1 ... 3) :: Interval Double idouble :: Interval Double -> Interval Double idouble = id -- | id function. Useful for type specification -- -- >>> :t ifloat (1 ... 3) -- ifloat (1 ... 3) :: Interval Float ifloat :: Interval Float -> Interval Float ifloat = id -- Bugs: -- sin 1 :: Interval Double default (Integer,Double) -- | an interval containing all x `quot` y -- >>> (5 `quot` 3) `member` ((4...6) `iquot` (2...4)) -- True -- >>> (1...10) `iquot` ((-5)...4) -- *** Exception: divide by zero iquot :: Integral a => Interval a -> Interval a -> Interval a iquot i j = case (i,j) of (Empty,_) -> Empty (_,Empty) -> Empty (I l u , I l' u') -> if l' <= 0 && 0 <= u' then throw DivideByZero else I (minimum [a `quot` b | a <- [l,u], b <- [l',u']]) (maximum [a `quot` b | a <- [l,u], b <- [l',u']]) -- | an interval containing all x `rem` y -- >>> (5 `rem` 3) `member` ((4...6) `irem` (2...4)) -- True -- >>> (1...10) `irem` ((-5)...4) -- *** Exception: divide by zero irem :: Integral a => Interval a -> Interval a -> Interval a irem i j = case (i,j) of (Empty,_) -> Empty (_,Empty) -> Empty (I l u , I l' u') -> if l' <= 0 && 0 <= u' then throw DivideByZero else I (minimum [0, signum l * (abs u' - 1), signum l * (abs l' - 1)]) (maximum [0, signum u * (abs u' - 1), signum u * (abs l' - 1)]) -- | an interval containing all x `div` y -- >>> (5 `div` 3) `member` ((4...6) `idiv` (2...4)) -- True -- >>> (1...10) `idiv` ((-5)...4) -- *** Exception: divide by zero idiv :: Integral a => Interval a -> Interval a -> Interval a idiv i j = case (i,j) of (Empty,_) -> Empty (_,Empty) -> Empty (I l u , I l' u') -> if l' <= 0 && 0 <= u' then throw DivideByZero else I (min (l `Prelude.div` max 1 l') (u `Prelude.div` min (-1) u')) (max (u `Prelude.div` max 1 l') (l `Prelude.div` min (-1) u')) -- | an interval containing all x `mod` y -- >>> (5 `mod` 3) `member` ((4...6) `imod` (2...4)) -- True -- >>> (1...10) `imod` ((-5)...4) -- *** Exception: divide by zero imod :: Integral a => Interval a -> Interval a -> Interval a imod i j = case (i,j) of (Empty,_) -> Empty (_,Empty) -> Empty (_ , I l' u') -> if l' <= 0 && 0 <= u' then throw DivideByZero else I (min (l'+1) 0) (max 0 (u'-1)) intervals-0.9.2/src/Numeric/Interval/Kaucher.hs0000644000000000000000000005633307346545000017627 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE DeriveDataTypeable #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE DeriveGeneric #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Numeric.Interval -- Copyright : (c) Edward Kmett 2010-2014 -- License : BSD3 -- Maintainer : ekmett@gmail.com -- Stability : experimental -- Portability : DeriveDataTypeable -- -- \"Directed\" Interval arithmetic -- ----------------------------------------------------------------------------- module Numeric.Interval.Kaucher ( Interval(..) , (...) , interval , whole , empty , null , singleton , member , notMember , elem , notElem , inf , sup , singular , width , midpoint , intersection , hull , bisect , magnitude , mignitude , distance , inflate, deflate , scale, symmetric , contains , isSubsetOf , certainly, (=!), (>!) , possibly, (=?), (>?) , clamp , idouble , ifloat , iquot , irem , idiv , imod ) where import Control.Applicative hiding (empty) import Control.Exception as Exception import Data.Data import Data.Distributive import Data.Foldable hiding (minimum, maximum, elem, notElem #if __GLASGOW_HASKELL__ >= 710 , null #endif ) import Data.Function (on) import Data.Traversable #if __GLASGOW_HASKELL__ >= 704 import GHC.Generics #endif import Numeric.Interval.Exception import Prelude hiding (null, elem, notElem) import qualified Data.Semigroup import qualified Data.Monoid -- $setup -- -- Eta expansion needed for GHC-7.6 -- >>> :set -fno-warn-deprecations -- >>> let null xs = Numeric.Interval.Kaucher.null xs -- >>> let elem x xs = Numeric.Interval.Kaucher.elem x xs -- >>> let notElem x xs = Numeric.Interval.Kaucher.notElem x xs data Interval a = I !a !a deriving ( Eq, Ord , Data , Typeable #if __GLASGOW_HASKELL__ >= 704 , Generic #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif #endif ) -- | 'Data.Semigroup.<>' is 'hull' instance Ord a => Data.Semigroup.Semigroup (Interval a) where (<>) = hull instance Functor Interval where fmap f (I a b) = I (f a) (f b) {-# INLINE fmap #-} instance Foldable Interval where foldMap f (I a b) = f a `Data.Monoid.mappend` f b {-# INLINE foldMap #-} instance Traversable Interval where traverse f (I a b) = I <$> f a <*> f b {-# INLINE traverse #-} instance Applicative Interval where pure a = I a a {-# INLINE pure #-} I f g <*> I a b = I (f a) (g b) {-# INLINE (<*>) #-} instance Monad Interval where return a = I a a {-# INLINE return #-} I a b >>= f = I a' b' where I a' _ = f a I _ b' = f b {-# INLINE (>>=) #-} instance Distributive Interval where distribute f = fmap inf f ... fmap sup f {-# INLINE distribute #-} infix 3 ... negInfinity :: Fractional a => a negInfinity = (-1)/0 {-# INLINE negInfinity #-} posInfinity :: Fractional a => a posInfinity = 1/0 {-# INLINE posInfinity #-} nan :: Fractional a => a nan = 0/0 fmod :: RealFrac a => a -> a -> a fmod a b = a - q*b where q = realToFrac (truncate $ a / b :: Integer) {-# INLINE fmod #-} -- | Create a directed interval. (...) :: a -> a -> Interval a (...) = I {-# INLINE (...) #-} -- | Try to create a non-empty interval. interval :: Ord a => a -> a -> Maybe (Interval a) interval a b | a <= b = Just $ I a b | otherwise = Nothing -- | The whole real number line -- -- >>> whole -- -Infinity ... Infinity whole :: Fractional a => Interval a whole = negInfinity ... posInfinity {-# INLINE whole #-} -- | An empty interval -- -- >>> empty -- NaN ... NaN empty :: Fractional a => Interval a empty = nan ... nan {-# INLINE empty #-} -- | negation handles NaN properly -- -- >>> null (1 ... 5) -- False -- -- >>> null (1 ... 1) -- False -- -- >>> null empty -- True null :: Ord a => Interval a -> Bool null x = not (inf x <= sup x) {-# INLINE null #-} -- | A singleton point -- -- >>> singleton 1 -- 1 ... 1 singleton :: a -> Interval a singleton a = a ... a {-# INLINE singleton #-} -- | The infinumum (lower bound) of an interval -- -- >>> inf (1 ... 20) -- 1 inf :: Interval a -> a inf (I a _) = a {-# INLINE inf #-} -- | The supremum (upper bound) of an interval -- -- >>> sup (1 ... 20) -- 20 sup :: Interval a -> a sup (I _ b) = b {-# INLINE sup #-} -- | Is the interval a singleton point? -- N.B. This is fairly fragile and likely will not hold after -- even a few operations that only involve singletons -- -- >>> singular (singleton 1) -- True -- -- >>> singular (1.0 ... 20.0) -- False singular :: Ord a => Interval a -> Bool singular x = not (null x) && inf x == sup x {-# INLINE singular #-} instance Show a => Show (Interval a) where showsPrec n (I a b) = showParen (n > 3) $ showsPrec 3 a . showString " ... " . showsPrec 3 b -- | Calculate the width of an interval. -- -- >>> width (1 ... 20) -- 19 -- -- >>> width (singleton 1) -- 0 -- -- >>> width empty -- NaN width :: Num a => Interval a -> a width (I a b) = b - a {-# INLINE width #-} -- | Magnitude -- -- >>> magnitude (1 ... 20) -- 20 -- -- >>> magnitude (-20 ... 10) -- 20 -- -- >>> magnitude (singleton 5) -- 5 magnitude :: (Num a, Ord a) => Interval a -> a magnitude = sup . abs {-# INLINE magnitude #-} -- | \"mignitude\" -- -- >>> mignitude (1 ... 20) -- 1 -- -- >>> mignitude (-20 ... 10) -- 0 -- -- >>> mignitude (singleton 5) -- 5 -- -- >>> mignitude empty -- NaN mignitude :: (Num a, Ord a) => Interval a -> a mignitude = inf . abs {-# INLINE mignitude #-} -- | Hausdorff distance between non-empty intervals. -- -- >>> distance (1 ... 7) (6 ... 10) -- 0 -- -- >>> distance (1 ... 7) (15 ... 24) -- 8 -- -- >>> distance (1 ... 7) (-10 ... -2) -- 3 -- -- >>> distance empty (1 ... 1) -- NaN distance :: (Num a, Ord a) => Interval a -> Interval a -> a distance i1 i2 = mignitude (i1 - i2) -- | Inflate an interval by enlarging it at both ends. -- -- >>> inflate 3 (-1 ... 7) -- -4 ... 10 -- -- >>> inflate (-2) (0 ... 4) -- 2 ... 2 inflate :: (Num a, Ord a) => a -> Interval a -> Interval a inflate x y = symmetric x + y -- | Deflate an interval by shrinking it from both ends. -- -- >>> deflate 3.0 (-4.0 ... 10.0) -- -1.0 ... 7.0 -- -- >>> deflate 2.0 (-1.0 ... 1.0) -- 1.0 ... -1.0 deflate :: Fractional a => a -> Interval a -> Interval a deflate x (I a b) = I a' b' where a' = a + x b' = b - x -- | Scale an interval about its midpoint. -- -- >>> scale 1.1 (-6.0 ... 4.0) -- -6.5 ... 4.5 -- -- >>> scale (-2.0) (-1.0 ... 1.0) -- 2.0 ... -2.0 scale :: Fractional a => a -> Interval a -> Interval a scale x i = I a b where h = x * width i / 2 mid = midpoint i a = mid - h b = mid + h -- | Construct a symmetric interval. -- -- >>> symmetric 3 -- -3 ... 3 -- -- >>> symmetric (-2) -- 2 ... -2 symmetric :: Num a => a -> Interval a symmetric x = negate x ... x instance (Num a, Ord a) => Num (Interval a) where I a b + I a' b' = (a + a') ... (b + b') {-# INLINE (+) #-} I a b - I a' b' = (a - b') ... (b - a') {-# INLINE (-) #-} I a b * I a' b' = minimum [a * a', a * b', b * a', b * b'] ... maximum [a * a', a * b', b * a', b * b'] {-# INLINE (*) #-} abs x@(I a b) | a >= 0 = x | b <= 0 = negate x | b > 0 && a < 0 = 0 ... max (- a) b | otherwise = x -- preserve the empty interval {-# INLINE abs #-} signum = increasing signum {-# INLINE signum #-} fromInteger i = singleton (fromInteger i) {-# INLINE fromInteger #-} -- | Bisect an interval at its midpoint. -- -- >>> bisect (10.0 ... 20.0) -- (10.0 ... 15.0,15.0 ... 20.0) -- -- >>> bisect (singleton 5.0) -- (5.0 ... 5.0,5.0 ... 5.0) -- -- >>> bisect empty -- (NaN ... NaN,NaN ... NaN) bisect :: Fractional a => Interval a -> (Interval a, Interval a) bisect x = (inf x ... m, m ... sup x) where m = midpoint x {-# INLINE bisect #-} -- | Nearest point to the midpoint of the interval. -- -- >>> midpoint (10.0 ... 20.0) -- 15.0 -- -- >>> midpoint (singleton 5.0) -- 5.0 -- -- >>> midpoint empty -- NaN midpoint :: Fractional a => Interval a -> a midpoint x = inf x + (sup x - inf x) / 2 {-# INLINE midpoint #-} -- | Determine if a point is in the interval. -- -- >>> member 3.2 (1.0 ... 5.0) -- True -- -- >>> member 5 (1.0 ... 5.0) -- True -- -- >>> member 1 (1.0 ... 5.0) -- True -- -- >>> member 8 (1.0 ... 5.0) -- False -- -- >>> member 5 empty -- False -- member :: Ord a => a -> Interval a -> Bool member x (I a b) = x >= a && x <= b {-# INLINE member #-} -- | Determine if a point is not included in the interval -- -- >>> notMember 8 (1.0 ... 5.0) -- True -- -- >>> notMember 1.4 (1.0 ... 5.0) -- False -- -- And of course, nothing is a member of the empty interval. -- -- >>> notMember 5 empty -- True notMember :: Ord a => a -> Interval a -> Bool notMember x xs = not (member x xs) {-# INLINE notMember #-} -- | Determine if a point is in the interval. -- -- >>> elem 3.2 (1.0 ... 5.0) -- True -- -- >>> elem 5 (1.0 ... 5.0) -- True -- -- >>> elem 1 (1.0 ... 5.0) -- True -- -- >>> elem 8 (1.0 ... 5.0) -- False -- -- >>> elem 5 empty -- False -- elem :: Ord a => a -> Interval a -> Bool elem = member {-# INLINE elem #-} {-# DEPRECATED elem "Use `member` instead." #-} -- | Determine if a point is not included in the interval -- -- >>> notElem 8 (1.0 ... 5.0) -- True -- -- >>> notElem 1.4 (1.0 ... 5.0) -- False -- -- And of course, nothing is a member of the empty interval. -- -- >>> notElem 5 empty -- True notElem :: Ord a => a -> Interval a -> Bool notElem = notMember {-# INLINE notElem #-} {-# DEPRECATED notElem "Use `notMember` instead." #-} -- | 'realToFrac' will use the midpoint instance Real a => Real (Interval a) where toRational x | null x = Exception.throw EmptyInterval | otherwise = a + (b - a) / 2 where a = toRational (inf x) b = toRational (sup x) {-# INLINE toRational #-} -- @'divNonZero' X Y@ assumes @0 `'notElem'` Y@ divNonZero :: (Fractional a, Ord a) => Interval a -> Interval a -> Interval a divNonZero (I a b) (I a' b') = minimum [a / a', a / b', b / a', b / b'] ... maximum [a / a', a / b', b / a', b / b'] -- @'divPositive' X y@ assumes y > 0, and divides @X@ by [0 ... y] divPositive :: (Fractional a, Ord a) => Interval a -> a -> Interval a divPositive x@(I a b) y | a == 0 && b == 0 = x -- b < 0 || isNegativeZero b = negInfinity ... ( b / y) | b < 0 = negInfinity ... ( b / y) | a < 0 = whole | otherwise = (a / y) ... posInfinity {-# INLINE divPositive #-} -- divNegative assumes y < 0 and divides the interval @X@ by [y ... 0] divNegative :: (Fractional a, Ord a) => Interval a -> a -> Interval a divNegative x@(I a b) y | a == 0 && b == 0 = - x -- flip negative zeros -- b < 0 || isNegativeZero b = (b / y) ... posInfinity | b < 0 = (b / y) ... posInfinity | a < 0 = whole | otherwise = negInfinity ... (a / y) {-# INLINE divNegative #-} divZero :: (Fractional a, Ord a) => Interval a -> Interval a divZero x | inf x == 0 && sup x == 0 = x | otherwise = whole {-# INLINE divZero #-} instance (Fractional a, Ord a) => Fractional (Interval a) where -- TODO: check isNegativeZero properly x / y | 0 `notElem` y = divNonZero x y | iz && sz = empty -- division by 0 | iz = divPositive x (inf y) | sz = divNegative x (sup y) | otherwise = divZero x where iz = inf y == 0 sz = sup y == 0 recip (I a b) = on min recip a b ... on max recip a b {-# INLINE recip #-} fromRational r = let r' = fromRational r in r' ... r' {-# INLINE fromRational #-} instance RealFrac a => RealFrac (Interval a) where properFraction x = (b, x - fromIntegral b) where b = truncate (midpoint x) {-# INLINE properFraction #-} ceiling x = ceiling (sup x) {-# INLINE ceiling #-} floor x = floor (inf x) {-# INLINE floor #-} round x = round (midpoint x) {-# INLINE round #-} truncate x = truncate (midpoint x) {-# INLINE truncate #-} instance (RealFloat a, Ord a) => Floating (Interval a) where pi = singleton pi {-# INLINE pi #-} exp = increasing exp {-# INLINE exp #-} log (I a b) = (if a > 0 then log a else negInfinity) ... log b {-# INLINE log #-} cos x | null x = empty | width t >= pi = (-1) ... 1 | inf t >= pi = - cos (t - pi) | sup t <= pi = decreasing cos t | sup t <= 2 * pi = (-1) ... cos ((pi * 2 - sup t) `min` inf t) | otherwise = (-1) ... 1 where t = fmod x (pi * 2) {-# INLINE cos #-} sin x | null x = empty | otherwise = cos (x - pi / 2) {-# INLINE sin #-} tan x | null x = empty | inf t' <= - pi / 2 || sup t' >= pi / 2 = whole | otherwise = increasing tan x where t = x `fmod` pi t' | t >= pi / 2 = t - pi | otherwise = t {-# INLINE tan #-} asin x@(I a b) | null x || b < -1 || a > 1 = empty | otherwise = (if a <= -1 then -halfPi else asin a) ... (if b >= 1 then halfPi else asin b) where halfPi = pi / 2 {-# INLINE asin #-} acos x@(I a b) | null x || b < -1 || a > 1 = empty | otherwise = (if b >= 1 then 0 else acos b) ... (if a < -1 then pi else acos a) {-# INLINE acos #-} atan = increasing atan {-# INLINE atan #-} sinh = increasing sinh {-# INLINE sinh #-} cosh x@(I a b) | null x = empty | b < 0 = decreasing cosh x | a >= 0 = increasing cosh x | otherwise = I 0 $ cosh $ if - a > b then a else b {-# INLINE cosh #-} tanh = increasing tanh {-# INLINE tanh #-} asinh = increasing asinh {-# INLINE asinh #-} acosh x@(I a b) | null x || b < 1 = empty | otherwise = I lo $ acosh b where lo | a <= 1 = 0 | otherwise = acosh a {-# INLINE acosh #-} atanh x@(I a b) | null x || b < -1 || a > 1 = empty | otherwise = (if a <= - 1 then negInfinity else atanh a) ... (if b >= 1 then posInfinity else atanh b) {-# INLINE atanh #-} -- | lift a monotone increasing function over a given interval increasing :: (a -> b) -> Interval a -> Interval b increasing f (I a b) = f a ... f b -- | lift a monotone decreasing function over a given interval decreasing :: (a -> b) -> Interval a -> Interval b decreasing f (I a b) = f b ... f a -- | We have to play some semantic games to make these methods make sense. -- Most compute with the midpoint of the interval. instance RealFloat a => RealFloat (Interval a) where floatRadix = floatRadix . midpoint floatDigits = floatDigits . midpoint floatRange = floatRange . midpoint decodeFloat = decodeFloat . midpoint encodeFloat m e = singleton (encodeFloat m e) exponent = exponent . midpoint significand x = min a b ... max a b where (_ ,em) = decodeFloat (midpoint x) (mi,ei) = decodeFloat (inf x) (ms,es) = decodeFloat (sup x) a = encodeFloat mi (ei - em - floatDigits x) b = encodeFloat ms (es - em - floatDigits x) scaleFloat n x = scaleFloat n (inf x) ... scaleFloat n (sup x) isNaN x = isNaN (inf x) || isNaN (sup x) isInfinite x = isInfinite (inf x) || isInfinite (sup x) isDenormalized x = isDenormalized (inf x) || isDenormalized (sup x) -- contains negative zero isNegativeZero x = not (inf x > 0) && not (sup x < 0) && ( (sup x == 0 && (inf x < 0 || isNegativeZero (inf x))) || (inf x == 0 && isNegativeZero (inf x)) || (inf x < 0 && sup x >= 0)) isIEEE x = isIEEE (inf x) && isIEEE (sup x) atan2 = error "unimplemented" -- TODO: (^), (^^) to give tighter bounds -- | Calculate the intersection of two intervals. -- -- >>> intersection (1 ... 10 :: Interval Double) (5 ... 15 :: Interval Double) -- 5.0 ... 10.0 intersection :: (Fractional a, Ord a) => Interval a -> Interval a -> Interval a intersection x@(I a b) y@(I a' b') | x /=! y = empty | otherwise = max a a' ... min b b' {-# INLINE intersection #-} -- | Calculate the convex hull of two intervals -- -- >>> hull (0 ... 10 :: Interval Double) (5 ... 15 :: Interval Double) -- 0.0 ... 15.0 -- -- >>> hull (15 ... 85 :: Interval Double) (0 ... 10 :: Interval Double) -- 0.0 ... 85.0 -- -- >>> hull (10 ... 20 :: Interval Double) (15 ... 0 :: Interval Double) -- 10.0 ... 20.0 -- hull :: Ord a => Interval a -> Interval a -> Interval a hull x@(I a b) y@(I a' b') | null x = y | null y = x | otherwise = min a a' ... max b b' {-# INLINE hull #-} -- | For all @x@ in @X@, @y@ in @Y@. @x '<' y@ -- -- >>> (5 ... 10 :: Interval Double) >> (5 ... 10 :: Interval Double) >> (20 ... 30 :: Interval Double) Interval a -> Interval a -> Bool x >> (5 ... 10 :: Interval Double) <=! (20 ... 30 :: Interval Double) -- True -- -- >>> (5 ... 10 :: Interval Double) <=! (10 ... 30 :: Interval Double) -- True -- -- >>> (20 ... 30 :: Interval Double) <=! (5 ... 10 :: Interval Double) -- False (<=!) :: Ord a => Interval a -> Interval a -> Bool x <=! y = sup x <= inf y {-# INLINE (<=!) #-} -- | For all @x@ in @X@, @y@ in @Y@. @x '==' y@ -- -- Only singleton intervals return true -- -- >>> (singleton 5 :: Interval Double) ==! (singleton 5 :: Interval Double) -- True -- -- >>> (5 ... 10 :: Interval Double) ==! (5 ... 10 :: Interval Double) -- False (==!) :: Eq a => Interval a -> Interval a -> Bool x ==! y = sup x == inf y && inf x == sup y {-# INLINE (==!) #-} -- | For all @x@ in @X@, @y@ in @Y@. @x '/=' y@ -- -- >>> (5 ... 15 :: Interval Double) /=! (20 ... 40 :: Interval Double) -- True -- -- >>> (5 ... 15 :: Interval Double) /=! (15 ... 40 :: Interval Double) -- False (/=!) :: Ord a => Interval a -> Interval a -> Bool x /=! y = sup x < inf y || inf x > sup y {-# INLINE (/=!) #-} -- | For all @x@ in @X@, @y@ in @Y@. @x '>' y@ -- -- >>> (20 ... 40 :: Interval Double) >! (10 ... 19 :: Interval Double) -- True -- -- >>> (5 ... 20 :: Interval Double) >! (15 ... 40 :: Interval Double) -- False (>!) :: Ord a => Interval a -> Interval a -> Bool x >! y = inf x > sup y {-# INLINE (>!) #-} -- | For all @x@ in @X@, @y@ in @Y@. @x '>=' y@ -- -- >>> (20 ... 40 :: Interval Double) >=! (10 ... 20 :: Interval Double) -- True -- -- >>> (5 ... 20 :: Interval Double) >=! (15 ... 40 :: Interval Double) -- False (>=!) :: Ord a => Interval a -> Interval a -> Bool x >=! y = inf x >= sup y {-# INLINE (>=!) #-} -- | For all @x@ in @X@, @y@ in @Y@. @x `op` y@ -- -- certainly :: Ord a => (forall b. Ord b => b -> b -> Bool) -> Interval a -> Interval a -> Bool certainly cmp l r | lt && eq && gt = True | lt && eq = l <=! r | lt && gt = l /=! r | lt = l =! r | eq = l ==! r | gt = l >! r | otherwise = False where lt = cmp LT EQ eq = cmp EQ EQ gt = cmp GT EQ {-# INLINE certainly #-} -- | Check if interval @X@ totally contains interval @Y@ -- -- >>> (20 ... 40 :: Interval Double) `contains` (25 ... 35 :: Interval Double) -- True -- -- >>> (20 ... 40 :: Interval Double) `contains` (15 ... 35 :: Interval Double) -- False contains :: Ord a => Interval a -> Interval a -> Bool contains x y = null y || (not (null x) && inf x <= inf y && sup y <= sup x) {-# INLINE contains #-} -- | Flipped version of `contains`. Check if interval @X@ a subset of interval @Y@ -- -- >>> (25 ... 35 :: Interval Double) `isSubsetOf` (20 ... 40 :: Interval Double) -- True -- -- >>> (20 ... 40 :: Interval Double) `isSubsetOf` (15 ... 35 :: Interval Double) -- False isSubsetOf :: Ord a => Interval a -> Interval a -> Bool isSubsetOf = flip contains {-# INLINE isSubsetOf #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<' y@? ( Interval a -> Interval a -> Bool x Interval a -> Interval a -> Bool x <=? y = inf x <= sup y {-# INLINE (<=?) #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '==' y@? (==?) :: Ord a => Interval a -> Interval a -> Bool x ==? y = inf x <= sup y && sup x >= inf y {-# INLINE (==?) #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '/=' y@? (/=?) :: Eq a => Interval a -> Interval a -> Bool x /=? y = inf x /= sup y || sup x /= inf y {-# INLINE (/=?) #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>' y@? (>?) :: Ord a => Interval a -> Interval a -> Bool x >? y = sup x > inf y {-# INLINE (>?) #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>=' y@? (>=?) :: Ord a => Interval a -> Interval a -> Bool x >=? y = sup x >= inf y {-# INLINE (>=?) #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x `op` y@? possibly :: Ord a => (forall b. Ord b => b -> b -> Bool) -> Interval a -> Interval a -> Bool possibly cmp l r | lt && eq && gt = True | lt && eq = l <=? r | lt && gt = l /=? r | lt = l =? r | eq = l ==? r | gt = l >? r | otherwise = False where lt = cmp LT EQ eq = cmp EQ EQ gt = cmp GT EQ {-# INLINE possibly #-} -- | The nearest value to that supplied which is contained in the interval. clamp :: Ord a => Interval a -> a -> a clamp (I a b) x | x < a = a | x > b = b | otherwise = x -- | id function. Useful for type specification -- -- >>> :t idouble (1 ... 3) -- idouble (1 ... 3) :: Interval Double idouble :: Interval Double -> Interval Double idouble = id -- | id function. Useful for type specification -- -- >>> :t ifloat (1 ... 3) -- ifloat (1 ... 3) :: Interval Float ifloat :: Interval Float -> Interval Float ifloat = id -- Bugs: -- sin 1 :: Interval Double default (Integer,Double) -- | an interval containing all x `quot` y -- >>> (5 `quot` 3) `member` ((4...6) `iquot` (2...4)) -- True -- >>> (1...10) `iquot` ((-5)...4) -- *** Exception: divide by zero iquot :: Integral a => Interval a -> Interval a -> Interval a iquot (I l u) (I l' u') = if l' <= 0 && 0 <= u' then throw DivideByZero else I (minimum [a `quot` b | a <- [l,u], b <- [l',u']]) (maximum [a `quot` b | a <- [l,u], b <- [l',u']]) -- | an interval containing all x `rem` y -- >>> (5 `rem` 3) `member` ((4...6) `irem` (2...4)) -- True -- >>> (1...10) `irem` ((-5)...4) -- *** Exception: divide by zero irem :: Integral a => Interval a -> Interval a -> Interval a irem (I l u) (I l' u') = if l' <= 0 && 0 <= u' then throw DivideByZero else I (minimum [0, signum l * (abs u' - 1), signum l * (abs l' - 1)]) (maximum [0, signum u * (abs u' - 1), signum u * (abs l' - 1)]) -- | an interval containing all x `div` y -- >>> (5 `div` 3) `member` ((4...6) `idiv` (2...4)) -- True -- >>> (1...10) `idiv` ((-5)...4) -- *** Exception: divide by zero idiv :: Integral a => Interval a -> Interval a -> Interval a idiv (I l u) (I l' u') = if l' <= 0 && 0 <= u' then throw DivideByZero else I (min (l `Prelude.div` max 1 l') (u `Prelude.div` min (-1) u')) (max (u `Prelude.div` max 1 l') (l `Prelude.div` min (-1) u')) -- | an interval containing all x `mod` y -- >>> (5 `mod` 3) `member` ((4...6) `imod` (2...4)) -- True -- >>> (1...10) `imod` ((-5)...4) -- *** Exception: divide by zero imod :: Integral a => Interval a -> Interval a -> Interval a imod _ (I l' u') = if l' <= 0 && 0 <= u' then throw DivideByZero else I (min (l'+1) 0) (max 0 (u'-1)) intervals-0.9.2/src/Numeric/Interval/NonEmpty.hs0000644000000000000000000000221607346545000020005 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE DeriveDataTypeable #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE DeriveGeneric #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Numeric.Interval.NonEmpty -- Copyright : (c) Edward Kmett 2010-2013 -- License : BSD3 -- Maintainer : ekmett@gmail.com -- Stability : experimental -- Portability : DeriveDataTypeable -- -- Interval arithmetic -- ----------------------------------------------------------------------------- module Numeric.Interval.NonEmpty ( Interval , (...) , interval , whole , singleton , member , notMember , elem , notElem , inf , sup , singular , width , midpoint , distance , intersection , hull , bisect , bisectIntegral , magnitude , mignitude , contains , isSubsetOf , certainly, (=!), (>!) , possibly, (=?), (>?) , clamp , inflate, deflate , scale, symmetric , idouble , ifloat , iquot , irem , idiv , imod ) where import Numeric.Interval.NonEmpty.Internal import Prelude () intervals-0.9.2/src/Numeric/Interval/NonEmpty/0000755000000000000000000000000007346545000017450 5ustar0000000000000000intervals-0.9.2/src/Numeric/Interval/NonEmpty/Internal.hs0000644000000000000000000006506107346545000021570 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE DeriveDataTypeable #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE DeriveGeneric #-} #endif {-# OPTIONS_HADDOCK not-home #-} ----------------------------------------------------------------------------- -- | -- Module : Numeric.Interval.NonEmpty.Internal -- Copyright : (c) Edward Kmett 2010-2014 -- License : BSD3 -- Maintainer : ekmett@gmail.com -- Stability : experimental -- Portability : DeriveDataTypeable -- -- Interval arithmetic ----------------------------------------------------------------------------- module Numeric.Interval.NonEmpty.Internal ( Interval(..) , (...) , interval , whole , singleton , member , notMember , elem , notElem , inf , sup , singular , width , midpoint , distance , intersection , hull , bisect , bisectIntegral , magnitude , mignitude , contains , isSubsetOf , certainly, (=!), (>!) , possibly, (=?), (>?) , clamp , inflate, deflate , scale, symmetric , idouble , ifloat , iquot , irem , idiv , imod ) where import Control.Exception as Exception import Data.Data #if __GLASGOW_HASKELL__ >= 704 import GHC.Generics #endif import Prelude hiding (null, elem, notElem) import qualified Data.Semigroup -- $setup -- >>> import Test.QuickCheck.Arbitrary -- >>> import Test.QuickCheck.Gen hiding (scale) -- >>> import Test.QuickCheck.Property -- >>> import Control.Applicative -- >>> import Control.Exception -- >>> :set -XNoMonomorphismRestriction -- >>> :set -XExtendedDefaultRules -- >>> default (Integer,Double) -- >>> instance (Ord a, Arbitrary a) => Arbitrary (Interval a) where arbitrary = (...) <$> arbitrary <*> arbitrary -- >>> let memberOf xs = sized $ \n -> case n of { 0 -> pure $ inf xs; 1 -> pure $ sup xs; _ -> choose (inf xs, sup xs); } -- >>> let conservative sf f xs = forAll (choose (inf xs, sup xs)) $ \x -> (sf x) `member` (f xs) -- >>> let conservative2 sf f xs ys = forAll ((,) <$> choose (inf xs, sup xs) <*> choose (inf ys, sup ys)) $ \(x,y) -> (sf x y) `member` (f xs ys) -- >>> let conservativeExceptNaN sf f xs = forAll (choose (inf xs, sup xs)) $ \x -> isNaN (sf x) || (sf x) `member` (f xs) -- >>> let compose2 = fmap . fmap -- >>> let commutative op a b = (a `op` b) == (b `op` a) -- -- -- Eta expansion needed for GHC-7.6 -- >>> :set -fno-warn-deprecations -- >>> let elem x xs = Numeric.Interval.NonEmpty.Internal.elem x xs -- >>> let notElem x xs = Numeric.Interval.NonEmpty.Internal.notElem x xs data Interval a = I !a !a deriving ( Eq, Ord , Data , Typeable #if __GLASGOW_HASKELL__ >= 704 , Generic #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif #endif ) -- | 'Data.Semigroup.<>' is 'hull' instance Ord a => Data.Semigroup.Semigroup (Interval a) where (<>) = hull infix 3 ... negInfinity :: Fractional a => a negInfinity = (-1)/0 {-# INLINE negInfinity #-} posInfinity :: Fractional a => a posInfinity = 1/0 {-# INLINE posInfinity #-} -- the sign of a number, but as an Ordering so that we can pattern match over it. -- GT means greater than zero, etc. signum' :: (Ord a, Num a) => a -> Ordering signum' x = compare x 0 -- arguments are period, range, derivative, function, and interval -- we require that each period of the function include precisely one local minimum and one local maximum periodic :: (Num a, Ord a) => a -> Interval a -> (a -> Ordering) -> (a -> a) -> Interval a -> Interval a periodic p r _ _ x | width x > p = r periodic _ r d f (I a b) = periodic' r (d a) (d b) (f a) (f b) -- arguments are global range, derivatives at endpoints, values at endpoints periodic' :: (Ord a) => Interval a -> Ordering -> Ordering -> a -> a -> Interval a periodic' r GT GT a b | a <= b = I a b -- stays in increasing zone | otherwise = r -- goes from increasing zone, all the way through decreasing zone, and back to increasing zone periodic' r LT LT a b | a >= b = I b a -- stays in decreasing zone | otherwise = r -- goes from decreasing zone, all the way through increasing zone, and back to decreasing zone periodic' r GT _ a b = I (min a b) (sup r) -- was going up, started going down periodic' r LT _ a b = I (inf r) (max a b) -- was going down, started going up periodic' r EQ GT a b | a < b = I a b -- stays in increasing zone | otherwise = r -- goes from increasing zone, all the way through decreasing zone, and back to increasing zone periodic' r EQ LT a b | a > b = I b a -- stays in decreasing zone | otherwise = r -- goes from decreasing zone, all the way through increasing zone, and back to decreasing zone periodic' _ _ _ a b = a ... b -- precisely begins and ends at local extremes, so it's either a singleton or whole -- | Create a non-empty interval, turning it around if necessary (...) :: Ord a => a -> a -> Interval a a ... b | a <= b = I a b | otherwise = I b a {-# INLINE (...) #-} -- | Try to create a non-empty interval. interval :: Ord a => a -> a -> Maybe (Interval a) interval a b | a <= b = Just $ I a b | otherwise = Nothing -- | The whole real number line -- -- >>> whole -- -Infinity ... Infinity -- -- prop> (x :: Double) `elem` whole whole :: Fractional a => Interval a whole = I negInfinity posInfinity {-# INLINE whole #-} -- | A singleton point -- -- >>> singleton 1 -- 1 ... 1 -- -- prop> x `elem` (singleton x) -- prop> x /= y ==> y `notElem` (singleton x) singleton :: a -> Interval a singleton a = I a a {-# INLINE singleton #-} -- | The infinumum (lower bound) of an interval -- -- >>> inf (1 ... 20) -- 1 -- -- prop> min x y == inf (x ... y) -- prop> inf x <= sup x inf :: Interval a -> a inf (I a _) = a {-# INLINE inf #-} -- | The supremum (upper bound) of an interval -- -- >>> sup (1 ... 20) -- 20 -- -- prop> sup x `elem` x -- prop> max x y == sup (x ... y) -- prop> inf x <= sup x sup :: Interval a -> a sup (I _ b) = b {-# INLINE sup #-} -- | Is the interval a singleton point? -- N.B. This is fairly fragile and likely will not hold after -- even a few operations that only involve singletons -- -- >>> singular (singleton 1) -- True -- -- >>> singular (1.0 ... 20.0) -- False singular :: Ord a => Interval a -> Bool singular (I a b) = a == b {-# INLINE singular #-} instance Show a => Show (Interval a) where showsPrec n (I a b) = showParen (n > 3) $ showsPrec 3 a . showString " ... " . showsPrec 3 b -- | Calculate the width of an interval. -- -- >>> width (1 ... 20) -- 19 -- -- >>> width (singleton 1) -- 0 -- -- prop> 0 <= width x width :: Num a => Interval a -> a width (I a b) = b - a {-# INLINE width #-} -- | Magnitude -- -- >>> magnitude (1 ... 20) -- 20 -- -- >>> magnitude (-20 ... 10) -- 20 -- -- >>> magnitude (singleton 5) -- 5 -- -- prop> 0 <= magnitude x magnitude :: (Num a, Ord a) => Interval a -> a magnitude = sup . abs {-# INLINE magnitude #-} -- | \"mignitude\" -- -- >>> mignitude (1 ... 20) -- 1 -- -- >>> mignitude (-20 ... 10) -- 0 -- -- >>> mignitude (singleton 5) -- 5 -- -- prop> 0 <= mignitude x mignitude :: (Num a, Ord a) => Interval a -> a mignitude = inf . abs {-# INLINE mignitude #-} -- | Num instance for intervals. -- -- prop> conservative2 ((+) :: Double -> Double -> Double) (+) -- prop> conservative2 ((-) :: Double -> Double -> Double) (-) -- prop> conservative2 ((*) :: Double -> Double -> Double) (*) -- prop> conservative (abs :: Double -> Double) abs instance (Num a, Ord a) => Num (Interval a) where I a b + I a' b' = (a + a') ... (b + b') {-# INLINE (+) #-} I a b - I a' b' = (a - b') ... (b - a') {-# INLINE (-) #-} I a b * I a' b' = minimum [a * a', a * b', b * a', b * b'] ... maximum [a * a', a * b', b * a', b * b'] {-# INLINE (*) #-} abs x@(I a b) | a >= 0 = x | b <= 0 = negate x | otherwise = 0 ... max (- a) b {-# INLINE abs #-} signum = increasing signum {-# INLINE signum #-} fromInteger i = singleton (fromInteger i) {-# INLINE fromInteger #-} -- | Bisect an interval at its midpoint. -- -- >>> bisect (10.0 ... 20.0) -- (10.0 ... 15.0,15.0 ... 20.0) -- -- >>> bisect (singleton 5.0) -- (5.0 ... 5.0,5.0 ... 5.0) -- -- prop> let (a, b) = bisect (x :: Interval Double) in sup a == inf b -- prop> let (a, b) = bisect (x :: Interval Double) in inf a == inf x -- prop> let (a, b) = bisect (x :: Interval Double) in sup b == sup x bisect :: Fractional a => Interval a -> (Interval a, Interval a) bisect (I a b) = (I a m, I m b) where m = a + (b - a) / 2 {-# INLINE bisect #-} bisectIntegral :: Integral a => Interval a -> (Interval a, Interval a) bisectIntegral (I a b) | a == m || b == m = (I a a, I b b) | otherwise = (I a m, I m b) where m = a + (b - a) `div` 2 {-# INLINE bisectIntegral #-} -- | Nearest point to the midpoint of the interval. -- -- >>> midpoint (10.0 ... 20.0) -- 15.0 -- -- >>> midpoint (singleton 5.0) -- 5.0 -- -- prop> midpoint x `elem` (x :: Interval Double) midpoint :: Fractional a => Interval a -> a midpoint (I a b) = a + (b - a) / 2 {-# INLINE midpoint #-} -- | Hausdorff distance between intervals. -- -- >>> distance (1 ... 7) (6 ... 10) -- 0 -- -- >>> distance (1 ... 7) (15 ... 24) -- 8 -- -- >>> distance (1 ... 7) (-10 ... -2) -- 3 -- -- prop> commutative (distance :: Interval Double -> Interval Double -> Double) -- prop> 0 <= distance x y distance :: (Num a, Ord a) => Interval a -> Interval a -> a distance i1 i2 = mignitude (i1 - i2) -- | Determine if a point is in the interval. -- -- >>> member 3.2 (1.0 ... 5.0) -- True -- -- >>> member 5 (1.0 ... 5.0) -- True -- -- >>> member 1 (1.0 ... 5.0) -- True -- -- >>> member 8 (1.0 ... 5.0) -- False member :: Ord a => a -> Interval a -> Bool member x (I a b) = x >= a && x <= b {-# INLINE member #-} -- | Determine if a point is not included in the interval -- -- >>> notMember 8 (1.0 ... 5.0) -- True -- -- >>> notMember 1.4 (1.0 ... 5.0) -- False notMember :: Ord a => a -> Interval a -> Bool notMember x xs = not (member x xs) {-# INLINE notMember #-} -- | Determine if a point is in the interval. -- -- >>> elem 3.2 (1.0 ... 5.0) -- True -- -- >>> elem 5 (1.0 ... 5.0) -- True -- -- >>> elem 1 (1.0 ... 5.0) -- True -- -- >>> elem 8 (1.0 ... 5.0) -- False elem :: Ord a => a -> Interval a -> Bool elem = member {-# INLINE elem #-} {-# DEPRECATED elem "Use `member` instead." #-} -- | Determine if a point is not included in the interval -- -- >>> notElem 8 (1.0 ... 5.0) -- True -- -- >>> notElem 1.4 (1.0 ... 5.0) -- False notElem :: Ord a => a -> Interval a -> Bool notElem = notMember {-# INLINE notElem #-} {-# DEPRECATED notElem "Use `notMember` instead." #-} -- | 'realToFrac' will use the midpoint instance Real a => Real (Interval a) where toRational (I ra rb) = a + (b - a) / 2 where a = toRational ra b = toRational rb {-# INLINE toRational #-} -- @'divNonZero' X Y@ assumes @0 `'notElem'` Y@ divNonZero :: (Fractional a, Ord a) => Interval a -> Interval a -> Interval a divNonZero (I a b) (I a' b') = minimum [a / a', a / b', b / a', b / b'] ... maximum [a / a', a / b', b / a', b / b'] -- @'divPositive' X y@ assumes y > 0, and divides @X@ by [0 ... y] divPositive :: (Fractional a, Ord a) => Interval a -> a -> Interval a divPositive x@(I a b) y | a == 0 && b == 0 = x -- b < 0 || isNegativeZero b = negInfinity ... ( b / y) | b < 0 = negInfinity ... (b / y) | a < 0 = whole | otherwise = (a / y) ... posInfinity {-# INLINE divPositive #-} -- divNegative assumes y < 0 and divides the interval @X@ by [y ... 0] divNegative :: (Fractional a, Ord a) => Interval a -> a -> Interval a divNegative x@(I a b) y | a == 0 && b == 0 = - x -- flip negative zeros -- b < 0 || isNegativeZero b = (b / y) ... posInfinity | b < 0 = (b / y) ... posInfinity | a < 0 = whole | otherwise = negInfinity ... (a / y) {-# INLINE divNegative #-} divZero :: (Fractional a, Ord a) => Interval a -> Interval a divZero x@(I a b) | a == 0 && b == 0 = x | otherwise = whole {-# INLINE divZero #-} -- | Fractional instance for intervals. -- -- prop> ys /= singleton 0 ==> conservative2 ((/) :: Double -> Double -> Double) (/) xs ys -- prop> xs /= singleton 0 ==> conservative (recip :: Double -> Double) recip xs instance (Fractional a, Ord a) => Fractional (Interval a) where -- TODO: check isNegativeZero properly x / y@(I a b) | 0 `notElem` y = divNonZero x y | iz && sz = Exception.throw DivideByZero | iz = divPositive x a | sz = divNegative x b | otherwise = divZero x where iz = a == 0 sz = b == 0 fromRational r = let r' = fromRational r in I r' r' {-# INLINE fromRational #-} instance RealFrac a => RealFrac (Interval a) where properFraction x = (b, x - fromIntegral b) where b = truncate (midpoint x) {-# INLINE properFraction #-} ceiling x = ceiling (sup x) {-# INLINE ceiling #-} floor x = floor (inf x) {-# INLINE floor #-} round x = round (midpoint x) {-# INLINE round #-} truncate x = truncate (midpoint x) {-# INLINE truncate #-} -- | Transcendental functions for intervals. -- -- prop> conservative (exp :: Double -> Double) exp -- prop> conservativeExceptNaN (log :: Double -> Double) log -- prop> conservative (sin :: Double -> Double) sin -- prop> conservative (cos :: Double -> Double) cos -- prop> conservative (tan :: Double -> Double) tan -- prop> conservativeExceptNaN (asin :: Double -> Double) asin -- prop> conservativeExceptNaN (acos :: Double -> Double) acos -- prop> conservative (atan :: Double -> Double) atan -- prop> conservative (sinh :: Double -> Double) sinh -- prop> conservative (cosh :: Double -> Double) cosh -- prop> conservative (tanh :: Double -> Double) tanh -- prop> conservativeExceptNaN (asinh :: Double -> Double) asinh -- prop> conservativeExceptNaN (acosh :: Double -> Double) acosh -- prop> conservativeExceptNaN (atanh :: Double -> Double) atanh -- -- >>> cos (0 ... (pi + 0.1)) -- -1.0 ... 1.0 instance (RealFloat a, Ord a) => Floating (Interval a) where pi = singleton pi {-# INLINE pi #-} exp = increasing exp {-# INLINE exp #-} log (I a b) = (if a > 0 then log a else negInfinity) ... (if b > 0 then log b else negInfinity) {-# INLINE log #-} sin = periodic (2 * pi) (symmetric 1) (signum' . cos) sin cos = periodic (2 * pi) (symmetric 1) (signum' . negate . sin) cos tan = periodic pi whole (const GT) tan -- derivative only has to have correct sign asin (I a b) = (asin' a) ... (asin' b) where asin' x | x >= 1 = halfPi | x <= -1 = -halfPi | otherwise = asin x halfPi = pi / 2 {-# INLINE asin #-} acos (I a b) = (acos' a) ... (acos' b) where acos' x | x >= 1 = 0 | x <= -1 = pi | otherwise = acos x {-# INLINE acos #-} atan = increasing atan {-# INLINE atan #-} sinh = increasing sinh {-# INLINE sinh #-} cosh x@(I a b) | b < 0 = decreasing cosh x | a >= 0 = increasing cosh x | otherwise = I 0 $ cosh $ if - a > b then a else b {-# INLINE cosh #-} tanh = increasing tanh {-# INLINE tanh #-} asinh = increasing asinh {-# INLINE asinh #-} acosh (I a b) = (acosh' a) ... (acosh' b) where acosh' x | x <= 1 = 0 | otherwise = acosh x {-# INLINE acosh #-} atanh (I a b) = (atanh' a) ... (atanh' b) where atanh' x | x <= -1 = negInfinity | x >= 1 = posInfinity | otherwise = atanh x {-# INLINE atanh #-} -- | lift a monotone increasing function over a given interval increasing :: (a -> b) -> Interval a -> Interval b increasing f (I a b) = I (f a) (f b) -- | lift a monotone decreasing function over a given interval decreasing :: (a -> b) -> Interval a -> Interval b decreasing f (I a b) = I (f b) (f a) -- | We have to play some semantic games to make these methods make sense. -- Most compute with the midpoint of the interval. instance RealFloat a => RealFloat (Interval a) where floatRadix = floatRadix . midpoint floatDigits = floatDigits . midpoint floatRange = floatRange . midpoint decodeFloat = decodeFloat . midpoint encodeFloat m e = singleton (encodeFloat m e) exponent = exponent . midpoint significand x = min a b ... max a b where (_ ,em) = decodeFloat (midpoint x) (mi,ei) = decodeFloat (inf x) (ms,es) = decodeFloat (sup x) a = encodeFloat mi (ei - em - floatDigits x) b = encodeFloat ms (es - em - floatDigits x) scaleFloat n (I a b) = I (scaleFloat n a) (scaleFloat n b) isNaN (I a b) = isNaN a || isNaN b isInfinite (I a b) = isInfinite a || isInfinite b isDenormalized (I a b) = isDenormalized a || isDenormalized b -- contains negative zero isNegativeZero (I a b) = not (a > 0) && not (b < 0) && ( (b == 0 && (a < 0 || isNegativeZero a)) || (a == 0 && isNegativeZero a) || (a < 0 && b >= 0)) isIEEE _ = False atan2 = error "unimplemented" -- TODO: (^), (^^) to give tighter bounds -- | Calculate the intersection of two intervals. -- -- >>> intersection (1 ... 10 :: Interval Double) (5 ... 15 :: Interval Double) -- Just (5.0 ... 10.0) intersection :: Ord a => Interval a -> Interval a -> Maybe (Interval a) intersection x@(I a b) y@(I a' b') | x /=! y = Nothing | otherwise = Just $ I (max a a') (min b b') {-# INLINE intersection #-} -- | Calculate the convex hull of two intervals -- -- >>> hull (0 ... 10 :: Interval Double) (5 ... 15 :: Interval Double) -- 0.0 ... 15.0 -- -- >>> hull (15 ... 85 :: Interval Double) (0 ... 10 :: Interval Double) -- 0.0 ... 85.0 -- -- prop> conservative2 const hull -- prop> conservative2 (flip const) hull hull :: Ord a => Interval a -> Interval a -> Interval a hull (I a b) (I a' b') = I (min a a') (max b b') {-# INLINE hull #-} -- | For all @x@ in @X@, @y@ in @Y@. @x '<' y@ -- -- >>> (5 ... 10 :: Interval Double) >> (5 ... 10 :: Interval Double) >> (20 ... 30 :: Interval Double) Interval a -> Interval a -> Bool I _ bx >> (5 ... 10 :: Interval Double) <=! (20 ... 30 :: Interval Double) -- True -- -- >>> (5 ... 10 :: Interval Double) <=! (10 ... 30 :: Interval Double) -- True -- -- >>> (20 ... 30 :: Interval Double) <=! (5 ... 10 :: Interval Double) -- False (<=!) :: Ord a => Interval a -> Interval a -> Bool I _ bx <=! I ay _ = bx <= ay {-# INLINE (<=!) #-} -- | For all @x@ in @X@, @y@ in @Y@. @x '==' y@ -- -- Only singleton intervals or empty intervals can return true -- -- >>> (singleton 5 :: Interval Double) ==! (singleton 5 :: Interval Double) -- True -- -- >>> (5 ... 10 :: Interval Double) ==! (5 ... 10 :: Interval Double) -- False (==!) :: Eq a => Interval a -> Interval a -> Bool I ax bx ==! I ay by = bx == ay && ax == by {-# INLINE (==!) #-} -- | For all @x@ in @X@, @y@ in @Y@. @x '/=' y@ -- -- >>> (5 ... 15 :: Interval Double) /=! (20 ... 40 :: Interval Double) -- True -- -- >>> (5 ... 15 :: Interval Double) /=! (15 ... 40 :: Interval Double) -- False (/=!) :: Ord a => Interval a -> Interval a -> Bool I ax bx /=! I ay by = bx < ay || ax > by {-# INLINE (/=!) #-} -- | For all @x@ in @X@, @y@ in @Y@. @x '>' y@ -- -- >>> (20 ... 40 :: Interval Double) >! (10 ... 19 :: Interval Double) -- True -- -- >>> (5 ... 20 :: Interval Double) >! (15 ... 40 :: Interval Double) -- False (>!) :: Ord a => Interval a -> Interval a -> Bool I ax _ >! I _ by = ax > by {-# INLINE (>!) #-} -- | For all @x@ in @X@, @y@ in @Y@. @x '>=' y@ -- -- >>> (20 ... 40 :: Interval Double) >=! (10 ... 20 :: Interval Double) -- True -- -- >>> (5 ... 20 :: Interval Double) >=! (15 ... 40 :: Interval Double) -- False (>=!) :: Ord a => Interval a -> Interval a -> Bool I ax _ >=! I _ by = ax >= by {-# INLINE (>=!) #-} -- | For all @x@ in @X@, @y@ in @Y@. @x `op` y@ certainly :: Ord a => (forall b. Ord b => b -> b -> Bool) -> Interval a -> Interval a -> Bool certainly cmp l r | lt && eq && gt = True | lt && eq = l <=! r | lt && gt = l /=! r | lt = l =! r | eq = l ==! r | gt = l >! r | otherwise = False where lt = cmp False True eq = cmp True True gt = cmp True False {-# INLINE certainly #-} -- | Check if interval @X@ totally contains interval @Y@ -- -- >>> (20 ... 40 :: Interval Double) `contains` (25 ... 35 :: Interval Double) -- True -- -- >>> (20 ... 40 :: Interval Double) `contains` (15 ... 35 :: Interval Double) -- False contains :: Ord a => Interval a -> Interval a -> Bool contains (I ax bx) (I ay by) = ax <= ay && by <= bx {-# INLINE contains #-} -- | Flipped version of `contains`. Check if interval @X@ a subset of interval @Y@ -- -- >>> (25 ... 35 :: Interval Double) `isSubsetOf` (20 ... 40 :: Interval Double) -- True -- -- >>> (20 ... 40 :: Interval Double) `isSubsetOf` (15 ... 35 :: Interval Double) -- False isSubsetOf :: Ord a => Interval a -> Interval a -> Bool isSubsetOf = flip contains {-# INLINE isSubsetOf #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<' y@? ( Interval a -> Interval a -> Bool I ax _ Interval a -> Interval a -> Bool I ax _ <=? I _ by = ax <= by {-# INLINE (<=?) #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '==' y@? (==?) :: Ord a => Interval a -> Interval a -> Bool I ax bx ==? I ay by = ax <= by && bx >= ay {-# INLINE (==?) #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '/=' y@? (/=?) :: Eq a => Interval a -> Interval a -> Bool I ax bx /=? I ay by = ax /= by || bx /= ay {-# INLINE (/=?) #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>' y@? (>?) :: Ord a => Interval a -> Interval a -> Bool I _ bx >? I ay _ = bx > ay {-# INLINE (>?) #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>=' y@? (>=?) :: Ord a => Interval a -> Interval a -> Bool I _ bx >=? I ay _ = bx >= ay {-# INLINE (>=?) #-} -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x `op` y@? possibly :: Ord a => (forall b. Ord b => b -> b -> Bool) -> Interval a -> Interval a -> Bool possibly cmp l r | lt && eq && gt = True | lt && eq = l <=? r | lt && gt = l /=? r | lt = l =? r | eq = l ==? r | gt = l >? r | otherwise = False where lt = cmp LT EQ eq = cmp EQ EQ gt = cmp GT EQ {-# INLINE possibly #-} -- | The nearest value to that supplied which is contained in the interval. -- -- prop> (clamp xs y) `elem` xs clamp :: Ord a => Interval a -> a -> a clamp (I a b) x | x < a = a | x > b = b | otherwise = x -- | Inflate an interval by enlarging it at both ends. -- -- >>> inflate 3 (-1 ... 7) -- -4 ... 10 -- -- >>> inflate (-2) (0 ... 4) -- -2 ... 6 -- -- prop> inflate x i `contains` i inflate :: (Num a, Ord a) => a -> Interval a -> Interval a inflate x y = symmetric x + y -- | Deflate an interval by shrinking it from both ends. -- Note that in cases that would result in an empty interval, the result is a singleton interval at the midpoint. -- -- >>> deflate 3.0 (-4.0 ... 10.0) -- -1.0 ... 7.0 -- -- >>> deflate 2.0 (-1.0 ... 1.0) -- 0.0 ... 0.0 deflate :: (Fractional a, Ord a) => a -> Interval a -> Interval a deflate x i@(I a b) | a' <= b' = I a' b' | otherwise = singleton m where a' = a + x b' = b - x m = midpoint i -- | Scale an interval about its midpoint. -- -- >>> scale 1.1 (-6.0 ... 4.0) -- -6.5 ... 4.5 -- -- >>> scale (-2.0) (-1.0 ... 1.0) -- -2.0 ... 2.0 -- -- prop> abs x >= 1 ==> (scale (x :: Double) i) `contains` i -- prop> forAll (choose (0,1)) $ \x -> abs x <= 1 ==> i `contains` (scale (x :: Double) i) scale :: (Fractional a, Ord a) => a -> Interval a -> Interval a scale x i = a ... b where h = x * width i / 2 mid = midpoint i a = mid - h b = mid + h -- | Construct a symmetric interval. -- -- >>> symmetric 3 -- -3 ... 3 -- -- >>> symmetric (-2) -- -2 ... 2 -- -- prop> x `elem` symmetric x -- prop> 0 `elem` symmetric x symmetric :: (Num a, Ord a) => a -> Interval a symmetric x = negate x ... x -- | id function. Useful for type specification -- -- >>> :t idouble (1 ... 3) -- idouble (1 ... 3) :: Interval Double idouble :: Interval Double -> Interval Double idouble = id -- | id function. Useful for type specification -- -- >>> :t ifloat (1 ... 3) -- ifloat (1 ... 3) :: Interval Float ifloat :: Interval Float -> Interval Float ifloat = id -- Bugs: -- sin 1 :: Interval Double default (Integer,Double) -- | an interval containing all x `quot` y -- prop> forAll (memberOf xs) $ \ x -> forAll (memberOf ys) $ \ y -> 0 `notMember` ys ==> (x `quot` y) `member` (xs `iquot` ys) -- prop> 0 `member` ys ==> ioProperty $ do z <- try (evaluate (xs `iquot` ys)); return $ z === Left DivideByZero iquot :: Integral a => Interval a -> Interval a -> Interval a iquot (I l u) (I l' u') = if l' <= 0 && 0 <= u' then throw DivideByZero else I (minimum [a `quot` b | a <- [l,u], b <- [l',u']]) (maximum [a `quot` b | a <- [l,u], b <- [l',u']]) -- | an interval containing all x `rem` y -- prop> forAll (memberOf xs) $ \ x -> forAll (memberOf ys) $ \ y -> 0 `notMember` ys ==> (x `rem` y) `member` (xs `irem` ys) -- prop> 0 `member` ys ==> ioProperty $ do z <- try (evaluate (xs `irem` ys)); return $ z === Left DivideByZero irem :: Integral a => Interval a -> Interval a -> Interval a irem (I l u) (I l' u') = if l' <= 0 && 0 <= u' then throw DivideByZero else I (minimum [0, signum l * (abs u' - 1), signum l * (abs l' - 1)]) (maximum [0, signum u * (abs u' - 1), signum u * (abs l' - 1)]) -- | an interval containing all x `div` y -- prop> forAll (memberOf xs) $ \ x -> forAll (memberOf ys) $ \ y -> 0 `notMember` ys ==> (x `div` y) `member` (xs `idiv` ys) -- prop> 0 `member` ys ==> ioProperty $ do z <- try (evaluate (xs `idiv` ys)); return $ z === Left DivideByZero idiv :: Integral a => Interval a -> Interval a -> Interval a idiv (I l u) (I l' u') = if l' <= 0 && 0 <= u' then throw DivideByZero else I (min (l `Prelude.div` max 1 l') (u `Prelude.div` min (-1) u')) (max (u `Prelude.div` max 1 l') (l `Prelude.div` min (-1) u')) -- | an interval containing all x `mod` y -- prop> forAll (memberOf xs) $ \ x -> forAll (memberOf ys) $ \ y -> 0 `notMember` ys ==> (x `mod` y) `member` (xs `imod` ys) -- prop> 0 `member` ys ==> ioProperty $ do z <- try (evaluate (xs `imod` ys)); return $ z === Left DivideByZero imod :: Integral a => Interval a -> Interval a -> Interval a imod _ (I l' u') = if l' <= 0 && 0 <= u' then throw DivideByZero else I (min (l'+1) 0) (max 0 (u'-1)) intervals-0.9.2/tests/0000755000000000000000000000000007346545000013064 5ustar0000000000000000intervals-0.9.2/tests/doctests.hs0000644000000000000000000000122707346545000015252 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Main (doctests) -- Copyright : (C) 2012-14 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- This module exists to add dependencies ----------------------------------------------------------------------------- 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"