Setf (?) Вызывает циклы в дереве

Question

Я реализую эволюционный алгоритм в 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))

Я пытаюсь обменять два случайных поддерева двух случайных деревьев из популяции. Но когда я делаю что-то вроде этого:

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

Иногда обнаруживается цикл, который явно не должен иметь место.

Проверка циклов в порядке, я также обнаружил циклы с помощью (трассировки). Я постоянно обновляю количество потомков.

Я думаю, что-то не так с (setf get-subtree). Я новичок в LISP и не очень хорош с расширением setf. Пожалуйста, помогите мне.

Answer 1

Подумайте, как это будет реализовано:

;; 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 чтобы точно узнать, что такое расширение в вашем случае.)

Другими словами, случайные поддеревья будут выбираться дважды (один раз при чтении и один раз при обновлении), так что вместо того, чтобы поддеревья обменивались друг с другом, ссылки на поддеревья будут скопированы в случайные места в другом дереве.

Например, на диаграмме ниже алгоритм может выбрать синее и красное поддерево для обмена. Но когда он присоединяется к ним, он помещает их в точки, отмеченные точками.

Нижняя половина диаграммы показывает результирующую структуру данных после того, как поддеревья были присоединены к новым точкам: вы можете видеть, что цикл был создан.

Поэтому вам нужно пересмотреть код, чтобы вы могли выбрать случайные поддеревья только один раз. Что-то вроде этого, возможно:

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