In Chapter 9 of The Little Schemer (“and Again, and Again, and Again,…"), it starts off by querying the reader if they want caviar and how to find it in a list, and then essentially gets (from caviar and grits) into issues around the halting problem.

But a number of pages into this chapter the book queries of a particular function: “Is this function total?” and presents the following:

(define C
  (lambda (n)
    (cond
     ((one? n) 1)
     (else
      (cond
       ((even? n) (C (÷ n 2)))
       (else (C (add1 (× 3 n)))))))))

I didn’t know what C was (a number of readers probably have recognised it already, but please don’t spoil it for the others just yet).

But whether we get the point of the function or not,we can implement it in Emacs Lisp, translating from the Scheme into Emacs Lisp (defining an equivalent of even? as an Emacs Lisp evenp first) as:

;; -*- lexical-binding: t; -*-
(defun evenp (n)
  "Returns `t' if `n' is even."
  (if (= (% n 2) 0)
      t
    nil))

(defun C (n)
  "Function C from Little Schemer p.155."
  (cond
   ((= n 1)
    1)
   ((evenp n)
    (C (/ n 2)))
   (t
    (C (1+ (* 3 n))))))

And we can try running this on various numbers:

(C 1) ; 1
(C 9) ; 1
(C 108) ; 1
(C 837799) ; 1
(C 8400511) ; 1
(C 63728126) ; 1

That is, for all of these numbers it just outputs 1. Well, we can try a couple of other values:

(C 0) ; cl-prin1: (error "Lisp nesting exceeds ‘max-lisp-eval-depth’")
(C 63728127) ; cl-prin1: (error "Lisp nesting exceeds ‘max-lisp-eval-depth’")

So C fails for 0 and numbers above 63728126, with a “excessive lisp nesting”-type issue.

But since the only non-error result we’re getting is 1, we could write a much simpler function.¹

;; -*- lexical-binding: t; -*-
(defun ersatz-C (n)
  "Returns 1 if `n' is 1;
enter an infinite nesting loop
if `n' is 0 or above 63728126;
for any other integer value,
pause briefly for sake of plausibly,
and then return 1."
  (cond
   ((= n 1)
    1)
   ((= n 0)
    (ersatz-C n))
   ((> n 63728126)
    (ersatz-C n))
   (t (progn
        (sleep-for 0.005)
        1))))

But obviously function C is doing something more interesting. So, let’s make it actually show us what it’s doing:

;; -*- lexical-binding: t; -*-
(defun C-verbose (n &optional count)
  "For a number `n', return `1' if it's `1'; otherwise,
if it's even, run the same function on half of `n';
else, run the same function on one more than three times
`n'."
  (let ((count (or count 0)))
    (print (format "Step %s: %s" count n))
    (setq count (1+ count))
    (cond
     ((= n 1)
      1)
     ((evenp n)
      (C-verbose (/ n 2) count))
     (t
      (C-verbose (1+ (* 3 n)) count)))))

(C-verbose 7) ; =
;; "Step 0: 7"
;; "Step 1: 22"
;; "Step 2: 11"
;; "Step 3: 34"
;; "Step 4: 17"
;; "Step 5: 52"
;; "Step 6: 26"
;; "Step 7: 13"
;; "Step 8: 40"
;; "Step 9: 20"
;; "Step 10: 10"
;; "Step 11: 5"
;; "Step 12: 16"
;; "Step 13: 8"
;; "Step 14: 4"
;; "Step 15: 2"
;; "Step 16: 1"

(C-verbose 9) ; =
;; "Step 0: 9"
;; "Step 1: 28"
;; "Step 2: 14"
;; "Step 3: 7"
;; "Step 4: 22"
;; "Step 5: 11"
;; "Step 6: 34"
;; "Step 7: 17"
;; "Step 8: 52"
;; "Step 9: 26"
;; "Step 10: 13"
;; "Step 11: 40"
;; "Step 12: 20"
;; "Step 13: 10"
;; "Step 14: 5"
;; "Step 15: 16"
;; "Step 16: 8"
;; "Step 17: 4"
;; "Step 18: 2"
;; "Step 19: 1"

Perhaps not surprisingly, we see that setting n=9 makes the function take more steps to reach 1 than setting n=7. But it’s not actually a direct linear relation, because if we set n=10, it’s a much shorter path:

(C-verbose 10) ; =
;; "Step 0: 10"
;; "Step 1: 5"
;; "Step 2: 16"
;; "Step 3: 8"
;; "Step 4: 4"
;; "Step 5: 2"
;; "Step 6: 1"

So we might still wonder about exactly what’s going on with function C, how it works, and what’s the point of it anyway.

Conjectures about simple arithmetic operations and integer pathways

The Little Schemer does give a clue about what C is, referring to the question of whether it’s a total function or not:

It doesn’t yield a value for 0, but otherwise nobody knows. Thank you, Lothar Collatz (1910–1990).

A bit of research and we can find quite a bit about C: it turns out to be the Collatz conjecture: one of the most famous unsolved problems in mathematics.

The Wikipedia page on the Collatz conjecture is useful here in laying out basics. As well, Eric Roosendaal‘s “On the 3x + 1 problem”. And Quantamagazine’s “The Simple Math Problem We Still Can’t Solve” presents a fairly accessible overview, including recent developments.

There’s some very interesting visualisations of the Collatz Functions paths as a Collatz tree, which is a rather aesthetically-appealling visual object. Here’s Algoritmarte’s 3D live render, based on a discussion from the Numberphile channel (for Numberphile’s original video, done by hand, see the fn):²

But Collatz conjecture is an unsolved problem that looks like it should certainly be solvable. It seems quite trivial in some sense: inductive logic would seem to suggest that the same basic patterns would repeat, even if there are more of them, or they are longer, given that every number that’s been tested has converged to 1 (or, more precisely, fallen into the “4-2-1” loop) and so this tempts people in trying to solve it. But Paul Erdős said of it “Mathematics may not be ready for such problems”.³

Well, we’ll not try to solve it, but rather use it for thinking about issues of recursion and long calculations in Emacs Lisp, and doing some practical engineering-type testing of different methods of dealing with such functions.

One thing we might note, as a sort of aside, is that The Little Schemer‘s C isn’t properly the Collatz function. The conjecture is really about whether the process will ever reach the repeating “4-2-1” loop, because the process of dividing even numbers by 2 and multiple odd numbers and adding 1 to them would actually mean that once we’ve reached 1, we need to multiple it by 3 and add 1, which means we’re back at 4, which is even, so we’ll divide by 2 and get 2, which is even, so we divide by 2 and get 1, which is odd, so we…. And so on.

We can write this “real Collatz” function:

;; -*- lexical-binding: t; -*-
(defun real-collatz (n)
  "For an integer `n', if it's evan, divide it by 2;
if it's odd, multiple it by 3 and add 1."
  (cond
   ((evenp n)
    (real-collatz (/ n 2)))
   (t (real-collatz (1+ (* n 3))))))

If we now try to feed it 9, we’ll hit the lisp-nesting error, but if we turn on toggle-debug-on-error, we can inspect what’s going on, and it’s exactly the “4-2-1” loop we predicted:

(real-collatz 9) ; cl-prin1: (error "Lisp nesting exceeds ‘max-lisp-eval-depth’")

;; DEBUG:
....
  real-collatz(1)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(2)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(4)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(1)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(2)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(4)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(1)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(2)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(4)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(1)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(2)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(4)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(1)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(2)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(4)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(1)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(2)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(4)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(1)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(2)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(4)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(8)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(16)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(5)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(10)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(20)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(40)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(13)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(26)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(52)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(17)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(34)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(11)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(22)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(7)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(14)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(28)
  (cond ((evenp n) (real-collatz (/ n 2))) (t (real-collatz (1+ (* n 3)))))
  real-collatz(9)
  eval((real-collatz 9) nil)
  elisp--eval-last-sexp(nil)
.....

We’ll make use of it later on though, somewhat (essentially with the n=1 condition displaced.)

Dealing with long winding paths, through hailstorms

Ok, so two things. One, let’s not just print things (longer paths are going to make his quite messy), but return a list of the steps our function goes through and a count of them. We do still want to be able to inspect the path patterns. (Wikipedia notes on this “[t]he sequence of numbers involved [in the paths] is sometimes referred to as the hailstone sequence, hailstone numbers or hailstone numerals (because the values are usually subject to multiple descents and ascents like hailstones in a cloud)".)

And, two, let’s use the cl-labels trick from last time to get tail-call optimisation in Emacs.

(And a minor thing: not bother with a separate evenp function; just use the calculation directly.)

;; -*- lexical-binding: t; -*-
(defun collatz-cllabels-tco (n)
  "Calculates the 'Collatz path' for `n',
return a list of all of the steps cons'ed
with count of the steps in the path.

[Uses `cl-labels' to get tail-call optimisation.]"
  (cl-labels ((collatz* (n r)
                  (setq r (cons n r))
                  (cond
                     ((= n 1)
                      r)
                     ((= (% n 2) 0)
                        (collatz* (/ n 2) r))
                     (t
                        (collatz* (1+ (* 3 n)) r)))))
    (let* ((clst (collatz* n nil))
          (clngth (1- (length clst))))
      (cons (nreverse clst) clngth))))

Here you will note that we’ve got our collatz* function (defined in cl-labels) being self-recursive only properly in tail positions, so it can be tail-call optimised. We start by calling collatz* with arguments n (whatever value we passed for n) and nil, with collatz* taking two arguments, n and r and setting r to the cons of n with r (we’ll pass this value on, collecting the steps), and then implementing the rest of the Collatz function in the same way as previously, except passing along the r value as our collector. At the end, we’ll count the steps and cons the list of the steps themselves, using nreverse to flip the list over (because it’ll have the last results on the “outer” left and the first results on the “inner” right), with the step count.

Some examples:

(collatz-cllabels-tco 9) ; ((9 28 14 7 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1) . 20)
                ; path from 9 to 1; 20 steps

(collatz-cllabels-tco 21) ; ((21 64 32 16 8 4 2 1) . 8)
                 ; path from 21 to 1; 8 steps

Excellent, but what about “63728127”?:— the number that tripped us up before:

;; -*- lexical-binding: t; -*-

(collatz-cllabels-tco 63728127) ; it works!

;; ...but the result is quite long, you can try it yourself;
;; use setq to be able to see all of it, e.g.,
;; (setq c-result (collatz-cllabels-tco 63728127)).

;; for, let's just see how many steps it is:
(defun collatz-return-steps (n)
  "Output just the number of steps that
`n' takes to reach 1."
  (format "%s takes %s steps to reach 1"
          n
          (cdr
           (collatz-cllabels-tco n))))


(collatz-return-steps 63728127) ; =
"63728127 takes 949 steps to reach 1"

“Let’s try it with a bigger number!", you say. Well, we can try it on most-positive-fixnum (which is I think probably set to 2305843009213693951 by default) — but remember the size of the number and the number of steps is not a direct linear relation, so you might be disappointed:

(collatz-return-steps most-positive-fixnum) ; =
"2305843009213693951 takes 860 steps to reach 1"

This is less than for 63728127.

Ok, so let’s make something really big then. 2^1000 + 1.

(collatz-return-steps (1+ (expt 2 1000))) ; =
"10715086071862673209484250490600018105614048117055336074437503883703510511249361224931983788156958581275946729175531468251871452856923140435984577574698574803934567774824230985421074605062371141877954182153046474983581941267398767559165543946077062914571196477686542167660429831652624386837205668069377 takes 7248 steps to reach 1"

It takes 7,248 steps. What about 2^10000 + 1?

(collatz-return-steps (1+ (expt 2 10000))) ; =
"19950631168807583848837421626835850838234968318861924548520089498529438830221946631919961684036194597899331129423209124271556491349413781117593785932096323957855730046793794526765246551266059895520550086918193311542508608460618104685509074866089624888090489894838009253941633257850621568309473902556912388065225096643874441046759871626985453222868538161694315775629640762836880760732228535091641476183956381458969463899410840960536267821064621427333394036525565649530603142680234969400335934316651459297773279665775606172582031407994198179607378245683762280037302885487251900834464581454650557929601414833921615734588139257095379769119277800826957735674444123062018757836325502728323789270710373802866393031428133241401624195671690574061419654342324638801248856147305207431992259611796250130992860241708340807605932320161268492288496255841312844061536738951487114256315111089745514203313820202931640957596464756010405845841566072044962867016515061920631004186422275908670900574606417856951911456055068251250406007519842261898059237118054444788072906395242548339221982707404473162376760846613033778706039803413197133493654622700563169937455508241780972810983291314403571877524768509857276937926433221599399876886660808368837838027643282775172273657572744784112294389733810861607423253291974813120197604178281965697475898164531258434135959862784130128185406283476649088690521047580882615823961985770122407044330583075869039319604603404973156583208672105913300903752823415539745394397715257455290510212310947321610753474825740775273986348298498340756937955646638621874569499279016572103701364433135817214311791398222983845847334440270964182851005072927748364550578634501100852987812389473928699540834346158807043959118985815145779177143619698728131459483783202081474982171858011389071228250905826817436220577475921417653715687725614904582904992461028630081535583308130101987675856234343538955409175623400844887526162643568648833519463720377293240094456246923254350400678027273837755376406726898636241037491410966718557050759098100246789880178271925953381282421954028302759408448955014676668389697996886241636313376393903373455801407636741877711055384225739499110186468219696581651485130494222369947714763069155468217682876200362777257723781365331611196811280792669481887201298643660768551639860534602297871557517947385246369446923087894265948217008051120322365496288169035739121368338393591756418733850510970271613915439590991598154654417336311656936031122249937969999226781732358023111862644575299135758175008199839236284615249881088960232244362173771618086357015468484058622329792853875623486556440536962622018963571028812361567512543338303270029097668650568557157505516727518899194129711337690149916181315171544007728650573189557450920330185304847113818315407324053319038462084036421763703911550639789000742853672196280903477974533320468368795868580237952218629120080742819551317948157624448298518461509704888027274721574688131594750409732115080498190455803416826949787141316063210686391511681774304792596709377 takes 72378 steps to reach 1"

72,378 steps.

Can we go one bigger?

(collatz-return-steps (1+ (expt 2 100000)))
;; Debugger entered--Lisp error: (overflow-error)

No. But it’s because Emacs has maximum-integer-width set to 65536 (so a number can only be 65,536 digits long). We can set it to something bigger, and it’ll work.

(let ((integer-width 99999999))
  (collatz-return-steps (1+ (expt 2 100000)))) ; =

;; I'll spare you the number `n' itself as it's realy quite long,
;; but that number takes 717,858 steps to reach 1.

You’ll note, if you’ve been evaluating along in your own Emacs that these results have been nearly instantaneous so far. This one takes a bit longer.

(I subsequently tried doing collatz-cllabels-tco on 2^1000000 + 1, but with only 16Gb in my machine, Linux’s OOM-killer killed Emacs before it reached the end. I should probably try setting up some sort of swap better.)

Streaming though the hail

We can also try the stream package we looked at before, which creates “lazy” conses, of potentially infinite sequences, which can be evaluated one piece at a time, as needed.

(defun collatz-stream (n)
  "For a number `n', return `1' if it's `1'; otherwise,
if it's even, run the same function on half of `n';
else, run the same function on one more than three times
`n'.
(Also, collect each step into a list and, when `n' is `1',
print the list.)
[Uses the `stream' package for lazy-evaluated conses.]"
  (cl-labels ((collatz* (n)
                (stream-cons n
                             ;; note that this is the `real' collatz func
                             ;; no checking for 1 here; we do it below
                              (cond
                               ((= (% n 2) 0)
                                (collatz* (/ n 2)))
                               (t (collatz* (1+ (* 3 n))))))))
    (let ((clst (collatz* n))
          (last 0)
          (out nil))
      (while (not (= last 1)) ;; stop when we reach 1
        (setq last (stream-pop clst))
        (setq out (cons last out)))
      (let* ((steps (1- (length out)))
            (rlist (nreverse out)))
        (cons rlist steps)))))

This, however, turns out to in fact be much slower than our cl-labels tco recursion.

In fact, we can quantify this a bit further using Adam Porter‘s bench-multi macro:

(bench-multi
  :times 5
  :forms (("collatz-stream" (let ((integer-width 99999999))
            (collatz-stream (1+ (expt 2 10000)))))
          ("collatz-cllabels-tco" (let ((integer-width 99999999))
            (collatz-cllabels-tco (1+ (expt 2 10000)))))))

Here the forms are ranked in order by fastest first; the second column says how much slower the form is compared against the fastest; then there are total runtime (for all iterations; we did here 5 for each); and total garbage collections performed by Emacs during those tests; and the total amount of time the garbage collection tasks themselves took.

I’m not quite sure why collatz-stream is this much slower than collatz-cllabels-tco is the case. My guess is that because of the delayed/lazy evaluation, we aren’t able to get real reduction of stack frames because we’re only evaluating one piece/instance of the Collatz function on each stream-pop, and there’s no advantage to using cl-labels here really.

The stream method certainly triggers more garbage collection, which is part of it, though I’m not entirely sure why it should involve triggering more garbage collection. (I suppose we could play with garbage collection settings in emacs and see if we can deal garbage collection and make the stream method better.)

Caught in loops still?

But what about a plain looping method for the Collatz function. We generally saw with the Fibonacci series that loops seemed more efficient.

We can try with both plain while loops and also cl-loops:

(defun collatz-while-loop (n)
  "Collatz function using emacs `while' loop."
  (let ((m n)
        (clst (list n)))
    (while (not (= m 1))
      (setq m
            (cond
             ((= (% m 2) 0)
              (/ m 2))
             (t (1+ (* 3 m)))))
      (setq clst (cons m clst)))
          (let* ((steps (1- (length clst)))
            (rlist (nreverse clst)))
            (cons rlist steps))))

(defun collatz-cl-loop (n)
  "Collatz function using `cl-loop' with
`while' clause condition."
  (let ((m n)
        (clst (list n)))
    (cl-loop while (not (= m 1))
             do (progn
                  (setq m
                        (cond
                         ((= (% m 2) 0)
                          (/ m 2))
                         (t (1+ (* 3 m)))))
                  (setq clst (cons m clst)))
             (let* ((steps (1- (length clst)))
                    (rlist (nreverse clst)))
               (cons rlist steps))))

And now comparing all of the methods:

(bench-multi
  :times 5
  :forms (("collatz-stream"
           (let ((integer-width 99999999))
             (collatz-stream (1+ (expt 2 10000)))))
          ("collatz-cllabels-tco"
           (let ((integer-width 99999999))
             (collatz-cllabels-tco (1+ (expt 2 10000)))))
          ("collatz-while-loop"
           (let ((integer-width 99999999))
             (collatz-while-loop (1+ (expt 2 10000)))))
          ("collatz-cl-loop"
           (let ((integer-width 99999999))
             (collatz-cl-loop (1+ (expt 2 10000)))))))

We find the following results:

Both types of loops turn out faster than even collatz-cllabels-tco, with the plain emacs while loop method seeming slightly faster than the cl-loop method, but probably within margin of error (or maybe just a bit of extra machine in cl-loop which loses a small amount of efficiency.)

For our TCO tail-recurive cll maybe it’s the additional garbage collection that slows down collatz-cllabels-tco.

What if we just look at the two loop methods, and run more trials?

(bench-multi
  :times 100
  :forms (("collatz-while-loop"
           (let ((integer-width 99999999))
             (collatz-while-loop (1+ (expt 2 10000)))))
          ("collatz-cl-loop"
           (let ((integer-width 99999999))
             (collatz-cl-loop (1+ (expt 2 10000)))))))

Our results are:

Still the plain while is slightly faster than cl-loop.

An attempt at promoting our recursive tco function

I’d really like to somehow improve our recursive TCO collatz function.

What if we pull the collector r out in a higher-scoping let and so don’t have to pass it into collatz* each time; thus:

(defun collatz-cllabels-tco-improved (n)
  "Calculates the 'Collatz path' for `n',
return a list of all of the steps cons'ed
with count of the steps in the path.

[Uses `cl-labels' to get tail-call optimisation.]"
  (let ((r nil))
    (cl-labels ((collatz* (n)
                    (setq r (cons n r))
                    (cond
                       ((= n 1)
                        r)
                       ((= (% n 2) 0)
                          (collatz* (/ n 2)))
                       (t
                          (collatz* (1+ (* 3 n)))))))
      (let* ((clst (collatz* n))
            (clngth (length clst)))
        (cons (nreverse clst) clngth)))))

(bench-multi
  :times 10
  :forms (("collatz-cllabels-tco"
           (let ((integer-width 99999999))
             (collatz-cllabels-tco (1+ (expt 2 10000)))))
          ("collatz-cllabels-tco-improved"
           (let ((integer-width 99999999))
             (collatz-cllabels-tco-improved (1+ (expt 2 10000)))))))

Here are the results:

We do seem to eke out a bit more performance.

But compared to the loops, it’s still not as performant:

(bench-multi
  :times 10
  :forms (("collatz-cllabels-tco"
           (let ((integer-width 99999999))
             (collatz-cllabels-tco (1+ (expt 2 10000)))))
          ("collatz-cllabels-tco-improved"
           (let ((integer-width 99999999))
             (collatz-cllabels-tco-improved (1+ (expt 2 10000)))))
          ("collatz-while-loop"
           (let ((integer-width 99999999))
             (collatz-while-loop (1+ (expt 2 10000)))))
          ("collatz-cl-loop"
           (let ((integer-width 99999999))
             (collatz-cl-loop (1+ (expt 2 10000)))))))

We seem to have done a bit better. Now collatz-cllabels-tco-improved is only 1.26x slower than the fastest, collatz-while-loop. We save an extra gc over the older collatz-cllabels-tco, but still have to run an additional one compared to the two loop functions.

Putting all of the methods we’ve come up with together and running more trials:

(bench-multi
  :times 100
  :forms (("collatz-stream"
           (let ((integer-width 99999999))
             (collatz-stream (1+ (expt 2 10000)))))
          ("collatz-cllabels-tco"
           (let ((integer-width 99999999))
             (collatz-cllabels-tco (1+ (expt 2 10000)))))
          ("collatz-cllabels-tco-improved"
           (let ((integer-width 99999999))
             (collatz-cllabels-tco-improved (1+ (expt 2 10000)))))
          ("collatz-while-loop"
           (let ((integer-width 99999999))
             (collatz-while-loop (1+ (expt 2 10000)))))
          ("collatz-cl-loop"
           (let ((integer-width 99999999))
             (collatz-cl-loop (1+ (expt 2 10000)))))))

Here, interestingly, we end up with collatz-cl-loop slightly edging out collatz-while-loop. And our favourite (well, my favourite) collatz-cllabels-tco-improved function doesn’t do too poorly: it’s only x1.28 slower than the fastest (collatz-cl-loop); and even the old collatz-cllabels-tco with additional argument passing is only x1.53 slower

The collatz-stream function remains significantly slower, x19 so.

There is an obvious correlation between runtime and garbage collection, (19 vs 20 vs 33 vs 47 vs 961), so again possibly tweaking garbage collection could change things. Although, if we get rid of the garbage collection runtime differences we end up with:

Now collatz-while-loop is again indeed actually the fastest, but still just barely more so than collatz-cl-loop; both recursive TCO’ing cl-labels aren’t actually too much slower than the loops, though the improved version is indeed better; and collatz-stream is still quite slow in comparison. So garbage collection is part of the difference, but not the only one, especially for the streams method.

Escaping (at least some) loops: out of recursion and into… different recursion (next time)

This was really an excursus (on an excursus). And, next time — really — we’ll deal with the Y Combinator. I know this one really wasn’t a lambda calculus post at all, but an excursion on our previous excursion into recursion, here mostly practical considerations for Emacs. But recursion is crucial for the upcoming discussion of the Y Combinator, and paradoxes (and their uses). And that’ll be interesting for lambda calculus, and its connections with Lisp.

And, after we’re through with Y Combinators and Fibonacci sequences and barbers who shave everyone who does’t shave themselves, and how these things all tie together, we can get to something I’ve been working on for a while:— given that, connections aside, Lisp isn’t lambda calculus: can we come up with a good implementation of lambda calculus in Lisp?

(And specifically in Emacs Lisp: which is maybe one of the Lisps least naturally suited for this: a Scheme or Clojure would be a better choice really. But it’s more fun to try to get it to work in Elisp, with all of the additional challenges it presents.)

A couple of excerpts from previous quotes from McCarthy on the subject to set the stage:

…And so, the way in which to [be able to handle function passing/higher order functions] was to borrow from Church’s Lambda Calculus, to borrow the lambda definition. Now, having borrowed this notation, one the myths concerning LISP that people think up or invent for themselves becomes apparent, and that is that LISP is somehow a realization of the lambda calculus, or that was the intention. The truth is that I didn’t understand the lambda calculus, really. In particular, I didn’t understand that you really could do conditional expressions in recursion in some sense in the pure lambda calculus.…

[McCarthy 1978a:190¹]

…Writing eval required inventing a notation representing LISP functions as LISP data, and such a notation was devised for the purposes of the paper with no thought that it would be used to express LISP programs in practice. Logical completeness required that the notation used to express functions used as functional arguments be extended to provide for recursive functions, and the LABEL notation was invented by Nathaniel Rochester for that purpose. D.M.R. Park pointed out that LABEL was logically unnecessary since the result could be achieved using only LAMBDA — by a construction analogous to Church’s Y-operator, albeit in a more complicated way.…

[McCarthy 1978a:179¹]

Examining Church’s Y Combinator will be something we return to (probably in a number of posts), but I’ll defer discussion of it for the moment.

For now, let’s consider recursion in lisps. We’ll be talking a lot of recursion in Emacs Lisp today in fact.

Self-reference, self-embedding

Recursion is a concept or process depends on a simpler or previous version of itself. It’s ubiquitous, including in the natural world: Wikipedia notes that “Shapes that seem to have been created by recursive processes sometimes appear in plants and animals, such as in branching structures in which one large part branches out into two or more similar smaller parts. One example is Romanesco broccoli.”

Recursion is a thing I deal with a lot in my day job, as it is a feature of natural language, especially syntax and semantics. To provide a quick illustration — though this is not at all how modern generative syntax is done anymore — consider phrase structure grammar and phrase structure rules used by Noam Chomsky and his colleagues in the 1950s.

Sentences (and linguistics objects generally) have formal structure, and it is part of the productive/creative nature of language that we might envision this structure as involving abstract structure rules that can be expanded in different ways (and then have vocabulary filled in).

A phrase structure rule will generally have the form A → [B C], indicating that A may be rewritten or expanded into [B C]. (In the following, I’ll use round brackets ()'s to denote optional constituents.)

So, a subset of these rules for English might include something like (note that some things have multiple rules that can apply to them):

1. S → NP VP
2. NP → (Det) N
3. N → (AdjP)* N
4. VP → V
5. VP → V NP (NP)
6. VP → V CP
7. CP → (Comp) S
...

(Where S is “sentence”; Det is a determiner (like “the”, “a”); NP is a noun phrase; Nₙ is a noun head; AdjP is an adjective phrase; VP is a verb phrase; V is a verb head; CP is a complementiser phrase; Comp is a complementiser (like “that”).)

So we can rewrite S as NP VP (1) and then rewrite NP VP as Det N VP (2, choosing an optional Det) and then Det N VP as Det N V (4) and then insert lexical items of the appropriate category into the ‘heads’ (the non-P elements). So we might choose “the” for Det and “cat” for N and “purrs” for V, and get the sentence “the cat purrs”.

But note that some of the rules allow for expansion into elements that contain expansions back into themselves. So rule (1) allows an S to exapnd into NP VP and rule (6) allows for a VP to expand into V CP and rule (7) allows for a CP to expand into an S. At which point we can apply rule (1) again to expand the new S into NP VP, and then repeat this process as many times as we like:

S
NP VP
N VP
N V CP
N V Comp S
N V Comp NP VP
N V Comp N VP
N V Comp N V CP
N V Comp N V Comp S
N V Comp N V Comp NP VP
N V Comp N V Comp N VP
N V Comp N V Comp N V CP
N V Comp N V Comp N V Comp S
N V Comp N V Comp N V Comp NP VP
N V Comp N V Comp N V Comp N VP
N V Comp N V Comp N V Comp N V CP
N V Comp N V Comp N V Comp N V Comp S
N V Comp N V Comp N V Comp N V Comp NP VP
...

And it’s easy to imagine examples of what such a sentence could be like, e.g., “John said that Sita said that Bill said that Mary said that Ram said that Kim said that…". It won’t be infinitely long, but there’s no particular theoretical bound on how long it could be (memory processing and finite human lifespans will impose practical limits, of course).

On the formal semantics side, things are similar: consider that logical languages too (which are often used to formalise natural language semantics) allow for recursion. Propositional logic construction with Boolean operators too have no theoretical upper limits: we can write (t ↔ (p ∧ (q ∨ (r → (s ∧ ¬¬¬¬¬¬t))))),² and there’s nothing which prevents composing this bit of formalism with yet another bit, and so on.

And in mathematics and computer science, recursion is often a thing which suggests itself.

For instance, though there are other ways of calculating it, the Fibonacci sequence³, i.e., a sequence of numbers in which each element is the sum of the two elements that precede it (e.g. 0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144…).

A natural way of writing an equation to calculate these is something like:

1. Fib(0) = 0 as base case 1.
2. Fib(1) = 1 as base case 2.
3. For all integers n > 1, Fib(n) = Fib(n − 1) + Fib(n − 2).

Rule 3 makes reference to itself. I.e., in order (by this method) to calculate Fib(6), you have to calculate Fib(5), for which you have to calculate Fib(4)), for which you have to calculate Fib(3), for which you have to calculate Fib(2), which you can then base on rules (1) & (2): you can add 0 and 1 (= Fib(0) and Fib(1)) together to get Fib(2), and then you can calculate Fib(3) by adding Fib(1) and Fib(2) and so on.

Cursed recursion

In early Lisp(s), despite the concern around recursion, writing recursive functions was/is not always pragmatically viable, because it can lead to stack overflows (potential infinities are hard in practice).

Scheme, a Lisp dialect originally created at MIT by Guy L. Steele, Jr. and Gerald Jay Sussman, was the first Lisp to implement tail call optimisation, which is a way of making significantly recursive functions viable, making tail calls similar in memory requirement to their equivalent loops.

Before talking (a little bit more) about tail recursion, let’s look at concrete examples of a tail recursive function and its loop equivalent. We’ve mentioned Fibonacci numbers already, so let’s try to write functions calculate these (in Emacs Lisp).

Following the mathematical abstraction for the Fibonacci sequence above, we could write a function like this:

;; -*- lexical-binding: t; -*-
(defun fib1 (n a b)
  "Calculate the first `n' Fibonacci numbers, recursively."
  (if (< n 1)
      a
    (cons a
          (fib1 (1- n) b (+ a b)))))

I’ve tried to make this as simple as possible, we could make it nicer (say, with a wrapper function or some some of flet) so that we didn’t have to pass in the initial values. But, keeping it simple (for now): fib1 is a function taking three arguments: n, the quantity of Fibonacci numbers to return; a, the first number to start with; and b, the second number to start with.

Following the schema above, we’re going to pass 0 for a and 1 for b. Let’s get the first ten numbers of the sequence, and pass 10 for n:

(fib1 10 0 1)  ; (0 1 1 2 3 5 8 13 21 34 . 55)

I know, the output is a bit ugly because we’re just cons’ing the results and so it’s not a proper list, but we’re keeping things simple.

Let’s walk through how it works. The function first looks at n, if n is less than 1, it returns a (whatever it is). If n isn’t less than 1, we return the cons of a with the result of calling fib1 itself on “n minus 1” b and “a plus b”.

So if we start with n=3, a=0, b=1, that is, evaluate (fib1 3 0 1), the function would say, well, 3 isn’t less than 1, so I’m going to create a cons with 0 and the result of calling (fib1 2 1 1) (2 = “n minus 1”, because n is currently 3; 1 because b=1; and 1 because a + b = 0 + 1 = 1).

So at this point we have a cons that looks like this:

(0 . (fib1 2 1 1))  ;; [= (cons 0 (fib1 2 1 1))]

When we evaluate (fib1 2 1 1), n is still not less than 1, so we’re going to cons the current value of a (which is 1) with another call to fib1: (fib1 1 1 2) (1 = “n minus 1”, because n is currently 2; 1 because b=1; and 2 because a + b = 1 + 1 = 2).

So now we have:

(0 1 . (fib1 1 1 2))  ;; [= (cons 0 (cons 1 (fib1 1 1 2)))]

Now we have to evaluate (fib1 1 1 2). n is still not less than 1; so we create another cons of 1 (as a is currently 1) with yet another call of fib1: (fib1 0 2 3) (0 = “n minus 1”, because n is currently 1; 2 because b=2; and 3 because a + b = 1 + 2 = 3). And so now:

(0 1 1 . (fib1 0 2 3))  ;; [= (cons 0 (cons 1 (cons 1 (fib1 0 2 3))))]

And, finally, evaluating (fib1 0 2 3), now n is less than one, so we take the first branch of the conditional and just return a, which is 2. So the result of starting with (fib1 3 0 1) is:

(0 1 1 . 2)  ;; [= (cons 0 (cons 1 (cons 1 2)))]

And you can try this with other values of n, e.g., try evaluating (fib1 100 0 1) to get the first 100 members of the sequence.⁴

But, at least for me on Emacs 30.0.93, 529 is the limit. If we try (fib1 520 0 1), the debugger pops up with a 1622 line long error, which begins:

Debugger entered--Lisp error: (excessive-lisp-nesting 1622)
  cl-print--cons-tail(excessive-lisp-nesting (1601) #<buffer  *temp*>)
  #f(compiled-function (object stream) #<bytecode 0x491d55561699a09>)(#0 #<buffer  *temp*>)
  apply(#f(compiled-function (object stream) #<bytecode 0x491d55561699a09>) (#0 #<buffer  *temp*>))
  #f(compiled-function (&rest args) #<bytecode 0x1c31d892b8046a8b>)()
  #f(compiled-function (cl--cnm object stream) #<bytecode 0x7c361f66f109692>)(#f(compiled-function (&rest args) #<bytecode 0x1c31d892b8046a8b>) #0 #<buffer  *temp*>)
  apply(#f(compiled-function (cl--cnm object stream) #<bytecode 0x7c361f66f109692>) #f(compiled-function (&rest args) #<bytecode 0x1c31d892b8046a8b>) (#0 #<buffer  *temp*>))
  #f(compiled-function (object stream) #<bytecode 0x1f277a9a6dc403fa>)(#0 #<buffer  *temp*>)
  apply(#f(compiled-function (object stream) #<bytecode 0x1f277a9a6dc403fa>) #0 #<buffer  *temp*>)
  cl-print-object(#0 #<buffer  *temp*>)
  cl-prin1(#0 #<buffer  *temp*>)
  backtrace--print(#0 #<buffer  *temp*>)
  cl-print-to-string-with-limit(backtrace--print #0 5000)
  backtrace--print-to-string(#0 nil)
  backtrace-print-to-string(#0)
  debugger--insert-header((error #0 :backtrace-base eval-expression--debug))
  #f(compiled-function () #<bytecode 0x299e53d67d1ac62>)()
  backtrace-print()
  debugger-setup-buffer((error #0 :backtrace-base eval-expression--debug))
  debug(error #0 :backtrace-base eval-expression--debug)
  eval-expression--debug(#0)
  (if (< n 1) a (cons a (fib1 (1- n) b (+ a b))))
  fib1(0 259396630450514843945535792456880074043523940756078363514486570322782139633750401577338505233670220572153381665 419712564636128966418863068957011388899128076671547993021605479585858227224221424221791102364954108601240491394)
  (cons a (fib1 (1- n) b (+ a b)))
  (if (< n 1) a (cons a (fib1 (1- n) b (+ a b))))
  fib1(1 160315934185614122473327276500131314855604135915469629507118909263076087590471022644452597131283888029087109729 259396630450514843945535792456880074043523940756078363514486570322782139633750401577338505233670220572153381665)
  (cons a (fib1 (1- n) b (+ a b)))
  (if (< n 1) a (cons a (fib1 (1- n) b (+ a b))))
  fib1(2 99080696264900721472208515956748759187919804840608734007367661059706052043279378932885908102386332543066271936 160315934185614122473327276500131314855604135915469629507118909263076087590471022644452597131283888029087109729)
....

Because we’ve built up a long, deeply-embedded list of conses and Emacs has a limit of how deep it’s willing/able to go (you can see above that we’ve almost made it to the end, just needing to calculate fib1(0), when Emacs decides it’s had enough).

In Scheme and elsewhere, self-recursive calls at the ends (“tails”) of functions can be optimised to avoid these sorts of stack overflows (excessive-lisp-nesting).⁵ Tail-call optimisation lets procedure calls in tail positions be treated a specialised GOTO statements, which can be efficiently processed:

…only in cases where structures are explicitly declared to be dynamically referenced should the compiler be forced to leave them on the stack in an otherwise tail-recursive situation. In general, procedure calls may be usefully thought of as GOTO statements which also pass parameters, and can be uniformly encoded as JUMP instructions. This is a simple, universal technique, to be contrasted with […] more powerful recursion-removal techniques…

[Steele 1977:155⁶]

But our fib1 function doesn’t do this, and we end up flooded the stack with too many conses.

Back to loops

Recursive functions are perhaps most idiomatic in Scheme (among lisps, I mean). Some implementations of Common Lisp can do tail-call optimisation, but loops are perhaps more common, and certainly in Emacs Lisp (for reasons you can see above), loops are usually what are used. And so we can write a new Fibonacci function with a loop. It won’t be nearly as pretty, but it’ll work better.

Here’s one possible implementation:

;; -*- lexical-binding: t; -*-
(defun fib2 (n a b)
  "Calculate the first `n' Fibonacci numbers,
in a loop."
  (let ((result nil))
    (dotimes (c n)
      (setq result (cons a result))
      (setq tempa b)
      (setq b (+ a b))
      (setq a tempa))
    (nreverse result)))

(fib2 10 0 1) ; (0 1 1 2 3 5 8 13 21 34)

(setq bigfib-50000 (fib2 50000 0 1)) ; this will work - we can get 50,000 numbers

The result is prettier at least: a proper rather than an improper list (because we started by cons'ing onto an empty list). Our fib2 function itself isn’t as mathematically pleasing as our fib1 function, we end up with a lot of setq's (the nreverse at the end reverses our list, because the way we build up our list is by cons'ing the first results first, so they end up at the end until we flip them with nreverse). But it works well. If you try to (fib2 100000 0 1), it’ll fail, but not because of stack overflow, just because we end up with numbers that are too big for Emacs. But you can certain get the over 50,000 members of the Fibonacci sequence, which is much better than fib1's limit of 529.

And dotimes is just one loop procedure available. (See cl-loop for a more powerful one.)

Optimal Tail with Emacs

Ok, so, practically, we should probably generally prefer loops over tail-recursive functions in Emacs. But, what if we just like the latter more?⁷ Are there any other possibilities?

Wilfred Hughes has an emacs package tco.el which implements a special macro for writing tail-recursive functions.⁸ It works by replacing each self-call with a thunk, and wrapping the function body in a loop that repeatedly evaluates the thunk. Thus a function foo defined with the defun-tco macro:

(defun-tco foo (...)
  (...)
  (foo (...)))

would be re-written as:

(defun foo (...)
   (flet (foo-thunk (...)
               (...)
               (lambda () (foo-thunk (...))))
     (let ((result (apply foo-thunk (...))))
       (while (functionp result)
         (setq result (funcall result)))
       result)))

And this delays evaluation in such a way as to avoid stack overflows. Unfortunately, at least currently for me (Emacs 30.0.93 again), tco.el seems to have some issues.

In Emacs 28.1, cl-labels (one of the ways of sort of doing let's for functions) gained some limited tail-call optimisation (as did named-let, which uses cl-labels).

;; -*- lexical-binding: t; -*-
(defun fib3 (n)
  "Calculate the first `n' Fibonacci numbers,
recursively, with limited tail-call optimisation
through `cl-labels'?!"
  (cl-labels ((fib* (n a b)
                (if (< n 1)
                    a
                  (cons a
                        (fib* (1- n)
                              b
                              (+ a b))))))
    (fib* n 0 1)))

(setq bigfib3 (fib3 397)) ; 396 highest that works

At least the way I’ve written it, it seems to suffer an overflow even sooner (at 397 rather than 529 as for our fib1), because it has to come back and do the cons after the tail-call — so fib* isn’t actually in the tail. (We can fix this in at least one way, which we’ll do in fib5.)

We could try to write an accumulator as a hack, where we try to do ours conses one at a time and pass along the results, but this fares no better than our fib1:

;; -*- lexical-binding: t; -*-
(defun fib4 (n a b accum)
  "Calculate the first `n' Fibonacci numbers, recursively,
but collect conses as we go and keep track of the length of
the `accum' cp. against `n'."
  (let* ((accum (cons a accum))
         (accum-lng (length accum)))
    (if (< n accum-lng)
        (nreverse accum)
      (fib4 n b (+ b a) accum))))

(setq bigfib4-529 (fib4 529 0 1 nil)) ; last good
(setq bigfib4-530 (fib4 530 0 1 nil)) ; overflows

If we combine cl-labels and the accumulator trick, however, we do seem to be able to escape stack overflows, because now we’ve got fib* properly in the tail:

;; -*- lexical-binding: t; -*-
(defun fib5 (n)
  "Calculate the first `n' Fibonacci numbers, recursively,
using both cl-labels and the accumulator trick."
  (cl-labels ((fib* (a b accum)
                   (let* ((accum (cons a accum))
                         (accum-lng (length accum)))
                     (if (< n accum-lng)
                         (nreverse accum)
                         (fib* b (+ b a) accum)))))
            (fib* 0 1 nil)))

(setq bigfib5-10000 (fib5 10000)) ; ok
(setq bigfib5-50000 (fib5 50000)) ; very slow, but ok

Now we’re back in the realms of what our fib2 non-recursive loop-style function could do. Although (setq bigfib5-50000 (fib5 50000)) calculates very slowly (worse than our looping fib2), so that’s not ideal.

Stream of Conses-ness

But here’s another possibility: Nicholas Pettton‘s stream package for emacs, where “streams” are delayed evaluations of cons cells.

;; -*- lexical-binding: t; -*-
(defun fib6 (n)
  "Return a list of the first `n' Fibonacci numbers,
implemented as stream of (delayed evaluation) conses."
  (cl-labels ((fibonacci-populate (a b)
                (stream-cons a (fibonacci-populate b (+ a b)))))
    (let ((fibonacci-stream
           (fibonacci-populate 0 1))
          (fibs nil))
      (dotimes (c n)
        (setq fibs (cons (stream-pop fibonacci-stream) fibs)))
      (nreverse fibs))))

(setq fib6-10k (fib6 10000)) ; ok
(setq fib6-50k (fib6 50000)) ; little slow, but works
(setq fib6-100k (fib6 100000)) ; little slow & overflow error

This works well. (fib6 50000) still turns out to run a bit slower than our (fib2 50000), so loops are still probably more efficient, but streams are pretty interesting. They can can used to represent infinite sequences. So here, above, fibonacci-stream (set by (fibonacci-populate 0 1)) is actually an infinite stream of Fibonaccis numbers, but lazily evaluated, so we just get the next one each time we call stream-pop on our fibonacci-stream local variable. (What happens is that stream-pop takes the car of fibonacci-stream, evaluates and returns it, and then sets fibonacci-stream to be its cdr (i.e., popping off and “discarding” the first element; which which captured in our fibs collector.))

Cascades of Fibonacci numbers

Oh, incidentally and irrelevantly, if you inspect the contents of your fib6-50k, it’s very aesthetically pleasing, a cascade of numbers:

excessive-lisp-nesting: (overflow-error)

I had hoped to get to the Y Combinator today (and think I might have suggested a promise of that), for that’s where things really get interesting. And we need to get back to lambda calculus, of course. But we may be near the limits of excessive lisp nesting ourselves here.

However, the recursion discussion here has set the stage for the Y Combinator, which we’ve already talked a couple of times, especially in connection to John McCarthy’s claims about “not really understanding” lambda calculus and the fact that these really centre on his not seeing how one could get recursion without direct Self-reference (and thus the need for LABEL) because of not knowing about the Y Combinator.

And, the Y Combinator ties in with all sorts of other curious things. Paradoxes, types, calligraphy.

[Thus, I ended up with an excursus on this excursus as the next post. I’ll put a link here to the proper third part when it’s up.]