Iterative deepening in common lisp

Question

I've written an iterative deepening algorithm, it works except when I add cycle checking, the algorithm returns a deeper solution than it should. But when I don't check for cycles it does work correctly, but it takes too long. Can anyone please spot the bug?

(defun rec-depth-limited (problem node cutoff closed)

  (if (= cutoff 0)

    (if (funcall (problem-goalp problem) node)

          node)

    (if (visited-p node closed)

        nil

        (progn

          ;; when i remove the next line, it works correctly

          (setf (gethash (node-state node) closed) t)

          (loop for child in (expand node (problem-actions problem)) do

            (let ((result (rec-depth-limited problem child (1- cutoff) closed)))

                (if result

                    (return result))))))))

(defun iterative-deepening (problem)

  "Iterative deepening search"

  (let ((cutoff 0))

    (loop

      (format t "~%cut-off: ~A" cutoff)

      (let ((solution (rec-depth-limited

                             problem

                             (make-node :state (problem-state problem)) 

                             cutoff 

                             (make-hash-table :test #'equalp)))) ;solve problem up to cutoff

        (if (null  solution) 

            (incf cutoff);if solution is not found, increment the depth

            (return solution))))))

(defun visited-p (node table)

  "Checks if the state in the node was visited before by checking

if it exists in the table"

  (nth-value 1 (gethash (node-state node) table)))

Edit: here is the expand function

(defun expand (node actions)

  "Expands a node, returns a list of the new nodes"

  (remove-if #'null (apply-actions node actions)));apply all actions on all nodes

(defun apply-actions (node actions)

  "Applies all actions to a state, returns a list of new states"

  (mapcan #'(lambda (action) 

              (mapcar #'(lambda (tile) (funcall action tile node))

                     (node-state node)))

          actions))

This is one of the actions, they are all the same except for minor changes

(defun slide-right (tile node)

  "slide the tile one cell to the right. returns nil if not possible, 

  otherwise returns a node with the new state"

  (when (can-slide-right-p tile (node-state node));if can slide right

      (and visualize (format t "~%slide ~A to the right" (tile-label tile)))

      (let*  ((newstate (mapcar #'copy-tile (node-state node)));copy the current state

             (depth (node-depth node))

             (newcol (incf (tile-col (find tile newstate :test #'equalp))));update state

             (cost (1+ (node-cost node))))

        (make-node :state newstate ;create new node with the new state

                   :parent node 

                   :depth (1+ depth) 

                   :action (concatenate 'string

                                        "slide "

                                        (tile-label tile)

                                        " right" )

                   :cost cost))))

Predicates

 (defun can-slide-right-p (tile state)

  "returns T if the specified tile can be sled one cell to the right"

  (let  ((row (tile-row tile)) 

        (end (+ (tile-col tile) (tile-length tile))) ;col at which tile ends after being sled

        (orient (tile-orientation tile)))

    (and (equal orient 'H)

         (or (tile-is-mouse tile) (< end *board-w*))

         (empty-cell-p row end state))))

(defun spans-cell-p (row col tile)

  "returns T if the specified tile spans the specified cell"

  (if (equal (tile-orientation tile) 'H)

      (horizontally-spans-cell-p row col tile)

      (vertically-spans-cell-p row col tile)))

(defun horizontally-spans-cell-p (row col tile)

  "Tests if the specified horizontal tile spans the specified cell"

  (let ((tile-col (tile-col tile))

        (tile-row (tile-row tile))

        (tile-len (tile-length tile)))

    (and (= tile-row row) (>= col tile-col) (< col (+ tile-col tile-len)))))

(defun vertically-spans-cell-p (row col tile)

  "Tests if the specified vertical tile spans the specified cell"

  (let  ((tile-col (tile-col tile))

        (tile-row (tile-row tile))

        (tile-len (tile-length tile)))

    (and (= tile-col col) (>= row tile-row) (< row (+ tile-row tile-len)))))

Answer 1

A confined depth-first search with cycle detection may return a longer path when the first path that leads to the goal is longer than any other shorter path that includes the same state. Iterative Deepening search (IDS) with a lookup table a brute force approach, where the search tree is rebuilt during each iteration of increasing depth. The search was augmented by a lookup table of all positions 6 moves away from the solution. In the implementation, this was not all that different from the bi-directional search. I ran one search from the goal position for 6 moves to fill in the entries in the "lookup table." The table was implemented as the same binary search tree I used for indexing positions in the bi-directional search.

Let D be a goal state:

 A -- B -- C -- D

 \

  C -- D

With a depth limit of 2, if the top branch is visited first, B and C will be visited and saved in the hash table. When the bottom branch is visited, it won't expand past C, because it was marked as visited.

A feasible solution is to set the hash value to the minimum depth where the state was found. This presents the state known as visited for a certain depth and beyond, but it'll be possible to expand it again if visited with less depth.

 (defun visited-p (node table)

  (let ((visited-depth (gethash (node-state node) table)))

    (and visited-depth

         (>= (node-depth node) visited-depth))))

(defun set-visited (node table)

  (let ((visited-depth (gethash (node-state node) table)))

    (setf (gethash (node-state node) table)

          (if visited-depth

              (min visited-depth (node-depth node))

              (node-depth node)))))

If you are looking to learn more about Artificial Intelligence then visit this Artificial Intelligence Course which will cover topics like Euclidean distance,Pearson Correlation Coefficient,Brute Force Algorithms,traveling salesman problem,NeuroEvolution of Augmenting Topologies,Fitness Function ,Resolution Algorithm,k-nearest neighbor algorithm, Markov Model, Genetic Algorithm,deep first iterative deeping and many more.