mcmc-synthesis 0.1.0.4 → 0.1.0.5

raw patch · 3 files changed

+32/−52 lines, 3 filesdep ~base

Dependency ranges changed: base

Files

• mcmc-synthesis.cabal +11/−8
• src/Language/Synthesis/MCMC.hs +18/−29
• src/Language/Synthesis/Synthesis.hs +3/−15

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.1.0.4+version:             0.1.0.5  -- A short (one-line) description of the package. synopsis:            MCMC applied to probabilistic program synthesis@@ -25,7 +25,7 @@ license-file:        LICENSE  -- The package author(s).-author:              Jacob Taylor+author:              Jacob Taylor, Tikhon Jelvis  -- An email address to which users can send suggestions, bug reports, and  -- patches.@@ -41,12 +41,15 @@ -- Constraint on the version of Cabal needed to build this package. cabal-version:       >=1.8 +source-repository head+  type:                git+  location:            git://github.com/jacobt/mcmc-synthesis.git  library-  build-depends:       base ==4.5.*, MonadRandom ==0.1.*+  build-depends:       base >3 && <=5, MonadRandom ==0.1.*   hs-source-dirs:      src-  exposed-modules:     Language.Synthesis.Distribution, Language.Synthesis.MCMC,-                       Language.Synthesis.Synthesis, Language.Synthesis.Mutations-  GHC-options:         -Wall -O2--  +  exposed-modules:     Language.Synthesis.Distribution,+                       Language.Synthesis.MCMC,+                       Language.Synthesis.Mutations,+                       Language.Synthesis.Synthesis+  GHC-options:         -Wall

@@ -1,10 +1,10 @@ module Language.Synthesis.MCMC (mhList) where -import           Control.Monad import           Control.Monad.Random            (Rand, RandomGen, getRandom,                                                   getSplit, runRand)-import           Control.Monad.Random.Class      () +import           Data.Functor                    ((<$>))+ import           Language.Synthesis.Distribution (Distr) import qualified Language.Synthesis.Distribution as Distr @@ -12,33 +12,22 @@ -- These functions work on triples, (value, aux, density). -- Density functions take a value and return auxilary and density. --mhNext :: RandomGen g => (a, b, Double) -> (a -> (b, Double)) ->-          (a -> Distr a) -> Rand g (a, b, Double)-mhNext (orig, origAux, origDensity) density jump = do-    next <- Distr.sample (jump orig)-    let origToNext = Distr.logProbability (jump orig) next-        nextToOrig = Distr.logProbability (jump next) orig-        (nextAux, nextDensity) = density next-        score = nextDensity - origDensity + nextToOrig - origToNext-    acceptance <- getRandom-    return $ if score >= log acceptance-                then (next, nextAux, nextDensity)-                else (orig, origAux, origDensity)---mhList' :: RandomGen g => (a, b, Double) -> (a -> (b, Double)) ->-           (a -> Distr a) -> g -> [(a, b, Double)]-mhList' orig density jump g = orig : mhList' next density jump g'-    where (next, g') = runRand (mhNext orig density jump) g-- -- |Use the Metropolis-Hastings algorithm to sample a list of values. mhList :: RandomGen g =>-          a                          -- ^The initial value.-          -> (a -> (b, Double))      -- ^Density function.-          -> (a -> Distr a)          -- ^Jumping distribution.+          a                         -- ^The initial value.+          -> (a -> (b, Double))       -- ^Density function.+          -> (a -> Distr a)           -- ^Jumping distribution.           -> Rand g [(a, b, Double)] -- ^List of (value, aux, density).-mhList orig density jump =-    liftM (mhList' (orig, origAux, origDensity) density jump) getSplit-    where (origAux, origDensity) = density orig+mhList startValue density jump = go (startValue, startAux, startDensity) <$> getSplit+  where (startAux, startDensity) = density startValue+        go orig g = let (next, g') = runRand (mhNext orig) g in orig : go next g'+        mhNext (orig, origAux, origDensity) = do+            next <- Distr.sample $ jump orig+            let origToNext = Distr.logProbability (jump orig) next+                nextToOrig = Distr.logProbability (jump next) orig+                (nextAux, nextDensity) = density next+                score = nextDensity - origDensity + nextToOrig - origToNext+            acceptance <- getRandom+            return $ if score >= log acceptance+                        then (next, nextAux, nextDensity)+                        else (orig, origAux, origDensity)

@@ -3,7 +3,7 @@     Mutation, synthesizeMhList, runningBest, Problem(..) ) where -import           Control.Monad.Random+import           Control.Monad.Random            (Rand, RandomGen)  import           Language.Synthesis.Distribution (Distr) import qualified Language.Synthesis.Distribution as Distr@@ -28,21 +28,9 @@     list <- mhList first density jump     return [(prog, sc) | (prog, sc, _) <- list] --scanl' :: (a -> b -> a) -> a -> [b] -> [a]-scanl' f q xs = q : (case xs of-                        [] -> []-                        first:rest -> next `seq` scanl f next rest-                            where next = f q first)- -- |Given (value, score) pairs, return a running list of the best pair so far.+runningBest :: [(a, Double)] -> [(a, Double)] runningBest []           = []-runningBest (first:rest) = scanl' maxScore first rest+runningBest (first:rest) = scanl maxScore first rest     where maxScore (p, ps) (q, qs) | qs >= ps = (q, qs)                                    | otherwise = (p, ps)---- runningBest :: [(a, Double)] -> [(a, Double)]--- runningBest [] = []--- runningBest [only] = [only]--- runningBest ((p,ps):(q,qs):rest) | qs >= ps = (p, ps) : runningBest ((q,qs):rest)---                                  | otherwise = (p, ps) : runningBest ((p,ps):rest)