{-| A collection of common strategies, built out of the combinators in the other libraries. 
    For examples of their use, see "Control.Search.Local.Example".
-}

module Control.Search.Local.Strategies(
  -- * Iterative Improvers
  iterativeImprover,firstFoundii,maximalii,minimalii,stochasticii,
  -- * TABU Search
  tabu,standardTabu,
  -- * Simulated Annealing
  sa,
  -- * Genetic Algorithms
  ga,gaConfig
)where

import Control.Search.Local
import Data.List

{-|
  The generic skeleton of iterative improvers. The first parameters is a neighbourhood stream expander, 
  the second is a stream contractor which makes choices from neighbourhoods. All neighbourhoods will be
  filtered so that the elements can only improve upon the previous solution. 

  Since the parameters are stream transformers, simple functions must be lifted before they can be used 
  as parameters. For example a deterministic neighbourhood function @df@ should be lifted with @map@ and 
  to choose the first element from each improving neighbourhood you would use @map head@, giving
 
 > iterativeImprover (map df) (map head). 

  This skeleton provides a standard infinite stream of solutions, rather than terminating 
  when a local minima is reached. This provides better safety for composition than the 
  versions suggested in the paper. When the filter results in an empty list, the seed 
  value is wrapped up as a list and returned in its place.
-}
iterativeImprover :: Ord s=>ExpandT s->ContraT s->StreamT s
iterativeImprover nf cf =  cf . mkSafe (improvement nf)
  where
    mkSafe f sols = zipWith (\a b->if null a then [b] else a) (f sols) sols 


{-| First found iterative improvement strategy. Fixes the choice function to @map head@. -}
firstFoundii :: Ord s=>ExpandT s->StreamT s
firstFoundii nf = iterativeImprover nf (map head )
{-| Maximal iterative improvement strategy. Since we seek the lowest possible value of solutions this 
    translates to fixing the choice function to @map minimum@. -}
maximalii :: Ord s=>ExpandT s->StreamT s
maximalii nf = iterativeImprover nf (map minimum )
{-| Minimal iterative improvement strategy. Fixes the choice function to @map maximum@.-}
minimalii :: Ord s=>ExpandT s->StreamT s
minimalii nf = iterativeImprover nf (map maximum )

{-| Stochastic iterative improvement strategy. The choice function is required to make a random choice from 
    the neighbourhood at each step. In order to keep this as general as possible we require a choice function, 
    and a stream of values, expected to be random numbers. The choice function takes one of these random values, 
    and a neighbourhood and returns a single value. 
    
    This choice function and stream of random values are then used to create a stochastic decision stream 
    contractor, and the strategy created.  
-}
stochasticii :: Ord s=>([s]->r->s)->[r]->ExpandT s->StreamT s
stochasticii rcf rs nf = iterativeImprover nf (zipWith (flip rcf) rs )


{-| A general skeleton for TABU search. The three parameters are 

    (1) a stream transformer to create the stream of TABU lists (typically provided by 'window')

    (2) a stream transformer to create the stream of neighbourhoods, in the same manner as seen in iterative improver

    (3) a choice transformer to choose a single element from a pruned neighbourhood.
-}
tabu :: Ord s=>  ExpandT s->ExpandT s->
                 ContraT s->StreamT s
tabu wf nf cf sols = cf $ tabuFilter (wf sols) nf sols

{-| Commonly TABU search does not take a function which makes a TABU list, but rather a size of 
    TABU list. We provide this less flexible form here, where the first parameter changes from 
    to being the window size. Implemented in terms of 'tabu'. -}
standardTabu :: Ord s=>  Int->ExpandT s->ContraT s->StreamT s
standardTabu winSize = tabu (window winSize) 

{-| Simulated Annealing skeleton. This requires a significant number of parameters due to the 
    various stochastic components, temperatures and the need for a numerical valuation of 
    solutions qualities. The parameters are;
   
    (1) a function to get the numerical value of a candidate solution
  
    (2) a function to provide a perturbation of a solution, with respect to some external factor, 
        such as a random number, which is what the data type /r/ is expected (though not required) to be.

    (3) a stream of values representing the temperature or cooling strategy
  
    (4) a stream of stochastic values

    (5) a stream of (stochastic) values for the creation of perturbations
-}
sa :: (Floating v,Ord v)=>(s->v)->StreamT s->[v]->[v]->StreamT s
sa getVal perturbF rs coolS sols = zipWith4 (saChoose getVal) rs coolS sols (perturbF sols)

{-| Genetic Algorithm skeleton.  In it's most general form this has three processes, which make up the parameters;

    (1) conversion of the stream of solutions into a stream of populations

    (2) recombination of elements of each population to give new solutions
   
    (3) mutation of elements of the stream to create variation

    It is expected that each of these processes will be created via the composition of a number of other functions.
-}
ga :: ExpandT s->ContraT s->StreamT s->StreamT s
ga mkPop recomb mutat = mutat . recomb . mkPop

{-| The standard genetic algorithm configuration. The parameters are;

    (1) the selection distribution

    (2) the population size

    (3) a stream of random values to parametrise the selection routine
 
    (4) a stream of boolean values to indicate where to apply mutation

    (5) the recombination stream transformer

    (6) the mutation stream transformer
-}
gaConfig :: Ord s=>[Float]->Int->[Float]->[Bool]->ContraT s->StreamT s->StreamT s
gaConfig dist popSize rs bs recombine mutate
  = ga (makePop popSize) (recombine . gaSelect 2 dist rs) (nest bs mutate)