mcmc-synthesis 0.1.1.1 → 0.1.2.1

raw patch · 4 files changed

+38/−12 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• mcmc-synthesis.cabal +1/−1
• src/Language/Synthesis/Distribution.hs +0/−1
• src/Language/Synthesis/Mutations.hs +23/−1
• src/Language/Synthesis/Synthesis.hs +14/−9

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.1.1.1+version:             0.1.2.1  -- A short (one-line) description of the package. synopsis:            MCMC applied to probabilistic program synthesis

@@ -22,7 +22,6 @@ negativeInfinity :: Double negativeInfinity = read "-Infinity" - -- |A distribution containing a single item. constant :: a -> Distr a constant item = Distr { sample = return item

@@ -1,7 +1,11 @@+{-# LANGUAGE RankNTypes, ScopedTypeVariables #-} module Language.Synthesis.Mutations (-    mutateInstruction, swapInstructions, mix, Mutation+    mutateInstruction, mutateInstructionAt, mutateInstructionsAt, swapInstructions, mix, Mutation ) where +import           Control.Monad                   (foldM)+import           Control.Monad.Random            (Rand)+ import           Language.Synthesis.Distribution (Distr (Distr)) import qualified Language.Synthesis.Distribution as Distr @@ -22,6 +26,24 @@               if (before', after') == (before, after)                   then Distr.logProbability instrDistr elem'                   else Distr.negativeInfinity++dropAt :: [Int] -> [a] -> [a]+dropAt positions = map snd . filter ((`elem` positions) . fst) . zip [0..]++takeAt :: [Int] -> [a] -> [a]+takeAt positions = map snd . filter ((`notElem` positions) . fst) . zip [0..]++mutateInstructionsAt :: Eq a => Distr a -> [Int] -> [a] -> Distr [a]+mutateInstructionsAt instrDistr positions program = Distr (samp ()) logProb+    where instrs = Distr.replicate (length positions) instrDistr+          samp () = do+            elems <- Distr.sample instrs+            return $ foldr (uncurry replaceAt) program (zip positions elems)   +          logProb other =+            if dropAt positions other == dropAt positions program+                  then Distr.logProbability instrs $ takeAt positions other+                  else Distr.negativeInfinity+  -- |Given a distribution over instructions, mutates a random instruction. mutateInstruction :: Eq a => Distr a -> Mutation [a]

@@ -1,6 +1,6 @@ {-# LANGUAGE NamedFieldPuns #-} module Language.Synthesis.Synthesis (-    Mutation, synthesizeMhList, runningBest, Problem(..)+    Score (..), Mutation, synthesizeMhList, runningBest, Problem(..) ) where  import           Control.Monad.Random            (Rand, RandomGen)@@ -10,26 +10,31 @@ import           Language.Synthesis.MCMC import           Language.Synthesis.Mutations    (Mutation) +-- | A score is anything that can be mapped to a double.+class Score a where toScore :: a -> Double++instance Score Double where toScore = id+ -- | This type specifies which program to synthesize. It comes with a -- specification, which is a program that already works, some inputs -- and a distance function.-data Problem program = Problem { score :: program -> Double-                               , prior :: Distr program-                               , jump  :: Mutation program-                               }+data Problem p s = Problem { score :: p -> s+                           , prior :: Distr p+                           , jump  :: Mutation p+                           }  -- |Given a prior distribution, score function, mutation distribution, generate -- a list of (program, score) values through MH sampling.-synthesizeMhList :: RandomGen gen => Problem program -> Rand gen [(program, Double)]+synthesizeMhList :: (Score s, RandomGen gen) => Problem p s -> Rand gen [(p, s)] synthesizeMhList Problem {prior, score, jump} = do     first <- Distr.sample prior-    let density prog = (sc, sc + Distr.logProbability prior prog)-            where sc = score prog+    let density prog = (sc, toScore sc + Distr.logProbability prior prog)+          where sc = score prog     list <- mhList first density jump     return [(prog, sc) | (prog, sc, _) <- list]  -- |Given (value, score) pairs, return a running list of the best pair so far.-runningBest :: [(a, Double)] -> [(a, Double)]+runningBest :: Ord s => [(a, s)] -> [(a, s)] runningBest []           = [] runningBest (first:rest) = scanl maxScore first rest     where maxScore (p, ps) (q, qs) | qs >= ps = (q, qs)