【PAIP】6 Building Software Tools (その4)

6.4 A set of searching toolsの続き。

(defstruct (city (:type list)) name long lat)

(defparameter *cities*
    '((Atlanda 84.23 33.45) (Los-Angeles 118.15 34.03)
      (Boston 71.05 42.21) (Memphis 90.03 35.09)
      (Chicago 87.37 45.50) (New-York 73.58 40.47)
      (Denver 105.00 39.45) (Oklahoma-City 97.28 35.26)
      (Eugene 123.05 44.03) (Pittsburgh 79.57 40.27)
      (Flagstaff 111.41 35.13) (Quebec 71.11 46.49)
      (Grand-Jct 108.37 39.05) (Reno 119.49 39.30)
      (Houston 105.00 34.00) (San-Francisco 122.26 37.47)
      (Indianapolis 86.10 39.46) (Tampa 82.27 27.57)
      (Jacksonville 81.40 30.22) (Victoria 123.21 48.25)
      (Kansas-City 94.35 39.06) (Wilmington 77.57 34.14)))

(defun neighbors (city)
  "Find all cities within 1000 kilometers."
  (find-all-if #'(lambda (c)
     (and (not (eq c city))
   (< (air-distance c city) 1000.0)))
        *cities*))

(defun city (name)
  "Find the city with this name."
  (assoc name *cities*))
;; そうか、assocはdotted-pair対象じゃなくてもいいんだ。確認、
#+test
(assoc 'hoge '((hoge 1 2) (piyo 3 4)))

(defun trip (start dest)
  "Search for a way from the start to dest."
  (beam-search start (is dest) #'neighbors
        #'(lambda (c) (air-distance c dest))
        1))

#+test
(trip (city 'san-francisco) (city 'boston)) ; => error
;; air-distanceの定義がまだだから。


;;; Search Paths

(defstruct (path (:print-function print-path))
  state (previous nil) (cost-so-far 0) (total-cost 0))
;;
;; データ構造だけみても何だかわからん。結局どう使わ
;; れるかがそれの説明。だとするとデータ構造の詳しい
;; 定義というのはそれの使われ方も書いてあるというこ
;; とになる。するとそこには関数の定義も含まれている
;; ような。
;; state : 探索の状態空間。
;; 空路探索アプリにおいては、city構造体が入る。
;; tripで初めにできる。start引数で値を指定する。
;; path-saver内にてsuccessorsに対応させて増産。
;; previous : 今拡張しようとしている部分パス
;; cost-so-far : previousにおけるcost
;; total-cost : ゴールまでの予測


(defun trip (start dest &optional (beam-width 1))
  "Search for the best path from the start to dest."
  (beam-search
   (make-path :state start)
   (is dest :key #'path-state)
   (path-saver #'neighbors #'air-distance
        #'(lambda (c) (air-distance c dest)))
   #'path-total-cost
   beam-width))

(defconstant earth-diameter 12765.0
  "Diameter of planet earth in kilometers.")

(defun air-distance (city1 city2)
  "The great circle distance between two cities."
  (let ((d (distance (xyz-coords city1) (xyz-coords city2))))
    ;; d is the straight-line chord between the two cities.
    ;; The length of the subtending arc is given by:
    (* earth-diameter (asin (/ d 2)))))

(defun xyz-coords (city)
  "Returns the x,y,z coordinates of a point on a sphere.
  The center is (0 0 0) and the north pole is (0 0 1)."
  (let ((psi (deg->radians (city-lat city)))
 (phi (deg->radians (city-long city))))
    (list (* (cos psi) (cos phi))
   (* (cos psi) (sin phi))
   (sin psi))))

(defun distance (point1 point2)
  "The Euclidian distance between two points.
  The points are coordinates in n-dimensional space."
  (sqrt (reduce #'+ (mapcar #'(lambda (a b) (expt (- a b) 2))
       point1 point2))))

(defun deg->radians (deg)
  "Convert degrees and minutes to radians."
  (* (+ (truncate deg) (* (rem deg 1) 100/60)) pi 1/180))

(defun is (value &key (key #'identity) (test #'eql))
  "Returns a predicate that tests for a given value."
  #'(lambda (path) (funcall test value (funcall key path))))

(defun path-saver (successors cost-fn cost-left-fn)
  #'(lambda (old-path)
      (let ((old-state (path-state old-path)))
 (mapcar
  #'(lambda (new-state)
      (let ((old-cost
      (+ (path-cost-so-far old-path)
         (funcall cost-fn old-state new-state))))
        (make-path
  :state new-state
  :previous old-path
  :cost-so-far old-cost
  :total-cost (+ old-cost (funcall cost-left-fn
       new-state)))))
  (funcall successors old-state)))))

(defun print-path (path &optional (stream t) depth)
  (declare (ignore depth))
  (format stream "#"
   (path-state path) (path-total-cost path)))

(defun show-city-path (path &optional (stream t))
  "Show the length of a path, and the cities along it."
  (format stream "#"
   (path-total-cost path)
   (reverse (map-path #'city-name path)))
  (values))

(defun map-path (fn path)
  "Call fn on each state in the path, collecting results."
  (if (null path)
      nil
    (cons (funcall fn (path-state path))
   (map-path fn (path-previous path)))))

#+test
(show-city-path (trip (city 'san-francisco) (city 'boston) 1))
;; => #

#+test
(show-city-path (trip (city 'boston) (city 'san-francisco) 1))
;; => #

#+test
(show-city-path (trip (city 'boston) (city 'san-francisco) 3))
;; => #

Guessing versus Guaranteeing a Good Solutionの前まで完了。こつこつ。