diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,6 @@ -import Distribution.Simple -main = defaultMain +module Main where + +import Distribution.Extra.Doctest (defaultMainWithDoctests) + +main :: IO () +main = defaultMainWithDoctests "doctests" diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,6 @@ +# Change Log + +## WIP + +## [0.12.3] - 2020-05-29 + - More relaxed version bounds diff --git a/default.nix b/default.nix new file mode 100644 --- /dev/null +++ b/default.nix @@ -0,0 +1,35 @@ +{ pkgs ? import { }, compiler ? null, hoogle ? true }: + +let + src = pkgs.nix-gitignore.gitignoreSource [ ] ./.; + + compiler' = if compiler != null then + compiler + else + "ghc" + pkgs.lib.concatStrings + (pkgs.lib.splitVersion pkgs.haskellPackages.ghc.version); + + # Any overrides we require to the specified haskell package set + haskellPackages = with pkgs.haskell.lib; + pkgs.haskell.packages.${compiler'}.override { + overrides = self: super: + { + checkers = self.callHackage "checkers" "0.5.1" { }; + } // pkgs.lib.optionalAttrs hoogle { + ghc = super.ghc // { withPackages = super.ghc.withHoogle; }; + ghcWithPackages = self.ghc.withPackages; + }; + }; + + # Generate a haskell derivation using the cabal2nix tool on `package.yaml` + drv = let old = haskellPackages.callCabal2nix "" src { }; + in old // { + env = pkgs.lib.overrideDerivation old.env (attrs: + pkgs.lib.optionalAttrs hoogle { + shellHook = attrs.shellHook + '' + export HIE_HOOGLE_DATABASE="$(cat $(${pkgs.which}/bin/which hoogle) | sed -n -e 's|.*--database \(.*\.hoo\).*|\1|p')" + ''; + }); + }; + +in if pkgs.lib.inNixShell then drv.env else drv diff --git a/exact-real.cabal b/exact-real.cabal --- a/exact-real.cabal +++ b/exact-real.cabal @@ -1,115 +1,119 @@ -name: exact-real -version: 0.12.2 -synopsis: Exact real arithmetic -description: - A type to represent exact real numbers using fast binary Cauchy sequences. -license: MIT -license-file: LICENSE -author: Joe Hermaszewski -maintainer: Joe Hermaszewski -homepage: http://github.com/expipiplus1/exact-real -bug-reports: http://github.com/expipiplus1/exact-real/issues -copyright: 2015 Joe Hermaszewski -category: Math -build-type: Simple +cabal-version: 1.24 + +-- This file has been generated from package.yaml by hpack version 0.33.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 4207194af32e5bff84d5b39c43a8685b42b56f671421be69c390c71e933be2b5 + +name: exact-real +version: 0.12.3 +synopsis: Exact real arithmetic +description: A type to represent exact real numbers using fast binary Cauchy sequences. +category: Math +homepage: https://github.com/expipiplus1/exact-real#readme +bug-reports: https://github.com/expipiplus1/exact-real/issues +author: Joe Hermaszewski +maintainer: Joe Hermaszewski +copyright: 2020 Joe Hermaszewski +license: MIT +license-file: LICENSE +build-type: Custom extra-source-files: - .gitignore - readme.md - stack.yaml -cabal-version: >=1.10 -tested-with: GHC >= 7.10 && <= 8.0.1 + .gitignore + readme.md + stack.yaml + default.nix + changelog.md source-repository head type: git location: https://github.com/expipiplus1/exact-real +custom-setup + setup-depends: + Cabal + , base + , cabal-doctest >=1 && <1.1 + library exposed-modules: - Data.CReal - Data.CReal.Converge - Data.CReal.Internal - build-depends: - base >= 4.8 && < 4.10, - integer-gmp < 1.1.0.0, - memoize >= 0.7 && < 0.9, - random >= 1.0 && < 1.2 + Data.CReal + Data.CReal.Converge + Data.CReal.Internal + other-modules: + Paths_exact_real hs-source-dirs: - src - default-language: - Haskell2010 - ghc-options: - -Wall + src + ghc-options: -Wall + build-depends: + base >=4.8 && <5 + , integer-gmp + , memoize >=0.7 + , random >=1.0 + default-language: Haskell2010 -benchmark bench - default-language: - Haskell2010 - type: - exitcode-stdio-1.0 - ghc-options: - -Wall -threaded -O2 +test-suite doctests + type: exitcode-stdio-1.0 + main-is: Doctests.hs + other-modules: + hs-source-dirs: - bench - main-is: - Bench.hs + test build-depends: - base >= 4 && < 5, - criterion >= 1.1 && < 1.2, - exact-real + base + , doctest + default-language: Haskell2010 test-suite test - default-language: - Haskell2010 - type: - exitcode-stdio-1.0 - ghc-options: - -Wall -threaded - hs-source-dirs: - test - main-is: - Test.hs + type: exitcode-stdio-1.0 + main-is: Test.hs other-modules: - BoundedFunctions, - Data.CReal.Extra, - Data.Monoid.Extra, - Data.Ratio.Extra, - Floating, - Fractional, - Num, - Ord, - Random, - Read, - Real, - RealFloat, - RealFrac, - Test.QuickCheck.Classes.Extra - Test.QuickCheck.Extra - Test.Tasty.Extra + BoundedFunctions + Data.CReal.Extra + Data.Monoid.Extra + Data.Ratio.Extra + Floating + Fractional + Num + Ord + Random + Read + Real + RealFloat + RealFrac + Test.QuickCheck.Classes.Extra + Test.QuickCheck.Extra + Test.Tasty.Extra + Paths_exact_real + hs-source-dirs: + test + ghc-options: -Wall -threaded build-depends: - base >= 4 && < 5, - groups >= 0.3 && < 0.5, - tasty >= 0.10 && < 0.12, - tasty-th >= 0.1 && < 0.2, - tasty-quickcheck >= 0.8 && < 0.9, - tasty-hunit >= 0.9 && < 0.10, - QuickCheck >= 2.8 && < 2.9, - random >= 1.0 && < 1.2, - checkers >= 0.4 && < 0.5, - exact-real + QuickCheck >=2.9 + , base >=4 + , checkers >=0.4 && <0.5.5 + , exact-real + , groups >=0.3 + , random >=1.0 + , tasty >=0.10 + , tasty-hunit >=0.9 + , tasty-quickcheck >=0.8 + , tasty-th >=0.1 + if impl(ghc < 8.0.0) + buildable: False + default-language: Haskell2010 -test-suite doctest - default-language: - Haskell2010 - type: - exitcode-stdio-1.0 - ghc-options: - -Wall -threaded +benchmark bench + type: exitcode-stdio-1.0 + main-is: Bench.hs + other-modules: + Paths_exact_real hs-source-dirs: - test - main-is: - DocTest.hs + bench + ghc-options: -Wall -threaded -O2 build-depends: - base >= 4 && < 5, - directory >= 1.0 && < 1.3, - doctest >= 0.8 && < 0.12, - filepath >= 1.3 && < 1.5 - + base >=4 + , criterion >=1.1 + , exact-real + default-language: Haskell2010 diff --git a/readme.md b/readme.md --- a/readme.md +++ b/readme.md @@ -15,6 +15,9 @@ Compare evaluating Euler's identity with a `Float`: +Note that you'll need the `DataKinds` extension turned on to evaluate the +examples in this readme. + ``` haskell λ> let i = 0 :+ 1 λ> exp (i * pi) + 1 :: Complex Float @@ -33,9 +36,6 @@ Implementation -------------- -The basic operations have explanations and proofs of correctness -[here][correctness]. - `CReal`'s phantom type parameter `n :: Nat` represents the precision at which values should be evaluated at when converting to a less precise representation. For instance the definition of `x == y` in the instance for `Eq` evaluates `x - @@ -85,4 +85,3 @@ -Joe [goldberg]: http://www.validlab.com/goldberg/paper.pdf "What Every Computer Scientist Should Know About Floating-Point Arithmetic" -[correctness]: http://www.imada.sdu.dk/~kornerup/RNC4/papers/p07.ps "The Correctness of an Implementation of Exact Arithmetic" diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,15 +1,5 @@ -# For more information, see: https://github.com/commercialhaskell/stack/blob/master/doc/yaml_configuration.md - -# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-3.13 - -# Local packages, usually specified by relative directory name +resolver: lts-11.22 packages: - '.' - -# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) -extra-deps: [] - -# Override default flag values for local packages and extra-deps -flags: {} - +extra-deps: +- memoize-0.8.1@sha256:2146197c639c126796d850cb4457b24cfeb6966d6d878825f855aafce31f8874,1601 diff --git a/test/Data/Monoid/Extra.hs b/test/Data/Monoid/Extra.hs --- a/test/Data/Monoid/Extra.hs +++ b/test/Data/Monoid/Extra.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -8,14 +8,9 @@ ( module Data.Monoid ) where -import Data.Monoid (Sum(..), Product(..)) -import Test.QuickCheck (Arbitrary) -import Test.QuickCheck.Checkers (EqProp) - -deriving instance Arbitrary a => Arbitrary (Sum a) +import Data.Monoid (Product (..), Sum (..)) +import Test.QuickCheck.Checkers (EqProp) deriving instance EqProp a => EqProp (Sum a) - -deriving instance Arbitrary a => Arbitrary (Product a) deriving instance EqProp a => EqProp (Product a) diff --git a/test/DocTest.hs b/test/DocTest.hs deleted file mode 100644 --- a/test/DocTest.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Main where - -import Control.Monad (filterM) -import Data.List (isSuffixOf) -import System.Directory (doesDirectoryExist, doesFileExist, getDirectoryContents) -import System.FilePath (()) -import Test.DocTest (doctest) - -main :: IO () -main = doctest =<< getSources - -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 - diff --git a/test/Doctests.hs b/test/Doctests.hs new file mode 100644 --- /dev/null +++ b/test/Doctests.hs @@ -0,0 +1,10 @@ +module Main where + +import Build_doctests ( flags + , module_sources + , pkgs + ) +import Test.DocTest ( doctest ) + +main :: IO () +main = doctest $ flags ++ pkgs ++ module_sources diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,62 +1,63 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main (main) where -import Data.List (inits) -import Data.Maybe (fromJust) -import Data.Ratio ((%)) -import Test.Tasty (testGroup, TestTree) -import Test.Tasty.QuickCheck (Positive(..), testProperty, (===), Property, (==>), (.&&.), testProperty) -import Test.Tasty.TH (defaultMainGenerator) -import Test.Tasty.HUnit (Assertion, (@=?), testCase) - -import Data.CReal.Converge -import Data.CReal.Internal -import Data.CReal.Extra () - -import BoundedFunctions (boundedFunctions) -import Floating (floating) -import Ord (ord) -import Read (read') -import Real (real) -import RealFrac (realFrac) -import RealFloat (realFloat) -import Random (random) +import Data.CReal.Converge +import Data.CReal.Extra () +import Data.CReal.Internal +import Data.List (inits) +import Data.Maybe (fromJust) +import Data.Proxy +import Data.Ratio ((%)) +import Data.Semigroup +import GHC.TypeNats +import Numeric.Natural +import Test.Tasty (TestTree, defaultMain, testGroup) +import Test.Tasty.HUnit (Assertion, testCase, (@=?)) +import Test.Tasty.QuickCheck (Positive (..), Property, testProperty, + (.&&.), (===), (==>)) --- How many binary digits to use for comparisons TODO: Test with many different --- precisions -type Precision = 10 +import BoundedFunctions (boundedFunctions) +import Floating (floating) +import Ord (ord) +import Random (random) +import Read (read') +import Real (real) +import RealFloat (realFloat) +import RealFrac (realFrac) {-# ANN test_floating "HLint: ignore Use camelCase" #-} -test_floating :: [TestTree] -test_floating = [floating (undefined :: CReal Precision)] +test_floating :: forall p proxy. KnownNat p => proxy p -> TestTree +test_floating _ = floating (undefined :: CReal p) {-# ANN test_ord "HLint: ignore Use camelCase" #-} -test_ord :: [TestTree] -test_ord = [ ord (undefined :: CReal Precision) ] +test_ord :: forall p proxy. KnownNat p => proxy p -> TestTree +test_ord _ = ord (undefined :: CReal p) {-# ANN test_real "HLint: ignore Use camelCase" #-} -test_real :: [TestTree] -test_real = [ real (\x -> 1 % toInteger (max 1 (crealPrecision (x::CReal Precision)))) ] +test_real :: forall p proxy . KnownNat p => proxy p -> TestTree +test_real _ = + real (\x -> 1 % toInteger (max 1 (crealPrecision (x :: CReal p)))) {-# ANN test_realFrac "HLint: ignore Use camelCase" #-} -test_realFrac :: [TestTree] -test_realFrac = [ realFrac (undefined :: CReal Precision) ] +test_realFrac :: forall p proxy. KnownNat p => proxy p -> TestTree +test_realFrac _ = realFrac (undefined :: CReal p) {-# ANN test_realFloat "HLint: ignore Use camelCase" #-} -test_realFloat :: [TestTree] -test_realFloat = [ realFloat (undefined :: CReal Precision) ] +test_realFloat :: forall p proxy. KnownNat p => proxy p -> TestTree +test_realFloat _ = realFloat (undefined :: CReal p) {-# ANN test_read "HLint: ignore Use camelCase" #-} -test_read :: [TestTree] -test_read = [ read' (undefined :: CReal Precision) ] +test_read :: forall p proxy. KnownNat p => proxy p -> TestTree +test_read _ = read' (undefined :: CReal p) {-# ANN test_random "HLint: ignore Use camelCase" #-} -test_random :: [TestTree] -test_random = [ random (undefined :: CReal Precision) ] +test_random :: forall p proxy. KnownNat p => proxy p -> TestTree +test_random _ = random (undefined :: CReal p) prop_decimalDigits :: Positive Int -> Property prop_decimalDigits (Positive p) = let d = decimalDigitsAtPrecision p @@ -66,10 +67,10 @@ prop_showIntegral :: Integer -> Property prop_showIntegral i = show i === show (fromInteger i :: CReal 0) -prop_shiftL :: CReal Precision -> Int -> Property +prop_shiftL :: forall p . KnownNat p => CReal p -> Int -> Property prop_shiftL x s = x `shiftL` s === x * 2 ** fromIntegral s -prop_shiftR :: CReal Precision -> Int -> Property +prop_shiftR :: forall p . KnownNat p => CReal p -> Int -> Property prop_shiftR x s = x `shiftR` s === x / 2 ** fromIntegral s prop_showNumDigits :: Positive Int -> Rational -> Property @@ -101,12 +102,14 @@ | otherwise = c * 3 + 1 -case_convergePointNineRecurringCReal :: Assertion -case_convergePointNineRecurringCReal = (Just 1 :: Maybe (CReal Precision)) @=? - converge (read <$> pointNineRecurring) +case_convergePointNineRecurringCReal + :: forall p proxy . KnownNat p => proxy p -> Assertion +case_convergePointNineRecurringCReal _ = (Just 1 :: Maybe (CReal p)) @=? + converge (read <$> pointNineRecurring) where pointNineRecurring = ("0.9" ++) <$> inits (repeat '9') -prop_convergeErrSqrtCReal :: Positive (CReal Precision) -> Property +prop_convergeErrSqrtCReal + :: forall p . KnownNat p => Positive (CReal p) -> Property prop_convergeErrSqrtCReal (Positive x) = sqrt' (x ^ (2::Int)) === x where sqrt' x' = let initialGuess = x' improve y = (y + x' / y) / 2 @@ -114,7 +117,8 @@ in fromJust $ convergeErr err (tail $ iterate improve initialGuess) -- Test that the behavior when error is too small is correct -prop_convergeErrSmallSqrtCReal :: Positive (CReal Precision) -> Property +prop_convergeErrSmallSqrtCReal + :: forall p . KnownNat p => Positive (CReal p) -> Property prop_convergeErrSmallSqrtCReal (Positive x) = sqrt' (x ^ (2::Int)) === x where sqrt' x' = let initialGuess = x' improve y = (y + x' / y) / 2 @@ -128,20 +132,60 @@ err y = abs (x' - y * y) in fromJust $ convergeErr err (tail $ iterate improve initialGuess) --- --- --- {-# ANN test_boundedFunctions "HLint: ignore Use camelCase" #-} -test_boundedFunctions :: [TestTree] -test_boundedFunctions = [ boundedFunctions (undefined :: CReal Precision) ] +test_boundedFunctions :: forall p proxy. KnownNat p => proxy p -> TestTree +test_boundedFunctions _ = boundedFunctions (undefined :: CReal p) -prop_expPosNeg :: CReal Precision -> Property +prop_expPosNeg :: KnownNat p => CReal p -> Property prop_expPosNeg x = expPosNeg x === (exp x, exp (-x)) -prop_square :: CReal Precision -> Property +prop_square :: KnownNat p => CReal p -> Property prop_square x = square x === x * x -main :: IO () -main = $(defaultMainGenerator) +-- +-- +-- +precisionTests :: Natural -> TestTree +precisionTests n = case someNatVal n of + SomeNat (_ :: Proxy p) -> testGroup + ("Precision Tests @" <> show n) + [ test_floating (Proxy @p) + , test_ord (Proxy @p) + , test_real (Proxy @p) + , test_realFrac (Proxy @p) + , test_realFloat (Proxy @p) + , test_read (Proxy @p) + , test_random (Proxy @p) + , testProperty "shiftL" (prop_shiftL @p) + , testProperty "shiftR" (prop_shiftR @p) + , testCase "convergePointNineRecurringCReal" + (case_convergePointNineRecurringCReal (Proxy @p)) + , testProperty "convergeErrSqrtCReal" (prop_convergeErrSqrtCReal @p) + , testProperty "convergeErrSmallSqrtCReal" + (prop_convergeErrSmallSqrtCReal @p) + , test_boundedFunctions (Proxy @p) + , testProperty "expPosNeg" (prop_expPosNeg @p) + , testProperty "square" (prop_square @p) + ] + +nonPrecisionTests :: TestTree +nonPrecisionTests = testGroup + "Non precision Tests" + [ testProperty "decimalDigits" prop_decimalDigits + , testProperty "showIntegral" prop_showIntegral + , testProperty "showNumDigits" prop_showNumDigits + , testCase "convergeErrEmptyCReal" case_convergeErrEmptyCReal + , testCase "convergeErrEmptyUnit" case_convergeErrEmptyUnit + , testCase "convergeEmptyCReal" case_convergeEmptyCReal + , testCase "convergeEmptyUnit" case_convergeEmptyUnit + , testProperty "convergeCollatzInteger" prop_convergeCollatzInteger + , testProperty "convergeErrSqrtInteger" prop_convergeErrSqrtInteger + ] + +main :: IO () +main = + let precisions = [0, 1, 2, 10, 30] + in defaultMain + (testGroup "Main" (nonPrecisionTests : (precisionTests <$> precisions)))