;;;; mazes.lisp (in-package #:mazes) (defclass cell () ((row :initarg :row :reader cell-row) (col :initarg :col :reader cell-col) (north :initarg :north :initform nil :accessor cell-north) (south :initarg :south :initform nil :accessor cell-south) (east :initarg :east :initform nil :accessor cell-east) (west :initarg :west :initform nil :accessor cell-west) (links :initform (make-hash-table) :accessor cell-links) (neighbors-list :initform () :accessor cell-neighbors)) (:documentation "Defines a single cell in a maze")) (defmethod print-object ((obj cell) stream) (print-unreadable-object (obj stream :type t) (format stream "Cell(~a,~a)" (cell-row obj) (cell-col obj)))) (defgeneric link (cell &key &allow-other-keys) (:documentation "Links current cell with neighbor cell. If bidi (bi-directional) is true both cells are updated")) (defgeneric unlink (cell &key &allow-other-keys) (:documentation "Unlinks current cell with neighbor cell. If bidi (bi-directional) is true both cells are updated")) (defgeneric links (cell) (:documentation "Return the list of all cells connected to given cell.")) (defgeneric linked-p (cell &key) (:documentation "Returns if the current cell is linked to a given cell.")) (defgeneric neighbors (cell) (:documentation "List of cells that adjoin this cell.")) (defgeneric distances (cell) (:documentation "Caluclate distance of each cell from root cell")) (defmethod link ((current-cell cell) &key neighbor-cell (bidi t)) (setf (gethash neighbor-cell (cell-links current-cell)) t) (when (eql bidi t) (setf (gethash current-cell (cell-links neighbor-cell)) t))) (defmethod unlink ((current-cell cell) &key neighbor-cell (bidi t)) (remhash neighbor-cell (cell-links current-cell)) (when (eql bidi t) (remhash current-cell (cell-links neighbor-cell)))) (defmethod links ((current-cell cell)) (get-hash-keys (cell-links current-cell))) (defmethod linked-p ((current-cell cell) &key other-cell) (gethash other-cell (cell-links current-cell))) (defmethod neighbors ((current-cell cell)) (when (and (cell-north current-cell) (not (find (cell-north current-cell) (cell-neighbors current-cell)))) (push (cell-north current-cell) (cell-neighbors current-cell))) (when (and (cell-south current-cell) (not (find (cell-south current-cell) (cell-neighbors current-cell)))) (push (cell-south current-cell) (cell-neighbors current-cell))) (when (and (cell-east current-cell) (not (find (cell-east current-cell) (cell-neighbors current-cell)))) (push (cell-east current-cell) (cell-neighbors current-cell))) (when (and (cell-west current-cell) (not (find (cell-west current-cell) (cell-neighbors current-cell)))) (push (cell-west current-cell) (cell-neighbors current-cell))) (cell-neighbors current-cell)) (defmethod distances ((root-cell cell)) (let ((dist (make-distance root-cell)) (frontier (list root-cell)) (new-frontier ())) (loop while (not (null frontier)) do (progn (setf new-frontier ()) (dolist (c frontier) (dolist (linked (links c)) (when (not (gethash linked (cells dist))) (set-distance dist :cell linked :distance (1+ (gethash c (cells dist)))) (setf new-frontier (append (list linked) new-frontier))))) (setf frontier (copy-tree new-frontier)))) (cells dist))) ;; ;; cell constructor ;; (defun make-cell (row col) (make-instance 'cell :row row :col col)) ;; ;; Util functions ;; (defun get-hash-keys (hash-table) (loop for key being the hash-keys of hash-table collect key))