本文介绍了常见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)))

这是扩展功能

(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))))

谓词

(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.

让D成为目标状态:

A -- B -- C -- D
 \
  C -- D

深度限制为2,如果首先访问顶部分支,则将访问B和C并将其保存在哈希表中.访问底部分支时,它不会扩展到C,因为它被标记为已访问.

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)))))

这篇关于常见Lisp中的迭代加深的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!

06-15 19:07