diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,3 +1,18 @@ +Changes in 0.5: + +* Clark Gaebel added Monoid and NFData instances to Summary types + +* Clark Gaebel added liftMCT to the export list + +* Casper Holmgreen fixed bug in Data.Summary.Bool Show instance + +* Gábor Lipták added test target to cabal + + +Changes in 0.4.3: + +* New cabal test use: cabal configure --enable-tests --enable-library-coverage + Changes in 0.4.2: * gliptak added compile fixes for ghc 7.4 diff --git a/lib/Control/Monad/MC/GSL.hs b/lib/Control/Monad/MC/GSL.hs --- a/lib/Control/Monad/MC/GSL.hs +++ b/lib/Control/Monad/MC/GSL.hs @@ -21,6 +21,7 @@ runMCT, evalMCT, execMCT, + liftMCT, -- * Pure random number generator creation RNG, @@ -37,6 +38,6 @@ ) where import Control.Monad.MC.GSLBase ( MC, runMC, evalMC, execMC, - MCT, runMCT, evalMCT, execMCT, RNG, Seed, mt19937, mt19937WithState, + MCT, runMCT, evalMCT, execMCT, liftMCT, RNG, Seed, mt19937, mt19937WithState, rngName, rngSize, rngState ) import Control.Monad.MC.Class hiding ( RNG ) diff --git a/lib/Data/Summary/Bool.hs b/lib/Data/Summary/Bool.hs --- a/lib/Data/Summary/Bool.hs +++ b/lib/Data/Summary/Bool.hs @@ -24,7 +24,9 @@ ) where +import Control.DeepSeq import Data.List( foldl' ) +import Data.Monoid import Text.Printf import Data.Summary.Utils @@ -41,12 +43,19 @@ instance Show Summary where show s@(S n c) = printf " sample size: %d" n - ++ printf "\n successes: %g" c + ++ printf "\n successes: %d" c ++ printf "\n proportion: %g" (sampleMean s) ++ printf "\n SE: %g" (sampleSE s) ++ printf "\n 99%% CI: (%g, %g)" c1 c2 where (c1,c2) = sampleCI 0.99 s +instance Monoid Summary where + mempty = empty + mappend = union + +instance NFData Summary + + -- | Get a summary of a list of values. summary :: [Bool] -> Summary summary = foldl' update empty @@ -54,6 +63,10 @@ -- | Get an empty summary. empty :: Summary empty = S 0 0 + +-- | Take the union of two summaries. +union :: Summary -> Summary -> Summary +union (S na ca) (S nb cb) = S (na + nb) (ca + cb) -- | Update the summary with a data point. update :: Summary -> Bool -> Summary diff --git a/lib/Data/Summary/Double.hs b/lib/Data/Summary/Double.hs --- a/lib/Data/Summary/Double.hs +++ b/lib/Data/Summary/Double.hs @@ -27,7 +27,9 @@ ) where +import Control.DeepSeq import Data.List( foldl' ) +import Data.Monoid import Text.Printf import Data.Summary.Utils @@ -51,6 +53,13 @@ ++ printf "\n 99%% CI: (%g, %g)" c1 c2 where (c1,c2) = sampleCI 0.99 s +instance Monoid Summary where + mempty = empty + mappend = union + +instance NFData Summary + + -- | Get a summary of a list of values. summary :: [Double] -> Summary summary = foldl' update empty @@ -72,6 +81,25 @@ l' = if x < l then x else l h' = if x > h then x else h in S n' m' s' l' h' + +-- | Take the union of two summaries. +-- Use the updating rules from Chan et al. "Updating Formulae and a Pairwise +-- Algorithm for Computing Sample Variances," available at +-- ftp://reports.stanford.edu/pub/cstr/reports/cs/tr/79/773/CS-TR-79-773.pdf +union :: Summary -> Summary -> Summary +union (S na ma sa la ha) (S nb mb sb lb hb) = + let delta = mb - ma + (na', nb') = (fromIntegral na, fromIntegral nb) + n = na + nb + n' = fromIntegral n + weightedDelta = delta*nb'/n' + m | n == 0 = 0 + | otherwise = ma + weightedDelta + s | n == 0 = 0 + | otherwise = sa + sb + delta*na'*weightedDelta + l = min la lb + h = max ha hb + in S n m s l h -- | Get the sample size. sampleSize :: Summary -> Int diff --git a/monte-carlo.cabal b/monte-carlo.cabal --- a/monte-carlo.cabal +++ b/monte-carlo.cabal @@ -1,5 +1,5 @@ name: monte-carlo -version: 0.4.2 +version: 0.5 license: BSD3 license-file: LICENSE author: Patrick Perry @@ -15,7 +15,7 @@ (GSL) is supported. build-type: Simple stability: experimental -cabal-version: >= 1.6 +cabal-version: >= 1.8 extra-source-files: NEWS examples/Binomial.hs examples/Pi.lhs examples/Poker.hs examples/Queue.hs tests/Main.hs tests/Makefile @@ -46,7 +46,8 @@ build-depends: base >= 4 && < 5, gsl-random >= 0.4.3 && < 0.5, mtl >= 1.1 && < 3.0, - vector >= 0.6 && < 0.10 + vector >= 0.6 && < 0.11, + deepseq >= 1.0 && < 2.0 hs-source-dirs: lib ghc-options: -Wall @@ -55,3 +56,23 @@ type: git location: https://github.com/patperry/hs-monte-carlo.git +test-suite monte-carlo-test + type: + exitcode-stdio-1.0 + hs-source-dirs: + lib, tests + main-is: + Main.hs + ghc-options: + -Wall -Werror + build-depends: + base >= 4 && < 5 + , gsl-random >= 0.4.3 && < 0.5 + , mtl >= 1.1 && < 3.0 + , vector >= 0.6 && < 0.11 + , ieee754 >= 0.7 && < 0.8 + , random >=1.0 && < 1.1 + , QuickCheck >= 2.4.0.1 && < 2.6 + , test-framework-quickcheck2 >= 0.2 && < 0.4 + , test-framework >= 0.4 && < 0.9 + , deepseq >= 1.0 && < 2.0 diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,37 +1,36 @@ - +{-# LANGUAGE RankNTypes #-} module Main where -import Debug.Trace import Control.Monad import Data.AEq -import Data.List -import System.IO -import System.Environment -import System.Random -import Text.Printf +import Data.Monoid +import Data.Summary import Test.QuickCheck import Test.Framework import Test.Framework.Providers.QuickCheck2 import Control.Monad.MC.Walker - +prop_table_probs :: Weights -> Bool prop_table_probs (Weights n ws) = let table = computeTable n ws in all (\i -> probOf table i ~== ps !! i) [0..n-1] where ps = probsFromWeights ws +prop_table_index :: Weights -> Unif -> Bool prop_table_index (Weights n ws) (Unif u) = let table = computeTable n ws i = indexTable table u in i >= 0 && i < n && (ws !! i > 0) +tests_Walker :: Test tests_Walker = testGroup "Walker" [ testProperty "table probabilities" prop_table_probs , testProperty "table indexing" prop_table_index ] +probOf :: Table -> Int -> Double probOf table i = (((sum . map ((1-) . fst) . filter ((==i) . snd)) (map (component table) [0..n-1])) @@ -39,13 +38,43 @@ where n = tableSize table +prop_monoid_update_equiv :: [Double] -> [Double] -> Bool +prop_monoid_update_equiv xs ys = + approxEqualS (summary $ xs <> ys) + (summary xs <> summary ys) + +prop_monoid_assoc :: [Double] -> [Double] -> [Double] -> Bool +prop_monoid_assoc xs ys zs = + let (sxs, sys, szs) = (summary xs, summary ys, summary zs) + in ((sxs <> sys) <> szs) `approxEqualS` (sxs <> (sys <> szs)) + +prop_monoid_commute :: [Double] -> [Double] -> Bool +prop_monoid_commute xs ys = + let (sxs, sys) = (summary xs, summary ys) + in (sxs <> sys) `approxEqualS` (sys <> sxs) + +tests_monoid :: Test +tests_monoid = testGroup "Monoid Instance" + [ testProperty "update equivalence" prop_monoid_update_equiv + , testProperty "associativity" prop_monoid_assoc + , testProperty "commutativity" prop_monoid_commute + ] + ------------------------------- Utility functions --------------------------- +probsFromWeights :: forall b. Fractional b => [b] -> [b] probsFromWeights ws = let w = sum ws ps = map (/w) ws in ps +approxEqualS :: Summary -> Summary -> Bool +approxEqualS a b = + sampleSize a == sampleSize b && + all eq [ sampleMin, sampleMax, sampleMean, sampleVar ] + where + eq f = f a ~== f b + ------------------------------- Test generators ----------------------------- posInt :: Gen Int @@ -83,4 +112,4 @@ main :: IO () -main = defaultMain [ tests_Walker ] +main = defaultMain [ tests_Walker, tests_monoid ]