module Control.Search.Local.Example (
main,TSPTour
) where
import Control.Search.Local
import System.Random
import qualified Data.Map as M
data TSPMap = TSPMap { tspNumCities :: Int,
tspLinkPricer :: Int->Int->Float}
data TSPTour = TSPTour { tspPath :: [Int],
tspCost :: Float}
priceTour :: TSPMap->[Int]->Float
priceTour (TSPMap _ f) xs = let priceTour' (_:[]) = 0
priceTour' (s:(ks@(k:_))) = f s k + (priceTour' ks)
in priceTour' xs
makeTour :: TSPMap->[Int]->TSPTour
makeTour m p = TSPTour p (priceTour m p)
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)
tourNeighbourhood :: ([Int]->[[Int]])->TSPMap->TSPTour->[TSPTour]
tourNeighbourhood basicNeighbourhood m t
= let n = basicNeighbourhood $ tspPath t
f = makeTour m
in map f n
makeASymmetricTSPMap :: RandomGen g=>Float->Int->g->TSPMap
makeASymmetricTSPMap distanceUpperLimit numCities g
= let cities = [0 ..(numCities1)]
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)
makeSymmetricTSPMap :: RandomGen g=>Float->Int->g->TSPMap
makeSymmetricTSPMap distanceUpperLimit numCities g
= let cities = [0 ..(numCities1)]
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)
displayTSPMap :: TSPMap->IO()
displayTSPMap (TSPMap n f) =
do let cities = [0 ..(n1)]
let cityCoords = [(a,b) | a<-cities,b<-cities,a/=b]
mapM_ (print.show) (zip cityCoords $ map (\(x,y)->f x y) cityCoords)
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)
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
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
(manualNavigator :: LSTree TSPTour->IO()) ((improvement . nSort) tree)