Setf (?) 트리에서 사이클을 일으키기

Question

커먼 리스프 (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 확장에별로 좋지 않다. 도와주세요.

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

(당신은 사용할 수 있습니다

는 rotatef 형태가 될 것입니다

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

이의 라인을 따라 뭔가에 매크로 확장 :

Answer 1

이 구현 될 것입니다 방법에 대해 생각 macroexpand을 사용하면 확장이 무엇인지 정확히 알 수 있습니다.)

즉, 임의의 하위 트리가 선택됩니다. 두 번 (한 번 읽는 동안 및 한 번 업데이트 할 때), 서로 바꿔주는 하위 트리가 아닌 다른 트리의 임의의 위치에 하위 트리에 대한 참조가 복사됩니다.

예를 들어 아래 다이어그램에서 알고리즘은 파란색 및 빨간색 하위 트리를 선택하여 스왑합니다. 그러나 그것들을 첨부 할 때 점으로 표시된 점에 놓습니다.

다이어그램의 하반부는 하위 트리 후 얻어진 데이터 구조의 새로운 포인트에 부착 된 나타낸다 : 한 사이클이 생성되었음을 확인할 수있다.

코드를 수정하여 무작위 하위 트리를 번만 선택하면 번만 입력하면됩니다. 아마도 이것과 같은 것 :

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