5

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)))))
Rainer Joswig
  • 136,269
  • 10
  • 221
  • 346
turingcomplete
  • 2,128
  • 3
  • 16
  • 25
  • This is too little information. Are the `goalp` and `expand` functions destructive? Is `state` a [structure](http://www.lispworks.com/documentation/HyperSpec/Body/m_defstr.htm)? If so, are all its fields kept the same under `equalp`? – acelent Oct 30 '12 at 18:45
  • goalp and expand aren't destructive. state is a list of structs. node-state returns a state. – turingcomplete Oct 31 '12 at 03:02
  • This still seems a bit far from the bug. I suggest you trace all your functions with a problem small enough to compute quickly and big enough to replicate the problem. I can't see anything bluntly wrong with your code. I'd say that `expand` and `apply-actions` could be optimized, and I don't know if a list of tiles is the best data type for the state (are there few tiles?). But keeping the subject, if the cycle checking is affecting the found solution's depth, then probably `problem-goalp` depends on the node's depth or cost. – acelent Oct 31 '12 at 12:19
  • There would be a maximum of 8 tiles in the list, so the overhead of expand and apply actions will not be that big of a deal. – turingcomplete Oct 31 '12 at 18:44
  • The part that's driving me crazy is that every other search strategy is working except for this one. – turingcomplete Oct 31 '12 at 21:43
  • I found another post with the same problem http://stackoverflow.com/questions/12598932/how-to-store-visited-states-in-iterative-deepening-depth-limited-search?rq=1 – turingcomplete Oct 31 '12 at 23:13

1 Answers1

6

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)))))
acelent
  • 7,965
  • 21
  • 39
  • Thanks a billion, I was just experimenting with some trees and finally found an example that would trigger the bug, then I saw your post. Thanks a lot. – turingcomplete Nov 01 '12 at 01:27
  • I suppose an alternative way for cycle checking that would work with any search algorithm is to backtrack from the node up to the root, if the node appeared before on the current path, then there's a cycle. Its more generic that way and will produce correct output with any search, but its slower since it would take O(d) time where d is the depth of the node. – turingcomplete Nov 01 '12 at 04:26
  • 1
    That could be optimized by copying the current table before visiting the children. This way, the current table would contain only the nodes thus far traversed. A further optimization would be to reuse the same table, by removing the current node before returning, but that would require locks if you'd want to use the cycle detection in parallel. For a certain amount of parallelization (e.g. cores), it'll still be rather efficient, but for more than, say, 16 threads, you'd prefer not locking at all. See [Amdahl's Law](http://en.wikipedia.org/wiki/Amdahl's_law). – acelent Nov 01 '12 at 13:13