-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Search.Local
-- Copyright   :  (c) Richard Senington & David Duke 2010
-- License     :  GPL-style
-- 
-- Maintainer  :  Richard Senington <sc06r2s@leeds.ac.uk>
-- Stability   :  provisional
-- Portability :  portable
-- 
-- This is the unification, and it is not expected that a user will have to directly import any other files, they are 
-- all exposed through this one. It then defines some basic search strategies of its own.
----------------------------------------------------------------------------- 

module Control.Search.Local (
  -- Strategies 
  firstImprov,
  minImprov,
  maxImprov,
  randomImprov,
  randomWalk,
  simpleTabu,
  minFirstTabu,
  maxFirstTabu,
  stochasticTabu,
  saTemp,
  simulatedAnnealingA,
  simulatedAnnealingB,
  
  -- Navigators
  firstChoice,
  manualNavigator,
  -- Transformations
  improvement,
  nShuffle,
  nSort,
  nReverse,
  tabu,
  thresholdWorsening,
  varyingThresholdWorsening,
  multiLevelApply,
  sImprovement,

  -- The internal tree, and accessor functions
  LSTree(LSTree),
  treeNodeName,
  treeNodeChildren, 
  mkTree,

  -- Neighbourhoods and problem specific stuff
  exchange,
  basicExchange,
  priceSolution,
  NumericallyPriced
)where

import Control.Search.Local.Tree
import Control.Search.Local.Transformation
import Control.Search.Local.Navigator
import Control.Search.Local.Neighbourhood 
import System.Random

-- | First improvement, relies upon the solutions forming an ordering. 

firstImprov :: Ord nme=>LSTree nme->[nme]
firstImprov = firstChoice . improvement

{- | Minimal improvement, will take the worst solution, that still improves upon the current 
  solution. It is slightly more cautious, and is likely to create longer paths in most problems. -}

minImprov :: Ord nme=>LSTree nme->[nme]
minImprov = firstImprov . nSort

-- | Maximal improvement, always takes the best neighbour, and stops when there are no more improvements

maxImprov :: Ord nme=>LSTree nme->[nme]
maxImprov = firstImprov . nReverse . nSort

-- | Random improvement, only accepts improvements, but is less predictable as to which it will take.

randomImprov :: (RandomGen g,Ord nme)=>g->LSTree nme->[nme]
randomImprov g = firstImprov . (nShuffle g)

{- | The simplest strategy. The randomisation may not be needed, it depends how 
   structured the tree is originally. Using the basicExchange function it will 
   be very ordered, so this is useful. -}

randomWalk :: RandomGen g=>g->LSTree nme->[nme]
randomWalk g = firstChoice . (nShuffle g)

{- | The simplest Tabu search, simply disallows backtracking, should do slightly better than a random walk, 
   but that is about it. -}

simpleTabu :: Eq nme=>Int->LSTree nme->[nme]
simpleTabu l = firstChoice . (tabu l [])

{- | This will always choose the lowest ordered element of the 
neighbourhood, unless it has been seen recently. 
The choice of the minFirstTabu or maxFirstTabu, depends upon the 
problem, and how it has been encoded, does the user wish for 
high ordered, or low ordered solutions. In most cases the 
other becomes pointless. -}

minFirstTabu :: Ord nme=>Int->LSTree nme->[nme]
minFirstTabu l = (simpleTabu l) . nSort

maxFirstTabu :: Ord nme=>Int->LSTree nme->[nme]
maxFirstTabu l = (simpleTabu l) . nReverse . nSort

{- | Injection of a random element into TABU, less useful than it 
sounds in this case, as this is very similar to simpleTabu.
In practice, real TABU systems use a process of choices. 
If improvement is possible (subject to the TABU list) you
accept the first (in whatever order, that is where randomness comes in)
improvement you find. Otherwise you take another element and continue.
This has not yet been represented. -}

stochasticTabu :: (Eq nme,RandomGen g)=>Int->g->LSTree nme->[nme]
stochasticTabu l g =(simpleTabu l) . (nShuffle g ) 

{- | A helper function for creating a falling temperature list. Used by 
Simulated Annealing. Really just to make it slightly easier to see 
what it is doing. -}

saTemp :: Num a=>a->a->[a]
saTemp p iTemp = iterate (*p) iTemp 

{- | There are two variants on simulated annealing represented here. The first is simpler,
it assumes that the temperature represents a threshold for a limited worsening filter.
This is applied, and the system is then navigated randomly. -}

simulatedAnnealingA :: (NumericallyPriced nme a,RandomGen g)=>a->a->g->LSTree nme->[nme]
simulatedAnnealingA p iTemp g = firstChoice . (varyingThresholdWorsening (saTemp p iTemp)) . (nShuffle g)

{- |
The second takes the approach that SA tends to be (based upon a level of randomisation) 
a random walk at high temperatures, and an iterative improver at low temperatures.
It generates a list of single level transformations based upon this idea, and then
applies them one at a time. -}

simulatedAnnealingB :: (Ord nme,RandomGen g,Num a,Random a,Ord a)=>a->a->g->LSTree nme->[nme]
simulatedAnnealingB p iTemp g = let (g' , g'' ) = split g
                                    xs = zip (saTemp p iTemp) (randoms g') 
                                    gFuncs = [if x < y then id else sImprovement | (x, y ) <- xs ]
                                in firstChoice . (multiLevelApply gFuncs) . (nShuffle g'')