{-| We capture the pattern of meta-heuristics and local search as a process or stream of 
    evolving solutions. These combinators provide a way to describe and manipulate these 
    processes quickly. The basic pattern of their use is this;

 > loopP (strategy) seed 

    The strategy itself is a stream transformer. The transformer becomes a search strategy 
    when it's output is fed back into it's input, which is the action of the loopP function.
    For example, the following is not a search strategy but you could write;

 > loopP (map (+1)) 0

    Which would generate the stream [0,1,2...
    A real search strategy then looks like;

  > loopP iterativeImprover tspSeed

    Many search strategies do not always produce improving sequences as the iterative improver does. For these
    we provide a simple modification of 'scanl' which can be applied to any stream, called 'bestSoFar'.
    Finally, these streams are usually descriptions of unlimited processes. To make them 
    practical we limit them using standard Haskell combinators such as 'take' and list index.

  > take 20 . bestSoFar $ loopP searchStrategy seed

    Search strategies are constructed via the composition of other functions. This often resembles the   
    composition of an arrow pipeline, and this library can be rewritten in terms of arrows, however we have 
    found no significant advantage in doing this. 
 
    A simple TABU like search strategy, that has a memory of the recent past (10 elements) of the search process, and 
    filters neighbourhoods accordingly can be created like this;
    
    > searchStrategy xs = map head $ zipWith (\ws->filter (flip notElem ws)) (window 10 xs) (neighbourhood xs)  

    A common way to improve meta-heuristics is to introduce stochastic elements, such as random decisions from a constrained
    set of choices, or neighbourhoods which will not generate exactly the same set of options each time a particular solution 
    is visited. Stream transformations allow this because they can thread additional state internally, while not exposing 
    the user of the transformation to a great deal of the process. For example in the above example, to create a random 
    choice from the constrained set at each point you would do this;

    > searchStrategy rs xs = select uniformCDF $ zipWith (\ws->filter (flip notElem ws)) (window 10 xs) (neighbourhood xs)
  
    The neighbourhood can be similarly modified. We must still provide the starting points for the extra data used by 
    such transformers, in this case a stream of random values, or in other cases a random number generator, but one provided
    it is hidden, and the transformer can be composed with any other transformation.

    Using the same transformation, which threads an internal state, in several places is harder. It involves 
    merging and dividing streams in sequenced patterns. For example;

    > applyToBoth tr as bs = (\xs->(map head xs,map last xs)) . chunk 2 $ tr (concat $ transpose [as,bs])
  -}

module Control.Search.Local(
  -- * Types
  StreamT,Stream,List,
  -- * Optimisable Type Class
  Optimisable,(=:=),(>:),(<:),best,worst,bestOf,sortO,bestSoFar,
  -- * Stream Transformation Combinators
  doMany,chunk,variableChunk,stretch,variableStretch,window,variableDoMany,varyWindow,improvement,
  select,select',until_,restart,restartExtract,nest,preNest,divide,join,
  -- * Loop Combinators
  loopP,loopS,
  -- * Helper functions
  safe,
  ) where

import Data.List
import System.Random
import System.IO.Unsafe

{-| In previous versions I have used the standard 'Eq' and 'Ord' classes. However I have then 
    had to assume that every problem is a minimisation. To get around this, and provide functions that 
    match more closely to optimisation problems, where the concept we seek is /better than/, rather than 
    /greater/ or /less/ than, I provide this new class. It is however very very like 'Ord'.

    It is proposed that this class is used for value of solution comparisons only, and the standard 'Eq' class
    is retained for situations where the solutions are identical, and do not just share the same value.-}
class Optimisable a where
  {-| Equal to, by solution quality.-}
  (=:=) :: a -> a -> Bool  
  {-| Better than, assumed to be by solution quality. -}
  (>:) :: a -> a -> Bool   
  {-| Worse than, assumed to be by solution quality. -}
  (<:) :: a -> a -> Bool   

{-| This returns the best solution in an input list. It can be thought of as similar to 'maximum'.-}
best :: Optimisable s => [s] -> s
best (x : xs) = foldl (\ a b -> if a >: b then a else b) x xs

{-| This returns the worse solution in an input list. It can be thought of as similar to 'minimum'.-}
worst :: Optimisable s => [s] -> s
worst (x : xs) = foldl (\ a b -> if a <: b then a else b) x xs

{-| This returns the best of two input solutions. It can be thought of as similar to 'max'.-}
bestOf :: Optimisable s => s -> s -> s
bestOf a b = if a >: b then a else b

{-| An alternative version of 'sort' (implemented in terms of 'sortBy'), 
    but using 'Optimisable', so that better solutions are earlier in the output list than worse ones.
-}
sortO :: Optimisable a => [a] -> [a]
sortO = sortBy (\ a b -> if a >: b then LT else GT)

{-| A transformer that is usually used as a final step in a process, to allow the user 
    to only see the best possible solution at each point, and ignore the intermediate values
    that a strategy may produce. 
-}
bestSoFar :: Optimisable s=>StreamT s s
bestSoFar (x:xs) = scanl bestOf x xs

{-| The basic stream transformation type. -}
type StreamT a b = Stream a->Stream b

{-| Internally streams are represented as standard Haskell lists. This type synonym is provided for readability. It is assumed that streams will be infinite.-}
type Stream s = [s]

{-| Lists are also used to represent finite collections or groups of solutions. This synonym is for where
    the list is being used as a finite list. -}
type List s = [s]

{-| The standard function for /tying the knot/ on a stream described process. 
    This links the outputs of the stream process to the inputs, with an initial set of values, and
    provides a single stream of values to the user. -}
loopS :: StreamT s s->StreamT s s
loopS streamT seed = let sols = seed ++ streamT sols in sols

{-| A more specific version of 'loopS' and implemented in terms of it. Rather than allowing a 
    number of initial values, this allows only 1.-}
loopP :: StreamT s s->s->Stream s
loopP f x = loopS f [x] 

{-| This was original created to assist with making multiple selections from a population within a genetic 
    algorithm. More generally this is a higher order function which will take a stream transformation and apply
    it multiple times to each element of the input stream gathering up the results. 

    It can be used to make multiple selections from a population in a GA, or to create a neighbourhood 
    function from a perturbation operation. For example;

    > nF = doMany 5 perturbFunction

    Where /5/ is just an arbitrary example constant and /perturbFunction/ is a placeholder.
     
    If the perturb function is defined with a parameter controlling the perturbation, for example a random number,  
    such as which pair of cities in a TSP to exchange then you can do this for a deterministic operation;

    > nF = doMany 5 (zipWith perturbationFunction (cycle [0..4]))

    For a more stochastic effect;
  
    > nF = doMany 5 (zipWith perturbationFunction (randoms g)) 

    Where /g/ is assumed to be of the 'System.Random.RandomGen' class.

 -}
doMany :: Int->StreamT s s'->StreamT s (List s')
doMany sz f = chunk sz . f . stretch sz

{-| /variableDoMany/ perfoms the same action as 'doMany', but allows the programmer to vary how many times 
    the transformation is applied to each underlying solution, through the use of a stream of sizes.-}
variableDoMany :: Stream Int->StreamT s s'->StreamT s (List s')
variableDoMany szs f = variableChunk szs . f . variableStretch szs

{-| Creates a rolling window over a stream of values up to the size parameter. The windows are then 
    produced as a stream of lists. This can also be done using a queue data structure, however this 
    was found to be slightly faster.-}
window :: Int->StreamT s (List s)
window sz xs = concat [zipWith take [0..sz] (repeat xs) ,map (take sz) . tails .drop (sz-1) $ xs]

{-| A function for transforming a stream of 'window's, taking random numbers of elements from the front 
    of each window. This can be used in the implementation of variations of the TABU search algorithm. 
    Usage as follows (with example values) ;

    > varyWindow (3,6) . window 10
-}
varyWindow :: (Int, Int) -> Stream (List s) -> Stream (List s)
varyWindow range = unsafePerformIO k
  where k = do g <- newStdGen
               return $ zipWith take (randomRs range g)

{-| Breaks down a stream into a series of chunks, frequently finds use in preparing sets of random numbers 
    for various functions, but also in the 'makePop' function that is important for genetic algorithms. -}
chunk :: Int->StreamT s (List s)
chunk i xs = let t = (take' i xs) in t `seq` (t : chunk i (drop i xs))
  where
    take' :: Int->[a]->[a]
    take' n _ | n<=0 = []
    take' n [] = []
    take' n (x:xs) = x `seq` (x : take' (n-1) xs)

--chunk i xs = (take' i xs) : chunk i (drop i xs)
-- chunk i xs = let (as,bs) = splitAt i xs in as : chunk i bs 
-- chunk i = unfoldr (Just . splitAt i) 

{-| A more flexible version of chunk which can vary the size of each chunk, in accordance with a list providing the 
    sizes required of each grouping. For example;

    > chunk i = variableChunk (repeat i)
    > variableChunk (cycle [1,2]) [0..] = [[0],[1,2],[3],[4,5]... 
-}
variableChunk :: Stream Int->StreamT s (List s)
variableChunk (i:is) xs = let t = take i xs in t : variableChunk is (drop i xs) 

{-| An operation which changes the structure of an underlying stream, but not the data type, by 
    replicating the elements of the stream in place. Can be thought of as changing the /speed/ of the stream. 
    This finds use in 'doMany', genetic algorithms and ant colony optimisation.
    For example;

    > stretch 2 "abcd" = "aabbccdd"

-}
stretch :: Int->StreamT s s
stretch sz = concatMap (replicate sz)

{-| A more flexible version of stretch which can vary how far each value in the underlying stream is stretched, 
    in accordance with a list providing the sizes required of each grouping. For example;

    > stretch i = variableStretch (repeat i)
    > variableStretch [3,3,7,2] "abcd" = "aaabbbcccccccdd" 
-}
variableStretch :: Stream Int->StreamT s s
variableStretch sz = concat . (zipWith replicate sz)

{-| This function transforms a neighbourhood function to give a transformation that yields /improving/ 
    neighbourhoods, that is, neighbourhoods that only contain solutions that improve upon the seed solution.
    In the case that there are no improving solutions (local minima), the output is a singleton list 
    containing the seed solution. This functionality is provided byt the 'safe' helper function.-}
improvement :: Optimisable s => StreamT s (List s) -> StreamT s (List s)
improvement nf sols = safe (map (:[]) sols)
                    $ zipWith (\a b -> filter (a >:) b) sols (nf sols)

{-| The generalised selection routine. This takes a stream of lists and selects one element from each list, 
    to construct the new stream. The selection routine takes a 'DistributionMaker', and selects based upon this.
    This only really makes sense when there is some internal structure in the stream of lists. For example;

    > select (poissonCDF 1) . map sortO   

    Each list in the input stream is sorted, so that the best solutions appear first. This is then selected from
    using a Poisson distribution, with the mean at 1. This means that the early (better) solutions are much more 
    likely to be selected.
-}
select :: (Random r, Ord r) => (Int -> List r) -> StreamT (List a) a
select mkDist = unsafePerformIO k 
  where k = do g <- newStdGen
               return $ select' (randoms g)
        select' rs xs = let dxs = map (\x -> zip (mkDist $ length x) x) xs
                       in zipWith s dxs rs
        s [x] _ = snd x
        s ((p, x) : xs) r = if r > p then s xs r else x

{-| This function acts like 'select', however the distribution is fixed, not being constructed anew for each 
    list in the input stream. This is much more efficient, but does assume that the size of each list in the 
    input is the same (a fixed size neighbourhood is perfect for this).
-}
select' :: (Random r,Ord r) => List r->StreamT (List a) a
select' dist = unsafePerformIO k 
  where k = do g <- newStdGen
               return $ select' (randoms g)
        select' rs xs = let dxs = map (\x -> zip dist x) xs
                       in zipWith s dxs rs
        s [x] _ = snd x
        s ((p, x) : xs) r = if r > p then s xs r else x

{-| This function is very similar to the /until/ function of FRP. It takes a stream and 
    returns the elements of that stream until 'True' appears on the trigger stream. At this point 
    one of the potential futures is chosen and becomes the remainder of the stream. 
    The potential futures are zipped with the triggers, so the choice is fixed, the /current/ potential 
    future is the choice. More generally this concept could be elaborated in the future.

    (1) The initial stream of values to place before the trigger
    (2) The stream of triggers
    (3) The stream of potential future streams

    Could be used to provide a temperature strategy that restarts once in Simulated Annealing like so;

    > let t = iterate (+1) 0 
    > in until_ t triggerStream (repeat t) 

    This alternative will restart every time 'True' appears on the trigger stream, not just the first time.

    > let t = until_ (iterate (+1) 0) triggerStream (repeat t) in t
-}
until_ :: Stream a -- stream of values, to place before trigger
       -> Stream Bool -- stream of triggers for switch over
       -> Stream (Stream a) -- stream of potential futures
       -> Stream a
until_ (a:_) (True:_) (_:(cs:_)) = a : cs
until_ (a : as) (False : bs) (_: cs) = a : until_ as bs cs

{-| A helper function that chooses between elements of the two input streams at each point in the 
    stream, and returns one which is non-empty. The check looks at values in the second stream first, 
    if this list is not empty, it is returned.
-}
safe :: Stream (List v) -> Stream (List v) -> Stream (List v)
safe = zipWith (\a b -> if null b then a else b)

{-| Restart is a little like loop. It will construct a stream of values by applying a stream transformation 
    to one value, and then the successor and so on. It differs in that it also takes a triggering mechanism
    that can choose to stop the current sequence and continue from a different value (the next value on the 
    initial stream). For example, the following will start counting initially from 0, then -5, then -10, and 
    will count until it reaches 11 each time. 

    > restart (map (+1)) (map (>10)) [0,-5,-10]
  -}
restart :: StreamT a a->StreamT a Bool->StreamT a a
restart f r (a : as) = let ms = loopP (nest [(False, id), (True, const as)] (r ms) . f ) a
                       in ms
{-| Exactly like 'restart', except that it will only return the result of an iteration of transformation,
    not the intermediate values. For example;

    > restartExtract (map (+1)) (map ((==0) . flip mod 4)) [1,-5,-10,-13]

    gives;

    > [4,-4,-8..

     -}
restartExtract :: StreamT a a->StreamT a Bool->StreamT a a
restartExtract f r (a : as) = let ms = loopP (nest [(False, id), (True, const as)] rs . f ) a
                                  rs = r ms
                              in [l | (p, l) <- zip (drop 2 $ window 2 rs) ms, p == [True, False]]

{-| Is the combination of 'divide' and 'join'. It takes a set of indices and stream transformations, 
    divides the input stream, using the indices and a stream of indices, transforms each substream 
    by the related stream transformation, and then puts them all back together again as a new stream.

    For example, to apply a transformation (f) to only every third value in a stream, you could do this;

    > nest [(True,id),(False,f)] (cycle [True,True,False])
-}
nest :: Eq n => List (n, Stream a -> Stream b) -> Stream n 
             -> Stream a -> Stream b
nest fs ns = flip join ns . zipWith (\(n, f ) s -> (n, f s)) fs 
           . divide (map fst fs) ns

{-| This function acts like 'nest', but the name stream makes choices (or can do) based upon the initial value
    of solutions on the input stream.-}
preNest :: Eq n => (Stream a -> Stream n) -> List (n, Stream a -> Stream b) 
                -> Stream a -> Stream b
preNest d fs xs = nest fs (d xs) xs

{-| Join is the inverse of 'divide', it combined substreams into a stream fo values. 
    It takes a list of substreams, and the indices that indicate them, and then a stream of the indices.
    For each value in the stream of indices, the /next/ value in the appropriate substream is chosen and  
    produced. 
-}
join :: Eq n => List (n, Stream v) -> Stream n -> Stream v
join streams ns = unfoldr f (ns, streams)
  where
    f (k : ks, vs) = let (as, (n, p : ps) : bs) = break ((== k) . fst) vs
                     in Just (p, (ks, as ++ (n, ps) : bs))

{-| Divide splits a stream of values into a list of substreams. The division is controlled by 
    a list of /indices/ and then a stream of these indices. -}
divide :: Eq n => List n -> Stream n -> Stream v -> List (Stream v)
divide indices ns xs = [substream (map (== n) ns) xs | n <- indices]
  where substream bs = map snd . filter fst . zip bs