3

Common Lisp (CLISP) で進化的アルゴリズムを実装していますが、問題があります。

私は木のようなクラスを持っています:

(defclass node ()
  ((item :initarg :item :initform nil :accessor item)
   (children :initarg :children :initform nil :accessor children)
   (number-of-descendants :initarg :descs :initform nil :accessor descs)))

そしていくつかの方法：

(defmethod copy-node ((n node))
  (make-instance
   'node
   :item (item n)
   :descs (descs n)
   :children (mapcar #'copy-node (children n))))

(defmethod get-subtree ((n node) nr)
 (gsth (children n) nr))
(defmethod (setf get-subtree) ((val node) (n node) nr)
  (setf (gsth (children n) nr) val))
(defmethod get-random-subtree ((n node))
  (gsth (children n) (random (descs n))))
(defmethod (setf get-random-subtree) ((val node) (n node))
  (setf (get-subtree n (random (descs n))) val))

(defun gsth (lst nr)    
  (let ((candidate (car lst)))
    (cond
      ((zerop nr) candidate)
      ((<= nr (descs candidate)) (gsth (children candidate) (1- nr)))
      (t (gsth (cdr lst) (- nr (descs candidate) 1))))))

(defun (setf gsth) (val lst nr)    
  (let ((candidate (car lst)))
    (cond
      ((zerop nr) (setf (car lst) val))
      ((<= nr (descs candidate))
       (setf (gsth (children candidate) (1- nr)) val))
      (t (setf (gsth (cdr lst) (- nr (descs candidate) 1)) val)))
    val))

私がやろうとしているのは、母集団から 2 つのランダム ツリーの 2 つのランダム サブツリーを交換することです。しかし、私がこのようなことをすると:

(defun stdx (population)
  (let ((n (length population))
        (npop))
    (do ((done 0 (+ done 2)))
        ((>= done n) npop)
      (push (stdx2 (copy-node (random-el population))
                   (copy-node (random-el population)))
            npop))))

(defun stdx2 (father mother)
  ;; swap subtrees
  (rotatef (get-random-subtree father)
           (get-random-subtree mother))
  (check-for-cycles father)
  (check-for-cycles mother))

サイクルが検出されることがありますが、これは明らかに発生すべきではありません。

サイクルのチェックは問題ありません。(trace) でもサイクルを検出しました。子孫の数を常に更新しています。

(setf get-subtree) に何か問題があると思います。私は LISP が初めてで、setf 展開があまり得意ではありません。私を助けてください。

4

1 に答える 1

6

これがどのように実装されるかを考えてみましょう:

;; swap subtrees
(rotatef (get-random-subtree father)
         (get-random-subtree mother))

フォームは、rotatef次の行に沿って何かにマクロ展開されます。

(let ((a (get-subtree father (random (descs father))))
      (b (get-subtree mother (random (descs mother)))))
  (setf (get-subtree father (random (descs father))) b)
  (setf (get-subtree mother (random (descs mother))) a))

(あなたmacroexpandの場合の拡張が何であるかを正確に知るために使用できます。)

つまり、ランダムなサブツリーは2 回(読み取り時に 1 回、更新時に 1 回) 選択されるため、サブツリーが互いに交換される代わりに、サブツリーへの参照が他のツリーのランダムな場所にコピーされます。

たとえば、下の図では、アルゴリズムが青と赤のサブツリーを選択して交換する場合があります。しかし、それらを取り付けるときは、ドットでマークされたポイントに配置します。

ダイアグラムの下半分は、サブツリーが新しいポイントにアタッチされた後のデータ構造を示しています。サイクルが作成されていることがわかります。

そのため、ランダム サブツリーを1 回だけ選択できるようにコードを修正する必要があります。おそらく、次のようなものです。

(let ((a (random (descs father)))
      (b (random (descs mother))))
  (rotatef (get-subtree father a)
           (get-subtree mother b)))
于 2012-12-10T18:11:43.583 に答える