log-domain (empty) → 0.1

raw patch · 14 files changed

+658/−0 lines, 14 filesdep +basedep +binarydep +comonadbuild-type:Customsetup-changed

Dependencies added: base, binary, comonad, deepseq, directory, distributive, doctest, filepath, generic-deriving, hashable, safecopy, semigroupoids, semigroups, simple-reflect, vector

Files

• .ghci +1/−0
• .gitignore +13/−0
• .travis.yml +27/−0
• .vim.custom +31/−0
• AUTHORS.markdown +9/−0
• CHANGELOG.markdown +4/−0
• LICENSE +30/−0
• README.markdown +15/−0
• Setup.lhs +55/−0
• log-domain.cabal +84/−0
• src/Numeric/Log.hs +272/−0
• tests/doctests.hsc +74/−0
• travis/cabal-apt-install +27/−0
• travis/config +16/−0

@@ -0,0 +1,1 @@+:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h -optP-Iincludes

@@ -0,0 +1,13 @@+dist+docs+wiki+TAGS+tags+wip+.DS_Store+.*.swp+.*.swo+*.o+*.hi+*~+*#

@@ -0,0 +1,27 @@+language: haskell+before_install:+  # Uncomment whenever hackage is down.+  # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && cabal update+  - cabal update++  # Try installing some of the build-deps with apt-get for speed.+  - travis/cabal-apt-install $mode++install:+  - cabal configure -flib-Werror $mode+  - cabal build++script:+  - $script && hlint src --cpp-define HLINT+  - scripts/stats++notifications:+  irc:+    channels:+      - "irc.freenode.org#haskell-lens"+    skip_join: true+    template:+      - "\x0313log\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"++env:+  - mode="--enable-tests" script="cabal test --show-details=always"

@@ -0,0 +1,31 @@+" 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 <F2> :exec ":!hasktags -x -c --ignore src"<CR><CR>++" 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"

@@ -0,0 +1,9 @@+@log@ 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

@@ -0,0 +1,4 @@+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

@@ -0,0 +1,30 @@+Copyright 2011 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.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++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.

@@ -0,0 +1,15 @@+log+===++[![Build Status](https://secure.travis-ci.org/ekmett/log.png?branch=master)](http://travis-ci.org/ekmett/log)++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

@@ -0,0 +1,55 @@+#!/usr/bin/runhaskell+\begin{code}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where++import Data.List ( nub )+import Data.Version ( showVersion )+import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )+import Distribution.Text ( display )+import Distribution.Verbosity ( Verbosity, normal )+import System.FilePath ( (</>) )++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+  { buildHook = \pkg lbi hooks flags -> do+     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi+     buildHook simpleUserHooks pkg lbi hooks flags+  , postHaddock = \args flags pkg lbi -> do+     copyFiles normal (haddockOutputDir flags pkg) []+     postHaddock simpleUserHooks args flags pkg lbi+  }++haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath+haddockOutputDir flags pkg = destDir where+  baseDir = case haddockDistPref flags of+    NoFlag -> "."+    Flag x -> x+  destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule verbosity pkg lbi = do+  let dir = autogenModulesDir lbi+  createDirectoryIfMissingVerbose verbosity True dir+  withLibLBI pkg lbi $ \_ libcfg -> do+    withTestLBI pkg lbi $ \suite suitecfg -> do+      rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines+        [ "module Build_" ++ testName suite ++ " where"+        , "deps :: [String]"+        , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+        ]+  where+    formatdeps = map (formatone . snd)+    formatone p = case packageName p of+      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)++testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys++\end{code}

@@ -0,0 +1,84 @@+name:          log-domain+category:      Numeric+version:       0.1+license:       BSD3+cabal-version: >= 1.8+license-file:  LICENSE+author:        Edward A. Kmett+maintainer:    Edward A. Kmett <ekmett@gmail.com>+stability:     provisional+homepage:      http://github.com/ekmett/log-domain/+bug-reports:   http://github.com/ekmett/log-domain/issues+copyright:     Copyright (C) 2013 Edward A. Kmett+build-type:    Custom+tested-with:   GHC == 7.4.1, GHC == 7.6.1+synopsis:      Log-domain arithmetic+description:   Log-domain arithmetic++extra-source-files:+  .travis.yml+  .ghci+  .gitignore+  .vim.custom+  travis/cabal-apt-install+  travis/config+  AUTHORS.markdown+  README.markdown+  CHANGELOG.markdown++source-repository head+  type: git+  location: git://github.com/ekmett/log-domain.git++-- You can disable the doctests test suite with -f-test-doctests+flag test-doctests+  default: True+  manual: True++flag lib-Werror+  default: False+  manual: True++library+  build-depends:+    base                      >= 4.3      && < 5,+    binary                    >= 0.5      && < 0.6,+    comonad                   >= 3        && < 4,+    deepseq                   >= 1.3      && < 1.5,+    distributive              >= 0.3      && < 1,+    generic-deriving          == 1.4.*,+    hashable                  >= 1.1.2.3  && < 1.3,+    semigroupoids             >= 3.0.2    && < 4,+    semigroups                >= 0.8.4    && < 1,+    safecopy                  >= 0.8.1    && < 0.9,+    vector                    >= 0.9      && < 0.11++  exposed-modules:+    Numeric.Log++  if flag(lib-Werror)+    ghc-options: -Werror++  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,+      directory      >= 1.0,+      doctest        >= 0.9.1,+      filepath,+      generic-deriving,+      semigroups     >= 0.9,+      simple-reflect >= 0.3.1++  if impl(ghc<7.6.1)+    ghc-options: -Werror

@@ -0,0 +1,272 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE TemplateHaskell #-}+--------------------------------------------------------------------+-- |+-- Copyright :  (c) Edward Kmett 2013+-- License   :  BSD3+-- Maintainer:  Edward Kmett <ekmett@gmail.com>+-- Stability :  experimental+-- Portability: non-portable+--+--------------------------------------------------------------------+module Numeric.Log+  ( Log(..)+  , Precise(..)+  ) where++import Control.Applicative+import Control.Comonad+import Control.DeepSeq+import Data.Binary as Binary+import Data.Complex+import Data.Data+import Data.Distributive+import Data.Foldable+import Data.Functor.Bind+import Data.Functor.Extend+import Data.Hashable+import Data.SafeCopy+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Data.Traversable+import Foreign.Ptr+import Foreign.Storable+import Generics.Deriving+import Text.Read++-- | @Log@-domain @Float@ and @Double@ values.+newtype Log a = Log { runLog :: a } deriving (Eq,Ord,Data,Typeable,Generic)++instance (Floating a, Show a) => Show (Log a) where+  showsPrec d (Log a) = showsPrec d (exp a)++instance (Floating a, Read a) => Read (Log a) where+  readPrec = Log . log <$> step readPrec++instance Binary a => Binary (Log a) where+  put = put . runLog+  {-# INLINE put #-}+  get = Log <$> Binary.get+  {-# INLINE get #-}++instance Functor Log where+  fmap f (Log a) = Log (f a)+  {-# INLINE fmap #-}++instance Hashable a => Hashable (Log a) where+  hashWithSalt i (Log a) = hashWithSalt i a+  {-# INLINE hashWithSalt #-}++instance Storable a => Storable (Log a) where+  sizeOf = sizeOf . runLog+  {-# INLINE sizeOf #-}+  alignment = alignment . runLog+  {-# INLINE alignment #-}+  peek ptr = Log <$> peek (castPtr ptr)+  {-# INLINE peek #-}+  poke ptr (Log a) = poke (castPtr ptr) a+  {-# INLINE poke #-}++instance NFData a => NFData (Log a) where+  rnf (Log a) = rnf a+  {-# INLINE rnf #-}++instance Foldable Log where+  foldMap f (Log a) = f a+  {-# INLINE foldMap #-}++instance Foldable1 Log where+  foldMap1 f (Log a) = f a+  {-# INLINE foldMap1 #-}++instance Traversable Log where+  traverse f (Log a) = Log <$> f a+  {-# INLINE traverse #-}++instance Traversable1 Log where+  traverse1 f (Log a) = Log <$> f a+  {-# INLINE traverse1 #-}++instance Distributive Log where+  distribute = Log . fmap runLog+  {-# INLINE distribute #-}++instance Extend Log where+  extended f w@Log{} = Log (f w)+  {-# INLINE extended #-}++instance Comonad Log where+  extract (Log a) = a+  {-# INLINE extract #-}+  extend f w@Log{} = Log (f w)+  {-# INLINE extend #-}++instance Applicative Log where+  pure = Log+  {-# INLINE pure #-}+  Log f <*> Log a = Log (f a)+  {-# INLINE (<*>) #-}++instance ComonadApply Log where+  Log f <@> Log a = Log (f a)+  {-# INLINE (<@>) #-}++instance Apply Log where+  Log f <.> Log a = Log (f a)+  {-# INLINE (<.>) #-}++instance Bind Log where+  Log a >>- f = f a+  {-# INLINE (>>-) #-}++instance Monad Log where+  return = Log+  {-# INLINE return #-}+  Log a >>= f = f a+  {-# INLINE (>>=) #-}++deriveSafeCopy 1 'base ''Log++-- | Negative infinity+negInf :: Fractional a => a+negInf = -(1/0)+{-# INLINE negInf #-}++instance (Precise a, RealFloat a) => Num (Log a) where+  Log a * Log b+    | isInfinite a && isInfinite b && a == -b = Log negInf+    | otherwise = Log (a + b)+  {-# INLINE (*) #-}+  Log a + Log b+    | a == b && isInfinite a && isInfinite b = Log a+    | a >= b    = Log (a + log1p (exp (b - a)))+    | otherwise = Log (b + log1p (exp (a - b)))+  {-# INLINE (+) #-}+  Log a - Log b+    | a == negInf && b == negInf = Log negInf+    | otherwise = Log (a + log1p (negate (exp (b - a))))+  {-# INLINE (-) #-}+  signum (Log a)+    | a == negInf = 0+    | a > negInf  = 1+    | otherwise   = negInf+  {-# INLINE signum #-}+  negate _ = negInf+  {-# INLINE negate #-}+  abs = id+  {-# INLINE abs #-}+  fromInteger = Log . log . fromInteger+  {-# INLINE fromInteger #-}++instance (Precise a, RealFloat a, Eq a) => Fractional (Log a) where+  -- n/0 == infinity is handled seamlessly for us. We must catch 0/0 and infinity/infinity NaNs, and handle 0/infinity.+  Log a / Log b+    | a == b && isInfinite a && isInfinite b = Log negInf+    | a == negInf                            = Log negInf+    | otherwise                              = Log (a-b)+  {-# INLINE (/) #-}+  fromRational = Log . log . fromRational+  {-# INLINE fromRational #-}++instance (Precise a, RealFloat a, Ord a) => Real (Log a) where+  toRational (Log a) = toRational (exp a)+  {-# INLINE toRational #-}++logMap :: Floating a => (a -> a) -> Log a -> Log a+logMap f = Log . log . f . exp . runLog+{-# INLINE logMap #-}++instance (RealFloat a, Precise a) => Floating (Log a) where+  pi = Log (log pi)+  {-# INLINE pi #-}+  exp (Log a) = Log (exp a)+  {-# INLINE exp #-}+  log (Log a) = Log (log a)+  {-# INLINE log #-}+  sqrt (Log a) = Log (a / 2)+  {-# INLINE sqrt #-}+  logBase (Log a) (Log b) = Log (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 = Log . realToFrac . runLog :: Log Double -> Log Float+"realToFrac" realToFrac = Log . realToFrac . runLog :: Log Float -> Log Double+"realToFrac" realToFrac = exp . runLog :: Log Double -> Double+"realToFrac" realToFrac = exp . runLog :: Log Float -> Float+"realToFrac" realToFrac = Log . log :: Double -> Log Double+"realToFrac" realToFrac = Log . 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.+  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++instance Precise Double where+  log1p = c_log1p+  {-# INLINE log1p #-}+  expm1 = c_expm1+  {-# INLINE expm1 #-}++instance Precise Float where+  log1p = c_log1pf+  {-# INLINE log1p #-}+  expm1 = c_expm1f+  {-# INLINE expm1 #-}++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 #-}++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

@@ -0,0 +1,74 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Main (doctests)+-- Copyright   :  (C) 2012-13 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- This module provides doctests for a project based on the actual versions+-- of the packages it was built with. It requires a corresponding Setup.lhs+-- to be added to the project+-----------------------------------------------------------------------------+module Main where++import Build_doctests (deps)+import Control.Applicative+import Control.Monad+import Data.List+import System.Directory+import System.FilePath+import Test.DocTest++##if defined(mingw32_HOST_OS)+##if defined(i386_HOST_ARCH)+##define USE_CP+import Control.Applicative+import Control.Exception+import Foreign.C.Types+foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool+foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt+##elif defined(x86_64_HOST_ARCH)+##define USE_CP+import Control.Applicative+import Control.Exception+import Foreign.C.Types+foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool+foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt+##endif+##endif++-- | Run in a modified codepage where we can print UTF-8 values on Windows.+withUnicode :: IO a -> IO a+##ifdef USE_CP+withUnicode m = do+  cp <- c_GetConsoleCP+  (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp+##else+withUnicode m = m+##endif++main :: IO ()+main = withUnicode $ getSources >>= \sources -> doctest $+    "-isrc"+  : "-idist/build/autogen"+  : "-optP-include"+  : "-optPdist/build/autogen/cabal_macros.h"+  : "-hide-all-packages"+  : "-Iincludes"+  : map ("-package="++) deps ++ sources++getSources :: IO [FilePath]+getSources = filter (isSuffixOf ".hs") <$> go "src"+  where+    go dir = do+      (dirs, files) <- getFilesAndDirectories dir+      (files ++) . concat <$> mapM go dirs++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c

@@ -0,0 +1,27 @@+#! /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+

@@ -0,0 +1,16 @@+-- 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