intervals-0.9.1/0000755000000000000000000000000007346545000011721 5ustar0000000000000000intervals-0.9.1/.hlint.yaml0000755000000000000000000000043307346545000014004 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.1/.travis.yml0000755000000000000000000002167107346545000014044 0ustar0000000000000000# This Travis job script has been generated by a script via # # haskell-ci '--output=.travis.yml' '--config=cabal.haskell-ci' 'cabal.project' # # For more information, see https://github.com/haskell-CI/haskell-ci # # version: 0.5.20180830 # language: c dist: xenial git: # whether to recursively clone submodules submodules: false notifications: irc: channels: - irc.freenode.org#haskell-lens skip_join: true template: - "\"\\x0313intervals\\x03/\\x0306%{branch}\\x03 \\x0314%{commit}\\x03 %{build_url} %{message}\"" cache: directories: - $HOME/.cabal/packages - $HOME/.cabal/store before_cache: - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log # remove files that are regenerated by 'cabal update' - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.* - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx - rm -rfv $CABALHOME/packages/head.hackage matrix: include: - compiler: ghc-8.8.1 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}} - compiler: ghc-8.6.5 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-3.0"]}} - compiler: ghc-8.4.4 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-3.0"]}} - compiler: ghc-8.2.2 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-3.0"]}} - compiler: ghc-8.0.2 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-3.0"]}} - compiler: ghc-7.10.3 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-3.0"]}} - compiler: ghc-7.8.4 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-3.0"]}} - compiler: ghc-7.6.3 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.6.3","cabal-install-3.0"]}} - compiler: ghc-7.4.2 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.4.2","cabal-install-3.0"]}} - compiler: ghc-7.2.2 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.2.2","cabal-install-3.0"]}} - compiler: ghc-7.0.4 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.0.4","cabal-install-3.0"]}} - compiler: ghc-head addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-head","cabal-install-head"]}} allow_failures: - compiler: ghc-head - compiler: ghc-7.0.4 - compiler: ghc-7.2.2 before_install: - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') - WITHCOMPILER="-w $HC" - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//') - HCPKG="$HC-pkg" - unset CC - CABAL=/opt/ghc/bin/cabal - CABALHOME=$HOME/.cabal - export PATH="$CABALHOME/bin:$PATH" - TOP=$(pwd) - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')" - echo $HCNUMVER - CABAL="$CABAL -vnormal+nowrap+markoutput" - set -o pipefail - | echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk echo 'BEGIN { state = "output"; }' >> .colorful.awk echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk echo ' if (state == "cabal") {' >> .colorful.awk echo ' print blue($0)' >> .colorful.awk echo ' } else {' >> .colorful.awk echo ' print $0' >> .colorful.awk echo ' }' >> .colorful.awk echo '}' >> .colorful.awk - cat .colorful.awk - | color_cabal_output () { awk -f $TOP/.colorful.awk } - echo text | color_cabal_output install: - ${CABAL} --version - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - TEST=--enable-tests - if [ $HCNUMVER -lt 70600 ] ; then TEST=--disable-tests ; fi - BENCH=--enable-benchmarks - HEADHACKAGE=false - if [ $HCNUMVER -gt 80801 ] ; then HEADHACKAGE=true ; fi - rm -f $CABALHOME/config - | echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config echo "remote-build-reporting: anonymous" >> $CABALHOME/config echo "write-ghc-environment-files: always" >> $CABALHOME/config echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config echo "world-file: $CABALHOME/world" >> $CABALHOME/config echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config echo "installdir: $CABALHOME/bin" >> $CABALHOME/config echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config echo "store-dir: $CABALHOME/store" >> $CABALHOME/config echo "install-dirs user" >> $CABALHOME/config echo " prefix: $CABALHOME" >> $CABALHOME/config echo "repository hackage.haskell.org" >> $CABALHOME/config echo " url: http://hackage.haskell.org/" >> $CABALHOME/config - | if $HEADHACKAGE; then echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1/g')" >> $CABALHOME/config echo "repository head.hackage.ghc.haskell.org" >> $CABALHOME/config echo " url: https://ghc.gitlab.haskell.org/head.hackage/" >> $CABALHOME/config echo " secure: True" >> $CABALHOME/config echo " root-keys: 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d" >> $CABALHOME/config echo " 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329" >> $CABALHOME/config echo " f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89" >> $CABALHOME/config echo " key-threshold: 3" >> $CABALHOME/config fi - cat $CABALHOME/config - rm -fv cabal.project cabal.project.local cabal.project.freeze - travis_retry ${CABAL} v2-update -v # Generate cabal.project - rm -rf cabal.project cabal.project.local cabal.project.freeze - touch cabal.project - | echo "packages: ." >> cabal.project - | - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(intervals)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" - rm cabal.project.freeze - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output script: - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) # Packaging... - ${CABAL} v2-sdist all | color_cabal_output # Unpacking... - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ - cd ${DISTDIR} || false - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \; - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \; - PKGDIR_intervals="$(find . -maxdepth 1 -type d -regex '.*/intervals-[0-9.]*')" # Generate cabal.project - rm -rf cabal.project cabal.project.local cabal.project.freeze - touch cabal.project - | echo "packages: ${PKGDIR_intervals}" >> cabal.project - | - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(intervals)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true # Building with tests and benchmarks... # build & run tests, build benchmarks - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output # Testing... - if [ $HCNUMVER -ge 70600 ] ; then ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output ; fi # cabal check... - (cd ${PKGDIR_intervals} && ${CABAL} -vnormal check) # haddock... - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all | color_cabal_output # REGENDATA ["--output=.travis.yml","--config=cabal.haskell-ci","cabal.project"] # EOF intervals-0.9.1/CHANGELOG.markdown0000755000000000000000000000373007346545000014762 0ustar00000000000000000.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.1/LICENSE0000644000000000000000000000245607346545000012735 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.1/README.markdown0000755000000000000000000000073607346545000014433 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.9.1/Setup.lhs0000644000000000000000000000124107346545000013527 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.9.1/Warning.hs0000755000000000000000000000040007346545000013657 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.9.1/intervals.cabal0000644000000000000000000000531507346545000014720 0ustar0000000000000000name: intervals version: 0.9.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.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.1 extra-source-files: .hlint.yaml .travis.yml CHANGELOG.markdown README.markdown 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 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 test-suite doctests type: exitcode-stdio-1.0 main-is: doctests.hs ghc-options: -Wall -threaded hs-source-dirs: tests if !flag(test-doctests) || !impl(ghc >= 7.6) buildable: False else build-depends: base >= 4.6, directory >= 1.0, doctest >= 0.11.1 && < 0.17, filepath, intervals, QuickCheck, template-haskell intervals-0.9.1/src/Numeric/0000755000000000000000000000000007346545000014112 5ustar0000000000000000intervals-0.9.1/src/Numeric/Interval.hs0000644000000000000000000000173207346545000016235 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.1/src/Numeric/Interval/0000755000000000000000000000000007346545000015676 5ustar0000000000000000intervals-0.9.1/src/Numeric/Interval/Exception.hs0000644000000000000000000000106707346545000020174 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.1/src/Numeric/Interval/Internal.hs0000644000000000000000000006000707346545000020011 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 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.1/src/Numeric/Interval/Kaucher.hs0000644000000000000000000005572307346545000017630 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 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.1/src/Numeric/Interval/NonEmpty.hs0000644000000000000000000000220007346545000017775 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.1/src/Numeric/Interval/NonEmpty/0000755000000000000000000000000007346545000017447 5ustar0000000000000000intervals-0.9.1/src/Numeric/Interval/NonEmpty/Internal.hs0000644000000000000000000006445107346545000021571 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 -- >>> :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 ) -- | '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.1/tests/0000755000000000000000000000000007346545000013063 5ustar0000000000000000intervals-0.9.1/tests/doctests.hs0000644000000000000000000000147207346545000015253 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