Artificial intelligence 公共lisp中的迭代深化

我已经编写了一个迭代深化算法，它可以工作，除非我添加了循环检查，该算法会返回比它应该返回的更深的解。但当我不检查循环时，它确实工作正常，但需要的时间太长。有人能发现这个虫子吗

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

这是其中一个动作，除了细微的变化外，它们都是相同的

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

（取消can-slide-right-p（平铺状态）
“如果指定的磁贴可以向右滑动一个单元格，则返回T”
（出租（（一排瓷砖）
（结束（+（瓦片列瓦片）（瓦片长度瓦片））；瓦片在被撬起后结束的位置
（方向（平铺方向平铺）））
（和（等于“H”）
（或（瓷砖是鼠标瓷砖）（=瓷砖列）（=row-tile-row）（

当通向目标的第一条路径比包含相同状态的任何其他较短路径长时，带循环检测的有限深度优先搜索可能返回较长路径

设D为目标状态：

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

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

一种可能的解决方案是将哈希值设置为找到状态的最小深度。这使得该状态在一定深度或更高的深度内被称为已访问，但如果访问深度较低，则可以再次扩展该状态

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

---

这信息太少了。

goalp

和

expand

功能是否具有破坏性？

状态是否为a？如果是这样，它的所有字段在
equalp
下是否保持相同？goalp和expand没有破坏性。状态是结构的列表。节点状态返回一个状态。这似乎离bug还有点远。我建议你用一个小到足以快速计算，大到足以复制问题的问题来跟踪你的所有函数。我看不出你的代码有任何明显的错误。我想说，
expand
和
apply actions
可以优化，我不知道tile列表是否是该状态的最佳数据类型（tile是否很少？）。但保留主题，如果周期检查影响找到的解决方案的深度，则问题目标可能取决于节点的深度或成本。列表中最多有8个分片，所以扩展和应用操作的开销不会有什么大不了的。让我抓狂的是，除了这个搜索策略之外，其他所有搜索策略都在运行。多亏了10亿美元，我刚刚尝试了一些树，终于找到了一个会触发bug的示例，然后我看到了你的帖子。非常感谢。我想任何搜索算法都可以使用的循环检查的另一种方法是从节点回溯到根，如果节点以前出现在当前路径上，那么就有一个循环。这种方式更通用，任何搜索都会产生正确的输出，但速度较慢，因为它需要O（d）时间，其中d是节点的深度。这可以通过在访问子节点之前复制当前表来优化。这样，当前表将只包含迄今为止已遍历的节点。进一步的优化是重用同一个表，方法是在返回之前删除当前节点，但如果希望并行使用循环检测，则需要锁定。对于一定数量的并行化（例如内核），它仍然是相当有效的，但是对于超过16个线程，您更希望根本不锁定。看见