SciBaseTypes (empty) → 0.0.0.1
raw patch · 14 files changed
+762/−0 lines, 14 filesdep +QuickCheckdep +SciBaseTypesdep +aesonsetup-changed
Dependencies added: QuickCheck, SciBaseTypes, aeson, base, binary, cereal, deepseq, hashable, lens, log-domain, mtl, tasty, tasty-quickcheck, tasty-th, vector, vector-th-unbox
Files
- Algebra/Structure/SemiRing.hs +194/−0
- LICENSE +30/−0
- Numeric/Discretized.hs +100/−0
- Numeric/Limits.hs +46/−0
- Numeric/LogDomain.hs +26/−0
- README.md +17/−0
- SciBaseTypes.cabal +126/−0
- Setup.hs +2/−0
- StatisticalMechanics/Ensemble.hs +27/−0
- Statistics/Odds.hs +51/−0
- Statistics/Probability.hs +123/−0
- changelog.md +4/−0
- tests/Benchmark.hs +8/−0
- tests/properties.hs +8/−0
+ Algebra/Structure/SemiRing.hs view
@@ -0,0 +1,194 @@++-- | A set with two binary operations, one for addition (@srplus@), one for+-- multiplication (@srmul@). Together with a neutral element for @srplus@,+-- named @srzero@, and one for @srmul@, named @srone@.++module Algebra.Structure.SemiRing where++import Control.DeepSeq (NFData(..))+import Data.Coerce+import Data.Monoid hiding ((<>))+import Data.Semigroup+import Data.Vector.Unboxed.Deriving+import Data.Vector.Unboxed (Unbox)+import GHC.Generics+import Unsafe.Coerce++import Numeric.Limits++++-- * The 'SemiRing' type class.++-- | The semiring operations and neutral elements.++class SemiRing a where+ srplus ∷ a → a → a+ srmul ∷ a → a → a+ srzero ∷ a+ srone ∷ a++-- | Unicode variant of @srplus@.++infixl 6 ⊕+infixl 6 `srplus`+(⊕) ∷ SemiRing a ⇒ a → a → a+(⊕) = srplus+{-# Inline (⊕) #-}++-- | Unicode variant of @srmul@.++infixl 7 ⊗+infixl 7 `srmul`+(⊗) ∷ SemiRing a ⇒ a → a → a+(⊗) = srmul+{-# Inline (⊗) #-}++++-- * Newtype wrappers for 'SemiRing' that make the semiring to use explicit.+-- This is important, because several types, say Prob(ability) have multiple+-- useful semiring instances.+--+-- 'Data.Monoid' in @base@ provides a number of newtype wrappers (@Sum@,+-- @Product@, etc) for monoids, which have one binary operation and identity.+-- There is, obviously, overlap with the structures constructed here.++-- | The Viterbi SemiRing. It maximizes over the product.++newtype Viterbi x = Viterbi { getViterbi ∷ x }+ deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)++derivingUnbox "Viterbi"+ [t| forall x . Unbox x ⇒ Viterbi x → x |] [| getViterbi |] [| Viterbi |]++instance NFData x ⇒ NFData (Viterbi x) where+ rnf (Viterbi x) = rnf x+ {-# Inline rnf #-}++-- |+--+-- TODO Shall we have generic instances, or specific ones like @SemiRing+-- (Viterbi Prob)@?+--+-- TODO Consider either a constraint @ProbLike x@ or the above.++instance (Ord x, Num x) ⇒ SemiRing (Viterbi x) where+ srplus (Viterbi x) (Viterbi y) = Viterbi $ max x y+ srmul (Viterbi x) (Viterbi y) = Viterbi $ x * y+ srzero = Viterbi 0+ srone = Viterbi 1+ {-# Inline srplus #-}+ {-# Inline srmul #-}+ {-# Inline srzero #-}+ {-# Inline srone #-}++-- | The tropical MinPlus SemiRing. It minimizes over the sum.++newtype MinPlus x = MinPlus { getMinPlus ∷ x }+ deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)++derivingUnbox "MinPlus"+ [t| forall x . Unbox x ⇒ MinPlus x → x |] [| getMinPlus |] [| MinPlus |]++instance NFData x ⇒ NFData (MinPlus x) where+ rnf (MinPlus x) = rnf x+ {-# Inline rnf #-}++-- |+--+-- TODO Shall we have generic instances, or specific ones like @SemiRing+-- (Viterbi Prob)@?+--+-- TODO Consider either a constraint @ProbLike x@ or the above.++instance (Ord x, Num x, NumericLimits x) ⇒ SemiRing (MinPlus x) where+ srplus (MinPlus x) (MinPlus y) = MinPlus $ min x y+ srmul (MinPlus x) (MinPlus y) = MinPlus $ x + y+ srzero = MinPlus maxFinite+ srone = 0+ {-# Inline srplus #-}+ {-# Inline srmul #-}+ {-# Inline srzero #-}+ {-# Inline srone #-}++++-- | The tropical MaxPlus SemiRing. It maximizes over the sum.++newtype MaxPlus x = MaxPlus { getMaxPlus ∷ x }+ deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)++derivingUnbox "MaxPlus"+ [t| forall x . Unbox x ⇒ MaxPlus x → x |] [| getMaxPlus |] [| MaxPlus |]++instance NFData x ⇒ NFData (MaxPlus x) where+ rnf (MaxPlus x) = rnf x+ {-# Inline rnf #-}++instance NumericLimits x ⇒ NumericLimits (MaxPlus x) where+ minFinite = MaxPlus minFinite+ maxFinite = MaxPlus maxFinite++-- |+--+-- TODO Shall we have generic instances, or specific ones like @SemiRing+-- (Viterbi Prob)@?+--+-- TODO Consider either a constraint @ProbLike x@ or the above.++instance (Ord x, Num x, NumericLimits x) ⇒ SemiRing (MaxPlus x) where+ srplus (MaxPlus x) (MaxPlus y) = MaxPlus $ max x y+ srmul (MaxPlus x) (MaxPlus y) = MaxPlus $ x + y+ srzero = MaxPlus minFinite+ srone = 0+ {-# Inline srplus #-}+ {-# Inline srmul #-}+ {-# Inline srzero #-}+ {-# Inline srone #-}++++-- * Generic semiring structure encoding.++-- | The generic semiring, defined over two 'Semigroup' and 'Monoid'+-- constructions.+--+-- It can be used like this:+-- @+-- srzero ∷ GSemiRing Min Sum Int == maxBound+-- srone ∷ GSemiRing Min Sum Int == 0+-- @+--+-- It is generally useful to still provide explicit instances, since @Min@+-- requires a @Bounded@ instance.++newtype GSemiRing (zeroMonoid ∷ * → *) (oneMonoid ∷ * → *) (x ∷ *) = GSemiRing { getSemiRing ∷ x }+ deriving (Eq, Ord, Read, Show, Generic)++instance+ forall zeroMonoid oneMonoid x+ . ( Semigroup (zeroMonoid x)+ , Monoid (zeroMonoid x)+ , Semigroup ( oneMonoid x)+ , Monoid ( oneMonoid x)+ )+ ⇒ SemiRing (GSemiRing zeroMonoid oneMonoid x) where+ srplus (GSemiRing x) (GSemiRing y) =+ let x' ∷ zeroMonoid x = unsafeCoerce x+ y' ∷ zeroMonoid x = unsafeCoerce y+ in unsafeCoerce $ x' <> y'+ srmul (GSemiRing x) (GSemiRing y) =+ let x' ∷ oneMonoid x = unsafeCoerce x+ y' ∷ oneMonoid x = unsafeCoerce y+ in unsafeCoerce $ x' <> y'+ srzero = unsafeCoerce (mempty ∷ zeroMonoid x)+ srone = unsafeCoerce (mempty ∷ oneMonoid x)+ {-# Inline srplus #-}+ {-# Inline srmul #-}+ {-# Inline srzero #-}+ {-# Inline srone #-}++-- ** Variants of 'Semigroup' structures, that use @NumericLimits@ instead of+-- @Bounded@.+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Christian Hoener zu Siederdissen 2018++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.++ * Neither the name of Christian Hoener zu Siederdissen nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++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.
+ Numeric/Discretized.hs view
@@ -0,0 +1,100 @@++-- | Discretized floating point numbers, where the scaling factor is kept+-- as two phantom types denoting the rational number used for scaling.++module Numeric.Discretized where++import Control.Applicative+import Data.Proxy+import Data.Ratio+import Debug.Trace+import GHC.Generics+import GHC.TypeLits+import GHC.Real (Ratio(..))++++-- | A discretized value takes a floating point number @n@ and produces @n *+-- fromIntegral l / fromIntegral u@ where both @u@ and @l@ are given as+-- @TypeLits@. I.e. a scaling factor of @ (u / l) = (1 / 100)@ does all+-- calculations in subdivisions of 100.+--+-- The main use of a 'Discretized' value is to enable calculations with 'Int'+-- while somewhat pretending to use floating point values.+--+-- Be careful with certain operations like @(*)@ as they will easily cause the+-- numbers to arbitrarily wrong. @(+)@ and @(-)@ are fine, however.+--+-- NOTE Export and import of data is in the form of floating points, which can+-- lead to additional loss of precision if one is careless!+--+-- TODO fast 'Show' methods required!+--+-- TODO blaze stuff?+--+-- TODO We might want to discretize @LogDomain@ style values. This requires+-- some thought on in which direction to wrap. Maybe, we want to log-domain+-- Discretized values, which probably just works.++newtype Discretized (u ∷ Nat) (l ∷ Nat) = Discretized { getDiscretized ∷ Int }+ deriving (Eq,Ord,Generic,Show,Read)++instance (KnownNat u, KnownNat l) ⇒ Num (Discretized u l) where+ Discretized x + Discretized y = Discretized (x+y)+ Discretized x - Discretized y = Discretized (x-y)+ Discretized x * Discretized y =+ let u = fromInteger $ natVal @u Proxy+ l = fromInteger $ natVal @l Proxy+ in Discretized $ (x*y*u) `div` l+ abs (Discretized x) = Discretized (abs x)+ signum (Discretized x) = Discretized $ signum x+ fromInteger = Discretized . fromInteger+ {-# Inline (+) #-}+ {-# Inline (-) #-}+ {-# Inline (*) #-}+ {-# Inline abs #-}+ {-# Inline signum #-}+ {-# Inline fromInteger #-}++instance Enum (Discretized u l) where+ toEnum = Discretized+ {-# Inline toEnum #-}+ fromEnum = getDiscretized+ {-# Inline fromEnum #-}++instance (Enum (Discretized u l), KnownNat u, KnownNat l) ⇒ Integral (Discretized u l) where++instance (KnownNat u, KnownNat l) ⇒ Fractional (Discretized u l) where+ Discretized x / Discretized y =+ let u = fromInteger $ natVal @u Proxy+ l = fromInteger $ natVal @l Proxy+ in Discretized $ (x * l) `div` (y * u)+ {-# Inline (/) #-}+ recip (Discretized x) =+ let u = fromInteger $ natVal @u Proxy+ l = fromInteger $ natVal @l Proxy+ in error "need to find approximately ok transformation"+ {-# Inline recip #-}+ fromRational (a :% b) =+ let u = natVal @u Proxy+ l = natVal @l Proxy+ in Discretized . fromInteger $ (a * l) `div` (b * u)++instance (KnownNat u, KnownNat l) ⇒ Real (Discretized u l) where+ toRational (Discretized d) =+ let u = natVal @u Proxy+ l = natVal @l Proxy+ in (fromIntegral d * u) % l+ {-# Inline toRational #-}++-- | Discretizes any @Real a@ into the @Discretized@ value. This conversion+-- is /lossy/!++discretize ∷ forall a u l . (Real a, KnownNat u, KnownNat l) ⇒ a → Discretized u l+discretize a =+ let u = natVal @u Proxy+ l = natVal @l Proxy+ k = toRational a+ in Discretized . fromIntegral $ numerator k * l `div` (denominator k * u)+{-# Inline discretize #-}+
+ Numeric/Limits.hs view
@@ -0,0 +1,46 @@++-- | Approximate and exact limits around 0 and towards transfinite numbers.++module Numeric.Limits where++++-- | The class of limits into the transfinite.++class NumericLimits x where+ -- "A" minimal finite number that can still be worked with. (And should not+ -- trip the CPU transfinite number handling)+ minFinite ∷ x+ -- "A" maximal finite number.+ maxFinite ∷ x++-- | The smallest value @/= 0@ for numeric values.++class NumericEpsilon x where+ -- | Numeric epsilon.+ epsilon ∷ x++++instance NumericLimits Word where+ minFinite = minBound `div` 100000+ maxFinite = maxBound `div` 100000+ {-# Inline minFinite #-}+ {-# Inline maxFinite #-}++instance NumericLimits Int where+ minFinite = minBound `div` 100000+ maxFinite = maxBound `div` 100000+ {-# Inline minFinite #-}+ {-# Inline maxFinite #-}++instance NumericLimits Double where+ minFinite = -1.79e308+ maxFinite = 1.79e308+ {-# Inline minFinite #-}+ {-# Inline maxFinite #-}++instance NumericEpsilon Double where+ epsilon = 2.2e-16+ {-# Inline epsilon #-}+
+ Numeric/LogDomain.hs view
@@ -0,0 +1,26 @@++-- | This module provides log-domain functionality. Ed Kmett provides, with+-- @log-domain@, a generic way to handle numbers in the log-domain, some which+-- is used under the hood here. We want some additional type safety and also+-- connect with the 'SemiRing' module.++module Numeric.LogDomain where++import Control.Monad.Except++++-- | Instances for @LogDomain x@ should be for specific types.++class LogDomain x where+ -- | The data family to connect a type @x@ with the type @Ln x@ in the+ -- log-domain.+ data Ln x ∷ *+ -- | Transport a value in @x@ into the log-domain. @logdom@ should throw an+ -- exception if @log x@ is not valid.+ logdom ∷ (MonadError String m) ⇒ x → m (Ln x)+ -- | Unsafely transport x into the log-domain.+ unsafelogdom ∷ x → Ln x+ -- | Transport a value @Ln x@ back into the linear domain @x@.+ lindom ∷ Ln x → x+
+ README.md view
@@ -0,0 +1,17 @@+[](https://travis-ci.org/choener/SciBaseTypes)++# SciBaseTypes++Base types, classes and functions shared across statistics, bioinformatics (the+Sci in sciences), and humanities. Some of the things defined here should be+lifted into their own libraries, once fleshed out.++++#### Contact++Christian Hoener zu Siederdissen +Leipzig University, Leipzig, Germany +choener@bioinf.uni-leipzig.de +http://www.bioinf.uni-leipzig.de/~choener/ +
+ SciBaseTypes.cabal view
@@ -0,0 +1,126 @@+Name: SciBaseTypes+Version: 0.0.0.1+License: BSD3+License-file: LICENSE+Author: Christian Hoener zu Siederdissen+Maintainer: choener@bioinf.uni-leipzig.de+Copyright: Christian Hoener zu Siederdissen, 2018+homepage: https://github.com/choener/SciBaseTypes+bug-reports: https://github.com/choener/SciBaseTypes/issues+Stability: Experimental+Category: Data+Build-type: Simple+Cabal-version: >= 1.10+tested-with: GHC == 8.4.4+Synopsis: Base types and classes for statistics, sciences and humanities+Description:+ This library provides a set of basic types and classes for+ statistics, sciences, and the humanities.++++extra-source-files:+ changelog.md+ README.md++++library+ exposed-modules:+ Algebra.Structure.SemiRing+ Numeric.Discretized+ Numeric.Limits+ Numeric.LogDomain+ StatisticalMechanics.Ensemble+ Statistics.Odds+ Statistics.Probability++ build-depends: base >= 4.7 && < 5.0+ , aeson >= 1.0+ , binary >= 0.7+ , cereal >= 0.4+ , deepseq >= 1.4+ , hashable >= 1.2+ , lens >= 4.0+ , log-domain >= 0.12+ , mtl >= 2.0+ , vector >= 0.10+ , vector-th-unbox >= 0.2+ ghc-options:+ -O2+ -funbox-strict-fields+ default-language:+ Haskell2010+ default-extensions: BangPatterns+ , ConstraintKinds+ , DataKinds+ , DeriveGeneric+ , FlexibleContexts+ , GeneralizedNewtypeDeriving+ , MultiParamTypeClasses+ , PolyKinds+ , RankNTypes+ , ScopedTypeVariables+ , StandaloneDeriving+ , TemplateHaskell+ , TupleSections+ , TypeApplications+ , TypeFamilies+ , UndecidableInstances+ , UnicodeSyntax++++benchmark BenchmarkSciBaseTypes+ build-depends: base+ , SciBaseTypes+ hs-source-dirs:+ tests+ main-is:+ Benchmark.hs+ default-language:+ Haskell2010+ type:+ exitcode-stdio-1.0+ default-extensions: BangPatterns+ , FlexibleContexts+ , ScopedTypeVariables+ , TypeFamilies+ , UnicodeSyntax+ ghc-options:+ -O2+ -funbox-strict-fields+ -funfolding-use-threshold1000+ -funfolding-keeness-factor1000++++test-suite properties+ type:+ exitcode-stdio-1.0+ main-is:+ properties.hs+ ghc-options:+ -threaded -rtsopts -with-rtsopts=-N+ hs-source-dirs:+ tests+ default-language:+ Haskell2010+ default-extensions: BangPatterns+ , ScopedTypeVariables+ , TemplateHaskell+ , TypeFamilies+ , UnicodeSyntax+ build-depends: base+ , SciBaseTypes+ , QuickCheck >= 2.7+ , tasty >= 0.11+ , tasty-quickcheck >= 0.8+ , tasty-th >= 0.1++++source-repository head+ type: git+ location: git://github.com/choener/SciBaseTypes+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ StatisticalMechanics/Ensemble.hs view
@@ -0,0 +1,27 @@++-- | This module provides generic functionality to deal with ensembles in+-- statistical mechanics.++module StatisticalMechanics.Ensemble where++++-- | The state probability functions provide conversion from some types @a@+-- into non-normalized probabilities. For "real" applications, using the+-- @logProbability@ function is preferred. This functions allows for easy+-- abstraction when types @a@ are given as fractions of some actual value (say:+-- deka-cal), or are discretized.+--+-- The returned values are not normalized, because we do not now the total+-- evidence @Z@ until integration over all states has happened -- which is not+-- feasible in a number of problems.+--+-- TODO replace @()@ with temperature and results with non-normalized @P@ or+-- @LogP@, depending.++class StateProbability a where+ -- | Given a temperature and a state "energy", return the corresponding+ -- non-normalized probability.+ stateProbability ∷ () → a → ()+ stateLogProbability ∷ () → a → ()+
+ Statistics/Odds.hs view
@@ -0,0 +1,51 @@++-- | Provides newtypes for odds, log-odds, and discretized versions.++module Statistics.Odds where++import Control.DeepSeq (NFData(..))+import Data.Aeson (FromJSON,ToJSON)+import Data.Binary (Binary)+import Data.Hashable (Hashable)+import Data.Serialize (Serialize)+import Data.Vector.Unboxed.Deriving+import GHC.Generics (Generic)++import Numeric.Limits++++-- | Odds.++newtype Odds = Odds { getOdds ∷ Double }+ deriving (Generic,Eq,Ord,Show,Read,Num)++-- | Encodes log-odds that have been rounded or clamped to integral numbers.+-- One advantage this provides is more efficient "maximum/minimum" calculations+-- compared to using @Double@s.+--+-- Note that these are "explicit" log-odds. Each numeric operation uses the+-- underlying operation on @Int@.++newtype DiscLogOdds = DiscLogOdds { getDiscLogOdds ∷ Int }+ deriving (Generic,Eq,Ord,Show,Read,Num)++derivingUnbox "DiscretizedLogOdds"+ [t| DiscLogOdds → Int |] [| getDiscLogOdds |] [| DiscLogOdds |]++instance Binary DiscLogOdds+instance Serialize DiscLogOdds+instance FromJSON DiscLogOdds+instance ToJSON DiscLogOdds+instance Hashable DiscLogOdds++instance NFData DiscLogOdds where+ rnf (DiscLogOdds k) = rnf k+ {-# Inline rnf #-}++instance NumericLimits DiscLogOdds where+ minFinite = DiscLogOdds minFinite+ {-# Inline minFinite #-}+ maxFinite = DiscLogOdds maxFinite+ {-# Inline maxFinite #-}+
+ Statistics/Probability.hs view
@@ -0,0 +1,123 @@++-- | Probability-related types.+--+-- TODO instances for serialization and further stuff+-- TODO vector instances++module Statistics.Probability where++import Control.Lens+import Numeric.Log+import Data.Vector.Unboxed.Deriving+import Data.Vector.Unboxed (Unbox)++import Algebra.Structure.SemiRing+import Numeric.LogDomain+import Numeric.Limits++++data IsNormalized = Normalized | NotNormalized++++-- * Probability in linear space++-- | @Prob@ wraps a @Double@ that encodes probabilities. If @Prob@ is tagged as+-- @Normalized@, the contained values are in the range @[0,...,1]@, otherwise+-- they are in the range @[0,...,∞]@.++newtype Prob (n ∷ IsNormalized) x = Prob { getProb ∷ x }+ deriving (Eq,Ord,Show,Read)++derivingUnbox "Prob"+ [t| forall n x. Unbox x ⇒ Prob n x → x |] [| getProb |] [| Prob |]++deriving instance (Enum x) ⇒ Enum (Prob n x)+deriving instance (Num x) ⇒ Num (Prob n x)+deriving instance (Fractional x) ⇒ Fractional (Prob n x)+deriving instance (Floating x) ⇒ Floating (Prob n x)+deriving instance (Real x) ⇒ Real (Prob n x)+deriving instance (RealFrac x) ⇒ RealFrac (Prob n x)+deriving instance (RealFloat x) ⇒ RealFloat (Prob n x)++instance (Num r) ⇒ SemiRing (Prob n r) where+ srplus = (+)+ srmul = (*)+ srzero = 0+ srone = 1++-- | Turns a value into a normalized probability. @error@ if the value is not+-- in the range @[0,...,1]@.++prob ∷ (Ord x, Num x, Show x) ⇒ x → Prob Normalized x+prob x+ | x >= 0 && x <= 1 = Prob x+ | otherwise = error $ show x ++ " not in range of [0,...,1]"+{-# Inline prob #-}++-- | Simple wrapper around @Prob@ that fixes non-normalization.++prob' ∷ (Ord x, Num x, Show x) ⇒ x → Prob NotNormalized x+prob' = Prob+{-# Inline prob' #-}++++-- * Probability in log space. A number of operations internally cast to @Log@+-- from @log-domain@, but the values themselves are *not* newtype-wrapped @Log+-- x@ values. This is because we want to be *explicit* that these are+-- log-probabilities.+--+-- @Log@ numbers in cases like @fromIntegral 1 :: Log Double@ are treated as+-- not being in the log-domain, hence @fromIntegral performs a @log@+-- operations.++newtype LogProb (n ∷ IsNormalized) x = LogProb { getLogProb ∷ x }+ deriving (Eq,Ord,Show)++derivingUnbox "LogProb"+ [t| forall n x. Unbox x ⇒ LogProb n x → x |] [| getLogProb |] [| LogProb |]++instance (Precise x, RealFloat x) ⇒ Num (LogProb n x) where+ (+) = withLog2 (+)+ (*) = withLog2 (*)+ abs = withLog1 abs+ signum = withLog1 signum+ fromInteger = LogProb . fromInteger+ negate = withLog1 negate+ (-) = withLog2 (-)++instance (Num d, Fractional d) ⇒ NumericLimits (LogProb n d) where+ minFinite = LogProb 0+ maxFinite = LogProb (1/0)++withLog1 ∷ (Log x → Log y) → LogProb n x → LogProb n y+withLog1 op (LogProb x) = LogProb . ln $ op (Exp x)+{-# Inline withLog1 #-}++withLog2 ∷ (Log x → Log y → Log z) → LogProb n x → LogProb n y → LogProb n z+withLog2 op (LogProb x) (LogProb y) = LogProb . ln $ op (Exp x) (Exp y)+{-# Inline withLog2 #-}+++-- * Conversion between probability in linear and log-space.++-- | Turn probability into log-probability.++p2lp ∷ (Floating x) ⇒ Prob n x → LogProb n x+p2lp (Prob x) = LogProb $ log x+{-# Inline p2lp #-}++-- | Turn log-probability into probability.++lp2p ∷ (Floating x) ⇒ LogProb n x → Prob n x+lp2p (LogProb x) = Prob $ exp x+{-# Inline lp2p #-}++-- | An isomorphism between @Prob@ and @LogProb@.++aslp ∷ (Floating x) ⇒ Iso' (Prob n x) (LogProb n x)+aslp = iso p2lp lp2p+{-# Inline aslp #-}+
+ changelog.md view
@@ -0,0 +1,4 @@+0.0.0.1+-------++- initial creation
+ tests/Benchmark.hs view
@@ -0,0 +1,8 @@++module Main where++++main ∷ IO ()+main = return ()+
+ tests/properties.hs view
@@ -0,0 +1,8 @@++module Main where++-- * Test @Numeric.Discretized@.++main ∷ IO ()+main = return ()+