;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*- File: tsp.lisp ;;;; The Travelling Salesperson Problem (TSP) ;;; Find a tour: a path that visits every city exactly once, and returns to ;;; the starting city. The shorter the total distance, the better. This ;;; builds on the map data structure defined in route-finding.lisp. It ;;; assumes that the map is a complete graph: there is a path from every city ;;; to every other city. ;;; ;;; Note: the TSP is NP complete in the general case, but there are some good ;;; algorithms for finding approximate solutions, particularly when the ;;; triangle inequality is satisfied (that the path from A->C is always ;;; shorter than A->B->C). Many of these algorithms are based on the idea of ;;; building a minimum spanning tree, converting it into a tour, and perhaps ;;; modifying it. We don't go into that here (because we are more interested ;;; in hooking up to the general search procedures than in special-purpose ;;; algorithms), but note that our tsp-h heuristic function is a relaxed ;;; version of a minimum spanning tree. (defstructure (tsp-problem (:include problem) (:constructor create-tsp-problem)) (map nil)) (defun make-tsp-problem (&key (map (random-tsp-map)) (start (city-name (first map)))) "Constructor for TSP problems. The map must be a complete graph." (check-tsp-map? map) (create-tsp-problem :initial-state (make-tsp :visited (list start) :to-visit (remove start (mapcar #'city-name map))) :map map)) (defmethod edge-cost ((problem tsp-problem) node action state) (declare (ignore action)) (road-distance (find-city (tsp-city-name (node-state node)) (tsp-problem-map problem)) (tsp-city-name state))) (defmethod h-cost ((problem tsp-problem) state) "A lower bound on the cost is the distance to ???" (let ((to-visit (tsp-to-visit state)) (map (tsp-problem-map problem))) (+ (nearest-neighbor-distance (tsp-city-name state) to-visit map) (nearest-neighbor-distance (tsp-start state) to-visit map) (path-lower-bound to-visit map)))) (defmethod successors ((problem tsp-problem) state) "Return a list of (action . state) pairs. Actions are just the name of the city to go to. You can only go to a city you haven't visited yet, unless you've visited them all, in which case you can only go back home." (if (null (tsp-to-visit state)) (list (cons (tsp-start state) (make-tsp :to-visit nil :visited (cons (tsp-start state) (tsp-visited state))))) ;; This is similar to the method for route-finding-problem (let ((city (find-city (tsp-city-name state) (tsp-problem-map problem))) (result nil)) (for each pair in (city-neighbors city) do (let ((next (first pair))) (when (member next (tsp-to-visit state)) (push (cons next (make-tsp :visited (cons next (tsp-visited state)) :to-visit (remove next (tsp-to-visit state)))) result)))) result))) (defmethod goal-test ((problem tsp-problem) state) "The goal is to leave no unvisited cities and get back to start." (and (null (tsp-to-visit state)) (eql (tsp-city-name state) (tsp-city-name (problem-initial-state problem))))) (defstruct (tsp (:type list)) "A state for a TSP problem lists cities visited, and remaining to see." (visited nil) ; List of names of cities visited so far (to-visit nil) ; Set of names of cities left to visit ) ;;;; Auxiliary Functions (defun nearest-neighbor-distance (name candidate-names map) "Find among the CANDIDATE-NAMES of cities, the one that is closest to city NAME, and return the distance to it." (if (null candidate-names) 0 (let ((city (find-city name map)) (distance infinity)) (for each other-name in candidate-names do (unless (eq other-name name) (setf distance (min distance (road-distance city other-name))))) distance))) (defun path-lower-bound (city-names map) "Find a lower bound for a path through these cities." ;; Each city must be connected to a next one, for n-1 links for n cities. ;; A lower bound is the sum of the shortest links for each city but first. (let ((sum 0)) (for each name in (rest city-names) do (incf sum (nearest-neighbor-distance name city-names map))) sum)) (defun random-tsp-map (&key (n-cities 6)) (random-route-map :n-cities n-cities :min-roads (- n-cities 1) :max-roads (- n-cities 1))) (defun check-tsp-map? (map) (for each city in map do (when (/= (length (city-neighbors city)) (- (length map) 1)) (error "This map can't be used for a travelling salesperson problem ~ because ~A is not connected to every other city." (city-name city))))) (defun tsp-city-name (tsp-state) "The current city: the last one visited." ;; We store the cities visited in reverse order, so take the first one (first (tsp-visited tsp-state))) (defun tsp-start (tsp-state) (last1 (tsp-visited tsp-state)))