Newer
Older
mazes / distances.lisp
(in-package #:mazes)

(defclass distances ()
  ((root :initarg :root :accessor root-cell)
   (cells :initarg :cells :initform (make-hash-table) :accessor distance-cells)
   (grid :initarg :grid :accessor distance-grid)
   (matrix :initform () :accessor distance-matrix))
  (:documentation "Keeps track of the distance of each cell from the given root cell."))

(defmethod initialize-instance :after ((d distances) &key)
  (setf (distance-matrix d) (grid-matrix (distance-grid d)))
  (setf (gethash (root-cell d) (distance-cells d)) 0))

(defgeneric set-distance (distances &key)
  (:documentation "Set the distance of the given cell from the root cell"))

(defgeneric calculate-distance (distances)
  (:documentation "Set the distance of the given cell from the root cell"))


(defmethod set-distance ((d distances) &key cell distance)
  (let ((cells (distance-cells d)))
    (setf (gethash cell cells) distance)))


(defgeneric distance-all-cells (distances)
  (:documentation "Return a list of cells with their respective distance from root"))

#|
(defmethod distance-all-cells ((d distances))
  (get-hash-keys (distance-cells d)))
|#


(defmethod calculate-distance ((d distances))
  (declare (optimize (debug 3)))
  (let* ((frontier (list (root-cell d)))
         (new-frontier ()))
    (loop while (not (null frontier)) 
      do (dolist (cell frontier)
        (setf new-frontier ())
        (dolist (linked (links cell))
          (when (not (gethash linked (distance-cells d)))
            (set-distance d :cell linked :distance (+ 1 (gethash cell (distance-cells d))))
            (setf new-frontier (append `(,linked) new-frontier)))))
         (setf frontier (copy-tree new-frontier))))
  (distance-cells d))

(defun make-distance (root grid)
  (make-instance 'distances :root root :grid grid))