diff --git a/Control/Search/Local.hs b/Control/Search/Local.hs --- a/Control/Search/Local.hs +++ b/Control/Search/Local.hs @@ -1,146 +1,315 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Search.Local --- Copyright : (c) Richard Senington & David Duke 2010 --- License : GPL-style --- --- Maintainer : Richard Senington --- 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. ------------------------------------------------------------------------------ +{-| 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; -module Control.Search.Local ( - -- Strategies - firstImprov, - minImprov, - maxImprov, - randomImprov, - randomWalk, - simpleTabu, - minFirstTabu, - maxFirstTabu, - stochasticTabu, - saTemp, - simulatedAnnealingA, - simulatedAnnealingB, + > 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 'saveBest'. + 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 . saveBest $ 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 $ adaptive filter adaptive filter (flip notElem) (window 10 xs) (neighbourhoods 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 = zipWith randomChoice rs $ adaptive filter adaptive filter (flip notElem) (window 10 xs) (neighbourhoods xs) - -- Navigators - firstChoice, - manualNavigator, - -- Transformations - improvement, - nShuffle, - nSort, - nReverse, - tabu, - thresholdWorsening, - varyingThresholdWorsening, - multiLevelApply, - sImprovement, + 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. - -- The internal tree, and accessor functions - LSTree(LSTree,treeNodeName,treeNodeChildren), - mkTree, + 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; - -- Neighbourhoods and problem specific stuff - exchange, - basicExchange, - NumericallyPriced(priceSolution) -)where + > applyToBoth tr as bs = (\xs->(map head xs,map last xs)) . chunk 2 $ tr (concat $ transpose [as,bs]) + + + -} -import Control.Search.Local.Tree -import Control.Search.Local.Transformation -import Control.Search.Local.Navigator -import Control.Search.Local.Neighbourhood -import System.Random +module Control.Search.Local( + -- * Types + StreamT,ExpandT,ContraT, + -- * Generic Combinators + lift,bestSoFar,chunk,window,until_,divide,join,nest,nestWithProb,makePop, + -- * Loop Combinators + loopP,loopS, + -- * Filters & Choices + improvement,varyWindow,tabuFilter,saChoose, + gaSelect,manySelect,select,streamSelect, + -- * Distributions + logCooling,geoCooling,linCooling, + -- * Complex GA distributions, experimental + limitedDistribution,geometricDistribution,uniformDistribution, + distributionSelectWithRemainder + ) where --- | First improvement, relies upon the solutions forming an ordering. +import Data.List +import Control.Search.Local.Queue -firstImprov :: Ord nme=>LSTree nme->[nme] -firstImprov = firstChoice . improvement +{-| The basic stream transformation type. This converts elements of one type into (expected) different elements of the + same type. -} +type StreamT s = [s]->[s] +{-| Many processes in meta-heuristics will create sets of options (e.g. neighbourhood functions) or collect + sets of information about streams (e.g. 'window'). This is the data type for these functions. -} +type ExpandT s = [s]->[[s]] +{-| Choices and selections from larger sets of elements are modelled as these /contractions/, for example + the selection of an element from a neighbourhood, or rather a stream of neighbourhoods. -} +type ContraT s = [[s]]->[s] -{- | 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. -} +{-| 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->StreamT s +loopS streamT seed = let sols = seed ++ streamT sols in sols -minImprov :: Ord nme=>LSTree nme->[nme] -minImprov = firstImprov . nSort +{-| 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] +loopP f x = loopS f [x] --- | Maximal improvement, always takes the best neighbour, and stops when there are no more improvements +{-| /lift/ is a lifting function, originally designed to lift filters and partitions to operate over + interrelated streams of data. An example of use is; -maxImprov :: Ord nme=>LSTree nme->[nme] -maxImprov = firstImprov . nReverse . nSort + > lift filter (<) as bs +-} +lift :: (t -> b -> c) -> (a -> t) -> [a] -> [b] -> [c] +lift f g = zipWith (f.g) --- | 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) +{-| 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 my produce. +-} +bestSoFar :: Ord s=>StreamT s +bestSoFar ~(x:xs) = scanl min x xs -{- | 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. -} +{-| Creates a rolling window over a stream of values up to the size parameter. The windows are then + produced as a stream of lists. -} +window :: Int->ExpandT s +window sz = (map toList) . (scanl fappend initQ) + where + fappend q v | sizeQ q == sz = append (remove q) v + | otherwise = append q v -randomWalk :: RandomGen g=>g->LSTree nme->[nme] -randomWalk g = firstChoice . (nShuffle 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->ExpandT 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) -{- | The simplest Tabu search, simply disallows backtracking, should do slightly better than a random walk, - but that is about it. -} +--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) -simpleTabu :: Eq nme=>Int->LSTree nme->[nme] -simpleTabu l = firstChoice . (tabu l []) +{-| Takes an input stream, breaks it down into 'chunk's, then sorts these chunks and stretches them to + give a stream of populations for processing in a genetic algorithm. -} +makePop :: Ord s => Int -> ExpandT s +makePop sz = concatMap (replicate sz . sort) . chunk sz -{- | 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. -} +{-| A way to link one stream with another at a joining point. The first stream is given as a list only, + the second stream is given as a function which converts from a passed value into a list. + The trigger is provided by a list of booleans paired with the passed values for creating the second list. -minFirstTabu :: Ord nme=>Int->LSTree nme->[nme] -minFirstTabu l = (simpleTabu l) . nSort + This allows for the creation of cyclical restarting cooling strategies in simulated annealing using a code + snippet like this; -maxFirstTabu :: Ord nme=>Int->LSTree nme->[nme] -maxFirstTabu l = (simpleTabu l) . nReverse . nSort + > let triggers = map (==0) . zipWith (-) (tail sols) $ sols + > restart basicS cs = until_ basicS cs $ map (restart basicS) (tails cs) + > coolStrat = restart (geoCooling 80000 (*0.5)) triggers + > in .... +-} +until_ :: [a]->[Bool]->[[a]]->[a] +until_ (a:_) (True:_) (_:cs:_) = a : cs +until_ (a:as) (False:bs) (_:cs) = a : until_ as bs cs -{- | 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. -} +{-| Splits a stream into two parts. The output of the contraction is not well named here, + it is in fact a collection of streams. The first stream being the part of the original stream + that matched to /False/ in the boolean stream, the second matching to /True/. -stochasticTabu :: (Eq nme,RandomGen g)=>Int->g->LSTree nme->[nme] -stochasticTabu l g =(simpleTabu l) . (nShuffle g ) + Any method can be used to create the boolean stream, e.g. + + > cycle [True,False] + > map (<0.75) (randoms g) +-} +divide :: [Bool]->ExpandT s +divide bs xs = [[ x | (b,x)<-zip bs xs,b==i] | i <-[False,True]] -{- | 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. -} +{-| Integrates a collection of streams. The boolean stream indicates the order of integration. + A /True/ in the boolean stream will cause an element to be taken from the second stream, + a /False/ will cause it to take from the first.-} +join :: [Bool]->ContraT s +join bs xss = unfoldr f (bs,xss) + where + f (False:ts,[x:xs,ys]) = Just (x,(ts,[xs,ys])) + f (True:ts,[xs,y:ys]) = Just (y,(ts,[xs,ys])) -saTemp :: Num a=>a->a->[a] -saTemp p iTemp = iterate (*p) iTemp +{-| A nesting procedure. This can nest one transformer into another. The boolean stream + provides the pattern for where the parametrising transformer should be run, with 'True' being the + indicator. It is constructed using divide and join. -{- | 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. -} + A simple example of this in operation is the following; We will have a stream of integers, + incrementing by one each time. Every so often, we will increment by an additional 2. -simulatedAnnealingA :: (NumericallyPriced nme a,RandomGen g)=>a->a->g->LSTree nme->[nme] -simulatedAnnealingA p iTemp g = firstChoice . (varyingThresholdWorsening (saTemp p iTemp)) . (nShuffle g) + > take 20 $ loopP (nest (concat $ repeat [False,False,True,False]) (map (+2)) . map (+1)) 0 -{- | -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. -} + This is primarily used in the genetic algorithm system for creating mutation transformers. -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'') + There is also a current problem with the nesting function. If the -O2 flag is not used during compilation + it causes a memory leak, for reasons currently unknown. + -} +nest :: [Bool]->StreamT s->StreamT s +nest bs tr = join bs . zipWith ($) [id,tr] . divide bs +{-| A specialisation of the nesting routine, which takes a stream of random values, and a + proportion/probability. This is used to construct the stream of booleans with that + proportion set to True. -} +nestWithProb :: (Ord r,Floating r)=>[r]->r->StreamT s->StreamT s +nestWithProb rs p = nest (map (ExpandT s->ExpandT s +improvement nf sols = lift filter (>) sols (nf sols) +{-| A specialist function that is used as part of a TABU variant called /robust taboo/. It is expected that + the integer stream provided is an appropriately ranged random stream, so that it can limit the TABU list at each + step by a random value. The version in the paper takes a range and random number generator. To avoid the + import of System.Random, this takes the stream of values to vary the window by. To implement the former; + + > varyWindow (randomRs range g) +-} +varyWindow :: [Int]->StreamT [s] +varyWindow rs = zipWith take rs + +{-| A filter, similar in some ways to an improvement filter, but more complex, carrying out the common TABU rules. + The first parameter is the stream of TABU lists, the second parameter the stream of source solutions. It operates + over streams of neighbourhoods. -} +tabuFilter :: Ord s=>[[s]]->ExpandT s->ExpandT s +tabuFilter tabu nf sols + = let (imp,notImp) = unzip $ lift partition (>) sols (nf sols) + notTabu = lift filter (flip notElem) tabu notImp + select [] [] c = c + select [] b _ = b + select a _ _ = a + in zipWith3 select imp notTabu notImp + +{-| The traditional choice function used within simulated annealing. The parameters are; + a function to yield quality of a solution, a value between 0 and 1 (stochastic expected) a temperature, + the old solution and the possible future solution. -} +saChoose :: (Floating v,Ord v)=>(s->v)->v->v->s->s->s +saChoose valueF r t oldSol newSol + | d<=0 || e>r = newSol + | otherwise = oldSol + where + e = exp (- (d/t)) + d = (valueF newSol) - (valueF oldSol) + +{-| A logarithmic cooling strategy intended for use within simulated annealing. Broadly the first value is + the starting temperature and the second a value between 0 and 1. -} +logCooling :: Floating b=>b->b->[b] +logCooling c d = map (\t->c / (log (t + d))) (iterate (+1) 1) + +{-| The most common cooling strategy for simulated annealing, geometric. The first value is the starting temperature, + the second a value between 0 and 1, the cooling rate. -} +geoCooling :: Floating b=>b->b->[b] +geoCooling startTemp tempChange = iterate (* tempChange) startTemp + +{-| Included for completeness, this is a cooling strategy for simulated annealing that is usually not very effective, + a linear changing strategy. The first value is the starting temperature the second is the value to increase it by + at each step. In order to have it reduce at each step, pass a negative value. +-} +linCooling :: Floating b=>b->b->[b] +linCooling startTemp tempChange= iterate (+ tempChange) startTemp + +-- ga selection functions + +{-| The basic selection function, not in stream form. This takes a distribution, + a random number, a collection of elements to select from and gives back + a single value, selected from the collection. -} +select :: Ord r=>[r]->r->[s]->s +select dist r = snd . head . dropWhile ((r>) . fst) . zip dist + +{-| The lifting of select to operate over streams of values, rather than making a single selection. + Provides a stream contraction operation. The first parameter is the distribution, the second a + stream of random values.-} +streamSelect :: Ord r=>[r]->[r]->ContraT s +streamSelect dist = zipWith (select dist) + +{-| This was original created to assist with making multiple selections from a population within a genetic + algorithm. More generally this is a function which operates over streams of collections (lists). + It takes a contraction operation and a size. It will apply the contraction a number of times to + each collection, gather the results and release a new collection. + + If the contraction stream operation has internal state, such as a stochastic factor, this will be + used correctly, each collection will not have the same elements selected, nor will the same element be + selected repeatedly from each collection. -} +manySelect :: Int->(ContraT s)->StreamT [s] +manySelect sz f = chunk sz . f . concatMap (replicate sz) + +{-| This can be considered the standard genetic algorithm selection process, though it is still + quite parametrisable. It takes a size, the number of elements for each recombination, + a distribution for the selection process to use and a stream of random numbers to control the + selections. + + The most basic version would select 2 parents using a geometric selection curve, like this; + + > gaSelect 2 (iterate (*1.005) 0.005) rs + + However there is no prescription on the distribution, or number of parents, e.g. + + > gaSelect 3 (uniform 0.1) rs + + Though I do not provide a /uniform/ function at the present time, I intended this example + to suggest three parents selected using a uniform distribution. + -} +gaSelect :: Ord r=>Int->[r]->[r]->StreamT [s] +gaSelect sz dist rs = manySelect sz (streamSelect dist rs) + + + +distributionSelectWithRemainder :: Ord r=>[r]->r->[s]->(s,[s]) +distributionSelectWithRemainder dist r xs + = let (as,bs) = span ((r>) . fst) $ zip dist xs + as' = map snd as + bs' = map snd bs + in if null bs then (last as',init as') else (head bs',as'++(tail bs')) + +uniformDistribution :: (Fractional n,Num n)=>n->[n] +uniformDistribution x = scanl (+) x (repeat x) + +geometricDistribution :: Num n=>n->n->[n] +geometricDistribution fact start = map (1-) $ iterate (*fact) start + +limitedDistribution :: Fractional n=>Int->[n]->[n] +limitedDistribution numElements xs = let xs' = take numElements xs + i = last xs' + in map (/i) xs' diff --git a/Control/Search/Local.hs~ b/Control/Search/Local.hs~ new file mode 100644 --- /dev/null +++ b/Control/Search/Local.hs~ @@ -0,0 +1,148 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Control.Search.Local +-- Copyright : (c) Richard Senington & David Duke 2010 +-- License : GPL-style +-- +-- Maintainer : Richard Senington +-- 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, + sSort, + sReverse + + -- The internal tree, and accessor functions + LSTree(LSTree,treeNodeName,treeNodeChildren), + mkTree, + + -- Neighbourhoods and problem specific stuff + exchange, + basicExchange, + NumericallyPriced(priceSolution) +)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'') + + + + diff --git a/Control/Search/Local.lhs~ b/Control/Search/Local.lhs~ new file mode 100644 --- /dev/null +++ b/Control/Search/Local.lhs~ @@ -0,0 +1,104 @@ +> module Control.Search.Local ( +> firstImprov,minImprov,maxImprov,randomImprov,randomWalk,simpleTabu,minFirstTabu,maxFirstTabu,stochasticTabu,saTemp,simulatedAnnealingA,simulatedAnnealingB, +> firstChoice,manualNavigator, +> improvement,nShuffle,nSort,nReverse,tabu,thresholdWorsening,varyingThresholdWorsening,multiLevelApply,sImprovement, +> LSTree(LSTree),treeNodeName,treeNodeChildren,mkTree, +> 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 + +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. + +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'') + + + + diff --git a/Control/Search/Local/Eager.hs b/Control/Search/Local/Eager.hs new file mode 100644 --- /dev/null +++ b/Control/Search/Local/Eager.hs @@ -0,0 +1,41 @@ +{-| + These combinators are for controlling local search processes at the top level and preventing stack and memory build ups. + The basic combinators seen in the other libraries are all lazy and will describe the structure of the computations + that will make up the search. When it comes to accessing values and solutions from these processes you can print + each solution which will push the process forwards and avoid memory problems. + + To avoid wasting processing time displaying many solutions in a process, when all you are interested in is the Nth one, + you might use the common list index function (!!). However this is a lazy operator and will cause Haskell to + construct the computation for the Nth value, in terms of the previous values, before beginning the evaluation. + This causes the memory problems. + + Instead we provide an eager replacement for (!!) which we call (!!!). For more sophisticated applications we + provide two other semi-eager operations which return both an eager value and a lazy remainder. +-} + +module Control.Search.Local.Eager((!!!),indexWithRemainder,splitAt') where + +import Data.List + +{-| This is an eager list index. It acts exactly like the common (!!) operation, however it + evaluates each element to WHNF. In the case where each element of the list depends upon previous + elements in some way (usually true of the local search systems), this will result in the + computation being pushed forwards. -} +(!!!) :: [a]->Int->a +(!!!) ~(x:_) 0 = x +(!!!) ~(x:xs) n = x `seq` (xs !!! (n-1)) + +{-| Similar to the eager list index, however it also gives back the remainder of the computation as an + unevaluated list. It is expected that this will be used to sample a stream for a human user, + allowing the user to see what has happened and make a decision to continue, or stop. If continue, then + the lazy remainder can be processed further. -} +indexWithRemainder :: [a]->Int->(a,[a]) +indexWithRemainder ~(x:xs) 0 = (x,xs) +indexWithRemainder ~(x:xs) n = x `seq` (indexWithRemainder xs (n-1)) + +{-| Eager /splitAt/. Looks like /splitAt/, but the elements of the first list are evaluated to WHNF. -} +splitAt' :: Int->[a]->([a],[a]) +splitAt' i xs = g ((iterate f ([],xs)) !!! i) + where + f (as,b:bs) = (b:as,bs) + g (as,bs) = (reverse as,bs) diff --git a/Control/Search/Local/Example.hs b/Control/Search/Local/Example.hs --- a/Control/Search/Local/Example.hs +++ b/Control/Search/Local/Example.hs @@ -1,148 +1,231 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Search.Local.Example --- Copyright : (c) Richard Senington & David Duke 2010 --- License : GPL-style --- --- Maintainer : Richard Senington --- Stability : provisional --- Portability : portable --- --- An example of the system running, on some randomly generated TSP (Traveling Sales Person) problems. --- The focus of the code is on generation of TSPs and representation of them. ------------------------------------------------------------------------------ +{-| + This library has embedded within it two example TSP files drawn from the TSPLIB; burma14 and fl417. + This module provides a loading routine for these two files only. General loading routines for + the TSPLIB format are provided by the Combinatorial Problems library. -module Control.Search.Local.Example ( - main,TSPTour -) where + This module also provides a collection of simple TSP perturbation and recombination methods for use in the following + examples. Much of the code for these examples, in terms of the TSP implementation, recombination and perturbation + methods is not particularly efficient and only intended for example purposes. -import Control.Search.Local -import System.Random -import qualified Data.Map as M + To run these examples first use the following imports; + + > import Control.Search.Local + > import Control.Search.Local.Example + > import Control.Search.Local.Strategy + > import Control.Search.Local.Eager --- | The data types defined are TSPMaps, the problems, and TSPTours, the solutions. + * A simple maximal iterative improver. This will print out all the solutions encountered. -data TSPMap = TSPMap { tspNumCities :: Int, - tspLinkPricer :: Int->Int->Float} + > loadExampleFile BURMA14 >>= return . loopP (maximalii (map adjacentExchangeN)) -data TSPTour = TSPTour { tspPath :: [Int], - tspCost :: Float} + * A stochastic choice from the improvement neighbourhood -{- | Slightly out of date with the TSPTour data type, but this is the function -that combines a sequence with a map, and gives a price. It is very slow, -as it loops over an entire solution list every time it is called. -} + > iiExample + > = do prob<-loadExampleFile FL417 + > strat<-newStdGen >>= return . stochasticii rChoice . randoms + > return . loopP (strat (map adjacentExchangeN)) $ prob + > where + > rChoice xs p = xs !! (floor ((p::Float) * fromIntegral (length xs))) -priceTour :: TSPMap->[Int]->Float -priceTour (TSPMap _ f) xs = let priceTour' (_:[]) = 0 - priceTour' (s:(ks@(k:_))) = f s k + (priceTour' ks) - in priceTour' xs + * The standard TABU search, with a TABU list size of 5 --- | makeTour is a helper function for taking a sequence of ints and returning a TSPTour data type, capturing the path and the price. + > loadExampleFile BURMA14 >>= return . bestSoFar . loopP (standardTabu 5 (map adjacentExchangeN) (map head)) -makeTour :: TSPMap->[Int]->TSPTour -makeTour m p = TSPTour p (priceTour m p) + * A more complex TABU search, with a varying neighbourhood and varying TABU list size + + > tabuExample + > = do prob<-loadExampleFile FL417 + > nF <- newStdGen >>= return . stochasticNeighbourhood 417 + > vWin <- newStdGen >>= return . varyWindow . randomRs (5,10) + > return . bestSoFar . loopP (tabu (vWin . window 15) nF (map head)) $ prob -{- | The TSPTour is then made member of a number of classes that are needed for interaction with the library, - Eq, Ord, Show (for display to the user) and NumericallyPriced. -} + * A simulated annealing search, using an adjacent exchange perturbation and a common geometric cooling strategy. + The values of the cooling strategy have been selected through rather rough and ready quick testing. -instance Eq TSPTour where - (==) a b = (tspPath a) == (tspPath b) + > saExample + > = do prob<-loadExampleFile FL417 + > (fIs,sIs) <- newStdGen >>= return . (\a->(map head a,map last a)) . chunk 2 . randomRs (0,numCities prob-1) + > let perturb = zipWith3 swapPositions fIs sIs + > choiceRs <-newStdGen >>= return . randoms + > return . bestSoFar . loopP (sa getTSPVal perturb + > (geoCooling 80000 (0.99 :: Float)) + > choiceRs) $ prob -instance Ord TSPTour where - compare a b = compare (tspCost a) (tspCost b) + * A genetic algorithm which only makes use of recombination. -instance NumericallyPriced TSPTour Float where - priceSolution t = tspCost t + > gaNoMutate + > = do prob<-loadExampleFile FL417 + > recomb<-newStdGen >>= return . stochasticRecombine + > startSols <- newStdGen >>= return . randomStarts 20 prob + > let dist = (++[1]) . takeWhile (<1) $ iterate (*1.0884) (0.2::Float) + > rs <- newStdGen >>= return . randoms + > return . bestSoFar . loopS (ga (makePop 20) + > (recomb . gaSelect 2 dist rs) + > id) $ startSols -instance Show TSPTour where - show (TSPTour p c) = "Tour : "++ (show p) ++" with cost "++(show c) + * A complete genetic algorithm that mutates in a random pattern (at a rate of 1/20th) -{- | This is a wrapper, to allow a user of this example to create a specialised TSP neighbourhood, complete with pricing - from a basic neighbourhood function from the Neighbourhood file. -} + > gaWithMutate + > = do prob<-loadExampleFile FL417 + > recomb<-newStdGen >>= return . stochasticRecombine + > startSols <- newStdGen >>= return . randomStarts 20 prob + > pattern <- newStdGen >>= return . map (<(0.05::Float)) . randoms -- boolean pattern + > (fIs,sIs) <- newStdGen >>= return . (\a->(map head a,map last a)) . chunk 2 . randomRs (0,numCities prob-1) + > let dist = (++[1]) . takeWhile (<1) $ iterate (*1.0884) (0.2::Float) + > let mut = nest pattern (zipWith3 swapPositions fIs sIs) + > rs <- newStdGen >>= return . randoms + > return . bestSoFar . loopS (ga (makePop 20) + > (recomb . gaSelect 2 dist rs) + > mut) $ startSols -tourNeighbourhood :: ([Int]->[[Int]])->TSPMap->TSPTour->[TSPTour] -tourNeighbourhood basicNeighbourhood m t - = let n = basicNeighbourhood $ tspPath t - f = makeTour m - in map f n + All these examples are best demonstrated by composition with the following limiting function, parametrised as + seen fit by the user; --- | Make an Asymmetric TSP example problem + > strategy >>= return . limiterTSP 0 10 +-} -makeASymmetricTSPMap :: RandomGen g=>Float->Int->g->TSPMap -makeASymmetricTSPMap distanceUpperLimit numCities g - = let cities = [0 ..(numCities-1)] - cityCoords = [(a,b) | a<-cities,b<-cities,a/=b] - matrix = M.fromList $ zip cityCoords (randomRs (1,distanceUpperLimit) g) - in TSPMap numCities (\x y->M.findWithDefault 0 (x,y) matrix) +module Control.Search.Local.Example( + -- * Loading routines + ExampleFiles(FL417,BURMA14),loadExampleFile, + -- * Perturbation functions + swapPositions,adjacentExchange, + -- * Neighbourhood functions + adjacentExchangeN,stochasticNeighbourhood, + -- * Recombination function + stochasticRecombine, + -- * Other TSP interaction functions + randomStarts,getTSPVal, + -- * Functions for terminating the search, not yet folded into the main library + limiter,limiterTSP +)where --- | Make a Symmetric TSP example problem +import Paths_local_search +import CombinatorialOptimisation.TSP +import FileFormat.TSPLIB +import Control.Search.Local +import qualified Data.IntMap as IM +import qualified Data.Set as S +import System.Random +import Data.List -makeSymmetricTSPMap :: RandomGen g=>Float->Int->g->TSPMap -makeSymmetricTSPMap distanceUpperLimit numCities g - = let cities = [0 ..(numCities-1)] - cityCoords = [(a,b) | a<-cities,b<-take (a+1) cities,a/=b ] - f e ((a,b),c) = M.insert (b,a) c (M.insert (a,b) c e) - matrix = foldl f M.empty (zip cityCoords (randomRs (1,distanceUpperLimit) g)) - in TSPMap numCities (\x y->M.findWithDefault 0 (x,y) matrix) +data ExampleFiles = FL417 | BURMA14 --- | So that we can convince ourselves the maps have the properties suggested by the names. +{-| A stream transformation that converts a local search process into a finite list. + The function takes a quality function parameter, that can yield a floating point quality of a solution. + The remaining functions control the limiting process; + + (1) When the difference in quality between two solutions is below the second parameter, terminate + (2) The two solutions that we are comparing are divided by the integer parameter + -} +limiter :: (Floating f,Ord f)=>(s->f)->f->Int->StreamT s +limiter quality l i xs = map fst . takeWhile f $ zip xs (drop i xs) + where + f (a,b) = abs (quality a - quality b) > l -displayTSPMap :: TSPMap->IO() -displayTSPMap (TSPMap n f) = - do let cities = [0 ..(n-1)] - let cityCoords = [(a,b) | a<-cities,b<-cities,a/=b] - mapM_ (print.show) (zip cityCoords $ map (\(x,y)->f x y) cityCoords) +{-| Specialisation of limiter, fixing the quality function and the problem data type. -} +limiterTSP = limiter getTSPVal -{- | -The manual solve example, give it a tree transformation you wish to see -used, and a map, with an initial solution sequence. E.g. +{-| Demonstration loading routine for only two files stored within this library. After loading this routine also + randomises the initial solution route. -import System.Random -g <- getStdGen -let p = makeSymmetricTSPMap 10 10 g -manualSolve improvement p [0..9] + For more general TSP loading routines see 'FileFormat.TSPLIB'. +-} +loadExampleFile :: ExampleFiles->IO TSPProblem +loadExampleFile FL417 = lFile "fl417.tsp" +loadExampleFile BURMA14 = lFile "burma14.tsp" -(this will work on the GHCI command prompt) -} +lFile :: String->IO TSPProblem +lFile s = do p<-getDataFileName s >>= loadTSPFile ExplicitMatrix + g<-newStdGen + return $ randomiseRoute g p -manualSolve :: (LSTree TSPTour->LSTree TSPTour)->TSPMap->[Int]->IO() -manualSolve trans tspmap iPath = - do let tourN = tourNeighbourhood basicExchange tspmap - let tree = mkTree tourN (makeTour tspmap iPath) - (manualNavigator :: LSTree TSPTour->IO()) (trans tree) +{-| Genetic algorithms require a number of (usually) stochastically generated solutions to begin the process, not 1. + This function is provided for these cases, taking the parameters; -{- | -And this is closer to useful code, though still printing out, not returning -a list. The termination condition of this process is just to run until -it hits 50, or the list ends. More sophisticated post navigation -behaviour is also possible. + (1) the number of solutions to produce + + (2) a sample solution (for edgeweights and problem size) + + (3) a random number generator +-} +randomStarts :: RandomGen g=>Int->TSPProblem->g->[TSPProblem] +randomStarts i x g = let rs = (chunk (numCities x) . randoms $ g) :: [[Float]] + routes = map ((0:) . map fst . sortBy (\a b->compare (snd a) (snd b)) . zip [1 .. numCities x -1]) + in take i $ map (flip setRoute x) (routes rs) -Example usage. -import System.Random -g <- getStdGen -let p = makeSymmetricTSPMap 10 10 g -justResultsSequence minImprov p [0..9] -justResultsSequence (simulatedAnnealingA 0.8 40 g) p [0..9] -} +{-| Not a loading routine, but a synonym for a function within the 'CombinatorialOptimisation.TSP' library.-} +getTSPVal :: Floating f=>TSPProblem->f +getTSPVal = solutionValue -justResultsSequence :: (LSTree TSPTour->[TSPTour])->TSPMap->[Int]->IO() -justResultsSequence trans tspmap iPath = - do let tourN = tourNeighbourhood basicExchange tspmap - let tree = mkTree tourN (makeTour tspmap iPath) - mapM_ print $ take 50 $ trans tree +{-| A synonym for the function 'swapCitiesOnIndex' found in the 'CombinatorialOptimisation.TSP' library. + This will form the foundation of our perturbation and neighbourhood functions.-} +swapPositions :: Int->Int->TSPProblem->TSPProblem +swapPositions = swapCitiesOnIndex -{- | Finally a main function, to allow users to just run it and see what it does -} -main :: IO() -main = do g <- getStdGen - let tspmap = makeSymmetricTSPMap 10 10 g - let tourN = tourNeighbourhood basicExchange tspmap - let iPath = [0..9] - let tree = mkTree tourN (makeTour tspmap iPath) - mapM_ print $ take 50 $ minImprov tree -- so you can see it just running - (manualNavigator :: LSTree TSPTour->IO()) ((improvement . nSort) tree) -- so you can step through the process and see what the rest of the space looks like +{-| Swap a city, indicated by index, with the city after it, indicated by index.-} +adjacentExchange :: Int->TSPProblem->TSPProblem +adjacentExchange i = swapPositions i (i+1) +{-| For a particular path, generate every path that can exist from swapping adjacent cities.-} +adjacentExchangeN :: TSPProblem->[TSPProblem] +adjacentExchangeN a = map (flip adjacentExchange a) [0 .. numCities a -2] +{-| Many strategies benefit from a small manageable neighbourhood, but with the opportunity to access wider options. + This stream transformer provides this, at each step providing a neighbourhood of size N, drawn randomly from the + set of all possible city swaps, adjacent or otherwise. + This does not need to be defined as a stream transformer, but the alternative still requires parametrisation + with values that will be drawn from a source of random numbers. This version would then require lifting to + become a stream transformer, and this introduces more complications in the meta-heuristic code. +-} +stochasticNeighbourhood :: RandomGen g=>Int->g->ExpandT TSPProblem +stochasticNeighbourhood nSize g sols = let as = chunk nSize . chunk 2 . randomRs (0,numCities (head sols) -1) $ g + f s = map (\[a,b]->swapPositions a b s) + in zipWith f sols as +{-| A recombination process, for use in the genetic algorithm examples. This is presented as a contraction, however + it does assume that each population has already been constrained to elements that will form the parents of the + new solution. This process also assumes that there will be exactly 2 parents to each new solution, so it is + an example of a recombination method only. -} +stochasticRecombine :: RandomGen g=>g->ContraT TSPProblem +stochasticRecombine g a = unfoldr f (a,randoms g :: [Double]) + where + f ([p1,p2]:ps,rs) = let (fs,rs') = stoRebuild rs (IM.fromList $ zip [0..] [(head c,last c,c) |c<-commonFragments p1edges p2route ]) + in Just (setRoute fs p1 ,(ps,rs')) +--unsafePerformIO (print . getTSPVal $ (setRoute fs p1)) + where + p1edges = let as = cycle p1route in S.fromList . map fst $ zip (zip as (tail as)) p1route + p2edges = let as = cycle p2route in S.fromList . map fst $ zip (zip as (tail as)) p2route + p2route = IM.elems . routeMap $ p2 + p1route = IM.elems . routeMap $ p1 - + stoRebuild (a:b:xs) lookup + | si == 1 = ((\(_,_,x)->x) (lookup IM.! 0),a:b:xs) + | a' == b' = stoRebuild xs lookup + | S.member (aE,bS) p1edges || S.member (aE,bS) p2edges = stoRebuild xs (linkChunks a' b' (si-1) (aS,bE,a''++b'') lookup) + | S.member (bE,aS) p1edges || S.member (bE,aS) p2edges = stoRebuild xs (linkChunks a' b' (si-1) (bS,aE,b'' ++ a'') lookup) + | head xs <0.3 = stoRebuild (tail xs) (linkChunks a' b' (si-1) (aS,bE,a''++b'') lookup) + | head xs <0.6 = stoRebuild (tail xs) (linkChunks a' b' (si-1) (bS,aE,b''++a'') lookup) + | otherwise = stoRebuild (tail xs) lookup + where + si = IM.size lookup + si' = fromIntegral si + a' = floor (a*si') + b' = floor (b*si') + (aS,aE,a'') = lookup IM.! a' + (bS,bE,b'') = lookup IM.! b' + linkChunks index1 index2 index3 newChunk lookup | index1 > index2 = linkChunks index2 index1 index3 newChunk lookup + | otherwise = IM.delete index3 . IM.insert index2 (lookup IM.! index3) . IM.insert index1 newChunk $ lookup + +commonFragments :: Ord t => S.Set (t, t) -> [t] -> [[t]] +commonFragments aEdges (b:bs) = f bs [[b]] + where + f [] [c] = [reverse c] + f [] (c:cs) + | S.member (head c,head $ last cs) aEdges = (reverse c ++ last cs) : init cs + | otherwise = reverse c : cs + f (x:xs) (c:cs) + | S.member (head c,x) aEdges = f xs ((x:c):cs) + | otherwise = f xs ([x] : reverse c : cs) diff --git a/Control/Search/Local/Navigator.hs b/Control/Search/Local/Navigator.hs deleted file mode 100644 --- a/Control/Search/Local/Navigator.hs +++ /dev/null @@ -1,47 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Search.Local.Navigator --- Copyright : (c) Richard Senington & David Duke 2010 --- License : GPL-style --- --- Maintainer : Richard Senington --- Stability : provisional --- Portability : portable --- --- The two ways to navigate a tree. The paper reduced all the different local search strategies to transformations --- composed with a first choice system, so that is the navigator that is expected to be used. However we also --- provide a manual inspection navigator, that allows for human interaction, by typing the number of the node --- you wish to move to. ------------------------------------------------------------------------------ - -module Control.Search.Local.Navigator ( - firstChoice, - manualNavigator -)where - -import Control.Search.Local.Tree -import Control.Search.Local.Transformation -import Control.Search.Local.Neighbourhood - -firstChoice :: LSTree a->[a] -firstChoice t | (null.treeNodeChildren) t = [treeNodeName t] - | otherwise = treeNodeName t : (firstChoice (head (treeNodeChildren t))) - --- | Types left out of the next two parts because of compilation problems with type inference if included. -manualNavigator t = - do displayLSSpace t - putStr ": " - x<-getLine - if x=="q" then return () - else do let i = (read x)::Int - manualNavigator (treeNodeChildren t !! i) - -displayLSSpace t = - do let nme = treeNodeName t - putStrLn $ "Current Location : "++(show nme) - putStrLn $ " Current Price : " -- ++(show $ priceSolution nme) - putStrLn $ " Neighbourhood" - mapM_ putStrLn $ map (\(x,y)->" "++(show x)++" "++(show.treeNodeName $ y)++" "++(show.priceSolution.treeNodeName $ y)) (zip [0..] $ treeNodeChildren t) - - - diff --git a/Control/Search/Local/Neighbourhood.hs b/Control/Search/Local/Neighbourhood.hs deleted file mode 100644 --- a/Control/Search/Local/Neighbourhood.hs +++ /dev/null @@ -1,65 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Search.Local.Neighbourhood --- Copyright : (c) Richard Senington & David Duke 2010 --- License : GPL-style --- --- Maintainer : Richard Senington --- Stability : provisional --- Portability : portable --- --- Simple Neighbourhood functions for the representation of problems to the library. --- All neighbourhood functions must ultimately be of the form a->[a]. --- --- This module also contains some additional code for the modeling of problems and the --- link between the model and the library. ------------------------------------------------------------------------------ - -module Control.Search.Local.Neighbourhood ( - exchange, - basicExchange, - NumericallyPriced(priceSolution) -) where - -import Data.List - --- | following helper function pinched from http://www.polyomino.f2s.com/david/haskell/combinatorics.html - -combinationsOf 0 _ = [[]] -combinationsOf _ [] = [] -combinationsOf k (x:xs) = map (x:) (combinationsOf (k-1) xs) ++ combinationsOf k xs - -{- | my code again from here on - -The first type of neighbourhood is based upon combination exchange in a sequence of elements. This is appropriate for something like TSP, where -order matters, but would be less useful for SAT. - -It takes 2 numbers as parameters, one of which is the number of exchanges to perform, the other the maximum distance within the list. -For example exchange 2 2, would change up to 2 elements in each neighbourhood, either adjacent or separated by 1 other element. -} - -exchange :: Eq a=>Int->Int->[a]->[[a]] -exchange _ 0 inlist = [inlist] -exchange exchanges dist inlist = nub (map (implement inlist) variants) - where - len = (length inlist -1) - opts = [(x,x+y) | x<-[0..len],y<-[1..dist],x+y<= len] - variants = combinationsOf exchanges opts - implement :: [a]->[(Int,Int)]->[a] - implement i [] = i - implement i ((x,y):xs) = implement (begin++[x2]++middle++[x1]++rest') xs - where - (begin,x1:rest) = splitAt x i - (middle,x2:rest') = splitAt (y-x-1) rest - --- | We provide the most basic exchange system for testing - -basicExchange :: Eq a=>[a]->[[a]] -basicExchange = exchange 1 1 - -{- | -Some transformations (and the manual inspector of the search process) need to be able to extract a numeric price from -a solution. To use these, the solution representation data type must be a part of the following class, please see -the example code. -} - -class (Ord b,Num b)=>NumericallyPriced a b | a->b where - priceSolution :: a->b diff --git a/Control/Search/Local/Queue.hs b/Control/Search/Local/Queue.hs new file mode 100644 --- /dev/null +++ b/Control/Search/Local/Queue.hs @@ -0,0 +1,20 @@ +module Control.Search.Local.Queue where + +data Queue a = Queue [a] [a] Int + +initQ :: Queue a +initQ = Queue [] [] 0 + +sizeQ :: Queue a->Int +sizeQ (Queue _ _ s) = s + +append :: Queue a -> a -> Queue a +append (Queue fr bk sz) x = Queue fr (x:bk) (1+sz) + +remove :: Queue a->Queue a +remove q@(Queue [] [] _ ) = q +remove (Queue [] bk sz) = remove (Queue (reverse bk) [] sz) +remove (Queue as bk sz) = Queue (tail as) bk (sz-1) + +toList :: Queue a->[a] +toList (Queue fr bk _) = fr ++ reverse bk diff --git a/Control/Search/Local/Strategies.hs b/Control/Search/Local/Strategies.hs new file mode 100644 --- /dev/null +++ b/Control/Search/Local/Strategies.hs @@ -0,0 +1,129 @@ +{-| 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) diff --git a/Control/Search/Local/Transformation.hs b/Control/Search/Local/Transformation.hs deleted file mode 100644 --- a/Control/Search/Local/Transformation.hs +++ /dev/null @@ -1,139 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Search.Local.Transformation --- Copyright : (c) Richard Senington & David Duke 2010 --- License : GPL-style --- --- Maintainer : Richard Senington --- Stability : provisional --- Portability : portable --- --- Transformations for capturing characteristics of algorithms. ------------------------------------------------------------------------------ - -module Control.Search.Local.Transformation ( - improvement, - nShuffle, - nSort, - nReverse, - tabu, - thresholdWorsening, - varyingThresholdWorsening, - multiLevelApply, - sImprovement -) where - -import Control.Search.Local.Tree -import Control.Search.Local.Neighbourhood -import Data.List -import System.Random - -{- | A basic recursive filter. This will check every neighbourhood, and remove those -neighbours that do not improve upon their parent solution. -} - -improvement :: Ord nme=>LSTree nme -> LSTree nme -improvement = multiLevelApply (repeat sImprovement) - -{- | A single level improvement transformation, that will remove from the top neighbourhood -of the tree those solutions that do not improve upon the parent solution. It is -used by both the recursive improvement transformation, and one of the -attempts to encode Simulated Annealing. -} - -sImprovement :: Ord nme=>LSTree nme -> LSTree nme -sImprovement t = let ns' = filter ([b]->[a]->[a] -shuffle rs xs = map snd (sortBy (\(a,_) (b,_)->compare a b) $ zip rs xs) - -{- | Another helper, to generate a specific number of random values from a - generator, and return them with the updated generator. -} - -makeLimitedRands :: (Random a,RandomGen g)=>g->Int->([a],g) -makeLimitedRands g l = foldl f ([],g) [1..l] - where - f (a,b) _ = let (c,b') = random b - in (c:a,b') - --- | Recursive neighbourhood shuffling transformation, all neighbourhoods will become randomised. - -nShuffle :: RandomGen g=>g->LSTree nme -> LSTree nme -nShuffle g t = LSTree (treeNodeName t) ns' - where - ns = treeNodeChildren t - (rs,g') = makeLimitedRands g $ length ns - ns' = map (nShuffle g') (shuffle (rs :: [Int]) ns) - -{- | Single level neighbourhood ordering transformation. -} -sSort :: Ord nme=>LSTree nme -> LSTree nme -sSort t = LSTree (treeNodeName t) (sort (treeNodeChildren t)) - -{- | Recursive neighbourhood ordering transformation. Implemented using multi-apply. -} - -nSort :: Ord nme=>LSTree nme -> LSTree nme -nSort = multiLevelApply (repeat sSort) - -{- | Single level reversal of neighbourhood order. To be used in conjunction with sorting for moving - between finding largest and smallest elements. -} - -sReverse :: LSTree nme -> LSTree nme -sReverse t = LSTree (treeNodeName t) (reverse $ treeNodeChildren t) - -{- | Recursive neighbourhood reversal transformation. Implemented using multi-apply. -} - -nReverse :: LSTree nme -> LSTree nme -nReverse = multiLevelApply (repeat sReverse) - - - -{- | A simple (very simple) TABU system. Based upon a limited Queue, and -direct node comparison (not the way it is usually used in the OR -community). Acts as a recursive filter based upon memory. -} - -tabu :: Eq nme=>Int->[nme]->LSTree nme->LSTree nme -tabu queueSize q t = LSTree nme ns'' - where - nme = treeNodeName t - q' = take queueSize $ nme:q - ns' = filter (\n->not $ elem (treeNodeName n) q') (treeNodeChildren t) - ns'' = map (tabu queueSize q') ns' - -{- | Takes advantage of numerically priced solutions, rather than just ordering, -to allow through solutions that are worse than the current solution, but -only to a limited extent. Would require some understanding of the maximum -and minimum differences likely in a solution set. -} - -thresholdWorsening :: NumericallyPriced nme a=>a->LSTree nme->LSTree nme -thresholdWorsening thresh t = LSTree nme ns' - where - nme = treeNodeName t - tP = priceSolution nme - ns = filter (\n->(priceSolution.treeNodeName) n - tP[a]->LSTree nme->LSTree nme -varyingThresholdWorsening (thresh:thresh') t = LSTree nme ns' - where - nme = treeNodeName t - tP = priceSolution nme - ns = filter (\n->(priceSolution.treeNodeName) n - tPLSTree nme]->LSTree nme->LSTree nme -multiLevelApply (x:xs) t = let ns = map (multiLevelApply xs) (treeNodeChildren $ x t) - in LSTree (treeNodeName t) ns - - - - diff --git a/Control/Search/Local/Tree.hs b/Control/Search/Local/Tree.hs deleted file mode 100644 --- a/Control/Search/Local/Tree.hs +++ /dev/null @@ -1,40 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Control.Search.Local.Tree --- Copyright : (c) Richard Senington & David Duke 2010 --- License : GPL-style --- --- Maintainer : Richard Senington --- Stability : provisional --- Portability : portable --- --- The internal data structure of the library. ------------------------------------------------------------------------------ - -module Control.Search.Local.Tree( - LSTree(treeNodeName,treeNodeChildren,LSTree),mkTree -)where - -{- | A rose tree, but not currently using an optimised data structure, just this little - home built one. The accessor functions should be easy enough to understand. -} - -data LSTree nme = LSTree {treeNodeName :: nme, - treeNodeChildren :: [LSTree nme]} - -{- | The construction function, as seen in the paper. Takes a neighbourhood function, that - is, a function that takes a solution and perterbs it in some way, giving a selection of - new solutions. It then requires a seed, and gives back an initial tree. -} - -mkTree :: (a->[a])->a->LSTree a -mkTree f seed = LSTree seed $ map (mkTree f) (f seed) - -{- | Making a tree part of Ord and Eq, for ease of comparison later. - Note that how the order is determined depends upon the implementation given for a solution. -} - -instance (Ord nme)=>Ord (LSTree nme) where - compare t1 t2 = compare (treeNodeName t1) (treeNodeName t2) - -instance (Eq nme)=>Eq (LSTree nme) where - (==) t1 t2 = (treeNodeName t1) == (treeNodeName t2) - - diff --git a/Demo.hs b/Demo.hs new file mode 100644 --- /dev/null +++ b/Demo.hs @@ -0,0 +1,67 @@ +-- This file will need to be moved away from the install folder before it will work. + +import Control.Search.Local.Eager +import Control.Search.Local.Strategies +import Control.Search.Local +import Control.Search.Local.Example + +import System.Random +import CombinatorialOptimisation.TSP + +import Data.List + +simpleII = loadExampleFile BURMA14 >>= return . loopP (maximalii (map adjacentExchangeN)) + +iiExample + = do prob<-loadExampleFile FL417 + strat<-newStdGen >>= return . stochasticii rChoice . randoms + return . loopP (strat (map adjacentExchangeN)) $ prob + where + rChoice xs p = xs !! (floor ((p::Float) * fromIntegral (length xs))) + +simpleTabu = loadExampleFile BURMA14 >>= return . bestSoFar . loopP (standardTabu 5 (map adjacentExchangeN) (map head)) + +tabuExample + = do prob<-loadExampleFile FL417 + nF <- newStdGen >>= return . stochasticNeighbourhood 417 + vWin <- newStdGen >>= return . varyWindow . randomRs (5,10) + return . bestSoFar . loopP (tabu (vWin . window 15) nF (map head)) $ prob + + +saExample + = do prob<-loadExampleFile FL417 + (fIs,sIs) <- newStdGen >>= return . (\a->(map head a,map last a)) . chunk 2 . randomRs (0,numCities prob-1) + let perturb = zipWith3 swapPositions fIs sIs + choiceRs <-newStdGen >>= return . randoms + return . bestSoFar . loopP (sa getTSPVal perturb + (geoCooling 80000 (0.99 :: Float)) + choiceRs) $ prob + +saRestartExample + = do prob<-loadExampleFile FL417 + (fIs,sIs) <- newStdGen >>= return . (\a->(map head a,map last a)) . chunk 2 . randomRs (0,numCities prob-1) + let perturb = zipWith3 swapPositions fIs sIs + choiceRs <-newStdGen >>= return . randoms + return (restartingSA perturb choiceRs prob) + where + restartingSA perturbF rs seed + = let cs = map (\w -> if null w then False else head w == last w) $ window 10 sols + restart base trigs = until_ base trigs $ map (restart base) (tails trigs) + ts = restart (geoCooling 80000 (0.99::Float) ) cs + sols = loopP (sa getTSPVal perturbF rs ts) seed + in bestSoFar sols + + +gaWithMutate + = do prob<-loadExampleFile FL417 + recomb<-newStdGen >>= return . stochasticRecombine + startSols <- newStdGen >>= return . randomStarts 20 prob + pattern <- newStdGen >>= return . map (<(0.05::Float)) . randoms -- boolean pattern + (fIs,sIs) <- newStdGen >>= return . (\a->(map head a,map last a)) . chunk 2 . randomRs (0,numCities prob-1) + let dist = (++[1]) . takeWhile (<1) $ iterate (*1.0884) (0.2::Float) + let mut = nest pattern (zipWith3 swapPositions fIs sIs) + rs <- newStdGen >>= return . randoms + return . bestSoFar . loopS (ga (makePop 20) + (recomb . gaSelect 2 dist rs) + mut) $ startSols + diff --git a/burma14.tsp b/burma14.tsp new file mode 100644 --- /dev/null +++ b/burma14.tsp @@ -0,0 +1,26 @@ +NAME: burma14 +TYPE: TSP +COMMENT: 14-Staedte in Burma (Zaw Win) +DIMENSION: 14 +EDGE_WEIGHT_TYPE: GEO +EDGE_WEIGHT_FORMAT: FUNCTION +DISPLAY_DATA_TYPE: COORD_DISPLAY +NODE_COORD_SECTION + 1 16.47 96.10 + 2 16.47 94.44 + 3 20.09 92.54 + 4 22.39 93.37 + 5 25.23 97.24 + 6 22.00 96.05 + 7 20.47 97.02 + 8 17.20 96.29 + 9 16.30 97.38 + 10 14.05 98.12 + 11 16.53 97.38 + 12 21.52 95.59 + 13 19.41 97.13 + 14 20.09 94.55 +EOF + + + diff --git a/fl417.tsp b/fl417.tsp new file mode 100644 --- /dev/null +++ b/fl417.tsp @@ -0,0 +1,424 @@ +NAME : fl417 +COMMENT : Drilling problem (Reinelt) +TYPE : TSP +DIMENSION : 417 +EDGE_WEIGHT_TYPE : EUC_2D +NODE_COORD_SECTION +1 1.02570e+03 1.97130e+03 +2 1.16167e+03 1.96539e+03 +3 1.19123e+03 1.95949e+03 +4 1.16759e+03 1.95949e+03 +5 1.09664e+03 1.95949e+03 +6 1.10256e+03 1.95358e+03 +7 1.09073e+03 1.95358e+03 +8 1.01979e+03 1.95358e+03 +9 1.23262e+03 1.94177e+03 +10 1.04344e+03 1.94177e+03 +11 1.23853e+03 1.93587e+03 +12 1.16759e+03 1.93587e+03 +13 1.13211e+03 1.93587e+03 +14 1.26809e+03 1.92996e+03 +15 1.24444e+03 1.92996e+03 +16 1.06708e+03 1.92996e+03 +17 1.17941e+03 1.92406e+03 +18 1.04935e+03 1.92406e+03 +19 1.03753e+03 1.92406e+03 +20 1.12620e+03 1.91815e+03 +21 1.09073e+03 1.91815e+03 +22 9.84319e+02 1.91815e+03 +23 1.32720e+03 1.90634e+03 +24 1.03161e+03 1.90634e+03 +25 9.96143e+02 1.90634e+03 +26 1.04935e+03 1.90044e+03 +27 1.18532e+03 1.89453e+03 +28 1.11438e+03 1.89453e+03 +29 1.31538e+03 1.88272e+03 +30 1.29173e+03 1.88272e+03 +31 1.07891e+03 1.88272e+03 +32 1.01388e+03 1.87682e+03 +33 1.73512e+03 1.74691e+03 +34 7.41934e+02 1.74691e+03 +35 1.72921e+03 1.74100e+03 +36 7.36022e+02 1.74100e+03 +37 1.52230e+03 1.72329e+03 +38 5.29108e+02 1.72329e+03 +39 1.18532e+03 1.64652e+03 +40 1.56959e+03 1.52252e+03 +41 5.76403e+02 1.52252e+03 +42 1.14985e+03 1.44575e+03 +43 6.17786e+02 1.44575e+03 +44 1.03161e+03 1.42213e+03 +45 1.10847e+03 1.41622e+03 +46 7.53758e+02 1.41622e+03 +47 1.03161e+03 1.41032e+03 +48 5.94138e+02 1.41032e+03 +49 7.59670e+02 1.39851e+03 +50 6.05962e+02 1.39851e+03 +51 7.53758e+02 1.27450e+03 +52 6.59169e+02 1.25088e+03 +53 1.26809e+03 1.24498e+03 +54 5.94138e+02 1.24498e+03 +55 6.11874e+02 1.22726e+03 +56 1.27991e+03 1.22136e+03 +57 6.59169e+02 1.15640e+03 +58 1.22670e+03 1.00287e+03 +59 1.14985e+03 9.96967e+02 +60 1.61097e+03 9.73347e+02 +61 1.03753e+03 8.02101e+02 +62 1.31538e+03 7.96196e+02 +63 1.11438e+03 7.96196e+02 +64 1.09073e+03 7.96196e+02 +65 1.27400e+03 7.90290e+02 +66 1.13211e+03 7.90290e+02 +67 1.10847e+03 7.90290e+02 +68 1.01388e+03 7.90290e+02 +69 1.26809e+03 7.84386e+02 +70 1.11438e+03 7.84386e+02 +71 1.03161e+03 7.84386e+02 +72 1.66418e+03 7.78481e+02 +73 1.23853e+03 7.78481e+02 +74 1.09664e+03 7.78481e+02 +75 1.04935e+03 7.78481e+02 +76 9.78407e+02 7.78481e+02 +77 1.23262e+03 7.72576e+02 +78 1.18532e+03 7.72576e+02 +79 1.07891e+03 7.72576e+02 +80 1.05526e+03 7.72576e+02 +81 1.01979e+03 7.72576e+02 +82 1.21488e+03 7.66670e+02 +83 1.19123e+03 7.66670e+02 +84 1.16759e+03 7.66670e+02 +85 1.08482e+03 7.66670e+02 +86 1.07300e+03 7.66670e+02 +87 1.23262e+03 7.60765e+02 +88 1.16167e+03 7.60765e+02 +89 1.26218e+03 7.54861e+02 +90 1.25035e+03 7.54861e+02 +91 1.17941e+03 7.54861e+02 +92 1.02570e+03 7.54861e+02 +93 1.26809e+03 7.48955e+02 +94 1.24444e+03 7.48955e+02 +95 1.17350e+03 7.48955e+02 +96 1.13211e+03 7.43050e+02 +97 1.12029e+03 7.43050e+02 +98 1.01979e+03 7.25335e+02 +99 9.96143e+02 7.25335e+02 +100 1.03753e+03 7.19430e+02 +101 1.00205e+03 7.19430e+02 +102 1.17350e+03 5.59994e+02 +103 1.61097e+03 5.48184e+02 +104 1.17350e+03 5.48184e+02 +105 1.22079e+03 5.36374e+02 +106 1.62871e+03 2.04806e+03 +107 1.62871e+03 2.03625e+03 +108 1.61689e+03 2.04806e+03 +109 1.61689e+03 2.03625e+03 +110 1.60506e+03 2.04806e+03 +111 1.60506e+03 2.03625e+03 +112 1.59324e+03 2.04806e+03 +113 1.59324e+03 2.03625e+03 +114 1.58141e+03 2.04806e+03 +115 1.58141e+03 2.03625e+03 +116 1.56959e+03 2.04806e+03 +117 1.56959e+03 2.03625e+03 +118 1.55777e+03 2.04806e+03 +119 1.55777e+03 2.03625e+03 +120 1.54594e+03 2.04806e+03 +121 1.54594e+03 2.03625e+03 +122 1.53412e+03 2.04806e+03 +123 1.53412e+03 2.03625e+03 +124 1.52230e+03 2.04806e+03 +125 1.52230e+03 2.03625e+03 +126 1.51047e+03 2.04806e+03 +127 1.51047e+03 2.03625e+03 +128 1.49865e+03 2.04806e+03 +129 1.49865e+03 2.03625e+03 +130 1.62280e+03 2.04216e+03 +131 1.62280e+03 2.03035e+03 +132 1.61097e+03 2.04216e+03 +133 1.61097e+03 2.03035e+03 +134 1.59915e+03 2.04216e+03 +135 1.59915e+03 2.03035e+03 +136 1.58733e+03 2.04216e+03 +137 1.58733e+03 2.03035e+03 +138 1.57550e+03 2.04216e+03 +139 1.57550e+03 2.03035e+03 +140 1.56368e+03 2.04216e+03 +141 1.56368e+03 2.03035e+03 +142 1.55185e+03 2.04216e+03 +143 1.55185e+03 2.03035e+03 +144 1.54003e+03 2.04216e+03 +145 1.54003e+03 2.03035e+03 +146 1.52821e+03 2.04216e+03 +147 1.52821e+03 2.03035e+03 +148 1.51638e+03 2.04216e+03 +149 1.51638e+03 2.03035e+03 +150 1.50456e+03 2.04216e+03 +151 1.50456e+03 2.03035e+03 +152 1.49274e+03 2.04216e+03 +153 1.49274e+03 2.03035e+03 +154 6.47346e+02 2.04806e+03 +155 6.47346e+02 2.03625e+03 +156 6.35522e+02 2.04806e+03 +157 6.35522e+02 2.03625e+03 +158 6.23699e+02 2.04806e+03 +159 6.23699e+02 2.03625e+03 +160 6.11875e+02 2.04806e+03 +161 6.11875e+02 2.03625e+03 +162 6.00051e+02 2.04806e+03 +163 6.00051e+02 2.03625e+03 +164 5.88228e+02 2.04806e+03 +165 5.88228e+02 2.03625e+03 +166 5.76404e+02 2.04806e+03 +167 5.76404e+02 2.03625e+03 +168 5.64581e+02 2.04806e+03 +169 5.64581e+02 2.03625e+03 +170 5.52757e+02 2.04806e+03 +171 5.52757e+02 2.03625e+03 +172 5.40933e+02 2.04806e+03 +173 5.40933e+02 2.03625e+03 +174 5.29109e+02 2.04806e+03 +175 5.29109e+02 2.03625e+03 +176 5.17286e+02 2.04806e+03 +177 5.17286e+02 2.03625e+03 +178 6.41434e+02 2.04216e+03 +179 6.41434e+02 2.03035e+03 +180 6.29611e+02 2.04216e+03 +181 6.29611e+02 2.03035e+03 +182 6.17787e+02 2.04216e+03 +183 6.17787e+02 2.03035e+03 +184 6.05963e+02 2.04216e+03 +185 6.05963e+02 2.03035e+03 +186 5.94140e+02 2.04216e+03 +187 5.94140e+02 2.03035e+03 +188 5.82316e+02 2.04216e+03 +189 5.82316e+02 2.03035e+03 +190 5.70492e+02 2.04216e+03 +191 5.70492e+02 2.03035e+03 +192 5.58669e+02 2.04216e+03 +193 5.58669e+02 2.03035e+03 +194 5.46845e+02 2.04216e+03 +195 5.46845e+02 2.03035e+03 +196 5.35022e+02 2.04216e+03 +197 5.35022e+02 2.03035e+03 +198 5.23198e+02 2.04216e+03 +199 5.23198e+02 2.03035e+03 +200 5.11374e+02 2.04216e+03 +201 5.11374e+02 2.03035e+03 +202 1.62871e+03 1.70262e+02 +203 1.62871e+03 1.58452e+02 +204 1.61689e+03 1.70262e+02 +205 1.61689e+03 1.58452e+02 +206 1.60506e+03 1.70262e+02 +207 1.60506e+03 1.58452e+02 +208 1.59324e+03 1.70262e+02 +209 1.59324e+03 1.58452e+02 +210 1.58141e+03 1.70262e+02 +211 1.58141e+03 1.58452e+02 +212 1.56959e+03 1.70262e+02 +213 1.56959e+03 1.58452e+02 +214 1.55777e+03 1.70262e+02 +215 1.55777e+03 1.58452e+02 +216 1.54594e+03 1.70262e+02 +217 1.54594e+03 1.58452e+02 +218 1.53412e+03 1.70262e+02 +219 1.53412e+03 1.58452e+02 +220 1.52230e+03 1.70262e+02 +221 1.52230e+03 1.58452e+02 +222 1.51047e+03 1.70262e+02 +223 1.51047e+03 1.58452e+02 +224 1.49865e+03 1.70262e+02 +225 1.49865e+03 1.58452e+02 +226 1.62280e+03 1.64357e+02 +227 1.62280e+03 1.52547e+02 +228 1.61097e+03 1.64357e+02 +229 1.61097e+03 1.52547e+02 +230 1.59915e+03 1.64357e+02 +231 1.59915e+03 1.52547e+02 +232 1.58733e+03 1.64357e+02 +233 1.58733e+03 1.52547e+02 +234 1.57550e+03 1.64357e+02 +235 1.57550e+03 1.52547e+02 +236 1.56368e+03 1.64357e+02 +237 1.56368e+03 1.52547e+02 +238 1.55185e+03 1.64357e+02 +239 1.55185e+03 1.52547e+02 +240 1.54003e+03 1.64357e+02 +241 1.54003e+03 1.52547e+02 +242 1.52821e+03 1.64357e+02 +243 1.52821e+03 1.52547e+02 +244 1.51638e+03 1.64357e+02 +245 1.51638e+03 1.52547e+02 +246 1.50456e+03 1.64357e+02 +247 1.50456e+03 1.52547e+02 +248 1.49274e+03 1.64357e+02 +249 1.49274e+03 1.52547e+02 +250 6.47346e+02 1.70262e+02 +251 6.47346e+02 1.58452e+02 +252 6.35522e+02 1.70262e+02 +253 6.35522e+02 1.58452e+02 +254 6.23699e+02 1.70262e+02 +255 6.23699e+02 1.58452e+02 +256 6.11875e+02 1.70262e+02 +257 6.11875e+02 1.58452e+02 +258 6.00051e+02 1.70262e+02 +259 6.00051e+02 1.58452e+02 +260 5.88228e+02 1.70262e+02 +261 5.88228e+02 1.58452e+02 +262 5.76404e+02 1.70262e+02 +263 5.76404e+02 1.58452e+02 +264 5.64581e+02 1.70262e+02 +265 5.64581e+02 1.58452e+02 +266 5.52757e+02 1.70262e+02 +267 5.52757e+02 1.58452e+02 +268 5.40933e+02 1.70262e+02 +269 5.40933e+02 1.58452e+02 +270 5.29109e+02 1.70262e+02 +271 5.29109e+02 1.58452e+02 +272 5.17286e+02 1.70262e+02 +273 5.17286e+02 1.58452e+02 +274 6.41434e+02 1.64357e+02 +275 6.41434e+02 1.52547e+02 +276 6.29611e+02 1.64357e+02 +277 6.29611e+02 1.52547e+02 +278 6.17787e+02 1.64357e+02 +279 6.17787e+02 1.52547e+02 +280 6.05963e+02 1.64357e+02 +281 6.05963e+02 1.52547e+02 +282 5.94140e+02 1.64357e+02 +283 5.94140e+02 1.52547e+02 +284 5.82316e+02 1.64357e+02 +285 5.82316e+02 1.52547e+02 +286 5.70492e+02 1.64357e+02 +287 5.70492e+02 1.52547e+02 +288 5.58669e+02 1.64357e+02 +289 5.58669e+02 1.52547e+02 +290 5.46845e+02 1.64357e+02 +291 5.46845e+02 1.52547e+02 +292 5.35022e+02 1.64357e+02 +293 5.35022e+02 1.52547e+02 +294 5.23198e+02 1.64357e+02 +295 5.23198e+02 1.52547e+02 +296 5.11374e+02 1.64357e+02 +297 5.11374e+02 1.52547e+02 +298 1.88883e+03 2.04806e+03 +299 1.87701e+03 2.04806e+03 +300 1.85336e+03 2.04806e+03 +301 1.84154e+03 2.04806e+03 +302 1.82971e+03 2.04806e+03 +303 1.78242e+03 2.04806e+03 +304 1.74695e+03 2.04806e+03 +305 1.72330e+03 2.04806e+03 +306 1.71147e+03 2.04806e+03 +307 1.67600e+03 2.04806e+03 +308 1.65236e+03 2.04806e+03 +309 9.07466e+02 2.04806e+03 +310 8.95642e+02 2.04806e+03 +311 8.71994e+02 2.04806e+03 +312 8.60171e+02 2.04806e+03 +313 8.48347e+02 2.04806e+03 +314 8.01053e+02 2.04806e+03 +315 7.65581e+02 2.04806e+03 +316 7.41934e+02 2.04806e+03 +317 7.30111e+02 2.04806e+03 +318 6.94640e+02 2.04806e+03 +319 6.70992e+02 2.04806e+03 +320 1.87109e+03 2.04216e+03 +321 1.80015e+03 2.04216e+03 +322 1.77651e+03 2.04216e+03 +323 1.75286e+03 2.04216e+03 +324 8.89730e+02 2.04216e+03 +325 8.18788e+02 2.04216e+03 +326 7.95141e+02 2.04216e+03 +327 7.71494e+02 2.04216e+03 +328 1.87701e+03 2.03625e+03 +329 1.85336e+03 2.03625e+03 +330 1.84154e+03 2.03625e+03 +331 1.74695e+03 2.03625e+03 +332 1.72330e+03 2.03625e+03 +333 1.69965e+03 2.03625e+03 +334 8.95642e+02 2.03625e+03 +335 8.71994e+02 2.03625e+03 +336 8.60171e+02 2.03625e+03 +337 7.65581e+02 2.03625e+03 +338 7.41934e+02 2.03625e+03 +339 7.18287e+02 2.03625e+03 +340 1.89474e+03 2.03035e+03 +341 1.87109e+03 2.03035e+03 +342 1.85927e+03 2.03035e+03 +343 1.82380e+03 2.03035e+03 +344 1.81198e+03 2.03035e+03 +345 1.80015e+03 2.03035e+03 +346 1.77651e+03 2.03035e+03 +347 1.76468e+03 2.03035e+03 +348 1.75286e+03 2.03035e+03 +349 9.13377e+02 2.03035e+03 +350 8.89730e+02 2.03035e+03 +351 8.77906e+02 2.03035e+03 +352 8.42435e+02 2.03035e+03 +353 8.30612e+02 2.03035e+03 +354 8.18788e+02 2.03035e+03 +355 7.95141e+02 2.03035e+03 +356 7.83317e+02 2.03035e+03 +357 7.71494e+02 2.03035e+03 +358 1.88883e+03 1.70261e+02 +359 1.87701e+03 1.70261e+02 +360 1.85336e+03 1.70261e+02 +361 1.84154e+03 1.70261e+02 +362 1.82971e+03 1.70261e+02 +363 1.78242e+03 1.70261e+02 +364 1.74695e+03 1.70261e+02 +365 1.72330e+03 1.70261e+02 +366 1.71147e+03 1.70261e+02 +367 1.67600e+03 1.70261e+02 +368 1.65236e+03 1.70261e+02 +369 9.07466e+02 1.70261e+02 +370 8.95642e+02 1.70261e+02 +371 8.71994e+02 1.70261e+02 +372 8.60171e+02 1.70261e+02 +373 8.48347e+02 1.70261e+02 +374 8.01053e+02 1.70261e+02 +375 7.65581e+02 1.70261e+02 +376 7.41934e+02 1.70261e+02 +377 7.30111e+02 1.70261e+02 +378 6.94640e+02 1.70261e+02 +379 6.70992e+02 1.70261e+02 +380 1.87109e+03 1.64357e+02 +381 1.80015e+03 1.64357e+02 +382 1.77651e+03 1.64357e+02 +383 1.75286e+03 1.64357e+02 +384 8.89730e+02 1.64357e+02 +385 8.18788e+02 1.64357e+02 +386 7.95141e+02 1.64357e+02 +387 7.71494e+02 1.64357e+02 +388 1.87701e+03 1.58451e+02 +389 1.85336e+03 1.58451e+02 +390 1.84154e+03 1.58451e+02 +391 1.74695e+03 1.58451e+02 +392 1.72330e+03 1.58451e+02 +393 1.69965e+03 1.58451e+02 +394 8.95642e+02 1.58451e+02 +395 8.71994e+02 1.58451e+02 +396 8.60171e+02 1.58451e+02 +397 7.65581e+02 1.58451e+02 +398 7.41934e+02 1.58451e+02 +399 7.18287e+02 1.58451e+02 +400 1.89474e+03 1.52546e+02 +401 1.87109e+03 1.52546e+02 +402 1.85927e+03 1.52546e+02 +403 1.82380e+03 1.52546e+02 +404 1.81198e+03 1.52546e+02 +405 1.80015e+03 1.52546e+02 +406 1.77651e+03 1.52546e+02 +407 1.76468e+03 1.52546e+02 +408 1.75286e+03 1.52546e+02 +409 9.13377e+02 1.52546e+02 +410 8.89730e+02 1.52546e+02 +411 8.77906e+02 1.52546e+02 +412 8.42435e+02 1.52546e+02 +413 8.30612e+02 1.52546e+02 +414 8.18788e+02 1.52546e+02 +415 7.95141e+02 1.52546e+02 +416 7.83317e+02 1.52546e+02 +417 7.71494e+02 1.52546e+02 +EOF diff --git a/local-search.cabal b/local-search.cabal --- a/local-search.cabal +++ b/local-search.cabal @@ -1,33 +1,32 @@ Name: local-search -Version: 0.0.3 +Version: 0.0.5 Synopsis: A first attempt at generalised local search within Haskell, for applications in combinatorial optimisation. -Description: This library represents a first attempt at creating a generalised library for - local (non-exhaustive) search in Haskell. It is based on work presented to - IFL2010, a draft of which is currently available on the homepage. The library - models local search space using a rose tree, with child nodes forming the - neighbourhood of any solution. The tree can then be transformed by various - combinators to implement different searching strategies; the result is then - "navigated" to yield a sequence of solutions. +Description: This library operates by representing metaheuristics as generators of solutions, or + streams of solutions, which are themselves the result of resolving the interactions of + other streams of values. The library contains combinators for constructing and + managing these structures. Stability: experimental Category: Control, Optimisation, Local Search Author: Richard Senington & David Duke License: GPL license-file: LICENSE -Copyright: Copyright (c) 2010 Richard Senington +Copyright: Copyright (c) 2012 Richard Senington Homepage: http://www.comp.leeds.ac.uk/sc06r2s/Projects/HaskellLocalSearch Maintainer: sc06r2s@leeds.ac.uk Build-Type: Simple Cabal-Version: >= 1.2 +Data-files: fl417.tsp,burma14.tsp library - Exposed-Modules: Control.Search.Local, - Control.Search.Local.Example - Control.Search.Local.Navigator - Control.Search.Local.Neighbourhood - Control.Search.Local.Transformation - Control.Search.Local.Tree - Build-Depends: base >= 2.0 && <=5, - random >= 1.0.0.1, - containers >= 0.2.0.1 + Exposed-Modules: Control.Search.Local + Control.Search.Local.Example + Control.Search.Local.Eager + Control.Search.Local.Strategies + GHC-Options: -O2 + Build-Depends: base >= 2.0 && <=5, + random >=1.0.0.3, + combinatorial-problems >=0.0.4, + containers >= 0.4.0.0 + Other-Modules: Paths_local_search,Control.Search.Local.Queue extensions: MultiParamTypeClasses, FunctionalDependencies