I wrote a macro that encapsulated the pattern. I’ve reworked that macro into a library for public use.

Acquiring

• Home page: http://nklein.com/software/track-best-library/
• Main git repository: http://git.nklein.com/lisp/libs/track-best.git
• Browsable repository: https://github.com/nklein/track-best

Using

There are a variety of examples in the README and the tests directory.

Here is one example to pique your interest. Suppose you have some data about the elevations of various cities in various states and you (being a Moxy Fruvous fan) want to know What Is the Lowest Highest Point? Here’s how you might tackle that with the TRACK-BEST library:

(let ((data '(("Alabama"  ("Birmingham" 664)
                          ("Mobile" 218)
                          ("Montegomery" 221))
              ("Alaska"   ("Anchorage" 144)
                          ("Fairbanks" 531))
              ("Arizona"  ("Grand Canyon" 6606)
                          ("Phoenix" 1132)
                          ("Tuscon"  2641)))))
  (with-track-best (:order-by-fn #'<)
    (dolist (state-info data)
      (multiple-value-bind (city altitude)
          (with-track-best ()
            (dolist (city-info (rest state-info))
              (track (first city-info) (second city-info))))
        (track (list (first state-info) city) altitude)))))

With this limited dataset, the end result would be (VALUES '("Alaska" "Fairbanks") 531). The inner WITH-TRACK-BEST finds the highest city in each state. The outer WITH-TRACK-BEST finds the lowest of these.

The Problem Domain

I read an article about Treaps on reddit yesterday. The article used pretty direct pylisp to present Treaps.

I thought it would be fun to go through the exercise in Common Lisp instead. Pylisp made a number of things awkward that would melt away in Common Lisp.

I began by defining a node structure to encapsulate the information at a given node:

(defstruct node
  (priority (random 1.0d0) :type real :read-only t)
  (key 0 :read-only t)
  (value 0 :read-only t)
  (left nil :type (or null node) :read-only t)
  (right nil :type (or null node) :read-only t))

Then, I defined a top-level structure to hold the root node, track the function used to sort the tree, and track the function used to create a key from a value. I used the convention that two keys are equivalent if neither is less than the other.

(defstruct treap
  (root nil :type (or null node) :read-only t)
  (less-than #'< :read-only t)
  (key #'identity :read-only t))

The First Build Up

The article was using a functional style. As you may have guessed by the liberal use of :read-only t in those DEFSTRUCT clauses, I also used a functional style.

When working with functional data structures, one often needs to copy a whole structure with only slight modifications. Here, Lisp’s keyword arguments made everything simple and clean. I made this functions:

(defun copy-node (node &key (priority (node-priority node))
                            (key (node-key node))
                            (value (node-value node))
                            (left (node-left node))
                            (right (node-right node)))
  (make-node :priority priority
             :key key
             :value value
             :left left
             :right right))

Now, for any node, I could copy it and only have to specify the fields that I wanted to change. Here is a left-rotation using this:

(defun left-rotate (node)
  (let ((left (node-left node)))
    (copy-node left
               :right (copy-node node
                                 :left (node-right left)))))

What other languages let you do anything like that so simply? You could pull it off in Perl if you were willing to have your node be a hash (which, admittedly, you probably are if you’re writing Perl). What other language lets you do anything like that? Even other languages with named arguments don’t let you have the defaults based on other arguments.

The Second Build Up

As with any binary tree, you find yourself having to deal with four specific cases over and over again with Treaps.

• You ran out of tree
• Your key is less than the current node’s key
• Your key is greater than the current node’s key
• Your key is equivalent to the current node’s key

I wrote myself a TREAP-CASES macro that streamlines all of these checks. It also validates to make sure you don’t have duplicate cases or cases other than these four. It makes sure that no matter which order you write the cases (or even if you leave some out), they end up organized in the order listed above. The four cases are mutually exclusive so the order doesn’t matter except that you want to make sure you haven’t run out of tree before doing comparisons and that once you’re beyond the less-than and greater-than cases you already know you’re in the equivalence case.

With this macro, my TREAP-FIND function looks like this:

(defun treap-find (key treap)
  (check-type treap treap)
  (labels ((treap-node-find (root)
             (treap-cases (key root treap)
               (null (values nil nil))
               (< (treap-node-find (node-left root)))
               (> (treap-node-find (node-right root)))
               (= (values (node-value root) t)))))
    (treap-node-find (treap-root treap))))

The little DSL makes writing and reading the code so much easier. All of the mess of comparing the key to the node’s key is hidden away.

With years of practice and days of debugging, you might be able to pull off some quasi-readable control construct like this using C++ templates. With enough therapy, you could convince yourself you can get a close-enough effect with C-preprocessor macros. In Lisp, it’s the work of minutes (without lying to yourself).

Here is the TREAP-CASES macro for reference/completeness.

(defmacro treap-cases ((key root treap) &rest clauses)
  (validate-treap-case-clauses clauses)
  (let ((k (gensym "KEY-"))
        (tr (gensym "TREAP-"))
        (r (gensym "ROOT-"))
        (t< (gensym "<-")))
    `(let* ((,k ,key)
            (,tr ,treap)
            (,r ,root)
            (,t< (treap-less-than ,tr)))
       (cond
        ((null ,r) ,@(rest (assoc 'null clauses)))
        ((funcall ,t< ,k (node-key ,r)) ,@(rest (assoc '< clauses)))
        ((funcall ,t< (node-key ,r) ,k) ,@(rest (assoc '> clauses)))
        (t ,@(rest (assoc '= clauses)))))))

I suppose I should also include #'VALIDATE-TREAP-CASE-CLAUSES, too, but it’s what you’d expect:

(defun validate-treap-case-clauses (clauses)
  (let ((all-choices '(null < > =)))
    (flet ((assert-all-choices-valid ()
             (dolist (c clauses)
               (unless (member (first c) all-choices)
                 (error "Unrecognized clause type: ~S" (first c)))))
           (assert-no-duplicates ()
             (dolist (c all-choices)
               (unless (<= (count c clauses :key #'first) 1)
                 (error "Duplicate ~S clause not allowed." c)))))
      (assert-all-choices-valid)
      (assert-no-duplicates))))

One of them is simple EXPONENT-MODULO that takes a base , an exponent , and a modulus and returns . There are more efficient ways to do this, but this one is much faster than the naïve method and quite easy to rewrite every time that I need it. The idea is that when is odd, you recursively calculate and return . When is even, you recursively calculate and return .

(defun expt-mod (b e m)
  (cond
    ((zerop e) 1)
    ((evenp e) (let ((a (expt-mod b (/ e 2) m)))
                 (mod (* a a) m)))
    (t (mod (* b (expt-mod b (1- e) m)) m))))

The other snippet of code is a good deal trickier. Every time I need it, I spend way more time than I want to futzing with examples, getting lost in subscripts, etc. So, while I could rewrite the above in a moment, what’s below, I hope I have the search-fu to find this post next time I need it.

If you have a number and some number which is relatively prime to (shares no factors except for one with) , then there exists some number such that . And, in fact, all such numbers for a given differ by a multiple of , so there is a unique such .

Another way of saying and are relatively prime is to say that their greatest common divisor is one. Besides being the biggest number that divides into both and , the is also the smallest positive number expressible as for integers and . If you keep track of the steps you use when calculating the greatest common divisor (which in this case is ) while using the Euclidean algorithm you can (with enough care) backtrack through the steps and determine and for your given and .

For example, suppose you had and . You want to know what you’d need for .
The steps in the Euclidean algorithm show:

Working backwards, you can express as a combination of . Then, you can express as a combination of and so on:

Wheee… in my example chosen to be easy to backtrack, the answer comes out to be which is equal to modulo . So, . I picked a lucky number that is its own inverse modulo . It’s not usually like that. For example, .

So, anyhow, here’s a function that takes and and returns two values and so that .

(defun gcd-as-linear-combination (a n)
  (multiple-value-bind (q r) (truncate n a)
    (if (zerop r)
        (values 1 0)
        (multiple-value-bind (x y) (gcd-as-linear-combination r a)
          (values (- y (* q x)) x)))))

Assuming that and are relatively prime with , the first value returned is ‘s inverse modulo .

I’m now working for Clozure Associates. It’s awesome.

And, on top of the awesome of getting paid to do Lisp, there was an added layer of awesome this week. I had dinner with some Clozure folk on Wednesday night in Boston. Cyrus Harmon happened to also be in Boston that day. News of Cyrus’s proximity triggered an impromptu Boston Lisp User’s dinner meeting. So, I met Zach Beane, Cyrus Harmon, Ben Hyde, François-René Rideau, Andrew Shalit, and Gail Zacharias all on the same day.

Zach is taller than I’d have thought. Cyrus isn’t Eastern European as I’d somehow believed him to be. Faré sounds just like I’d imagined in such an eerie way that if he had looked at all familiar I’d have believed that I’d seen him live or on video before.

A few weeks back, I needed to generate all of the primes up to a given number. The number was big enough that I didn’t want to keep an array of bytes (or even bits) big enough to do the sieving. I just had an aversion to keeping around O() memory when O() would suffice. I also had a hankering (probably because of Let Over Lambda) to implement it as a generator—a function that each time you called it gave you the next prime.

My first version amounted to trial-division against the entire list of primes generated so far. For the number of primes that I wanted to generate, this took more than nine minutes. Unacceptable.

I made some tweaks to it to ensure that I was only checking against the previously generated primes that were less than or equal to (isqrt n). I made some other tweaks to keep my previously generated primes sorted so the most-likely to be a divisor of were first. I made another tweak to accumulate the first primes into a product so that I could check all of those against with a (gcd n product-of-first-k) where was constrained so that the product stayed below most-positive-fixnum.

Those tweaks got me down to around two minutes. That was still more than twice as long as I wanted it to take.

Now, with the help of CL-HEAP and the Rosetta-Code-approved optimization mentioned in that blog post, I have it down to thirty seconds with no trial division, no square roots, and only one multiplication per prime.

I keep a heap of cons cells. The car is the next number that will be crossed out by this prime and the cdr is how much to increment the car once I’ve crossed out the car.

Ignoring the special-case at the beginning for two, my current algorithm looks like this:

(defun prime-generator ()
  (let ((nixed (make-instance 'cl-heap:fibonacci-heap
                              :key #'first
                              :sort-fun #'<))
        (guess 1))
 
    (lambda ()
      (loop :do (incf guess 2) :until (%prime-p guess nixed))
      (cl-heap:add-to-heap nixed (cons (* guess guess) (* guess 2)))
      guess)))

The %prime-p function pulls cons cells off of the heap until it finds whose car isn’t equal to the current guess. For each of them where the car was equal, it increments the car by its cdr. Then, it puts all of the cons cells it removed back on the heap. The guess was prime if it wasn’t equal to any of the numbers on the heap.

(defun %prime-p (guess nixed)
  (let ((prime t)
        (n nil))
    (loop :do (setf n (cl-heap:pop-heap nixed))
       :while (and n (= (car n) guess))
       :do (progn
             (incf (car n) (cdr n))
             (cl-heap:add-to-heap nixed n)
             (setf prime nil))
       :finally (when n (cl-heap:add-to-heap nixed n)))
    prime))

I could probably save some time and cons-ing by peeking at the top of the heap rather than always gathering or countless other ways, but this more than exceeded my expectations for today.

Each time I did it imperatively, I decreased the overall size of the code. The functional code is smaller still and got smaller on my second try. The previous video was bowling-20130102.lisp and the functional versions end in -f.lisp.

% lisp_count *.lisp
70 bowling-20121230.lisp
70 bowling-20130102.lisp
64 bowling-20130106.lisp
62 bowling-20130107.lisp
64 bowling-20130109.lisp
66 bowling-20130110.lisp
62 bowling-20130113.lisp
54 bowling-20130113b-f.lisp
57 bowling-20130114.lisp
57 bowling-20130114b.lisp
51 bowling-20130114c-f.lisp
Total:
677

These SLOC numbers were generated using David A. Wheeler’s ‘SLOCCount’. Straight up byte, word, and line counts follow the same trend.

Soon, I will record another run through the imperative style and a run through the functional style.

Here are the most recent versions of each style:

• bowling-20130114b
• bowling-20130114c-f

The Bowling Game Kata in Common Lisp from Patrick Stein on Vimeo.

Code Kata are repetitive coding tasks designed to help one internalize certain patterns, methodologies, or tools. In this video, I go through Uncle Bob Martin’s The Bowling Game Kata. The Kata exercises test-driven development. Uncle Bob’s presentation of the Kata is in Java. This is in Common Lisp.

Additionally, Nick is incredibly responsive. I found an oversight in a corner-case of cl-log last Friday at 1am. I emailed him about it at 1:19am. In under 5 hours, I had email back pointing me to a new release with that case corrected.

I hope to do a more complete comparison of the existing log libraries at some point. At this point, know that I’ve tried all of the ones on the Cliki which had obvious documentation or examples, and I’ll be using cl-log.

In Clean Code, Episode 3 – Functions, he makes the case that we should be striving to keep each function under five lines long. So, over the past month or so, I’ve been trying this out in all of my Scala and Lisp endeavors.

Once you get each function down to four lines or fewer, you start running into symbol-proliferation. You pretty much throw out (LABELS ...) and (FLET ...) unless you need the closure (and then try to say that when you can’t that it’s good enough to just keep the subfunctions under five lines and the body under five, too). You create bunches of functions that should never be called anywhere except the one place it’s called now.

Enter Package Proliferation!

Then, I remembered some Lisp coding style guidelines that I read early this year sometime. Those guidelines advocated having one package for each Lisp file and explicitly making peer files have to import or qualify symbols used from other peer files. This will help me with the symbol-proliferation! Let’s do it!

Enter File Proliferation!

After two weeks of that, I woke up yesterday morning realizing that I wasn’t getting the full benefit from this if I was exporting more than one symbol from each package. If keeping each function tiny is Good and limiting a package to one file is Good, then it is certainly Bad to have one file’s package exporting eight different functions.

So, today, I reworked all of the UNet that I wrote in the last couple of weeks to have one package per file and as few exported symbols per package as possible.

In the interest of testability and modularity, I had broken out a subpackage of UNet called UNet-Sockets that is to be the interface the UNet library uses to interact with sockets. I had realized that I had a file called methods.lisp with four different publicly available (DEFMETHOD ...) forms in it. Now, each is in its own file and package. I did the same for various other declarations.

Now, there is a top-level package which uses Tim Bradshaw’s Conduit Packages to collect all of the symbols meant to be used externally from these packages. If there is an exported function in a package, that is the only exported symbol in that package. If there is an exported generic function declaration in a package, that is the only exported symbol from that package. If there is an exported method implementation in a package, there aren’t any exported symbols from that package. If there is an exported condition in a package, that condition and its accessors are the only exported symbols from that package. If there is an exported class in a package, that class and its accessors are the only exported symbols from that package.

Example

The top-level package of the UNET-SOCKETS system, that defines the interface that UNet will use to access its sockets, consists of just a (DEFPACKAGE ...) form. You can see the full package on github in the unet-sockets.asd and the sockets/ directory.

(org.tfeb.conduit-packages:defpackage :unet-sockets
  (:use :cl)
  (:extends/including :unet-sockets-interface
                      #:sockets-interface)
 
  (:extends/including :unet-sockets-base-socket
                      #:base-socket)
 
  (:extends/including :unet-sockets-hostname-not-found-error
                      #:hostname-not-found-error
                      #:hostname-not-found-error-hostname)
 
  (:extends/including :unet-sockets-get-address
                      #:get-address)
 
  (:extends/including :unet-sockets-address+port-not-available-error
                      #:address+port-not-available-error
                      #:address+port-not-available-error-address
                      #:address+port-not-available-error-port)
 
  (:extends/including :unet-sockets-create-datagram-socket
                      #:create-datagram-socket)
 
  (:extends/including :unet-sockets-send-datagram
                      #:send-datagram)
 
  (:extends/including :unet-sockets-poll-datagram
                      #:poll-datagram))

Conclusion?

The jury’s still out on this for me. On the one hand, the self-flagellation is an interesting exercise. On the other hand, if I’m going to have to export everything useful and import it in multiple places then I’m taking away some of the fun. I feel like I’m maintaining C++ header files to some extent.

I think I’ll keep it up for the UNet project, at least. It makes good documentation to have each exported symbol in a package and file named for that exported symbol. You can open up any file and read the three-to-four line exported function in it. You can see, right there with it, any supporting function it uses that no other files need to use. You can see from the (DEFPACKAGE ...) form at the top where any other supporting functions came from. And nothing else is cluttering up the landscape.

We’ll see if I develop religion on this topic. At the moment, I think it’s eventually going to fall into the moderation in all things bucket. Time will tell.

Last night, for grins, I thought I would implement them in Common Lisp. I started out doing them without referencing the Scala code that I’d written. Then, I got lazy and pulled up the Scala code for the last problem and a half.

For all three problems, I came up with better solutions that translated back into the Scala. Some of it was just the benefit of looking at the previous solution again. Some of it was thinking about it with a new language in mind. Some of it was being more comfortable with Lisp. It was such a dramatic improvement in the code that even though I had scored 10/10 six days ago, I still reworked the Scala code and resubmitted it last night.

As it relates to Common Lisp development specifically…. One of the first Lisp books that I read was Paul Graham’s On Lisp. In that book, he does a great deal of turning recursive functions into tail-recursive functions. I had followed his idiom of calling the internal function rec:

(defun factorial (n)
  (labels ((rec (n accum)
             (if (zerop n)
                 accum
               (rec (1- n) (* n accum)))))
    (rec n 1)))

For the Scala, I started out naming the internal function with a Rec suffix on the function name:

def factorial (n: Int): Int =
  def factorialRec (n: Int, accum: Int): Int =
    if (n == 0) accum
    else factorialRec(n-1, n*accum)
  factorialRec(n,1)

Now, I’m partial to just re-using the function name:

(defun factorial (n)
  (labels ((factorial (n accum)
             (if (zerop n)
                 accum
               (factorial (1- n) (* n accum)))))
    (factorial n 1)))