Exercise 1.4.18

Circular Trees

The nconc procedure is fine when all you want is a simple cycle, but it's also possible to use direct mutation to create more elaborate structures.

* (defparameter *knot* (list 1 2 3 4 (cons nil nil)))
*KNOT*

* (setf (car (nth 4 *knot*)) (cdr *knot*))
#1=(1 2 3 4 (#1#))

* (setf (cdr (nth 4 *knot*)) (cddr *knot*))
#1=(3 4 ((1 2 . #1#) . #1#))

Now we've got a structure that branches back on itself twice.

* (defun cycle-walk (count cycle &key (turn #'car))
    (loop with place = cycle
          repeat count for elem = (car place)
          unless (consp elem) do (format t "~a " elem)
          do (setf place (if (consp elem)
                             (funcall turn elem)
                             (cdr place)))))
CYCLE-WALK

* (cycle-walk 25 *knot* :turn #'car)
1 2 3 4 2 3 4 2 3 4 2 3 4 2 3 4 2 3 4
NIL

* (cycle-walk 25 *knot* :turn #'cdr)
1 2 3 4 3 4 3 4 3 4 3 4 3 4 3 4 3 4
NIL

* (let ((dir))
    (defun switch (pair)
      (setf dir (not dir))
      (if dir
          (car pair)
          (cdr pair))))
SWITCH

* (cycle-walk 25 *knot* :turn #'switch)
1 2 3 4 3 4 2 3 4 3 4 2 3 4 3 4 2 3 4
NIL

Of course, it's possible to go further. Large, divergent "trees" that eventually cycle backwards from any number of branches at arbitrary depths. You'd build them the same way though; using some combination of nconc, setf along with car/cdr and friends.