Example.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Search.Local.Example
-- Copyright   :  (c) Richard Senington & David Duke 2010
-- License     :  GPL-style
-- 
-- Maintainer  :  Richard Senington <sc06r2s@leeds.ac.uk>
-- 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.
----------------------------------------------------------------------------- 

module Control.Search.Local.Example (
  main
) where

import Control.Search.Local 
import System.Random
import qualified Data.Map as M

-- | The data types defined are TSPMaps, the problems, and TSPTours, the solutions.

data TSPMap = TSPMap { tspNumCities :: Int,
                       tspLinkPricer :: Int->Int->Float}

data TSPTour = TSPTour { tspPath :: [Int],
                         tspCost :: Float}

{- | 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. -}

priceTour :: TSPMap->[Int]->Float
priceTour (TSPMap _ f) xs = let priceTour' (_:[]) = 0
                                priceTour' (s:(ks@(k:_))) = f s k + (priceTour' ks)
                            in priceTour' xs

-- | makeTour is a helper function for taking a sequence of ints and returning a TSPTour data type, capturing the path and the price.

makeTour :: TSPMap->[Int]->TSPTour
makeTour m p = TSPTour p (priceTour m p)

{- | 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. -}

instance Eq TSPTour where
  (==) a b = (tspPath a) == (tspPath b)

instance Ord TSPTour where
  compare a b = compare (tspCost a) (tspCost b)

instance NumericallyPriced TSPTour Float where
  priceSolution t = tspCost t

instance Show TSPTour where
  show (TSPTour p c) = "Tour : "++ (show p) ++" with cost "++(show c)

{- | 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. -}

tourNeighbourhood :: ([Int]->[[Int]])->TSPMap->TSPTour->[TSPTour]
tourNeighbourhood basicNeighbourhood m t 
  = let n = basicNeighbourhood $ tspPath t
        f = makeTour m
    in map f n

-- | Make an Asymmetric TSP example problem

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)

-- | Make a Symmetric TSP example problem

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)

-- | So that we can convince ourselves the maps have the properties suggested by the names.

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)

{- |
The manual solve example, give it a tree transformation you wish to see 
used, and a map, with an initial solution sequence. E.g. 

import System.Random
g <- getStdGen
let p = makeSymmetricTSPMap 10 10 g
manualSolve improvement p [0..9]

(this will work on the GHCI command prompt) -}

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)

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

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

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

{- | Finally a main function, to allow users to just run it and see what it does -}

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