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