Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Iterative deepening in common lisp

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)))))
like image 639
turingcomplete Avatar asked Oct 30 '12 14:10

turingcomplete


People also ask

What is iterative deepening search example?

Example of Iterative Deepening Depth-First SearchThe goal node is R where we have to find the depth and the path to reach it. The depth from the figure is 4. In this example, we consider the tree as a finite tree, while we can consider the same procedure for the infinite tree as well.

How does iterative deepening work?

In computer science, iterative deepening search or more specifically iterative deepening depth-first search (IDS or IDDFS) is a state space/graph search strategy in which a depth-limited version of depth-first search is run repeatedly with increasing depth limits until the goal is found.

What is iterative deepening algorithm in AI?

Iterative Deepening Depth First Search(IDDFS): It is iterative in nature. It searches for the best depth in each iteration. It performs the Algorithm until it reaches the goal node. The algorithm is set to search until a certain depth and the depth keeps increasing at every iteration until it reaches the goal state.

What is the only problem with iterative deepening?

The problem with this approach is, if there is a node close to root, but not in first few subtrees explored by DFS, then DFS reaches that node very late. Also, DFS may not find shortest path to a node (in terms of number of edges).


1 Answers

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)))))
like image 180
acelent Avatar answered Sep 18 '22 01:09

acelent