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

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

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

-- | 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

-- | 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

-- | Runs several 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