diff options
| -rw-r--r-- | src/PPL/Internal.hs | 19 |
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 |