Annealer.hs

{-# LANGUAGE RecordWildCards #-}

-- | The traditional simulated annealing is to maintain a current state,
-- and repeatedly perturb it, keeping or discarding the perturbed state
-- depending on the difference in an energy function and a "temperature,"
-- which changes as a function of time.  This concurrent
-- SA implementation maintains a population of current states which are
-- perturbed, and lower-ranked states are deleted according to a temperature
-- function.  It is intended as a lightweight approach to parallelizing
-- optimization problems.
module Control.Concurrent.Annealer  (Annealer, initAnnealer, offerState, getBestState, annealForTime) where

import Control.Concurrent (forkIO, killThread, threadDelay)
import Control.Monad (replicateM)

import Control.Concurrent.Annealer.Population hiding (offerState)
import qualified Control.Concurrent.Annealer.Population as Pop

-- | An annealer.  Maintains a population of states and a perturbation function.
data Annealer s e = PopAnn {
	solPop :: {-# UNPACK #-} !(Population s e),
	perturb :: s -> IO s}

-- | Returns the current best state in the annealer.
getBestState :: Ord e => Annealer s e -> IO s
getBestState = getBest . solPop

-- | A thread in which states in the annealer's current population are perturbed
-- and offered back into the population.
perturber :: Annealer s e -> IO ()
perturber pop@PopAnn{..} = do
	sol' <- perturb =<< pickState solPop
	Pop.offerState sol' solPop
	perturber pop

-- | @'initAnnealer' initPop energyFunc popSize perturb@ initializes an annealer.
initAnnealer :: Ord e => 
	   [s] 			-- A seed collection of initial states.
	-> (s -> e)		-- The energy function of a state.
	-> Int			-- The size at which to maintain the population.
	-> (s -> IO s) 		-- The perturbation function.
	-> IO (Annealer s e) 	-- The annealer.
initAnnealer sols solScore popSize perturb = 
	do	solPop <- initPop solScore sols popSize
		return PopAnn{..}

-- | Offer a state to the annealer.  Depending on the current
-- population, the state may or may not be kept.
offerState :: s -> Annealer s e -> IO ()
offerState s = Pop.offerState s . solPop

-- | @'annealForTime' nThreads microTime annealer@ runs @nThreads@ annealing threads for the specified length of time.
annealForTime :: Ord e => 
		Int	-- The number of annealing threads to run.
		-> Int	-- The number of milliseconds until this program will try to stop.
		-> Annealer s e	-- The annealer to run.
		-> IO s	-- The best state in the annealer's population at the time of ending.
annealForTime nThreads t pop = do
	threads <- replicateM nThreads (forkIO (perturber pop))
	threadDelay t
	mapM_ killThread threads
	getBestState pop