intervals-0.8.1/0000755000000000000000000000000013136746572011733 5ustar0000000000000000intervals-0.8.1/intervals.cabal0000644000000000000000000000455313136746572014735 0ustar0000000000000000name: intervals version: 0.8.1 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: Custom cabal-version: >=1.8 tested-with: GHC == 7.4.2, GHC == 7.6.1, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.1 extra-source-files: .travis.yml CHANGELOG.markdown README.markdown HLint.hs Warning.hs source-repository head type: git location: git://github.com/ekmett/intervals.git custom-setup setup-depends: base >= 4 && <5, Cabal, cabal-doctest >= 1 && <1.1 -- You can disable the doctests test suite with -f-test-doctests flag test-doctests description: Enable (or disable via f-test-doctests) the doctest suite when using the enable-tests option for cabal. default: True manual: True 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 ghc-options: -Wall -O2 if flag(herbie) build-depends: HerbiePlugin >= 0.1 && < 0.2 cpp-options: -DHERBIE ghc-options: -fplugin=Herbie test-suite doctests type: exitcode-stdio-1.0 main-is: doctests.hs ghc-options: -Wall -threaded hs-source-dirs: tests if !flag(test-doctests) buildable: False else build-depends: base, directory >= 1.0, doctest >= 0.11.1 && <0.13, filepath, intervals, QuickCheck, template-haskell intervals-0.8.1/CHANGELOG.markdown0000644000000000000000000000310413136746572014764 0ustar00000000000000000.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.8.1/README.markdown0000644000000000000000000000073613136746572014442 0ustar0000000000000000intervals ========== [![Hackage](https://img.shields.io/hackage/v/intervals.svg)](https://hackage.haskell.org/package/intervals) [![Build Status](https://secure.travis-ci.org/ekmett/intervals.svg?branch=master)](http://travis-ci.org/ekmett/intervals) 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.8.1/Setup.lhs0000644000000000000000000000124113136746572013541 0ustar0000000000000000\begin{code} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} module Main (main) where #ifndef MIN_VERSION_cabal_doctest #define MIN_VERSION_cabal_doctest(x,y,z) 0 #endif #if MIN_VERSION_cabal_doctest(1,0,0) import Distribution.Extra.Doctest ( defaultMainWithDoctests ) main :: IO () main = defaultMainWithDoctests "doctests" #else #ifdef MIN_VERSION_Cabal -- If the macro is defined, we have new cabal-install, -- but for some reason we don't have cabal-doctest in package-db -- -- Probably we are running cabal sdist, when otherwise using new-build -- workflow import Warning () #endif import Distribution.Simple main :: IO () main = defaultMain #endif \end{code} intervals-0.8.1/Warning.hs0000644000000000000000000000040013136746572013666 0ustar0000000000000000module Warning {-# WARNING ["You are configuring this package without cabal-doctest installed.", "The doctests test-suite will not work as a result.", "To fix this, install cabal-doctest before configuring."] #-} () where intervals-0.8.1/.travis.yml0000644000000000000000000001032713136746572014047 0ustar0000000000000000# This file has been generated -- see https://github.com/hvr/multi-ghc-travis language: c sudo: false cache: directories: - $HOME/.cabsnap - $HOME/.cabal/packages before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar matrix: include: - env: CABALVER=1.24 GHCVER=7.0.4 compiler: ": #GHC 7.0.4" addons: {apt: {packages: [cabal-install-1.24,ghc-7.0.4], sources: [hvr-ghc]}} - env: CABALVER=1.24 GHCVER=7.2.2 compiler: ": #GHC 7.2.2" addons: {apt: {packages: [cabal-install-1.24,ghc-7.2.2], sources: [hvr-ghc]}} - env: CABALVER=1.24 GHCVER=7.4.2 compiler: ": #GHC 7.4.2" addons: {apt: {packages: [cabal-install-1.24,ghc-7.4.2], sources: [hvr-ghc]}} - env: CABALVER=1.24 GHCVER=7.6.3 compiler: ": #GHC 7.6.3" addons: {apt: {packages: [cabal-install-1.24,ghc-7.6.3], sources: [hvr-ghc]}} - env: CABALVER=1.24 GHCVER=7.8.4 compiler: ": #GHC 7.8.4" addons: {apt: {packages: [cabal-install-1.24,ghc-7.8.4], sources: [hvr-ghc]}} - env: CABALVER=1.24 GHCVER=7.10.3 compiler: ": #GHC 7.10.3" addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.3], sources: [hvr-ghc]}} - env: CABALVER=1.24 GHCVER=8.0.2 compiler: ": #GHC 8.0.2" addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2], sources: [hvr-ghc]}} - env: CABALVER=2.0 GHCVER=8.2.1 compiler: ": #GHC 8.2.1" addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.1], sources: [hvr-ghc]}} - env: CABALVER=head GHCVER=head compiler: ": #GHC head" addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} allow_failures: - env: CABALVER=1.24 GHCVER=7.0.4 - env: CABALVER=1.24 GHCVER=7.2.2 - env: CABALVER=head GHCVER=head before_install: - unset CC - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH install: - cabal --version - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; then zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > $HOME/.cabal/packages/hackage.haskell.org/00-index.tar; fi - travis_retry cabal update -v - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - cabal install --only-dependencies --enable-tests --dry -v > installplan.txt - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt # check whether current requested install-plan matches cached package-db snapshot - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; then echo "cabal build-cache HIT"; rm -rfv .ghc; cp -a $HOME/.cabsnap/ghc $HOME/.ghc; cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; else echo "cabal build-cache MISS"; rm -rf $HOME/.cabsnap; mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; cabal install -j --only-dependencies --enable-tests; fi # snapshot package-db on cache miss - if [ ! -d $HOME/.cabsnap ]; then echo "snapshotting package-db to build-cache"; mkdir $HOME/.cabsnap; cp -a $HOME/.ghc $HOME/.cabsnap/ghc; cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; fi # Here starts the actual work to be performed for the package under # test; any command which exits with a non-zero exit code causes the # build to fail. script: # -v2 provides useful information for debugging - cabal configure --enable-tests -v2 # this builds all libraries and executables # (including tests/benchmarks) - cabal build # tests that a source-distribution can be generated - cabal sdist # check that the generated source-distribution can be built & installed - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ; cd dist/; if [ -f "$SRC_TGZ" ]; then cabal install --force-reinstalls "$SRC_TGZ"; else echo "expected '$SRC_TGZ' not found"; exit 1; fi notifications: irc: channels: - "irc.freenode.org#haskell-lens" skip_join: true template: - "\x0313intervals\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" # EOF intervals-0.8.1/LICENSE0000644000000000000000000000245613136746572012747 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.8.1/HLint.hs0000644000000000000000000000032713136746572013307 0ustar0000000000000000import "hint" HLint.HLint -- not viable ignore "Reduce duplication" -- don't want to! ignore "Use infix" -- these don't consider the corner cases when using doubles ignore "Use >" ignore "Use <=" ignore "Use >=" intervals-0.8.1/src/0000755000000000000000000000000013136746572012522 5ustar0000000000000000intervals-0.8.1/src/Numeric/0000755000000000000000000000000013136746572014124 5ustar0000000000000000intervals-0.8.1/src/Numeric/Interval.hs0000644000000000000000000000173213136746572016247 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.8.1/src/Numeric/Interval/0000755000000000000000000000000013136746572015710 5ustar0000000000000000intervals-0.8.1/src/Numeric/Interval/Kaucher.hs0000644000000000000000000005531413136746572017636 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.Monoid import Data.Traversable #if __GLASGOW_HASKELL__ >= 704 import GHC.Generics #endif import Numeric.Interval.Exception import Prelude hiding (null, elem, notElem) -- $setup data Interval a = I !a !a deriving ( Eq, Ord , Data , Typeable #if __GLASGOW_HASKELL__ >= 704 , Generic #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif #endif ) 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 `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 :: 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.8.1/src/Numeric/Interval/NonEmpty.hs0000644000000000000000000000220013136746572020007 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.8.1/src/Numeric/Interval/Exception.hs0000644000000000000000000000106713136746572020206 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.8.1/src/Numeric/Interval/Internal.hs0000644000000000000000000005776013136746572020037 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.Foldable hiding (minimum, maximum, elem, notElem #if __GLASGOW_HASKELL__ >= 710 , null #endif ) import Data.Function (on) import Data.Monoid #if __GLASGOW_HASKELL__ >= 704 import GHC.Generics #endif import Numeric.Interval.Exception import Prelude hiding (null, elem, notElem) -- $setup data Interval a = I !a !a | Empty deriving ( Eq, Ord , Data , Typeable #if __GLASGOW_HASKELL__ >= 704 , Generic #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif #endif ) instance Foldable Interval where foldMap f (I a b) = f a `mappend` f b foldMap _ Empty = mempty {-# INLINE foldMap #-} 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.8.1/src/Numeric/Interval/NonEmpty/0000755000000000000000000000000013136746572017461 5ustar0000000000000000intervals-0.8.1/src/Numeric/Interval/NonEmpty/Internal.hs0000644000000000000000000006455613136746572021611 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 import Data.Foldable hiding (minimum, maximum, elem, notElem) import Data.Monoid #if __GLASGOW_HASKELL__ >= 704 import GHC.Generics #endif import Numeric.Interval.Exception import Prelude hiding (null, elem, notElem) -- $setup -- >>> import Test.QuickCheck.Arbitrary -- >>> import Test.QuickCheck.Gen hiding (scale) -- >>> import Test.QuickCheck.Property -- >>> import Control.Applicative -- >>> :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) data Interval a = I !a !a deriving ( Eq, Ord , Data , Typeable #if __GLASGOW_HASKELL__ >= 704 , Generic #if __GLASGOW_HASKELL__ >= 706 , Generic1 #endif #endif ) instance Foldable Interval where foldMap f (I a b) = f a `mappend` f b {-# INLINE foldMap #-} 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.8.1/tests/0000755000000000000000000000000013136746572013075 5ustar0000000000000000intervals-0.8.1/tests/doctests.hs0000644000000000000000000000147213136746572015265 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 provides doctests for a project based on the actual versions -- of the packages it was built with. It requires a corresponding Setup.lhs -- to be added to the project ----------------------------------------------------------------------------- module Main where import Build_doctests (flags, pkgs, module_sources) import Data.Foldable (traverse_) import Test.DocTest main :: IO () main = do traverse_ putStrLn args doctest args where args = flags ++ pkgs ++ module_sources