aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Util
diff options
context:
space:
mode:
Diffstat (limited to 'XMonad/Util')
-rw-r--r--XMonad/Util/Anneal.hs93
1 files changed, 93 insertions, 0 deletions
diff --git a/XMonad/Util/Anneal.hs b/XMonad/Util/Anneal.hs
new file mode 100644
index 0000000..0d63ba3
--- /dev/null
+++ b/XMonad/Util/Anneal.hs
@@ -0,0 +1,93 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : XMonad.Util.Anneal
+-- Copyright : (c) David Roundy
+-- License : BSD-style (see LICENSE)
+--
+-- Maintainer : David Roundy <droundy@darcs.org>
+-- Stability : unstable
+-- Portability : unportable
+--
+-- Requires the 'random' package
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Util.Anneal (-- * Usage
+ -- $usage
+ Rated(Rated), the_value, the_rating
+ , anneal, annealMax ) where
+
+import System.Random ( StdGen, Random, mkStdGen, randomR )
+import Control.Monad.State ( State, runState, put, get, gets, modify )
+
+-- $usage
+-- See "XMonad.Layout.Mosaic" for an usage example.
+
+data Rated a b = Rated !a !b
+ deriving ( Show )
+instance Functor (Rated a) where
+ f `fmap` (Rated v a) = Rated v (f a)
+
+the_value :: Rated a b -> b
+the_value (Rated _ b) = b
+the_rating :: Rated a b -> a
+the_rating (Rated a _) = a
+
+instance Eq a => Eq (Rated a b) where
+ (Rated a _) == (Rated a' _) = a == a'
+instance Ord a => Ord (Rated a b) where
+ compare (Rated a _) (Rated a' _) = compare a a'
+
+anneal :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a
+anneal st r sel = runAnneal st r (do_anneal sel)
+
+annealMax :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a
+annealMax st r sel = runAnneal st (negate . r) (do_anneal sel)
+
+do_anneal :: (a -> [a]) -> State (Anneal a) (Rated Double a)
+do_anneal sel = do sequence_ $ replicate 100 da
+ gets best
+ where da = do select_metropolis sel
+ modify $ \s -> s { temperature = temperature s *0.99 }
+
+data Anneal a = A { g :: StdGen
+ , best :: Rated Double a
+ , current :: Rated Double a
+ , rate :: a -> Rated Double a
+ , temperature :: Double }
+
+runAnneal :: a -> (a -> Double) -> State (Anneal a) b -> b
+runAnneal start r x = fst $ runState x (A { g = mkStdGen 137
+ , best = Rated (r start) start
+ , current = Rated (r start) start
+ , rate = \xx -> Rated (r xx) xx
+ , temperature = 1.0 })
+
+select_metropolis :: (a -> [a]) -> State (Anneal a) ()
+select_metropolis x = do c <- gets current
+ a <- select $ x $ the_value c
+ metropolis a
+
+metropolis :: a -> State (Anneal a) ()
+metropolis x = do r <- gets rate
+ c <- gets current
+ t <- gets temperature
+ let rx = r x
+ boltz = exp $ (the_rating c - the_rating rx) / t
+ if rx < c then do modify $ \s -> s { current = rx, best = rx }
+ else do p <- getOne (0,1)
+ if p < boltz
+ then modify $ \s -> s { current = rx }
+ else return ()
+
+select :: [a] -> State (Anneal a) a
+select [] = the_value `fmap` gets best
+select [x] = return x
+select xs = do n <- getOne (0,length xs - 1)
+ return (xs !! n)
+
+getOne :: (Random a) => (a,a) -> State (Anneal x) a
+getOne bounds = do s <- get
+ (x,g') <- return $ randomR bounds (g s)
+ put $ s { g = g' }
+ return x