;This program is a maze solving program for a 8 by 8 grid maze.
;I am using the A* algorithm to find the shortest path.
(setf maze (make-array '(8 8)
:initial-contents
'((x 0 0 0 w 0 0 w)
(0 0 0 0 w 0 0 w)
(0 0 w 0 0 0 0 0)
(0 0 w 0 0 w 0 0)
(w 0 0 0 0 w w 0)
(w 0 w w 0 0 w 0)
(w w 0 0 0 w 0 0)
(w 0 0 w w w 0 d))))
(setf g (make-array '(8 8)))
(setf h (make-array '(8 8)))
(setf f (make-array '(8 8)))
(setq count_x 0)
(setq count_y 0)
;figure out where you start in the maze
(defun search_for_start (count_x count_y)
(cond ((eq (setf value (aref maze count_x count_y)) 'x) (setq start_x count_x) (setq start_y count_y))
((and (>= count_x 0) (<= count_x 6)) (setq count_x (+ 1 count_x)) (search_for_start count_x count_y))
((= count_x 7) (setq count_y (+ 1 count_y)) (setq count_x 0) (search_for_start count_x count_y))
)
)
;figure out where the door is
(defun search_for_door (count_x count_y)
(cond ((eq (setf value (aref maze count_x count_y)) 'd) (setq door_x count_x) (setq door_y count_y))
((and (>= count_x 0) (<= count_x 6)) (setq count_x (+ 1 count_x)) (search_for_door count_x count_y))
((= count_x 7) (setq count_y (+ 1 count_y)) (setq count_x 0) (search_for_door count_x count_y))
)
)
;calculate g value
(defun calculate_g (current_square_x current_square_y)
(cond ((eq (setf value (aref maze (abs(- 1 current_square_x)) (abs(- 1 current_square_y)))) 'w)
(setf (aref g (abs(- 1 current_square_x)) (abs(- 1 current_square_y))) 'w))
((OR (< (abs(- 1 current_square_x)) 0) (< (abs(- 1 current_square_y)) 0) nil))
(T (setf (aref g (abs(- 1 current_square_x)) (abs(- 1 current_square_y))) 14))
)
(cond ((eq (setf value (aref maze (+ 1 current_square_x) (+ 1 current_square_y))) 'w)
(setf (aref g (+ 1 current_square_x) (+ 1 current_square_y)) 'w))
((OR (> (+ 1 current_square_x) 8) (> (+ 1 current_square_y) 8) nil))
(T (setf (aref g (+ 1 current_square_x) (+ 1 current_square_y)) 14))
)
(cond ((eq (setf value (aref maze (+ 1 current_square_x) current_square_y)) 'w)
(setf (aref g (+ 1 current_square_x) current_square_y) 'w))
((> (+ 1 current_square_x) 8) nil)
(t (setf (aref g (+ 1 current_square_x) current_square_y) 10))
)
(cond ((eq (setf value (aref maze (abs(- 1 current_square_x)) current_square_y)) 'w)
(setf (aref g (abs(- 1 current_square_x)) current_square_y) 'w))
((< (abs(- 1 current_square_x)) 0) nil)
(t (setf (aref g (abs(- 1 current_square_x)) current_square_y) 10))
)
(cond ((eq (setf value (aref maze current_square_x (+ 1 current_square_y))) 'w)
(setf (aref g current_square_x (+ 1 current_square_y)) 'w))
((> (+ 1 current_square_y) 8) nil)
(t (setf (aref g current_square_x (+ 1 current_square_y)) 10))
)
(cond ((eq (setf value (aref maze current_square_x (abs(- 1 current_square_y)))) 'w)
(setf (aref g current_square_x (abs(- 1 current_square_y))) 'w))
((< (abs(- 1 current_square_y)) 0) nil)
(t (setf (aref g current_square_x (abs(- 1 current_square_y))) 10))
)
(cond ((eq (setf value (aref maze (abs(- 1 current_square_x)) (+ 1 current_square_y))) 'w)
(setf (aref g (abs(- 1 current_square_x)) (+ 1 current_square_y)) 'w))
((OR (< (abs(- 1 current_square_x)) 0) (> (+ 1 current_square_y) 8) nil))
(T (setf (aref g (abs(- 1 current_square_x)) (+ 1 current_square_y)) 14))
)
(cond ((eq (setf value (aref maze (+ 1 current_square_x) (abs(- 1 current_square_y)))) 'w)
(setf (aref g (+ 1 current_square_x) (abs(- 1 current_square_y))) 'w))
((OR (> (+ 1 current_square_x) 8) (< (abs(- 1 current_square_y)) 0) nil))
(T (setf (aref g (+ 1 current_square_x) (abs(- 1 current_square_y))) 14))
)
)
;calculate h values
(defun calculate_h (current_square_x current_square_y)
(cond ((eq (setf value (aref maze (abs(- 1 current_square_x)) (abs(- 1 current_square_y)))) 'w)
(setf (aref h (abs(- 1 current_square_x)) (abs(- 1 current_square_y))) 'w))
((OR (< (abs(- 1 current_square_x)) 0) (< (abs(- 1 current_square_y)) 0) nil))
(T (setf (aref h (abs(- 1 current_square_x)) (abs(- 1 current_square_y)))
(* (+ (abs(- door_x (abs(- 1 current_square_x)))) (abs(- door_y (- 1 current_square_y)))) 10)))
)
(cond ((eq (setf value (aref maze (+ 1 current_square_x) (+ 1 current_square_y))) 'w)
(setf (aref h (+ 1 current_square_x) (+ 1 current_square_y)) 'w))
((OR (> (+ 1 current_square_x) 8) (> (+ 1 current_square_y) 8) nil))
(T (setf (aref h (+ 1 current_square_x) (+ 1 current_square_y))
(* (+ (abs(- door_x (+ 1 current_square_x))) (abs(- door_y (+ 1 current_square_y)))) 10)))
)
(cond ((eq (setf value (aref maze (+ 1 current_square_x) current_square_y)) 'w)
(setf (aref h (+ 1 current_square_x) current_square_y) 'w))
((> (+ 1 current_square_x) 8) nil)
(t (setf (aref h (+ 1 current_square_x) current_square_y)
(* (+ (abs(- door_x (+ 1 current_square_x))) (abs(- door_y current_square_y))) 10)))
)
(cond ((eq (setf value (aref maze (abs(- 1 current_square_x)) current_square_y)) 'w)
(setf (aref h (abs(- 1 current_square_x)) current_square_y) 'w))
((< (abs(- 1 current_square_x)) 0) nil)
(t (setf (aref h (abs(- 1 current_square_x)) current_square_y)
(* (+ (abs(- door_x (- 1 current_square_x))) (abs(- door_y current_square_y))) 10)))
)
(cond ((eq (setf value (aref maze current_square_x (+ 1 current_square_y))) 'w)
(setf (aref h current_square_x (+ 1 current_square_y)) 'w))
((> (+ 1 current_square_y) 8) nil)
(t (setf (aref h current_square_x (+ 1 current_square_y))
(* (+ (abs(- door_x current_square_x)) (abs(- door_y (+ 1 current_square_y)))) 10)))
)
(cond ((eq (setf value (aref maze current_square_x (abs(- 1 current_square_y)))) 'w)
(setf (aref h current_square_x (abs(- 1 current_square_y))) 'w))
((< (abs(- 1 current_square_y)) 0) nil)
(t (setf (aref h current_square_x (abs(- 1 current_square_y)))
(* (+ (abs(- door_x current_square_x)) (abs(- door_y (abs(- 1 current_square_y))))) 10)))
)
(cond ((eq (setf value (aref maze (abs(- 1 current_square_x)) (+ 1 current_square_y))) 'w)
(setf (aref h (abs(- 1 current_square_x)) (+ 1 current_square_y)) 'w))
((OR (< (abs(- 1 current_square_x)) 0) (> (+ 1 current_square_y) 8) nil))
(T (setf (aref h (abs(- 1 current_square_x)) (+ 1 current_square_y))
(* (+ (abs(- door_x (abs(- 1 current_square_x)))) (abs(- door_y (+ 1 current_square_y)))) 10)))
)
(cond ((eq (setf value (aref maze (+ 1 current_square_x) (abs(- 1 current_square_y)))) 'w)
(setf (aref h (+ 1 current_square_x) (abs(- 1 current_square_y))) 'w))
((OR (> (+ 1 current_square_x) 8) (< (abs(- 1 current_square_y)) 0) nil))
(T (setf (aref h (+ 1 current_square_x) (abs(- 1 current_square_y)))
(* (+ (abs(- door_x (+ 1 current_square_x))) (abs(- door_y (abs(- 1 current_square_y))))) 10)))
)
)
;calculate f values
(defun calculate_f (current_square_x current_square_y)
(cond ((eq (setf value (aref maze (abs(- 1 current_square_x)) (abs(- 1 current_square_y)))) 'w)
(setf (aref f (abs(- 1 current_square_x)) (abs(- 1 current_square_y))) 'w))
((OR (< (abs(- 1 current_square_x)) 0) (< (abs(- 1 current_square_y)) 0) nil))
(T (setf (aref f (abs(- 1 current_square_x)) (abs(- 1 current_square_y)))
(+ (setf value (aref g (abs(- 1 current_square_x)) (abs(- 1 current_square_y)))) (setf value (aref h (abs(- 1 current_square_x)) (abs(- 1 current_square_y)))))))
)
(cond ((eq (setf value (aref maze (+ 1 current_square_x) (+ 1 current_square_y))) 'w)
(setf (aref f (+ 1 current_square_x) (+ 1 current_square_y)) 'w))
((OR (> (+ 1 current_square_x) 8) (> (+ 1 current_square_y) 8) nil))
(T (setf (aref f (+ 1 current_square_x) (+ 1 current_square_y))
(+ (setf value (aref g (+ 1 current_square_x) (+ 1 current_square_y))) (setf value (aref h (+ 1 current_square_x) (+ 1 current_square_y))))))
)
(cond ((eq (setf value (aref maze (+ 1 current_square_x) current_square_y)) 'w)
(setf (aref f (+ 1 current_square_x) current_square_y) 'w))
((> (+ 1 current_square_x) 8) nil)
(t (setf (aref f (+ 1 current_square_x) current_square_y)
(+ (setf value (aref g (+ 1 current_square_x) current_square_y))
(setf value (aref h (+ 1 current_square_x) current_square_y)))))
)
(cond ((eq (setf value (aref maze (abs(- 1 current_square_x)) current_square_y)) 'w)
(setf (aref f (abs(- 1 current_square_x)) current_square_y) 'w))
((< (abs(- 1 current_square_x)) 0) nil)
(t (setf (aref f (abs(- 1 current_square_x)) current_square_y)
(+ (setf value (aref g (abs(- 1 current_square_x)) current_square_y))
(setf value (aref h (abs(- 1 current_square_x)) current_square_y)))))
)
(cond ((eq (setf value (aref maze current_square_x (+ 1 current_square_y))) 'w)
(setf (aref f current_square_x (+ 1 current_square_y)) 'w))
((> (+ 1 current_square_y) 8) nil)
(t (setf (aref f current_square_x (+ 1 current_square_y))
(+ (setf value (aref g current_square_x (+ 1 current_square_y)))
(setf value (aref h current_square_x (+ 1 current_square_y))))))
)
(cond ((eq (setf value (aref maze current_square_x (abs(- 1 current_square_y)))) 'w)
(setf (aref f current_square_x (abs(- 1 current_square_y))) 'w))
((< (abs(- 1 current_square_y)) 0) nil)
(t (setf (aref f current_square_x (abs(- 1 current_square_y)))
(+ (setf value (aref g current_square_x (abs(- 1 current_square_y))))
(setf value (aref h current_square_x (abs(- 1 current_square_y)))))))
)
(cond ((eq (setf value (aref maze (abs(- 1 current_square_x)) (+ 1 current_square_y))) 'w)
(setf (aref f (abs(- 1 current_square_x)) (+ 1 current_square_y)) 'w))
((OR (< (abs(- 1 current_square_x)) 0) (> (+ 1 current_square_y) 8) nil))
(T (setf (aref f (abs(- 1 current_square_x)) (+ 1 current_square_y))
(+ (setf value (aref g (abs(- 1 current_square_x)) (+ 1 current_square_y)))
(setf value (aref h (abs(- 1 current_square_x)) (+ 1 current_square_y))))))
)
(cond ((eq (setf value (aref maze (+ 1 current_square_x) (abs(- 1 current_square_y)))) 'w)
(setf (aref f (+ 1 current_square_x) (abs(- 1 current_square_y))) 'w))
((OR (> (+ 1 current_square_x) 8) (< (abs(- 1 current_square_y)) 0) nil))
(T (setf (aref f (+ 1 current_square_x) (abs(- 1 current_square_y)))
(+ (setf value (aref g (+ 1 current_square_x) (abs(- 1 current_square_y))))
(setf value (aref h (+ 1 current_square_x) (abs(- 1 current_square_y)))))))
)
)
;move to new square
(defun new_move (current_square_x current_square_y)
(setq new_square_f 10000)
(cond ((and (numberp (setf value (aref f (abs(- 1 current_square_x)) (abs(- 1 current_square_y)))))
(numberp (setf value (aref f (abs(+ 1 current_square_x)) (abs current_square_y))))
(< (setf value (aref f (abs(- 1 current_square_x)) (abs(- 1 current_square_y))))
(setf value (aref f (+ 1 current_square_x) current_square_y))))
(set 'new_square_x (abs(- 1 current_square_x)))
(set 'new_square_y (abs(- 1 current_square_y)))
(set 'new_square_f (setf value (aref f (abs(- 1 current_square_x)) (abs(- 1 current_square_y))))))
(t nil)
)
(cond ((and (numberp (setf value (aref f (abs(- 1 current_square_x)) (abs(- 1 current_square_y)))))
(numberp (setf value (aref f (abs(+ 1 current_square_x)) (abs current_square_y))))
(> (setf value (aref f (abs(- 1 current_square_x)) (abs(- 1 current_square_y))))
(setf value (aref f (+ 1 current_square_x) current_square_y))))
(set 'new_square_x (+ 1 current_square_x))
(set 'new_square_y current_square_y)
(set 'new_square_f (setf value (aref f (+ 1 current_square_x) current_square_y))))
(t nil)
)
(cond ((and (numberp (setf value (aref f (+ 1 current_square_x) (+ 1 current_square_y))))
(< (setf value (aref f (+ 1 current_square_x) (+ 1 current_square_y))) new_square_f))
(set 'new_square_x (+ 1 current_square_x))
(set 'new_square_y (+ 1 current_square_y))
(set 'new_square_f (setf value (aref f (+ 1 current_square_x) (+ 1 current_square_y))))
)
(t nil)
)
(cond ((and (numberp (setf value (aref f (+ 1 current_square_x) (abs(- 1 current_square_y)))))
(< (setf value (aref f (+ 1 current_square_x) (abs(- 1 current_square_y)))) new_square_f))
(set 'new_square_x (+ 1 current_square_x))
(set 'new_square_y (abs(- 1 current_square_y)))
(set 'new_square_f (setf value (aref f (+ 1 current_square_x) (abs(- 1 current_square_y)))))
)
(t nil)
)
(cond ((and (numberp (setf value (aref f (abs(- 1 current_square_x)) (+ 1 current_square_y))))
(< (setf value (aref f (abs(- 1 current_square_x)) (+ 1 current_square_y))) new_square_f))
(set 'new_square_x (abs(- 1 current_square_x)))
(set 'new_square_y (+ 1 current_square_y))
(set 'new_square_f (setf value (aref f (abs(- 1 current_square_x)) (+ 1 current_square_y))))
)
(t nil)
)
(cond ((and (numberp (setf value (aref f (+ 1 current_square_x) current_square_y)))
(< (setf value (aref f (+ 1 current_square_x) current_square_y)) new_square_f))
(set 'new_square_x (+ 1 current_square_x))
(set 'new_square_y current_square_y)
(set 'new_square_f (setf value (aref f (+ 1 current_square_x) current_square_y)))
)
(t nil)
)
(cond ((and (numberp (setf value (aref f current_square_x (abs(- 1 current_square_y)))))
(< (setf value (aref f current_square_x (abs(- 1 current_square_y)))) new_square_f))
(set 'new_square_x current_square_x)
(set 'new_square_y (abs(- 1 current_square_y)))
(set 'new_square_f (setf value (aref f current_square_x (abs(- 1 current_square_y)))))
)
(t nil)
)
(cond ((and (numberp (setf value (aref f current_square_x (+ 1 current_square_y))))
(< (setf value (aref f current_square_x (+ 1 current_square_y))) new_square_f))
(set 'new_square_x current_square_x)
(set 'new_square_y (+ 1 current_square_y))
(set 'new_square_f (setf value (aref f current_square_x (+ 1 current_square_y))))
)
(t nil)
)
(cond ((and (numberp (setf value (aref f (abs(- 1 current_square_x)) current_square_y)))
(< (setf value (aref f (abs(- 1 current_square_x)) current_square_y)) new_square_f))
(set 'new_square_x (abs(- 1 current_square_x)))
(set 'new_square_y current_square_y)
(set 'new_square_f (setf value (aref f (abs(- 1 current_square_x)) current_square_y)))
)
(t nil)
)
(cond ( (eq (setf value (aref maze (+ 1 current_square_x) (abs(- 1 current_square_y)))) 'd)
(set 'new_square_x (+ 1 current_square_x))
(set 'new_square_y (abs(- 1 current_square_y)))
(set 'new_square_f 'd)
)
(t nil)
)
(cond ( (eq (setf value (aref maze (+ 1 current_square_x) current_square_y)) 'd)
(set 'new_square_x (+ 1 current_square_x))
(set 'new_square_y current_square_y)
(set 'new_square_f 'd)
)
(t nil)
)
(cond ( (eq (setf value (aref maze (+ 1 current_square_x) (+ 1 current_square_y))) 'd)
(set 'new_square_x (+ 1 current_square_x))
(set 'new_square_y (+ 1 current_square_y))
(set 'new_square_f 'd)
)
(t nil)
)
(cond ( (eq (setf value (aref maze current_square_x (+ 1 current_square_y))) 'd)
(set 'new_square_x current_square_x)
(set 'new_square_y (+ 1 current_square_y))
(set 'new_square_f 'd)
)
(t nil)
)
(cond ( (eq (setf value (aref maze (abs(- 1 current_square_x)) (+ 1 current_square_y))) 'd)
(set 'new_square_x (abs(- 1 current_square_x)))
(set 'new_square_y (+ 1 current_square_y))
(set 'new_square_f 'd)
)
(t nil)
)
(cond ( (eq (setf value (aref maze (abs(- 1 current_square_x)) current_square_y)) 'd)
(set 'new_square_x (abs(- 1 current_square_x)))
(set 'new_square_y current_square_y)
(set 'new_square_f 'd)
)
(t nil)
)
(cond ( (eq (setf value (aref maze (abs(- 1 current_square_x)) (abs(- 1 current_square_y)))) 'd)
(set 'new_square_x (abs(- 1 current_square_x)))
(set 'new_square_y (abs(- 1 current_square_y)))
(set 'new_square_f 'd)
)
(t nil)
)
(cond ( (eq (setf value (aref maze current_square_x (abs(- 1 current_square_y)))) 'd)
(set 'new_square_x current_square_x)
(set 'new_square_y (abs(- 1 current_square_y)))
(set 'new_square_f 'd)
)
(t nil)
)
)
(defun solve_maze (current_square_x current_square_y)
(calculate_g current_square_x current_square_y)
(calculate_h current_square_x current_square_y)
(calculate_f current_square_x current_square_y)
(new_move current_square_x current_square_y)
(setf (aref maze current_square_x current_square_y) 0)
(setq current_square_x new_square_x)
(setq current_square_y new_square_y)
(setf (aref maze current_square_x current_square_y) 'x)
(print '------------------------- )
(print maze)
(cond ((eq new_square_f 'd) (print "Door exitted"))
(t (solve_maze current_square_x current_square_y))
)
)
(search_for_start count_x count_y)
(setq current_square_x start_x)
(setq current_square_y start_y)
(search_for_door count_x count_y)
(print maze)
(solve_maze current_square_x current_square_y)