Setf (?) causing cycles in tree

Question

I'm implementing an evolutionary algorithm in Common Lisp (CLISP) and I have a problem.

I have a tree-like class:

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

And some methods:

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

What I'm trying to do is to swap two random subtrees of two random trees from the population. But when I do something like this:

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

Sometimes a cycle is detected, which obviously shouldn't take place.

Check-for-cycles is OK, I detected cycles with (trace) too. I keep number-of-descendants updated all the time.

I guess something is wrong with (setf get-subtree). I'm new to LISP and I'm not very good with setf expansion. Please help me.

Answer 1

Think about how this is going to be implemented:

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

The rotatef form is going to be macro-expanded into something along the lines of this:

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

(You can use macroexpand to find out exactly what the expansion is in your case.)

In other words, the random subtrees are going to be selected twice (once when reading and once when updating), so that instead of the subtrees being swapped with each other, references to the subtrees will be copied into random places in the other tree.

For example, in the diagram below, the algorithm might pick the blue and red subtrees to swap. But when it comes to attach them, it puts them at the points marked with dots.

The bottom half of the diagram shows the resulting data structure after the subtrees have been attached to the new points: you can see that a cycle has been created.

So you need to revise the code so that you can select the random subtrees just once. Something like this, perhaps:

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