;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*- File: search/domains/route-finding

;;;; Find a Route Between Cities on a Map

(defun route-finding-problem (&key (n-cities 10)
				   (map (random-route-map :n-cities n-cities))
				   (start (city-name (random-element map)))
				   (goal (city-name (random-element map))))
  "Create a route-finding problem, using a random map, unless you explicitly
  specify the :map argument."
  (let ((goal-city (find-city goal map)))
    (make-problem
     :initial-state  start
     :successor-fn   #'(lambda (x) (route-finding-successors x map))
     :goal-test      #'(lambda (x) (equal x goal))
     :h-cost-fn      #'(lambda (x)
			 (straight-distance (find-city x map) goal-city))
     :edge-cost-fn   #'(lambda (x y)
			 (road-distance (find-city x map) y map))
     :domain         "Route Finding"
     )))

;;; We define two data structures in this file:
;;;     city - A structure holding a name, location, and neighbors
;;;     map  - A list of cities
;;; A state in a route-finding problem is just the name of the current
;;; city.  We can use this name to lookup on a map and find a city
;;; structure, which contains the cities location (an (x y) pair) and
;;; a list of neighboring cities, and the distance along the road to
;;; each neighbor.  Be careful to distinguish between a city name and
;;; a city structure.  Note that a more complicated version of this
;;; problem would augment the state with considerations of time, gas
;;; used, wear on car, tolls to pay, etc.

(defstruct (city (:type list))
  name loc neighbors)

(defun route-finding-successors (city-name map)
  "Return a list of (action . new-state) pairs.
  In this case, the action and the new state are both the name of the city."
  (with-collection ()
   (for each pair in (city-neighbors (find-city city-name map)) do
	(collect (cons (first pair) (first pair))))))

(defun road-distance (city1 city-name2 map)
  "The distance along the road between two cities.  The first is a city 
  structure, the second just the name of the intended destination."
  (declare (ignore map))
  (cdr (assoc city-name2 (city-neighbors city1))))

(defun straight-distance (city1 city2)
  "Distance between two cities on a straight line (as the crow flies)."
  ;; We round this to the nearest integer, just to make things easier to read
  (round (xy-distance (city-loc city1) (city-loc city2))))

(defun find-city (name map)
  "Look up the city on the map, and return its information."
  (assoc name map))

(defun random-route-map (&key (n-cities 10) (width 100) (height 100)
			      (min-roads 2) (max-roads (+ min-roads 3)))
  "Return a random map with n-cities in it, and some roads between them.
  Each city is connected to between MIN-ROADS and MAX-ROADS other cities.
  The default is from 2 to 5.  The road between any two cities has a length 
  of 1 to 1.5 times the straight-line distance between them."
  ;; First build the cities
  (let ((map (with-collection ()
	      (for i = 1 to n-cities do
		   (collect
		    (make-city :name (number->name i) :neighbors nil
			       :loc (@ (random width) (random height))))))))
    ;; Now lay down the roads
    ;; CANDIDATES is all the cities that don't yet have a road to CITY
    ;; SORTED-NEIGHBORS is sorted by distance to CITY, closest first
    ;; We pick out the first 
    (for each city in map do
	 (let* ((n-roads (- (random-integer min-roads max-roads)
			    (length (city-neighbors city))))
		(candidates
		 (remove-if #'(lambda(c)
				(or (eq c city)
				    (assoc (city-name c)
					   (city-neighbors city))))
			    map))
		(sorted-neighbors
		 (sort candidates #'<
		       :key #'(lambda (city2)
				(straight-distance city city2)))))
	   (for each city2 in (subseq sorted-neighbors 0 (max n-roads 0)) do
		(build-road city city2))))
    map))

(defun build-road (city1 city2)
  "Construct a road between two cities."
  (let* ((distance (straight-distance city1 city2))
	 (road-distance (round (* (+ 1.0 (random 0.5)) distance))))
    (push (cons (city-name city1) road-distance) (city-neighbors city2))
    (push (cons (city-name city2) road-distance) (city-neighbors city1))))

(defun number->name (i)
  "Turn an integer into a symbol.  1-26 go to A-Z; beyond that use Ci"
  (if (<= 1 i 26)
      (aref '#(0 a b c d e f g h i j k l m n o p q r s t u v w x y z) i)
    (intern (format nil "C~D" i))))

;;;; The Romanian Map

(defparameter *romania-map*
  '(
    (Arad       ( 91 492) ((Zerind . 75) (Sibiu . 140) (Timisoara . 118)))
    (Bucharest	(400 327) ((Fagaras . 211) (Pitesti . 101) (Giurgiu . 90)
			   (Urziceni . 85)))
    (Craiova	(253 288) ((Dobreta . 120) (Rimnicu . 146) (Pitesti . 138)))
    (Dobreta	(165 299) ((Mehadia . 75) (Craiova . 120)))
    (Eforie	(562 293) ((Hirsova . 86)))
    (Fagaras	(305 449) ((Sibiu . 99) (Bucharest . 211)))
    (Giurgiu	(375 270) ((Bucharest . 90)))
    (Hirsova	(534 350) ((Urziceni . 98) (Eforie . 86)))
    (Iasi	(473 506) ((Neamt . 87) (Vaslui . 92)))
    (Lugoj	(165 379) ((Timisoara . 111) (Mehadia . 70)))
    (Mehadia	(168 339) ((Lugoj . 70) (Dobreta . 75)))
    (Neamt	(406 537) ((Iasi . 87)))
    (Oradea	(131 571) ((Zerind . 71) (Sibiu . 151)))
    (Pitesti	(320 368) ((Rimnicu . 97) (Craiova . 138) (Bucharest . 101)))
    (Rimnicu	(233 410) ((Sibiu . 80) (Pitesti . 97) (Craiova . 146)))
    (Sibiu	(207 457) ((Arad . 140) (Oradea . 151) (Fagaras . 99)
			   (Rimnicu . 80)))
    (Timisoara	( 94 410) ((Arad . 118) (Lugoj . 111)))
    (Urziceni	(456 350) ((Bucharest . 85) (Hirsova . 98) (Vaslui . 142)))
    (Vaslui	(509 444) ((Iasi . 92) (Urziceni . 142)))
    (Zerind	(108 531) ((Arad . 75) (Oradea . 71)))
    )
  "A representation of the map in Figure 4.2 [p 95].
  But note that the straight-line distances to Bucharest are NOT the same.")

(defun romanian-problem (&key (start 'Arad) (goal 'Bucharest))
  "Problem: Find a path between two cities in Romania."
  (route-finding-problem :start start :goal goal :map *romania-map*))

(defun random-romanian-problem ()
  "Problem: Find a path between two random cities in Romania."
  (romanian-problem :start (city-name (random-element *romania-map*))
		    :goal (city-name (random-element *romania-map*))))