14.5 ������������

�����������E�����������l���������������������������������D

(defclass block-node (node)
  ((state :initarg :state :accessor state)))

(defun init-block nil
  (setq *block-graph*
    (make-instance
        'graph
      :nodes
      (list
       (make-instance 'block-node
         :name "s1"
         :state
         '((a on table) (b on table)
           (c on table)))
       (make-instance 'block-node
         :name "s2"
         :state
         '((a on table) (b on c)
           (c on table)))
       (make-instance 'block-node
         :name "s3"
         :state
         '((a on table) (b on a)
           (c on table)))
       (make-instance 'block-node
         :name "s4"
         :state
         '((a on c) (b on table)
           (c on table)))
       (make-instance 'block-node
         :name "s5"
         :state
         '((a on b) (b on table)
           (c on table)))
       (make-instance 'block-node
         :name "s6"
         :state
         '((a on table) (b on table)
           (c on b)))
       (make-instance 'block-node
         :name "s7"
         :state
         '((a on table) (b on table)
           (c on a)))
       (make-instance 'block-node
         :name "s8"
         :state
         '((a on b) (b on c)
           (c on table)))
       (make-instance 'block-node
         :name "s9"
         :state
         '((a on table) (b on a)
           (c on b)))
       (make-instance 'block-node
         :name "s10"
         :state
         '((a on c) (b on a)
           (c on table)))
       (make-instance 'block-node
         :name "s11"
         :state
         '((a on b) (b on table)
           (c on a)))
       (make-instance 'block-node
         :name "s12"
         :state
         '((a on c) (b on table)
           (c on b)))
       (make-instance 'block-node
         :name "s13"
         :state
         '((a on table) (b on c)
           (c on a)))
       )))
  
  (put-arc *block-graph* "s1" "s2")
  (put-arc *block-graph* "s1" "s3")
  (put-arc *block-graph* "s1" "s4")
  (put-arc *block-graph* "s1" "s5")
  (put-arc *block-graph* "s1" "s6")
  (put-arc *block-graph* "s1" "s7")
  (put-arc *block-graph* "s2" "s8")
  (put-arc *block-graph* "s2" "s3")
  (put-arc *block-graph* "s3" "s9")
  (put-arc *block-graph* "s4" "s10")
  (put-arc *block-graph* "s5" "s11")
  (put-arc *block-graph* "s6" "s12")
  (put-arc *block-graph* "s6" "s7")
  (put-arc *block-graph* "s7" "s13")
  
  )

(defun block-test nil
  (init-block)
  (setq dp (find-route
            *block-graph*
            "s8" "s13" 'depth-first))
  (setq bp (find-route
            *block-graph*
            "s8" "s13" 'breadth-first))
  nil)


<cl> (block-test)
DEPTH-FIRST Search from s8 to s13:
  (s8 s2 s3 s1 s7 s13)
BREADTH-FIRST Search from s8 to s13:
  (s8 s2 s1 s7 s13)