如何减少 A* 搜索 8-puzzle 中的长时间执行时间
How to reduce long execution time in an A* search for 8-puzzle
我正在尝试对 Lisp 中的谜题“8-puzzle”实施启发式搜索策略 A*。
为了 运行 我的搜索我使用命令：
(运行-最佳'(0 1 2 3 4 5 6 B 7)'(0 1 2 3 4 5 6 7 B))
第一个状态是开始目标，第二个状态是最终目标。
然而，我的程序 运行ning 了很长时间。最终，我假设它会 stack-overflow。 *编辑：它不会 运行 内存不足，但它花了 30 分钟，比我的广度优先搜索时间长得多。
搜索算法代码：
;;; This is one of the example programs from the textbook:
;;;
;;; Artificial Intelligence:
;;; Structures and strategies for complex problem solving
;;;
;;; by George F. Luger and William A. Stubblefield
;;;
;;; Corrections by Christopher E. Davis (chris2d@cs.unm.edu)
;;; insert-by-weight will add new child states to an ordered list of
;;; states-to-try.
(defun insert-by-weight (children sorted-list)
(cond ((null children) sorted-list)
(t (insert (car children)
(insert-by-weight (cdr children) sorted-list)))))
(defun insert (item sorted-list)
(cond ((null sorted-list) (list item))
((< (get-weight item) (get-weight (car sorted-list)))
(cons item sorted-list))
(t (cons (car sorted-list) (insert item (cdr sorted-list))))))
;;; run-best is a simple top-level "calling" function to run best-first-search
(defun run-best (start goal)
(declare (special *goal*)
(special *open*)
(special *closed*))
(setq *goal* goal)
(setq *open* (list (build-record start nil 0 (heuristic start))))
(setq *closed* nil)
(best-first))
;;; These functions handle the creation and access of (state parent)
;;; pairs.
(defun build-record (state parent depth weight)
(list state parent depth weight))
(defun get-state (state-tuple) (nth 0 state-tuple))
(defun get-parent (state-tuple) (nth 1 state-tuple))
(defun get-depth (state-tuple) (nth 2 state-tuple))
(defun get-weight (state-tuple) (nth 3 state-tuple))
(defun retrieve-by-state (state list)
(cond ((null list) nil)
((equal state (get-state (car list))) (car list))
(t (retrieve-by-state state (cdr list)))))
;; best-first defines the actual best-first search algorithm
;;; it uses "global" open and closed lists.
(defun best-first ()
(declare (special *goal*)
(special *open*)
(special *closed*)
(special *moves*))
(print "open =") (print *open*)
(print "closed =") (print *closed*)
(cond ((null *open*) nil)
(t (let ((state (car *open*)))
(setq *closed* (cons state *closed*))
(cond ((equal (get-state state) *goal*) (reverse (build-solution *goal*)))
(t (setq *open*
(insert-by-weight
(generate-descendants (get-state state)
(1+ (get-depth state))
*moves*)
(cdr *open*)))
(best-first)))))))
;;; generate-descendants produces all the descendants of a state
(defun generate-descendants (state depth moves)
(declare (special *closed*)
(special *open*))
(cond ((null moves) nil)
(t (let ((child (funcall (car moves) state))
(rest (generate-descendants state depth (cdr moves))))
(cond ((null child) rest)
((retrieve-by-state child rest) rest)
((retrieve-by-state child *open*) rest)
((retrieve-by-state child *closed*) rest)
(t (cons (build-record child state depth
(+ depth (heuristic child)))
rest)))))))
(defun build-solution (state)
(declare (special *closed*))
(cond ((null state) nil)
(t (cons state (build-solution
(get-parent
(retrieve-by-state state *closed*)))))))
8puzzle 的启发式函数：
(defun hole (grid)
"Return integer index into GRID at which the 'hole' is located."
(position '0 grid))
(defun col (pair)
(car pair))
(defun row (pair)
(cdr pair))
(defun coords (index1)
"Transform INDEX, an integer index into the list, into an (X . Y)
coordinate pair for a 3x3 grid."
(cons (second (multiple-value-list (floor index1 3)))
(floor index1 3)))
(defun index1 (coords)
"Transform COORDS, an (X . Y) coordinate pair for a 3x3 grid, into
an integer index."
(+ (col coords)
(* 3 (row coords))))
(defun swap (a b list)
"Return a new list equivalent to LIST but with the items at indexes
A and B swapped."
(let ((new (copy-seq list)))
(setf (nth a new)
(nth b list))
(setf (nth b new)
(nth a list))
new))
(defun right1 (grid)
"Move the 'hole' on the 3x3 GRID one space to the right. If there
is no space to the right, return NIL."
(let ((hole (coords (hole grid))))
(if (= 2 (col hole))
nil
(swap (index1 hole)
(index1 (cons (1+ (col hole)) (row hole)))
grid))))
(defun left1 (grid)
"Move the 'hole' on the 3x3 GRID one space to the left. If there
is no space to the left, return NIL."
(let ((hole (coords (hole grid))))
(if (zerop (col hole))
nil
(swap (index1 hole)
(index1 (cons (1- (col hole)) (row hole)))
grid))))
(defun up (grid)
"Move the 'hole' on the 3x3 GRID one space up. If there is no space
up, return NIL."
(let ((hole (coords (hole grid))))
(if (zerop (row hole))
nil
(swap (index1 (cons (col hole) (1- (row hole))))
(index1 hole)
grid))))
(defun down (grid)
"Move the 'hole' on the 3x3 GRID one space down. If there is no
space down, return NIL."
(let ((hole (coords (hole grid))))
(if (= 2 (row hole))
nil
(swap (index1 (cons (col hole) (1+ (row hole))))
(index1 hole)
grid))))
;Moves
(setq *moves*
'(right1 left1 up down))
;heuristics for puzzle8
(defun heuristic (state)
(declare (special *goal*))
(heuristic-eval state *goal*))
(defun heuristic-eval (state goal)
(cond ((null state) 0)
((equal (car state) (car goal))
(heuristic-eval (cdr state) (cdr goal)))
(t (1+ (heuristic-eval (cdr state) (cdr goal))))))
试试 memoize 实用程序。您可以在此处找到相关问题 (How do I memoize a recursive function in Lisp?)。
Memoize 跟踪对任何记忆函数的调用，并立即 returns 任何已知（先前计算的）结果以避免重新计算它们。像你这样的递归函数的结果是惊人的。
代码中的问题：
递归。写循环以避免堆栈溢出
可能是长开放和封闭列表。打开和关闭列表可能会很长。一种操作是检查列表中是否存在具有特定状态的记录。我会使用散列-table 来记录状态，然后使用 table 检查状态是否存在。
我的代码版本
无解：
CL-USER 220 > (time (run-best '(0 1 2 3 4 5 6 7 8)
'(0 2 1 3 4 5 6 7 8)
'(right1 left1 up down)))
Timing the evaluation of (RUN-BEST (QUOTE (0 1 2 3 4 5 6 7 8))
(QUOTE (0 2 1 3 4 5 6 7 8))
(QUOTE (RIGHT1 LEFT1 UP DOWN)))
User time = 0:01:05.620
System time = 0.220
Elapsed time = 0:01:05.749
Allocation = 115386560 bytes
22397 Page faults
NO-SOLUTION
解决方案：
CL-USER 223 > (time (pprint (run-best '(2 1 5 3 4 6 0 8 7)
'(0 1 2 3 4 5 6 7 8)
'(right1 left1 up down))))
Timing the evaluation of (PPRINT (RUN-BEST (QUOTE (2 1 5 3 4 6 0 8 7))
(QUOTE (0 1 2 3 4 5 6 7 8))
(QUOTE (RIGHT1 LEFT1 UP DOWN))))
((2 1 5 3 4 6 0 8 7)
(2 1 5 0 4 6 3 8 7)
(2 1 5 4 0 6 3 8 7)
(2 0 5 4 1 6 3 8 7)
(0 2 5 4 1 6 3 8 7)
(4 2 5 0 1 6 3 8 7)
(4 2 5 1 0 6 3 8 7)
(4 2 5 1 6 0 3 8 7)
(4 2 5 1 6 7 3 8 0)
(4 2 5 1 6 7 3 0 8)
(4 2 5 1 0 7 3 6 8)
(4 2 5 1 7 0 3 6 8)
(4 2 0 1 7 5 3 6 8)
(4 0 2 1 7 5 3 6 8)
(0 4 2 1 7 5 3 6 8)
(1 4 2 0 7 5 3 6 8)
(1 4 2 3 7 5 0 6 8)
(1 4 2 3 7 5 6 0 8)
(1 4 2 3 0 5 6 7 8)
(1 0 2 3 4 5 6 7 8)
(0 1 2 3 4 5 6 7 8))
User time = 0.115
System time = 0.001
Elapsed time = 0.103
Allocation = 2439744 bytes
194 Page faults
我正在尝试对 Lisp 中的谜题“8-puzzle”实施启发式搜索策略 A*。
为了 运行 我的搜索我使用命令： (运行-最佳'(0 1 2 3 4 5 6 B 7)'(0 1 2 3 4 5 6 7 B))
第一个状态是开始目标，第二个状态是最终目标。
然而，我的程序 运行ning 了很长时间。最终，我假设它会 stack-overflow。 *编辑：它不会 运行 内存不足，但它花了 30 分钟，比我的广度优先搜索时间长得多。
搜索算法代码：
;;; This is one of the example programs from the textbook:
;;;
;;; Artificial Intelligence:
;;; Structures and strategies for complex problem solving
;;;
;;; by George F. Luger and William A. Stubblefield
;;;
;;; Corrections by Christopher E. Davis (chris2d@cs.unm.edu)
;;; insert-by-weight will add new child states to an ordered list of
;;; states-to-try.
(defun insert-by-weight (children sorted-list)
(cond ((null children) sorted-list)
(t (insert (car children)
(insert-by-weight (cdr children) sorted-list)))))
(defun insert (item sorted-list)
(cond ((null sorted-list) (list item))
((< (get-weight item) (get-weight (car sorted-list)))
(cons item sorted-list))
(t (cons (car sorted-list) (insert item (cdr sorted-list))))))
;;; run-best is a simple top-level "calling" function to run best-first-search
(defun run-best (start goal)
(declare (special *goal*)
(special *open*)
(special *closed*))
(setq *goal* goal)
(setq *open* (list (build-record start nil 0 (heuristic start))))
(setq *closed* nil)
(best-first))
;;; These functions handle the creation and access of (state parent)
;;; pairs.
(defun build-record (state parent depth weight)
(list state parent depth weight))
(defun get-state (state-tuple) (nth 0 state-tuple))
(defun get-parent (state-tuple) (nth 1 state-tuple))
(defun get-depth (state-tuple) (nth 2 state-tuple))
(defun get-weight (state-tuple) (nth 3 state-tuple))
(defun retrieve-by-state (state list)
(cond ((null list) nil)
((equal state (get-state (car list))) (car list))
(t (retrieve-by-state state (cdr list)))))
;; best-first defines the actual best-first search algorithm
;;; it uses "global" open and closed lists.
(defun best-first ()
(declare (special *goal*)
(special *open*)
(special *closed*)
(special *moves*))
(print "open =") (print *open*)
(print "closed =") (print *closed*)
(cond ((null *open*) nil)
(t (let ((state (car *open*)))
(setq *closed* (cons state *closed*))
(cond ((equal (get-state state) *goal*) (reverse (build-solution *goal*)))
(t (setq *open*
(insert-by-weight
(generate-descendants (get-state state)
(1+ (get-depth state))
*moves*)
(cdr *open*)))
(best-first)))))))
;;; generate-descendants produces all the descendants of a state
(defun generate-descendants (state depth moves)
(declare (special *closed*)
(special *open*))
(cond ((null moves) nil)
(t (let ((child (funcall (car moves) state))
(rest (generate-descendants state depth (cdr moves))))
(cond ((null child) rest)
((retrieve-by-state child rest) rest)
((retrieve-by-state child *open*) rest)
((retrieve-by-state child *closed*) rest)
(t (cons (build-record child state depth
(+ depth (heuristic child)))
rest)))))))
(defun build-solution (state)
(declare (special *closed*))
(cond ((null state) nil)
(t (cons state (build-solution
(get-parent
(retrieve-by-state state *closed*)))))))
8puzzle 的启发式函数：
(defun hole (grid)
"Return integer index into GRID at which the 'hole' is located."
(position '0 grid))
(defun col (pair)
(car pair))
(defun row (pair)
(cdr pair))
(defun coords (index1)
"Transform INDEX, an integer index into the list, into an (X . Y)
coordinate pair for a 3x3 grid."
(cons (second (multiple-value-list (floor index1 3)))
(floor index1 3)))
(defun index1 (coords)
"Transform COORDS, an (X . Y) coordinate pair for a 3x3 grid, into
an integer index."
(+ (col coords)
(* 3 (row coords))))
(defun swap (a b list)
"Return a new list equivalent to LIST but with the items at indexes
A and B swapped."
(let ((new (copy-seq list)))
(setf (nth a new)
(nth b list))
(setf (nth b new)
(nth a list))
new))
(defun right1 (grid)
"Move the 'hole' on the 3x3 GRID one space to the right. If there
is no space to the right, return NIL."
(let ((hole (coords (hole grid))))
(if (= 2 (col hole))
nil
(swap (index1 hole)
(index1 (cons (1+ (col hole)) (row hole)))
grid))))
(defun left1 (grid)
"Move the 'hole' on the 3x3 GRID one space to the left. If there
is no space to the left, return NIL."
(let ((hole (coords (hole grid))))
(if (zerop (col hole))
nil
(swap (index1 hole)
(index1 (cons (1- (col hole)) (row hole)))
grid))))
(defun up (grid)
"Move the 'hole' on the 3x3 GRID one space up. If there is no space
up, return NIL."
(let ((hole (coords (hole grid))))
(if (zerop (row hole))
nil
(swap (index1 (cons (col hole) (1- (row hole))))
(index1 hole)
grid))))
(defun down (grid)
"Move the 'hole' on the 3x3 GRID one space down. If there is no
space down, return NIL."
(let ((hole (coords (hole grid))))
(if (= 2 (row hole))
nil
(swap (index1 (cons (col hole) (1+ (row hole))))
(index1 hole)
grid))))
;Moves
(setq *moves*
'(right1 left1 up down))
;heuristics for puzzle8
(defun heuristic (state)
(declare (special *goal*))
(heuristic-eval state *goal*))
(defun heuristic-eval (state goal)
(cond ((null state) 0)
((equal (car state) (car goal))
(heuristic-eval (cdr state) (cdr goal)))
(t (1+ (heuristic-eval (cdr state) (cdr goal))))))
试试 memoize 实用程序。您可以在此处找到相关问题 (How do I memoize a recursive function in Lisp?)。 Memoize 跟踪对任何记忆函数的调用，并立即 returns 任何已知（先前计算的）结果以避免重新计算它们。像你这样的递归函数的结果是惊人的。
代码中的问题：
递归。写循环以避免堆栈溢出
可能是长开放和封闭列表。打开和关闭列表可能会很长。一种操作是检查列表中是否存在具有特定状态的记录。我会使用散列-table 来记录状态，然后使用 table 检查状态是否存在。
我的代码版本
无解：
CL-USER 220 > (time (run-best '(0 1 2 3 4 5 6 7 8)
'(0 2 1 3 4 5 6 7 8)
'(right1 left1 up down)))
Timing the evaluation of (RUN-BEST (QUOTE (0 1 2 3 4 5 6 7 8))
(QUOTE (0 2 1 3 4 5 6 7 8))
(QUOTE (RIGHT1 LEFT1 UP DOWN)))
User time = 0:01:05.620
System time = 0.220
Elapsed time = 0:01:05.749
Allocation = 115386560 bytes
22397 Page faults
NO-SOLUTION
解决方案：
CL-USER 223 > (time (pprint (run-best '(2 1 5 3 4 6 0 8 7)
'(0 1 2 3 4 5 6 7 8)
'(right1 left1 up down))))
Timing the evaluation of (PPRINT (RUN-BEST (QUOTE (2 1 5 3 4 6 0 8 7))
(QUOTE (0 1 2 3 4 5 6 7 8))
(QUOTE (RIGHT1 LEFT1 UP DOWN))))
((2 1 5 3 4 6 0 8 7)
(2 1 5 0 4 6 3 8 7)
(2 1 5 4 0 6 3 8 7)
(2 0 5 4 1 6 3 8 7)
(0 2 5 4 1 6 3 8 7)
(4 2 5 0 1 6 3 8 7)
(4 2 5 1 0 6 3 8 7)
(4 2 5 1 6 0 3 8 7)
(4 2 5 1 6 7 3 8 0)
(4 2 5 1 6 7 3 0 8)
(4 2 5 1 0 7 3 6 8)
(4 2 5 1 7 0 3 6 8)
(4 2 0 1 7 5 3 6 8)
(4 0 2 1 7 5 3 6 8)
(0 4 2 1 7 5 3 6 8)
(1 4 2 0 7 5 3 6 8)
(1 4 2 3 7 5 0 6 8)
(1 4 2 3 7 5 6 0 8)
(1 4 2 3 0 5 6 7 8)
(1 0 2 3 4 5 6 7 8)
(0 1 2 3 4 5 6 7 8))
User time = 0.115
System time = 0.001
Elapsed time = 0.103
Allocation = 2439744 bytes
194 Page faults