declarative

DIY Markov Chains
git clone git://git.jtobin.io/declarative.git
Log | Files | Refs | README | LICENSE

Anneal.hs (2530B)

      1 {-# OPTIONS_GHC -fno-warn-type-defaults #-}
      2 {-# LANGUAGE RecordWildCards #-}
      3 
      4 -- |
      5 -- Module: Numeric.MCMC.Anneal
      6 -- Copyright: (c) 2015 Jared Tobin
      7 -- License: MIT
      8 --
      9 -- Maintainer: Jared Tobin <jared@jtobin.ca>
     10 -- Stability: unstable
     11 -- Portability: ghc
     12 --
     13 -- Transition operators can easily be tweaked to operate over an /annealed/
     14 -- parameter space, which can be useful when sampling from bumpy landscapes
     15 -- with isolated modes.
     16 --
     17 -- This library exports a single 'anneal' function that allows one to run a
     18 -- /declarative/-compatible transition operator over a space that has been
     19 -- annealed to a specified temperature.
     20 --
     21 -- > import Numeric.MCMC
     22 -- >
     23 -- > annealingTransition = do
     24 -- >   anneal 0.70 (metropolis 1)
     25 -- >   anneal 0.05 (metropolis 1)
     26 -- >   anneal 0.05 (metropolis 1)
     27 -- >   anneal 0.70 (metropolis 1)
     28 -- >   metropolis 1
     29 --
     30 -- These annealed operators can then just be used like any other:
     31 --
     32 -- > himmelblau :: Target [Double]
     33 -- > himmelblau = Target lHimmelblau Nothing where
     34 -- >   lHimmelblau :: [Double] -> Double
     35 -- >   lHimmelblau [x0, x1] =
     36 -- >     (-1) * ((x0 * x0 + x1 - 11) ^ 2 + (x0 + x1 * x1 - 7) ^ 2)
     37 -- >
     38 -- > main :: IO ()
     39 -- > main = withSystemRandom . asGenIO $
     40 -- >   mcmc 10000 [0, 0] annealingTransition himmelblau
     41 
     42 module Numeric.MCMC.Anneal (
     43     anneal
     44   ) where
     45 
     46 import Control.Monad.Trans.State.Strict (get, modify)
     47 import Data.Sampling.Types (Transition, Chain(..), Target(..))
     48 
     49 -- | An annealing transformer.
     50 --
     51 --   When executed, the supplied transition operator will execute over the
     52 --   parameter space annealed to the supplied inverse temperature.
     53 --
     54 --   > let annealedTransition = anneal 0.30 (slice 0.5)
     55 anneal
     56   :: (Monad m, Functor f)
     57   => Double
     58   -> Transition m (Chain (f Double) b)
     59   -> Transition m (Chain (f Double) b)
     60 anneal invTemp baseTransition
     61   | invTemp < 0 = error "anneal: invalid temperture"
     62   | otherwise = do
     63       Chain {..} <- get
     64       let annealedTarget = annealer invTemp chainTarget
     65       modify $ useTarget annealedTarget
     66       baseTransition
     67       modify $ useTarget chainTarget
     68 
     69 annealer :: Functor f => Double -> Target (f Double) -> Target (f Double)
     70 annealer invTemp target = Target annealedL annealedG where
     71   annealedL xs = invTemp * lTarget target xs
     72   annealedG    =
     73     case glTarget target of
     74       Nothing -> Nothing
     75       Just g  -> Just (fmap (* invTemp) . g)
     76 
     77 useTarget :: Target a -> Chain a b -> Chain a b
     78 useTarget newTarget Chain {..} =
     79   Chain newTarget (lTarget newTarget chainPosition) chainPosition chainTunables
     80