;;; -*- 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.

(defun tsp-problem (&key (n-cities 6)
			 (map (random-route-map :n-cities n-cities
						:min-roads (- n-cities 1)
						:max-roads (- n-cities 1)))
			 (start (city-name (first map))))
  "Return a TSP problem for a given map  The map must be a complete graph."
  (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))))
  (make-problem
   :initial-state      (make-tsp
			:visited (list start)
			:to-visit (remove start (mapcar #'city-name map)))
   :successor-fn       #'(lambda (state) (tsp-successors state map))
   :goal-test          #'(lambda (state)
			   (and (null (tsp-to-visit state))
				(eql (tsp-city-name state) start)))
   :h-cost-fn          #'(lambda (state) (tsp-h state map))
   :edge-cost-fn       #'(lambda (state1 state2)
			   (road-distance (find-city (tsp-city-name state1) map)
					  (tsp-city-name state2) map))
   :domain             "tsp"
   ))

(defstruct (tsp (:type list))
  (visited nil)				; List of names of cities visited so far
  (to-visit nil)			; Set of names of cities left to visit
  )

;;;; Auxiliary Functions

(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)))

;;;; Successor and Heuristic Functions

(defun tsp-successors (state map)
  "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 to start."
  (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 based on route-finding-successors
    (let ((city (find-city (tsp-city-name state) map)))
      (with-collection ()
        (for each pair in (city-neighbors city) do
	     (let ((next (first pair)))
	       (when (member next (tsp-to-visit state))
		 (collect (cons next
				(make-tsp
				 :visited (cons next (tsp-visited state))
				 :to-visit (remove
					    next (tsp-to-visit state))))))))))))

(defun tsp-h (state map)
  "Build a minimum spanning tree with the unvisited cities, then add the
  cost of that tree to the cheapest possible cost of hooking it up to the
  tour so far.  This gives an admissible (low) estimate of the cost to go."
  (let ((to-visit (tsp-to-visit state)))
    (+ (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))))

(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)))
      (with-collection (minimize infinity min)
       (for each other-name in candidate-names do
	    (unless (eq other-name name)
	      (minimize (road-distance city other-name map))))))))

(defun path-lower-bound (city-names map)
  "Find a lower bound on what it would cost find 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 n-1 shortest links, 1 for each city except the first.
  (with-collection (sum 0 +)
   (for each name in (rest city-names) do
	(sum (nearest-neighbor-distance name city-names map)))))