Posts Tagged ‘traveling’

Programming Praxis – Traveling Salesman: Nearest Neighbor

March 16, 2010

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.

Programming Praxis – Traveling Salesman: Brute Force

March 12, 2010

In today’s Programming Praxis exercise we have to implement a brute-force algorithm for solving the well-known traveling salesman algorithm. The provided Scheme solution clocks in at 28 lines. Let’s see if we can come up with something a tad more compact.

A quick import or two:

import Data.List
import qualified Data.List.Key as K

In order to calculate the total distance traveled, we need to calculate the distance between two points.

dist :: Floating a => (a, a) -> (a, a) -> a
dist (x1, y1) (x2, y2) = sqrt ((x1 - x2) ** 2 + (y1 - y2) ** 2)

Calculating all possible tours is just a matter of generating all the permutations of the points, making sure to duplicate the first element of a tour at the end in order to get back home. We also add an index to the points to make the result a bit easier to read (and mainly because the Scheme solution does it too).

tours :: [b] -> [[(Int, b)]]
tours = map (\(x:xs) -> x:xs ++ [x]) . permutations . zip [0..]

Calculating the total cost of a tour is a simple matter of summing the distances between every consecutive pair of points. This function resembles the typical definition of the Fibonacci sequence, since that works in much the same way.

cost :: Floating a => [(b, (a, a))] -> a
cost xs = sum $ zipWith dist xs (tail xs)

Finally, showing the shortest path is a simple matter of generating all the tours, taking the one with the lowest cost, showing the indices of the points and getting rid of the duplicated starting point.

shortestPath :: [(Double, Double)] -> [Int]
shortestPath = init . map fst . K.minimum cost . tours

As usual, a test to see if everything is working correctly:

main :: IO ()
main = print $ shortestPath [(5, 2), (19, 13), (4, 8), (6, 32),
                             (23, 7), (57, 54), (55, 8), (70, 59)]

You’ll notice that the result is different from the Scheme solution. Specifically, it’s reversed and cycled a few positions. Since we’re walking a loop, this means that we’re walking clockwise instead of counterclockwise and starting in a different town. A trivial difference, since the route is the same and can be reversed and cycled at will. The reason is the order in which the permutations are generated.

That brings us to 4 lines total, an 85% reduction compared to the Scheme solution. That’s not half bad in my book.