math-functions-0.2.1.0/0000755000000000000000000000000013020035203012761 5ustar0000000000000000math-functions-0.2.1.0/math-functions.cabal0000644000000000000000000000533113020035203016706 0ustar0000000000000000name: math-functions version: 0.2.1.0 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE author: Bryan O'Sullivan , Aleksey Khudyakov maintainer: Bryan O'Sullivan homepage: https://github.com/bos/math-functions bug-reports: https://github.com/bos/math-functions/issues category: Math, Numeric build-type: Simple synopsis: Special functions and Chebyshev polynomials description: This library provides implementations of special mathematical functions and Chebyshev polynomials. These functions are often useful in statistical and numerical computing. extra-source-files: changelog.md README.markdown benchmark/*.hs tests/*.hs tests/Tests/*.hs tests/Tests/SpecFunctions/gen.py doc/sinc.hs library default-language: Haskell2010 other-extensions: BangPatterns CPP DeriveDataTypeable FlexibleContexts MultiParamTypeClasses ScopedTypeVariables TemplateHaskell TypeFamilies DeriveGeneric ghc-options: -Wall -O2 build-depends: base >=4.5 && <5 , deepseq , vector >= 0.7 , primitive , vector-th-unbox if flag(system-expm1) || !os(windows) cpp-options: -DUSE_SYSTEM_EXPM1 exposed-modules: Numeric.MathFunctions.Constants Numeric.MathFunctions.Comparison Numeric.Polynomial Numeric.Polynomial.Chebyshev Numeric.RootFinding Numeric.SpecFunctions Numeric.SpecFunctions.Extra Numeric.Series Numeric.Sum other-modules: Numeric.SpecFunctions.Internal flag system-expm1 description: Use expm1 provided by system. Only have effect on windows default: False manual: True test-suite tests default-language: Haskell2010 other-extensions: ViewPatterns type: exitcode-stdio-1.0 ghc-options: -Wall -threaded if arch(i386) -- The Sum tests require SSE2 on i686 to pass (because of excess precision) ghc-options: -msse2 hs-source-dirs: tests main-is: tests.hs other-modules: Tests.Helpers Tests.Chebyshev Tests.Comparison Tests.SpecFunctions Tests.SpecFunctions.Tables Tests.Sum build-depends: math-functions, base >=4.5 && <5, deepseq, primitive, vector >= 0.7, vector-th-unbox, erf, HUnit >= 1.2, QuickCheck >= 2.7, test-framework, test-framework-hunit, test-framework-quickcheck2 source-repository head type: git location: https://github.com/bos/math-functions source-repository head type: mercurial location: https://bitbucket.org/bos/math-functions math-functions-0.2.1.0/changelog.md0000644000000000000000000000453513020035203015241 0ustar0000000000000000## Changes in 0.2.1.0 * `log1p` and `expm1` are simply reexported from `GHC.Float`. They're methods of `Floating` type class. * On windows `expm1` is implemented in pure haskell for older GHCs. ## Changes in 0.2.0.0 * Bug fixes and documentation tweaks ## Changes in 0.2.0.0 * `logGamma` now uses Lancsoz approximation and same as `logGammaL`. Old implementation of `logGamma` moved to `Numeric.SpecFunctions.Extra.logGammaAS245`. * Precision of `logGamma` for z<1 improved. * New much more precise implementation for `incompleteGamma` * Dependency on `erf` pacakge dropped. `erf` and `erfc` just do direct calls to C. * `Numeric.SpecFunctions.expm1` added * `Numeric.SpecFunctions.log1pmx` added. * `logGammaCorrection` exported in `Numeric.SpecFunctions.Extra`. * Module `Numeric.Series` added for working with infinite sequences, series summation and evaluation of continued fractions. * Module `statistics: Statistics.Math.RootFinding` copied to `Numeric.RootFinding`. Instances for `binary` and `aeson` dropped. * Root-finding using Newton-Raphson added * `Numeric.MathFunctions.Comparison.ulpDelta` added. It calculates signed distance between two doubles. * Other bug fixes. ## Changes in 0.1.7.0 * Module `statistics: Statistics.Function.Comparison` moved to `Numeric.MathFunctions.Comparison`. Old implementation if `within` compared negative numbers incorrectly. * `addUlps` and `ulpDistance` added to `Numeric.MathFunctions.Comparison`. * `relativeError` and `eqRelErr` added to `Numeric.MathFunctions.Comparison`. * Precision of `logFactorial` is slightly improved. ## Changes in 0.1.6.0 * `logChoose` added for calculation of logarithm of binomial coefficient * `chooseExact` and `logChooseFast` added * `sinc` added ## Changes in 0.1.5.3 * Fix for test suite on 32bit platform ## Changes in 0.1.5 * Numeric.Sum: new module adds accurate floating point summation. ## Changes in 0.1.4 * logFactorial type is genberalized. It accepts any `Integral` type * Evaluation of polynomials using Horner's method where coefficients are store in lists added ## Changes in 0.1.3 * Error function and its inverse added. * Digamma function added * Evaluation of polynomials using Horner's method added. * Crash bug in the inverse incomplete beta fixed. math-functions-0.2.1.0/README.markdown0000644000000000000000000000154313020035203015465 0ustar0000000000000000# math-functions: efficient, special purpose mathematical functions This package provides a number of special-purpose mathematical functions used in statistical and numerical computing. Where possible, we give citations and computational complexity estimates for the algorithms used. # Get involved! Please report bugs via the [github issue tracker](https://github.com/bos/math-functions/issues). Master [git mirror](https://github.com/bos/math-functions): * `git clone git://github.com/bos/math-functions.git` There's also a [Mercurial mirror](https://bitbucket.org/bos/math-functions): * `hg clone https://bitbucket.org/bos/math-functions` (You can create and contribute changes using either Mercurial or git.) # Authors This library is written and maintained by Bryan O'Sullivan and Aleksey Khudyakov . math-functions-0.2.1.0/LICENSE0000644000000000000000000000246113020035203013771 0ustar0000000000000000Copyright (c) 2009, 2010 Bryan O'Sullivan 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. math-functions-0.2.1.0/Setup.hs0000644000000000000000000000005613020035203014416 0ustar0000000000000000import Distribution.Simple main = defaultMain math-functions-0.2.1.0/doc/0000755000000000000000000000000013020035203013526 5ustar0000000000000000math-functions-0.2.1.0/doc/sinc.hs0000644000000000000000000000142013020035203015013 0ustar0000000000000000-- Description of choice of approximation boundaries in sinc function module Sinc where import Numeric.MathFunctions.Constants (m_epsilon) -- Approximations for sinc up to 6th order and "exact" implementation f2,f4,f6,f :: Double -> Double f2 x = 1 - x*x/6 f4 x = 1 - x*x/6 + x*x*x*x/120 f6 x = 1 - x*x/6 + x*x*x*x/120 - x*x*x*x*x*x/5040 f x = sin x / x -- When next term becomes so small that (1-e)==1 we can neglect it: e0,e2,e4 :: Double e0 = sqrt (6 * m_epsilon / 4) e2 = (30 * m_epsilon) ** (1/4) / 2 e4 = (1260 * m_epsilon) ** (1/6) / 2 test :: IO () test = do print ("e0",e0) print $ f e0 == 1 print $ f2 e0 == 1 -- print ("e2",e2) print $ f e2 == f2 e2 print $ f2 e2 == f4 e2 -- print ("e4",e4) print $ f e4 == f4 e4 print $ f4 e4 == f6 e4 math-functions-0.2.1.0/tests/0000755000000000000000000000000013020035203014123 5ustar0000000000000000math-functions-0.2.1.0/tests/view.hs0000644000000000000000000000452113020035203015433 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} import Control.Applicative import Control.Monad import Numeric.SpecFunctions import Numeric.MathFunctions.Constants import CPython.Sugar import CPython.MPMath import qualified CPython as Py import HEP.ROOT.Plot ---------------------------------------------------------------- viewBetaDelta = runPy $ do addToPythonPath "." m <- loadMPMath mpmSetDps m 100 xs <- forM pqBeta $ \(p,q) -> do x <- fromMPNum =<< mpmLog m =<< mpmBeta m (MPDouble p) (MPDouble q) return (p,q, relErr x (logBeta p q)) draws $ do -- let xs = [ (p,q, logBeta p q `relErr` (logGammaL p + logGammaL q - logGammaL (q+p))) -- | (p,q) <- pqBeta -- ] add $ Graph2D xs pqBeta = [ (p,q) | p <- logRange 50 0.3 0.6 , q <- logRange 50 5 6 ] where viewIBeta x = runPy $ do addToPythonPath "." m <- loadMPMath mpmSetDps m 30 -- let n = 40 let pq = (,) <$> logRange n 100 1000 <*> logRange n 100 1000 -- xs <- forM pq $ \(p,q) -> do i <- fromMPNum =<< mpmIncompleteBeta m (MPDouble p) (MPDouble q) (MPDouble x) return (p,q, incompleteBeta p q x `relErr` i) -- draws $ do add $ Graph2D xs go = runPy $ do addToPythonPath "." m <- loadMPMath mpmSetDps m 16 -- print =<< fromMPNum =<< mpmIncompleteBeta m (MPDouble 10) (MPDouble 10) (MPDouble 0.4) print $ incompleteBeta 10 10 0.4 viewLancrox = runPy $ do addToPythonPath "." m <- loadMPMath mpmSetDps m 50 -- let xs = logRange 10000 (1e-8) (1e-1) pl <- forM xs $ \x -> do y0 <- fromMPNum =<< mpmLog m =<< mpmGamma m (MPDouble x) return (x, y0) draws $ do add $ Graph $ [ (x, abs $ y `relErr` logGammaL x) | (x,y) <- pl ] set $ lineColor RED -- add $ Graph $ [ (x, abs $ y `relErr` logGamma x) | (x,y) <- pl ] set $ lineColor BLUE -- set $ xaxis $ logScale ON -- set $ yaxis $ logScale ON -- add $ HLine m_epsilon add $ HLine $ negate m_epsilon ---------------------------------------------------------------- relErr :: Double -> Double -> Double relErr 0 0 = 0 relErr x y = (x - y) / max (abs x) (abs y) logRange :: Int -> Double -> Double -> [Double] logRange n a b = [ a * r^i | i <- [0 .. n] ] where r = (b / a) ** (1 / fromIntegral n) math-functions-0.2.1.0/tests/tests.hs0000644000000000000000000000072013020035203015620 0ustar0000000000000000import Test.Framework (defaultMain) import qualified Tests.SpecFunctions import qualified Tests.Chebyshev import qualified Tests.Sum import qualified Tests.Comparison main :: IO () main = defaultMain [ Tests.SpecFunctions.tests -- FIXME: tests for chebyshev polynomials fail intermittently -- , Tests.Chebyshev.tests , Tests.Sum.tests , Tests.Comparison.tests ] math-functions-0.2.1.0/tests/Tests/0000755000000000000000000000000013020035203015225 5ustar0000000000000000math-functions-0.2.1.0/tests/Tests/Sum.hs0000644000000000000000000000506313020035203016331 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} module Tests.Sum (tests) where import Control.Applicative ((<$>)) import Numeric.Sum as Sum import Prelude hiding (sum) import Test.Framework (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck (Arbitrary(..)) import qualified Prelude t_sum :: ([Double] -> Double) -> [Double] -> Bool t_sum f xs = f xs == trueSum xs t_sum_error :: ([Double] -> Double) -> [Double] -> Bool t_sum_error f xs = abs (ts - f xs) <= abs (ts - Prelude.sum xs) where ts = trueSum xs t_sum_shifted :: ([Double] -> Double) -> [Double] -> Bool t_sum_shifted f = t_sum_error f . zipWith (+) badvec trueSum :: (Fractional b, Real a) => [a] -> b trueSum xs = fromRational . Prelude.sum . map toRational $ xs badvec :: [Double] badvec = cycle [1,1e16,-1e16] tests :: Test tests = testGroup "Summation" [ testGroup "ID" [ -- plain summation loses precision quickly -- testProperty "t_sum" $ t_sum (sum id) -- tautological tests: -- testProperty "t_sum_error" $ t_sum_error (sum id) -- testProperty "t_sum_shifted" $ t_sum_shifted (sum id) ] , testGroup "Kahan" [ -- tests that cannot pass: -- testProperty "t_sum" $ t_sum (sum kahan) -- testProperty "t_sum_error" $ t_sum_error (sum kahan) -- kahan summation only beats normal summation with large values testProperty "t_sum_shifted" $ t_sum_shifted (sum kahan) ] , testGroup "KBN" [ testProperty "t_sum" $ t_sum (sum kbn) , testProperty "t_sum_error" $ t_sum_error (sum kbn) , testProperty "t_sum_shifted" $ t_sum_shifted (sum kbn) ] , testGroup "KB2" [ testProperty "t_sum" $ t_sum (sum kb2) , testProperty "t_sum_error" $ t_sum_error (sum kb2) , testProperty "t_sum_shifted" $ t_sum_shifted (sum kb2) ] ] instance Arbitrary KahanSum where arbitrary = toKahan <$> arbitrary shrink = map toKahan . shrink . fromKahan toKahan :: (Double, Double) -> KahanSum toKahan (a,b) = KahanSum a b fromKahan :: KahanSum -> (Double, Double) fromKahan (KahanSum a b) = (a,b) instance Arbitrary KBNSum where arbitrary = toKBN <$> arbitrary shrink = map toKBN . shrink . fromKBN toKBN :: (Double, Double) -> KBNSum toKBN (a,b) = KBNSum a b fromKBN :: KBNSum -> (Double, Double) fromKBN (KBNSum a b) = (a,b) instance Arbitrary KB2Sum where arbitrary = toKB2 <$> arbitrary shrink = map toKB2 . shrink . fromKB2 toKB2 :: (Double, Double, Double) -> KB2Sum toKB2 (a,b,c) = KB2Sum a b c fromKB2 :: KB2Sum -> (Double, Double, Double) fromKB2 (KB2Sum a b c) = (a,b,c) math-functions-0.2.1.0/tests/Tests/Helpers.hs0000644000000000000000000000403613020035203017166 0ustar0000000000000000-- | Helpers for testing module Tests.Helpers ( -- * helpers T(..) , typeName , eq , eqC -- * Generic QC tests , monotonicallyIncreases -- * HUnit helpers , testAssertion , testEquality ) where import Data.Complex import Data.Typeable import qualified Test.HUnit as HU import Test.Framework import Test.Framework.Providers.HUnit import Numeric.MathFunctions.Comparison ---------------------------------------------------------------- -- Helpers ---------------------------------------------------------------- -- | Phantom typed value used to select right instance in QC tests data T a = T -- | String representation of type name typeName :: Typeable a => T a -> String typeName = show . typeOf . typeParam where typeParam :: T a -> a typeParam _ = undefined -- | Approximate equality for 'Double'. Doesn't work well for numbers -- which are almost zero. eq :: Double -- ^ Relative error -> Double -> Double -> Bool eq = eqRelErr -- | Approximate equality for 'Complex Double' eqC :: Double -- ^ Relative error -> Complex Double -> Complex Double -> Bool eqC eps a@(ar :+ ai) b@(br :+ bi) | a == 0 && b == 0 = True | otherwise = abs (ar - br) <= eps * d && abs (ai - bi) <= eps * d where d = max (realPart $ abs a) (realPart $ abs b) ---------------------------------------------------------------- -- Generic QC ---------------------------------------------------------------- -- Check that function is nondecreasing monotonicallyIncreases :: (Ord a, Ord b) => (a -> b) -> a -> a -> Bool monotonicallyIncreases f x1 x2 = f (min x1 x2) <= f (max x1 x2) ---------------------------------------------------------------- -- HUnit helpers ---------------------------------------------------------------- testAssertion :: String -> Bool -> Test testAssertion str cont = testCase str $ HU.assertBool str cont testEquality :: (Show a, Eq a) => String -> a -> a -> Test testEquality msg a b = testCase msg $ HU.assertEqual msg a b math-functions-0.2.1.0/tests/Tests/Chebyshev.hs0000644000000000000000000000447313020035203017511 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-type-defaults #-} module Tests.Chebyshev ( tests ) where import Data.Vector.Unboxed (fromList) import Test.Framework import Test.Framework.Providers.QuickCheck2 import Test.QuickCheck (Arbitrary(..),counterexample,Property) import Tests.Helpers import Numeric.Polynomial.Chebyshev import Numeric.MathFunctions.Comparison tests :: Test tests = testGroup "Chebyshev polynomials" [ testProperty "Chebyshev 0" $ \a0 (Ch x) -> testCheb [a0] x , testProperty "Chebyshev 1" $ \a0 a1 (Ch x) -> testCheb [a0,a1] x , testProperty "Chebyshev 2" $ \a0 a1 a2 (Ch x) -> testCheb [a0,a1,a2] x , testProperty "Chebyshev 3" $ \a0 a1 a2 a3 (Ch x) -> testCheb [a0,a1,a2,a3] x , testProperty "Chebyshev 4" $ \a0 a1 a2 a3 a4 (Ch x) -> testCheb [a0,a1,a2,a3,a4] x , testProperty "Broucke" $ testBroucke ] where testBroucke :: Ch -> [Double] -> Property testBroucke _ [] = counterexample "" True testBroucke (Ch x) (c:cs) = counterexample (">>> Chebyshev = " ++ show c1) $ counterexample (">>> Brouke = " ++ show cb) $ counterexample (">>> rel.err. = " ++ show (relativeError c1 cb)) $ counterexample (">>> diff. ulps = " ++ show (ulpDistance c1 cb)) $ within 64 c1 cb where c1 = chebyshev x (fromList $ c : cs) cb = chebyshevBroucke x (fromList $ c*2 : cs) testCheb :: [Double] -> Double -> Property testCheb as x = counterexample (">>> Exact = " ++ show exact) $ counterexample (">>> Numeric = " ++ show num ) $ counterexample (">>> rel.err. = " ++ show err ) $ counterexample (">>> diff. ulps = " ++ show (ulpDistance num exact)) $ eq 1e-12 num exact where exact = evalCheb as x num = chebyshev x (fromList as) err = relativeError num exact evalCheb :: [Double] -> Double -> Double evalCheb as x = realToFrac $ sum $ zipWith (*) (map realToFrac as) $ map ($ realToFrac x) cheb -- Chebyshev polynomials of low order cheb :: [Rational -> Rational] cheb = [ \_ -> 1 , \x -> x , \x -> 2*x^2 - 1 , \x -> 4*x^3 - 3*x , \x -> 8*x^4 - 8*x^2 + 1 ] -- Double in the [-1 .. 1] range newtype Ch = Ch Double deriving Show instance Arbitrary Ch where arbitrary = do x <- arbitrary return $ Ch $ 2 * (abs . snd . properFraction) x - 1 math-functions-0.2.1.0/tests/Tests/Comparison.hs0000644000000000000000000000321213020035203017671 0ustar0000000000000000-- | -- Tests for approximate comparison module Tests.Comparison (tests) where import Test.Framework import Test.Framework.Providers.QuickCheck2 import Tests.Helpers import Numeric.MathFunctions.Comparison import Numeric.MathFunctions.Constants (m_epsilon) tests :: Test tests = testGroup "Comparison" [ testProperty "addUlps 0" $ \x -> x == addUlps 0 x , testProperty "addUlps sym" $ \i x -> x == (addUlps (-i) . addUlps i) x , testProperty "ulpDistance==0" $ \x -> ulpDistance x x == 0 , testProperty "ulpDistance sym" $ \x y -> ulpDistance x y == ulpDistance y x , testProperty "ulpDistance/addUlps" $ \x i -> ulpDistance x (addUlps i x) == fromIntegral (abs i) -- Test that code is correct for m_epsilon , testAssertion "eps distance" $ ulpDistance 1 (1+m_epsilon) == 1 , testAssertion "eps add" $ addUlps 1 1 == 1 + m_epsilon -- , testProperty "relativeError sym" $ \x y -> relativeError x y == relativeError y x , testAssertion "relativeError inf 1" $ isNaN $ relativeError inf 1 , testAssertion "relativeError 1 inf" $ isNaN $ relativeError 1 inf , testAssertion "relativeError -inf 1" $ isNaN $ relativeError (-inf) 1 , testAssertion "relativeError 1 -inf" $ isNaN $ relativeError 1 (-inf) , testAssertion "relativeError inf inf" $ isNaN $ relativeError inf inf , testAssertion "relativeError inf-inf" $ isNaN $ relativeError inf (-inf) , testAssertion "relativeError 1 Nan" $ isNaN $ relativeError 1 nan , testAssertion "relativeError NaN 1" $ isNaN $ relativeError nan 1 , testAssertion "relativeError NaN Nan" $ isNaN $ relativeError nan nan ] where inf = 1/0 nan = 0/0 math-functions-0.2.1.0/tests/Tests/SpecFunctions.hs0000644000000000000000000002171313020035203020350 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} -- | Tests for Statistics.Math module Tests.SpecFunctions ( tests ) where import qualified Data.Vector as V import Data.Vector ((!)) import Test.QuickCheck hiding (choose,within) import Test.Framework import Test.Framework.Providers.QuickCheck2 import Tests.Helpers import Tests.SpecFunctions.Tables import Numeric.SpecFunctions import Numeric.MathFunctions.Comparison (within,relativeError) import Numeric.MathFunctions.Constants (m_epsilon,m_tiny) tests :: Test tests = testGroup "Special functions" [ testProperty "Gamma(x+1) = x*Gamma(x) [logGamma]" $ gammaReccurence logGamma 3e-8 , testProperty "Gamma(x+1) = x*Gamma(x) [logGammaL]" $ gammaReccurence logGammaL 2e-13 , testProperty "gamma(1,x) = 1 - exp(-x)" $ incompleteGammaAt1Check , testProperty "0 <= gamma <= 1" $ incompleteGammaInRange , testProperty "0 <= I[B] <= 1" $ incompleteBetaInRange , testProperty "invIncompleteGamma = gamma^-1" $ invIGammaIsInverse -- XXX FIXME DISABLED due to failures -- , testProperty "invIncompleteBeta = B^-1" $ invIBetaIsInverse , testProperty "gamma - increases" $ \(abs -> s) (abs -> x) (abs -> y) -> s > 0 ==> monotonicallyIncreases (incompleteGamma s) x y , testProperty "invErfc = erfc^-1" $ invErfcIsInverse , testProperty "invErf = erf^-1" $ invErfIsInverse -- Unit tests , testAssertion "Factorial is expected to be precise at 1e-15 level" $ and [ eq 1e-15 (factorial (fromIntegral n :: Int)) (fromIntegral (factorial' n)) |n <- [0..170]] , testAssertion "Log factorial is expected to be precise at 1e-15 level" $ and [ eq 1e-15 (logFactorial (fromIntegral n :: Int)) (log $ fromIntegral $ factorial' n) | n <- [2..170]] , testAssertion "logGamma is expected to be precise at 1e-9 level [integer points]" $ and [ eq 1e-9 (logGamma (fromIntegral n)) (logFactorial (n-1)) | n <- [3..10000::Int]] , testAssertion "logGamma is expected to be precise at 1e-9 level [fractional points]" $ and [ eq 1e-9 (logGamma x) lg | (x,lg) <- tableLogGamma ] , testAssertion "logGammaL is expected to be precise at 1e-15 level" $ and [ eq 1e-15 (logGammaL (fromIntegral n)) (logFactorial (n-1)) | n <- [3..10000::Int]] , testAssertion "logGammaL is expected to be precise at 1e-10 level [fractional points]" $ and [ eq (64*m_epsilon) (logGammaL x) lg | (x,lg) <- tableLogGamma ] -- FIXME: loss of precision when logBeta p q ≈ 0. -- Relative error doesn't work properly in this case. , testAssertion "logBeta is expected to be precise at 1e-6 level" $ and [ eq 1e-6 (logBeta p q) (logGammaL p + logGammaL q - logGammaL (p+q)) | p <- [0.1,0.2 .. 0.9] ++ [2 .. 20] , q <- [0.1,0.2 .. 0.9] ++ [2 .. 20] ] , testAssertion "digamma is expected to be precise at 1e-14 [integers]" $ digammaTestIntegers 1e-14 -- Relative precision is lost when digamma(x) ≈ 0 , testAssertion "digamma is expected to be precise at 1e-12" $ and [ eq 1e-12 r (digamma x) | (x,r) <- tableDigamma ] , testAssertion "incompleteBeta is expected to be precise at 32*m_epsilon level" $ and [ eq (32 * m_epsilon) (incompleteBeta p q x) ib | (p,q,x,ib) <- tableIncompleteBeta ] , testAssertion "incompleteBeta with p > 3000 and q > 3000" $ and [ eq 1e-11 (incompleteBeta p q x) ib | (x,p,q,ib) <- [ (0.495, 3001, 3001, 0.2192546757957825068677527085659175689142653854877723) , (0.501, 3001, 3001, 0.5615652382981522803424365187631195161665429270531389) , (0.531, 3500, 3200, 0.9209758089734407825580172472327758548870610822321278) , (0.501, 13500, 13200, 0.0656209987264794057358373443387716674955276089622780) ] ] , testAssertion "choose is expected to precise at 1e-12 level" $ and [ eq 1e-12 (choose (fromIntegral n) (fromIntegral k)) (fromIntegral $ choose' n k) | n <- [0..1000], k <- [0..n]] , testAssertion "logChoose == log . choose" $ and [ let n' = fromIntegral n k' = fromIntegral k in within 2 (logChoose n' k') (log $ choose n' k') | n <- [0..1000], k <- [0..n]] ---------------------------------------------------------------- -- Self tests , testProperty "Self-test: 0 <= range01 <= 1" $ \x -> let f = range01 x in f <= 1 && f >= 0 ] ---------------------------------------------------------------- -- QC tests ---------------------------------------------------------------- -- Γ(x+1) = x·Γ(x) gammaReccurence :: (Double -> Double) -> Double -> Double -> Property gammaReccurence logG ε x = (x > 0 && x < 100) ==> (abs (g2 - g1 - log x) < ε) where g1 = logG x g2 = logG (x+1) -- γ(s,x) is in [0,1] range incompleteGammaInRange :: Double -> Double -> Property incompleteGammaInRange (abs -> s) (abs -> x) = x >= 0 && s > 0 ==> let i = incompleteGamma s x in i >= 0 && i <= 1 -- γ(1,x) = 1 - exp(-x) -- Since Γ(1) = 1 normalization doesn't make any difference incompleteGammaAt1Check :: Double -> Property incompleteGammaAt1Check (abs -> x) = x > 0 ==> (incompleteGamma 1 x + exp(-x)) ≈ 1 where (≈) = eq 1e-13 -- invIncompleteGamma is inverse of incompleteGamma invIGammaIsInverse :: Double -> Double -> Property invIGammaIsInverse (abs -> a) (range01 -> p) = a > m_tiny && p > m_tiny && p < 1 ==> ( counterexample ("a = " ++ show a ) $ counterexample ("p = " ++ show p ) $ counterexample ("x = " ++ show x ) $ counterexample ("p' = " ++ show p') $ counterexample ("err = " ++ show (relativeError p p')) $ counterexample ("pred = " ++ show δ) $ relativeError p p' < δ ) where x = invIncompleteGamma a p f' = exp ( log x * (a-1) - x - logGamma a) p' = incompleteGamma a x -- FIXME: 128 is big constant. It should be replaced by something -- smaller when #42 is fixed δ = (m_epsilon/2) * (256 + 1 * (1 + abs (x * f' / p))) -- invErfc is inverse of erfc invErfcIsInverse :: Double -> Property invErfcIsInverse ((*2) . range01 -> p) = counterexample ("p = " ++ show p ) $ counterexample ("x = " ++ show x ) $ counterexample ("p' = " ++ show p') $ abs (p - p') <= 1e-14 where x = invErfc p p' = erfc x -- invErf is inverse of erf invErfIsInverse :: Double -> Property invErfIsInverse a = counterexample ("p = " ++ show p ) $ counterexample ("x = " ++ show x ) $ counterexample ("p' = " ++ show p') $ abs (p - p') <= 1e-14 where x = invErf p p' = erf x p | a < 0 = - range01 a | otherwise = range01 a -- B(s,x) is in [0,1] range incompleteBetaInRange :: Double -> Double -> Double -> Property incompleteBetaInRange (abs -> p) (abs -> q) (range01 -> x) = p > 0 && q > 0 ==> let i = incompleteBeta p q x in i >= 0 && i <= 1 -- invIncompleteBeta is inverse of incompleteBeta invIBetaIsInverse :: Double -> Double -> Double -> Property invIBetaIsInverse (abs -> p) (abs -> q) (range01 -> x) = p > 0 && q > 0 ==> ( counterexample ("p = " ++ show p ) $ counterexample ("q = " ++ show q ) $ counterexample ("x = " ++ show x ) $ counterexample ("x' = " ++ show x') $ counterexample ("a = " ++ show a) $ counterexample ("err = " ++ (show $ abs $ (x - x') / x)) $ abs (x - x') <= 1e-12 ) where x' = incompleteBeta p q a a = invIncompleteBeta p q x -- Table for digamma function: -- -- Uses equality ψ(n) = H_{n-1} - γ where -- H_{n} = Σ 1/k, k = [1 .. n] - harmonic number -- γ = 0.57721566490153286060 - Euler-Mascheroni number digammaTestIntegers :: Double -> Bool digammaTestIntegers eps = all (uncurry $ eq eps) $ take 3000 digammaInt where ok approx exact = approx -- Harmonic numbers starting from 0 harmN = scanl (\a n -> a + 1/n) 0 [1::Rational .. ] gam = 0.57721566490153286060 -- Digamma values digammaInt = zipWith (\i h -> (digamma i, realToFrac h - gam)) [1..] harmN ---------------------------------------------------------------- -- Unit tests ---------------------------------------------------------------- -- Lookup table for fact factorial calculation. It has fixed size -- which is bad but it's OK for this particular case factorial_table :: V.Vector Integer factorial_table = V.generate 2000 (\n -> product [1..fromIntegral n]) -- Exact implementation of factorial factorial' :: Integer -> Integer factorial' n = factorial_table ! fromIntegral n -- Exact albeit slow implementation of choose choose' :: Integer -> Integer -> Integer choose' n k = factorial' n `div` (factorial' k * factorial' (n-k)) -- Truncate double to [0,1] range01 :: Double -> Double range01 = abs . (snd :: (Integer, Double) -> Double) . properFraction math-functions-0.2.1.0/tests/Tests/SpecFunctions/0000755000000000000000000000000013020035203020010 5ustar0000000000000000math-functions-0.2.1.0/tests/Tests/SpecFunctions/Tables.hs0000644000000000000000000001625413020035203021566 0ustar0000000000000000module Tests.SpecFunctions.Tables where tableLogGamma :: [(Double,Double)] tableLogGamma = [(0.000001250000000, 13.592366285131767256) , (0.000068200000000, 9.5930266308318756785) , (0.000246000000000, 8.3100370767447948595) , (0.000880000000000, 7.0350813373524845318) , (0.003120000000000, 5.7681293583655666168) , (0.026700000000000, 3.6082588918892972707) , (0.077700000000000, 2.5148371858768232556) , (0.234000000000000, 1.3579557559432757774) , (0.860000000000000, 0.098146578027685588141) , (1.340000000000000, -0.11404757557207759189) , (1.890000000000000, -0.042511642297870140539) , (2.450000000000000, 0.25014296569217620014) , (3.650000000000000, 1.3701041997380685178) , (4.560000000000000, 2.5375143317949575561) , (6.660000000000000, 5.9515377269550207018) , (8.250000000000000, 9.0331869196051215454) , (11.300000000000001, 15.814180681373947834) , (25.600000000000001, 56.711261598328121636) , (50.399999999999999, 146.12815158702164808) , (123.299999999999997, 468.85500075897556371) , (487.399999999999977, 2526.9846647543727158) , (853.399999999999977, 4903.9359135978220365) , (2923.300000000000182, 20402.93198938705973) , (8764.299999999999272, 70798.268343590112636) , (12630.000000000000000, 106641.7726498250704) , (34500.000000000000000, 325976.34838781820145) , (82340.000000000000000, 849629.79603036714252) , (234800.000000000000000, 2668846.4390507955104) , (834300.000000000000000, 10540830.912557533011) , (1230000.000000000000000, 16017699.322315014899) ] tableIncompleteBeta :: [(Double,Double,Double,Double)] tableIncompleteBeta = [(2.000000000000000, 3.000000000000000, 0.030000000000000, 0.0051864299999999988189) , (2.000000000000000, 3.000000000000000, 0.230000000000000, 0.22845923000000001313) , (2.000000000000000, 3.000000000000000, 0.760000000000000, 0.95465727999999994147) , (4.000000000000000, 2.300000000000000, 0.890000000000000, 0.93829812158347791762) , (1.000000000000000, 1.000000000000000, 0.550000000000000, 0.55000000000000004441) , (0.300000000000000, 12.199999999999999, 0.110000000000000, 0.95063000053947066537) , (13.100000000000000, 9.800000000000001, 0.120000000000000, 1.3483109941962659385e-07) , (13.100000000000000, 9.800000000000001, 0.420000000000000, 0.071321857831804780226) , (13.100000000000000, 9.800000000000001, 0.920000000000000, 0.99999578339197070509) ] tableDigamma :: [(Double,Double)] tableDigamma = [(10.0261172557341425, 2.2544954834170942704) , (0.9070101446062873, -0.74152778337908598072) , (3.4679213262860156, 1.0925031389314479036) , (28.5703089405901878, 3.3347652650101657912) , (5.9700184459319399, 1.7006665338476731897) , (20.5303177686997920, 2.9973508205248808878) , (5.6622605630542511, 1.6429280447671743559) , (4.4741465342999014, 1.3824198603491071324) , (21.4416006516504787, 3.0418326144933285349) , (47.6946291432301663, 3.8542988022858128971) , (11.2357450115053670, 2.37393979612347783) , (0.3352840110772935, -3.1124447967622668187) , (2.5037441860153118, 0.70499097759044615508) , (0.5241560861477529, -1.8489960634174653631) , (0.1972018552655726, -5.3635382066874592866) , (0.8289440927562556, -0.90024805153750442344) , (2.0717397641759350, 0.4680412969073853291) , (9.1173553049782452, 2.1543380160183831507) , (1.1815938184339669, -0.31262126373727594508) , (7.3600347508772019, 1.9265946441432049152) , (19.7457045917841398, 2.9574003365402390386) , (4.1956416643620571, 1.3101672771843546617) , (7.3868205159465790, 1.9304848277860633399) , (1.2786090750546355, -0.19373178842778399078) , (10.6498308581562604, 2.3178608134278069208) , (10.6750266252851169, 2.3203381265132185796) , (10.6883248506773985, 2.3216431742802625671) , (14.3373372205836365, 2.6275879484098640937) , (3.3932538441985769, 1.0672611106295626371) , (11.4168205413938768, 2.3906538776946248959) , (3.2500957742991048, 1.0170253699094919941) , (2.7573211981404855, 0.82209952378707851217) , (21.8943170241258827, 3.063216323919045081) , (16.7950471612825254, 2.7910180230044043803) , (9.2578640399661225, 2.1704940538770385317) , (5.3213868642873896, 1.5748408574979930741) , (9.4381079039564071, 2.1908443398518979706) , (13.1568457441413429, 2.538458049596743038) , (10.6478950333943825, 2.3176702242110884811) , (6.4894496431749733, 1.7911554320176725774) , (20.3998669454332315, 2.9908182167188113176) , (3.6989463639934752, 1.1668268193484248041) , (3.4716258279958572, 1.093739186127963281) , (24.7013029455164919, 3.1864775907749920414) , (1.1608524325026863, -0.33982067949719851896) , (1.9482800424522431, 0.3888762195060542215) , (30.4956621109554185, 3.4010990755913685923) , (16.3105956379859052, 2.7608468922073350349) , (10.6908820268137070, 2.3218939328714371939) , (3.4369121607821915, 1.082096765647714065) , (2.2914619096171260, 0.5953971130541900747) , (24.1273989930028883, 3.1624816269998849982) , (14.9455957898231535, 2.6705890837495616097) , (32.2002179941400826, 3.4563650137673369578) , (1.7232417075599473, 0.22682264125689588496) , (9.9662376350778192, 2.248195612105357899) , (10.9702870318273966, 2.348920912357223223) , (18.8934063317711676, 2.912115343761407793) , (8.6720493874148570, 2.1013420151521415846) , (20.4905634096258815, 2.9953645521238549954) , (1.4654265058258678, 0.0036653372399428492921) , (15.4401781010745509, 2.7042406258657996077) , (13.6688064138713390, 2.5780909087521290957) , (2.4073661551765566, 0.65668881914974130964) , (0.8108729056729371, -0.94026521559981879328) , (29.5024809785193902, 3.367430902728568487) , (7.5321882978878660, 1.9513375601887514854) , (3.3716588961200955, 1.0598414578703589939) , (2.9310065630306474, 0.89516303667430119351) , (7.2023118361897769, 1.9033764996201536501) , (3.1362387322050900, 0.97520764792577085966) , (6.5709053027851487, 1.8046329737306385788) , (3.7348491113356177, 1.1779005641199544741) , (1.2328105814385013, -0.24823346907893503732) , (7.9098387372709587, 2.0035651569967258823) , (2.8590898311999715, 0.86554629114604864082) , (2.1964374279534344, 0.54225028515290207842) , (3.8933394033155189, 1.2253803767351847398) , (10.7410508007627694, 2.3268008547643748152) , (2.4921048837305193, 0.69927782909414781809) , (2.2101710538553756, 0.55010424351998354897) , (14.0357118427322334, 2.6055587167248708269) , (4.1320729121597584, 1.2929216807716104043) , (0.2766365979680845, -3.8108738889017752527) , (27.9448247140513644, 3.3122329205038494315) , (9.3081256750537182, 2.1762105230057038341) , (1.4222181352589696, -0.038843893649701873028) , (1.5107587188614726, 0.046499571962236106726) , (3.3467578222470555, 1.0512176183500512305) , (12.2373583939228876, 2.4630788434421742039) , (0.9385094944630431, -0.68317598609698348966) , (5.8655552400886410, 1.6814385243672138603) , (17.1377048621110468, 2.8118219246156086477) , (4.0502102843199079, 1.2702685434611069581) , (2.2041235084734976, 0.54665320805956585382) , (0.9498749870396368, -0.66283138696545962354) , (5.5020466797149687, 1.6115010556650317675) , (1.8741725410778542, 0.33826100356492333487) , (14.1730624058772161, 2.6156503142962224118) , (1.0704026637921555, -0.46701211139417769802) ] math-functions-0.2.1.0/tests/Tests/SpecFunctions/gen.py0000644000000000000000000000354313020035203021140 0ustar0000000000000000#!/usr/bin/python """ """ from mpmath import * import random # Set very-very large precision mp.dps = 100 # Set fixed seed in order to get repeatable results random.seed( 279570842 ) def printListLiteral(lines) : print " [" + "\n , ".join(lines) + "\n ]" ################################################################ # Generate header print "module Tests.SpecFunctions.Tables where" print ################################################################ ## Generate table for logGamma print "tableLogGamma :: [(Double,Double)]" print "tableLogGamma =" gammaArg = [ 1.25e-6, 6.82e-5, 2.46e-4, 8.8e-4, 3.12e-3, 2.67e-2, 7.77e-2, 0.234, 0.86, 1.34, 1.89, 2.45, 3.65, 4.56, 6.66, 8.25, 11.3, 25.6, 50.4, 123.3, 487.4, 853.4, 2923.3, 8764.3, 1.263e4, 3.45e4, 8.234e4, 2.348e5, 8.343e5, 1.23e6, ] printListLiteral( [ '(%.15f, %.20g)' % (x, log(gamma(x))) for x in gammaArg ] ) ################################################################ ## Generate table for incompleteBeta print "tableIncompleteBeta :: [(Double,Double,Double,Double)]" print "tableIncompleteBeta =" incompleteBetaArg = [ (2, 3, 0.03), (2, 3, 0.23), (2, 3, 0.76), (4, 2.3, 0.89), (1, 1, 0.55), (0.3, 12.2, 0.11), (13.1, 9.8, 0.12), (13.1, 9.8, 0.42), (13.1, 9.8, 0.92), ] printListLiteral( [ '(%.15f, %.15f, %.15f, %.20g)' % (p,q,x, betainc(p,q,0,x, regularized=True)) for (p,q,x) in incompleteBetaArg ]) ################################################################ ## Generate table for digamma print "tableDigamma :: [(Double,Double)]" print "tableDigamma =" printListLiteral( [ '(%.16f, %.20g)' % (x, digamma(x)) for x in [ random.expovariate(0.1) for i in xrange(100) ] ] ) math-functions-0.2.1.0/Numeric/0000755000000000000000000000000013020035203014363 5ustar0000000000000000math-functions-0.2.1.0/Numeric/RootFinding.hs0000644000000000000000000001276513020035203017154 0ustar0000000000000000{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveGeneric, CPP #-} -- | -- Module : Numeric.RootFinding -- Copyright : (c) 2011 Bryan O'Sullivan -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- Haskell functions for finding the roots of real functions of real arguments. module Numeric.RootFinding ( Root(..) , fromRoot , ridders , newtonRaphson -- * References -- $references ) where import Control.Applicative (Alternative(..), Applicative(..)) import Control.Monad (MonadPlus(..), ap) import Data.Data (Data, Typeable) #if __GLASGOW_HASKELL__ > 704 import GHC.Generics (Generic) #endif import Numeric.MathFunctions.Comparison (within) -- | The result of searching for a root of a mathematical function. data Root a = NotBracketed -- ^ The function does not have opposite signs when -- evaluated at the lower and upper bounds of the search. | SearchFailed -- ^ The search failed to converge to within the given -- error tolerance after the given number of iterations. | Root a -- ^ A root was successfully found. deriving (Eq, Read, Show, Typeable, Data #if __GLASGOW_HASKELL__ > 704 , Generic #endif ) instance Functor Root where fmap _ NotBracketed = NotBracketed fmap _ SearchFailed = SearchFailed fmap f (Root a) = Root (f a) instance Monad Root where NotBracketed >>= _ = NotBracketed SearchFailed >>= _ = SearchFailed Root a >>= m = m a return = Root instance MonadPlus Root where mzero = SearchFailed r@(Root _) `mplus` _ = r _ `mplus` p = p instance Applicative Root where pure = Root (<*>) = ap instance Alternative Root where empty = SearchFailed r@(Root _) <|> _ = r _ <|> p = p -- | Returns either the result of a search for a root, or the default -- value if the search failed. fromRoot :: a -- ^ Default value. -> Root a -- ^ Result of search for a root. -> a fromRoot _ (Root a) = a fromRoot a _ = a -- | Use the method of Ridders to compute a root of a function. -- -- The function must have opposite signs when evaluated at the lower -- and upper bounds of the search (i.e. the root must be bracketed). ridders :: Double -- ^ Absolute error tolerance. -> (Double,Double) -- ^ Lower and upper bounds for the search. -> (Double -> Double) -- ^ Function to find the roots of. -> Root Double ridders tol (lo,hi) f | flo == 0 = Root lo | fhi == 0 = Root hi | flo*fhi > 0 = NotBracketed -- root is not bracketed | otherwise = go lo flo hi fhi 0 where go !a !fa !b !fb !i -- Root is bracketed within 1 ulp. No improvement could be made | within 1 a b = Root a -- Root is found. Check that f(m) == 0 is nessesary to ensure -- that root is never passed to 'go' | fm == 0 = Root m | fn == 0 = Root n | d < tol = Root n -- Too many iterations performed. Fail | i >= (100 :: Int) = SearchFailed -- Ridder's approximation coincide with one of old -- bounds. Revert to bisection | n == a || n == b = case () of _| fm*fa < 0 -> go a fa m fm (i+1) | otherwise -> go m fm b fb (i+1) -- Proceed as usual | fn*fm < 0 = go n fn m fm (i+1) | fn*fa < 0 = go a fa n fn (i+1) | otherwise = go n fn b fb (i+1) where d = abs (b - a) dm = (b - a) * 0.5 !m = a + dm !fm = f m !dn = signum (fb - fa) * dm * fm / sqrt(fm*fm - fa*fb) !n = m - signum dn * min (abs dn) (abs dm - 0.5 * tol) !fn = f n !flo = f lo !fhi = f hi -- | Solve equation using Newton-Raphson iterations. -- -- This method require both initial guess and bounds for root. If -- Newton step takes us out of bounds on root function reverts to -- bisection. newtonRaphson :: Double -- ^ Required precision -> (Double,Double,Double) -- ^ (lower bound, initial guess, upper bound). Iterations will no -- go outside of the interval -> (Double -> (Double,Double)) -- ^ Function to finds roots. It returns pair of function value and -- its derivative -> Root Double newtonRaphson !prec (!low,!guess,!hi) function = go low guess hi where go !xMin !x !xMax | f == 0 = Root x | abs (dx / x) < prec = Root x | otherwise = go xMin' x' xMax' where (f,f') = function x -- Calculate Newton-Raphson step delta | f' == 0 = error "handle f'==0" | otherwise = f / f' -- Calculate new approximation and actual change of approximation (dx,x') | z <= xMin = let d = 0.5*(x - xMin) in (d, x - d) | z >= xMax = let d = 0.5*(x - xMax) in (d, x - d) | otherwise = (delta, z) where z = x - delta -- Update root bracket xMin' | dx < 0 = x | otherwise = xMin xMax' | dx > 0 = x | otherwise = xMax -- $references -- -- * Ridders, C.F.J. (1979) A new algorithm for computing a single -- root of a real continuous function. -- /IEEE Transactions on Circuits and Systems/ 26:979–980. math-functions-0.2.1.0/Numeric/Sum.hs0000644000000000000000000002052713020035203015471 0ustar0000000000000000{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleContexts, MultiParamTypeClasses, TemplateHaskell, TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -- | -- Module : Numeric.Sum -- Copyright : (c) 2014 Bryan O'Sullivan -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- Functions for summing floating point numbers more accurately than -- the naive 'Prelude.sum' function and its counterparts in the -- @vector@ package and elsewhere. -- -- When used with floating point numbers, in the worst case, the -- 'Prelude.sum' function accumulates numeric error at a rate -- proportional to the number of values being summed. The algorithms -- in this module implement different methods of /compensated -- summation/, which reduce the accumulation of numeric error so that -- it either grows much more slowly than the number of inputs -- (e.g. logarithmically), or remains constant. module Numeric.Sum ( -- * Summation type class Summation(..) , sumVector -- ** Usage -- $usage -- * Kahan-Babuška-Neumaier summation , KBNSum(..) , kbn -- * Order-2 Kahan-Babuška summation , KB2Sum(..) , kb2 -- * Less desirable approaches -- ** Kahan summation , KahanSum(..) , kahan -- ** Pairwise summation , pairwiseSum -- * References -- $references ) where import Control.Arrow ((***)) import Control.DeepSeq (NFData(..)) import Data.Bits (shiftR) import Data.Data (Typeable, Data) import Data.Vector.Generic (Vector(..), foldl') import Data.Vector.Unboxed.Deriving (derivingUnbox) -- Needed for GHC 7.2 & 7.4 to derive Unbox instances import Data.Vector.Generic.Mutable (MVector(..)) import qualified Data.Foldable as F import qualified Data.Vector as V import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as U -- | A class for summation of floating point numbers. class Summation s where -- | The identity for summation. zero :: s -- | Add a value to a sum. add :: s -> Double -> s -- | Sum a collection of values. -- -- Example: -- @foo = 'sum' 'kbn' [1,2,3]@ sum :: (F.Foldable f) => (s -> Double) -> f Double -> Double sum f = f . F.foldl' add zero {-# INLINE sum #-} instance Summation Double where zero = 0 add = (+) -- | Kahan summation. This is the least accurate of the compensated -- summation methods. In practice, it only beats naive summation for -- inputs with large magnitude. Kahan summation can be /less/ -- accurate than naive summation for small-magnitude inputs. -- -- This summation method is included for completeness. Its use is not -- recommended. In practice, 'KBNSum' is both 30% faster and more -- accurate. data KahanSum = KahanSum {-# UNPACK #-} !Double {-# UNPACK #-} !Double deriving (Eq, Show, Typeable, Data) derivingUnbox "KahanSum" [t| KahanSum -> (Double, Double) |] [| \ (KahanSum a b) -> (a, b) |] [| \ (a, b) -> KahanSum a b |] instance Summation KahanSum where zero = KahanSum 0 0 add = kahanAdd instance NFData KahanSum where rnf !_ = () kahanAdd :: KahanSum -> Double -> KahanSum kahanAdd (KahanSum sum c) x = KahanSum sum' c' where sum' = sum + y c' = (sum' - sum) - y y = x - c -- | Return the result of a Kahan sum. kahan :: KahanSum -> Double kahan (KahanSum sum _) = sum -- | Kahan-Babuška-Neumaier summation. This is a little more -- computationally costly than plain Kahan summation, but is /always/ -- at least as accurate. data KBNSum = KBNSum {-# UNPACK #-} !Double {-# UNPACK #-} !Double deriving (Eq, Show, Typeable, Data) derivingUnbox "KBNSum" [t| KBNSum -> (Double, Double) |] [| \ (KBNSum a b) -> (a, b) |] [| \ (a, b) -> KBNSum a b |] instance Summation KBNSum where zero = KBNSum 0 0 add = kbnAdd instance NFData KBNSum where rnf !_ = () kbnAdd :: KBNSum -> Double -> KBNSum kbnAdd (KBNSum sum c) x = KBNSum sum' c' where c' | abs sum >= abs x = c + ((sum - sum') + x) | otherwise = c + ((x - sum') + sum) sum' = sum + x -- | Return the result of a Kahan-Babuška-Neumaier sum. kbn :: KBNSum -> Double kbn (KBNSum sum c) = sum + c -- | Second-order Kahan-Babuška summation. This is more -- computationally costly than Kahan-Babuška-Neumaier summation, -- running at about a third the speed. Its advantage is that it can -- lose less precision (in admittedly obscure cases). -- -- This method compensates for error in both the sum and the -- first-order compensation term, hence the use of \"second order\" in -- the name. data KB2Sum = KB2Sum {-# UNPACK #-} !Double {-# UNPACK #-} !Double {-# UNPACK #-} !Double deriving (Eq, Show, Typeable, Data) derivingUnbox "KB2Sum" [t| KB2Sum -> (Double, Double, Double) |] [| \ (KB2Sum a b c) -> (a, b, c) |] [| \ (a, b, c) -> KB2Sum a b c |] instance Summation KB2Sum where zero = KB2Sum 0 0 0 add = kb2Add instance NFData KB2Sum where rnf !_ = () kb2Add :: KB2Sum -> Double -> KB2Sum kb2Add (KB2Sum sum c cc) x = KB2Sum sum' c' cc' where sum' = sum + x c' = c + k cc' | abs c >= abs k = cc + ((c - c') + k) | otherwise = cc + ((k - c') + c) k | abs sum >= abs x = (sum - sum') + x | otherwise = (x - sum') + sum -- | Return the result of an order-2 Kahan-Babuška sum. kb2 :: KB2Sum -> Double kb2 (KB2Sum sum c cc) = sum + c + cc -- | /O(n)/ Sum a vector of values. sumVector :: (Vector v Double, Summation s) => (s -> Double) -> v Double -> Double sumVector f = f . foldl' add zero {-# INLINE sumVector #-} -- | /O(n)/ Sum a vector of values using pairwise summation. -- -- This approach is perhaps 10% faster than 'KBNSum', but has poorer -- bounds on its error growth. Instead of having roughly constant -- error regardless of the size of the input vector, in the worst case -- its accumulated error grows with /O(log n)/. pairwiseSum :: (Vector v Double) => v Double -> Double pairwiseSum v | len <= 256 = G.sum v | otherwise = uncurry (+) . (pairwiseSum *** pairwiseSum) . G.splitAt (len `shiftR` 1) $ v where len = G.length v {-# SPECIALIZE pairwiseSum :: V.Vector Double -> Double #-} {-# SPECIALIZE pairwiseSum :: U.Vector Double -> Double #-} -- $usage -- -- Most of these summation algorithms are intended to be used via the -- 'Summation' typeclass interface. Explicit type annotations should -- not be necessary, as the use of a function such as 'kbn' or 'kb2' -- to extract the final sum out of a 'Summation' instance gives the -- compiler enough information to determine the precise type of -- summation algorithm to use. -- -- As an example, here is a (somewhat silly) function that manually -- computes the sum of elements in a list. -- -- @ -- sillySumList :: [Double] -> Double -- sillySumList = loop 'zero' -- where loop s [] = 'kbn' s -- loop s (x:xs) = 'seq' s' loop s' xs -- where s' = 'add' s x -- @ -- -- In most instances, you can simply use the much more general 'sum' -- function instead of writing a summation function by hand. -- -- @ -- -- Avoid ambiguity around which sum function we are using. -- import Prelude hiding (sum) -- -- -- betterSumList :: [Double] -> Double -- betterSumList xs = 'sum' 'kbn' xs -- @ -- Note well the use of 'seq' in the example above to force the -- evaluation of intermediate values. If you must write a summation -- function by hand, and you forget to evaluate the intermediate -- values, you are likely to incur a space leak. -- -- Here is an example of how to compute a prefix sum in which the -- intermediate values are as accurate as possible. -- -- @ -- prefixSum :: [Double] -> [Double] -- prefixSum xs = map 'kbn' . 'scanl' 'add' 'zero' $ xs -- @ -- $references -- -- * Kahan, W. (1965), Further remarks on reducing truncation -- errors. /Communications of the ACM/ 8(1):40. -- -- * Neumaier, A. (1974), Rundungsfehleranalyse einiger Verfahren zur -- Summation endlicher Summen. -- /Zeitschrift für Angewandte Mathematik und Mechanik/ 54:39–51. -- -- * Klein, A. (2006), A Generalized -- Kahan-Babuška-Summation-Algorithm. /Computing/ 76(3):279-293. -- -- * Higham, N.J. (1993), The accuracy of floating point -- summation. /SIAM Journal on Scientific Computing/ 14(4):783–799. math-functions-0.2.1.0/Numeric/Polynomial.hs0000644000000000000000000000513213020035203017043 0ustar0000000000000000-- | -- Module : Numeric.Polynomial -- Copyright : (c) 2012 Aleksey Khudyakov -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- Function for evaluating polynomials using Horher's method. module Numeric.Polynomial ( -- * Polynomials evaluatePolynomial , evaluateEvenPolynomial , evaluateOddPolynomial -- ** Lists -- $list , evaluatePolynomialL , evaluateEvenPolynomialL , evaluateOddPolynomialL ) where import qualified Data.Vector.Generic as G import qualified Data.Vector as V import Data.Vector.Generic (Vector) -- | Evaluate polynomial using Horner's method. Coefficients starts -- from lowest. In pseudocode: -- -- > evaluateOddPolynomial x [1,2,3] = 1 + 2*x + 3*x^2 evaluatePolynomial :: (Vector v a, Num a) => a -- ^ /x/ -> v a -- ^ Coefficients -> a {-# INLINE evaluatePolynomial #-} evaluatePolynomial x v | G.null v = 0 | otherwise = G.foldr1 (\a r -> a + r*x) v -- | Evaluate polynomial with only even powers using Horner's method. -- Coefficients starts from lowest. In pseudocode: -- -- > evaluateOddPolynomial x [1,2,3] = 1 + 2*x^2 + 3*x^4 evaluateEvenPolynomial :: (Vector v a, Num a) => a -- ^ /x/ -> v a -- ^ Coefficients -> a {-# INLINE evaluateEvenPolynomial #-} evaluateEvenPolynomial x = evaluatePolynomial (x*x) -- | Evaluate polynomial with only odd powers using Horner's method. -- Coefficients starts from lowest. In pseudocode: -- -- > evaluateOddPolynomial x [1,2,3] = 1*x + 2*x^3 + 3*x^5 evaluateOddPolynomial :: (Vector v a, Num a) => a -- ^ /x/ -> v a -- ^ Coefficients -> a {-# INLINE evaluateOddPolynomial #-} evaluateOddPolynomial x coefs = x * evaluatePolynomial (x*x) coefs -- $lists -- -- When all coefficients are known statically it's more convenient to -- pass coefficient in a list instad of vector. Functions below -- provide just that functionality. If list is known statically it -- will be inlined anyway. evaluatePolynomialL :: (Num a) => a -> [a] -> a evaluatePolynomialL x = evaluatePolynomial x . V.fromList {-# INLINE evaluatePolynomialL #-} evaluateEvenPolynomialL :: (Num a) => a -> [a] -> a evaluateEvenPolynomialL x = evaluateEvenPolynomial x . V.fromList {-# INLINE evaluateEvenPolynomialL #-} evaluateOddPolynomialL :: (Num a) => a -> [a] -> a evaluateOddPolynomialL x = evaluateOddPolynomial x . V.fromList {-# INLINE evaluateOddPolynomialL #-} math-functions-0.2.1.0/Numeric/Series.hs0000644000000000000000000001175513020035203016162 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ExistentialQuantification #-} -- | -- Module : Numeric.Series -- Copyright : (c) 2016 Alexey Khudyakov -- License : BSD3 -- -- Maintainer : alexey.skladnoy@gmail.com, bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- Functions for working with infinite sequences. In particular -- summation of series and evaluation of continued fractions. module Numeric.Series ( -- * Data type for infinite sequences. Sequence(..) -- * Constructors , enumSequenceFrom , enumSequenceFromStep , scanSequence -- * Summation of series , sumSeries , sumPowerSeries , sequenceToList -- * Evaluation of continued fractions , evalContFractionB ) where import Control.Applicative import Data.List (unfoldr) import Numeric.MathFunctions.Constants (m_epsilon) ---------------------------------------------------------------- -- | Infinite series. It's represented as opaque state and step -- function. data Sequence a = forall s. Sequence s (s -> (a,s)) instance Functor Sequence where fmap f (Sequence s0 step) = Sequence s0 (\s -> let (a,s') = step s in (f a, s')) {-# INLINE fmap #-} instance Applicative Sequence where pure a = Sequence () (\() -> (a,())) Sequence sA fA <*> Sequence sB fB = Sequence (sA,sB) $ \(!sa,!sb) -> let (a,sa') = fA sa (b,sb') = fB sb in (a b, (sa',sb')) {-# INLINE pure #-} {-# INLINE (<*>) #-} -- | Elementwise operations with sequences instance Num a => Num (Sequence a) where (+) = liftA2 (+) (*) = liftA2 (*) (-) = liftA2 (-) {-# INLINE (+) #-} {-# INLINE (*) #-} {-# INLINE (-) #-} abs = fmap abs signum = fmap signum fromInteger = pure . fromInteger {-# INLINE abs #-} {-# INLINE signum #-} {-# INLINE fromInteger #-} -- | Elementwise operations with sequences instance Fractional a => Fractional (Sequence a) where (/) = liftA2 (/) recip = fmap recip fromRational = pure . fromRational {-# INLINE (/) #-} {-# INLINE recip #-} {-# INLINE fromRational #-} ---------------------------------------------------------------- -- Constructors ---------------------------------------------------------------- -- | @enumSequenceFrom x@ generate sequence: -- -- \[ a_n = x + n \] enumSequenceFrom :: Num a => a -> Sequence a enumSequenceFrom i = Sequence i (\n -> (n,n+1)) {-# INLINE enumSequenceFrom #-} -- | @enumSequenceFromStep x d@ generate sequence: -- -- \[ a_n = x + nd \] enumSequenceFromStep :: Num a => a -> a -> Sequence a enumSequenceFromStep n d = Sequence n (\i -> (i,i+d)) {-# INLINE enumSequenceFromStep #-} -- | Analog of 'scanl' for sequence. scanSequence :: (b -> a -> b) -> b -> Sequence a -> Sequence b {-# INLINE scanSequence #-} scanSequence f b0 (Sequence s0 step) = Sequence (b0,s0) $ \(b,s) -> let (a,s') = step s b' = f b a in (b,(b',s')) ---------------------------------------------------------------- -- Evaluation of series ---------------------------------------------------------------- -- | Calculate sum of series -- -- \[ \sum_{i=0}^\infty a_i \] -- -- Summation is stopped when -- -- \[ a_{n+1} < \varepsilon\sum_{i=0}^n a_i \] -- -- where ε is machine precision ('m_epsilon') sumSeries :: Sequence Double -> Double {-# INLINE sumSeries #-} sumSeries (Sequence sInit step) = go x0 s0 where (x0,s0) = step sInit go x s | abs (d/x) >= m_epsilon = go x' s' | otherwise = x' where (d,s') = step s x' = x + d -- | Calculate sum of series -- -- \[ \sum_{i=0}^\infty x^ia_i \] -- -- Calculation is stopped when next value in series is less than -- ε·sum. sumPowerSeries :: Double -> Sequence Double -> Double sumPowerSeries x ser = sumSeries $ liftA2 (*) (scanSequence (*) 1 (pure x)) ser {-# INLINE sumPowerSeries #-} -- | Convert series to infinite list sequenceToList :: Sequence a -> [a] sequenceToList (Sequence s f) = unfoldr (Just . f) s ---------------------------------------------------------------- -- Evaluation of continued fractions ---------------------------------------------------------------- -- | -- Evaluate continued fraction using modified Lentz algorithm. -- Sequence contain pairs (a[i],b[i]) which form following expression: -- -- \[ -- b_0 + \frac{a_1}{b_1+\frac{a_2}{b_2+\frac{a_3}{b_3 + \cdots}}} -- \] -- -- Modified Lentz algorithm is described in Numerical recipes 5.2 -- "Evaluation of Continued Fractions" evalContFractionB :: Sequence (Double,Double) -> Double {-# INLINE evalContFractionB #-} evalContFractionB (Sequence sInit step) = let ((_,b0),s0) = step sInit f0 = maskZero b0 in go f0 f0 0 s0 where tiny = 1e-60 maskZero 0 = tiny maskZero x = x go f c d s | abs (delta - 1) >= m_epsilon = go f' c' d' s' | otherwise = f' where ((a,b),s') = step s d' = recip $ maskZero $ b + a*d c' = maskZero $ b + a/c delta = c'*d' f' = f*delta math-functions-0.2.1.0/Numeric/SpecFunctions.hs0000644000000000000000000000636213020035203017511 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | -- Module : Numeric.SpecFunctions -- Copyright : (c) 2009, 2011, 2012 Bryan O'Sullivan -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- Special functions and factorials. module Numeric.SpecFunctions ( -- * Error function erf , erfc , invErf , invErfc -- * Gamma function , logGamma , logGammaL , incompleteGamma , invIncompleteGamma , digamma -- * Beta function , logBeta , incompleteBeta , incompleteBeta_ , invIncompleteBeta -- * Sinc , sinc -- * Logarithm -- $log1p , log1p , log1pmx , log2 -- * Exponent , expm1 -- * Factorial , factorial , logFactorial , stirlingError -- * Combinatorics , choose , logChoose -- * References -- $references ) where import Numeric.SpecFunctions.Internal #if MIN_VERSION_base(4,9,0) import GHC.Float (log1p, expm1) #endif -- $log1p -- -- Base starting from @4.9.0@ (GHC 8.0) provides 'log1p' and 'expm1' -- as method of class 'Floating'. In this case we simply reexport -- these function. Otherwise we provide our own with more restrictive -- signature @Double → Double@. -- $references -- -- * Bernardo, J. (1976) Algorithm AS 103: Psi (digamma) -- function. /Journal of the Royal Statistical Society. Series C -- (Applied Statistics)/ 25(3):315-317. -- -- -- * Cran, G.W., Martin, K.J., Thomas, G.E. (1977) Remark AS R19 -- and Algorithm AS 109: A Remark on Algorithms: AS 63: The -- Incomplete Beta Integral AS 64: Inverse of the Incomplete Beta -- Function Ratio. /Journal of the Royal Statistical Society. Series -- C (Applied Statistics)/ Vol. 26, No. 1 (1977), pp. 111-114 -- -- -- * Lanczos, C. (1964) A precision approximation of the gamma -- function. /SIAM Journal on Numerical Analysis B/ -- 1:86–96. -- -- * Loader, C. (2000) Fast and Accurate Computation of Binomial -- Probabilities. -- -- * Macleod, A.J. (1989) Algorithm AS 245: A robust and reliable -- algorithm for the logarithm of the gamma function. -- /Journal of the Royal Statistical Society, Series C (Applied Statistics)/ -- 38(2):397–402. -- -- * Majumder, K.L., Bhattacharjee, G.P. (1973) Algorithm AS 63: The -- Incomplete Beta Integral. /Journal of the Royal Statistical -- Society. Series C (Applied Statistics)/ Vol. 22, No. 3 (1973), -- pp. 409-411. -- -- * Majumder, K.L., Bhattacharjee, G.P. (1973) Algorithm AS 64: -- Inverse of the Incomplete Beta Function Ratio. /Journal of the -- Royal Statistical Society. Series C (Applied Statistics)/ -- Vol. 22, No. 3 (1973), pp. 411-414 -- -- -- * Temme, N.M. (1992) Asymptotic inversion of the incomplete beta -- function. /Journal of Computational and Applied Mathematics -- 41(1992) 145-157. -- -- * Temme, N.M. (1994) A set of algorithms for the incomplete gamma -- functions. /Probability in the Engineering and Informational -- Sciences/, 8, 1994, 291-307. Printed in the U.S.A. math-functions-0.2.1.0/Numeric/MathFunctions/0000755000000000000000000000000013020035203017145 5ustar0000000000000000math-functions-0.2.1.0/Numeric/MathFunctions/Constants.hs0000644000000000000000000000547613020035203021471 0ustar0000000000000000-- | -- Module : Numeric.MathFunctions.Constants -- Copyright : (c) 2009, 2011 Bryan O'Sullivan -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- Constant values common to much numeric code. module Numeric.MathFunctions.Constants ( -- * IEE754 constants m_epsilon , m_huge , m_tiny , m_max_exp , m_pos_inf , m_neg_inf , m_NaN , m_max_log , m_min_log -- * Mathematical constants , m_1_sqrt_2 , m_2_sqrt_pi , m_ln_sqrt_2_pi , m_sqrt_2 , m_sqrt_2_pi , m_eulerMascheroni ) where ---------------------------------------------------------------- -- IEE754 constants ---------------------------------------------------------------- -- | Largest representable finite value. m_huge :: Double m_huge = 1.7976931348623157e308 {-# INLINE m_huge #-} -- | The smallest representable positive normalized value. m_tiny :: Double m_tiny = 2.2250738585072014e-308 {-# INLINE m_tiny #-} -- | The largest 'Int' /x/ such that 2**(/x/-1) is approximately -- representable as a 'Double'. m_max_exp :: Int m_max_exp = 1024 -- | Positive infinity. m_pos_inf :: Double m_pos_inf = 1/0 {-# INLINE m_pos_inf #-} -- | Negative infinity. m_neg_inf :: Double m_neg_inf = -1/0 {-# INLINE m_neg_inf #-} -- | Not a number. m_NaN :: Double m_NaN = 0/0 {-# INLINE m_NaN #-} -- | Maximum possible finite value of @log x@ m_max_log :: Double m_max_log = 709.782712893384 {-# INLINE m_max_log #-} -- | Logarithm of smallest normalized double ('m_tiny') m_min_log :: Double m_min_log = -708.3964185322641 {-# INLINE m_min_log #-} ---------------------------------------------------------------- -- Mathematical constants ---------------------------------------------------------------- -- | @sqrt 2@ m_sqrt_2 :: Double m_sqrt_2 = 1.4142135623730950488016887242096980785696718753769480731766 {-# INLINE m_sqrt_2 #-} -- | @sqrt (2 * pi)@ m_sqrt_2_pi :: Double m_sqrt_2_pi = 2.5066282746310005024157652848110452530069867406099383166299 {-# INLINE m_sqrt_2_pi #-} -- | @2 / sqrt pi@ m_2_sqrt_pi :: Double m_2_sqrt_pi = 1.1283791670955125738961589031215451716881012586579977136881 {-# INLINE m_2_sqrt_pi #-} -- | @1 / sqrt 2@ m_1_sqrt_2 :: Double m_1_sqrt_2 = 0.7071067811865475244008443621048490392848359376884740365883 {-# INLINE m_1_sqrt_2 #-} -- | The smallest 'Double' ε such that 1 + ε ≠ 1. m_epsilon :: Double m_epsilon = encodeFloat (signif+1) expo - 1.0 where (signif,expo) = decodeFloat (1.0::Double) -- | @log(sqrt((2*pi))@ m_ln_sqrt_2_pi :: Double m_ln_sqrt_2_pi = 0.9189385332046727417803297364056176398613974736377834128171 {-# INLINE m_ln_sqrt_2_pi #-} -- | Euler–Mascheroni constant (γ = 0.57721...) m_eulerMascheroni :: Double m_eulerMascheroni = 0.5772156649015328606065121 {-# INLINE m_eulerMascheroni #-} math-functions-0.2.1.0/Numeric/MathFunctions/Comparison.hs0000644000000000000000000001120513020035203021612 0ustar0000000000000000-- | -- Module : Numeric.MathFunctions.Comparison -- Copyright : (c) 2011 Bryan O'Sullivan -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- Functions for approximate comparison of floating point numbers. -- -- Approximate floating point comparison, based on Bruce Dawson's -- \"Comparing floating point numbers\": -- module Numeric.MathFunctions.Comparison ( -- * Relative erros relativeError , eqRelErr -- * Ulps-based comparison , addUlps , ulpDistance , ulpDelta , within ) where import Control.Monad.ST (runST) import Data.Primitive.ByteArray (newByteArray, readByteArray, writeByteArray) import Data.Word (Word64) import Data.Int (Int64) ---------------------------------------------------------------- -- Ulps-based comparison ---------------------------------------------------------------- -- | -- Calculate relative error of two numbers: -- -- \[ \frac{|a - b|}{\max(|a|,|b|)} \] -- -- It lies in [0,1) interval for numbers with same sign and (1,2] for -- numbers with different sign. If both arguments are zero or negative -- zero function returns 0. If at least one argument is transfinite it -- returns NaN relativeError :: Double -> Double -> Double relativeError a b | a == 0 && b == 0 = 0 | otherwise = abs (a - b) / max (abs a) (abs b) -- | Check that relative error between two numbers @a@ and @b@. If -- 'relativeError' returns NaN it returns @False@. eqRelErr :: Double -- ^ /eps/ relative error should be in [0,1) range -> Double -- ^ /a/ -> Double -- ^ /b/ -> Bool eqRelErr eps a b = relativeError a b < eps ---------------------------------------------------------------- -- Ulps-based comparison ---------------------------------------------------------------- -- | -- Add N ULPs (units of least precision) to @Double@ number. addUlps :: Int -> Double -> Double addUlps n a = runST $ do buf <- newByteArray 8 ai0 <- writeByteArray buf 0 a >> readByteArray buf 0 -- Convert to ulps number represented as Int64 let big = 0x8000000000000000 order :: Word64 -> Int64 order i | i < big = fromIntegral i | otherwise = fromIntegral $ maxBound - (i - big) unorder :: Int64 -> Word64 unorder i | i >= 0 = fromIntegral i | otherwise = big + (maxBound - (fromIntegral i)) let ai0' = unorder $ order ai0 + fromIntegral n writeByteArray buf 0 ai0' >> readByteArray buf 0 -- | -- Measure distance between two @Double@s in ULPs (units of least -- precision). Note that it's different from @abs (ulpDelta a b)@ -- since it returns correct result even when 'ulpDelta' overflows. ulpDistance :: Double -> Double -> Word64 ulpDistance a b = runST $ do buf <- newByteArray 8 ai0 <- writeByteArray buf 0 a >> readByteArray buf 0 bi0 <- writeByteArray buf 0 b >> readByteArray buf 0 -- IEEE754 floats use most significant bit as sign bit (not -- 2-complement) and we need to rearrange representations of float -- number so that they could be compared lexicographically as -- Word64. let big = 0x8000000000000000 order i | i < big = i + big | otherwise = maxBound - i ai = order ai0 bi = order bi0 d | ai > bi = ai - bi | otherwise = bi - ai return $! d -- | -- Measure signed distance between two @Double@s in ULPs (units of least -- precision). Note that unlike 'ulpDistance' it can overflow. -- -- > >>> ulpDelta 1 (1 + m_epsilon) -- > 1 ulpDelta :: Double -> Double -> Int64 ulpDelta a b = runST $ do buf <- newByteArray 8 ai0 <- writeByteArray buf 0 a >> readByteArray buf 0 bi0 <- writeByteArray buf 0 b >> readByteArray buf 0 -- IEEE754 floats use most significant bit as sign bit (not -- 2-complement) and we need to rearrange representations of float -- number so that they could be compared lexicographically as -- Word64. let big = 0x8000000000000000 :: Word64 order i | i < big = i + big | otherwise = maxBound - i ai = order ai0 bi = order bi0 return $! fromIntegral $ bi - ai -- | Compare two 'Double' values for approximate equality, using -- Dawson's method. -- -- The required accuracy is specified in ULPs (units of least -- precision). If the two numbers differ by the given number of ULPs -- or less, this function returns @True@. within :: Int -- ^ Number of ULPs of accuracy desired. -> Double -> Double -> Bool within ulps a b | ulps < 0 = False | otherwise = ulpDistance a b <= fromIntegral ulps math-functions-0.2.1.0/Numeric/SpecFunctions/0000755000000000000000000000000013020035203017146 5ustar0000000000000000math-functions-0.2.1.0/Numeric/SpecFunctions/Internal.hs0000644000000000000000000011244213020035203021262 0ustar0000000000000000{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables, ForeignFunctionInterface #-} -- | -- Module : Numeric.SpecFunctions.Internal -- Copyright : (c) 2009, 2011, 2012 Bryan O'Sullivan -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- Internal module with implementation of special functions. module Numeric.SpecFunctions.Internal where #if !MIN_VERSION_base(4,9,0) import Control.Applicative #endif import Data.Bits ((.&.), (.|.), shiftR) import Data.Int (Int64) import Data.Word (Word) import qualified Data.Vector.Unboxed as U import Data.Vector.Unboxed ((!)) import Text.Printf #if MIN_VERSION_base(4,9,0) import GHC.Float (log1p,expm1) #endif import Numeric.Polynomial.Chebyshev (chebyshevBroucke) import Numeric.Polynomial (evaluatePolynomialL,evaluateEvenPolynomialL,evaluateOddPolynomialL) import Numeric.RootFinding (Root(..), newtonRaphson) import Numeric.Series import Numeric.MathFunctions.Constants ---------------------------------------------------------------- -- Error function ---------------------------------------------------------------- -- | Error function. -- -- \[ -- \operatorname{erf}(x) = \frac{2}{\sqrt{\pi}} \int_{0}^{x} \exp(-t^2) dt -- \] -- -- Function limits are: -- -- \[ -- \begin{aligned} -- &\operatorname{erf}(-\infty) &=& -1 \\ -- &\operatorname{erf}(0) &=& \phantom{-}\,0 \\ -- &\operatorname{erf}(+\infty) &=& \phantom{-}\,1 \\ -- \end{aligned} -- \] erf :: Double -> Double {-# INLINE erf #-} erf = c_erf -- | Complementary error function. -- -- \[ -- \operatorname{erfc}(x) = 1 - \operatorname{erf}(x) -- \] -- -- Function limits are: -- -- \[ -- \begin{aligned} -- &\operatorname{erf}(-\infty) &=&\, 2 \\ -- &\operatorname{erf}(0) &=&\, 1 \\ -- &\operatorname{erf}(+\infty) &=&\, 0 \\ -- \end{aligned} -- \] erfc :: Double -> Double {-# INLINE erfc #-} erfc = c_erfc foreign import ccall "erf" c_erf :: Double -> Double foreign import ccall "erfc" c_erfc :: Double -> Double -- | Inverse of 'erf'. invErf :: Double -- ^ /p/ ∈ [-1,1] -> Double invErf p = invErfc (1 - p) -- | Inverse of 'erfc'. invErfc :: Double -- ^ /p/ ∈ [0,2] -> Double invErfc p | p == 2 = m_neg_inf | p == 0 = m_pos_inf | p >0 && p < 2 = if p <= 1 then r else -r | otherwise = modErr $ "invErfc: p must be in [0,2] got " ++ show p where pp = if p <= 1 then p else 2 - p t = sqrt $ -2 * log( 0.5 * pp) -- Initial guess x0 = -0.70711 * ((2.30753 + t * 0.27061) / (1 + t * (0.99229 + t * 0.04481)) - t) r = loop 0 x0 -- loop :: Int -> Double -> Double loop !j !x | j >= 2 = x | otherwise = let err = erfc x - pp x' = x + err / (1.12837916709551257 * exp(-x * x) - x * err) -- // Halley in loop (j+1) x' ---------------------------------------------------------------- -- Gamma function ---------------------------------------------------------------- data L = L {-# UNPACK #-} !Double {-# UNPACK #-} !Double -- | Compute the logarithm of the gamma function, Γ(/x/). -- -- \[ -- \Gamma(x) = \int_0^{\infty}t^{x-1}e^{-t}\,dt = (x - 1)! -- \] -- -- This implementation uses Lanczos approximation. It gives 14 or more -- significant decimal digits, except around /x/ = 1 and /x/ = 2, -- where the function goes to zero. -- -- Returns ∞ if the input is outside of the range (0 < /x/ -- ≤ 1e305). logGamma :: Double -> Double logGamma x | x <= 0 = m_pos_inf | x < 1 = lanczos (1+x) - log x | otherwise = lanczos x where -- Evaluate Lanczos approximation for γ=6 lanczos z = fini $ U.foldl' go (L 0 (z+7)) a where fini (L l _) = log (l+a0) + log m_sqrt_2_pi - z65 + (z-0.5) * log z65 go (L l t) k = L (l + k / t) (t-1) z65 = z + 6.5 -- Coefficients for Lanczos approximation a0 = 0.9999999999995183 a = U.fromList [ 0.1659470187408462e-06 , 0.9934937113930748e-05 , -0.1385710331296526 , 12.50734324009056 , -176.6150291498386 , 771.3234287757674 , -1259.139216722289 , 676.5203681218835 ] -- | Synonym for 'logGamma'. Retained for compatibility logGammaL :: Double -> Double logGammaL = logGamma -- | -- Compute the log gamma correction factor for Stirling -- approximation for @x@ ≥ 10. This correction factor is -- suitable for an alternate (but less numerically accurate) -- definition of 'logGamma': -- -- \[ -- \log\Gamma(x) = \frac{1}{2}\log(2\pi) + (x-\frac{1}{2})\log x - x + \operatorname{logGammaCorrection}(x) -- \] logGammaCorrection :: Double -> Double logGammaCorrection x | x < 10 = m_NaN | x < big = chebyshevBroucke (t * t * 2 - 1) coeffs / x | otherwise = 1 / (x * 12) where big = 94906265.62425156 t = 10 / x coeffs = U.fromList [ 0.1666389480451863247205729650822e+0, -0.1384948176067563840732986059135e-4, 0.9810825646924729426157171547487e-8, -0.1809129475572494194263306266719e-10, 0.6221098041892605227126015543416e-13, -0.3399615005417721944303330599666e-15, 0.2683181998482698748957538846666e-17 ] -- | Compute the normalized lower incomplete gamma function -- γ(/z/,/x/). Normalization means that γ(/z/,∞)=1 -- -- \[ -- \gamma(z,x) = \frac{1}{\Gamma(z)}\int_0^{x}t^{z-1}e^{-t}\,dt -- \] -- -- Uses Algorithm AS 239 by Shea. incompleteGamma :: Double -- ^ /z/ ∈ (0,∞) -> Double -- ^ /x/ ∈ (0,∞) -> Double -- Notation used: -- + P(a,x) - regularized lower incomplete gamma -- + Q(a,x) - regularized upper incomplete gamma incompleteGamma a x | a <= 0 || x < 0 = error $ "incompleteGamma: Domain error z=" ++ show a ++ " x=" ++ show x | x == 0 = 0 | x == m_pos_inf = 1 -- For very small x we use following expansion for P: -- -- See http://functions.wolfram.com/GammaBetaErf/GammaRegularized/06/01/05/01/01/ | x < sqrt m_epsilon && a > 1 = x**a / a / exp (logGammaL a) * (1 - a*x / (a + 1)) | x < 0.5 = case () of _| (-0.4)/log x < a -> taylorSeriesP | otherwise -> taylorSeriesComplQ | x < 1.1 = case () of _| 0.75*x < a -> taylorSeriesP | otherwise -> taylorSeriesComplQ | a > 20 && useTemme = uniformExpansion | x - (1 / (3 * x)) < a = taylorSeriesP | otherwise = contFraction where mu = (x - a) / a useTemme = (a > 200 && 20/a > mu*mu) || (abs mu < 0.4) -- Gautschi's algorithm. -- -- Evaluate series for P(a,x). See [Temme1994] Eq. 5.5 -- -- FIXME: Term `exp (log x * z - x - logGamma (z+1))` doesn't give full precision taylorSeriesP = sumPowerSeries x (scanSequence (/) 1 $ enumSequenceFrom (a+1)) * exp (log x * a - x - logGamma (a+1)) -- Series for 1-Q(a,x). See [Temme1994] Eq. 5.5 taylorSeriesComplQ = sumPowerSeries (-x) (scanSequence (/) 1 (enumSequenceFrom 1) / enumSequenceFrom a) * x**a / exp(logGammaL a) -- Legendre continued fractions contFraction = 1 - ( exp ( log x * a - x - logGamma a ) / evalContFractionB frac ) where frac = (\k -> (k*(a-k), x - a + 2*k + 1)) <$> enumSequenceFrom 0 -- Evaluation based on uniform expansions. See [Temme1994] 5.2 uniformExpansion = let -- Coefficients f_m in paper fm :: U.Vector Double fm = U.fromList [ 1.00000000000000000000e+00 ,-3.33333333333333370341e-01 , 8.33333333333333287074e-02 ,-1.48148148148148153802e-02 , 1.15740740740740734316e-03 , 3.52733686067019369930e-04 ,-1.78755144032921825352e-04 , 3.91926317852243766954e-05 ,-2.18544851067999240532e-06 ,-1.85406221071515996597e-06 , 8.29671134095308545622e-07 ,-1.76659527368260808474e-07 , 6.70785354340149841119e-09 , 1.02618097842403069078e-08 ,-4.38203601845335376897e-09 , 9.14769958223679020897e-10 ,-2.55141939949462514346e-11 ,-5.83077213255042560744e-11 , 2.43619480206674150369e-11 ,-5.02766928011417632057e-12 , 1.10043920319561347525e-13 , 3.37176326240098513631e-13 ] y = - log1pmx mu eta = sqrt (2 * y) * signum mu -- Evaluate S_α (Eq. 5.9) loop !_ !_ u 0 = u loop bm1 bm0 u i = let t = (fm ! i) + (fromIntegral i + 1)*bm1 / a u' = eta * u + t in loop bm0 t u' (i-1) s_a = let n = U.length fm in loop (fm ! (n-1)) (fm ! (n-2)) 0 (n-3) / exp (logGammaCorrection a) in 1/2 * erfc(-eta*sqrt(a/2)) - exp(-(a*y)) / sqrt (2*pi*a) * s_a -- Adapted from Numerical Recipes §6.2.1 -- | Inverse incomplete gamma function. It's approximately inverse of -- 'incompleteGamma' for the same /z/. So following equality -- approximately holds: -- -- > invIncompleteGamma z . incompleteGamma z ≈ id invIncompleteGamma :: Double -- ^ /z/ ∈ (0,∞) -> Double -- ^ /p/ ∈ [0,1] -> Double invIncompleteGamma a p | a <= 0 = modErr $ printf "invIncompleteGamma: a must be positive. a=%g p=%g" a p | p < 0 || p > 1 = modErr $ printf "invIncompleteGamma: p must be in [0,1] range. a=%g p=%g" a p | p == 0 = 0 | p == 1 = 1 / 0 | otherwise = loop 0 guess where -- Solve equation γ(a,x) = p using Halley method loop :: Int -> Double -> Double loop i x | i >= 12 = x' -- For small s derivative becomes approximately 1/x*exp(-x) and -- skyrockets for small x. If it happens correct answer is 0. | isInfinite f' = 0 | abs dx < eps * x' = x' | otherwise = loop (i + 1) x' where -- Value of γ(a,x) - p f = incompleteGamma a x - p -- dγ(a,x)/dx f' | a > 1 = afac * exp( -(x - a1) + a1 * (log x - lna1)) | otherwise = exp( -x + a1 * log x - gln) u = f / f' -- Halley correction to Newton-Rapson step corr = u * (a1 / x - 1) dx = u / (1 - 0.5 * min 1.0 corr) -- New approximation to x x' | x < dx = 0.5 * x -- Do not go below 0 | otherwise = x - dx -- Calculate inital guess for root guess -- | a > 1 = let t = sqrt $ -2 * log(if p < 0.5 then p else 1 - p) x1 = (2.30753 + t * 0.27061) / (1 + t * (0.99229 + t * 0.04481)) - t x2 = if p < 0.5 then -x1 else x1 in max 1e-3 (a * (1 - 1/(9*a) - x2 / (3 * sqrt a)) ** 3) -- For a <= 1 use following approximations: -- γ(a,1) ≈ 0.253a + 0.12a² -- -- γ(a,x) ≈ γ(a,1)·x^a x < 1 -- γ(a,x) ≈ γ(a,1) + (1 - γ(a,1))(1 - exp(1 - x)) x >= 1 | otherwise = let t = 1 - a * (0.253 + a*0.12) in if p < t then (p / t) ** (1 / a) else 1 - log( 1 - (p-t) / (1-t)) -- Constants a1 = a - 1 lna1 = log a1 afac = exp( a1 * (lna1 - 1) - gln ) gln = logGamma a eps = 1e-8 ---------------------------------------------------------------- -- Beta function ---------------------------------------------------------------- -- | Compute the natural logarithm of the beta function. -- -- \[ -- B(a,b) = \int_0^1 t^{a-1}(1-t)^{1-b}\,dt = \frac{\Gamma(a)\Gamma(b)}{\Gamma(a+b)} -- \] logBeta :: Double -- ^ /a/ > 0 -> Double -- ^ /b/ > 0 -> Double logBeta a b | p < 0 = m_NaN | p == 0 = m_pos_inf | p >= 10 = log q * (-0.5) + m_ln_sqrt_2_pi + logGammaCorrection p + c + (p - 0.5) * log ppq + q * log1p(-ppq) | q >= 10 = logGamma p + c + p - p * log pq + (q - 0.5) * log1p(-ppq) | otherwise = logGamma p + logGamma q - logGamma pq where p = min a b q = max a b ppq = p / pq pq = p + q c = logGammaCorrection q - logGammaCorrection pq -- | Regularized incomplete beta function. -- -- \[ -- I(x;a,b) = \frac{1}{B(a,b)} \int_0^x t^{a-1}(1-t)^{1-b}\,dt -- \] -- -- Uses algorithm AS63 by Majumder and Bhattachrjee and quadrature -- approximation for large /p/ and /q/. incompleteBeta :: Double -- ^ /a/ > 0 -> Double -- ^ /b/ > 0 -> Double -- ^ /x/, must lie in [0,1] range -> Double incompleteBeta p q = incompleteBeta_ (logBeta p q) p q -- | Regularized incomplete beta function. Same as 'incompleteBeta' -- but also takes logarithm of beta function as parameter. incompleteBeta_ :: Double -- ^ logarithm of beta function for given /p/ and /q/ -> Double -- ^ /a/ > 0 -> Double -- ^ /b/ > 0 -> Double -- ^ /x/, must lie in [0,1] range -> Double incompleteBeta_ beta p q x | p <= 0 || q <= 0 = modErr $ printf "incompleteBeta_: p <= 0 || q <= 0. p=%g q=%g x=%g" p q x | x < 0 || x > 1 || isNaN x = modErr $ printf "incompleteBeta_: x out of [0,1] range. p=%g q=%g x=%g" p q x | x == 0 || x == 1 = x | p >= (p+q) * x = incompleteBetaWorker beta p q x | otherwise = 1 - incompleteBetaWorker beta q p (1 - x) -- Approximation of incomplete beta by quandrature. -- -- Note that x =< p/(p+q) incompleteBetaApprox :: Double -> Double -> Double -> Double -> Double incompleteBetaApprox beta p q x | ans > 0 = 1 - ans | otherwise = -ans where -- Constants p1 = p - 1 q1 = q - 1 mu = p / (p + q) lnmu = log mu lnmuc = log1p (-mu) -- Upper limit for integration xu = max 0 $ min (mu - 10*t) (x - 5*t) where t = sqrt $ p*q / ( (p+q) * (p+q) * (p + q + 1) ) -- Calculate incomplete beta by quadrature go y w = let t = x + (xu - x) * y in w * exp( p1 * (log t - lnmu) + q1 * (log(1-t) - lnmuc) ) s = U.sum $ U.zipWith go coefY coefW ans = s * (xu - x) * exp( p1 * lnmu + q1 * lnmuc - beta ) -- Worker for incomplete beta function. It is separate function to -- avoid confusion with parameter during parameter swapping incompleteBetaWorker :: Double -> Double -> Double -> Double -> Double incompleteBetaWorker beta p q x -- For very large p and q this method becomes very slow so another -- method is used. | p > 3000 && q > 3000 = incompleteBetaApprox beta p q x | otherwise = loop (p+q) (truncate $ q + cx * (p+q)) 1 1 1 where -- Constants eps = 1e-15 cx = 1 - x -- Common multiplies for expansion. Accurate calculation is a bit -- tricky. Performing calculation in log-domain leads to slight -- loss of precision for small x, while using ** prone to -- underflows. -- -- If either beta function of x**p·(1-x)**(q-1) underflows we -- switch to log domain. It could waste work but there's no easy -- switch criterion. factor | beta < m_min_log || prod < m_tiny = exp( p * log x + (q - 1) * log cx - beta) | otherwise = prod / exp beta where prod = x**p * cx**(q - 1) -- Soper's expansion of incomplete beta function loop !psq (ns :: Int) ai term betain | done = betain' * factor / p | otherwise = loop psq' (ns - 1) (ai + 1) term' betain' where -- New values term' = term * fact / (p + ai) betain' = betain + term' fact | ns > 0 = (q - ai) * x/cx | ns == 0 = (q - ai) * x | otherwise = psq * x -- Iterations are complete done = db <= eps && db <= eps*betain' where db = abs term' psq' = if ns < 0 then psq + 1 else psq -- | Compute inverse of regularized incomplete beta function. Uses -- initial approximation from AS109, AS64 and Halley method to solve -- equation. invIncompleteBeta :: Double -- ^ /a/ > 0 -> Double -- ^ /b/ > 0 -> Double -- ^ /x/ ∈ [0,1] -> Double invIncompleteBeta p q a | p <= 0 || q <= 0 = modErr $ printf "invIncompleteBeta p <= 0 || q <= 0. p=%g q=%g a=%g" p q a | a < 0 || a > 1 = modErr $ printf "invIncompleteBeta x must be in [0,1]. p=%g q=%g a=%g" p q a | a == 0 || a == 1 = a | otherwise = invIncompleteBetaWorker (logBeta p q) p q a invIncompleteBetaWorker :: Double -> Double -> Double -> Double -> Double invIncompleteBetaWorker beta a b p = loop (0::Int) (invIncBetaGuess beta a b p) where a1 = a - 1 b1 = b - 1 -- Solve equation using Halley method loop !i !x -- We cannot continue at this point so we simply return `x' | x == 0 || x == 1 = x -- When derivative becomes infinite we cannot continue -- iterations. It can only happen in vicinity of 0 or 1. It's -- hardly possible to get good answer in such circumstances but -- `x' is already reasonable. | isInfinite f' = x -- Iterations limit reached. Most of the time solution will -- converge to answer because of discreteness of Double. But -- solution have good precision already. | i >= 10 = x -- Solution converges | abs dx <= 16 * m_epsilon * x = x' | otherwise = loop (i+1) x' where -- Calculate Halley step. f = incompleteBeta_ beta a b x - p f' = exp $ a1 * log x + b1 * log1p (-x) - beta u = f / f' -- We bound Halley correction to Newton-Raphson to (-1,1) range corr | d > 1 = 1 | d < -1 = -1 | isNaN d = 0 | otherwise = d where d = u * (a1 / x - b1 / (1 - x)) dx = u / (1 - 0.5 * corr) -- Next approximation. If Halley step leads us out of [0,1] -- range we revert to bisection. x' | z < 0 = x / 2 | z > 1 = (x + 1) / 2 | otherwise = z where z = x - dx -- Calculate initial guess for inverse incomplete beta function. invIncBetaGuess :: Double -> Double -> Double -> Double -> Double -- Calculate initial guess. for solving equation for inverse incomplete beta. -- It's really hodgepodge of different approximations accumulated over years. -- -- Equations are referred to by name of paper and number e.g. [AS64 2] -- In AS64 papers equations are not numbered so they are refered to by -- number of appearance starting from definition of incomplete beta. invIncBetaGuess beta a b p -- If both a and b are less than 1 incomplete beta have inflection -- point. -- -- > x = (1 - a) / (2 - a - b) -- -- We approximate incomplete beta by neglecting one of factors under -- integral and then rescaling result of integration into [0,1] -- range. | a < 1 && b < 1 = let x_infl = (1 - a) / (2 - a - b) p_infl = incompleteBeta a b x_infl x | p < p_infl = let xg = (a * p * exp beta) ** (1/a) in xg / (1+xg) | otherwise = let xg = (b * (1-p) * exp beta) ** (1/b) in 1 - xg/(1+xg) in x -- If both a and b larger or equal that 1 but not too big we use -- same approximation as above but calculate it a bit differently | a+b <= 6 && a>1 && b>1 = let x_infl = (a - 1) / (a + b - 2) p_infl = incompleteBeta a b x_infl x | p < p_infl = exp ((log(p * a) + beta) / a) | otherwise = 1 - exp((log((1-p) * b) + beta) / b) in x -- For small a and not too big b we use approximation from boost. | b < 5 && a <= 1 = let x | p**(1/a) < 0.5 = (p * a * exp beta) ** (1/a) | otherwise = 1 - (1 - p ** (b * exp beta))**(1/b) in x -- When a>>b and both are large approximation from [Temme1992], -- section 4 "the incomplete gamma function case" used. In this -- region it greatly improves over other approximation (AS109, AS64, -- "Numerical Recipes") -- -- FIXME: It could be used when b>>a too but it require inverse of -- upper incomplete gamma to be precise enough. In current -- implementation it loses precision in horrible way (40 -- order of magnitude off for sufficiently small p) | a+b > 5 && a/b > 4 = let -- Calculate initial approximation to eta using eq 4.1 eta0 = invIncompleteGamma b (1-p) / a mu = b / a -- Eq. 4.3 -- A lot of helpers for calculation of w = sqrt(1 + mu) -- Eq. 4.9 w_2 = w * w w_3 = w_2 * w w_4 = w_2 * w_2 w_5 = w_3 * w_2 w_6 = w_3 * w_3 w_7 = w_4 * w_3 w_8 = w_4 * w_4 w_9 = w_5 * w_4 w_10 = w_5 * w_5 d = eta0 - mu d_2 = d * d d_3 = d_2 * d d_4 = d_2 * d_2 w1 = w + 1 w1_2 = w1 * w1 w1_3 = w1 * w1_2 w1_4 = w1_2 * w1_2 -- Evaluation of eq 4.10 e1 = (w + 2) * (w - 1) / (3 * w) + (w_3 + 9 * w_2 + 21 * w + 5) * d / (36 * w_2 * w1) - (w_4 - 13 * w_3 + 69 * w_2 + 167 * w + 46) * d_2 / (1620 * w1_2 * w_3) - (7 * w_5 + 21 * w_4 + 70 * w_3 + 26 * w_2 - 93 * w - 31) * d_3 / (6480 * w1_3 * w_4) - (75 * w_6 + 202 * w_5 + 188 * w_4 - 888 * w_3 - 1345 * w_2 + 118 * w + 138) * d_4 / (272160 * w1_4 * w_5) e2 = (28 * w_4 + 131 * w_3 + 402 * w_2 + 581 * w + 208) * (w - 1) / (1620 * w1 * w_3) - (35 * w_6 - 154 * w_5 - 623 * w_4 - 1636 * w_3 - 3983 * w_2 - 3514 * w - 925) * d / (12960 * w1_2 * w_4) - ( 2132 * w_7 + 7915 * w_6 + 16821 * w_5 + 35066 * w_4 + 87490 * w_3 + 141183 * w_2 + 95993 * w + 21640 ) * d_2 / (816480 * w_5 * w1_3) - ( 11053 * w_8 + 53308 * w_7 + 117010 * w_6 + 163924 * w_5 + 116188 * w_4 - 258428 * w_3 - 677042 * w_2 - 481940 * w - 105497 ) * d_3 / (14696640 * w1_4 * w_6) e3 = -( (3592 * w_7 + 8375 * w_6 - 1323 * w_5 - 29198 * w_4 - 89578 * w_3 - 154413 * w_2 - 116063 * w - 29632 ) * (w - 1) ) / (816480 * w_5 * w1_2) - ( 442043 * w_9 + 2054169 * w_8 + 3803094 * w_7 + 3470754 * w_6 + 2141568 * w_5 - 2393568 * w_4 - 19904934 * w_3 - 34714674 * w_2 - 23128299 * w - 5253353 ) * d / (146966400 * w_6 * w1_3) - ( 116932 * w_10 + 819281 * w_9 + 2378172 * w_8 + 4341330 * w_7 + 6806004 * w_6 + 10622748 * w_5 + 18739500 * w_4 + 30651894 * w_3 + 30869976 * w_2 + 15431867 * w + 2919016 ) * d_2 / (146966400 * w1_4 * w_7) eta = evaluatePolynomialL (1/a) [eta0, e1, e2, e3] -- Now we solve eq 4.2 to recover x using Newton iterations u = eta - mu * log eta + (1 + mu) * log(1 + mu) - mu cross = 1 / (1 + mu); lower = if eta < mu then cross else 0 upper = if eta < mu then 1 else cross x_guess = (lower + upper) / 2 func x = ( u + log x + mu*log(1 - x) , 1/x - mu/(1-x) ) Root x0 = newtonRaphson 1e-8 (lower, x_guess, upper) func in x0 -- For large a and b approximation from AS109 (Carter -- approximation). It's reasonably good in this region | a > 1 && b > 1 = let r = (y*y - 3) / 6 s = 1 / (2*a - 1) t = 1 / (2*b - 1) h = 2 / (s + t) w = y * sqrt(h + r) / h - (t - s) * (r + 5/6 - 2 / (3 * h)) in a / (a + b * exp(2 * w)) -- Otherwise we revert to approximation from AS64 derived from -- [AS64 2] when it's applicable. -- -- It slightly reduces average number of iterations when `a' and -- `b' have different magnitudes. | chi2 > 0 && ratio > 1 = 1 - 2 / (ratio + 1) -- If all else fails we use approximation from "Numerical -- Recipes". It's very similar to approximations [AS64 4,5] but -- it never goes out of [0,1] interval. | otherwise = case () of _| p < t / w -> (a * p * w) ** (1/a) | otherwise -> 1 - (b * (1 - p) * w) ** (1/b) where lna = log $ a / (a+b) lnb = log $ b / (a+b) t = exp( a * lna ) / a u = exp( b * lnb ) / b w = t + u where -- Formula [AS64 2] ratio = (4*a + 2*b - 2) / chi2 -- Quantile of chi-squared distribution. Formula [AS64 3]. chi2 = 2 * b * (1 - t + y * sqrt t) ** 3 where t = 1 / (9 * b) -- `y' is Hasting's approximation of p'th quantile of standard -- normal distribution. y = r - ( 2.30753 + 0.27061 * r ) / ( 1.0 + ( 0.99229 + 0.04481 * r ) * r ) where r = sqrt $ - 2 * log p ---------------------------------------------------------------- -- Sinc function ---------------------------------------------------------------- -- | Compute sinc function @sin(x)\/x@ sinc :: Double -> Double sinc x | ax < eps_0 = 1 | ax < eps_2 = 1 - x2/6 | ax < eps_4 = 1 - x2/6 + x2*x2/120 | otherwise = sin x / x where ax = abs x x2 = x*x -- For explanation of choice see `doc/sinc.hs' eps_0 = 1.8250120749944284e-8 -- sqrt (6ε/4) eps_2 = 1.4284346431400855e-4 -- (30ε)**(1/4) / 2 eps_4 = 4.043633626430947e-3 -- (1206ε)**(1/6) / 2 ---------------------------------------------------------------- -- Logarithm ---------------------------------------------------------------- -- GHC.Float provides log1p and expm1 since 4.9.0 #if !MIN_VERSION_base(4,9,0) -- | Compute the natural logarithm of 1 + @x@. This is accurate even -- for values of @x@ near zero, where use of @log(1+x)@ would lose -- precision. log1p :: Double -> Double log1p x | x == 0 = 0 | x == -1 = m_neg_inf | x < -1 = m_NaN | x' < m_epsilon * 0.5 = x | (x >= 0 && x < 1e-8) || (x >= -1e-9 && x < 0) = x * (1 - x * 0.5) | x' < 0.375 = x * (1 - x * chebyshevBroucke (x / 0.375) coeffs) | otherwise = log (1 + x) where x' = abs x coeffs = U.fromList [ 0.10378693562743769800686267719098e+1, -0.13364301504908918098766041553133e+0, 0.19408249135520563357926199374750e-1, -0.30107551127535777690376537776592e-2, 0.48694614797154850090456366509137e-3, -0.81054881893175356066809943008622e-4, 0.13778847799559524782938251496059e-4, -0.23802210894358970251369992914935e-5, 0.41640416213865183476391859901989e-6, -0.73595828378075994984266837031998e-7, 0.13117611876241674949152294345011e-7, -0.23546709317742425136696092330175e-8, 0.42522773276034997775638052962567e-9, -0.77190894134840796826108107493300e-10, 0.14075746481359069909215356472191e-10, -0.25769072058024680627537078627584e-11, 0.47342406666294421849154395005938e-12, -0.87249012674742641745301263292675e-13, 0.16124614902740551465739833119115e-13, -0.29875652015665773006710792416815e-14, 0.55480701209082887983041321697279e-15, -0.10324619158271569595141333961932e-15 ] -- | Compute @exp x - 1@ without loss of accuracy for x near zero. expm1 :: Double -> Double #ifdef USE_SYSTEM_EXPM1 expm1 = c_expm1 foreign import ccall "expm1" c_expm1 :: Double -> Double #else -- NOTE: this is simplest implementation and not terribly efficient. expm1 x | x < (-37.42994775023705) = -1 | x > m_max_log = m_pos_inf | abs x > 0.5 = exp x - 1 | otherwise = sumSeries $ liftA2 (*) (scanSequence (*) x (pure x)) (1 / scanSequence (*) 1 (enumSequenceFrom 2)) #endif #endif -- | Compute log(1+x)-x: log1pmx :: Double -> Double log1pmx x | x < -1 = error "Domain error" | x == -1 = m_neg_inf | ax > 0.95 = log(1 + x) - x | ax < m_epsilon = -(x * x) /2 | otherwise = - x * x * sumPowerSeries (-x) (recip <$> enumSequenceFrom 2) where ax = abs x -- | /O(log n)/ Compute the logarithm in base 2 of the given value. log2 :: Int -> Int log2 v0 | v0 <= 0 = modErr $ "log2: nonpositive input, got " ++ show v0 | otherwise = go 5 0 v0 where go !i !r !v | i == -1 = r | v .&. b i /= 0 = let si = U.unsafeIndex sv i in go (i-1) (r .|. si) (v `shiftR` si) | otherwise = go (i-1) r v b = U.unsafeIndex bv !bv = U.fromList [ 0x02, 0x0c, 0xf0, 0xff00 , fromIntegral (0xffff0000 :: Word) , fromIntegral (0xffffffff00000000 :: Word)] !sv = U.fromList [1,2,4,8,16,32] ---------------------------------------------------------------- -- Factorial ---------------------------------------------------------------- -- | Compute the factorial function /n/!. Returns +∞ if the -- input is above 170 (above which the result cannot be represented by -- a 64-bit 'Double'). factorial :: Int -> Double factorial n | n < 0 = error "Numeric.SpecFunctions.factorial: negative input" | n <= 1 = 1 | n <= 170 = U.product $ U.map fromIntegral $ U.enumFromTo 2 n | otherwise = m_pos_inf -- | Compute the natural logarithm of the factorial function. Gives -- 16 decimal digits of precision. logFactorial :: Integral a => a -> Double logFactorial n | n < 0 = error "Numeric.SpecFunctions.logFactorial: negative input" | n <= 14 = log $ factorial $ fromIntegral n -- N.B. Γ(n+1) = n! -- -- We use here asymptotic series for gamma function. See -- http://mathworld.wolfram.com/StirlingsSeries.html | otherwise = (x - 0.5) * log x - x + m_ln_sqrt_2_pi + evaluateOddPolynomialL (1/x) [1/12, -1/360, 1/1260, -1/1680] where x = fromIntegral n + 1 {-# SPECIALIZE logFactorial :: Int -> Double #-} -- | Calculate the error term of the Stirling approximation. This is -- only defined for non-negative values. -- -- \[ -- \operatorname{stirlingError}(n) = \log(n!) - \log(\sqrt{2\pi n}\frac{n}{e}^n) -- \] stirlingError :: Double -> Double stirlingError n | n <= 15.0 = case properFraction (n+n) of (i,0) -> sfe `U.unsafeIndex` i _ -> logGamma (n+1.0) - (n+0.5) * log n + n - m_ln_sqrt_2_pi | n > 500 = evaluateOddPolynomialL (1/n) [s0,-s1] | n > 80 = evaluateOddPolynomialL (1/n) [s0,-s1,s2] | n > 35 = evaluateOddPolynomialL (1/n) [s0,-s1,s2,-s3] | otherwise = evaluateOddPolynomialL (1/n) [s0,-s1,s2,-s3,s4] where s0 = 0.083333333333333333333 -- 1/12 s1 = 0.00277777777777777777778 -- 1/360 s2 = 0.00079365079365079365079365 -- 1/1260 s3 = 0.000595238095238095238095238 -- 1/1680 s4 = 0.0008417508417508417508417508 -- 1/1188 sfe = U.fromList [ 0.0, 0.1534264097200273452913848, 0.0810614667953272582196702, 0.0548141210519176538961390, 0.0413406959554092940938221, 0.03316287351993628748511048, 0.02767792568499833914878929, 0.02374616365629749597132920, 0.02079067210376509311152277, 0.01848845053267318523077934, 0.01664469118982119216319487, 0.01513497322191737887351255, 0.01387612882307074799874573, 0.01281046524292022692424986, 0.01189670994589177009505572, 0.01110455975820691732662991, 0.010411265261972096497478567, 0.009799416126158803298389475, 0.009255462182712732917728637, 0.008768700134139385462952823, 0.008330563433362871256469318, 0.007934114564314020547248100, 0.007573675487951840794972024, 0.007244554301320383179543912, 0.006942840107209529865664152, 0.006665247032707682442354394, 0.006408994188004207068439631, 0.006171712263039457647532867, 0.005951370112758847735624416, 0.005746216513010115682023589, 0.005554733551962801371038690 ] ---------------------------------------------------------------- -- Combinatorics ---------------------------------------------------------------- -- | -- Quickly compute the natural logarithm of /n/ @`choose`@ /k/, with -- no checking. -- -- Less numerically stable: -- -- > exp $ lg (n+1) - lg (k+1) - lg (n-k+1) -- > where lg = logGamma . fromIntegral logChooseFast :: Double -> Double -> Double logChooseFast n k = -log (n + 1) - logBeta (n - k + 1) (k + 1) -- | Calculate binomial coefficient using exact formula chooseExact :: Int -> Int -> Double n `chooseExact` k = U.foldl' go 1 $ U.enumFromTo 1 k where go a i = a * (nk + j) / j where j = fromIntegral i :: Double nk = fromIntegral (n - k) -- | Compute logarithm of the binomial coefficient. logChoose :: Int -> Int -> Double n `logChoose` k | k > n = (-1) / 0 -- For very large N exact algorithm overflows double so we -- switch to beta-function based one | k' < 50 && (n < 20000000) = log $ chooseExact n k' | otherwise = logChooseFast (fromIntegral n) (fromIntegral k) where k' = min k (n-k) -- | Compute the binomial coefficient /n/ @\``choose`\`@ /k/. For -- values of /k/ > 50, this uses an approximation for performance -- reasons. The approximation is accurate to 12 decimal places in the -- worst case -- -- Example: -- -- > 7 `choose` 3 == 35 choose :: Int -> Int -> Double n `choose` k | k > n = 0 | k' < 50 = chooseExact n k' | approx < max64 = fromIntegral . round64 $ approx | otherwise = approx where k' = min k (n-k) approx = exp $ logChooseFast (fromIntegral n) (fromIntegral k') max64 = fromIntegral (maxBound :: Int64) round64 x = round x :: Int64 -- | Compute ψ(/x/), the first logarithmic derivative of the gamma -- function. -- -- \[ -- \psi(x) = \frac{d}{dx} \ln \left(\Gamma(x)\right) = \frac{\Gamma'(x)}{\Gamma(x)} -- \] -- -- Uses Algorithm AS 103 by Bernardo, based on Minka's C implementation. digamma :: Double -> Double digamma x | isNaN x || isInfinite x = m_NaN -- FIXME: -- This is ugly. We are testing here that number is in fact -- integer. It's somewhat tricky question to answer. When ε for -- given number becomes 1 or greater every number is represents -- an integer. We also must make sure that excess precision -- won't bite us. | x <= 0 && fromIntegral (truncate x :: Int64) == x = m_neg_inf -- Jeffery's reflection formula | x < 0 = digamma (1 - x) + pi / tan (negate pi * x) | x <= 1e-6 = - γ - 1/x + trigamma1 * x | x' < c = r -- De Moivre's expansion | otherwise = let s = 1/x' in evaluateEvenPolynomialL s [ r + log x' - 0.5 * s , - 1/12 , 1/120 , - 1/252 , 1/240 , - 1/132 , 391/32760 ] where γ = m_eulerMascheroni c = 12 -- Reduce to digamma (x + n) where (x + n) >= c (r, x') = reduce 0 x where reduce !s y | y < c = reduce (s - 1 / y) (y + 1) | otherwise = (s, y) ---------------------------------------------------------------- -- Constants ---------------------------------------------------------------- -- Coefficients for 18-point Gauss-Legendre integration. They are -- used in implementation of incomplete gamma and beta functions. coefW,coefY :: U.Vector Double coefW = U.fromList [ 0.0055657196642445571, 0.012915947284065419, 0.020181515297735382 , 0.027298621498568734, 0.034213810770299537, 0.040875750923643261 , 0.047235083490265582, 0.053244713977759692, 0.058860144245324798 , 0.064039797355015485, 0.068745323835736408, 0.072941885005653087 , 0.076598410645870640, 0.079687828912071670, 0.082187266704339706 , 0.084078218979661945, 0.085346685739338721, 0.085983275670394821 ] coefY = U.fromList [ 0.0021695375159141994, 0.011413521097787704, 0.027972308950302116 , 0.051727015600492421, 0.082502225484340941, 0.12007019910960293 , 0.16415283300752470, 0.21442376986779355, 0.27051082840644336 , 0.33199876341447887, 0.39843234186401943, 0.46931971407375483 , 0.54413605556657973, 0.62232745288031077, 0.70331500465597174 , 0.78649910768313447, 0.87126389619061517, 0.95698180152629142 ] {-# NOINLINE coefW #-} {-# NOINLINE coefY #-} trigamma1 :: Double trigamma1 = 1.6449340668482264365 -- pi**2 / 6 modErr :: String -> a modErr msg = error $ "Numeric.SpecFunctions." ++ msg math-functions-0.2.1.0/Numeric/SpecFunctions/Extra.hs0000644000000000000000000000674413020035203020600 0ustar0000000000000000-- | -- Module : Numeric.SpecFunctions.Extra -- Copyright : (c) 2009, 2011 Bryan O'Sullivan -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- Less common mathematical functions. module Numeric.SpecFunctions.Extra ( bd0 , chooseExact , logChooseFast , logGammaAS245 , logGammaCorrection ) where import Numeric.MathFunctions.Constants (m_NaN,m_pos_inf) import Numeric.SpecFunctions.Internal (chooseExact,logChooseFast,logGammaCorrection) -- | Evaluate the deviance term @x log(x/np) + np - x@. bd0 :: Double -- ^ @x@ -> Double -- ^ @np@ -> Double bd0 x np | isInfinite x || isInfinite np || np == 0 = m_NaN | abs x_np >= 0.1*(x+np) = x * log (x/np) - x_np | otherwise = loop 1 (ej0*vv) s0 where x_np = x - np v = x_np / (x+np) s0 = x_np * v ej0 = 2*x*v vv = v*v loop j ej s = case s + ej/(2*j+1) of s' | s' == s -> s' -- FIXME: Comparing Doubles for equality! | otherwise -> loop (j+1) (ej*vv) s' -- | Compute the logarithm of the gamma function Γ(/x/). Uses -- Algorithm AS 245 by Macleod. -- -- Gives an accuracy of 10-12 significant decimal digits, except -- for small regions around /x/ = 1 and /x/ = 2, where the function -- goes to zero. For greater accuracy, use 'logGammaL'. -- -- Returns ∞ if the input is outside of the range (0 < /x/ ≤ 1e305). logGammaAS245 :: Double -> Double -- Adapted from http://people.sc.fsu.edu/~burkardt/f_src/asa245/asa245.html logGammaAS245 x | x <= 0 = m_pos_inf -- Handle positive infinity. logGamma overflows before 1e308 so -- it's safe | x > 1e308 = m_pos_inf -- Normal cases | x < 1.5 = a + c * ((((r1_4 * b + r1_3) * b + r1_2) * b + r1_1) * b + r1_0) / ((((b + r1_8) * b + r1_7) * b + r1_6) * b + r1_5) | x < 4 = (x - 2) * ((((r2_4 * x + r2_3) * x + r2_2) * x + r2_1) * x + r2_0) / ((((x + r2_8) * x + r2_7) * x + r2_6) * x + r2_5) | x < 12 = ((((r3_4 * x + r3_3) * x + r3_2) * x + r3_1) * x + r3_0) / ((((x + r3_8) * x + r3_7) * x + r3_6) * x + r3_5) | x > 3e6 = k | otherwise = k + x1 * ((r4_2 * x2 + r4_1) * x2 + r4_0) / ((x2 + r4_4) * x2 + r4_3) where (a , b , c) | x < 0.5 = (-y , x + 1 , x) | otherwise = (0 , x , x - 1) y = log x k = x * (y-1) - 0.5 * y + alr2pi alr2pi = 0.918938533204673 x1 = 1 / x x2 = x1 * x1 r1_0 = -2.66685511495; r1_1 = -24.4387534237; r1_2 = -21.9698958928 r1_3 = 11.1667541262; r1_4 = 3.13060547623; r1_5 = 0.607771387771 r1_6 = 11.9400905721; r1_7 = 31.4690115749; r1_8 = 15.2346874070 r2_0 = -78.3359299449; r2_1 = -142.046296688; r2_2 = 137.519416416 r2_3 = 78.6994924154; r2_4 = 4.16438922228; r2_5 = 47.0668766060 r2_6 = 313.399215894; r2_7 = 263.505074721; r2_8 = 43.3400022514 r3_0 = -2.12159572323e5; r3_1 = 2.30661510616e5; r3_2 = 2.74647644705e4 r3_3 = -4.02621119975e4; r3_4 = -2.29660729780e3; r3_5 = -1.16328495004e5 r3_6 = -1.46025937511e5; r3_7 = -2.42357409629e4; r3_8 = -5.70691009324e2 r4_0 = 0.279195317918525; r4_1 = 0.4917317610505968; r4_2 = 0.0692910599291889; r4_3 = 3.350343815022304 r4_4 = 6.012459259764103 math-functions-0.2.1.0/Numeric/Polynomial/0000755000000000000000000000000013020035203016506 5ustar0000000000000000math-functions-0.2.1.0/Numeric/Polynomial/Chebyshev.hs0000644000000000000000000000464413020035203020772 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} -- | -- Module : Numeric.Polynomial.Chebyshev -- Copyright : (c) 2009, 2011 Bryan O'Sullivan -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- Chebyshev polynomials. module Numeric.Polynomial.Chebyshev ( -- * Chebyshev polinomials -- $chebyshev chebyshev , chebyshevBroucke -- * References -- $references ) where import qualified Data.Vector.Generic as G -- $chebyshev -- -- A Chebyshev polynomial of the first kind is defined by the -- following recurrence: -- -- \[\begin{aligned} -- T_0(x) &= 1 \\ -- T_1(x) &= x \\ -- T_{n+1}(x) &= 2xT_n(x) - T_{n-1}(x) \\ -- \end{aligned} -- \] data C = C {-# UNPACK #-} !Double {-# UNPACK #-} !Double -- | Evaluate a Chebyshev polynomial of the first kind. Uses -- Clenshaw's algorithm. chebyshev :: (G.Vector v Double) => Double -- ^ Parameter of each function. -> v Double -- ^ Coefficients of each polynomial term, in increasing order. -> Double chebyshev x a = fini . G.foldr' step (C 0 0) . G.tail $ a where step k (C b0 b1) = C (k + x2 * b0 - b1) b0 fini (C b0 b1) = G.head a + x * b0 - b1 x2 = x * 2 {-# INLINE chebyshev #-} data B = B {-# UNPACK #-} !Double {-# UNPACK #-} !Double {-# UNPACK #-} !Double -- | Evaluate a Chebyshev polynomial of the first kind. Uses Broucke's -- ECHEB algorithm, and his convention for coefficient handling. It -- treat 0th coefficient different so -- -- > chebyshev x [a0,a1,a2...] == chebyshevBroucke [2*a0,a1,a2...] chebyshevBroucke :: (G.Vector v Double) => Double -- ^ Parameter of each function. -> v Double -- ^ Coefficients of each polynomial term, in increasing order. -> Double chebyshevBroucke x = fini . G.foldr' step (B 0 0 0) where step k (B b0 b1 _) = B (k + x2 * b0 - b1) b0 b1 fini (B b0 _ b2) = (b0 - b2) * 0.5 x2 = x * 2 {-# INLINE chebyshevBroucke #-} -- $references -- -- * Broucke, R. (1973) Algorithm 446: Ten subroutines for the -- manipulation of Chebyshev series. /Communications of the ACM/ -- 16(4):254–256. -- -- * Clenshaw, C.W. (1962) Chebyshev series for mathematical -- functions. /National Physical Laboratory Mathematical Tables 5/, -- Her Majesty's Stationery Office, London. -- math-functions-0.2.1.0/benchmark/0000755000000000000000000000000013020035203014713 5ustar0000000000000000math-functions-0.2.1.0/benchmark/bench.hs0000644000000000000000000000466413020035203016340 0ustar0000000000000000import Criterion.Main import qualified Data.Vector.Unboxed as U import Numeric.SpecFunctions import Numeric.Polynomial import Text.Printf -- Uniformly sample logGamma performance between 10^-6 to 10^6 benchmarkLogGamma logG = [ bench (printf "%.3g" x) $ nf logG x | x <- [ m * 10**n | n <- [ -8 .. 8 ] , m <- [ 10**(i / tics) | i <- [0 .. tics-1] ] ] ] where tics = 3 {-# INLINE benchmarkLogGamma #-} -- Power of polynomial to be evaluated (In other words length of coefficients vector) coef_size :: [Int] coef_size = [ 1,2,3,4,5,6,7,8,9 , 10, 30 , 100, 300 , 1000, 3000 , 10000, 30000 ] {-# INLINE coef_size #-} -- Precalculated coefficients coef_list :: [U.Vector Double] coef_list = [ U.replicate n 1.2 | n <- coef_size] {-# NOINLINE coef_list #-} main :: IO () main = defaultMain [ bgroup "logGamma" $ benchmarkLogGamma logGamma , bgroup "logGammaL" $ benchmarkLogGamma logGammaL , bgroup "incompleteGamma" $ [ bench (show p) $ nf (incompleteGamma p) p | p <- [ 0.1 , 1, 3 , 10, 30 , 100, 300 , 999, 1000 ] ] , bgroup "factorial" [ bench (show n) $ nf factorial n | n <- [ 0, 1, 3, 6, 9, 11, 15 , 20, 30, 40, 50, 60, 70, 80, 90, 100 ] ] , bgroup "incompleteBeta" [ bench (show (p,q,x)) $ nf (incompleteBeta p q) x | (p,q,x) <- [ (10, 10, 0.5) , (101, 101, 0.5) , (1010, 1010, 0.5) , (10100, 10100, 0.5) , (100100, 100100, 0.5) , (1001000, 1001000, 0.5) , (10010000,10010000,0.5) ] ] , bgroup "log1p" [ bench (show x) $ nf log1p x | x <- [ -0.9 , -0.5 , -0.1 , 0.1 , 0.5 , 1 , 10 , 100 ] ] , bgroup "sinc" $ bench "sin" (nf sin (0.55 :: Double)) : [ bench (show x) $ nf sinc x | x <- [0, 1e-6, 1e-3, 0.5] ] , bgroup "poly" $ [ bench ("vector_"++show (U.length coefs)) $ nf (\x -> evaluatePolynomial x coefs) (1 :: Double) | coefs <- coef_list ] ++ [ bench ("unpacked_"++show n) $ nf (\x -> evaluatePolynomialL x (map fromIntegral [1..n])) (1 :: Double) | n <- coef_size ] ] math-functions-0.2.1.0/benchmark/Summation.hs0000644000000000000000000000067613020035203017234 0ustar0000000000000000import Criterion.Main import Numeric.Sum as Sum import System.Random.MWC import qualified Data.Vector.Unboxed as U main = do gen <- createSystemRandom v <- uniformVector gen 10000000 :: IO (U.Vector Double) defaultMain [ bench "naive" $ whnf U.sum v , bench "pairwise" $ whnf pairwiseSum v , bench "kahan" $ whnf (sumVector kahan) v , bench "kbn" $ whnf (sumVector kbn) v , bench "kb2" $ whnf (sumVector kb2) v ]