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 state in 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)))))
A limited 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.
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 possible solution is to set the hash value to the minimum depth where the state was found. This makes 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)))))