----------------------------------------------------------------------------- -- | -- 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,TSPTour ) 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 :: 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