search.lisp

;; search.lisp

;; This environment holds the size of the environment,
;; the location of the gold and a bitmask for blocked
;; squares.
(defstruct env
  (width 5)
  (height 5)
  (gold-x-pos 0)
  (gold-y-pos 0)
  (blocked 0))  ;; Using an integer as a bit-vector

;; Defines a bunch of different environments, 
;; (width, height, gold-x, gold-y, block-pattern)
(setf *patterns*
      '( 
        (3 3 1 1 0)
        (3 3 2 2 16)
        (5 5 4 4 8726850)
        (5 5 4 4 4325508)
        (5 5 4 4 234368)
        (5 5 4 4 1376592)
        (10 10 9 9 432269679165628350070411165172394)   
       )
)

;; Select and return a random element from a list
(defun random-element (list)
  (elt list (random (length list))))

;; Generates a random element by selecting from *patterns*
(defun random-env ()
  (init-env (random-element *patterns*)))

;; Given a list of width, height, x and y location of
;; gold and a block pattern, instantiates an environment
;; and returns it.
(defun init-env (pattern)
  (make-env :width (elt pattern 0) 
            :height (elt pattern 1)
            :gold-x-pos (elt pattern 2)
            :gold-y-pos (elt pattern 3)
            :blocked (elt pattern 4)))

;; Checks if a location in an environment is blocked
;; (logbitp N M) returns T if bit N is set in the integer
;; M, nil otherwise.
(defun env-block (env x y)
  (logbitp (+ x (* y (env-width env)))
           (env-blocked env)))

;; This structure stores a state of the search. The
;; state consists of an environment and an x,y location
;; of the agent.
(defstruct state
  (env (make-env))
  (x-pos 0)
  (y-pos 0))

;; This function gives a unique number for a state, used as an id
;; to avoid exploring the same state more than once
(defun state-id (state)
  (let ((x (state-x-pos state))
        (y (state-y-pos state))
        (env (state-env state)))
    (+ x (* y (env-width env)))
  ))

;; Draws a picture of a state, for debugging
(defun print-state (state)
  (let* ((env (state-env state))
         (w (env-width env))
         (h (env-height env))
         (x (state-x-pos state))
         (y (state-y-pos state)))
    (format t "   ")
    (dotimes (j w) (format t "~4d" j))
    (format t "~%")
    (dotimes (i h)
      (format t "    ")
      (dotimes (j w) (format t "+---"))
      (format t "+~%")
      (format t "~a~4t" i)
      (dotimes (j w)
        (format t "|")
        (if (env-block env j i)
            (format t "///")
            (progn
              (if (and (= j x) (= i y))
                  (format t " A")
                  (format t "  "))
              (if (and (= j (env-gold-x-pos env))
                       (= i (env-gold-y-pos env)))
                  (format t "G")
                  (format t " ")))))
      (format t "|~%")
    )
    (format t "    ")
    (dotimes (j w) (format t "+---"))
    (format t "+~%")
  )
)

;; To see the available states, execute the following:
;; (mapcar (lambda (pattern)
;;            (print pattern)
;;            (format t "~%")
;;            (print-state (make-state :env (init-env pattern))))
;;         *patterns*)


;; This function checks a state if it is legal, i.e.
;; if the agent is in-bounds and not on a blocked square.
;; Use it in your successor generator function to filter
;; out the illegal states.
(defun is-legal (state)
  (let* ((env (state-env state))
         (w (env-width env))
         (h (env-height env))
         (x (state-x-pos state))
         (y (state-y-pos state)))
    (and (>= x 0)    ;; must stay inside boundary
         (>= y 0)
         (< x w)
         (< y h)
         (not (env-block env x y)))  ;; cannot occupy blocked sqrs
))

;; This function generates successors by moving the agent to the
;; adjacent squares. Illegal states are removed from the list before returning.
(defun successors (state)
  (let* ((env (state-env state))
         (x (state-x-pos state))
         (y (state-y-pos state)))
    (remove-if-not #'is-legal (list
           (make-state :x-pos (1- x) :y-pos y      :env env)
           (make-state :x-pos x      :y-pos (1- y) :env env)
           (make-state :x-pos (1+ x) :y-pos y      :env env)
           (make-state :x-pos x      :y-pos (1+ y) :env env)
    ))
  )
)

;; This is the goal test function, it simply tests if the agent is on
;; the same square that the gold is placed on.
(defun found-gold (state)
  (and (= (state-x-pos state)
          (env-gold-x-pos (state-env state)))
       (= (state-y-pos state)
          (env-gold-y-pos (state-env state)))
))

;; A search node. It contains a state and a reference to the parent
;; node. This way we can reconstruct the path by tracing the parent
;; links backwards.
(defstruct node
  (parent NIL)
  (depth 0)
  (state))

;; BFS adds nodes to the back of the fringe list
(defun insert-bfs (node fringe)
  (append fringe (list node)))

;; DFS adds nodes to the front of the fringe list
(defun insert-dfs (node fringe)
  (cons node fringe))

;; This function reconstructs a path from a node by tracing the parent
;; links backwards. Note that the list is constructed by prepending
;; (x y) coordinates so the final list will be in the correct order
(defun get-path (node)
  (let ((path (list (node-state node))))
    (loop while (node-parent node) do
         (setf node (node-parent node))
         (setf path (cons (node-state node) path)))
    (mapcar (lambda (s) (list (state-x-pos s) (state-y-pos s))) path)))

;; This structure stores statistics about the search and is updated as
;; the search is performed
(defstruct stats
  (expansions 0)
  (max-nodes 0)
  (current-nodes 0) ;; Helper to track the maximum number of nodes
)

;; Helper functions for maintaining the stats
(defun count-expansion (stats)
  (setf (stats-expansions stats)
        (1+ (stats-expansions stats)))
)

(defun fringe-increase (stats)
  (setf (stats-current-nodes stats)
        (1+ (stats-current-nodes stats)))
  (if (> (stats-current-nodes stats)
         (stats-max-nodes stats))
      (setf (stats-max-nodes stats)
            (stats-current-nodes stats)))
)

(defun fringe-decrease (stats)
  (setf (stats-current-nodes stats)
        (1- (stats-current-nodes stats)))
)

;; Helper function to check if a list contains a specific element
(defun list-contains (haystack needle)
  (if haystack
      (if (= needle (first haystack))
          t
          (list-contains (rest haystack) needle))
      nil
  )
)


;; This is the main search function, that applies blind search. The
;; insert function for the fringe list is parameterized, so it can
;; hadle both DFS and BFS (and possibly others). It collects
;; statistics (number of expansions, fringe list size) along the way
;; in the structure passed as stats-data.
(defun do-search (initial-state
                  goal-check
                  succ-function
                  fringe-insert
                  stats-data
                  max-depth)
  (if (funcall goal-check initial-state)
      initial-state
      (let ((fringe (funcall fringe-insert 
                             (make-node :state initial-state)
                             '()))
            (generated '())  ;; list of already generated state ids
            (n))
        (fringe-increase stats-data)
        (loop named outer do
             (if fringe
                 (progn
                   (setf n (first fringe))
                   (setf fringe (rest fringe))
                   (fringe-decrease stats-data)
                   (count-expansion stats-data)
                   (loop for s in (funcall succ-function (node-state n)) do
                        (if (funcall goal-check s)
                            (return-from outer (get-path (make-node :parent n
                                                                    :depth (1+ (node-depth n))
                                                                    :state s)))
                            (if (and (not (list-contains generated (state-id s)))
                                     (< (node-depth n) max-depth))
                                (progn
                                  (setf fringe (funcall fringe-insert
                                                        (make-node :parent n
                                                                   :depth (1+ (node-depth n))
                                                                   :state s)
                                                        
                                                        fringe))
                                  (fringe-increase stats-data)
                                  (setf generated (cons (state-id s) generated))
                                )
                            )
                        )
                   )
                 )
                 (return-from outer NIL)
             )
         )
      )
  )
)


;; Iterative deepening applies DFS, but does so with increasing max-depth until
;; a solution is found.
(defun ids (initial-state
            goal-check
            succ-function
            stats-data
            max-depth)
  (let ((result))
    (loop for depth from 0 to max-depth do
         (setf (stats-current-nodes stats) 0)
         (setf result (do-search initial-state goal-check succ-function #'insert-dfs stats-data depth))
         (if result
             (return-from ids result))
    )
  )
)


;; This function tests all algorithms for one environment
(defun test-algorithms (env)
  (let ((stats)
        (result)
        (s0 (make-state :env env)))
    (print-state s0)
    (format t "~&~6a ~5a ~5a ~8a ~6a  Path~%" "Alg" "Found" "Expns" "MaxNodes" "Length")

    (setf stats (make-stats))
    (setf result (do-search s0 #'found-gold #'successors #'insert-bfs stats 10000))
    (format t "~6a ~5a ~5d ~8d ~6d  ~a~%" "BFS" (if result "yes" "no")
                                         (stats-expansions stats)
                                         (stats-max-nodes stats)
                                         (length result)
                                         result)

    (setf stats (make-stats))
    (setf result (do-search s0 #'found-gold #'successors #'insert-dfs stats 10000))
    (format t "~6a ~5a ~5d ~8d ~6d  ~a~%" "DFS" (if result "yes" "no")
                                         (stats-expansions stats)
                                         (stats-max-nodes stats)
                                         (length result)
                                         result)

    (setf stats (make-stats))
    (setf result (ids s0 #'found-gold #'successors stats 10000))
    (format t "~6a ~5a ~5d ~8d ~6d  ~a~%" "IDS" (if result "yes" "no")
                                         (stats-expansions stats)
                                         (stats-max-nodes stats)
                                         (length result)
                                         result)

    ))

;; This maps the above function over all available environments
(defun run-tests ()
  (loop for pattern in *patterns* do
       (test-algorithms (init-env pattern))
  )
)

;;; Local Variables: ***
;;; indent-tabs-mode: NIL ***
;;; End: ***