intervals 0.7.2 → 0.9.3
raw patch · 15 files changed
Files
- .hlint.yaml +12/−0
- .travis.yml +0/−1
- CHANGELOG.markdown +37/−0
- HLint.hs +0/−12
- README.markdown +1/−1
- Setup.lhs +4/−52
- intervals.cabal +25/−29
- src/Numeric/Interval.hs +8/−2
- src/Numeric/Interval/Exception.hs +2/−2
- src/Numeric/Interval/Internal.hs +121/−54
- src/Numeric/Interval/Kaucher.hs +113/−43
- src/Numeric/Interval/NonEmpty.hs +8/−5
- src/Numeric/Interval/NonEmpty/Internal.hs +96/−49
- tests/doctests.hs +19/−0
- tests/doctests.hsc +0/−76
+ .hlint.yaml view
@@ -0,0 +1,12 @@+- 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 >="}
− .travis.yml
@@ -1,1 +0,0 @@-language: haskell
CHANGELOG.markdown view
@@ -1,3 +1,40 @@+0.9.3 [2024.12.04]+------------------+* Drop support for pre-8.0 versions of GHC.++0.9.2 [2021.02.17]+------------------+* Export `(/=!)` and `(/=?)` operators.+* The build-type has been changed from `Custom` to `Simple`.+ To achieve this, the `doctests` test suite has been removed in favor of using+ [`cabal-docspec`](https://github.com/phadej/cabal-extras/tree/master/cabal-docspec)+ to run the doctests.++0.9.1 [2020.01.29]+------------------+* Add `Semigroup` instances for the `Interval` types in `Numeric.Interval`,+ `Numeric.Interval.Kaucher`, and `Numeric.Interval.NonEmpty`.+ Add a `Monoid` instance for the `Interval` type in `Numeric.Interval`.++0.9 [2019.05.10]+----------------+* Remove the `Foldable` instances for the `Interval` types from+ `Numeric.Interval` and `Numeric.Interval.NonEmpty`.++0.8.1+-----+* Support `doctest-0.12`++0.8+---+* `Eq` and `Ord` instances are now structural+* Deprecate `elem` and `notElem` in favor of `member` and `nonMember`+* Add `iquot`, `irem`, `idiv`, and `imod` functions+* Relax `Fractional` constraint in `deflate` to `Num`+* Revamp `Setup.hs` to use `cabal-doctest`. This makes it build+ with `Cabal-2.0`, and makes the `doctest`s work with `cabal new-build` and+ sandboxes.+ 0.7.2 ----- * Redundant constraint cleanup
− HLint.hs
@@ -1,12 +0,0 @@-import "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 >="
README.markdown view
@@ -1,7 +1,7 @@ intervals ========== -[](https://hackage.haskell.org/package/intervals) [](http://travis-ci.org/ekmett/intervals)+[](https://hackage.haskell.org/package/intervals) [](https://github.com/ekmett/intervals/actions?query=workflow%3AHaskell-CI) Basic interval arithmetic
Setup.lhs view
@@ -1,55 +1,7 @@ #!/usr/bin/runhaskell-\begin{code}-{-# OPTIONS_GHC -Wall #-}-module Main (main) where--import Data.List ( nub )-import Data.Version ( showVersion )-import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName )-import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )-import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )-import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )-import Distribution.Simple.BuildPaths ( autogenModulesDir )-import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))-import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )-import Distribution.Text ( display )-import Distribution.Verbosity ( Verbosity, normal )-import System.FilePath ( (</>) )--main :: IO ()-main = defaultMainWithHooks simpleUserHooks- { buildHook = \pkg lbi hooks flags -> do- generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi- buildHook simpleUserHooks pkg lbi hooks flags- , postHaddock = \args flags pkg lbi -> do- copyFiles normal (haddockOutputDir flags pkg) []- postHaddock simpleUserHooks args flags pkg lbi- }--haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath-haddockOutputDir flags pkg = destDir where- baseDir = case haddockDistPref flags of- NoFlag -> "."- Flag x -> x- destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)--generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()-generateBuildModule verbosity pkg lbi = do- let dir = autogenModulesDir lbi- createDirectoryIfMissingVerbose verbosity True dir- withLibLBI pkg lbi $ \_ libcfg -> do- withTestLBI pkg lbi $ \suite suitecfg -> do- rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines- [ "module Build_" ++ testName suite ++ " where"- , "deps :: [String]"- , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))- ]- where- formatdeps = map (formatone . snd)- formatone p = case packageName p of- PackageName n -> n ++ "-" ++ showVersion (packageVersion p)+> module Main (main) where -testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]-testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys+> import Distribution.Simple -\end{code}+> main :: IO ()+> main = defaultMain
intervals.cabal view
@@ -1,5 +1,5 @@ name: intervals-version: 0.7.2+version: 0.9.3 synopsis: Interval Arithmetic description: A 'Numeric.Interval.Interval' is a closed, convex set of floating point values.@@ -15,26 +15,29 @@ 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, GHC == 8.0.1+build-type: Simple+cabal-version: >=1.10+tested-with: GHC == 8.0.2+ , GHC == 8.2.2+ , GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.4+ , GHC == 8.10.7+ , GHC == 9.0.2+ , GHC == 9.2.8+ , GHC == 9.4.8+ , GHC == 9.6.6+ , GHC == 9.8.4+ , GHC == 9.10.1 extra-source-files:- .travis.yml+ .hlint.yaml CHANGELOG.markdown README.markdown- HLint.hs source-repository head type: git location: git://github.com/ekmett/intervals.git --- 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@@ -52,11 +55,9 @@ build-depends: array >= 0.3 && < 0.6,- base >= 4 && < 5,- distributive >= 0.2 && < 1-- if impl(ghc >=7.4)- build-depends: ghc-prim+ base >= 4.9 && < 5,+ distributive >= 0.2 && < 1,+ ghc-prim ghc-options: -Wall -O2 @@ -65,20 +66,15 @@ cpp-options: -DHERBIE ghc-options: -fplugin=Herbie + default-language: Haskell2010+ x-docspec-options: --check-properties+ x-docspec-property-variables: i x y xs ys test-suite doctests type: exitcode-stdio-1.0 main-is: doctests.hs ghc-options: -Wall -threaded hs-source-dirs: tests-- if !flag(test-doctests) || impl(ghc >= 8)- buildable: False- else- build-depends:- base,- directory >= 1.0,- doctest >= 0.9.1,- filepath,- QuickCheck,- template-haskell+ build-depends: base >= 4.9 && < 5+ , QuickCheck >=2.14.2+ default-language: Haskell2010
src/Numeric/Interval.hs view
@@ -18,6 +18,8 @@ , empty , null , singleton+ , member+ , notMember , elem , notElem , inf@@ -36,10 +38,14 @@ , scale, symmetric , contains , isSubsetOf- , certainly, (<!), (<=!), (==!), (>=!), (>!)- , possibly, (<?), (<=?), (==?), (>=?), (>?)+ , certainly, (<!), (<=!), (==!), (/=!), (>=!), (>!)+ , possibly, (<?), (<=?), (==?), (/=?), (>=?), (>?) , idouble , ifloat+ , iquot+ , irem+ , idiv+ , imod ) where import Numeric.Interval.Internal
src/Numeric/Interval/Exception.hs view
@@ -8,7 +8,7 @@ import Data.Data data EmptyInterval = EmptyInterval- deriving (Eq,Ord,Typeable,Data)+ deriving (Eq,Ord,Data) instance Show EmptyInterval where show EmptyInterval = "empty interval"@@ -16,7 +16,7 @@ instance Exception EmptyInterval data AmbiguousComparison = AmbiguousComparison- deriving (Eq,Ord,Typeable,Data)+ deriving (Eq,Ord,Data) instance Show AmbiguousComparison where show AmbiguousComparison = "ambiguous comparison"
src/Numeric/Interval/Internal.hs view
@@ -1,9 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE DeriveDataTypeable #-}-#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE DeriveGeneric #-}-#endif {-# OPTIONS_HADDOCK not-home #-} ----------------------------------------------------------------------------- -- |@@ -26,6 +24,8 @@ , empty , null , singleton+ , member+ , notMember , elem , notElem , inf@@ -44,45 +44,43 @@ , scale, symmetric , contains , isSubsetOf- , certainly, (<!), (<=!), (==!), (>=!), (>!)- , possibly, (<?), (<=?), (==?), (>=?), (>?)+ , 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) +import qualified Data.Semigroup+import qualified Data.Monoid+ -- $setup+-- >>> :set -Wno-deprecations+-- >>> let null = Numeric.Interval.Internal.null+-- >>> let elem = Numeric.Interval.Internal.elem+-- >>> let notElem = Numeric.Interval.Internal.notElem data Interval a = I !a !a | Empty deriving- ( Data- , Typeable-#if __GLASGOW_HASKELL__ >= 704- , Generic-#if __GLASGOW_HASKELL__ >= 706- , Generic1-#endif-#endif- )+ (Eq, Ord, Data, Generic, Generic1) -instance Foldable Interval where- foldMap f (I a b) = f a `mappend` f b- foldMap _ Empty = mempty- {-# INLINE foldMap #-}+-- | '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 +/- @@ -191,10 +189,6 @@ singular (I a b) = a == b {-# INLINE singular #-} -instance Eq a => Eq (Interval a) where- (==) = (==!)- {-# INLINE (==) #-}- instance Show a => Show (Interval a) where showsPrec _ Empty = showString "Empty" showsPrec n (I a b) =@@ -295,7 +289,7 @@ -- -- >>> deflate 1.0 empty -- Empty-deflate :: (Fractional a, Ord a) => a -> Interval a -> Interval a+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@@ -400,6 +394,44 @@ -- | 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 --@@ -416,9 +448,9 @@ -- False -- elem :: Ord a => a -> Interval a -> Bool-elem x (I a b) = x >= a && x <= b-elem _ Empty = False+elem = member {-# INLINE elem #-}+{-# DEPRECATED elem "Use `member` instead." #-} -- | Determine if a point is not included in the interval --@@ -433,8 +465,9 @@ -- >>> notElem 5 empty -- True notElem :: Ord a => a -> Interval a -> Bool-notElem x xs = not (elem x xs)+notElem = notMember {-# INLINE notElem #-}+{-# DEPRECATED notElem "Use `notMember` instead." #-} -- | 'realToFrac' will use the midpoint instance Real a => Real (Interval a) where@@ -444,27 +477,6 @@ b = toRational rb {-# INLINE toRational #-} -instance Ord a => Ord (Interval a) where- compare Empty Empty = EQ- compare Empty _ = LT- compare _ Empty = GT- compare (I ax bx) (I ay by)- | bx < ay = LT- | ax > by = GT- | bx == ay && ax == by = EQ- | otherwise = Exception.throw AmbiguousComparison- {-# INLINE compare #-}-- max (I a b) (I a' b') = max a a' ... max b b'- max Empty i = i- max i Empty = i- {-# INLINE max #-}-- min (I a b) (I a' b') = min a a' ... min b b'- min Empty _ = Empty- min _ Empty = Empty- {-# INLINE min #-}- -- @'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') =@@ -886,3 +898,58 @@ -- 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))
src/Numeric/Interval/Kaucher.hs view
@@ -1,9 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE DeriveDataTypeable #-}-#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE DeriveGeneric #-}-#endif ----------------------------------------------------------------------------- -- | -- Module : Numeric.Interval@@ -13,7 +11,7 @@ -- Stability : experimental -- Portability : DeriveDataTypeable ----- "Directed" Interval arithmetic+-- \"Directed\" Interval arithmetic -- ----------------------------------------------------------------------------- @@ -25,6 +23,8 @@ , empty , null , singleton+ , member+ , notMember , elem , notElem , inf@@ -42,50 +42,50 @@ , scale, symmetric , contains , isSubsetOf- , certainly, (<!), (<=!), (==!), (>=!), (>!)- , possibly, (<?), (<=?), (==?), (>=?), (>?)+ , 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.Foldable hiding (minimum, maximum, elem, notElem, null) 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) +import qualified Data.Semigroup+import qualified Data.Monoid+ -- $setup+-- >>> :set -Wno-deprecations+-- >>> let null = Numeric.Interval.Kaucher.null+-- >>> let elem = Numeric.Interval.Kaucher.elem+-- >>> let notElem = Numeric.Interval.Kaucher.notElem data Interval a = I !a !a deriving- ( Data- , Typeable-#if __GLASGOW_HASKELL__ >= 704- , Generic-#if __GLASGOW_HASKELL__ >= 706- , Generic1-#endif-#endif- )+ (Eq, Ord, Data, Generic, Generic1) +-- | '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 `mappend` f b+ foldMap f (I a b) = f a `Data.Monoid.mappend` f b {-# INLINE foldMap #-} instance Traversable Interval where@@ -99,8 +99,10 @@ {-# INLINE (<*>) #-} instance Monad Interval where+#if !(MIN_VERSION_base(4,11,0)) return a = I a a {-# INLINE return #-}+#endif I a b >>= f = I a' b' where I a' _ = f a I _ b' = f b@@ -207,10 +209,6 @@ singular x = not (null x) && inf x == sup x {-# INLINE singular #-} -instance Eq a => Eq (Interval a) where- (==) = (==!)- {-# INLINE (==) #-}- instance Show a => Show (Interval a) where showsPrec n (I a b) = showParen (n > 3) $@@ -379,6 +377,43 @@ -- | 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 --@@ -395,8 +430,9 @@ -- False -- elem :: Ord a => a -> Interval a -> Bool-elem x xs = x >= inf xs && x <= sup xs+elem = member {-# INLINE elem #-}+{-# DEPRECATED elem "Use `member` instead." #-} -- | Determine if a point is not included in the interval --@@ -411,8 +447,9 @@ -- >>> notElem 5 empty -- True notElem :: Ord a => a -> Interval a -> Bool-notElem x xs = not (elem x xs)+notElem = notMember {-# INLINE notElem #-}+{-# DEPRECATED notElem "Use `notMember` instead." #-} -- | 'realToFrac' will use the midpoint instance Real a => Real (Interval a) where@@ -424,20 +461,6 @@ b = toRational (sup x) {-# INLINE toRational #-} -instance Ord a => Ord (Interval a) where- compare x y- | sup x < inf y = LT- | inf x > sup y = GT- | sup x == inf y && inf x == sup y = EQ- | otherwise = Exception.throw AmbiguousComparison- {-# INLINE compare #-}-- max (I a b) (I a' b') = max a a' ... max b b'- {-# INLINE max #-}-- min (I a b) (I a' b') = min a a' ... min b b'- {-# INLINE min #-}- -- @'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') =@@ -634,6 +657,10 @@ -- -- >>> 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@@ -829,3 +856,46 @@ 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))
src/Numeric/Interval/NonEmpty.hs view
@@ -1,9 +1,6 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE DeriveDataTypeable #-}-#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE DeriveGeneric #-}-#endif ----------------------------------------------------------------------------- -- | -- Module : Numeric.Interval.NonEmpty@@ -23,6 +20,8 @@ , interval , whole , singleton+ , member+ , notMember , elem , notElem , inf@@ -39,13 +38,17 @@ , mignitude , contains , isSubsetOf- , certainly, (<!), (<=!), (==!), (>=!), (>!)- , possibly, (<?), (<=?), (==?), (>=?), (>?)+ , certainly, (<!), (<=!), (==!), (/=!), (>=!), (>!)+ , possibly, (<?), (<=?), (==?), (/=?), (>=?), (>?) , clamp , inflate, deflate , scale, symmetric , idouble , ifloat+ , iquot+ , irem+ , idiv+ , imod ) where import Numeric.Interval.NonEmpty.Internal
src/Numeric/Interval/NonEmpty/Internal.hs view
@@ -1,9 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE DeriveDataTypeable #-}-#if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE DeriveGeneric #-}-#endif {-# OPTIONS_HADDOCK not-home #-} ----------------------------------------------------------------------------- -- |@@ -22,6 +20,8 @@ , interval , whole , singleton+ , member+ , notMember , elem , notElem , inf@@ -38,55 +38,53 @@ , mignitude , contains , isSubsetOf- , certainly, (<!), (<=!), (==!), (>=!), (>!)- , possibly, (<?), (<=?), (==?), (>=?), (>?)+ , 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) +import qualified Data.Semigroup+ -- $setup -- >>> import Test.QuickCheck.Arbitrary -- >>> import Test.QuickCheck.Gen hiding (scale) -- >>> import Test.QuickCheck.Property -- >>> import Control.Applicative+-- >>> import Control.Exception -- >>> :set -XNoMonomorphismRestriction -- >>> :set -XExtendedDefaultRules -- >>> default (Integer,Double) -- >>> instance (Ord a, Arbitrary a) => Arbitrary (Interval a) where arbitrary = (...) <$> arbitrary <*> arbitrary--- >>> let elementOf 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) `elem` (f xs)--- >>> let conservative2 sf f xs ys = forAll ((,) <$> choose (inf xs, sup xs) <*> choose (inf ys, sup ys)) $ \(x,y) -> (sf x y) `elem` (f xs ys)--- >>> let conservativeExceptNaN sf f xs = forAll (choose (inf xs, sup xs)) $ \x -> isNaN (sf x) || (sf x) `elem` (f xs)+-- >>> 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)+--+-- >>> :set -Wno-deprecations+-- >>> let elem = Numeric.Interval.NonEmpty.Internal.elem+-- >>> let notElem = Numeric.Interval.NonEmpty.Internal.notElem data Interval a = I !a !a deriving- ( Data- , Typeable-#if __GLASGOW_HASKELL__ >= 704- , Generic-#if __GLASGOW_HASKELL__ >= 706- , Generic1-#endif-#endif- )+ (Eq, Ord, Data, Generic, Generic1) -instance Foldable Interval where- foldMap f (I a b) = f a `mappend` f b- {-# INLINE foldMap #-}+-- | 'Data.Semigroup.<>' is 'hull'+instance Ord a => Data.Semigroup.Semigroup (Interval a) where+ (<>) = hull infix 3 ... @@ -194,10 +192,6 @@ singular (I a b) = a == b {-# INLINE singular #-} -instance Eq a => Eq (Interval a) where- (==) = (==!)- {-# INLINE (==) #-}- instance Show a => Show (Interval a) where showsPrec n (I a b) = showParen (n > 3) $@@ -331,6 +325,34 @@ -- | 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 --@@ -343,8 +365,9 @@ -- >>> elem 8 (1.0 ... 5.0) -- False elem :: Ord a => a -> Interval a -> Bool-elem x (I a b) = x >= a && x <= b+elem = member {-# INLINE elem #-}+{-# DEPRECATED elem "Use `member` instead." #-} -- | Determine if a point is not included in the interval --@@ -354,8 +377,9 @@ -- >>> notElem 1.4 (1.0 ... 5.0) -- False notElem :: Ord a => a -> Interval a -> Bool-notElem x xs = not (elem x xs)+notElem = notMember {-# INLINE notElem #-}+{-# DEPRECATED notElem "Use `notMember` instead." #-} -- | 'realToFrac' will use the midpoint instance Real a => Real (Interval a) where@@ -364,20 +388,6 @@ b = toRational rb {-# INLINE toRational #-} -instance Ord a => Ord (Interval a) where- compare (I ax bx) (I ay by)- | bx < ay = LT- | ax > by = GT- | bx == ay && ax == by = EQ- | otherwise = Exception.throw AmbiguousComparison- {-# INLINE compare #-}-- max (I a b) (I a' b') = max a a' ... max b b'- {-# INLINE max #-}-- min (I a b) (I a' b') = min a a' ... min b b'- {-# INLINE min #-}- -- @'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') =@@ -413,8 +423,9 @@ -- | Fractional instance for intervals. ----- prop> ys /= singleton 0 ==> conservative2 ((/) :: Double -> Double -> Double) (/) xs ys--- prop> xs /= singleton 0 ==> conservative (recip :: Double -> Double) recip xs+-- -- The property tests below are currently disabled (#66).+-- -- 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)@@ -473,7 +484,7 @@ 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 + where asin' x | x >= 1 = halfPi | x <= -1 = -halfPi | otherwise = asin x@@ -782,7 +793,8 @@ -- >>> scale (-2.0) (-1.0 ... 1.0) -- -2.0 ... 2.0 ----- prop> abs x >= 1 ==> (scale (x :: Double) i) `contains` i+-- -- The property test below is currently disabled (#66).+-- -- 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@@ -822,3 +834,38 @@ -- 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))
+ tests/doctests.hs view
@@ -0,0 +1,19 @@+-----------------------------------------------------------------------------+-- |+-- Module : Main (doctests)+-- Copyright : (C) 2012-14 Edward Kmett+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : provisional+-- Portability : portable+--+-- This module exists to add dependencies+-----------------------------------------------------------------------------+module Main where++main :: IO ()+main = do+ putStrLn "This test-suite exists only to add dependencies"+ putStrLn "To run doctests: "+ putStrLn " cabal build all --enable-tests"+ putStrLn " cabal-docspec"
− tests/doctests.hsc
@@ -1,76 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ForeignFunctionInterface #-}--------------------------------------------------------------------------------- |--- Module : Main (doctests)--- Copyright : (C) 2012-13 Edward Kmett--- License : BSD-style (see the file LICENSE)--- Maintainer : Edward Kmett <ekmett@gmail.com>--- 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 (deps)-#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif-import Control.Monad-import Data.List-import System.Directory-import System.FilePath-import Test.DocTest--##if defined(mingw32_HOST_OS)-##if defined(i386_HOST_ARCH)-##define USE_CP-import Control.Applicative-import Control.Exception-import Foreign.C.Types-foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool-foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt-##elif defined(x86_64_HOST_ARCH)-##define USE_CP-import Control.Applicative-import Control.Exception-import Foreign.C.Types-foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool-foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt-##endif-##endif---- | Run in a modified codepage where we can print UTF-8 values on Windows.-withUnicode :: IO a -> IO a-##ifdef USE_CP-withUnicode m = do- cp <- c_GetConsoleCP- (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp-##else-withUnicode m = m-##endif--main :: IO ()-main = withUnicode $ getSources >>= \sources -> doctest $- "-isrc"- : "-idist/build/autogen"- : "-optP-include"- : "-optPdist/build/autogen/cabal_macros.h"- : "-packageQuickCheck"- : "-hide-all-packages"- : map ("-package="++) deps ++ sources--getSources :: IO [FilePath]-getSources = filter (isSuffixOf ".hs") <$> go "src"- where- go dir = do- (dirs, files) <- getFilesAndDirectories dir- (files ++) . concat <$> mapM go dirs--getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])-getFilesAndDirectories dir = do- c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir- (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c