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.

### Like this:

Like Loading...

*Related*

Tags: algorithm, bonsai, code, Haskell, kata, nearest, neighbour, praxis, programming, salesman, traveling

This entry was posted on March 16, 2010 at 1:37 pm and is filed under Programming Praxis. You can follow any responses to this entry through the RSS 2.0 feed.
You can leave a response, or trackback from your own site.

March 18, 2010 at 3:56 am |

Interesting problem. A few comments:

The way I remembered the problem was that not every point was connected to every other point. This made it considerably more tricky, as you would then have a shortest-path problem as well as a travelling salesman problem.

Also, how do you do haskell syntax highlighting in wordpress?

March 18, 2010 at 7:22 am |

I’m just basing my solution on the exercise given by Programming Praxis, and in his version all the points are connected.

As for syntax highlighting, if you have your own wordpress install you can install one of the many syntax hightlighting plugins. Since I’m on wordpress.com i don’t have that option, so I use a program called Hightlight Code Convertor which outputs raw html (lots of spans and style tags) and use that. Not particularly elegant or easy to change afterwards, but it works well enough.

April 14, 2010 at 2:56 pm |

You could speed things up by not using the distance metric

but by using the distance squared metric. You are looking

for minimum dist and this will work equally as well for dist squared.

Avoid the slow square roots.

July 23, 2014 at 6:11 pm |

Please let me know if you’re looking for a article author

for your blog. You have some really great articles and I feel

I would be a good asset. If you ever want to take some of the load

off, I’d love to write some content for your blog in exchange for a link

back to mine. Please send me an email if interested.

Kudos!