In today’s Programming Praxis exercise we have to implement a significantly faster algorithm for the traveling salesman problem than in the previous exercise. Let’s get started, shall we?
As usual, some imports:
import Control.Monad import Data.List import qualified Data.List.Key as K import System.Random
The functions for calculating distance and total distance are largely the same as in the previous exercise, though because I’ve switched to using lists of integers we now need an extra fromIntegral, and repeating the first point in order to complete the loop has been moved to the cost function.
dist :: (Int, Int) -> (Int, Int) -> Float dist (x1, y1) (x2, y2) = sqrt (f (x1 - x2) ** 2 + f (y1 - y2) ** 2) where f = fromIntegral cost :: [(Int, Int)] -> Float cost xs = sum $ zipWith dist xs (tail xs ++ xs)
Generating a series of random points is a bit longer than it could be because we have to make sure all the points are unique.
randomPoints :: Int -> IO [(Int, Int)] randomPoints n = f  where f ps = if length ps == n then return ps else do p <- liftM2 (,) rnd rnd if elem p ps then f ps else f (p:ps) rnd = randomRIO (0, 10 * n)
Determining the tour to take using the nearest neighbor algorithm is not that difficult. Again, we index the points for similarity to the Programming Praxis solution, not because it is needed.
nearTour :: [(Int, Int)] -> [(Integer, (Int, Int))] nearTour = f . zip [0..] where f  =  f [x] = [x] f ((i,p):ps) = (i,p) : f (nxt : delete nxt ps) where nxt = K.minimum (dist p . snd) ps
To test, we check both a random set of points, as well as the set from the Programming Praxis solution.
main :: IO () main = do rndTour <- fmap nearTour $ randomPoints 25 print (cost $ map snd rndTour, rndTour) let praxisTour = nearTour [(139, 31),( 41,126),(108, 49),(112,193),(179,188), (212, 24),(245, 50),(167,187),(159,236),(185, 78), ( 27, 63),(101,188),(195,167),( 30, 10),(238,110), (221, 60),( 27,231),(146, 67),(249,172),( 36, 71), ( 37,203),(118, 38),(241,226),(197, 29),(220,186)] print (cost $ map snd praxisTour, praxisTour)
We get the same tour as the Programming Praxis solution (Ok, the reverse to be exact. Again, this doesn’t matter and I think starting with the first point is more logical), and at a third of the line count, so I think we can call this one done.