log-domain 0.12 → 0.13
raw patch · 8 files changed
+237/−244 lines, 8 filesdep ~basedep ~doctest
Dependency ranges changed: base, doctest
Files
- .gitignore +18/−2
- .hlint.yaml +3/−0
- .travis.yml +162/−93
- CHANGELOG.markdown +3/−2
- HLint.hs +0/−1
- log-domain.cabal +14/−6
- src/Numeric/Log.hs +10/−110
- src/Numeric/Log/Signed.hs +27/−30
.gitignore view
@@ -1,5 +1,3 @@-.cabal-sandbox-cabal.sandbox.config dist dist-newstyle docs@@ -14,3 +12,21 @@ *.hi *~ *#+.stack-work/+cabal-dev+*.chi+*.chs.h+*.dyn_o+*.dyn_hi+.hpc+.hsenv+.cabal-sandbox/+cabal.sandbox.config+*.prof+*.aux+*.hp+*.eventlog+cabal.project.local+cabal.project.local~+.HTF/+.ghc.environment.*
+ .hlint.yaml view
@@ -0,0 +1,3 @@+- arguments: [--cpp-define=HLINT, --cpp-ansi, --cpp-define=__USE_FFI__]++- ignore: {name: Use camelCase}
.travis.yml view
@@ -1,106 +1,175 @@-# This file has been generated -- see https://github.com/hvr/multi-ghc-travis+# This Travis job script has been generated by a script via+#+# haskell-ci '--output=.travis.yml' '--config=cabal.haskell-ci' 'cabal.project'+#+# For more information, see https://github.com/haskell-CI/haskell-ci+#+# version: 0.5.20180830+# language: c-sudo: false-+dist: xenial+git:+ # whether to recursively clone submodules+ submodules: false+notifications:+ irc:+ channels:+ - irc.freenode.org#haskell-lens+ skip_join: true+ template:+ - "\"\\x0313log-domain\\x03/\\x0306%{branch}\\x03 \\x0314%{commit}\\x03 %{build_url} %{message}\"" cache: directories:- - $HOME/.cabsnap - $HOME/.cabal/packages-+ - $HOME/.cabal/store before_cache:- - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log- - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar-+ - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log+ # remove files that are regenerated by 'cabal update'+ - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*+ - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx+ - rm -rfv $CABALHOME/packages/head.hackage matrix: include:- - env: CABALVER=1.24 GHCVER=7.4.2- compiler: ": #GHC 7.4.2"- addons: {apt: {packages: [cabal-install-1.24,ghc-7.4.2,hlint], sources: [hvr-ghc]}}- - env: CABALVER=1.24 GHCVER=7.6.3- compiler: ": #GHC 7.6.3"- addons: {apt: {packages: [cabal-install-1.24,ghc-7.6.3,hlint], sources: [hvr-ghc]}}- - env: CABALVER=1.24 GHCVER=7.8.4- compiler: ": #GHC 7.8.4"- addons: {apt: {packages: [cabal-install-1.24,ghc-7.8.4,hlint], sources: [hvr-ghc]}}- - env: CABALVER=1.24 GHCVER=7.10.3- compiler: ": #GHC 7.10.3"- addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.3,hlint], sources: [hvr-ghc]}}- - env: CABALVER=1.24 GHCVER=8.0.2- compiler: ": #GHC 8.0.2"- addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2,hlint], sources: [hvr-ghc]}}- - env: CABALVER=2.0 GHCVER=8.2.1- compiler: ": #GHC 8.2.1"- addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.1,hlint], sources: [hvr-ghc]}}- - env: CABALVER=1.24 GHCVER=head- compiler: ": #GHC head"- addons: {apt: {packages: [cabal-install-1.24,ghc-head,hlint], sources: [hvr-ghc]}}-+ - compiler: ghc-8.8.1+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}}+ - compiler: ghc-8.6.5+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-3.0"]}}+ - compiler: ghc-8.4.4+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-3.0"]}}+ - compiler: ghc-8.2.2+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-3.0"]}}+ - compiler: ghc-8.0.2+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-3.0"]}}+ - compiler: ghc-7.10.3+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-3.0"]}}+ - compiler: ghc-7.8.4+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-3.0"]}}+ - compiler: ghc-7.6.3+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.6.3","cabal-install-3.0"]}}+ - compiler: ghc-7.4.2+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.4.2","cabal-install-3.0"]}}+ - compiler: ghc-head+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-head","cabal-install-head"]}} allow_failures:- - env: CABALVER=1.24 GHCVER=head-+ - compiler: ghc-head before_install:- - unset CC- - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH-+ - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')+ - WITHCOMPILER="-w $HC"+ - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')+ - HCPKG="$HC-pkg"+ - unset CC+ - CABAL=/opt/ghc/bin/cabal+ - CABALHOME=$HOME/.cabal+ - export PATH="$CABALHOME/bin:$PATH"+ - TOP=$(pwd)+ - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"+ - echo $HCNUMVER+ - CABAL="$CABAL -vnormal+nowrap+markoutput"+ - set -o pipefail+ - |+ echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk+ echo 'BEGIN { state = "output"; }' >> .colorful.awk+ echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk+ echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk+ echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk+ echo ' if (state == "cabal") {' >> .colorful.awk+ echo ' print blue($0)' >> .colorful.awk+ echo ' } else {' >> .colorful.awk+ echo ' print $0' >> .colorful.awk+ echo ' }' >> .colorful.awk+ echo '}' >> .colorful.awk+ - cat .colorful.awk+ - |+ color_cabal_output () {+ awk -f $TOP/.colorful.awk+ }+ - echo text | color_cabal_output install:- - cabal --version- - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"- - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];- then- zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >- $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;- fi- - travis_retry cabal update -v- - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config- - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt- - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt--# check whether current requested install-plan matches cached package-db snapshot- - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;- then- echo "cabal build-cache HIT";- rm -rfv .ghc;- cp -a $HOME/.cabsnap/ghc $HOME/.ghc;- cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;- else- echo "cabal build-cache MISS";- rm -rf $HOME/.cabsnap;- mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;- cabal install -j --only-dependencies --enable-tests --enable-benchmarks;- fi--# snapshot package-db on cache miss- - if [ ! -d $HOME/.cabsnap ];- then- echo "snapshotting package-db to build-cache";- mkdir $HOME/.cabsnap;- cp -a $HOME/.ghc $HOME/.cabsnap/ghc;- cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;- fi--# Here starts the actual work to be performed for the package under test;-# any command which exits with a non-zero exit code causes the build to fail.+ - ${CABAL} --version+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"+ - TEST=--enable-tests+ - BENCH=--enable-benchmarks+ - HEADHACKAGE=false+ - if [ $HCNUMVER -gt 80801 ] ; then HEADHACKAGE=true ; fi+ - rm -f $CABALHOME/config+ - |+ echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config+ echo "remote-build-reporting: anonymous" >> $CABALHOME/config+ echo "write-ghc-environment-files: always" >> $CABALHOME/config+ echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config+ echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config+ echo "world-file: $CABALHOME/world" >> $CABALHOME/config+ echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config+ echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config+ echo "installdir: $CABALHOME/bin" >> $CABALHOME/config+ echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config+ echo "store-dir: $CABALHOME/store" >> $CABALHOME/config+ echo "install-dirs user" >> $CABALHOME/config+ echo " prefix: $CABALHOME" >> $CABALHOME/config+ echo "repository hackage.haskell.org" >> $CABALHOME/config+ echo " url: http://hackage.haskell.org/" >> $CABALHOME/config+ - |+ if $HEADHACKAGE; then+ echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1/g')" >> $CABALHOME/config+ echo "repository head.hackage.ghc.haskell.org" >> $CABALHOME/config+ echo " url: https://ghc.gitlab.haskell.org/head.hackage/" >> $CABALHOME/config+ echo " secure: True" >> $CABALHOME/config+ echo " root-keys: 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d" >> $CABALHOME/config+ echo " 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329" >> $CABALHOME/config+ echo " f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89" >> $CABALHOME/config+ echo " key-threshold: 3" >> $CABALHOME/config+ fi+ - cat $CABALHOME/config+ - rm -fv cabal.project cabal.project.local cabal.project.freeze+ - travis_retry ${CABAL} v2-update -v+ - if [ $HCNUMVER -ge 80800 ] && [ $HCNUMVER -lt 80802 ] ; then (cd /tmp && ${CABAL} v2-install $WITHCOMPILER -j2 hlint --constraint='hlint ==2.1.*' | color_cabal_output) ; fi+ # Generate cabal.project+ - rm -rf cabal.project cabal.project.local cabal.project.freeze+ - touch cabal.project+ - |+ echo "packages: ." >> cabal.project+ - |+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(log-domain)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"+ - cat cabal.project || true+ - cat cabal.project.local || true+ - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi+ - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output+ - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"+ - rm cabal.project.freeze+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output script:- - cabal configure -v2 --enable-tests --enable-benchmarks # -v2 provides useful information for debugging- - cabal build # this builds all libraries and executables (including tests/benchmarks)- - cabal test --show-details=always- - cabal sdist # tests that a source-distribution can be generated- - hlint src --cpp-define HLINT- - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;- cd dist/;- if [ -f "$SRC_TGZ" ]; then- cabal install "$SRC_TGZ";- else- echo "expected '$SRC_TGZ' not found";- exit 1;- fi--notifications:- irc:- channels:- - "irc.freenode.org#haskell-lens"- skip_join: true- template:- - "\x0313log-domain\x0f/\x0306%{branch}\x0f \x0314%{commit}\x0f %{message} \x0302\x1f%{build_url}\x0f"+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)+ # Packaging...+ - ${CABAL} v2-sdist all | color_cabal_output+ # Unpacking...+ - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/+ - cd ${DISTDIR} || false+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;+ - PKGDIR_log_domain="$(find . -maxdepth 1 -type d -regex '.*/log-domain-[0-9.]*')"+ # Generate cabal.project+ - rm -rf cabal.project cabal.project.local cabal.project.freeze+ - touch cabal.project+ - |+ echo "packages: ${PKGDIR_log_domain}" >> cabal.project+ - |+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(log-domain)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"+ - cat cabal.project || true+ - cat cabal.project.local || true+ # Building with tests and benchmarks...+ # build & run tests, build benchmarks+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output+ # Testing...+ - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output+ # HLint..+ - if [ $HCNUMVER -ge 80800 ] && [ $HCNUMVER -lt 80802 ] ; then (cd ${PKGDIR_log_domain} && hlint src) ; fi+ # cabal check...+ - (cd ${PKGDIR_log_domain} && ${CABAL} -vnormal check)+ # haddock...+ - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all | color_cabal_output +# REGENDATA ["--output=.travis.yml","--config=cabal.haskell-ci","cabal.project"] # EOF
CHANGELOG.markdown view
@@ -1,5 +1,6 @@-0.12-----+0.12 [2018.01.18]+-----------------+* Add `Semigroup` instance for `Log`. * Drop `safecopy` support * Removed some unused constraints.
− HLint.hs
@@ -1,1 +0,0 @@-ignore "Use camelCase"
log-domain.cabal view
@@ -1,6 +1,6 @@ name: log-domain category: Numeric-version: 0.12+version: 0.13 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE@@ -11,7 +11,15 @@ bug-reports: http://github.com/ekmett/log-domain/issues copyright: Copyright (C) 2013-2015 Edward A. Kmett build-type: Custom-tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2+tested-with: GHC == 7.4.2+ , GHC == 7.6.3+ , GHC == 7.8.4+ , GHC == 7.10.3+ , GHC == 8.0.2+ , GHC == 8.2.2+ , GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.1 synopsis: Log-domain arithmetic description: This package provides log-domain floats, doubles and complex numbers. @@ -19,13 +27,13 @@ .travis.yml .ghci .gitignore+ .hlint.yaml .vim.custom travis/cabal-apt-install travis/config AUTHORS.markdown README.markdown CHANGELOG.markdown- HLint.hs Warning.hs source-repository head@@ -34,7 +42,7 @@ custom-setup setup-depends:- base >= 4 && < 5,+ base >= 4.9 && < 5, Cabal, cabal-doctest >= 1 && < 1.1 @@ -56,7 +64,7 @@ comonad >= 4 && < 6, deepseq >= 1.3 && < 1.5, distributive >= 0.3 && < 1,- hashable >= 1.2.5 && < 1.3,+ hashable >= 1.2.5 && < 1.4, semigroupoids >= 4 && < 6, semigroups >= 0.8.4 && < 1, vector >= 0.9 && < 0.13@@ -84,7 +92,7 @@ else build-depends: base,- doctest >= 0.11.1 && < 0.14,+ doctest >= 0.11.1 && < 0.17, generic-deriving, log-domain, semigroups >= 0.9,
src/Numeric/Log.hs view
@@ -4,7 +4,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Trustworthy #-} --------------------------------------------------------------------@@ -18,7 +17,6 @@ -------------------------------------------------------------------- module Numeric.Log ( Log(..)- , Precise(..) , sum ) where @@ -31,7 +29,6 @@ import Control.Monad import Data.Binary as Binary import Data.Bytes.Serial-import Data.Complex import Data.Data import Data.Distributive import Data.Foldable as Foldable hiding (sum)@@ -55,6 +52,7 @@ import Foreign.Ptr import Foreign.Storable import GHC.Generics+import Numeric import Text.Read as T import Text.Show as T @@ -172,7 +170,7 @@ Exp a >>= f = f a {-# INLINE (>>=) #-} -instance (RealFloat a, Precise a, Enum a) => Enum (Log a) where+instance (RealFloat a, Enum a) => Enum (Log a) where succ a = a + 1 {-# INLINE succ #-} pred a = a - 1@@ -299,7 +297,7 @@ -- >>> signum (Exp (0/0)) :: Log Double -- NaN -instance (Precise a, RealFloat a) => Num (Log a) where+instance RealFloat a => Num (Log a) where Exp a * Exp b = Exp (a + b) {-# INLINE (*) #-} Exp a + Exp b@@ -325,7 +323,7 @@ fromInteger = Exp . log . fromInteger {-# INLINE fromInteger #-} -instance (Precise a, RealFloat a) => Fractional (Log a) where+instance RealFloat a => Fractional (Log a) where -- n/0 == infinity is handled seamlessly for us, as is 0/0 and infinity/infinity NaNs, and 0/infinity == 0. Exp a / Exp b = Exp (a-b) {-# INLINE (/) #-}@@ -340,7 +338,7 @@ -- >>> (properFraction 0.5 :: (Integer, Log Double)) -- (0,0.5) -instance (Precise a, RealFloat a) => RealFrac (Log a) where+instance RealFloat a => RealFrac (Log a) where properFraction l | ln l < 0 = (0, l) | otherwise = (\(b,a) -> (b, Exp $ log a)) $ properFraction $ exp (ln l)@@ -395,13 +393,13 @@ basicUnsafeCopy (MV_Log mv) (V_Log v) = G.basicUnsafeCopy mv v elemseq _ (Exp x) z = G.elemseq (undefined :: U.Vector a) x z -instance (Precise a, RealFloat a, Ord a) => Real (Log a) where+instance (RealFloat a, Ord a) => Real (Log a) where toRational (Exp a) = toRational (exp a) {-# INLINE toRational #-} data Acc1 a = Acc1 {-# UNPACK #-} !Int64 !a -instance (Precise a, RealFloat a) => Semigroup (Log a) where+instance RealFloat a => Semigroup (Log a) where (<>) = (+) {-# INLINE (<>) #-} sconcat (Exp z :| zs) = Exp $ case List.foldl' step1 (Acc1 0 z) zs of@@ -413,7 +411,7 @@ step2 a r (Exp x) = r + expm1 (x - a) {-# INLINE sconcat #-} -instance (Precise a, RealFloat a) => Monoid (Log a) where+instance RealFloat a => Monoid (Log a) where mempty = Exp negInf {-# INLINE mempty #-} #if !(MIN_VERSION_base(4,11,0))@@ -446,7 +444,7 @@ -- True -- -- /NB:/ This does require two passes over the data.-sum :: (RealFloat a, Precise a, Foldable f) => f (Log a) -> Log a+sum :: (RealFloat a, Foldable f) => f (Log a) -> Log a sum xs = Exp $ case Foldable.foldl' step1 None xs of None -> negInf Acc nm1 a@@ -458,7 +456,7 @@ step2 a r (Exp x) = r + expm1 (x - a) {-# INLINE sum #-} -instance (RealFloat a, Precise a) => Floating (Log a) where+instance RealFloat a => Floating (Log a) where pi = Exp (log pi) {-# INLINE pi #-} exp (Exp a) = Exp (exp a)@@ -503,101 +501,3 @@ "realToFrac" realToFrac = exp . ln :: Log Float -> Float "realToFrac" realToFrac = Exp . log :: Double -> Log Double "realToFrac" realToFrac = Exp . log :: Float -> Log Float #-}---- | This provides @log1p@ and @expm1@ for working more accurately with small numbers.-class Floating a => Precise a where- -- | Computes @log(1 + x)@- --- -- This is far enough from 0 that the Taylor series is defined.- --- -- This can provide much more accurate answers for logarithms of numbers close to 1 (x near 0).- --- -- These arise when working wth log-scale probabilities a lot.- log1p :: a -> a-- -- | The Taylor series for exp(x) is given by- --- -- > exp(x) = 1 + x + x^2/2! + ...- --- -- When @x@ is small, the leading 1 consumes all of the available precision.- --- -- This computes:- --- -- > exp(x) - 1 = x + x^2/2! + ..- --- -- which can afford you a great deal of additional precision if you move things around- -- algebraically to provide the 1 by other means.- expm1 :: a -> a-- log1pexp :: a -> a- log1pexp a = log1p (exp a)-- log1mexp :: a -> a- log1mexp a = log1p (negate (exp a))--instance Precise Double where- log1p = c_log1p- {-# INLINE log1p #-}- expm1 = c_expm1- {-# INLINE expm1 #-}- log1mexp a- | a <= log 2 = log (negate (expm1 a))- | otherwise = log1p (negate (exp a))- {-# INLINE log1mexp #-}- log1pexp a- | a <= 18 = log1p (exp a)- | a <= 100 = a + exp (negate a)- | otherwise = a- {-# INLINE log1pexp #-}---instance Precise Float where- log1p = c_log1pf- {-# INLINE log1p #-}- expm1 = c_expm1f- {-# INLINE expm1 #-}- log1mexp a | a <= log 2 = log (negate (expm1 a))- | otherwise = log1p (negate (exp a))- {-# INLINE log1mexp #-}- log1pexp a- | a <= 18 = log1p (exp a)- | a <= 100 = a + exp (negate a)- | otherwise = a- {-# INLINE log1pexp #-}--instance (RealFloat a, Precise a) => Precise (Complex a) where- expm1 x@(a :+ b)- | a*a + b*b < 1, u <- expm1 a, v <- sin (b/2), w <- -2*v*v = (u*w+u+w) :+ (u+1)*sin b- | otherwise = exp x - 1- {-# INLINE expm1 #-}- log1p x@(a :+ b)- | abs a < 0.5 && abs b < 0.5, u <- 2*a+a*a+b*b = log1p (u/(1+sqrt (u+1))) :+ atan2 (1 + a) b- | otherwise = log (1 + x)- {-# INLINE log1p #-}--#ifdef __USE_FFI__--foreign import ccall unsafe "math.h log1p" c_log1p :: Double -> Double-foreign import ccall unsafe "math.h expm1" c_expm1 :: Double -> Double-foreign import ccall unsafe "math.h expm1f" c_expm1f :: Float -> Float-foreign import ccall unsafe "math.h log1pf" c_log1pf :: Float -> Float--#else--c_log1p :: Double -> Double-{-# INLINE c_log1p #-}-c_log1p x = log (1 + x)--c_expm1 :: Double -> Double-{-# INLINE c_expm1 #-}-c_expm1 x = exp x - 1--c_expm1f :: Float -> Float-{-# INLINE c_expm1f #-}-c_expm1f x = exp x - 1--c_log1pf :: Float -> Float-{-# INLINE c_log1pf #-}-c_log1pf x = log (1 + x)--#endif
src/Numeric/Log/Signed.hs view
@@ -1,12 +1,8 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PatternGuards #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE Trustworthy #-} {-# LANGUAGE ScopedTypeVariables #-} -------------------------------------------------------------------- -- |@@ -18,16 +14,16 @@ -- -------------------------------------------------------------------- module Numeric.Log.Signed- ( SignedLog(..)- ) where+( SignedLog(..)+) where -import Numeric.Log (Precise(..)) #if __GLASGOW_HASKELL__ < 710 import Data.Monoid (Monoid(..)) #endif import Data.Data (Data(..)) import GHC.Generics (Generic(..)) import Data.Typeable (Typeable)+import Numeric import Text.Read as T import Text.Show as T #if __GLASGOW_HASKELL__ < 710@@ -80,7 +76,7 @@ instance (Show a, RealFloat a, Eq a, Fractional a) => Show (SignedLog a) where showsPrec d (SLExp s a) = (if not s && a /= negInf && not (isNaN a) then T.showChar '-' else id) . T.showsPrec d (exp a) -instance (Precise a, RealFloat a, Read a) => Read (SignedLog a) where+instance (RealFloat a, Read a) => Read (SignedLog a) where readPrec = (realToFrac :: a -> SignedLog a) <$> step T.readPrec nxor :: Bool -> Bool -> Bool@@ -102,16 +98,16 @@ -- >>> (1 - 3 :: SignedLog Float) ~= (-2) -- True ----- >>> (SLExp True (1/0)) - (SLExp True (1/0)) :: SignedLog Double+-- >>> SLExp True (1/0) - SLExp True (1/0) :: SignedLog Double -- NaN -- -- >>> 0 - 0 :: SignedLog Double -- 0.0 ----- >>> 0 - (SLExp True (1/0)) :: SignedLog Double+-- >>> 0 - SLExp True (1/0) :: SignedLog Double -- -Infinity ----- >>> (SLExp True (1/0)) - 0.0 :: SignedLog Double+-- >>> SLExp True (1/0) - 0.0 :: SignedLog Double -- Infinity -- -- Multiplication@@ -119,19 +115,19 @@ -- >>> (3 * 2 :: SignedLog Double) ~= 6 -- True ----- >>> 0 * (SLExp True (1/0)) :: SignedLog Double+-- >>> 0 * SLExp True (1/0) :: SignedLog Double -- NaN ----- >>> (SLExp True (1/0)) * (SLExp True (1/0)) :: SignedLog Double+-- >>> SLExp True (1/0) * SLExp True (1/0) :: SignedLog Double -- Infinity -- -- >>> 0 * 0 :: SignedLog Double -- 0.0 ----- >>> (SLExp True (0/0)) * 0 :: SignedLog Double+-- >>> SLExp True (0/0) * 0 :: SignedLog Double -- NaN ----- >>> (SLExp True (0/0)) * (SLExp True (1/0)) :: SignedLog Double+-- >>> SLExp True (0/0) * SLExp True (1/0) :: SignedLog Double -- NaN -- -- Addition@@ -142,10 +138,10 @@ -- >>> 0 + 0 :: SignedLog Double -- 0.0 ----- >>> (SLExp True (1/0)) + (SLExp True (1/0)) :: SignedLog Double+-- >>> SLExp True (1/0) + SLExp True (1/0) :: SignedLog Double -- Infinity ----- >>> (SLExp True (1/0)) + 0 :: SignedLog Double+-- >>> SLExp True (1/0) + 0 :: SignedLog Double -- Infinity -- -- Division@@ -156,13 +152,13 @@ -- >>> 3 / 0 :: SignedLog Double -- Infinity ----- >>> (SLExp True (1/0)) / 0 :: SignedLog Double+-- >>> SLExp True (1/0) / 0 :: SignedLog Double -- Infinity ----- >>> 0 / (SLExp True (1/0)) :: SignedLog Double+-- >>> 0 / SLExp True (1/0) :: SignedLog Double -- 0.0 ----- >>> (SLExp True (1/0)) / (SLExp True (1/0)) :: SignedLog Double+-- >>> SLExp True (1/0) / SLExp True (1/0) :: SignedLog Double -- NaN -- -- >>> 0 / 0 :: SignedLog Double@@ -190,10 +186,10 @@ -- >>> signum (SLExp True (0/0)) :: SignedLog Double -- NaN -instance (Precise a, RealFloat a) => Num (SignedLog a) where- (SLExp sA a) * (SLExp sB b) = SLExp (nxor sA sB) (a+b)+instance RealFloat a => Num (SignedLog a) where+ SLExp sA a * SLExp sB b = SLExp (nxor sA sB) (a+b) {-# INLINE (*) #-}- (SLExp sA a) + (SLExp sB b)+ SLExp sA a + SLExp sB b | a == b && isInfinite a && (a < 0 || nxor sA sB) = SLExp True a | sA == sB && a >= b = SLExp sA (a + log1pexp (b - a)) | sA == sB && otherwise = SLExp sA (b + log1pexp (a - b))@@ -213,8 +209,8 @@ negate (SLExp sA a) = SLExp (not sA) a {-# INLINE negate #-} -instance (Precise a, RealFloat a) => Fractional (SignedLog a) where- (SLExp sA a) / (SLExp sB b) = SLExp (nxor sA sB) (a-b)+instance RealFloat a => Fractional (SignedLog a) where+ SLExp sA a / SLExp sB b = SLExp (nxor sA sB) (a-b) {-# INLINE (/) #-} fromRational a = SLExp (a >= 0) $ log $ fromRational $ abs a {-# INLINE fromRational #-}@@ -224,7 +220,7 @@ -- >>> (toRational (-3.5 :: SignedLog Double)) -- (-7) % 2 -instance (Precise a, RealFloat a, Ord a) => Real (SignedLog a) where+instance (RealFloat a, Ord a) => Real (SignedLog a) where toRational (SLExp sA a) = toRational $ multSign sA $ exp a {-# INLINE toRational #-} @@ -233,7 +229,7 @@ where value = f $ multSign sA $ exp a {-# INLINE logMap #-} -instance (RealFloat a, Precise a) => Floating (SignedLog a) where+instance RealFloat a => Floating (SignedLog a) where pi = SLExp True (log pi) {-# INLINE pi #-} exp (SLExp sA a) = SLExp True (multSign sA $ exp a)@@ -241,7 +237,7 @@ log (SLExp True a) = SLExp (a >= 0) (log $ abs a) log (SLExp False _) = nan {-# INLINE log #-}- (SLExp sB b) ** (SLExp sE e) | sB || e == 0 || isInfinite e = SLExp sB (b * (multSign sE $ exp e))+ (SLExp sB b) ** (SLExp sE e) | sB || e == 0 || isInfinite e = SLExp sB (b * multSign sE (exp e)) _ ** _ = nan {-# INLINE (**) #-} sqrt (SLExp True a) = SLExp True (a / 2)@@ -284,7 +280,8 @@ -- >>> (properFraction (-0.5) :: (Integer, SignedLog Double)) -- (0,-0.5) -instance (Precise a, RealFloat a) => RealFrac (SignedLog a) where+instance RealFloat a => RealFrac (SignedLog a) where properFraction slX@(SLExp sX x) | x < 0 = (0, slX)- | otherwise = (\(b,a) -> (b, SLExp sX $ log $ abs a)) $ properFraction $ multSign sX $ exp x+ | otherwise = case properFraction $ multSign sX $ exp x of+ (b,a) -> (b, SLExp sX $ log $ abs a)