log-domain-0.12/0000755000000000000000000000000013171707327011660 5ustar0000000000000000log-domain-0.12/.ghci0000644000000000000000000000014513171707327012573 0ustar0000000000000000:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h -optP-Iincludes log-domain-0.12/.gitignore0000644000000000000000000000016613171707327013653 0ustar0000000000000000.cabal-sandbox cabal.sandbox.config dist dist-newstyle docs wiki TAGS tags wip .DS_Store .*.swp .*.swo *.o *.hi *~ *# log-domain-0.12/.travis.yml0000644000000000000000000000765613171707327014007 0ustar0000000000000000# This file has been generated -- see https://github.com/hvr/multi-ghc-travis language: c sudo: false cache: directories: - $HOME/.cabsnap - $HOME/.cabal/packages before_cache: - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar 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]}} allow_failures: - env: CABALVER=1.24 GHCVER=head before_install: - unset CC - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH 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. 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" # EOF log-domain-0.12/.vim.custom0000644000000000000000000000137713171707327013775 0ustar0000000000000000" Add the following to your .vimrc to automatically load this on startup " if filereadable(".vim.custom") " so .vim.custom " endif function StripTrailingWhitespace() let myline=line(".") let mycolumn = col(".") silent %s/ *$// call cursor(myline, mycolumn) endfunction " enable syntax highlighting syntax on " search for the tags file anywhere between here and / set tags=TAGS;/ " highlight tabs and trailing spaces set listchars=tab:‗‗,trail:‗ set list " f2 runs hasktags map :exec ":!hasktags -x -c --ignore src" " strip trailing whitespace before saving " au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace() " rebuild hasktags after saving au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src" log-domain-0.12/AUTHORS.markdown0000644000000000000000000000055413171707327014555 0ustar0000000000000000`log-domain` was inspired by the `LogFloat` package by Wren Thornton. A variant of that code was introduced into `Data.Analytics.Numeric.Log` in the [analytics](http://github.com/analytics) project by * [Edward Kmett](mailto:ekmett@gmail.com) [@ekmett](https://github.com/ekmett) This package is an attempt to open that version up to more users. -Edward Kmett log-domain-0.12/CHANGELOG.markdown0000644000000000000000000000475513171707327014726 0ustar00000000000000000.12 ---- * Drop `safecopy` support * Removed some unused constraints. 0.11.2 ------ * Support `doctest-0.12` 0.11.1 ------ * Revamp `Setup.hs` to use `cabal-doctest`. This makes it build with `Cabal-2.0`, and makes the `doctest`s work with `cabal new-build` and sandboxes. 0.11 ---- * Replace use of `Hashable1` from `hashable-extras` in favor of `Hashable` from `hashable-1.2.5.0`. As a result, the `hashable-extras` dependency has been removed. * On Windows, we now use the FFI to link against the C math library if building with GHC 8.0 or later, which features a much improved runtime linker story. * Remove `generic-deriving` dependency 0.10.3.1 -------- * Support `safecopy` 0.9 0.10.3 ------ * Work around an issue with `safecopy` on GHC 7.10 * Changed the repository link to my `ekmett` github account from `analytics`. 0.10.2.1 -------- * Add `vector` 0.11 support. 0.10.2 ------ * Add `generic-deriving` 1.8 support. We also no longer incur a `generic-deriving` dependency at all on GHC 7.6+ 0.10.1.1 -------- * Compiles warning-free on GHC 7.10 0.10.1 ------ * `semigroupoids` 5 support. 0.10.0.1 -------- * Improved the stability and portability of the `doctest` test suite 0.10 ---- * `(**)` is now much more accurately defined. * We now avoid comparisons for equality with infinities. * Fixed a bug in `negate`. * On windows we avoid FFI into the math library, and accept less accurate results. (Sorry!) 0.9.3 ------- * Fixed subtraction again. For real this time. 0.9.2.1 ------- * Support `generic-deriving` 1.7 0.9.2 ----- * Fixed subtraction better. 0.9.1 ----- * Fixed subtraction. 0.8 --- * Updated to `comonad` and `semigroupoids` 4. 0.7.2 ----- * Dependency bump to allow `comonad` and `semigroupoids` 4.0 0.7.1 ----- * Marked `Numeric.Log` `Trustworthy`. 0.6 --- * Renamed the data constructor to `Exp` and the field accessor to `ln` per issue #1. 0.5.0.1 ------- * Wider bounds for `generic-deriving` so we can build with GHC HEAD. 0.5 --- * Switched the `Hashable1` instance to use the new, lighter, `hashable-extras` 0.4 --- * `instance Hashable1 Log` 0.3.0.1 ------- * Wider `binary` version bound 0.3 --- * Added support for `cereal`. 0.2 --- * Added an `Enum` instance. * Added `sum` to calculate using the `log-sum-exp` trick. 0.1.0.1 ------- * Minor packaging changes 0.1 --- * Renamed from `log` to `log-domain` due to internal hackage issues rendering that name inaccessible. * Ported `Numeric.Log` from [analytics](http://github.com/analytics) at the request of @bgamari log-domain-0.12/HLint.hs0000644000000000000000000000002713171707327013231 0ustar0000000000000000ignore "Use camelCase" log-domain-0.12/LICENSE0000644000000000000000000000236413171707327012672 0ustar0000000000000000Copyright 2011-2015 Edward Kmett All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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 AUTHORS ``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 AUTHORS 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. log-domain-0.12/log-domain.cabal0000644000000000000000000000453113171707327014675 0ustar0000000000000000name: log-domain category: Numeric version: 0.12 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/ekmett/log-domain/ 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 synopsis: Log-domain arithmetic description: This package provides log-domain floats, doubles and complex numbers. extra-source-files: .travis.yml .ghci .gitignore .vim.custom travis/cabal-apt-install travis/config AUTHORS.markdown README.markdown CHANGELOG.markdown HLint.hs Warning.hs source-repository head type: git location: https://github.com/analytics/log-domain custom-setup setup-depends: base >= 4 && < 5, Cabal, cabal-doctest >= 1 && < 1.1 -- You can disable the doctests test suite with -f-test-doctests flag test-doctests default: True manual: True flag ffi default: True manual: True library build-depends: base >= 4.5 && < 5, binary >= 0.5 && < 0.9, bytes >= 0.7 && < 1, cereal >= 0.3.5 && < 0.6, comonad >= 4 && < 6, deepseq >= 1.3 && < 1.5, distributive >= 0.3 && < 1, hashable >= 1.2.5 && < 1.3, semigroupoids >= 4 && < 6, semigroups >= 0.8.4 && < 1, vector >= 0.9 && < 0.13 exposed-modules: Numeric.Log Numeric.Log.Signed if impl(ghc < 7.6) build-depends: ghc-prim if flag(ffi) && !(os(windows) && !impl(ghc >= 8.0)) cpp-options: -D__USE_FFI__ ghc-options: -Wall -fwarn-tabs -O2 hs-source-dirs: src test-suite doctests type: exitcode-stdio-1.0 main-is: doctests.hs ghc-options: -Wall -threaded hs-source-dirs: tests if !flag(test-doctests) buildable: False else build-depends: base, doctest >= 0.11.1 && < 0.14, generic-deriving, log-domain, semigroups >= 0.9, simple-reflect >= 0.3.1 log-domain-0.12/README.markdown0000644000000000000000000000162113171707327014361 0ustar0000000000000000log-domain ========== [![Hackage](https://img.shields.io/hackage/v/log-domain.svg)](https://hackage.haskell.org/package/log-domain) [![Build Status](https://secure.travis-ci.org/ekmett/log-domain.png?branch=master)](http://travis-ci.org/ekmett/log-domain) > What rolls down stairs alone or in pairs > Rolls over your neighbor's dog? > What's great for a snack and fits on your back? > It's Log, Log, Log! > It's Log, Log, it's big, it's heavy, it's wood. > It's Log, Log, it's better than bad, it's good! > Everyone wants a log! You're gonna love it, Log! > Come on and get your log! Everyone needs a Log!" > -- Ren & Stimpy, The Log Song This package provides log-domain floats, doubles and complex numbers. Contact Information ------------------- Contributions and bug reports are welcome! Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net. -Edward Kmett log-domain-0.12/Setup.lhs0000644000000000000000000000124113171707327013466 0ustar0000000000000000\begin{code} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} module Main (main) where #ifndef MIN_VERSION_cabal_doctest #define MIN_VERSION_cabal_doctest(x,y,z) 0 #endif #if MIN_VERSION_cabal_doctest(1,0,0) import Distribution.Extra.Doctest ( defaultMainWithDoctests ) main :: IO () main = defaultMainWithDoctests "doctests" #else #ifdef MIN_VERSION_Cabal -- If the macro is defined, we have new cabal-install, -- but for some reason we don't have cabal-doctest in package-db -- -- Probably we are running cabal sdist, when otherwise using new-build -- workflow import Warning () #endif import Distribution.Simple main :: IO () main = defaultMain #endif \end{code} log-domain-0.12/Warning.hs0000644000000000000000000000040013171707327013613 0ustar0000000000000000module Warning {-# WARNING ["You are configuring this package without cabal-doctest installed.", "The doctests test-suite will not work as a result.", "To fix this, install cabal-doctest before configuring."] #-} () where log-domain-0.12/src/0000755000000000000000000000000013171707327012447 5ustar0000000000000000log-domain-0.12/src/Numeric/0000755000000000000000000000000013171707327014051 5ustar0000000000000000log-domain-0.12/src/Numeric/Log.hs0000644000000000000000000003746213171707327015142 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Trustworthy #-} -------------------------------------------------------------------- -- | -- Copyright : (c) Edward Kmett 2013-2015 -- License : BSD3 -- Maintainer: Edward Kmett -- Stability : experimental -- Portability: non-portable -- -------------------------------------------------------------------- module Numeric.Log ( Log(..) , Precise(..) , sum ) where import Prelude hiding (maximum, sum) #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif import Control.Comonad import Control.DeepSeq 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) import Data.Functor.Bind import Data.Functor.Extend import Data.Hashable import Data.Hashable.Lifted import Data.Int import Data.List as List hiding (sum) import Data.List.NonEmpty (NonEmpty(..)) import Data.Semigroup import Data.Semigroup.Foldable import Data.Semigroup.Traversable import Data.Serialize as Serialize #if __GLASGOW_HASKELL__ < 710 import Data.Traversable #endif import Data.Vector.Unboxed as U hiding (sum) import Data.Vector.Generic as G hiding (sum) import Data.Vector.Generic.Mutable as M import Foreign.Ptr import Foreign.Storable import GHC.Generics import Text.Read as T import Text.Show as T {-# ANN module "HLint: ignore Eta reduce" #-} -- $setup -- >>> let Exp x ~= Exp y = abs ((exp x-exp y) / exp x) < 0.01 -- | @Log@-domain @Float@ and @Double@ values. newtype Log a = Exp { ln :: a } deriving (Eq,Ord,Data,Typeable,Generic) instance (Floating a, Show a) => Show (Log a) where showsPrec d (Exp a) = T.showsPrec d (exp a) instance (Floating a, Read a) => Read (Log a) where readPrec = Exp . log <$> step T.readPrec instance Binary a => Binary (Log a) where put = Binary.put . ln {-# INLINE put #-} get = Exp <$> Binary.get {-# INLINE get #-} instance Serialize a => Serialize (Log a) where put = Serialize.put . ln {-# INLINE put #-} get = Exp <$> Serialize.get {-# INLINE get #-} instance Serial a => Serial (Log a) where serialize = serialize . ln deserialize = Exp <$> deserialize instance Serial1 Log where serializeWith f = f . ln deserializeWith m = Exp <$> m instance Functor Log where fmap f (Exp a) = Exp (f a) {-# INLINE fmap #-} instance Hashable a => Hashable (Log a) where hashWithSalt i (Exp a) = hashWithSalt i a {-# INLINE hashWithSalt #-} instance Hashable1 Log where liftHashWithSalt hws i (Exp a) = hws i a {-# INLINE liftHashWithSalt #-} instance Storable a => Storable (Log a) where sizeOf = sizeOf . ln {-# INLINE sizeOf #-} alignment = alignment . ln {-# INLINE alignment #-} peek ptr = Exp <$> peek (castPtr ptr) {-# INLINE peek #-} poke ptr (Exp a) = poke (castPtr ptr) a {-# INLINE poke #-} instance NFData a => NFData (Log a) where rnf (Exp a) = rnf a {-# INLINE rnf #-} instance Foldable Log where foldMap f (Exp a) = f a {-# INLINE foldMap #-} instance Foldable1 Log where foldMap1 f (Exp a) = f a {-# INLINE foldMap1 #-} instance Traversable Log where traverse f (Exp a) = Exp <$> f a {-# INLINE traverse #-} instance Traversable1 Log where traverse1 f (Exp a) = Exp <$> f a {-# INLINE traverse1 #-} instance Distributive Log where distribute = Exp . fmap ln {-# INLINE distribute #-} instance Extend Log where extended f w@Exp{} = Exp (f w) {-# INLINE extended #-} instance Comonad Log where extract (Exp a) = a {-# INLINE extract #-} extend f w@Exp{} = Exp (f w) {-# INLINE extend #-} instance Applicative Log where pure = Exp {-# INLINE pure #-} Exp f <*> Exp a = Exp (f a) {-# INLINE (<*>) #-} instance ComonadApply Log where Exp f <@> Exp a = Exp (f a) {-# INLINE (<@>) #-} instance Apply Log where Exp f <.> Exp a = Exp (f a) {-# INLINE (<.>) #-} instance Bind Log where Exp a >>- f = f a {-# INLINE (>>-) #-} instance Monad Log where return = pure {-# INLINE return #-} Exp a >>= f = f a {-# INLINE (>>=) #-} instance (RealFloat a, Precise a, Enum a) => Enum (Log a) where succ a = a + 1 {-# INLINE succ #-} pred a = a - 1 {-# INLINE pred #-} toEnum = fromIntegral {-# INLINE toEnum #-} fromEnum = round . exp . ln {-# INLINE fromEnum #-} enumFrom (Exp a) = [ Exp (log b) | b <- Prelude.enumFrom (exp a) ] {-# INLINE enumFrom #-} enumFromThen (Exp a) (Exp b) = [ Exp (log c) | c <- Prelude.enumFromThen (exp a) (exp b) ] {-# INLINE enumFromThen #-} enumFromTo (Exp a) (Exp b) = [ Exp (log c) | c <- Prelude.enumFromTo (exp a) (exp b) ] {-# INLINE enumFromTo #-} enumFromThenTo (Exp a) (Exp b) (Exp c) = [ Exp (log d) | d <- Prelude.enumFromThenTo (exp a) (exp b) (exp c) ] {-# INLINE enumFromThenTo #-} -- | Negative infinity negInf :: Fractional a => a negInf = -(1/0) {-# INLINE negInf #-} -- $LogNumTests -- -- Subtraction -- -- >>> (3 - 1 :: Log Double) ~= 2 -- True -- -- >>> 1 - 3 :: Log Double -- NaN -- -- >>> (3 - 2 :: Log Float) ~= 1 -- True -- -- >>> 1 - 3 :: Log Float -- NaN -- -- >>> (Exp (1/0)) - (Exp (1/0)) :: Log Double -- NaN -- -- >>> 0 - 0 :: Log Double -- 0.0 -- -- >>> 0 - (Exp (1/0)) :: Log Double -- NaN -- -- >>> (Exp (1/0)) - 0.0 :: Log Double -- Infinity -- -- Multiplication -- -- >>> (3 * 2 :: Log Double) ~= 6 -- True -- -- >>> 0 * (Exp (1/0)) :: Log Double -- NaN -- -- >>> (Exp (1/0)) * (Exp (1/0)) :: Log Double -- Infinity -- -- >>> 0 * 0 :: Log Double -- 0.0 -- -- >>> (Exp (0/0)) * 0 :: Log Double -- NaN -- -- >>> (Exp (0/0)) * (Exp (1/0)) :: Log Double -- NaN -- -- Addition -- -- >>> (3 + 1 :: Log Double) ~= 4 -- True -- -- >>> 0 + 0 :: Log Double -- 0.0 -- -- >>> (Exp (1/0)) + (Exp (1/0)) :: Log Double -- Infinity -- -- >>> (Exp (1/0)) + 0 :: Log Double -- Infinity -- -- Division -- -- >>> (3 / 2 :: Log Double) ~= 1.5 -- True -- -- >>> 3 / 0 :: Log Double -- Infinity -- -- >>> (Exp (1/0)) / 0 :: Log Double -- Infinity -- -- >>> 0 / (Exp (1/0)) :: Log Double -- 0.0 -- -- >>> (Exp (1/0)) / (Exp (1/0)) :: Log Double -- NaN -- -- >>> 0 / 0 :: Log Double -- NaN -- -- Negation -- -- >>> ((-3) + 8 :: Log Double) ~= 8 -- False -- -- >>> (-0) :: Log Double -- 0.0 -- -- >>> (-(0/0)) :: Log Double -- NaN -- -- Signum -- -- >>> signum 0 :: Log Double -- 0.0 -- -- >>> signum 3 :: Log Double -- 1.0 -- -- >>> signum (Exp (0/0)) :: Log Double -- NaN instance (Precise a, RealFloat a) => Num (Log a) where Exp a * Exp b = Exp (a + b) {-# INLINE (*) #-} Exp a + Exp b | a == b && isInfinite a && isInfinite b = Exp a | a >= b = Exp (a + log1pexp (b - a)) | otherwise = Exp (b + log1pexp (a - b)) {-# INLINE (+) #-} Exp a - Exp b | isInfinite a && isInfinite b && a < 0 && b < 0 = Exp negInf | otherwise = Exp (a + log1mexp (b - a)) {-# INLINE (-) #-} signum a | a == 0 = Exp negInf -- 0 | a > 0 = Exp 0 -- 1 | otherwise = Exp (0/0) -- NaN {-# INLINE signum #-} negate (Exp a) | isInfinite a && a < 0 = Exp negInf | otherwise = Exp (0/0) {-# INLINE negate #-} abs = id {-# INLINE abs #-} fromInteger = Exp . log . fromInteger {-# INLINE fromInteger #-} instance (Precise a, 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 (/) #-} fromRational = Exp . log . fromRational {-# INLINE fromRational #-} -- $LogProperFractionTests -- -- >>> (properFraction 3.5 :: (Integer, Log Double)) -- (3,0.5) -- -- >>> (properFraction 0.5 :: (Integer, Log Double)) -- (0,0.5) instance (Precise a, RealFloat a) => RealFrac (Log a) where properFraction l | ln l < 0 = (0, l) | otherwise = (\(b,a) -> (b, Exp $ log a)) $ properFraction $ exp (ln l) newtype instance U.MVector s (Log a) = MV_Log (U.MVector s a) newtype instance U.Vector (Log a) = V_Log (U.Vector a) instance (RealFloat a, Unbox a) => Unbox (Log a) instance Unbox a => M.MVector U.MVector (Log a) where {-# INLINE basicLength #-} {-# INLINE basicUnsafeSlice #-} {-# INLINE basicOverlaps #-} {-# INLINE basicUnsafeNew #-} {-# INLINE basicUnsafeReplicate #-} {-# INLINE basicUnsafeRead #-} {-# INLINE basicUnsafeWrite #-} {-# INLINE basicClear #-} #if MIN_VERSION_vector(0,11,0) {-# INLINE basicInitialize #-} #endif {-# INLINE basicSet #-} {-# INLINE basicUnsafeCopy #-} {-# INLINE basicUnsafeGrow #-} basicLength (MV_Log v) = M.basicLength v basicUnsafeSlice i n (MV_Log v) = MV_Log $ M.basicUnsafeSlice i n v basicOverlaps (MV_Log v1) (MV_Log v2) = M.basicOverlaps v1 v2 basicUnsafeNew n = MV_Log `liftM` M.basicUnsafeNew n basicUnsafeReplicate n (Exp x) = MV_Log `liftM` M.basicUnsafeReplicate n x basicUnsafeRead (MV_Log v) i = Exp `liftM` M.basicUnsafeRead v i basicUnsafeWrite (MV_Log v) i (Exp x) = M.basicUnsafeWrite v i x basicClear (MV_Log v) = M.basicClear v #if MIN_VERSION_vector(0,11,0) basicInitialize (MV_Log v) = M.basicInitialize v #endif basicSet (MV_Log v) (Exp x) = M.basicSet v x basicUnsafeCopy (MV_Log v1) (MV_Log v2) = M.basicUnsafeCopy v1 v2 basicUnsafeGrow (MV_Log v) n = MV_Log `liftM` M.basicUnsafeGrow v n instance (RealFloat a, Unbox a) => G.Vector U.Vector (Log a) where {-# INLINE basicUnsafeFreeze #-} {-# INLINE basicUnsafeThaw #-} {-# INLINE basicLength #-} {-# INLINE basicUnsafeSlice #-} {-# INLINE basicUnsafeIndexM #-} {-# INLINE elemseq #-} basicUnsafeFreeze (MV_Log v) = V_Log `liftM` G.basicUnsafeFreeze v basicUnsafeThaw (V_Log v) = MV_Log `liftM` G.basicUnsafeThaw v basicLength (V_Log v) = G.basicLength v basicUnsafeSlice i n (V_Log v) = V_Log $ G.basicUnsafeSlice i n v basicUnsafeIndexM (V_Log v) i = Exp `liftM` G.basicUnsafeIndexM v i 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 toRational (Exp a) = toRational (exp a) {-# INLINE toRational #-} data Acc1 a = Acc1 {-# UNPACK #-} !Int64 !a instance (Precise a, RealFloat a) => Semigroup (Log a) where (<>) = (+) {-# INLINE (<>) #-} sconcat (Exp z :| zs) = Exp $ case List.foldl' step1 (Acc1 0 z) zs of Acc1 nm1 a | isInfinite a -> a | otherwise -> a + log1p (List.foldl' (step2 a) 0 zs + fromIntegral nm1) where step1 (Acc1 n y) (Exp x) = Acc1 (n + 1) (max x y) step2 a r (Exp x) = r + expm1 (x - a) {-# INLINE sconcat #-} instance (Precise a, RealFloat a) => Monoid (Log a) where mempty = Exp negInf {-# INLINE mempty #-} #if !(MIN_VERSION_base(4,11,0)) mappend = (<>) #endif mconcat [] = 0 mconcat (x:xs) = sconcat (x :| xs) logMap :: Floating a => (a -> a) -> Log a -> Log a logMap f = Exp . log . f . exp . ln {-# INLINE logMap #-} data Acc a = Acc {-# UNPACK #-} !Int64 !a | None -- | Efficiently and accurately compute the sum of a set of log-domain numbers -- -- While folding with @(+)@ accomplishes the same end, it requires an -- additional @n-2@ logarithms to sum @n@ terms. In addition, -- here we introduce fewer opportunities for round-off error. -- -- While for small quantities the naive sum accumulates error, -- -- >>> let xs = Prelude.replicate 40000 (Exp 1e-4) :: [Log Float] -- >>> Prelude.sum xs ~= 4.00e4 -- True -- -- This sum gives a more accurate result, -- -- >>> Numeric.Log.sum xs ~= 4.00e4 -- True -- -- /NB:/ This does require two passes over the data. sum :: (RealFloat a, Precise a, Foldable f) => f (Log a) -> Log a sum xs = Exp $ case Foldable.foldl' step1 None xs of None -> negInf Acc nm1 a | isInfinite a -> a | otherwise -> a + log1p (Foldable.foldl' (step2 a) 0 xs + fromIntegral nm1) where step1 None (Exp x) = Acc 0 x step1 (Acc n y) (Exp x) = Acc (n + 1) (max x y) step2 a r (Exp x) = r + expm1 (x - a) {-# INLINE sum #-} instance (RealFloat a, Precise a) => Floating (Log a) where pi = Exp (log pi) {-# INLINE pi #-} exp (Exp a) = Exp (exp a) {-# INLINE exp #-} log (Exp a) = Exp (log a) {-# INLINE log #-} Exp b ** Exp e = Exp (b * exp e) {-# INLINE (**) #-} sqrt (Exp a) = Exp (a / 2) {-# INLINE sqrt #-} logBase (Exp a) (Exp b) = Exp (log (logBase (exp a) (exp b))) {-# INLINE logBase #-} sin = logMap sin {-# INLINE sin #-} cos = logMap cos {-# INLINE cos #-} tan = logMap tan {-# INLINE tan #-} asin = logMap asin {-# INLINE asin #-} acos = logMap acos {-# INLINE acos #-} atan = logMap atan {-# INLINE atan #-} sinh = logMap sinh {-# INLINE sinh #-} cosh = logMap cosh {-# INLINE cosh #-} tanh = logMap tanh {-# INLINE tanh #-} asinh = logMap asinh {-# INLINE asinh #-} acosh = logMap acosh {-# INLINE acosh #-} atanh = logMap atanh {-# INLINE atanh #-} {-# RULES "realToFrac" realToFrac = Exp . realToFrac . ln :: Log Double -> Log Float "realToFrac" realToFrac = Exp . realToFrac . ln :: Log Float -> Log Double "realToFrac" realToFrac = exp . ln :: Log Double -> Double "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 log-domain-0.12/src/Numeric/Log/0000755000000000000000000000000013171707327014572 5ustar0000000000000000log-domain-0.12/src/Numeric/Log/Signed.hs0000644000000000000000000001703613171707327016346 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE ScopedTypeVariables #-} -------------------------------------------------------------------- -- | -- Copyright : (c) Edward Kmett 2013-2015 -- License : BSD3 -- Maintainer: Edward Kmett -- Stability : experimental -- Portability: non-portable -- -------------------------------------------------------------------- module Numeric.Log.Signed ( 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 Text.Read as T import Text.Show as T #if __GLASGOW_HASKELL__ < 710 import Data.Functor ((<$>)) #endif -- $setup -- >>> let SLExp sX x ~= SLExp sY y = abs ((exp x-(multSign (nxor sX sY) (exp y))) / exp x) < 0.01 -- | @Log@-domain @Float@ and @Double@ values, with a sign bit. data SignedLog a = SLExp { signSL :: Bool, lnSL :: a} deriving (Data, Typeable, Generic) negInf :: Fractional a => a negInf = (-1)/0 nan :: Fractional a => a nan = 0/0 multSign :: (Num a) => Bool -> a -> a multSign True = id multSign False = (*) (-1) -- $SignedLogCompTests -- -- >>> (-7) < (3 :: SignedLog Double) -- True -- -- >>> 0 == (0 :: SignedLog Double) -- True instance (Eq a, Fractional a) => Eq (SignedLog a) where (SLExp sA a) == (SLExp sB b) = (a == b) && (sA == sB || a == negInf) -- Does not necissarily handle NaNs in the same way as 'a' for >=, etc. instance (Ord a, Fractional a) => Ord (SignedLog a) where compare (SLExp _ a) (SLExp _ b) | a == b && a == negInf = EQ compare (SLExp sA a) (SLExp sB b) = mappend (compare sA sB) $ compare a b -- $SignedLogShowTests -- -- >>> show (-0 :: SignedLog Double) -- "0.0" -- -- >>> show (1 :: SignedLog Double) -- "1.0" -- -- >>> show (-1 :: SignedLog Double) -- "-1.0" 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 readPrec = (realToFrac :: a -> SignedLog a) <$> step T.readPrec nxor :: Bool -> Bool -> Bool nxor = (==) -- $SignedLogNumTests -- -- Subtraction -- -- >>> (3 - 1 :: SignedLog Double) ~= 2 -- True -- -- >>> (1 - 3 :: SignedLog Double) ~= (-2) -- True -- -- >>> (3 - 2 :: SignedLog Float) ~= 1 -- True -- -- >>> (1 - 3 :: SignedLog Float) ~= (-2) -- True -- -- >>> (SLExp True (1/0)) - (SLExp True (1/0)) :: SignedLog Double -- NaN -- -- >>> 0 - 0 :: SignedLog Double -- 0.0 -- -- >>> 0 - (SLExp True (1/0)) :: SignedLog Double -- -Infinity -- -- >>> (SLExp True (1/0)) - 0.0 :: SignedLog Double -- Infinity -- -- Multiplication -- -- >>> (3 * 2 :: SignedLog Double) ~= 6 -- True -- -- >>> 0 * (SLExp True (1/0)) :: SignedLog Double -- NaN -- -- >>> (SLExp True (1/0)) * (SLExp True (1/0)) :: SignedLog Double -- Infinity -- -- >>> 0 * 0 :: SignedLog Double -- 0.0 -- -- >>> (SLExp True (0/0)) * 0 :: SignedLog Double -- NaN -- -- >>> (SLExp True (0/0)) * (SLExp True (1/0)) :: SignedLog Double -- NaN -- -- Addition -- -- >>> (3 + 1 :: SignedLog Double) ~= 4 -- True -- -- >>> 0 + 0 :: SignedLog Double -- 0.0 -- -- >>> (SLExp True (1/0)) + (SLExp True (1/0)) :: SignedLog Double -- Infinity -- -- >>> (SLExp True (1/0)) + 0 :: SignedLog Double -- Infinity -- -- Division -- -- >>> (3 / 2 :: SignedLog Double) ~= 1.5 -- True -- -- >>> 3 / 0 :: SignedLog Double -- Infinity -- -- >>> (SLExp True (1/0)) / 0 :: SignedLog Double -- Infinity -- -- >>> 0 / (SLExp True (1/0)) :: SignedLog Double -- 0.0 -- -- >>> (SLExp True (1/0)) / (SLExp True (1/0)) :: SignedLog Double -- NaN -- -- >>> 0 / 0 :: SignedLog Double -- NaN -- -- Negation -- -- >>> ((-3) + 8 :: SignedLog Double) ~= 8 -- False -- -- >>> (-0) :: SignedLog Double -- 0.0 -- -- >>> (-(0/0)) :: SignedLog Double -- NaN -- -- Signum -- -- >>> signum 0 :: SignedLog Double -- 0.0 -- -- >>> signum 3 :: SignedLog Double -- 1.0 -- -- >>> 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) {-# INLINE (*) #-} (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)) | sA /= sB && a == b && not (isInfinite a) = SLExp True negInf | sA /= sB && a > b = SLExp sA (a + log1mexp (b - a)) | otherwise = SLExp sB (b + log1mexp (a - b)) {-# INLINE (+) #-} abs (SLExp _ a) = SLExp True a {-# INLINE abs #-} signum (SLExp sA a) | isInfinite a && a < 0 = SLExp True negInf | isNaN a = SLExp True nan -- signum(0/0::Double) == -1.0, this doesn't seem like a behavior worth replicating. | otherwise = SLExp sA 0 {-# INLINE signum #-} fromInteger i = SLExp (i >= 0) $ log $ fromInteger $ abs i {-# INLINE fromInteger #-} 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) {-# INLINE (/) #-} fromRational a = SLExp (a >= 0) $ log $ fromRational $ abs a {-# INLINE fromRational #-} -- $SignedLogToRationalTest -- -- >>> (toRational (-3.5 :: SignedLog Double)) -- (-7) % 2 instance (Precise a, RealFloat a, Ord a) => Real (SignedLog a) where toRational (SLExp sA a) = toRational $ multSign sA $ exp a {-# INLINE toRational #-} logMap :: (Floating a, Ord a) => (a -> a) -> SignedLog a -> SignedLog a logMap f (SLExp sA a) = SLExp (value >= 0) $ log $ abs value where value = f $ multSign sA $ exp a {-# INLINE logMap #-} instance (RealFloat a, Precise a) => Floating (SignedLog a) where pi = SLExp True (log pi) {-# INLINE pi #-} exp (SLExp sA a) = SLExp True (multSign sA $ exp a) {-# INLINE exp #-} 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)) _ ** _ = nan {-# INLINE (**) #-} sqrt (SLExp True a) = SLExp True (a / 2) sqrt (SLExp False _) = nan {-# INLINE sqrt #-} logBase slA@(SLExp _ a) slB@(SLExp _ b) | slA >= 0 && slB >= 0 = SLExp (value >= 0) (log $ abs value) where value = logBase (exp a) (exp b) logBase _ _ = nan {-# INLINE logBase #-} sin = logMap sin {-# INLINE sin #-} cos = logMap cos {-# INLINE cos #-} tan = logMap tan {-# INLINE tan #-} asin = logMap asin {-# INLINE asin #-} acos = logMap acos {-# INLINE acos #-} atan = logMap atan {-# INLINE atan #-} sinh = logMap sinh {-# INLINE sinh #-} cosh = logMap cosh {-# INLINE cosh #-} tanh = logMap tanh {-# INLINE tanh #-} asinh = logMap asinh {-# INLINE asinh #-} acosh = logMap acosh {-# INLINE acosh #-} atanh = logMap atanh {-# INLINE atanh #-} -- $SignedLogProperFractionTests -- -- >>> (properFraction (-1.5) :: (Integer, SignedLog Double)) -- (-1,-0.5) -- -- >>> (properFraction (-0.5) :: (Integer, SignedLog Double)) -- (0,-0.5) instance (Precise a, 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 log-domain-0.12/tests/0000755000000000000000000000000013171707327013022 5ustar0000000000000000log-domain-0.12/tests/doctests.hs0000644000000000000000000000147213171707327015212 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Main (doctests) -- Copyright : (C) 2012-14 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- This module provides doctests for a project based on the actual versions -- of the packages it was built with. It requires a corresponding Setup.lhs -- to be added to the project ----------------------------------------------------------------------------- module Main where import Build_doctests (flags, pkgs, module_sources) import Data.Foldable (traverse_) import Test.DocTest main :: IO () main = do traverse_ putStrLn args doctest args where args = flags ++ pkgs ++ module_sources log-domain-0.12/travis/0000755000000000000000000000000013171707327013170 5ustar0000000000000000log-domain-0.12/travis/cabal-apt-install0000755000000000000000000000127213171707327016410 0ustar0000000000000000#! /bin/bash set -eu APT="sudo apt-get -q -y" CABAL_INSTALL_DEPS="cabal install --only-dependencies --force-reinstall" $APT update $APT install dctrl-tools # Find potential system packages to satisfy cabal dependencies deps() { local M='^\([^ ]\+\)-[0-9.]\+ (.*$' local G=' -o ( -FPackage -X libghc-\L\1\E-dev )' local E="$($CABAL_INSTALL_DEPS "$@" --dry-run -v 2> /dev/null \ | sed -ne "s/$M/$G/p" | sort -u)" grep-aptavail -n -sPackage \( -FNone -X None \) $E | sort -u } $APT install $(deps "$@") libghc-quickcheck2-dev # QuickCheck is special $CABAL_INSTALL_DEPS "$@" # Install the rest via Hackage if ! $APT install hlint ; then $APT install $(deps hlint) cabal install hlint fi log-domain-0.12/travis/config0000644000000000000000000000120613171707327014357 0ustar0000000000000000-- This provides a custom ~/.cabal/config file for use when hackage is down that should work on unix -- -- This is particularly useful for travis-ci to get it to stop complaining -- about a broken build when everything is still correct on our end. -- -- This uses Luite Stegeman's mirror of hackage provided by his 'hdiff' site instead -- -- To enable this, uncomment the before_script in .travis.yml remote-repo: hdiff.luite.com:http://hdiff.luite.com/packages/archive remote-repo-cache: ~/.cabal/packages world-file: ~/.cabal/world build-summary: ~/.cabal/logs/build.log remote-build-reporting: anonymous install-dirs user install-dirs global