local-search-0.0.5: Demo.hs

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