aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJustin Bedo <cu@cua0.org>2023-01-01 17:25:36 +1100
committerJustin Bedo <cu@cua0.org>2023-01-05 07:13:49 +1100
commitb906da9afa6802bf8104dfabe26b67a6c673af91 (patch)
tree5599a8178068d632da69c372b9328549c0914faf
parent89f31630897f2c252e9ff29f1f8e67827676e61a (diff)
slight tidy
-rw-r--r--src/PPL/Internal.hs19
1 files changed, 8 insertions, 11 deletions
diff --git a/src/PPL/Internal.hs b/src/PPL/Internal.hs
index a729d3d..201a3aa 100644
--- a/src/PPL/Internal.hs
+++ b/src/PPL/Internal.hs
@@ -26,10 +26,8 @@ split (Tree r (t : ts)) = (t, Tree r ts)
{-# INLINE randomTree #-}
randomTree :: RandomGen g => g -> Tree
randomTree g = let (a, g') = random g in Tree a (randomTrees g')
-
-{-# INLINE randomTrees #-}
-randomTrees :: RandomGen g => g -> [Tree]
-randomTrees g = let (g1, g2) = R.split g in randomTree g1 : randomTrees g2
+ where
+ randomTrees g = let (g1, g2) = R.split g in randomTree g1 : randomTrees g2
{-# INLINE mutateTree #-}
mutateTree :: RandomGen g => Double -> g -> Tree -> Tree
@@ -37,12 +35,10 @@ mutateTree p g (Tree a ts) =
let (r, g1) = random g
(b, g2) = random g1
in Tree (if r < p then b else a) (mutateTrees p g2 ts)
-
-{-# INLINE mutateTrees #-}
-mutateTrees :: RandomGen g => Double -> g -> [Tree] -> [Tree]
-mutateTrees p g (t:ts) =
- let (g1, g2) = R.split g
- in mutateTree p g1 t : mutateTrees p g2 ts
+ where
+ mutateTrees p g (t:ts) =
+ let (g1, g2) = R.split g
+ in mutateTree p g1 t : mutateTrees p g2 ts
newtype Prob a = Prob {runProb :: Tree -> a}
@@ -71,11 +67,12 @@ score = scoreLog . Exp . log . max eps
scoreLog :: Log Double -> Meas ()
scoreLog = Meas . tell . Product
+{-# INLINE sample #-}
sample :: Prob a -> Meas a
sample = Meas . lift
{-# INLINE samples #-}
samples :: forall a. Meas a -> Tree -> [(a, Log Double)]
-samples (Meas m) t = map (second getProduct) $ runProb f t
+samples (Meas m) = map (second getProduct) . runProb f
where
f = runWriterT m >>= \x -> (x:) <$> f