add Data.Sample, start of stat-rethinking

Author: ocramz

app/stat-rethinking/Main.hs

@@ -0,0 +1,37 @@
+module Main where
+
+import Data.Permutation (Permutation, permutations, getPermutationList)
+import Data.Sample (Sample, fromList, filter, sample2, sample3)
+import Data.Ratio (Ratio, (%))
+
+import Prelude hiding (filter)
+
+main :: IO ()
+main = putStrLn "hello!"
+
+
+
+
+
+-- | Ratio of observed outcomes to all possible outcomes for samples of length 3
+--
+-- >>> pOutcomes (fromList [1,0,1]) (fromList [1,1,0,0])
+-- 1 % 8
+-- >>> pOutcomes (fromList [1,0,1]) (fromList [1,0,0,0])
+-- 3 % 64
+pOutcomes :: Sample Int -- ^ observed sample
+          -> Sample Int -- ^ hypothesis
+          -> Ratio Int
+pOutcomes spl hypot = nsps % ntot
+  where
+    xs = samples3 hypot
+    nsps = length $ filter (== spl) xs
+    ntot = length xs
+
+-- | All possible samples of length 3
+samples3 :: Sample Int -> Sample (Sample Int)
+samples3 xs = sample3 <$> xs <*> xs <*> xs
+
+
+
+

bayesian-inference.cabal

@@ -28,6 +28,7 @@ library
                        Numeric.Math
                        Data.Graph.Examples
                        Data.Permutation
+                       Data.Sample
   other-modules:       System.Random.MWC.Probability.Conditional
   build-depends:       base >= 4.7 && < 5
                      , algebraic-graphs
@@ -37,8 +38,8 @@ library
                      , ghc-prim
                      , logging-effect
                      , massiv
-                     , microlens
-                     , microlens-mtl
+                     -- , microlens
+                     -- , microlens-mtl
                      , mtl
                      , mwc-probability
                      , mwc-probability-transition
@@ -50,6 +51,14 @@ library
                      , hspec
                      , QuickCheck
 
+executable stat-rethinking
+  default-language:    Haskell2010
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  hs-source-dirs:      app/stat-rethinking
+  main-is:             Main.hs
+  build-depends:       base
+                     , bayesian-inference
+
 executable graph-export
   default-language:    Haskell2010
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N

src/Data/Permutation.hs

@@ -3,7 +3,7 @@
 Finite permutations
 -}
 module Data.Permutation (
-  Permutation, permutation, getPermutation, permutations
+  Permutation, permutation, getPermutation, getPermutationList, permutations
   -- * Helper functions
   , swaps, swapsEnum
   ) where
@@ -21,12 +21,16 @@ newtype Permutation a = Permutation {
   _getPermutation :: V.Vector a
                                }
 
+getPermutationList :: Permutation a -> [a]
+getPermutationList = V.toList . getPermutation
+
 getPermutation :: Permutation a -> V.Vector a
 getPermutation = _getPermutation
 
 instance Show a => Show (Permutation a) where
   show (Permutation pv) = show $ V.toList pv
 
+-- | Compute all permutations of the given list
 permutations :: [a] -> [Permutation a]
 permutations xs = permSwap p0 `map` swaps n  where
   p0 = permutation xs

src/Data/Sample.hs

@@ -0,0 +1,43 @@
+{-# language DeriveFunctor, GeneralizedNewtypeDeriving #-}
+module Data.Sample (Sample, empty, cons, fromList
+                   , filter
+                   , sample2, sample3) where
+
+import Data.Foldable (Foldable(..))
+import qualified Data.Sequence as S
+import Prelude hiding (filter)
+
+
+-- | Finite sample, internally represented as a 'S.Seq' (i.e. a finger tree)
+newtype Sample a = Sample {
+  getSample_ :: S.Seq a
+  } deriving (Eq, Functor, Applicative, Foldable)
+instance Show a => Show (Sample a) where
+  show (Sample xs) = show $ toList xs
+
+sample2 :: a -> a -> Sample a
+sample2 a b = a `cons` (b `cons` empty)
+{-# INLINE sample2 #-}
+
+sample3 :: a -> a -> a -> Sample a
+sample3 a b c = fromList [a, b, c]
+{-# INLINE sample3 #-}
+
+-- | Filter a sample according to a predicate
+filter :: (a -> Bool) -> Sample a -> Sample a
+filter q (Sample s) = Sample $ S.filter q s
+
+-- | Empty sample
+empty :: Sample a
+empty = Sample S.empty
+
+-- | O(1) Left append
+cons :: a -> Sample a -> Sample a
+x `cons` s = Sample $ x S.<| getSample_ s
+{-# INLINE cons #-}
+
+fromList :: [a] -> Sample a
+fromList = Sample . S.fromList
+
+
+

src/Numeric/Statistics/Inference/Bayes/Exact/VariableElimination.hs

@@ -27,9 +27,9 @@ import Control.Monad.Catch (MonadThrow(..))
 -- import qualified Data.Massiv.Array as A (Array, all, Comp(..), makeArray, Construct(..), Sz(..))
 -- import Data.Massiv.Array (Index, Ix1(..), D, (..:), ifoldlWithin', foldlWithin', Lower, Dim(..), Source)
 -- microlens
-import Lens.Micro (Lens(..), Lens', lens, (^.), (.~), (%~), Getting)
+-- import Lens.Micro (Lens(..), Lens', lens, (^.), (.~), (%~), Getting)
 -- microlens-mtl
-import Lens.Micro.Mtl (view, (%=))
+-- import Lens.Micro.Mtl (view, (%=))
 -- mtl
 import Control.Monad.State (MonadState(..), gets)
 import Control.Monad.Reader (MonadReader(..), asks)

stack.yaml

@@ -5,28 +5,9 @@ resolver: lts-12.14
 # resolver: nightly-2019-08-04
 # resolver: nightly-2019-11-29
 
-# User packages to be built.
-# Various formats can be used as shown in the example below.
-#
-# packages:
-# - some-directory
-# - https://example.com/foo/bar/baz-0.0.2.tar.gz
-# - location:
-#    git: https://github.com/commercialhaskell/stack.git
-#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
-# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
-#   extra-dep: true
-#  subdirs:
-#  - auto-update
-#  - wai
-#
-# A package marked 'extra-dep: true' will only be built if demanded by a
-# non-dependency (i.e. a user package), and its test suites and benchmarks
-# will not be run. This is useful for tweaking upstream packages.
 packages:
 - .
-# Dependency packages to be pulled from upstream that are not in the resolver
-# (e.g., acme-missiles-0.3)
+
 extra-deps: 
 - mwc-probability-transition-0.3.0.3
 - algebraic-graphs-0.4@sha256:5d163af6f2f8c6729572f5378e1b0037b563c765930a957a135aa9d34e4518c5